- 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

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" "$@"
!#
;; 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 (yppasswd-program)
"/usr/bin/yppasswd")
(define (yppasswd-prompts)
(map cons
'(old-prompt new-prompt retype-prompt wrong-message mismatch-message
success-message)
(define system-type
(let ((systype (getenv "SYSTYPE")))
(if (not systype)
(error "Cannot determine system type ($SYSTYPE not set)."))
(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??
)))))
((string=? systype "sun4x_58") 'sun)
((string=? systype "i386_fbsd52") 'freebsd)
((string=? systype "i386_linux24") 'linux)
(else (raise-unsupported-machine)))))
(define (verify-yp-password old-pw)
(let ((prompts (yppasswd-prompts)))
;; *** general password interface ************************************
(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-password spec password)
(call-with-current-continuation
(lambda (return)
(chat (spawn (,(yppasswd-program)) (= 2 1))
(chat-abort (rx ,(assq/false 'wrong-message prompts)))
(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"))))