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

better error reports

Browse Source 
svn: r5324
This commit is contained in:
Eli Barzilay 2007-01-12 05:35:22 +00:00
parent 89ce220ed9
commit 4d57d7b6be
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/handin-client/client.ss
View File

@ -13,6 +13,10 @@
(define-struct handin (r w)) (define-struct handin (r w))
;; errors to the user: no need for a "foo: " prefix
(define (error* fmt . args)
(error (apply format fmt args)))
(define (write+flush port . xs) (define (write+flush port . xs)
(for-each (lambda (x) (write x port) (newline port)) xs) (for-each (lambda (x) (write x port) (newline port)) xs)
(flush-output port)) (flush-output port))
@ -23,9 +27,9 @@
(define (wait-for-ok r who . reader) (define (wait-for-ok r who . reader)
(let ([v (if (pair? reader) ((car reader)) (read r))]) (let ([v (if (pair? reader) ((car reader)) (read r))])
(unless (eq? v 'ok) (error 'handin-connect "~a error: ~a" who v)))) (unless (eq? v 'ok) (error* "~a error: ~a" who v))))
;; ssl connection, makes an easier error message if no connection ;; ssl connection, makes a readable error message if no connection
(define (connect-to server port) (define (connect-to server port)
(define pem (in-this-collection "server-cert.pem")) (define pem (in-this-collection "server-cert.pem"))
(define ctx (ssl-make-client-context)) (define ctx (ssl-make-client-context))
@ -67,8 +71,7 @@
(write+flush w 'get-user-fields 'bye) (write+flush w 'get-user-fields 'bye)
(let ([v (read r)]) (let ([v (read r)])
(unless (and (list? v) (andmap string? v)) (unless (and (list? v) (andmap string? v))
(error 'handin-connect (error* "failed to get user-fields list from server"))
"failed to get user-fields list from server"))
(wait-for-ok r "get-user-fields") (wait-for-ok r "get-user-fields")
(close-handin-ports h) (close-handin-ports h)
v))) v)))
@ -78,8 +81,7 @@
(write+flush w 'get-active-assignments) (write+flush w 'get-active-assignments)
(let ([v (read r)]) (let ([v (read r)])
(unless (and (list? v) (andmap string? v)) (unless (and (list? v) (andmap string? v))
(error 'handin-connect (error* "failed to get active-assignment list from server"))
"failed to get active-assignment list from server"))
v))) v)))
(define (submit-assignment h username passwd assignment content (define (submit-assignment h username passwd assignment content
@ -101,8 +103,7 @@
(wait-for-ok r "login") (wait-for-ok r "login")
(write+flush w (bytes-length content)) (write+flush w (bytes-length content))
(let ([v (read r)]) (let ([v (read r)])
(unless (eq? v 'go) (unless (eq? v 'go) (error* "upload error: ~a" v)))
(error 'handin-connect "upload error: ~a" v)))
(display "$" w) (display "$" w)
(display content w) (display content w)
(flush-output w) (flush-output w)
@ -112,8 +113,7 @@
;; we expect a string and a style-list to be used with `message-box' and ;; we expect a string and a style-list to be used with `message-box' and
;; the resulting value written back ;; the resulting value written back
(let ([v (read/message)]) (let ([v (read/message)])
(unless (eq? 'confirm v) (unless (eq? 'confirm v) (error* "submit error: ~a" v)))
(error (format "submit error: ~a" v))))
(on-commit) (on-commit)
(write+flush w 'check) (write+flush w 'check)
(wait-for-ok r "commit" read/message) (wait-for-ok r "commit" read/message)
@ -128,7 +128,7 @@
'get-submission) 'get-submission)
(let ([len (read r)]) (let ([len (read r)])
(unless (and (number? len) (integer? len) (positive? len)) (unless (and (number? len) (integer? len) (positive? len))
(error 'handin-connect "bad response from server: ~a" len)) (error* "bad response from server: ~a" len))
(let ([buf (begin (regexp-match #rx"[$]" r) (read-bytes len r))]) (let ([buf (begin (regexp-match #rx"[$]" r) (read-bytes len r))])
(wait-for-ok r "get-submission") (wait-for-ok r "get-submission")
(close-handin-ports h) (close-handin-ports h)
@ -164,7 +164,7 @@
'get-user-info 'bye) 'get-user-info 'bye)
(let ([v (read r)]) (let ([v (read r)])
(unless (and (list? v) (andmap string? v)) (unless (and (list? v) (andmap string? v))
(error 'handin-connect "failed to get user-info list from server")) (error* "failed to get user-info list from server"))
(wait-for-ok r "get-user-info") (wait-for-ok r "get-user-info")
(close-handin-ports h) (close-handin-ports h)
v))) v)))