diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-05-14 23:51:36 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-05-14 23:51:36 +0200 |
commit | 91fe0e20c7da2b706a1ac0e7b75235b6c1e6ed0a (patch) | |
tree | 1579c2b5dc616cdd9f8177722d8b93fbdf2df8c4 /guix | |
parent | b30b13dc3d881d734098599540aa0bb13bcf7e61 (diff) | |
download | gnu-guix-91fe0e20c7da2b706a1ac0e7b75235b6c1e6ed0a.tar gnu-guix-91fe0e20c7da2b706a1ac0e7b75235b6c1e6ed0a.tar.gz |
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.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/ftp-client.scm | 72 | ||||
-rw-r--r-- | guix/scripts/package.scm | 16 |
2 files changed, 42 insertions, 46 deletions
diff --git a/guix/ftp-client.scm b/guix/ftp-client.scm index ba3201fdab..dd9135e95a 100644 --- a/guix/ftp-client.scm +++ b/guix/ftp-client.scm @@ -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))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5c6a118560..094d348ac9 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -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)))) |