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
setup/plt-installer
help/bug-report
racket/file)
racket/file
setup/unpack)
(import [prefix drracket:unit: drracket:unit^]
[prefix drracket:app: drracket:app^]
@ -473,74 +474,86 @@
;; 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)
(with-handlers ([(λ (x) #f)
(λ (exn)
(message-box (string-constant drscheme)
(if (exn? exn)
(format "~a" (exn-message exn))
(format "~s" exn))
#:dialog-mixin frame:focus-table-mixin))])
(define-values (port size)
(let-values ([(port header)
(get-pure-port/headers (string->url s-url)
#:redirections 5)])
(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
(make-object gauge% #f 100 d)
#f)]
[exn #f]
; Semaphores to avoid race conditions:
[wait-to-start (make-semaphore 0)]
[wait-to-break (make-semaphore 0)]
; Thread to perform the download:
[t (thread
(λ ()
(semaphore-wait wait-to-start)
(with-handlers ([exn:fail?
(λ (x)
(set! exn x))]
[exn:break? ; throw away break exceptions
void])
(semaphore-post wait-to-break)
(with-output-to-file tmp-filename
(λ ()
(let loop ([total 0])
(when gauge
(send gauge set-value
(inexact->exact
(floor (* 100 (/ total size))))))
(let ([s (read-string 1024 port)])
(define-values (port size)
(let-values ([(port header)
(get-pure-port/headers (string->url s-url)
#:redirections 5)])
(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
(make-object gauge% #f 100 d)
#f)]
[exn #f]
; Semaphores to avoid race conditions:
[wait-to-start (make-semaphore 0)]
[wait-to-break (make-semaphore 0)]
; Thread to perform the download:
[t (thread
(λ ()
(semaphore-wait wait-to-start)
(with-handlers ([exn:fail?
(λ (x)
(set! exn x))]
[exn:break? ; throw away break exceptions
void])
(semaphore-post wait-to-break)
(with-output-to-file tmp-filename
(λ ()
(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)
(loop (+ total (string-length s))))))))
#:mode 'binary #:exists 'truncate))
(send d show #f)))])
(send d center)
(make-object button% (string-constant &stop)
d
(λ (b e)
(semaphore-wait wait-to-break)
(set! tmp-filename #f)
(send d show #f)
(break-thread t)))
; Let thread run only after the dialog is shown
(queue-callback (λ () (semaphore-post wait-to-start)))
(send d show #t)
(when exn (raise exn))
(parameterize ([error-display-handler drracket:init:original-error-display-handler])
(run-installer tmp-filename
(λ ()
(delete-file tmp-filename)))))))
(display s)
(loop (+ total (string-length s))))))))
#:mode 'binary #:exists 'truncate))
(send d show #f)))])
(send d center)
(make-object button% (string-constant &stop)
d
(λ (b e)
(semaphore-wait wait-to-break)
(set! tmp-filename #f)
(send d show #f)
(break-thread t)))
; Let thread run only after the dialog is shown
(queue-callback (λ () (semaphore-post wait-to-start)))
(send d show #t)
(when exn (raise exn))
(define unpack-err (open-output-string))
(cond
[(with-handlers ((exn:fail? values))
(parameterize ([error-display-handler drracket:init:original-error-display-handler]
[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%
(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-filename "Filename:")
(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 "Install ~a or open for editing?")