nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2013-05-14 23:51:36 +02:00
parent b30b13dc3d
commit 91fe0e20c7
2 changed files with 39 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
guix/ftp-client.scm
View File

@ -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 ;; Use 21 as the default PORT instead of "ftp", to avoid depending on
;; libc's NSS, which is not available during bootstrap. ;; libc's NSS, which is not available during bootstrap.
(catch 'getaddrinfo-error (define addresses
(lambda () (getaddrinfo host
(define addresses (if (number? port) (number->string port) port)
(getaddrinfo host (if (number? port) AI_NUMERICSERV 0)))
(if (number? port) (number->string port) port)
(if (number? port) AI_NUMERICSERV 0)))
(let loop ((addresses addresses)) (let loop ((addresses addresses))
(let* ((ai (car addresses)) (let* ((ai (car addresses))
(s (socket (addrinfo:fam ai) (addrinfo:socktype ai) (s (socket (addrinfo:fam ai) (addrinfo:socktype ai)
(addrinfo:protocol ai)))) (addrinfo:protocol ai))))
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect s (addrinfo:addr ai)) (connect s (addrinfo:addr ai))
(setvbuf s _IOLBF) (setvbuf s _IOLBF)
(let-values (((code message) (%ftp-listen s))) (let-values (((code message) (%ftp-listen s)))
(if (eqv? code 220) (if (eqv? code 220)
(begin (begin
;;(%ftp-command "OPTS UTF8 ON" 200 s) ;;(%ftp-command "OPTS UTF8 ON" 200 s)
(%ftp-login "anonymous" "guix@example.com" s) (%ftp-login "anonymous" "guix@example.com" s)
(%make-ftp-connection s ai)) (%make-ftp-connection s ai))
(begin (begin
(format (current-error-port) (format (current-error-port)
"FTP to `~a' failed: ~A: ~A~%" "FTP to `~a' failed: ~A: ~A~%"
host code message) host code message)
(close s) (close s)
#f)))) #f))))
(lambda args (lambda args
;; Connection failed, so try one of the other addresses. ;; Connection failed, so try one of the other addresses.
(close s) (close s)
(if (null? addresses) (if (null? addresses)
(apply throw args) (apply throw args)
(loop (cdr addresses)))))))) (loop (cdr addresses))))))))
(lambda (key errcode)
(format (current-error-port) "failed to resolve `~a': ~a~%"
host (gai-strerror errcode))
#f)))
(define (ftp-close conn) (define (ftp-close conn)
(close (ftp-connection-socket conn))) (close (ftp-connection-socket conn)))

16
guix/scripts/package.scm
View File

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