suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco pkg: improve error for failed package-source download

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
racket/collects/pkg/lib.rkt
View File

@ -140,7 +140,14 @@
(λ (op) (λ (op)
(call/input-url+200 (call/input-url+200
url 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 (cond
[(and checksum use-cache?) [(and checksum use-cache?)
(cache-file file (cache-file file

13
racket/collects/pkg/util.rkt
View File

@ -32,15 +32,18 @@
(make-string (+ (- width (string-length col)) 4) #\space)))) (make-string (+ (- width (string-length col)) 4) #\space))))
(printf "\n"))) (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)) #;(printf "\t\tReading ~a\n" (url->string u))
(define-values (ip hs) (get-pure-port/headers u headers (define-values (ip hs) (get-pure-port/headers u headers
#:redirections 25 #:redirections 25
#:status? #t)) #:status? #t))
(and (string=? "200" (substring hs 9 12)) (if (string=? "200" (substring hs 9 12))
(begin0 (begin0
(fun ip) (fun ip)
(close-input-port ip)))) (close-input-port ip))
(fail-k hs)))
(define (url-path/no-slash url) (define (url-path/no-slash url)
(define p (url-path url)) (define p (url-path url))