--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/utils/passwd.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,386 @@
+;;; passwd.el --- Prompting for passwords semi-securely
+
+;; Copyright (C) 1994 Free Software Foundation, Inc.
+;; Keywords: comm, extensions
+
+;; Author: Jamie Zawinski <jwz@netscape.com>
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;;; Synched up with: Not in FSF.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Change Log:
+;;
+;;  Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it
+;;    Added support for password histories and (provide 'passwd)
+;;    (jwz says: this "history" thing is completely undocumented, you loser!)
+;; 2-Jan-95 (mon); 4:13 AM by jwz@netscape.com
+;;    Fixed Sandy's extreme keymap bogosity.  Made it invert the screen when
+;;    reading securely (this could be better; maybe use red text or something
+;;    instead...)
+;; 9-Jul-95 (fri); 4:55 AM by jwz@netscape.com
+;;    Made it work with XEmacs 19.12.
+;; 7-Jul-95 by cthomp@cs.uiuc.edu
+;;    Added variable to control inverting frame when keyboard grabbed
+
+;;; Code:
+
+(defvar passwd-invert-frame-when-keyboard-grabbed t
+  "*If non-nil swap the foreground and background colors of all faces.
+This is done while the keyboard is grabbed in order to give a visual
+clue that a grab is in effect.")
+
+(defvar passwd-echo ?.
+  "*The character which should be echoed when typing a password,
+or nil, meaning echo nothing.")
+
+(defvar read-passwd-map
+  (let ((i 0)
+	(s (make-string 1 0))
+	map)
+    (cond ((fboundp 'set-keymap-parent)
+	   (setq map (make-keymap))
+	   (set-keymap-parent map minibuffer-local-map))
+	  (t  ; v18/FSFmacs compatibility
+	   (setq map (copy-keymap minibuffer-local-map))))
+    (if (fboundp 'set-keymap-name)
+	(set-keymap-name map 'read-passwd-map))
+
+    (while (< i 127)
+      (aset s 0 i)
+      (or (and (boundp 'meta-prefix-char) (eq i meta-prefix-char))
+	  (define-key map s 'self-insert-command))
+      (setq i (1+ i)))
+
+    (define-key map "\C-g" 'keyboard-quit)
+    (define-key map "\C-h" 'delete-backward-char)
+    (define-key map "\r" 'exit-minibuffer)
+    (define-key map "\n" 'exit-minibuffer)
+    (define-key map "\C-u" 'passwd-erase-buffer)
+    (define-key map "\C-q" 'quoted-insert)
+    (define-key map "\177" 'delete-backward-char)
+    (define-key map "\M-n" 'passwd-next-history-element)
+    (define-key map "\M-p" 'passwd-previous-history-element)
+    map)
+  "Keymap used for reading passwords in the minibuffer.
+The \"bindings\" in this map are not real commands; only a limited
+number of commands are understood.  The important bindings are:
+\\<read-passwd-map>
+	\\[passwd-erase-buffer]	Erase all input.
+	\\[quoted-insert]	Insert the next character literally.
+	\\[delete-backward-char]	Delete the previous character.
+	\\[exit-minibuffer]	Accept what you have typed.
+	\\[keyboard-quit]	Abort the command.
+
+All other characters insert themselves (but do not echo.)")
+
+;;; internal variables
+
+(defvar passwd-history nil)
+(defvar passwd-history-posn 0)
+
+;;;###autoload
+(defun read-passwd (prompt &optional confirm default)
+  "Prompts for a password in the minibuffer, and returns it as a string.
+If PROMPT may be a prompt string or an alist of elements 
+'\(prompt . default\).
+If optional arg CONFIRM is true, then ask the user to type the password
+again to confirm that they typed it correctly.
+If optional arg DEFAULT is provided, then it is a string to insert as
+the default choice (it is not, of course, displayed.)
+
+If running under X, the keyboard will be grabbed (with XGrabKeyboard())
+to reduce the possibility that evesdropping is occuring.
+
+When reading a password, all keys self-insert, except for:
+\\<read-passwd-map>
+	\\[read-passwd-erase-line]	Erase the entire line.
+	\\[quoted-insert]	Insert the next character literally.
+	\\[delete-backward-char]	Delete the previous character.
+	\\[exit-minibuffer]	Accept what you have typed.
+	\\[keyboard-quit]	Abort the command.
+
+The returned value is always a newly-created string.  No additional copies
+of the password remain after this function has returned.
+
+NOTE: unless great care is taken, the typed password will exist in plaintext
+form in the running image for an arbitrarily long time.  Priveleged users may
+be able to extract it from memory.  If emacs crashes, it may appear in the
+resultant core file.
+
+Some steps you can take to prevent the password from being copied around:
+
+ - as soon as you are done with the returned string, destroy it with
+   (fillarray string 0).  The same goes for any default passwords
+   or password histories.
+
+ - do not copy the string, as with concat or substring - if you do, be
+   sure to keep track of and destroy all copies.
+
+ - do not insert the password into a buffer - if you do, be sure to 
+   overwrite the buffer text before killing it, as with the functions 
+   `passwd-erase-buffer' or `passwd-kill-buffer'.  Note that deleting
+   the text from the buffer does NOT necessarily remove the text from
+   memory.
+
+ - be careful of the undo history - if you insert the password into a 
+   buffer which has undo recording turned on, the password will be 
+   copied onto the undo list, and thus recoverable.
+
+ - do not pass it as an argument to a shell command - anyone will be
+   able to see it if they run `ps' at the right time.
+
+Note that the password will be temporarily recoverable with the `view-lossage'
+command.  This data will not be overwritten until another hundred or so 
+characters are typed.  There's not currently a way around this."
+
+  (save-excursion
+    (let ((input (get-buffer-create " *password*"))
+	  (passwd-history-posn 0)
+	  passwd-history)
+      (if (listp prompt)
+	  (setq passwd-history prompt
+		default (cdr (car passwd-history))))
+      (set-buffer input)
+      (buffer-disable-undo input)
+      (use-local-map read-passwd-map)
+      (unwind-protect
+	  (progn
+	    (if (passwd-grab-keyboard)
+		(passwd-secure-display))
+	    (read-passwd-1 input prompt nil default)
+	    (set-buffer input)
+
+	    (if (not confirm)
+		(buffer-string)
+	      (let ((ok nil)
+		    passwd)
+		(while (not ok)
+		  (set-buffer input)
+		  (setq passwd (buffer-string))
+		  (read-passwd-1 input prompt "[Retype to confirm]")
+		  (if (passwd-compare-string-to-buffer passwd input)
+		      (setq ok t)
+		    (fillarray passwd 0)
+		    (setq passwd nil)
+		    (beep)
+		    (read-passwd-1 input prompt "[Mismatch. Start over]")
+		    ))
+		passwd)))
+	;; protected
+	(passwd-ungrab-keyboard)
+	(passwd-insecure-display)
+	(passwd-kill-buffer input)
+	(if (fboundp 'clear-message) ;XEmacs
+	    (clear-message)
+	  (message ""))
+	))))
+
+
+(defun read-passwd-1 (buffer prompt &optional prompt2 default)
+  (set-buffer buffer)
+  (passwd-erase-buffer)
+  (if default (insert default))
+  (catch 'exit ; exit-minibuffer throws here
+    (while t
+      (set-buffer buffer)
+      (let* ((minibuffer-completion-table nil)
+	     (cursor-in-echo-area t)
+	     (echo-keystrokes 0)
+	     (key (passwd-read-key-sequence
+		   (concat (if (listp prompt)
+			       (car (nth passwd-history-posn passwd-history))
+			     prompt)
+			   prompt2
+			   (if passwd-echo
+			       (make-string (buffer-size) passwd-echo)))))
+	     (binding (key-binding key)))
+	(setq prompt2 nil)
+	(set-buffer buffer)		; just in case...
+	(if (fboundp 'event-to-character) ;; lemacs
+	    (setq last-command-event (aref key (1- (length key)))
+		  last-command-char (event-to-character last-command-event))
+	  ;; v18/FSFmacs compatibility
+	  (setq last-command-char (aref key (1- (length key)))))
+	(setq this-command binding)
+	(condition-case c
+	    (command-execute binding)
+	  (error
+	   (beep)
+	   (if (fboundp 'display-error)
+	       (display-error c t)
+	     ;; v18/FSFmacs compatibility
+	     (message (concat (or (get (car-safe c) 'error-message) "???")
+			      (if (cdr-safe c) ": ")
+			      (mapconcat 
+			       (function (lambda (x) (format "%s" x)))
+			       (cdr-safe c) ", "))))
+	   (sit-for 2)))
+	))))
+
+(defun passwd-previous-history-element (n)
+  (interactive "p")
+  (or passwd-history
+      (error "Password history is empty."))
+  (let ((l (length passwd-history)))
+    (setq passwd-history-posn
+	  (% (+ n passwd-history-posn) l))
+    (if (< passwd-history-posn 0)
+	(setq passwd-history-posn (+ passwd-history-posn l))))
+  (let ((obuff (current-buffer))) ; want to move point in passwd buffer
+    (unwind-protect
+	(progn
+	  (set-buffer " *password*")
+	  (passwd-erase-buffer)
+	  (insert (cdr (nth passwd-history-posn passwd-history))))
+      (set-buffer obuff))))
+
+(defun passwd-next-history-element (n)
+  (interactive "p")
+  (passwd-previous-history-element (- n)))
+
+(defun passwd-erase-buffer ()
+  ;; First erase the buffer, which will simply enlarge the gap.
+  ;; Then insert null characters until the gap is filled with them
+  ;; to prevent the old text from being visible in core files or kmem.
+  ;; (Actually use 3x the size of the buffer just to be safe - a longer
+  ;; passwd might have been typed and backspaced over.)
+  (interactive)
+  (widen)
+  (let ((s (* (buffer-size) 3)))
+    (erase-buffer)
+    (while (> s 0)
+      (insert ?\000)
+      (setq s (1- s)))
+    (erase-buffer)))
+
+(defun passwd-kill-buffer (buffer)
+  (save-excursion
+    (set-buffer buffer)
+    (buffer-disable-undo buffer)
+    (passwd-erase-buffer)
+    (set-buffer-modified-p nil))
+  (kill-buffer buffer))
+
+
+(defun passwd-compare-string-to-buffer (string buffer)
+  ;; same as (equal string (buffer-string)) but with no dangerous consing.
+  (save-excursion
+    (set-buffer buffer)
+    (goto-char (point-min))
+    (let ((L (length string))
+	  (i 0))
+      (if (/= L (- (point-max) (point-min)))
+	  nil
+	(while (not (eobp))
+	  (if (/= (following-char) (aref string i))
+	      (goto-char (point-max))
+	    (setq i (1+ i))
+	    (forward-char)))
+	(= (point) (+ i (point-min)))))))
+
+
+(defvar passwd-face-data nil)
+(defun passwd-secure-display ()
+  ;; Inverts the screen - used to indicate secure input, like xterm.
+  (cond
+   ((and passwd-invert-frame-when-keyboard-grabbed
+	 (fboundp 'set-face-foreground))
+    (setq passwd-face-data
+	  (delq nil (mapcar (function
+			     (lambda (face)
+			       (let ((fg (face-foreground face))
+				     (bg (face-background face)))
+				 (if (or fg bg)
+				     (if (fboundp 'color-name)
+					 (list face
+					       (color-name fg)
+					       (color-name bg))
+				       (list face fg bg))
+				   nil))))
+			    (if (fboundp 'list-faces)
+				(list-faces) ; lemacs
+			      (face-list)    ; FSFmacs
+			      ))))
+    (let ((rest passwd-face-data))
+      (while rest
+	(set-face-foreground (nth 0 (car rest)) (nth 2 (car rest)))
+	(set-face-background (nth 0 (car rest)) (nth 1 (car rest)))
+	(setq rest (cdr rest))))))
+  nil)
+
+(defun passwd-insecure-display ()
+  ;; Undoes the effect of `passwd-secure-display'.
+  (cond
+   (passwd-invert-frame-when-keyboard-grabbed
+    (while passwd-face-data
+      (set-face-foreground (nth 0 (car passwd-face-data))
+			   (nth 1 (car passwd-face-data)))
+      (set-face-background (nth 0 (car passwd-face-data))
+			   (nth 2 (car passwd-face-data)))
+      (setq passwd-face-data (cdr passwd-face-data)))
+    nil)))
+
+(defun passwd-grab-keyboard ()
+  (cond ((not (and (fboundp 'x-grab-keyboard) ; lemacs 19.10+
+		   (eq 'x (if (fboundp 'frame-type)
+			      (frame-type (selected-frame))
+			    (live-screen-p (selected-screen))))))
+	 nil)
+	((x-grab-keyboard)
+	 t)
+	(t
+	 (message "Unable to grab keyboard - waiting a second...")
+	 (sleep-for 1)
+	 (cond ((x-grab-keyboard)
+		(message "Keyboard grabbed on second try.")
+		t)
+	       (t
+		(beep)
+		(message "WARNING: keyboard is insecure (unable to grab!)")
+		(sleep-for 3)
+		nil)))))
+
+(defun passwd-ungrab-keyboard ()
+  (if (and (fboundp 'x-ungrab-keyboard) ; lemacs 19.10+
+	   (eq 'x (if (fboundp 'frame-type)
+		      (frame-type (selected-frame))
+		    (live-screen-p (selected-screen)))))
+      (x-ungrab-keyboard)))
+
+;; v18 compatibility
+(or (fboundp 'buffer-disable-undo)
+    (fset 'buffer-disable-undo 'buffer-flush-undo))
+
+;; read-key-sequence echoes the key sequence in Emacs 18.
+(defun passwd-read-key-sequence (prompt)
+  (let ((inhibit-quit t)
+	str)
+    (while (or (null str) (keymapp (key-binding str)))
+      (if (fboundp 'display-message)
+	  (display-message 'prompt prompt)
+	(message prompt))
+      (setq str (concat str (char-to-string (read-char)))))
+    (setq quit-flag nil)
+    str))
+
+(or (string-match "^18" emacs-version)
+    (fset 'passwd-read-key-sequence 'read-key-sequence))
+
+(provide 'passwd)
+
+;;; passwd.el ends here