1 ;;; passwd.el --- Prompting for passwords semi-securely
3 ;; Copyright (C) 1994 Free Software Foundation, Inc.
4 ;; Keywords: comm, extensions
6 ;; Author: Jamie Zawinski <jwz@netscape.com>
8 ;; This file is part of XEmacs.
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;;; Synched up with: Not in FSF.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
28 ;; Sun Jun 12 04:19:30 1994 by sandy on ibm550.sissa.it
29 ;; Added support for password histories and (provide 'passwd)
30 ;; (jwz says: this "history" thing is completely undocumented, you loser!)
31 ;; 2-Jan-95 (mon); 4:13 AM by jwz@netscape.com
32 ;; Fixed Sandy's extreme keymap bogosity. Made it invert the screen when
33 ;; reading securely (this could be better; maybe use red text or something
35 ;; 9-Jul-95 (fri); 4:55 AM by jwz@netscape.com
36 ;; Made it work with XEmacs 19.12.
37 ;; 7-Jul-95 by cthomp@cs.uiuc.edu
38 ;; Added variable to control inverting frame when keyboard grabbed
42 (defvar passwd-invert-frame-when-keyboard-grabbed t
43 "*If non-nil swap the foreground and background colors of all faces.
44 This is done while the keyboard is grabbed in order to give a visual
45 clue that a grab is in effect.")
47 (defvar passwd-echo ?.
48 "*The character which should be echoed when typing a password,
49 or nil, meaning echo nothing.")
51 (defvar read-passwd-map
55 (cond ((fboundp 'set-keymap-parent)
56 (setq map (make-keymap))
57 (set-keymap-parent map minibuffer-local-map))
58 (t ; v18/FSFmacs compatibility
59 (setq map (copy-keymap minibuffer-local-map))))
60 (if (fboundp 'set-keymap-name)
61 (set-keymap-name map 'read-passwd-map))
65 (or (and (boundp 'meta-prefix-char) (eq i meta-prefix-char))
66 (define-key map s 'self-insert-command))
69 (define-key map "\C-g" 'keyboard-quit)
70 (define-key map "\C-h" 'delete-backward-char)
71 (define-key map "\r" 'exit-minibuffer)
72 (define-key map "\n" 'exit-minibuffer)
73 (define-key map "\C-u" 'passwd-erase-buffer)
74 (define-key map "\C-q" 'quoted-insert)
75 (define-key map "\177" 'delete-backward-char)
76 (define-key map "\M-n" 'passwd-next-history-element)
77 (define-key map "\M-p" 'passwd-previous-history-element)
79 "Keymap used for reading passwords in the minibuffer.
80 The \"bindings\" in this map are not real commands; only a limited
81 number of commands are understood. The important bindings are:
83 \\[passwd-erase-buffer] Erase all input.
84 \\[quoted-insert] Insert the next character literally.
85 \\[delete-backward-char] Delete the previous character.
86 \\[exit-minibuffer] Accept what you have typed.
87 \\[keyboard-quit] Abort the command.
89 All other characters insert themselves (but do not echo.)")
91 ;;; internal variables
93 (defvar passwd-history nil)
94 (defvar passwd-history-posn 0)
97 (defun read-passwd (prompt &optional confirm default)
98 "Prompts for a password in the minibuffer, and returns it as a string.
99 If PROMPT may be a prompt string or an alist of elements
100 '\(prompt . default\).
101 If optional arg CONFIRM is true, then ask the user to type the password
102 again to confirm that they typed it correctly.
103 If optional arg DEFAULT is provided, then it is a string to insert as
104 the default choice (it is not, of course, displayed.)
106 If running under X, the keyboard will be grabbed (with XGrabKeyboard())
107 to reduce the possibility that evesdropping is occuring.
109 When reading a password, all keys self-insert, except for:
111 \\[read-passwd-erase-line] Erase the entire line.
112 \\[quoted-insert] Insert the next character literally.
113 \\[delete-backward-char] Delete the previous character.
114 \\[exit-minibuffer] Accept what you have typed.
115 \\[keyboard-quit] Abort the command.
117 The returned value is always a newly-created string. No additional copies
118 of the password remain after this function has returned.
120 NOTE: unless great care is taken, the typed password will exist in plaintext
121 form in the running image for an arbitrarily long time. Priveleged users may
122 be able to extract it from memory. If emacs crashes, it may appear in the
125 Some steps you can take to prevent the password from being copied around:
127 - as soon as you are done with the returned string, destroy it with
128 (fillarray string 0). The same goes for any default passwords
129 or password histories.
131 - do not copy the string, as with concat or substring - if you do, be
132 sure to keep track of and destroy all copies.
134 - do not insert the password into a buffer - if you do, be sure to
135 overwrite the buffer text before killing it, as with the functions
136 `passwd-erase-buffer' or `passwd-kill-buffer'. Note that deleting
137 the text from the buffer does NOT necessarily remove the text from
140 - be careful of the undo history - if you insert the password into a
141 buffer which has undo recording turned on, the password will be
142 copied onto the undo list, and thus recoverable.
144 - do not pass it as an argument to a shell command - anyone will be
145 able to see it if they run `ps' at the right time.
147 Note that the password will be temporarily recoverable with the `view-lossage'
148 command. This data will not be overwritten until another hundred or so
149 characters are typed. There's not currently a way around this."
152 (let ((input (get-buffer-create " *password*"))
153 (passwd-history-posn 0)
156 (setq passwd-history prompt
157 default (cdr (car passwd-history))))
159 (buffer-disable-undo input)
160 (use-local-map read-passwd-map)
163 (if (passwd-grab-keyboard)
164 (passwd-secure-display))
165 (read-passwd-1 input prompt nil default)
174 (setq passwd (buffer-string))
175 (read-passwd-1 input prompt "[Retype to confirm]")
176 (if (passwd-compare-string-to-buffer passwd input)
181 (read-passwd-1 input prompt "[Mismatch. Start over]")
185 (passwd-ungrab-keyboard)
186 (passwd-insecure-display)
187 (passwd-kill-buffer input)
188 (if (fboundp 'clear-message) ;XEmacs
194 (defun read-passwd-1 (buffer prompt &optional prompt2 default)
196 (passwd-erase-buffer)
197 (if default (insert default))
198 (catch 'exit ; exit-minibuffer throws here
201 (let* ((minibuffer-completion-table nil)
202 (cursor-in-echo-area t)
204 (key (passwd-read-key-sequence
205 (concat (if (listp prompt)
206 (car (nth passwd-history-posn passwd-history))
210 (make-string (buffer-size) passwd-echo)))))
211 (binding (key-binding key)))
213 (set-buffer buffer) ; just in case...
214 (if (fboundp 'event-to-character) ;; lemacs
215 (setq last-command-event (aref key (1- (length key)))
216 last-command-char (event-to-character last-command-event))
217 ;; v18/FSFmacs compatibility
218 (setq last-command-char (aref key (1- (length key)))))
219 (setq this-command binding)
221 (command-execute binding)
224 (if (fboundp 'display-error)
226 ;; v18/FSFmacs compatibility
227 (message (concat (or (get (car-safe c) 'error-message) "???")
228 (if (cdr-safe c) ": ")
230 (function (lambda (x) (format "%s" x)))
231 (cdr-safe c) ", "))))
235 (defun passwd-previous-history-element (n)
238 (error "Password history is empty."))
239 (let ((l (length passwd-history)))
240 (setq passwd-history-posn
241 (% (+ n passwd-history-posn) l))
242 (if (< passwd-history-posn 0)
243 (setq passwd-history-posn (+ passwd-history-posn l))))
244 (let ((obuff (current-buffer))) ; want to move point in passwd buffer
247 (set-buffer " *password*")
248 (passwd-erase-buffer)
249 (insert (cdr (nth passwd-history-posn passwd-history))))
250 (set-buffer obuff))))
252 (defun passwd-next-history-element (n)
254 (passwd-previous-history-element (- n)))
256 (defun passwd-erase-buffer ()
257 ;; First erase the buffer, which will simply enlarge the gap.
258 ;; Then insert null characters until the gap is filled with them
259 ;; to prevent the old text from being visible in core files or kmem.
260 ;; (Actually use 3x the size of the buffer just to be safe - a longer
261 ;; passwd might have been typed and backspaced over.)
264 (let ((s (* (buffer-size) 3)))
271 (defun passwd-kill-buffer (buffer)
274 (buffer-disable-undo buffer)
275 (passwd-erase-buffer)
276 (set-buffer-modified-p nil))
277 (kill-buffer buffer))
280 (defun passwd-compare-string-to-buffer (string buffer)
281 ;; same as (equal string (buffer-string)) but with no dangerous consing.
284 (goto-char (point-min))
285 (let ((L (length string))
287 (if (/= L (- (point-max) (point-min)))
290 (if (/= (following-char) (aref string i))
291 (goto-char (point-max))
294 (= (point) (+ i (point-min)))))))
297 (defvar passwd-face-data nil)
298 (defun passwd-secure-display ()
299 ;; Inverts the screen - used to indicate secure input, like xterm.
301 ((and passwd-invert-frame-when-keyboard-grabbed
302 (fboundp 'set-face-foreground))
303 (setq passwd-face-data
304 (delq nil (mapcar (function
306 (let ((fg (face-foreground face))
307 (bg (face-background face)))
309 (if (fboundp 'color-name)
315 (if (fboundp 'list-faces)
316 (list-faces) ; lemacs
317 (face-list) ; FSFmacs
319 (let ((rest passwd-face-data))
321 (set-face-foreground (nth 0 (car rest)) (nth 2 (car rest)))
322 (set-face-background (nth 0 (car rest)) (nth 1 (car rest)))
323 (setq rest (cdr rest))))))
326 (defun passwd-insecure-display ()
327 ;; Undoes the effect of `passwd-secure-display'.
329 (passwd-invert-frame-when-keyboard-grabbed
330 (while passwd-face-data
331 (set-face-foreground (nth 0 (car passwd-face-data))
332 (nth 1 (car passwd-face-data)))
333 (set-face-background (nth 0 (car passwd-face-data))
334 (nth 2 (car passwd-face-data)))
335 (setq passwd-face-data (cdr passwd-face-data)))
338 (defun passwd-grab-keyboard ()
339 (cond ((not (and (fboundp 'x-grab-keyboard) ; lemacs 19.10+
340 (eq 'x (if (fboundp 'frame-type)
341 (frame-type (selected-frame))
342 (live-screen-p (selected-screen))))))
347 (message "Unable to grab keyboard - waiting a second...")
349 (cond ((x-grab-keyboard)
350 (message "Keyboard grabbed on second try.")
354 (message "WARNING: keyboard is insecure (unable to grab!)")
358 (defun passwd-ungrab-keyboard ()
359 (if (and (fboundp 'x-ungrab-keyboard) ; lemacs 19.10+
360 (eq 'x (if (fboundp 'frame-type)
361 (frame-type (selected-frame))
362 (live-screen-p (selected-screen)))))
363 (x-ungrab-keyboard)))
366 (or (fboundp 'buffer-disable-undo)
367 (fset 'buffer-disable-undo 'buffer-flush-undo))
369 ;; read-key-sequence echoes the key sequence in Emacs 18.
370 (defun passwd-read-key-sequence (prompt)
371 (let ((inhibit-quit t)
373 (while (or (null str) (keymapp (key-binding str)))
374 (if (fboundp 'display-message)
375 (display-message 'prompt prompt)
377 (setq str (concat str (char-to-string (read-char)))))
381 (or (string-match "^18" emacs-version)
382 (fset 'passwd-read-key-sequence 'read-key-sequence))
386 ;;; passwd.el ends here