X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fpgg.el;h=99294211e06c109d88d489259dc9e49bdbfc15f0;hb=c85ff27626350a909ee39474fecac012fec8cd26;hp=e76d04e0075317774133b4a7fdd1501add23a66b;hpb=b719a6d1d90bb76a5f2cb4072064606b9bc0ca06;p=gnus diff --git a/lisp/pgg.el b/lisp/pgg.el index e76d04e00..99294211e 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -1,19 +1,19 @@ ;;; pgg.el --- glue for the various PGP implementations. -;; Copyright (C) 1999, 2000, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 1999-2000, 2002-2011 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Symmetric encryption added by: Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP +;; Obsolete-since: 24.1 ;; 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 @@ -21,25 +21,101 @@ ;; 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. - -;;; Commentary: +;; along with GNU Emacs. If not, see . ;;; 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))) @@ -88,11 +164,19 @@ is true, or else the output buffer is displayed." (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. @@ -101,9 +185,21 @@ Truncate the key to 8 trailing characters unless NOTRUNCATE is true 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. @@ -113,11 +209,27 @@ Truncate the key to 8 trailing characters unless NOTRUNCATE is true 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. @@ -132,9 +244,16 @@ references to it. 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))) @@ -296,7 +415,7 @@ If the optional 3rd argument CLEARTEXT is non-nil, it does not create 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." @@ -305,7 +424,7 @@ 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)) @@ -321,7 +440,7 @@ If optional arguments START and END are specified, only sign data 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." @@ -329,8 +448,8 @@ 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)) @@ -348,8 +467,8 @@ signer's public key from `pgg-default-keyserver-address'." (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))))))) @@ -452,8 +571,7 @@ within the region." (defun pgg-fetch-key (keyserver key) "Attempt to fetch a KEY from KEYSERVER for addition to PGP or GnuPG keyring." - (with-current-buffer (let ((default-enable-multibyte-characters t)) - (get-buffer-create pgg-output-buffer)) + (with-current-buffer (get-buffer-create pgg-output-buffer) (buffer-disable-undo) (erase-buffer) (let ((proto (if (string-match "^[a-zA-Z\\+\\.\\\\-]+:" keyserver) @@ -476,5 +594,4 @@ within the region." (provide 'pgg) -;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 ;;; pgg.el ends here