diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index d649800f98..d194f8cfb7 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -140,7 +140,14 @@ (λ (op) (call/input-url+200 url - (λ (ip) (copy-port ip op)))))) + (λ (ip) (copy-port ip op)) + #:failure + (lambda (reply-s) + (pkg-error (~a "error downloading package\n" + " URL: ~a\n" + " server response: ~a") + (url->string url) + (read-line (open-input-string reply-s)))))))) (cond [(and checksum use-cache?) (cache-file file diff --git a/racket/collects/pkg/util.rkt b/racket/collects/pkg/util.rkt index f96cb61ac0..aba23d796a 100644 --- a/racket/collects/pkg/util.rkt +++ b/racket/collects/pkg/util.rkt @@ -32,15 +32,18 @@ (make-string (+ (- width (string-length col)) 4) #\space)))) (printf "\n"))) -(define (call/input-url+200 u fun #:headers [headers '()]) +(define (call/input-url+200 u fun + #:headers [headers '()] + #:failure [fail-k (lambda (s) #f)]) #;(printf "\t\tReading ~a\n" (url->string u)) (define-values (ip hs) (get-pure-port/headers u headers #:redirections 25 #:status? #t)) - (and (string=? "200" (substring hs 9 12)) - (begin0 - (fun ip) - (close-input-port ip)))) + (if (string=? "200" (substring hs 9 12)) + (begin0 + (fun ip) + (close-input-port ip)) + (fail-k hs))) (define (url-path/no-slash url) (define p (url-path url))