summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-14 23:51:36 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-14 23:51:36 +0200
commit91fe0e20c7da2b706a1ac0e7b75235b6c1e6ed0a (patch)
tree1579c2b5dc616cdd9f8177722d8b93fbdf2df8c4 /guix
parentb30b13dc3d881d734098599540aa0bb13bcf7e61 (diff)
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.scm72
-rw-r--r--guix/scripts/package.scm16
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))))