- abstracted chat over passwd-program, to reuse code for the other programs
This commit is contained in:
frese
parent
72deaa76de
commit
a69eb8275d
|
|
@ -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"))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue