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

Adjust the web download phase of the install .plt file

Browse Source 
menu item in drracket so that it first checks to see if
the downloaded file matches a .plt archive and, if not,
try to put some friendlier message in front of the gzip error

closes PR 9425
closes PR 13129
This commit is contained in:
Robby Findler 2012-09-24 14:06:31 -05:00
parent 008d1f7f1b
commit ec6408b343
2 changed files with 82 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
collects/drracket/private/frame.rkt
View File

@ -10,7 +10,8 @@
net/head net/head
setup/plt-installer setup/plt-installer
help/bug-report help/bug-report
racket/file) racket/file
setup/unpack)
(import [prefix drracket:unit: drracket:unit^] (import [prefix drracket:unit: drracket:unit^]
[prefix drracket:app: drracket:app^] [prefix drracket:app: drracket:app^]
@ -473,74 +474,86 @@
;; install-plt-from-url : string (union #f dialog%) -> void ;; install-plt-from-url : string (union #f dialog%) -> void
;; downloads and installs a .plt file from the given url ;; downloads and installs a .plt file from the given url
(define (install-plt-from-url s-url parent) (define (install-plt-from-url s-url parent)
(with-handlers ([(λ (x) #f) (define-values (port size)
(λ (exn) (let-values ([(port header)
(message-box (string-constant drscheme) (get-pure-port/headers (string->url s-url)
(if (exn? exn) #:redirections 5)])
(format "~a" (exn-message exn)) (define size
(format "~s" exn)) (let* ([content-header (extract-field "content-length" header)]
#:dialog-mixin frame:focus-table-mixin))]) [m (and content-header
(define-values (port size) (regexp-match "[0-9]+" content-header))])
(let-values ([(port header) (and m (string->number (car m)))))
(get-pure-port/headers (string->url s-url) (values port size)))
#:redirections 5)]) (let* ([tmp-filename (make-temporary-file "tmp~a.plt")]
(define size [header (purify-port port)]
(let* ([content-header (extract-field "content-length" header)] [d (make-object dialog% (string-constant downloading) parent)]
[m (and content-header [message (make-object message% (string-constant downloading-file...) d)]
(regexp-match "[0-9]+" content-header))]) [gauge (if size
(and m (string->number (car m))))) (make-object gauge% #f 100 d)
(values port size))) #f)]
(let* ([tmp-filename (make-temporary-file "tmp~a.plt")] [exn #f]
[header (purify-port port)] ; Semaphores to avoid race conditions:
[d (make-object dialog% (string-constant downloading) parent)] [wait-to-start (make-semaphore 0)]
[message (make-object message% (string-constant downloading-file...) d)] [wait-to-break (make-semaphore 0)]
[gauge (if size ; Thread to perform the download:
(make-object gauge% #f 100 d) [t (thread
#f)] (λ ()
[exn #f] (semaphore-wait wait-to-start)
; Semaphores to avoid race conditions: (with-handlers ([exn:fail?
[wait-to-start (make-semaphore 0)] (λ (x)
[wait-to-break (make-semaphore 0)] (set! exn x))]
; Thread to perform the download: [exn:break? ; throw away break exceptions
[t (thread void])
(λ () (semaphore-post wait-to-break)
(semaphore-wait wait-to-start) (with-output-to-file tmp-filename
(with-handlers ([exn:fail? (λ ()
(λ (x) (let loop ([total 0])
(set! exn x))] (when gauge
[exn:break? ; throw away break exceptions (send gauge set-value
void]) (inexact->exact
(semaphore-post wait-to-break) (floor (* 100 (/ total size))))))
(with-output-to-file tmp-filename (let ([s (read-string 1024 port)])
(λ () (unless (eof-object? s)
(let loop ([total 0])
(when gauge
(send gauge set-value
(inexact->exact
(floor (* 100 (/ total size))))))
(let ([s (read-string 1024 port)])
(unless (eof-object? s) (unless (eof-object? s)
(unless (eof-object? s) (display s)
(display s) (loop (+ total (string-length s))))))))
(loop (+ total (string-length s)))))))) #:mode 'binary #:exists 'truncate))
#:mode 'binary #:exists 'truncate)) (send d show #f)))])
(send d show #f)))]) (send d center)
(send d center) (make-object button% (string-constant &stop)
(make-object button% (string-constant &stop) d
d (λ (b e)
(λ (b e) (semaphore-wait wait-to-break)
(semaphore-wait wait-to-break) (set! tmp-filename #f)
(set! tmp-filename #f) (send d show #f)
(send d show #f) (break-thread t)))
(break-thread t))) ; Let thread run only after the dialog is shown
; Let thread run only after the dialog is shown (queue-callback (λ () (semaphore-post wait-to-start)))
(queue-callback (λ () (semaphore-post wait-to-start))) (send d show #t)
(send d show #t) (when exn (raise exn))
(when exn (raise exn)) (define unpack-err (open-output-string))
(parameterize ([error-display-handler drracket:init:original-error-display-handler]) (cond
(run-installer tmp-filename [(with-handlers ((exn:fail? values))
(λ () (parameterize ([error-display-handler drracket:init:original-error-display-handler]
(delete-file tmp-filename))))))) [current-error-port unpack-err])
(fold-plt-archive tmp-filename void void void void void))
#f)
=>
(λ (exn)
(delete-file tmp-filename)
(message-box (string-constant drscheme)
(string-append
(string-constant install-plt-error-header)
"\n\n"
(exn-message exn)
"\n\n"
(get-output-string unpack-err))
#:dialog-mixin frame:focus-table-mixin))]
[else
(parameterize ([error-display-handler drracket:init:original-error-display-handler])
(run-installer tmp-filename
(λ ()
(delete-file tmp-filename))))])))
(define keybindings-frame% (define keybindings-frame%
(class frame% (class frame%

1
collects/string-constants/private/english-string-constants.rkt
View File

@ -440,6 +440,7 @@ please adhere to these guidelines:
(install-plt-file-tab "File") (install-plt-file-tab "File")
(install-plt-filename "Filename:") (install-plt-filename "Filename:")
(install-plt-url "URL:") (install-plt-url "URL:")
(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 ;; install plt file when opened in drscheme strings
(install-plt-file "Install ~a or open for editing?") (install-plt-file "Install ~a or open for editing?")