scsh-conservatory
/
scsh-expect
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- abstracted chat over passwd-program, to reuse code for the other programs

This commit is contained in:
frese 2004-07-17 14:42:20 +00:00
parent 72deaa76de
commit a69eb8275d
1 changed files with 76 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

139
examples/passwd-wrapper.scm
View File

@ -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" "$@" 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) (define (assq/false key alist)
(let ((p (assq key alist))) (let ((p (assq key alist)))
(and p (cdr p)))) (and p (cdr p))))
@ -86,59 +89,38 @@ Please choose a password with at least 2 character classes.")
;; TODO: cache the results ;; 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) (define (raise-unsupported-machine)
(display "I refuse to run on unsupported machines\n" (display "I refuse to run on unsupported machines\n"
(current-error-port)) (current-error-port))
(exit 10)) (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) ;; *** general password interface ************************************
"/usr/bin/yppasswd")
(define (yppasswd-prompts) (define (define-passwd program old-prompt new-prompt retype-prompt wrong-message
(map cons mismatch-message success-message)
'(old-prompt new-prompt retype-prompt wrong-message mismatch-message `((program . ,program)
success-message) (old-prompt . ,old-prompt)
(cond (new-prompt . ,new-prompt)
((freebsd-machine?) '("Old Password:" (retype-prompt . ,retype-prompt)
"New Password:" (wrong-message . ,wrong-message)
"Retype New Password:" (mismatch-message . ,mismatch-message)
"yppasswd: sorry" (success-message . ,success-message)))
"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 (verify-yp-password old-pw) (define (verify-password spec password)
(let ((prompts (yppasswd-prompts))) (call-with-current-continuation
(call-with-current-continuation (lambda (return)
(lambda (return) (chat (spawn (,(assq/false 'program spec)) (= 2 1))
(chat (spawn (,(yppasswd-program)) (= 2 1)) (chat-abort (rx ,(assq/false 'wrong-message spec)))
(chat-abort (rx ,(assq/false 'wrong-message prompts)))
(chat-monitor (lambda (event value) (chat-monitor (lambda (event value)
;(format (current-error-port) ;(format (current-error-port)
; "Event: ~a <~a>\n" event value) ; "Event: ~a <~a>\n" event value)
@ -146,20 +128,19 @@ Please choose a password with at least 2 character classes.")
(case event (case event
((eof timeout abort) (return #f))))) ((eof timeout abort) (return #f)))))
(look-for (assq/false 'old-prompt prompts)) (look-for (assq/false 'old-prompt spec))
(send/cr old-pw) (send/cr password)
(look-for (assq/false 'new-prompt prompts)) (look-for (assq/false 'new-prompt spec))
;; if we are prompted for the new pw, old one was correct ;; if we are prompted for the new pw, old one was correct
#t))))) #t))))
(define (change-yp-password old-pw new-pw) (define (change-password spec old-pw new-pw)
(let* ((prompts (yppasswd-prompts)) (let ((success-message (assq/false 'success-message spec)))
(success-message (assq/false 'success-message prompts)))
(call-with-current-continuation (call-with-current-continuation
(lambda (return) (lambda (return)
(chat (spawn (,(yppasswd-program)) (= 2 1)) (chat (spawn (,(assq/false 'program spec)) (= 2 1))
(chat-abort (rx (| ,(assq/false 'mismatch-message prompts) (chat-abort (rx (| ,(assq/false 'mismatch-message spec)
,(assq/false 'wrong-message prompts)))) ,(assq/false 'wrong-message spec))))
(chat-monitor (lambda (event value) (chat-monitor (lambda (event value)
;(format (current-error-port) ;(format (current-error-port)
; "Event: ~a <~a>\n" event value) ; "Event: ~a <~a>\n" event value)
@ -171,13 +152,12 @@ Please choose a password with at least 2 character classes.")
(return #f) (return #f)
(return #t)))))) (return #t))))))
(look-for (assq/false 'old-prompt prompts)) (look-for (assq/false 'old-prompt spec))
(send/cr old-pw) (send/cr old-pw)
(look-for (assq/false 'new-prompt prompts)) (look-for (assq/false 'new-prompt spec))
(send/cr new-pw) (send/cr new-pw)
(look-for (assq/false 'retype-prompt prompts)) (look-for (assq/false 'retype-prompt spec))
(send/cr new-pw) (send/cr new-pw)
(display (if success-message "YES\n" "NO\n"))
(if success-message (if success-message
;; if there's gonna be a success-message, wait for it. ;; if there's gonna be a success-message, wait for it.
(begin (look-for success-message) #t) (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 ;; TODO: there is no eof, although program ends
(begin (sleep 2000) #t))))))) (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 ************************************************** ;; *** all together **************************************************
(define (verify-old-password pw) (define (verify-old-password pw)
(verify-yp-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)) (change-yp-password old-pw new-pw))
(define (ask/check-old-password) (define (ask/check-old-password)
@ -217,6 +231,7 @@ Please choose a password with at least 2 character classes.")
(display no-match) (display no-match)
(newline) (newline)
(lp #f))) (lp #f)))
;; TODO: there are more restrictions concerning 'too similar'!
(let ((pw (read-password new-pw-prompt-1))) (let ((pw (read-password new-pw-prompt-1)))
(cond (cond
((< (string-length pw) min-password-length) ((< (string-length pw) min-password-length)
@ -232,10 +247,8 @@ Please choose a password with at least 2 character classes.")
(lp pw)))))))) (lp pw))))))))
(define (main args) (define (main args)
(if (not (or (solaris-machine?) (freebsd-machine?)))
(raise-unsupported-machine))
(let ((old-pw (ask/check-old-password)) (let ((old-pw (ask/check-old-password))
(new-pw (ask-new-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 changed.\n")
(display "Password could not be changed.\n")))) (display "Password could not be changed.\n"))))