cgit.sxemacs.org Git - packages/blob - xemacs-packages/ecrypto/password.el

   1 ;;; password.el --- Read passwords from user, possibly using a password cache.
   2
   3 ;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
   4
   5 ;; Author: Simon Josefsson <simon@josefsson.org>
   6 ;; Created: 2003-12-21
   7 ;; Keywords: password cache passphrase key
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
  29 ;; fixes for XEmacs by Katsumi Yamaoka.  In fact, this is mostly just
  30 ;; a rip-off.
  31 ;;
  32 ;; (password-read "Password? " "test")
  33 ;; ;; Minibuffer prompt for password.
  34 ;;  => "foo"
  35 ;;
  36 ;; (password-cache-add "test" "foo")
  37 ;;  => nil
  38
  39 ;; Note the previous two can be replaced with:
  40 ;; (password-read-and-add "Password? " "test")
  41 ;; ;; Minibuffer prompt for password.
  42 ;; => "foo"
  43 ;; ;; "foo" is now cached with key "test"
  44
  45
  46 ;; (password-read "Password? " "test")
  47 ;; ;; No minibuffer prompt
  48 ;;  => "foo"
  49 ;;
  50 ;; (password-read "Password? " "test")
  51 ;; ;; No minibuffer prompt
  52 ;;  => "foo"
  53 ;;
  54 ;; ;; Wait `password-cache-expiry' seconds.
  55 ;;
  56 ;; (password-read "Password? " "test")
  57 ;; ;; Minibuffer prompt for password is back.
  58 ;;  => "foo"
  59
  60 ;;; Code:
  61
  62 (eval-when-compile
  63   (require 'cl))
  64
  65 ;; XEmacs has a buggy version of run-at-time.  This defines a
  66 ;; non-buggy version of the same.
  67 (defalias
  68   'password-run-at-time
  69   (if (condition-case nil
  70           (progn
  71             (unless (or itimer-process itimer-timer)
  72               (itimer-driver-start))
  73             ;; Check whether there is a bug to which the difference of
  74             ;; the present time and the time when the itimer driver was
  75             ;; woken up is subtracted from the initial itimer value.
  76             (let* ((inhibit-quit t)
  77                    (ctime (current-time))
  78                    (itimer-timer-last-wakeup
  79                     (prog1
  80                         ctime
  81                       (setcar ctime (1- (car ctime)))))
  82                    (itimer-list nil)
  83                    (itimer (start-itimer "run-at-time" 'ignore 5)))
  84               (sleep-for 0.1) ;; Accept the timeout interrupt.
  85               (prog1
  86                   (> (itimer-value itimer) 0)
  87                 (delete-itimer itimer))))
  88         (error nil))
  89       (lambda (time repeat function &rest args)
  90         "Function emulating the function of the same name of Emacs.
  91 TIME should be nil meaning now, or a number of seconds from now.
  92 Return an itimer object which can be used in either `delete-itimer'
  93 or `cancel-timer'."
  94         (apply #'start-itimer "run-at-time"
  95                function (if time (max time 1e-9) 1e-9)
  96                repeat nil t args))
  97     (lambda (time repeat function &rest args)
  98       "Function emulating the function of the same name of Emacs.
  99 It works correctly for TIME even if there is a bug in the XEmacs core.
 100 TIME should be nil meaning now, or a number of seconds from now.
 101 Return an itimer object which can be used in either `delete-itimer'
 102 or `cancel-timer'."
 103       (let ((itimers (list nil)))
 104         (setcar
 105          itimers
 106          (apply #'start-itimer "fixed-run-at-time"
 107                 (lambda (itimers repeat function &rest args)
 108                   (let ((itimer (car itimers)))
 109                     (if repeat
 110                         (progn
 111                           (set-itimer-function
 112                            itimer
 113                            (lambda (itimer repeat function &rest args)
 114                              (set-itimer-restart itimer repeat)
 115                              (set-itimer-function itimer function)
 116                              (set-itimer-function-arguments itimer args)
 117                              (apply function args)))
 118                           (set-itimer-function-arguments
 119                            itimer
 120                            (append (list itimer repeat function) args)))
 121                       (set-itimer-function
 122                        itimer
 123                        (lambda (itimer function &rest args)
 124                          (delete-itimer itimer)
 125                          (apply function args)))
 126                       (set-itimer-function-arguments
 127                        itimer
 128                        (append (list itimer function) args)))))
 129                 1e-9 (if time (max time 1e-9) 1e-9)
 130                 nil t itimers repeat function args))))))
 131
 132 (defcustom password-cache t
 133   "Whether to cache passwords."
 134   :group 'password
 135   :type 'boolean)
 136
 137 (defcustom password-cache-expiry 16
 138   "How many seconds passwords are cached, or nil to disable expiring.
 139 Whether passwords are cached at all is controlled by `password-cache'."
 140   :group 'password
 141   :type '(choice (const :tag "Never" nil)
 142                  (integer :tag "Seconds")))
 143
 144 (defvar password-data (make-vector 7 0))
 145
 146 (defun password-read (prompt &optional key)
 147   "Read password, for use with KEY, from user, or from cache if wanted.
 148 KEY indicate the purpose of the password, so the cache can
 149 separate passwords.  The cache is not used if KEY is nil.  It is
 150 typically a string.
 151 The variable `password-cache' control whether the cache is used."
 152   (or (and password-cache
 153            key
 154            (symbol-value (intern-soft key password-data)))
 155       (read-passwd prompt)))
 156
 157 (defun password-read-and-add (prompt &optional key)
 158   "Read password, for use with KEY, from user, or from cache if wanted.
 159 Then store the password in the cache.  Uses `password-read' and
 160 `password-cache-add'."
 161   (let ((password (password-read prompt key)))
 162     (when (and password key)
 163       (password-cache-add key password))
 164     password))
 165
 166 (defun password-cache-remove (key)
 167   "Remove password indexed by KEY from password cache.
 168 This is typically run be a timer setup from `password-cache-add',
 169 but can be invoked at any time to forcefully remove passwords
 170 from the cache.  This may be useful when it has been detected
 171 that a password is invalid, so that `password-read' query the
 172 user again."
 173   (let ((password (symbol-value (intern-soft key password-data))))
 174     (when password
 175       (fillarray password ?_)
 176       (unintern key password-data))))
 177
 178 (defun password-cache-add (key password)
 179   "Add password to cache.
 180 The password is removed by a timer after `password-cache-expiry'
 181 seconds."
 182   (set (intern key password-data) password)
 183   (when password-cache-expiry
 184     (password-run-at-time password-cache-expiry nil
 185                           #'password-cache-remove
 186                           key))
 187   nil)
 188
 189 (provide 'password)
 190
 191 ;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
 192 ;;; password.el ends here