Changeset 12227 in project for chicken/trunk/chicken-install.scm


Ignore:
Timestamp:
10/21/08 20:42:22 (12 years ago)
Author:
felix winkelmann
Message:
  • added helpful script for testing in build dir
  • chicken-install checks for TCP timeouts and handles multiple default sources to download from
  • alias-global-hook is saved and restored when loading compiler extensions
  • making bootstrap automaticaly makes confclean
File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/chicken-install.scm

    r11989 r12227  
    5454         (else (foreign-value "C_INSTALL_BIN_HOME" c-string) ) )) )
    5555
    56   (define *default-transport* #f)
    57   (define *default-location* #f)
    5856  (define *keep* #f)
    5957  (define *force* #f)
     
    6664  (define *username* #f)
    6765  (define *password* #f)
     66  (define *default-sources* '())
     67  (define *default-location* #f)
     68  (define *default-transport* 'http)
    6869
    6970  (define (load-defaults)
    70     (let* ((deff (make-pathname (repository-path) "setup.defaults"))
    71            (def (cond ((file-exists? deff)
    72                        (with-input-from-file deff read))
    73                       (else '())))
    74            (loc (assq 'location def))
    75            (tr (assq 'transport def)))
    76       (when loc (set! *default-location* (cadr loc)))
    77       (when tr (set! *default-transport* (cadr tr)))
    78       (pair? def)))
     71    (let ((deff (make-pathname (repository-path) "setup.defaults")))
     72      (cond ((not (file-exists? deff)) '())
     73            (else
     74             (set! *default-sources* (read-file deff))
     75             (pair? *default-sources*)))))
    7976
    8077  (define (deps key meta)
     
    137134    (define *checked* '())
    138135
     136    (define (try name version)
     137      (let loop ((defs (if (and *default-location* *default-transport*)
     138                           `(((location ,*default-location*)
     139                              (transport ,*default-transport*)))
     140                           *default-sources*)))
     141        (and (pair? defs)
     142             (let* ((def (car defs))
     143                    (loc (cadr (or (assq 'location def)
     144                                   (error "missing location entry" def))))
     145                    (trans (cadr (or (assq 'transport def)
     146                                     (error "missing transport entry" def)))))
     147               (or (condition-case
     148                       (retrieve-extension
     149                        name trans loc
     150                        version: version
     151                        destination: (and *retrieve-only* (current-directory))
     152                        tests: *run-tests*
     153                        username: *username*
     154                        password: *password*)
     155                     ((exn net)
     156                      (print "TCP connect timeout")
     157                      #f)
     158                     (e () (abort e)))
     159                   (loop (cdr defs)))))))
     160
    139161    (define (retrieve eggs)
    140162      (print "retrieving ...")
     
    148170                (let* ((name (if (pair? egg) (car egg) egg))
    149171                       (version (and (pair? egg) (cdr egg)))
    150                        (dir (retrieve-extension
    151                              name *default-transport* *default-location*
    152                              version: version
    153                              destination: (and *retrieve-only* (current-directory))
    154                              tests: *run-tests*
    155                              username: *username*
    156                              password: *password*)))
     172                       (dir (try name version)))
    157173                  (unless dir
    158174                    (error "extension or version not found"))
     
    241257
    242258  (define (usage code)
    243     (print #<#EOF
     259    (print #<<EOF
    244260usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
    245261
     
    248264       -force                   don't ask, install even if versions don't match
    249265  -k   -keep                    keep temporary files
    250   -l   -location LOCATION       install from given location instead of default (#{*default-location*})
    251   -t   -transport TRANSPORT     use given transport instead of default (#{*default-transport*})
     266  -l   -location LOCATION       install from given location instead of default
     267  -t   -transport TRANSPORT     use given transport instead of default
    252268  -s   -sudo                    use sudo(1) for installing or removing files
    253269  -r   -retrieve                only retrieve egg into current directory, don't install
Note: See TracChangeset for help on using the changeset viewer.