catch networking errors and show a dialog

that doesn't say "internal error"

closes PR 14254
This commit is contained in:
Robby Findler 2013-12-15 21:18:20 -06:00
parent ef6af9c47c
commit 4a7c36e96e
2 changed files with 95 additions and 81 deletions

View File

@ -536,29 +536,31 @@
;; install-plt-from-url : string (union #f dialog%) -> void
;; downloads and installs a .plt file from the given url
(define (install-plt-from-url s-url parent)
(define-values (port size)
(let-values ([(port header)
(get-pure-port/headers (string->url s-url)
#:redirections 5)])
(define url (string->url s-url))
(define-values (port header)
(with-handlers ([exn:fail? (λ (x) (values #f x))])
(get-pure-port/headers url #:redirections 5)))
(cond
[port
(define size
(let* ([content-header (extract-field "content-length" header)]
[m (and content-header
(regexp-match "[0-9]+" content-header))])
(and m (string->number (car m)))))
(values port size)))
(let* ([tmp-filename (make-temporary-file "tmp~a.plt")]
[header (purify-port port)]
[d (make-object dialog% (string-constant downloading) parent)]
[message (make-object message% (string-constant downloading-file...) d)]
[gauge (if size
(define tmp-filename (make-temporary-file "tmp~a.plt"))
(define header (purify-port port))
(define d (make-object dialog% (string-constant downloading) parent))
(define message (make-object message% (string-constant downloading-file...) d))
(define gauge (if size
(make-object gauge% #f 100 d)
#f)]
[exn #f]
#f))
(define exn #f)
; Semaphores to avoid race conditions:
[wait-to-start (make-semaphore 0)]
[wait-to-break (make-semaphore 0)]
(define wait-to-start (make-semaphore 0))
(define wait-to-break (make-semaphore 0))
; Thread to perform the download:
[t (thread
(define t
(thread
(λ ()
(semaphore-wait wait-to-start)
(with-handlers ([exn:fail?
@ -580,7 +582,7 @@
(display s)
(loop (+ total (string-length s))))))))
#:mode 'binary #:exists 'truncate))
(send d show #f)))])
(send d show #f))))
(send d center)
(make-object button% (string-constant &stop)
d
@ -615,7 +617,16 @@
(parameterize ([error-display-handler drracket:init:original-error-display-handler])
(run-installer tmp-filename
(λ ()
(delete-file tmp-filename))))])))
(delete-file tmp-filename))))])]
[else
(define exn header)
(define sp (open-output-string))
(parameterize ([current-error-port sp])
(drracket:init:original-error-display-handler (exn-message exn) exn))
(message-box (string-constant drracket)
(string-append
(string-constant install-plt-error-downloading)
(get-output-string sp)))]))
(define keybindings-frame%
(class frame%

View File

@ -462,6 +462,9 @@ please adhere to these guidelines:
(install-plt-file-tab "File")
(install-plt-filename "Filename:")
(install-plt-url "URL:")
; an error message from a primitive operation is appended to the end of this message.
(install-plt-error-downloading "There was an error when downloading the"
" .plt file.\n\nDetails:\n")
(install-plt-error-header "There was an error when checking the validity of the downloaded .plt file. Please check the url and try again.")
;; install plt file when opened in drscheme strings