rekahsoft
/
guix
1
1
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
;; 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)))
(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))))
(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))))
(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)))
(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)))

16
guix/scripts/package.scm
View File

@ -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))))