remember password in client for 5 minutes

svn: r7501

collects/handin-client/client-gui.ss

@@ -22,7 +22,10 @@
 
   (define handin-name   (#%info-lookup 'name))
   (define web-menu-name (#%info-lookup 'web-menu-name (lambda () #f)))
-  (define web-address   (#%info-lookup 'web-address (lambda () #f)))
+  (define web-address   (#%info-lookup 'web-address   (lambda () #f)))
+
+  (define password-keep-minutes
+    (#%info-lookup 'password-keep-minutes (lambda () #f)))
 
   (define handin-dialog-name (string-append handin-name " Handin"))
   (define button-label/h     (string-append handin-name " Handin"))
@@ -44,6 +47,58 @@
 
   (define (connect) (handin-connect server port-no))
 
+  ;; parameter-like procedure that keeps the password cached for a few minutes
+  (define cached-password
+    (let ([passwd #f]
+          [timer #f])
+      (define protect
+        (let ([s (make-semaphore 1)])
+          (lambda (thunk)
+            (dynamic-wind (lambda () (semaphore-wait s))
+                          thunk
+                          (lambda () (semaphore-post s))))))
+      (case-lambda
+        [() passwd]
+        [(new)
+         (protect (lambda ()
+                    (when (and password-keep-minutes
+                               (not (equal? 0) password-keep-minutes)
+                               (not (equal? passwd new)))
+                      (when timer (kill-thread timer))
+                      (set! passwd new)
+                      (set! timer (thread
+                                   (lambda ()
+                                     (sleep password-keep-minutes)
+                                     (protect (lambda ()
+                                                (set! passwd #f)
+                                                (set! timer #f)))))))))])))
+  ;; a password entry box that uses the one cached above
+  (define cached-passwd%
+    (class text-field%
+      (define cached (cached-password))
+      ;; use this instead of a cached password -- to avoid copy/pastes
+      ;; of a password, and to hide its length
+      (define fake-value "CACHED PASSWD")
+      (define/override (get-value)
+        (or cached (super get-value)))
+      (define/override (on-focus on?)
+        (if on?
+          ;; got focus -- clear out bogus contents, if any
+          (when cached (send this set-value "") (set! cached #f))
+          ;; lost focus -- remember a new password, or restore it
+          (let ([p (super get-value)])
+            (cond [(and p (not (string=? "" p)))
+                   ;; don't behave as if we have a cache: don't clear
+                   ;; the value now, or if we get the focus later
+                   (set! cached #f)
+                   (cached-password p)]
+                  [(cached-password)
+                   => (lambda (p)
+                        (set! cached p)
+                        (send this set-value fake-value))]))))
+      (super-new [init-value (if cached fake-value "")]
+                 [style '(single password)])))
+
   (provide handin-frame%)
   (define handin-frame%
     (class dialog%
@@ -67,12 +122,11 @@
 			    [parent this]
 			    [callback (lambda (t e) (activate-ok))]
 			    [stretchable-width #t]))
-      (define passwd (new text-field%
-			  [label "Password:"]
-			  [parent this]
-			  [callback (lambda (t e) (activate-ok))]
-			  [style '(single password)]
-			  [stretchable-width #t]))
+      (define passwd (new cached-passwd%
+                          [label "Password:"]
+                          [parent this]
+                          [callback (lambda (t e) (activate-ok))]
+                          [stretchable-width #t]))
       (define assignment (new choice%
 			      [label "Assignment:"]
 			      [choices null]
@@ -260,11 +314,15 @@
 	(inner (void) on-close)
 	(do-cancel-button))
 
-      (send ok enable #f)
+      (init-comm)
+
+      (send (cond [(string=? "" (send username get-value)) username]
+                  [(string=? "" (send passwd get-value)) passwd]
+                  [else ok])
+            focus)
+      (send ok enable #f) ; disable after focus possibly sent to it
       (send assignment enable #f)
 
-      (init-comm)
-      (send passwd focus)
       (center)
       (show #t)))
 
@@ -343,7 +401,11 @@
       (send old-username set-value (remembered-user))
 
       (define old-passwd
-        (mk-passwd "Old Password:" old-user-box activate-change))
+        (new cached-passwd%
+             [label "Old Password:"]
+             [parent old-user-box]
+             [callback (lambda (t e) (activate-change))]
+             [stretchable-width #t]))
       (define change-user-fields
         (map (lambda (f)
                (mk-txt (string-append f ":") old-user-box activate-change))
@@ -383,8 +445,10 @@
         (map (lambda (f)
                (mk-txt (string-append f ":") new-user-box activate-new))
              (or user-fields '())))
-      (define add-passwd  (mk-passwd "Password:" new-user-box activate-new))
-      (define add-passwd2 (mk-passwd "Password again:" new-user-box activate-new))
+      (define add-passwd
+        (mk-passwd "Password:" new-user-box activate-new))
+      (define add-passwd2
+        (mk-passwd "Password again:" new-user-box activate-new))
       (define new-button (new button%
                               [label "Add User"] [parent new-user-box]
                               [callback (lambda (b e)

collects/handin-client/info.ss

@@ -34,6 +34,9 @@
   ;(define selection-default ; suffixes to auto-choose (string or string-list)
   ;  '("*.scm;*.ss" "*.scm;*.ss;*.txt"))
 
+  ;; Client configuration
+  ;(define password-keep-minutes 5) ; client remembers entered password 5 mins
+
   (define requires '(("mred") ("openssl")))
 
   )