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

Use `post-impure-port' to submit the bugreport, and check the resulting

Browse Source 
HTTP status for an error code.

If there was an error, then render the HTML like other errors, so the
user can now hit back and try to fix things.
This commit is contained in:
Eli Barzilay 2011-06-01 16:41:43 -04:00
parent c82d8cea32
commit 18d40dca3c
1 changed files with 28 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/help/bug-report.rkt
View File

@ -207,24 +207,43 @@
(parameterize ([current-alist-separator-mode 'amp]) (parameterize ([current-alist-separator-mode 'amp])
(call/input-url (call/input-url
bug-report-url bug-report-url
(lambda (x) (post-pure-port x post-data)) (lambda (x) (post-impure-port x post-data))
(lambda (port) (lambda (port)
(define response-text (new html-text%)) (define error?
(render-html-to-text port response-text #t #f) (cond [(regexp-match #rx"^HTTP/[0-9.]+ +([0-9]+) *(.*)$"
(send response-text auto-wrap #t) (read-line port 'any))
(send response-text lock #t) => (lambda (m)
(channel-put response-chan response-text))))))))) ;; ignore the status text -- the reply should
;; have a better indication of what went wrong
((string->number (cadr m)) . >= . 400))]
[else #f]))
;; skip HTTP headers
(regexp-match-positions #rx"\r?\n\r?\n" port)
(if error?
;; error status => show as error
(begin (with-pending-text
(λ ()
(send pending-text erase)
(render-html-to-text port pending-text #t #f)))
(channel-put exn-chan #f)) ; #f = "already rendered"
;; (hopefully) a good result
(let ([response-text (new html-text%)])
(render-html-to-text port response-text #t #f)
(send response-text auto-wrap #t)
(send response-text lock #t)
(channel-put response-chan response-text)))))))))))
(define (render-error to-render) (define (render-error to-render)
(cond (cond
[(string? to-render) [(string? to-render)
(let ([str (string-append "<pre>\n\nERROR:\n"to-render"\n</pre>\n")]) (let ([str (string-append "<pre>\n\nERROR:\n"to-render"\n</pre>\n")])
(render-error (open-input-string str)))] (render-error (open-input-string str)))]
[(exn? to-render) (render-error (exn-message to-render))] [(exn? to-render) (render-error (exn-message to-render))]
[(input-port? to-render) [(or (input-port? to-render) (not to-render))
(queue-callback (queue-callback
(λ () (λ ()
(with-pending-text (when to-render
(λ () (render-html-to-text to-render pending-text #t #f))) (with-pending-text
(λ () (render-html-to-text to-render pending-text #t #f))))
(send pending-back enable #t) (send pending-back enable #t)
(send pending-abort enable #f)))] (send pending-abort enable #f)))]
[else (error 'render-error "internal error")])) [else (error 'render-error "internal error")]))