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

+ added interrupt handelers for catching ctrl-c etc 

+ verify old password in all three systems: NIS, Kerberos and AFS
This commit is contained in:
eknauel 2004-11-09 19:48:51 +00:00
parent 09f27ea9f3
commit d016ba79d9
1 changed files with 30 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
examples/passwd-wrapper.scm
View File

@ -2,9 +2,6 @@
exec scsh -lel expect/load.scm -lel yp/load.scm -o yp -o threads -o expect -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))))
@ -238,8 +235,8 @@ Please choose a password with at least 2 character classes.")
(case system-type
((freebsd) (cons "/afs/wsi/i386_fbsd52/heimdal-1.6/bin/klist"
"/afs/wsi/i386_fbsd52/heimdal-1.6/bin/kinit"))
((solaris) (cons "/afs/wsi/sun4x_58/krb5-1.3.1/bin/klist"
"/afs/wsi/sun4x_58/krb5-1.3.1/bin/kinit"))))
((solaris) (cons "/afs/wsi/sun4x_58/heimdal-0.6/bin/klist"
"/afs/wsi/sun4x_58/heimdal-0.6/bin/kinit"))))
(define (verify-kerbv-password password)
(verify-password kerberos-v password))
@ -252,16 +249,26 @@ Please choose a password with at least 2 character classes.")
(output (run/string (,klist))))
(not (string-match (rx (| "No ticket file" ">>>Expired<<<")) output))))
;; works for heimdal's kinit program
(define (run-heimdal-kinit program user password)
(call-with-current-continuation
(lambda (return)
(let ((task (spawn (,program ,user) (= 2 1))))
(chat task
(chat-abort (rx "Password incorrect"))
(chat-monitor
(lambda (event value)
(case event
((eof) (return (zero? (wait (task:process task)))))
((timeout abort) (return #f)))))
(look-for (rx (: ,user "@" (+ (- any #\')) "'s Password:")))
(send/cr password)
(look-for (rx (: #\space ,(ascii->char 13) ,(ascii->char 10))))
(look-for (rx (- any any))))))))
(define (get-kerbv-ticket password)
;; TODO look at status result?
(let ((kinit (cdr kerbv-programs)))
(let ((res (chat (spawn (,kinit))
(chat-timeout 3)
(look-for "Password") (sleep 0.1)
(send password)
(look-for "Password incorrect")
#f)))
res)))
(run-heimdal-kinit kinit (user-login-name) password)))
(define (ensure-kerbv-ticket password)
(or (valid-kerbv-ticket?)
@ -297,8 +304,11 @@ Please choose a password with at least 2 character classes.")
;; *** all together **************************************************
;; also check kerberos and afs password
(define (verify-old-password pw)
(verify-yp-password pw))
(and (verify-yp-password pw)
(verify-kerbv-password pw)
(change-afs-password pw pw)))
(define (change-all-passwords old-pw new-pw)
(if (change-yp-password old-pw new-pw)
@ -311,7 +321,8 @@ Please choose a password with at least 2 character classes.")
(if (change-afs-password old-pw new-pw)
(display "AFS password changed successfully.\n")
(begin
(display "AFS password could not be changed. Trying to restore old NIS and Kerberos V passwords.\n")
(display "AFS password could not be changed. Trying to restore old NIS and Kerberos V passwords. This will take some time. Please stand by.\n")
(sleep (* 1000 30))
(if (change-yp-password new-pw old-pw)
(begin
(display "Old NIS password restored.\n")
@ -381,6 +392,9 @@ Please choose a password with at least 2 character classes.")
(display "Written by David Frese.\n"))
(define (main args)
(set-interrupt-handler interrupt/int (lambda a (values)))
(set-interrupt-handler interrupt/term (lambda a (values)))
(set-interrupt-handler interrupt/quit (lambda a (values)))
(if (null? (cdr args))
(case system-type
((freebsd solaris)
@ -389,7 +403,7 @@ Please choose a password with at least 2 character classes.")
(if (not (ensure-kerbv-ticket old-pw))
(display "Cannot get a Kerberos-V ticket, required to change the Kerberos-V password. Use a different machine, or contact your administrator.")
(if (change-all-passwords old-pw new-pw)
(display "Passwords changed.\n")
(display "Success.\n")
(display "Warning: Your passwords are not consistent anymore. Contact your system administrator.\n")))))
(else
(raise-unsupported-machine)))