raco pkg: improve error for failed package-source download

Related to PR 14441
This commit is contained in:
Matthew Flatt 2014-04-10 05:26:06 -06:00
parent fe2c796c41
commit 206466708f
2 changed files with 16 additions and 6 deletions

View File

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

View File

@ -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))
(if (string=? "200" (substring hs 9 12))
(begin0
(fun ip)
(close-input-port ip))))
(close-input-port ip))
(fail-k hs)))
(define (url-path/no-slash url)
(define p (url-path url))