Changeset 11705 in project


Ignore:
Timestamp:
08/22/08 10:45:50 (13 years ago)
Author:
felix winkelmann
Message:

error checking in setup tools

Location:
chicken/branches/hygienic
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/hygienic/chicken-install.scm

    r11703 r11705  
    135135                        version #f
    136136                        (and *retrieve-only* (current-directory)))))
     137             (unless dir
     138               (error "extension or version not found"))
    137139             (print " " name " located at " dir)
    138140             (set! *eggs+dirs* (alist-cons name dir *eggs+dirs*)))))
     
    215217    (unless *keep*
    216218      (and-let* ((tmpdir (temporary-directory)))
    217         (print "removing temporary directory " tmpdir)
    218219        (remove-directory tmpdir))))
    219220
  • chicken/branches/hygienic/henrietta.scm

    r11703 r11705  
    5757                  name *default-transport* *default-location*
    5858                  version #t))))
     59      (unless dir
     60        (fail "no such extension or version" name version))
    5961      (let walk ((dir dir) (prefix "."))
    6062        (let ((files (directory dir)))
  • chicken/branches/hygienic/setup-download.scm

    r11703 r11705  
    7575 
    7676  (define (locate-egg/svn egg repo #!optional version destination)
    77     (let ((cmd (sprintf "svn ls --username=anonymous --password='' -R \"~a/~a\"" repo egg)))
    78       (d "checking available versions ...~%  ~a~%" cmd)
    79       (let* ((files (with-input-from-pipe cmd read-lines))
    80              (hastrunk (member "trunk/" files))
    81              (filedir
    82               (or (let ((vs (filter-map
    83                              (lambda (f)
    84                                (and-let* ((m (string-search "^tags/([^/]+)/" f))
    85                                           (v (cadr m)))
    86                                  (print v)
    87                                  v))
    88                              files)))
    89                     (if version
    90                         (if (member version vs)
    91                             (string-append "tags/" version)
    92                             (error "version not found" egg version))
    93                         (let ((vs (sort vs version>=?)))
    94                           (and (pair? vs)
    95                                (string-append "tags/" (car vs))))))
    96                   (begin
    97                     (when version
    98                       (warning "extension has no such version - using trunk" egg version))
    99                     (and hastrunk "trunk") )
    100                   ""))
    101              (tmpdir (make-pathname (or destination (get-temporary-directory)) egg))
    102              (cmd (sprintf "svn co --username=anonymous --password='' \"~a/~a/~a\" \"~a\" ~a"
    103                            repo egg filedir
    104                            tmpdir
    105                            (if *quiet* "1>&2" ""))))
    106         (d "  ~a~%" cmd)
    107         (system* cmd)
    108         tmpdir)) )
     77    (call/cc
     78     (lambda (k)
     79       (define (runcmd cmd)
     80         (unless (zero? (system cmd))
     81           (k #f)))
     82       (let ((cmd (sprintf "svn ls --username=anonymous --password='' -R \"~a/~a\"" repo egg)))
     83         (d "checking available versions ...~%  ~a~%" cmd)
     84         (let* ((files (with-input-from-pipe cmd read-lines))
     85                (hastrunk (member "trunk/" files))
     86                (filedir
     87                 (or (let ((vs (filter-map
     88                                (lambda (f)
     89                                  (and-let* ((m (string-search "^tags/([^/]+)/" f))
     90                                             (v (cadr m)))
     91                                    (print v)
     92                                    v))
     93                                files)))
     94                       (if version
     95                           (if (member version vs)
     96                               (string-append "tags/" version)
     97                               (error "version not found" egg version))
     98                           (let ((vs (sort vs version>=?)))
     99                             (and (pair? vs)
     100                                  (string-append "tags/" (car vs))))))
     101                     (begin
     102                       (when version
     103                         (warning "extension has no such version - using trunk" egg version))
     104                       (and hastrunk "trunk") )
     105                     ""))
     106                (tmpdir (make-pathname (or destination (get-temporary-directory)) egg))
     107                (cmd (sprintf "svn co --username=anonymous --password='' \"~a/~a/~a\" \"~a\" ~a"
     108                              repo egg filedir
     109                              tmpdir
     110                              (if *quiet* "1>&2" ""))))
     111           (d "  ~a~%" cmd)
     112           (runcmd cmd)
     113           tmpdir)) )))
    109114
    110115  (define (locate-egg/http egg url #!optional version destination)
     
    156161        (let loop ((files '()))
    157162          (let ((name (read in)))
    158             (d "  ~a~%" name)
    159163            (cond ((and (pair? name) (eq? 'error (car name)))
    160                    (apply error (cdr name)))
     164                   (apply
     165                    error
     166                    (string-append "[Server] " (cadr name))
     167                    (cddr name)))
    161168                  ((or (eof-object? name) (not name))
    162169                   (close-input-port in)
     
    165172                   (error "invalid file name - possibly corrupt transmission" name))
    166173                  ((string-suffix? "/" name)
     174                   (d "  " name)
    167175                   (create-directory (make-pathname dest name))
    168176                   (loop files))
    169177                  (else
     178                   (d "  " name)
    170179                   (let* ((size (read in))
    171180                          (_ (read-line in))
Note: See TracChangeset for help on using the changeset viewer.