From 697043dbc187329ba1fc19b4b2cef0d864fd60a0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 16 Aug 2005 20:17:55 +0000 Subject: [PATCH] handin server/client fixup svn: r601 --- collects/handin-client/client.ss | 11 +++++-- collects/handin-client/info.ss | 8 ++--- collects/handin-client/server-cert.pem | 39 +++++++++++----------- collects/handin-client/tool.ss | 2 +- collects/handin-server/handin-server.ss | 43 +++++++++++++++---------- collects/handin-server/private-key.pem | 26 +++++++-------- 6 files changed, 70 insertions(+), 59 deletions(-) diff --git a/collects/handin-client/client.ss b/collects/handin-client/client.ss index 0589680a43..7f17ec8e31 100644 --- a/collects/handin-client/client.ss +++ b/collects/handin-client/client.ss @@ -15,11 +15,12 @@ (ssl-load-verify-root-certificates! ctx pem) (let-values ([(r w) (ssl-connect server port ctx)]) ;; Sanity check: server sends "handin", first: - (let ([s (read-string 6 r)]) - (unless (equal? "handin" s) + (let ([s (read-bytes 6 r)]) + (unless (equal? #"handin" s) (error 'handin-connect "bad handshake from server: ~e" s))) ;; Tell server protocol = 'original: (fprintf w "original\n") + (flush-output w) ;; One more sanity check: server recognizes protocol: (let ([s (read r)]) (unless (eq? s 'original) @@ -36,20 +37,24 @@ (let ([r (handin-r h)] [w (handin-w h)]) (fprintf w "~s ~s ~s\n" username passwd assignment) + (flush-output w) (let ([v (read r)]) (unless (eq? v 'ok) (error 'handin-connect "login error: ~a" v))) - (fprintf w "~s\n" (string-length content)) + (fprintf w "~s\n" (bytes-length content)) + (flush-output w) (let ([v (read r)]) (unless (eq? v 'go) (error 'handin-connect "upload error: ~a" v))) (fprintf w "$") (display content w) + (flush-output w) (let ([v (read r)]) (unless (eq? v 'confirm) (error 'handin-connect "submit error: ~a" v))) (on-commit) (fprintf w "check\n") + (flush-output w) (let ([v (read r)]) (unless (eq? v 'done) (error 'handin-connect "commit probably unsucccesful: ~e" v))) diff --git a/collects/handin-client/info.ss b/collects/handin-client/info.ss index d8abb68c31..9c2afa2871 100644 --- a/collects/handin-client/info.ss +++ b/collects/handin-client/info.ss @@ -3,7 +3,7 @@ ;; Also replace the "icon.png" and "server-cert.pem" files. (define name "Course Handin") (define collection "handin-client") - ;; (define server:port "localhost:7979") + ;(define server:port "localhost:7979") ;; --> server:port should be defined here, if it is not defined, not tool ;; will appear. To try things, you can set the PLT_HANDIN_SERVER_PORT ;; environment variable when this is undefined. @@ -15,7 +15,7 @@ ;(define web-menu-name "Course Homepage") ;(define web-address "http://www.university.edu/course/") - #;(define tool-icons (list (list "icon.png" collection))) - #;(define tools '(("tool.ss"))) - #;(define tool-names (list name)) + (define tool-icons (list (list "icon.png" collection))) + (define tools '(("tool.ss"))) + (define tool-names (list name)) (define requires '(("mred") ("openssl")))) diff --git a/collects/handin-client/server-cert.pem b/collects/handin-client/server-cert.pem index bb1cb31e7d..1b92152d5c 100644 --- a/collects/handin-client/server-cert.pem +++ b/collects/handin-client/server-cert.pem @@ -1,23 +1,20 @@ -----BEGIN CERTIFICATE----- -MIIDwDCCAymgAwIBAgIBADANBgkqhkiG9w0BAQQFADCBojELMAkGA1UEBhMCVVMx -DTALBgNVBAgTBFV0YWgxFzAVBgNVBAcTDlNhbHQgTGFrZSBDaXR5MRkwFwYDVQQK -ExBQTFQgU2NoZW1lLCBJbmMuMQ0wCwYDVQQLEwREZW1vMRswGQYDVQQDExJ3d3cu -cGx0LXNjaGVtZS5vcmcxJDAiBgkqhkiG9w0BCQEWFXNjaGVtZUBwbHQtc2NoZW1l -Lm9yZzAeFw0wMzA3MjIxNTA0MTdaFw0wNDA3MjExNTA0MTdaMIGiMQswCQYDVQQG -EwJVUzENMAsGA1UECBMEVXRhaDEXMBUGA1UEBxMOU2FsdCBMYWtlIENpdHkxGTAX -BgNVBAoTEFBMVCBTY2hlbWUsIEluYy4xDTALBgNVBAsTBERlbW8xGzAZBgNVBAMT -End3dy5wbHQtc2NoZW1lLm9yZzEkMCIGCSqGSIb3DQEJARYVc2NoZW1lQHBsdC1z -Y2hlbWUub3JnMIGfMA0GCSqGSIb3DQEBAQUAA4GNADCBiQKBgQC4/XjGBcwJU/jD -4cZRe8LcjrJaWh9F8Nh0j97nGv2JgeLYCJp6oClWBvWLfAs/YBDIMogsN48jjA6n -QExslJ6Dk+oriK92EPLlIuiqrHcTif9lHu2H0BarIme4COTVVPmfETXTrDBNxp/D -93kzGvXsbxdnO2lSsU3u6hZoj1ZEGwIDAQABo4IBAjCB/zAdBgNVHQ4EFgQU0X7d -ycn57T16KLOXUwMM35kdhKEwgc8GA1UdIwSBxzCBxIAU0X7dycn57T16KLOXUwMM -35kdhKGhgaikgaUwgaIxCzAJBgNVBAYTAlVTMQ0wCwYDVQQIEwRVdGFoMRcwFQYD -VQQHEw5TYWx0IExha2UgQ2l0eTEZMBcGA1UEChMQUExUIFNjaGVtZSwgSW5jLjEN -MAsGA1UECxMERGVtbzEbMBkGA1UEAxMSd3d3LnBsdC1zY2hlbWUub3JnMSQwIgYJ -KoZIhvcNAQkBFhVzY2hlbWVAcGx0LXNjaGVtZS5vcmeCAQAwDAYDVR0TBAUwAwEB -/zANBgkqhkiG9w0BAQQFAAOBgQAJEtqvFtCPszpdUg273+hMC0NMSIINToTqv8+T -Knl3yfTJtzdcvFBuTRaYVzPz4YyREx8Y46e5dKSk5Qr2dNogn00yOn6nzzumbkqN -hu9gFV5/J9fJtvaQV/hF4ynhpD0M5TSCILdMJIc1Ls70xEtVFHPT51iZev3zDUuN -4Xintg== +MIIDQjCCAqugAwIBAgIBADANBgkqhkiG9w0BAQQFADB6MQswCQYDVQQGEwJVUzEN +MAsGA1UECBMEVXRhaDEMMAoGA1UEBxMDU0xDMRgwFgYDVQQKEw9QTFQgU2NoZW1l +IEluYy4xDDAKBgNVBAMTA1BMVDEmMCQGCSqGSIb3DQEJARYXcGx0QHBsc2NoZW1l +LXNjaGVtZS5vcmcwHhcNMDUwODE2MTk0ODAzWhcNMTUwODE0MTk0ODAzWjB6MQsw +CQYDVQQGEwJVUzENMAsGA1UECBMEVXRhaDEMMAoGA1UEBxMDU0xDMRgwFgYDVQQK +Ew9QTFQgU2NoZW1lIEluYy4xDDAKBgNVBAMTA1BMVDEmMCQGCSqGSIb3DQEJARYX +cGx0QHBsc2NoZW1lLXNjaGVtZS5vcmcwgZ8wDQYJKoZIhvcNAQEBBQADgY0AMIGJ +AoGBAMdLMny/wvHYNxyQZAjI8wwyRzRQalJLgbelm2FU3Iwo2rm+QIw/GEhjXAZP +cNT7jQINFX9tWDrcONJJQw6fkGBsawcLdEiojEgRYem8cdq7yLSHR84+qqFDUb3v +QvP9oHpsObUqxKCTaeAH8B0818IQfPd/oAHaGHMBB0/csp5vAgMBAAGjgdcwgdQw +HQYDVR0OBBYEFMuCBFBMnAfhGRTn5gEODVz0+LVpMIGkBgNVHSMEgZwwgZmAFMuC +BFBMnAfhGRTn5gEODVz0+LVpoX6kfDB6MQswCQYDVQQGEwJVUzENMAsGA1UECBME +VXRhaDEMMAoGA1UEBxMDU0xDMRgwFgYDVQQKEw9QTFQgU2NoZW1lIEluYy4xDDAK +BgNVBAMTA1BMVDEmMCQGCSqGSIb3DQEJARYXcGx0QHBsc2NoZW1lLXNjaGVtZS5v +cmeCAQAwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQQFAAOBgQAhywbndr1xp2Gy +jrTiDToZzQCnmhoqJpxb2e71zM3jpQLfdOAF86W196HoIRlwBaKQKzS1rL3ezjqu +JALq992K/Bi68LWaA7dekB2EiagNfvtR9vIjBD7Q4Qtp0yjpRV9uLTEfYRff6ecm +rSywn1Wmca+PBdVY79TbaeEsgCxt6Q== -----END CERTIFICATE----- diff --git a/collects/handin-client/tool.ss b/collects/handin-client/tool.ss index 58a0c7ea85..e3044c6eb3 100644 --- a/collects/handin-client/tool.ss +++ b/collects/handin-client/tool.ss @@ -466,7 +466,7 @@ (send ed write-to-file stream)) editors) (write-editor-global-footer stream) - (send base get-string))) + (send base get-bytes))) (add-test-suite-extension "Handin" diff --git a/collects/handin-server/handin-server.ss b/collects/handin-server/handin-server.ss index bac3aa75ea..3c5db3c867 100644 --- a/collects/handin-server/handin-server.ss +++ b/collects/handin-server/handin-server.ss @@ -23,7 +23,8 @@ (parameterize ([date-display-format 'iso-8601]) (date->string (seconds->date (current-seconds)) #t)) (apply format str args))]) - (display line log-port))) + (display line log-port) + (flush-output log-port))) (define (get-config which default) (get-preference which @@ -65,20 +66,21 @@ (define backup-dir-re (regexp (format "^~a[0-9]+$" backup-prefix))) (define (backup n) (format "~a~a" backup-prefix n)) (define (files+backups) - (let* ([files (directory-list)] + (let* ([files (map path->string (directory-list))] [backups (filter (lambda (f) - (and (directory-exists? f) - (regexp-match backup-dir-re f))) - files)]) + (and (directory-exists? f) + (regexp-match backup-dir-re f))) + files)]) (values (remove* backups files) backups))) (define (do-backups) (let-values ([(files backups) (files+backups)]) (define (make-backup-available n) (when (member (backup n) backups) (if (< n MAX-UPLOAD-KEEP) - (begin (make-backup-available (add1 n)) - (rename-file-or-directory (backup n) (backup (add1 n)))) - (delete-directory/files (backup n))))) + (begin + (make-backup-available (add1 n)) + (rename-file-or-directory (backup n) (backup (add1 n)))) + (delete-directory/files (backup n))))) (unless (null? files) (LOG "backing up ~a" files) (make-backup-available 0) @@ -117,14 +119,15 @@ "max handin file size is ~s bytes, file to handin is too big (~s bytes)" MAX-UPLOAD len)) (fprintf w "go\n") + (flush-output w) (unless (regexp-match #rx"[$]" r-safe) (error 'handin "did not find start-of-content marker")) - (let ([s (read-string len r)]) - (unless (and (string? s) (= (string-length s) len)) + (let ([s (read-bytes len r)]) + (unless (and (bytes? s) (= (bytes-length s) len)) (error 'handin - "error uploading (got ~s, expected ~s bytes)" - (if (string? s) (string-length s) s) + "error uploading (got ~e, expected ~s bytes)" + (if (bytes? s) (bytes-length s) s) len)) (do-backups) (LOG "checking ~a for ~a" assignment user) @@ -136,12 +139,14 @@ user s) DEFAULT-FILE-NAME))]) (fprintf w "confirm\n") + (flush-output w) (let ([v (read (make-limited-input-port r 50))]) (if (eq? v 'check) (begin (LOG "saving ~a for ~a" assignment user) (save-submission s part) - (fprintf w "done\n")) + (fprintf w "done\n") + (flush-output w)) (error 'handin "upload not confirmed: ~s" v)))))))))) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -234,7 +239,7 @@ (error 'handin "bad username or password for ~a" username)])))) (define assignment-list - (quicksort (directory-list "active") stringstring (directory-list "active")) string