diff --git a/examples/passwd-wrapper.scm b/examples/passwd-wrapper.scm index 41326e3..6bd3848 100755 --- a/examples/passwd-wrapper.scm +++ b/examples/passwd-wrapper.scm @@ -2,6 +2,9 @@ exec scsh -lm ../scheme/packages.scm -o threads -o chat-package -o expect-package -o let-opt -e main -s "$0" "$@" !# +;; TODO: +;; make program uninterruptable - catch Ctrl-C + (define (assq/false key alist) (let ((p (assq key alist))) (and p (cdr p)))) @@ -86,59 +89,38 @@ Please choose a password with at least 2 character classes.") ;; TODO: cache the results -(define (solaris-machine?) - (let ((systype (getenv "SYSTYPE"))) - (and systype (string=? systype "sun4x_58")))) - -(define (freebsd-machine?) - (let ((systype (getenv "SYSTYPE"))) - (and systype (string=? systype "i386_fbsd52")))) - -(define (linux-machine?) - (let ((systype (getenv "SYSTYPE"))) - (and systype (string=? systype "i386_linux24")))) - (define (raise-unsupported-machine) (display "I refuse to run on unsupported machines\n" (current-error-port)) (exit 10)) -;; *** interface to yppasswd ***************************************** +(define system-type + (let ((systype (getenv "SYSTYPE"))) + (if (not systype) + (error "Cannot determine system type ($SYSTYPE not set).")) + (cond + ((string=? systype "sun4x_58") 'sun) + ((string=? systype "i386_fbsd52") 'freebsd) + ((string=? systype "i386_linux24") 'linux) + (else (raise-unsupported-machine))))) -(define (yppasswd-program) - "/usr/bin/yppasswd") +;; *** general password interface ************************************ -(define (yppasswd-prompts) - (map cons - '(old-prompt new-prompt retype-prompt wrong-message mismatch-message - success-message) - (cond - ((freebsd-machine?) '("Old Password:" - "New Password:" - "Retype New Password:" - "yppasswd: sorry" - "Mismatch; try again, EOF to quit." - #f)) - ((solaris-machine?) '("Enter existing login password:" - "New Password: " - "Re-enter new Password: " - "yppasswd: Sorry, wrong passwd" - "passwd(SYSTEM): They don't match." - "passwd: password successfully changed")) - ((linux-machine?) '("Please enter old password:" - "Please enter new password:" - "Please retype new password:" - "Sorry." - "Mismatch - password unchanged." - #f ;; TODO?? - ))))) +(define (define-passwd program old-prompt new-prompt retype-prompt wrong-message + mismatch-message success-message) + `((program . ,program) + (old-prompt . ,old-prompt) + (new-prompt . ,new-prompt) + (retype-prompt . ,retype-prompt) + (wrong-message . ,wrong-message) + (mismatch-message . ,mismatch-message) + (success-message . ,success-message))) -(define (verify-yp-password old-pw) - (let ((prompts (yppasswd-prompts))) - (call-with-current-continuation - (lambda (return) - (chat (spawn (,(yppasswd-program)) (= 2 1)) - (chat-abort (rx ,(assq/false 'wrong-message prompts))) +(define (verify-password spec password) + (call-with-current-continuation + (lambda (return) + (chat (spawn (,(assq/false 'program spec)) (= 2 1)) + (chat-abort (rx ,(assq/false 'wrong-message spec))) (chat-monitor (lambda (event value) ;(format (current-error-port) ; "Event: ~a <~a>\n" event value) @@ -146,20 +128,19 @@ Please choose a password with at least 2 character classes.") (case event ((eof timeout abort) (return #f))))) - (look-for (assq/false 'old-prompt prompts)) - (send/cr old-pw) - (look-for (assq/false 'new-prompt prompts)) + (look-for (assq/false 'old-prompt spec)) + (send/cr password) + (look-for (assq/false 'new-prompt spec)) ;; if we are prompted for the new pw, old one was correct - #t))))) + #t)))) -(define (change-yp-password old-pw new-pw) - (let* ((prompts (yppasswd-prompts)) - (success-message (assq/false 'success-message prompts))) +(define (change-password spec old-pw new-pw) + (let ((success-message (assq/false 'success-message spec))) (call-with-current-continuation (lambda (return) - (chat (spawn (,(yppasswd-program)) (= 2 1)) - (chat-abort (rx (| ,(assq/false 'mismatch-message prompts) - ,(assq/false 'wrong-message prompts)))) + (chat (spawn (,(assq/false 'program spec)) (= 2 1)) + (chat-abort (rx (| ,(assq/false 'mismatch-message spec) + ,(assq/false 'wrong-message spec)))) (chat-monitor (lambda (event value) ;(format (current-error-port) ; "Event: ~a <~a>\n" event value) @@ -171,13 +152,12 @@ Please choose a password with at least 2 character classes.") (return #f) (return #t)))))) - (look-for (assq/false 'old-prompt prompts)) + (look-for (assq/false 'old-prompt spec)) (send/cr old-pw) - (look-for (assq/false 'new-prompt prompts)) + (look-for (assq/false 'new-prompt spec)) (send/cr new-pw) - (look-for (assq/false 'retype-prompt prompts)) + (look-for (assq/false 'retype-prompt spec)) (send/cr new-pw) - (display (if success-message "YES\n" "NO\n")) (if success-message ;; if there's gonna be a success-message, wait for it. (begin (look-for success-message) #t) @@ -185,12 +165,46 @@ Please choose a password with at least 2 character classes.") ;; TODO: there is no eof, although program ends (begin (sleep 2000) #t))))))) +;; *** interface to yppasswd ***************************************** + +(define yppasswd + (let ((program "/usr/bin/yppasswd")) + (case system-type + ((freebsd) (define-passwd program + "Old Password:" + "New Password:" + "Retype New Password:" + "yppasswd: sorry" + "Mismatch; try again, EOF to quit." + #f)) + ((solaris) (define-passwd program + "Enter existing login password:" + "New Password: " + "Re-enter new Password: " + "yppasswd: Sorry, wrong passwd" + "passwd(SYSTEM): They don't match." + "passwd: password successfully changed")) + ((linux) (define-passwd program + "Please enter old password:" + "Please enter new password:" + "Please retype new password:" + "Sorry." + "Mismatch - password unchanged." + #f ;; TODO?? + ))))) + +(define (verify-yp-password password) + (verify-password yppasswd password)) + +(define (change-yp-password old-pw new-pw) + (change-password yppasswd old-pw new-pw)) + ;; *** all together ************************************************** (define (verify-old-password pw) (verify-yp-password pw)) -(define (change-password old-pw new-pw) +(define (change-all-passwords old-pw new-pw) (change-yp-password old-pw new-pw)) (define (ask/check-old-password) @@ -217,6 +231,7 @@ Please choose a password with at least 2 character classes.") (display no-match) (newline) (lp #f))) + ;; TODO: there are more restrictions concerning 'too similar'! (let ((pw (read-password new-pw-prompt-1))) (cond ((< (string-length pw) min-password-length) @@ -232,10 +247,8 @@ Please choose a password with at least 2 character classes.") (lp pw)))))))) (define (main args) - (if (not (or (solaris-machine?) (freebsd-machine?))) - (raise-unsupported-machine)) (let ((old-pw (ask/check-old-password)) (new-pw (ask-new-password))) - (if (change-password old-pw new-pw) + (if (change-all-passwords old-pw new-pw) (display "Password changed.\n") (display "Password could not be changed.\n"))))