substitute-binary: Gracefully handle HTTP GET errors.

* guix/http-client.scm (&http-get-error): New condition type.
  (http-fetch): Raise it instead of using 'error'.
* guix/scripts/substitute-binary.scm (fetch) <http>: Wrap body into
  'guard' form; gracefully handle 'http-get-error?' conditions.
This commit is contained in:
Ludovic Courtès 2014-03-01 15:38:11 +01:00
parent 1f7fd80032
commit 706e9e575d
2 changed files with 61 additions and 32 deletions

View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012 Free Software Foundation, Inc. ;;; Copyright © 2012 Free Software Foundation, Inc.
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -23,19 +23,36 @@
#:use-module (web client) #:use-module (web client)
#:use-module (web response) #:use-module (web response)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:export (open-socket-for-uri #:export (&http-get-error
http-get-error?
http-get-error-uri
http-get-error-code
http-get-error-reason
open-socket-for-uri
http-fetch)) http-fetch))
;;; Commentary: ;;; Commentary:
;;; ;;;
;;; HTTP client portable among Guile versions. ;;; HTTP client portable among Guile versions, and with proper error condition
;;; reporting.
;;; ;;;
;;; Code: ;;; Code:
;; HTTP GET error.
(define-condition-type &http-get-error &error
http-get-error?
(uri http-get-error-uri) ; URI
(code http-get-error-code) ; integer
(reason http-get-error-reason)) ; string
(define-syntax when-guile<=2.0.5 (define-syntax when-guile<=2.0.5
(lambda (s) (lambda (s)
(syntax-case s () (syntax-case s ()
@ -154,7 +171,9 @@ unbuffered."
"Return an input port containing the data at URI, and the expected number of "Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be bytes available or #f. If TEXT? is true, the data at URI is considered to be
textual. Follow any HTTP redirection. When BUFFERED? is #f, return an textual. Follow any HTTP redirection. When BUFFERED? is #f, return an
unbuffered port, suitable for use in `filtered-port'." unbuffered port, suitable for use in `filtered-port'.
Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri uri)) (let loop ((uri uri))
(let ((port (or port (let ((port (or port
(open-socket-for-uri uri (open-socket-for-uri uri
@ -202,7 +221,11 @@ unbuffered port, suitable for use in `filtered-port'."
(uri->string uri)) (uri->string uri))
(loop uri))) (loop uri)))
(else (else
(error "download failed" uri code (raise (condition (&http-get-error
(response-reason-phrase resp)))))))) (uri uri)
(code code)
(reason (response-reason-phrase resp)))
(&message
(message "download failed"))))))))))
;;; http-client.scm ends here ;;; http-client.scm ends here

View File

@ -38,6 +38,7 @@
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (web uri) #:use-module (web uri)
#:use-module (guix http-client) #:use-module (guix http-client)
#:export (guix-substitute-binary)) #:export (guix-substitute-binary))
@ -133,6 +134,11 @@ provide."
(if buffered? "rb" "r0b")))) (if buffered? "rb" "r0b"))))
(values port (stat:size (stat port))))) (values port (stat:size (stat port)))))
((http) ((http)
(guard (c ((http-get-error? c)
(leave (_ "download from '~a' failed: ~a, ~s~%")
(uri->string (http-get-error-uri c))
(http-get-error-code c)
(http-get-error-reason c))))
;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So ;; On Guile 2.0.5, `http-fetch' fetches the whole thing at once. So
;; honor TIMEOUT? to disable the timeout when fetching a nar. ;; honor TIMEOUT? to disable the timeout when fetching a nar.
;; ;;
@ -159,7 +165,7 @@ provide."
(begin (begin
(when (or (not port) (port-closed? port)) (when (or (not port) (port-closed? port))
(set! port (open-socket-for-uri uri #:buffered? buffered?))) (set! port (open-socket-for-uri uri #:buffered? buffered?)))
(http-fetch uri #:text? #f #:port port))))))) (http-fetch uri #:text? #f #:port port))))))))
(define-record-type <cache> (define-record-type <cache>
(%make-cache url store-directory wants-mass-query?) (%make-cache url store-directory wants-mass-query?)