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

- fixed some bugs 

- made output a little nicer
This commit is contained in:
frese 2004-07-16 14:51:52 +00:00
parent ddf471ff81
commit 72deaa76de
1 changed files with 26 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
examples/passwd-wrapper.scm
View File

@ -32,14 +32,12 @@ exec scsh -lm ../scheme/packages.scm -o threads -o chat-package -o expect-packag
all-char-sets)))
(define (display-password-too-short)
(newline)
(display "Password too short (minimum length ")
(display min-password-length)
(display ")")
(newline))
(define (display-password-too-long)
(newline)
(display "Password too long (maximum length ")
(display max-password-length)
(display ")")
@ -80,6 +78,8 @@ Please choose a password with at least 2 character classes.")
(let ((password (read-line port)))
(set-tty-info/now port tty-before)
(flush-tty/both port)
(newline)
(force-output (current-output-port))
password))))
;; *** supported machines ********************************************
@ -135,11 +135,14 @@ Please choose a password with at least 2 character classes.")
(define (verify-yp-password old-pw)
(let ((prompts (yppasswd-prompts)))
(call/cc
(call-with-current-continuation
(lambda (return)
(chat (spawn ,(yppasswd-program) (= 2 1))
(chat (spawn (,(yppasswd-program)) (= 2 1))
(chat-abort (rx ,(assq/false 'wrong-message prompts)))
(chat-monitor (lambda (event value)
;(format (current-error-port)
; "Event: ~a <~a>\n" event value)
;(force-output (current-error-port))
(case event
((eof timeout abort) (return #f)))))
@ -150,14 +153,17 @@ Please choose a password with at least 2 character classes.")
#t)))))
(define (change-yp-password old-pw new-pw)
(let ((prompts (yppasswd-prompts))
(success-message (assq/false 'success-message prompts)))
(call/cc
(let* ((prompts (yppasswd-prompts))
(success-message (assq/false 'success-message prompts)))
(call-with-current-continuation
(lambda (return)
(chat (spawn ,(yppasswd-program (= 2 1)))
(chat (spawn (,(yppasswd-program)) (= 2 1))
(chat-abort (rx (| ,(assq/false 'mismatch-message prompts)
,(assq/false 'wrong-message prompts))))
(chat-monitor (lambda (event value)
;(format (current-error-port)
; "Event: ~a <~a>\n" event value)
;(force-output (current-error-port))
(case event
((timeout abort) (return #f))
((eof)
@ -166,16 +172,18 @@ Please choose a password with at least 2 character classes.")
(return #t))))))
(look-for (assq/false 'old-prompt prompts))
(send old-pw)
(send/cr old-pw)
(look-for (assq/false 'new-prompt prompts))
(send new-pw)
(send/cr new-pw)
(look-for (assq/false 'retype-prompt prompts))
(send new-pw)
(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)
;; else wait a bit for errors (#f) or eof (#t)
(begin (sleep 2000) #f)))))))
;; TODO: there is no eof, although program ends
(begin (sleep 2000) #t)))))))
;; *** all together **************************************************
@ -193,20 +201,19 @@ Please choose a password with at least 2 character classes.")
((verify-old-password pw)
pw)
(else
(display "Wrong password. Try again.")
(newline)
(display "Wrong password. Try again.\n")
(force-output)
(lp (read-password old-pw-prompt))))))))
(define (ask-new-password)
(let ((new-pw-prompt-1 "New password: ")
(new-pw-prompt-2 "\nRetype new password: ")
(new-pw-prompt-2 "Retype new password: ")
(no-match "Passwords do not match. Retry."))
(let lp ((pw #f))
(if pw
(if (string=? pw (read-password new-pw-prompt-2))
pw
(begin
(newline)
(display no-match)
(newline)
(lp #f)))
@ -229,4 +236,6 @@ Please choose a password with at least 2 character classes.")
(raise-unsupported-machine))
(let ((old-pw (ask/check-old-password))
(new-pw (ask-new-password)))
(change-password old-pw new-pw)))
(if (change-password old-pw new-pw)
(display "Password changed.\n")
(display "Password could not be changed.\n"))))