~ruther/guix-local

91fe0e20c7da2b706a1ac0e7b75235b6c1e6ed0a — Ludovic Courtès 13 years ago b30b13d
ftp-client: Let callers handle `ftp-open' exceptions.

* guix/ftp-client.scm (ftp-open): Let exceptions through.
* guix/scripts/package.scm (waiting): Wrap EXP in a `dynamic-wind', so
  the line is always cleared.
2 files changed, 42 insertions(+), 46 deletions(-)

M guix/ftp-client.scm
M guix/scripts/package.scm
M guix/ftp-client.scm => guix/ftp-client.scm +33 -39
@@ 87,45 87,39 @@ or a TCP port number), and return it."
  ;; Use 21 as the default PORT instead of "ftp", to avoid depending on
  ;; libc's NSS, which is not available during bootstrap.

  (catch 'getaddrinfo-error
    (lambda ()
      (define addresses
        (getaddrinfo host
                     (if (number? port) (number->string port) port)
                     (if (number? port) AI_NUMERICSERV 0)))

      (let loop ((addresses addresses))
        (let* ((ai (car addresses))
               (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)
                           (addrinfo:protocol ai))))

          (catch 'system-error
            (lambda ()
              (connect s (addrinfo:addr ai))
              (setvbuf s _IOLBF)
              (let-values (((code message) (%ftp-listen s)))
                (if (eqv? code 220)
                    (begin
                      ;;(%ftp-command "OPTS UTF8 ON" 200 s)
                      (%ftp-login "anonymous" "guix@example.com" s)
                      (%make-ftp-connection s ai))
                    (begin
                      (format (current-error-port)
                              "FTP to `~a' failed: ~A: ~A~%"
                              host code message)
                      (close s)
                      #f))))

            (lambda args
              ;; Connection failed, so try one of the other addresses.
              (close s)
              (if (null? addresses)
                  (apply throw args)
                  (loop (cdr addresses))))))))
    (lambda (key errcode)
      (format (current-error-port) "failed to resolve `~a': ~a~%"
              host (gai-strerror errcode))
      #f)))
  (define addresses
    (getaddrinfo host
                 (if (number? port) (number->string port) port)
                 (if (number? port) AI_NUMERICSERV 0)))

  (let loop ((addresses addresses))
    (let* ((ai (car addresses))
           (s  (socket (addrinfo:fam ai) (addrinfo:socktype ai)
                       (addrinfo:protocol ai))))

      (catch 'system-error
        (lambda ()
          (connect s (addrinfo:addr ai))
          (setvbuf s _IOLBF)
          (let-values (((code message) (%ftp-listen s)))
            (if (eqv? code 220)
                (begin
                  ;;(%ftp-command "OPTS UTF8 ON" 200 s)
                  (%ftp-login "anonymous" "guix@example.com" s)
                  (%make-ftp-connection s ai))
                (begin
                  (format (current-error-port)
                          "FTP to `~a' failed: ~A: ~A~%"
                          host code message)
                  (close s)
                  #f))))

        (lambda args
          ;; Connection failed, so try one of the other addresses.
          (close s)
          (if (null? addresses)
              (apply throw args)
              (loop (cdr addresses))))))))

(define (ftp-close conn)
  (close (ftp-connection-socket conn)))

M guix/scripts/package.scm => guix/scripts/package.scm +9 -7
@@ 307,13 307,15 @@ return its return value."
    (force-output (current-error-port))
    (call-with-sigint-handler
     (lambda ()
       (let ((result exp))
         ;; Clear the line.
         (display #\cr (current-error-port))
         (display blank (current-error-port))
         (display #\cr (current-error-port))
         (force-output (current-error-port))
         exp))
       (dynamic-wind
         (const #f)
         (lambda () exp)
         (lambda ()
           ;; Clear the line.
           (display #\cr (current-error-port))
           (display blank (current-error-port))
           (display #\cr (current-error-port))
           (force-output (current-error-port)))))
     (lambda (signum)
       (format (current-error-port) "  interrupted by signal ~a~%" SIGINT)
       #f))))