X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fpgg.el;h=f64c4084c5a6cd84fc93ad69acc4513d47ce0a74;hb=eecef83650f3311ef866414b7d22b8b82e8ad98a;hp=588665ce0ac7c036f63e2f85f2c6bec56fef6d7a;hpb=22819cb6e2e33b3541182eb8382536c9b3e9a3d9;p=gnus diff --git a/lisp/pgg.el b/lisp/pgg.el index 588665ce0..f64c4084c 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -1,17 +1,19 @@ ;;; pgg.el --- glue for the various PGP implementations. -;; Copyright (C) 1999, 2000, 2003, 2004, 2005 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Daiki Ueno +;; Symmetric encryption added by: Sascha Wilde ;; Created: 1999/10/28 ;; Keywords: PGP ;; 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 @@ -19,34 +21,104 @@ ;; 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 . ;;; 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 + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) (require 'cl)) -;; Fixme: This would be better done with an autoload for -;; `url-insert-file-contents', and the url stuff rationalized. -;; (`locate-library' can say whether the url code is available.) -(eval-when-compile - (ignore-errors - (require 'w3) - (require 'url))) ;;; @ utility functions ;;; -(defvar pgg-fetch-key-function (if (fboundp 'url-insert-file-contents) - (function pgg-fetch-key-with-w3))) +(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 @@ -76,29 +148,116 @@ (set-window-buffer window buffer) (shrink-window-if-larger-than-buffer window))) +;; XXX `pgg-display-output-buffer' is a horrible name for this function. +;; It should be something like `pgg-situate-output-or-display-error'. (defun pgg-display-output-buffer (start end status) + "Situate en/decryption results or pop up an error buffer. + +Text from START to END is replaced by contents of output buffer if STATUS +is true, or else the output buffer is displayed." (if status - (progn - (delete-region start end) - (insert-buffer-substring pgg-output-buffer) - (decode-coding-region start (point) buffer-file-coding-system)) - (let ((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))))) - -(defun pgg-read-passphrase (prompt &optional key) - (when pgg-cache-passphrase - (password-read prompt (setq key (pgg-truncate-key-identifier key))))) - -(defun pgg-add-passphrase-cache (key passphrase) - (let ((password-cache-expiry pgg-passphrase-cache-expiry)) - (password-cache-add (setq key (pgg-truncate-key-identifier key)) - passphrase))) - -(defun pgg-remove-passphrase-cache (key) - (password-cache-remove key)) + (pgg-situate-output start end) + (pgg-display-error-buffer))) + +(defun pgg-situate-output (start end) + "Place en/decryption result in place of current text from START to END." + (delete-region start end) + (insert-buffer-substring pgg-output-buffer) + (decode-coding-region start (point) buffer-file-coding-system)) + +(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))) + (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. + +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." + (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. + +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." + + (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. + +Truncate the key to 8 trailing characters unless NOTRUNCATE is true +\(default false). + +This is a no-op if there is not entry for KEY (eg, it's already expired. + +The memory for the passphrase is filled with underscores to clear any +references to it. + +Custom variables `pgg-cache-passphrase' and `pgg-passphrase-cache-expiry' +regulate cache behavior." + (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))) @@ -149,93 +308,156 @@ ;;; ;;;###autoload -(defun pgg-encrypt-region (start end rcpts &optional sign) +(defun pgg-encrypt-region (start end rcpts &optional sign passphrase) "Encrypt the current region between START and END for RCPTS. -If optional argument SIGN is non-nil, do a combined sign and encrypt." + +If optional argument SIGN is non-nil, do a combined sign and encrypt. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive (list (region-beginning)(region-end) (split-string (read-string "Recipients: ") "[ \t,]+"))) (let ((status (pgg-save-coding-system start end (pgg-invoke "encrypt-region" (or pgg-scheme pgg-default-scheme) - (point-min) (point-max) rcpts sign)))) + (point-min) (point-max) rcpts sign passphrase)))) + (when (interactive-p) + (pgg-display-output-buffer start end status)) + status)) + +;;;###autoload +(defun pgg-encrypt-symmetric-region (start end &optional passphrase) + "Encrypt the current region between START and END symmetric with passphrase. + +If optional PASSPHRASE is not specified, it will be obtained from the +cache or user." + (interactive "r") + (let ((status + (pgg-save-coding-system start end + (pgg-invoke "encrypt-symmetric-region" + (or pgg-scheme pgg-default-scheme) + (point-min) (point-max) passphrase)))) + (when (interactive-p) + (pgg-display-output-buffer start end status)) + status)) + +;;;###autoload +(defun pgg-encrypt-symmetric (&optional start end passphrase) + "Encrypt the current buffer using a symmetric, rather than key-pair, cipher. + +If optional arguments START and END are specified, only encrypt within +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." + (interactive) + (let* ((start (or start (point-min))) + (end (or end (point-max))) + (status (pgg-encrypt-symmetric-region start end passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-encrypt (rcpts &optional sign start end) +(defun pgg-encrypt (rcpts &optional sign start end passphrase) "Encrypt the current buffer for RCPTS. + If optional argument SIGN is non-nil, do a combined sign and encrypt. + If optional arguments START and END are specified, only encrypt within -the region." +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive (list (split-string (read-string "Recipients: ") "[ \t,]+"))) (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-encrypt-region start end rcpts sign))) + (status (pgg-encrypt-region start end rcpts sign passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-decrypt-region (start end) - "Decrypt the current region between START and END." +(defun pgg-decrypt-region (start end &optional passphrase) + "Decrypt the current region between START and END. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "r") (let* ((buf (current-buffer)) (status (pgg-save-coding-system start end (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) - (point-min) (point-max))))) + (point-min) (point-max) passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-decrypt (&optional start end) +(defun pgg-decrypt (&optional start end passphrase) "Decrypt the current buffer. + If optional arguments START and END are specified, only decrypt within -the region." +the region. + +If optional PASSPHRASE is not specified, it will be obtained from the +passphrase cache or user." (interactive "") (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-decrypt-region start end))) + (status (pgg-decrypt-region start end passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-sign-region (start end &optional cleartext) +(defun pgg-sign-region (start end &optional cleartext passphrase) "Make the signature from text between START and END. + 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." (interactive "r") (let ((status (pgg-save-coding-system start end (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme) (point-min) (point-max) - (or (interactive-p) cleartext))))) + (or (interactive-p) cleartext) + passphrase)))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) ;;;###autoload -(defun pgg-sign (&optional cleartext start end) +(defun pgg-sign (&optional cleartext start end passphrase) "Sign the current buffer. + If the optional argument CLEARTEXT is non-nil, it does not create a detached signature. + 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." (interactive "") (let* ((start (or start (point-min))) (end (or end (point-max))) - (status (pgg-sign-region start end (or (interactive-p) cleartext)))) + (status (pgg-sign-region start end + (or (interactive-p) cleartext) + passphrase))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) - + ;;;###autoload (defun pgg-verify-region (start end &optional signature fetch) "Verify the current region between START and END. @@ -249,8 +471,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))))))) @@ -266,7 +488,7 @@ signer's public key from `pgg-default-keyserver-address'." (or (cdr (assq 'preferred-key-server packet)) pgg-default-keyserver-address)) (pgg-fetch-key keyserver key)) - (setq status + (setq status (pgg-save-coding-system start end (pgg-invoke "verify-region" (or pgg-scheme pgg-default-scheme) (point-min) (point-max) signature))) @@ -376,5 +598,4 @@ within the region." (provide 'pgg) -;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 ;;; pgg.el ends here