424 lines
14 KiB
Scheme
Executable File
424 lines
14 KiB
Scheme
Executable File
#!/bin/sh
|
|
exec scsh -lel expect/load.scm -lel yp/load.scm -o yp -o threads -o expect -o let-opt -e main -s "$0" "$@"
|
|
!#
|
|
|
|
(define (assq/false key alist)
|
|
(let ((p (assq key alist)))
|
|
(and p (cdr p))))
|
|
|
|
;; *** password restrictions *****************************************
|
|
|
|
(define min-password-length 8)
|
|
(define max-password-length 32)
|
|
(define min-password-char-classes 2)
|
|
|
|
(define known-char-sets
|
|
(list char-set:lower-case char-set:upper-case
|
|
char-set:digit char-set:punctuation))
|
|
|
|
(define all-char-sets
|
|
(cons (char-set-difference
|
|
char-set:full
|
|
(apply char-set-union known-char-sets))
|
|
known-char-sets))
|
|
|
|
(define (count-char-classes pw)
|
|
(apply + (map (lambda (cs)
|
|
(if (string-fold
|
|
(lambda (c s)
|
|
(or s (char-set-contains? cs c)))
|
|
#f pw)
|
|
1 0))
|
|
all-char-sets)))
|
|
|
|
(define (display-password-too-short)
|
|
(display "Password too short (minimum length ")
|
|
(display min-password-length)
|
|
(display ")")
|
|
(newline))
|
|
|
|
(define (display-password-too-long)
|
|
(display "Password too long (maximum length ")
|
|
(display max-password-length)
|
|
(display ")")
|
|
(newline))
|
|
|
|
(define (display-password-too-few-char-classes)
|
|
(display "
|
|
New password does not have enough character classes.
|
|
The character classes are:
|
|
- lower-case letters
|
|
- upper-case letters
|
|
- digits
|
|
- punctuation, and
|
|
- all other characters (e.g., control characters).
|
|
|
|
Please choose a password with at least 2 character classes.")
|
|
(newline))
|
|
|
|
;; *** tty support ***************************************************
|
|
|
|
;; read string without echoing it
|
|
;; optionals arguments:
|
|
;; prompt - a string to be display before reading (default none)
|
|
;; port - the port to read from (default current-input-port)
|
|
(define (read-password . args)
|
|
(let-optionals args ((prompt #f)
|
|
(port (current-input-port)))
|
|
(let* ((tty-before (tty-info port))
|
|
(tty-sans-echo (copy-tty-info tty-before)))
|
|
(if prompt
|
|
(begin
|
|
(display prompt)
|
|
(force-output (current-output-port))))
|
|
(set-tty-info:local-flags
|
|
tty-sans-echo (bitwise-and (tty-info:local-flags tty-sans-echo)
|
|
(bitwise-not ttyl/echo)))
|
|
(set-tty-info/now port tty-sans-echo)
|
|
(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 ********************************************
|
|
|
|
(define (raise-unsupported-machine)
|
|
(display "I refuse to run on unsupported machines\n"
|
|
(current-error-port))
|
|
(exit 10))
|
|
|
|
(define system-type
|
|
(let ((systype (getenv "SYSTYPE")))
|
|
(if (not systype)
|
|
(error "Cannot determine system type ($SYSTYPE not set)."))
|
|
(cond
|
|
((string=? systype "sun4x_59") 'solaris)
|
|
((string=? systype "i386_fbsd52") 'freebsd)
|
|
((string=? systype "i386_rh90") 'linux)
|
|
(else (raise-unsupported-machine)))))
|
|
|
|
;; *** 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 (,(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)
|
|
;(force-output (current-error-port))
|
|
(case event
|
|
((eof timeout abort) (return #f)))))
|
|
|
|
(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))))
|
|
|
|
(define (change-password spec old-pw new-pw)
|
|
(let ((success-message (assq/false 'success-message spec)))
|
|
(call-with-current-continuation
|
|
(lambda (return)
|
|
(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)
|
|
;(force-output (current-error-port))
|
|
(case event
|
|
((timeout abort) (return #f))
|
|
((eof)
|
|
(if success-message
|
|
(return #f)
|
|
(return #t))))))
|
|
|
|
(look-for (assq/false 'old-prompt spec))
|
|
(send/cr old-pw)
|
|
(look-for (assq/false 'new-prompt spec))
|
|
(send/cr new-pw)
|
|
(look-for (assq/false 'retype-prompt spec))
|
|
(send/cr new-pw)
|
|
(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)
|
|
;; TODO: there is no eof, although program ends
|
|
(begin (sleep 2000) #t)))))))
|
|
|
|
;; *** interface to yppasswd *****************************************
|
|
|
|
(define (password-stored-in-yp-passwd? user . args)
|
|
(let-optionals args
|
|
((domain (yp-get-default-domain)))
|
|
(let ((splitter (infix-splitter (rx ":"))))
|
|
(cond
|
|
((yp-match "passwd.byname" user domain)
|
|
=> (lambda (entry)
|
|
(not (string=? "x" (cadr (splitter entry))))))
|
|
(else #f)))))
|
|
|
|
(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"
|
|
(rx "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."
|
|
(rx "The NIS password has been changed on"))))))
|
|
|
|
(define (verify-yp-password password)
|
|
(let ((user-has-yp-password?
|
|
(password-stored-in-yp-passwd? (user-login-name))))
|
|
(if user-has-yp-password?
|
|
(verify-password yppasswd password)
|
|
#t)))
|
|
|
|
(define (change-yp-password old-pw new-pw)
|
|
(if (password-stored-in-yp-passwd? (user-login-name))
|
|
(change-password yppasswd old-pw new-pw)
|
|
#t))
|
|
|
|
;; *** Kerberos V interface ******************************************
|
|
|
|
(define kerberos-v
|
|
(case system-type
|
|
((freebsd) (define-passwd "/afs/wsi/i386_fbsd52/heimdal-1.6/bin/kpasswd"
|
|
"Password: "
|
|
"New password: "
|
|
"Verifying - New password: "
|
|
"kpasswd: Password incorrect"
|
|
"Verify failure"
|
|
"Success"))
|
|
((solaris) (define-passwd "/afs/wsi/sun4x_58/krb5-1.3.1/bin/kpasswd"
|
|
(rx (: "Password for " (+ (- any #\:)) ": "))
|
|
"Enter new password: : "
|
|
"Enter it again: : "
|
|
"Password incorrect while getting initial ticket"
|
|
"Password mismatch while reading password"
|
|
"Password changed."))
|
|
((linux) (define-passwd "/afs/wsi/i386_rh90/heimdal-0.6/bin/kpasswd"
|
|
"Password: "
|
|
"New password: "
|
|
"Verifying - New password: "
|
|
"kpasswd: Password incorrect"
|
|
"Verify failure"
|
|
"Success"))))
|
|
|
|
(define kerbv-programs
|
|
(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/heimdal-0.6/bin/klist"
|
|
"/afs/wsi/sun4x_58/heimdal-0.6/bin/kinit"))
|
|
((linux) (cons "/afs/wsi/i386_rh90/heimdal-0.6/bin/klist"
|
|
"/afs/wsi/i386_rh90/heimdal-0.6/bin/kinit"))))
|
|
|
|
(define (verify-kerbv-password password)
|
|
(verify-password kerberos-v password))
|
|
|
|
(define (change-kerbv-password old-pw new-pw)
|
|
(change-password kerberos-v old-pw new-pw))
|
|
|
|
(define (valid-kerbv-ticket?)
|
|
(let* ((klist (car kerbv-programs))
|
|
(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)
|
|
(let ((kinit (cdr kerbv-programs)))
|
|
(run-heimdal-kinit kinit (user-login-name) password)))
|
|
|
|
(define (ensure-kerbv-ticket password)
|
|
(or (valid-kerbv-ticket?)
|
|
(get-kerbv-ticket password)))
|
|
|
|
;; *** AFS (Kerberos IV) interface ***********************************
|
|
|
|
(define afs
|
|
(case system-type
|
|
((freebsd) (define-passwd "/afs/wsi/i386_fbsd52/openafs-cvs/bin/kpasswd"
|
|
"Old password: "
|
|
(rx "New password (RETURN to abort): ")
|
|
"Retype new password: "
|
|
;; Attention: the old password is checked AFTER the
|
|
;; new password is entered! So verify will not work!
|
|
;; However: changing old-pw to old-pw works fine
|
|
"kpasswd: Incorrect old password."
|
|
"Mismatch"
|
|
"Password changed."))
|
|
((solaris) (define-passwd "/afs/wsi/sun4x_58/openafs-1.2.11/bin/kpasswd"
|
|
"Old password: "
|
|
(rx "New password (RETURN to abort): ")
|
|
"Retype new password: "
|
|
"kpasswd: Incorrect old password."
|
|
"Mismatch"
|
|
"Password changed."))
|
|
((linux) (define-passwd "/afs/wsi/i386_rh90/openafs-1.2.11/bin/kpasswd"
|
|
"Old password: "
|
|
(rx "New password (RETURN to abort): ")
|
|
"Retype new password: "
|
|
;; Attention: the old password is checked AFTER the
|
|
;; new password is entered! So verify will not work!
|
|
;; However: changing old-pw to old-pw works fine
|
|
"kpasswd: Incorrect old password."
|
|
"Mismatch"
|
|
"Password changed."))))
|
|
|
|
(define (change-afs-password old-pw new-pw)
|
|
(change-password afs old-pw new-pw))
|
|
|
|
;; *** all together **************************************************
|
|
|
|
;; also check kerberos and afs password
|
|
(define (verify-old-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)
|
|
(begin
|
|
(display "NIS password changed successfully.\n")
|
|
;; TODO: make sure we have a ticket
|
|
(if (change-kerbv-password old-pw new-pw)
|
|
(begin
|
|
(display "Kerberos V password changed successfully.\n")
|
|
(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. 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")
|
|
;; because the Kerberos password needs some
|
|
;; minutes to become effective, we also try
|
|
;; it with the old password.
|
|
(if (or (change-kerbv-password old-pw old-pw)
|
|
(change-kerbv-password new-pw old-pw))
|
|
(display "Old Kerberos V password restored.\n")
|
|
(begin
|
|
(display "Old Kerberos V password could not be restored.\n")
|
|
#f)))
|
|
(begin
|
|
(display "Old NIS password could not be restored.\n")
|
|
#f)))))
|
|
(begin
|
|
(display "Kerberos V password could not be changed. Trying to restore old NIS password.\n")
|
|
(if (change-yp-password new-pw old-pw)
|
|
(display "Old NIS password restored.\n")
|
|
(begin
|
|
(display "Old NIS password could not be restored.\n")
|
|
#f)))))
|
|
(display "NIS password could not be changed. No passwords changed.\n")))
|
|
|
|
(define (ask/check-old-password)
|
|
(let ((old-pw-prompt "Old password: "))
|
|
(let lp ((old-pw #f))
|
|
(let ((pw (read-password old-pw-prompt)))
|
|
(cond
|
|
((verify-old-password pw)
|
|
pw)
|
|
(else
|
|
(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 "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
|
|
(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)
|
|
(display-password-too-short)
|
|
(lp #f))
|
|
((> (string-length pw) max-password-length)
|
|
(display-password-too-long)
|
|
(lp #f))
|
|
((< (count-char-classes pw) min-password-char-classes)
|
|
(display-password-too-few-char-classes)
|
|
(lp #f))
|
|
(else
|
|
(lp pw))))))))
|
|
|
|
(define (display-usage)
|
|
(display "Usage: passwd-wrapper.scm\n")
|
|
(display "Change NIS, Kerberos IV and Kerberos V passwords at once.\n")
|
|
(display "Written by Eric Knauel and 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 linux)
|
|
(let ((old-pw (ask/check-old-password))
|
|
(new-pw (ask-new-password)))
|
|
(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 "Success.\n")
|
|
(display "Warning: Your passwords are not consistent anymore. Contact your system administrator.\n")))))
|
|
(else
|
|
(raise-unsupported-machine)))
|
|
(display-usage)))
|