cgit.sxemacs.org Git - gnus/blob - lisp/password.el

   1 ;;; password.el --- Read passwords from user, possibly using a password cache.
   2
   3 ;; Copyright (C) 1999, 2000, 2003 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 ;; (password-read "Password? " "test")
  40 ;; ;; No minibuffer prompt
  41 ;;  => "foo"
  42 ;;
  43 ;; (password-read "Password? " "test")
  44 ;; ;; No minibuffer prompt
  45 ;;  => "foo"
  46 ;;
  47 ;; ;; Wait `password-cache-expiry' seconds.
  48 ;;
  49 ;; (password-read "Password? " "test")
  50 ;; ;; Minibuffer prompt for password is back.
  51 ;;  => "foo"
  52
  53 ;;; Code:
  54
  55 (autoload 'run-at-time "timer")
  56
  57 (eval-when-compile
  58   (require 'cl))
  59
  60 (defcustom password-cache t
  61   "Whether to cache passwords."
  62   :group 'password
  63   :type 'boolean)
  64
  65 (defcustom password-cache-expiry 16
  66   "How many seconds passwords are cached, or nil to disable expiring.
  67 Whether passwords are cached at all is controlled by `password-cache'."
  68   :group 'password
  69   :type '(choice (const :tag "Never" nil)
  70                  (integer :tag "Seconds")))
  71
  72 (defvar password-data (make-vector 7 0))
  73
  74 (defun password-read (prompt &optional key)
  75   "Read password, for use with KEY, from user, or from cache if wanted.
  76 KEY indicate the purpose of the password, so the cache can
  77 separate passwords.  The cache is not used if KEY is nil.  It is
  78 typically a string.
  79 The variable `password-cache' control whether the cache is used."
  80   (or (and password-cache
  81            key
  82            (symbol-value (intern-soft key password-data)))
  83       (read-passwd prompt)))
  84
  85 (eval-when-compile
  86   (defvar itimer-process)
  87   (defvar itimer-timer)
  88   (autoload 'delete-itimer "itimer")
  89   (autoload 'itimer-driver-start "itimer")
  90   (autoload 'itimer-value "itimer")
  91   (autoload 'set-itimer-function "itimer")
  92   (autoload 'set-itimer-function-arguments "itimer")
  93   (autoload 'set-itimer-restart "itimer")
  94   (autoload 'start-itimer "itimer"))
  95
  96 (eval-and-compile
  97   (defalias
  98     'password-run-at-time
  99     (if (featurep 'xemacs)
 100         (if (condition-case nil
 101                 (progn
 102                   (unless (or itimer-process itimer-timer)
 103                     (itimer-driver-start))
 104                   ;; Check whether there is a bug to which the difference of
 105                   ;; the present time and the time when the itimer driver was
 106                   ;; woken up is subtracted from the initial itimer value.
 107                   (let* ((inhibit-quit t)
 108                          (ctime (current-time))
 109                          (itimer-timer-last-wakeup
 110                           (prog1
 111                               ctime
 112                             (setcar ctime (1- (car ctime)))))
 113                          (itimer-list nil)
 114                          (itimer (start-itimer "password-run-at-time" 'ignore 5)))
 115                     (sleep-for 0.1) ;; Accept the timeout interrupt.
 116                     (prog1
 117                         (> (itimer-value itimer) 0)
 118                       (delete-itimer itimer))))
 119               (error nil))
 120             (lambda (time repeat function &rest args)
 121               "Emulating function run as `run-at-time'.
 122 TIME should be nil meaning now, or a number of seconds from now.
 123 Return an itimer object which can be used in either `delete-itimer'
 124 or `cancel-timer'."
 125               (apply #'start-itimer "password-run-at-time"
 126                      function (if time (max time 1e-9) 1e-9)
 127                      repeat nil t args))
 128           (lambda (time repeat function &rest args)
 129             "Emulating function run as `run-at-time' in the right way.
 130 TIME should be nil meaning now, or a number of seconds from now.
 131 Return an itimer object which can be used in either `delete-itimer'
 132 or `cancel-timer'."
 133             (let ((itimers (list nil)))
 134               (setcar
 135                itimers
 136                (apply #'start-itimer "password-run-at-time"
 137                       (lambda (itimers repeat function &rest args)
 138                         (let ((itimer (car itimers)))
 139                           (if repeat
 140                               (progn
 141                                 (set-itimer-function
 142                                  itimer
 143                                  (lambda (itimer repeat function &rest args)
 144                                    (set-itimer-restart itimer repeat)
 145                                    (set-itimer-function itimer function)
 146                                    (set-itimer-function-arguments itimer args)
 147                                    (apply function args)))
 148                                 (set-itimer-function-arguments
 149                                  itimer
 150                                  (append (list itimer repeat function) args)))
 151                             (set-itimer-function
 152                              itimer
 153                              (lambda (itimer function &rest args)
 154                                (delete-itimer itimer)
 155                                (apply function args)))
 156                             (set-itimer-function-arguments
 157                              itimer
 158                              (append (list itimer function) args)))))
 159                       1e-9 (if time (max time 1e-9) 1e-9)
 160                       nil t itimers repeat function args)))))
 161       'run-at-time)))
 162
 163 (defun password-cache-remove (key)
 164   "Remove password indexed by KEY from password cache.
 165 This is typically run be a timer setup from `password-cache-add',
 166 but can be invoked at any time to forcefully remove passwords
 167 from the cache.  This may be useful when it has been detected
 168 that a password is invalid, so that `password-read' query the
 169 user again."
 170   (let ((password (symbol-value (intern-soft key password-data))))
 171     (when password
 172       (fillarray password ?_)
 173       (unintern key password-data))))
 174
 175 (defun password-cache-add (key password)
 176   "Add password to cache.
 177 The password is removed by a timer after `password-cache-expiry'
 178 seconds."
 179   (set (intern key password-data) password)
 180   (when password-cache-expiry
 181     (password-run-at-time password-cache-expiry nil
 182                           #'password-cache-remove
 183                           key))
 184   nil)
 185
 186 (provide 'password)
 187
 188 ;;; password.el ends here