;;; pgg.el --- glue for the various PGP implementations.
;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
-;; 2005, 2006 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@unixuser.org>
;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs 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.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+;; This file is on its way to obsolescence, waiting for allout.el to
+;; switch to EPG.
+
;;; Code:
(require 'pgg-def)
(require 'pgg-parse)
-(require 'password)
+(autoload 'run-at-time "timer")
;; Don't merge these two `eval-when-compile's.
(eval-when-compile
+ ;; For Emacs <22.2 and XEmacs.
+ (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(require 'cl))
;;; @ utility functions
;;;
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (defmacro pgg-run-at-time-1 (time repeat function args)
+ (if (condition-case nil
+ (let ((delete-itimer 'delete-itimer)
+ (itimer-driver-start 'itimer-driver-start)
+ (itimer-value 'itimer-value)
+ (start-itimer 'start-itimer))
+ (unless (or (symbol-value 'itimer-process)
+ (symbol-value 'itimer-timer))
+ (funcall itimer-driver-start))
+ ;; Check whether there is a bug to which the difference of
+ ;; the present time and the time when the itimer driver was
+ ;; woken up is subtracted from the initial itimer value.
+ (let* ((inhibit-quit t)
+ (ctime (current-time))
+ (itimer-timer-last-wakeup
+ (prog1
+ ctime
+ (setcar ctime (1- (car ctime)))))
+ (itimer-list nil)
+ (itimer (funcall start-itimer "pgg-run-at-time"
+ 'ignore 5)))
+ (sleep-for 0.1) ;; Accept the timeout interrupt.
+ (prog1
+ (> (funcall itimer-value itimer) 0)
+ (funcall delete-itimer itimer))))
+ (error nil))
+ `(let ((time ,time))
+ (apply #'start-itimer "pgg-run-at-time"
+ ,function (if time (max time 1e-9) 1e-9)
+ ,repeat nil t ,args))
+ `(let ((time ,time)
+ (itimers (list nil)))
+ (setcar
+ itimers
+ (apply #'start-itimer "pgg-run-at-time"
+ (lambda (itimers repeat function &rest args)
+ (let ((itimer (car itimers)))
+ (if repeat
+ (progn
+ (set-itimer-function
+ itimer
+ (lambda (itimer repeat function &rest args)
+ (set-itimer-restart itimer repeat)
+ (set-itimer-function itimer function)
+ (set-itimer-function-arguments itimer args)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer repeat function) args)))
+ (set-itimer-function
+ itimer
+ (lambda (itimer function &rest args)
+ (delete-itimer itimer)
+ (apply function args)))
+ (set-itimer-function-arguments
+ itimer
+ (append (list itimer function) args)))))
+ 1e-9 (if time (max time 1e-9) 1e-9)
+ nil t itimers ,repeat ,function ,args)))))))
+
+(eval-and-compile
+ (if (featurep 'xemacs)
+ (progn
+ (defun pgg-run-at-time (time repeat function &rest args)
+ "Emulating function run as `run-at-time'.
+TIME should be nil meaning now, or a number of seconds from now.
+Return an itimer object which can be used in either `delete-itimer'
+or `cancel-timer'."
+ (pgg-run-at-time-1 time repeat function args))
+ (defun pgg-cancel-timer (timer)
+ "Emulate cancel-timer for xemacs."
+ (let ((delete-itimer 'delete-itimer))
+ (funcall delete-itimer timer))))
+ (defalias 'pgg-run-at-time 'run-at-time)
+ (defalias 'pgg-cancel-timer 'cancel-timer)))
+
(defun pgg-invoke (func scheme &rest args)
(progn
(require (intern (format "pgg-%s" scheme)))
(defun pgg-display-error-buffer ()
"Pop up an error buffer indicating the reason for an en/decryption failure."
(let ((temp-buffer-show-function
- (function pgg-temp-buffer-show-function)))
+ (function pgg-temp-buffer-show-function)))
(with-output-to-temp-buffer pgg-echo-buffer
(set-buffer standard-output)
(insert-buffer-substring pgg-errors-buffer))))
+(defvar pgg-passphrase-cache (make-vector 7 0))
+
+(defvar pgg-pending-timers (make-vector 7 0)
+ "Hash table for managing scheduled pgg cache management timers.
+
+We associate key and timer, so the timer can be cancelled if a new
+timeout for the key is set while an old one is still pending.")
+
(defun pgg-read-passphrase (prompt &optional key notruncate)
"Using PROMPT, obtain passphrase for KEY from cache or user.
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
- (password-read prompt (if notruncate
- key
- (pgg-truncate-key-identifier key))))
+ (or (pgg-read-passphrase-from-cache key notruncate)
+ (read-passwd prompt)))
+
+(defun pgg-read-passphrase-from-cache (key &optional notruncate)
+ "Obtain passphrase for KEY from time-limited passphrase cache.
+
+Truncate the key to 8 trailing characters unless NOTRUNCATE is true
+\(default false).
+
+Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
+regulate cache behavior."
+ (and pgg-cache-passphrase
+ key (or notruncate
+ (setq key (pgg-truncate-key-identifier key)))
+ (symbol-value (intern-soft key pgg-passphrase-cache))))
(defun pgg-add-passphrase-to-cache (key passphrase &optional notruncate)
"Associate KEY with PASSPHRASE in time-limited passphrase cache.
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
- (let ((password-cache-expiry pgg-passphrase-cache-expiry))
- (password-cache-add (if notruncate
- key
- (pgg-truncate-key-identifier key))
- passphrase)))
+
+ (let* ((key (if notruncate key (pgg-truncate-key-identifier key)))
+ (interned-timer-key (intern-soft key pgg-pending-timers))
+ (old-timer (symbol-value interned-timer-key))
+ new-timer)
+ (when old-timer
+ (cancel-timer old-timer)
+ (unintern interned-timer-key pgg-pending-timers))
+ (set (intern key pgg-passphrase-cache)
+ passphrase)
+ (set (intern key pgg-pending-timers)
+ (pgg-run-at-time pgg-passphrase-cache-expiry nil
+ #'pgg-remove-passphrase-from-cache
+ key notruncate))))
+
+(if (fboundp 'clear-string)
+ (defalias 'pgg-clear-string 'clear-string)
+ (defun pgg-clear-string (string)
+ (fillarray string ?_)))
+
+(declare-function pgg-clear-string "pgg" (string))
(defun pgg-remove-passphrase-from-cache (key &optional notruncate)
"Omit passphrase associated with KEY in time-limited passphrase cache.
Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry'
regulate cache behavior."
- (password-cache-remove (if notruncate
- key
- (pgg-truncate-key-identifier key))))
+ (let* ((passphrase (pgg-read-passphrase-from-cache key notruncate))
+ (key (if notruncate key (pgg-truncate-key-identifier key)))
+ (interned-timer-key (intern-soft key pgg-pending-timers))
+ (old-timer (symbol-value interned-timer-key)))
+ (when passphrase
+ (pgg-clear-string passphrase)
+ (unintern key pgg-passphrase-cache))
+ (when old-timer
+ (pgg-cancel-timer old-timer)
+ (unintern interned-timer-key pgg-pending-timers))))
(defmacro pgg-convert-lbt-region (start end lbt)
`(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
a detached signature.
If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed.
+and the output is displayed.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme)
(point-min) (point-max)
(or (interactive-p) cleartext)
- passphrase))))
+ passphrase))))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
within the region.
If this function is called interactively, CLEARTEXT is enabled
-and the the output is displayed.
+and the output is displayed.
If optional PASSPHRASE is not specified, it will be obtained from the
passphrase cache or user."
(let* ((start (or start (point-min)))
(end (or end (point-max)))
(status (pgg-sign-region start end
- (or (interactive-p) cleartext)
- passphrase)))
+ (or (interactive-p) cleartext)
+ passphrase)))
(when (interactive-p)
(pgg-display-output-buffer start end status))
status))
(if (null signature) nil
(with-temp-buffer
(buffer-disable-undo)
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
+ (unless (featurep 'xemacs)
+ (set-buffer-multibyte nil))
(insert-file-contents signature)
(cdr (assq 2 (pgg-decode-armor-region
(point-min)(point-max)))))))
(provide 'pgg)
-;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4
;;; pgg.el ends here
projects / gnus / blobdiff