Import No Gnus v0.4.
[elisp/gnus.git-] / lisp / pgg.el
index abb49a9..468fbc6 100644 (file)
@@ -1,8 +1,10 @@
 ;;; pgg.el --- glue for the various PGP implementations.
 
-;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
+;; Copyright (C) 1999, 2000, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
+;; Symmetric encryption added by: Sascha Wilde <wilde@sha-bang.de>
 ;; Created: 1999/10/28
 ;; Keywords: PGP
 
@@ -20,8 +22,8 @@
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 ;; Don't merge these two `eval-when-compile's.
 (eval-when-compile
   (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)))
-
 (defun pgg-invoke (func scheme &rest args)
   (progn
     (require (intern (format "pgg-%s" scheme)))
     (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)
+      (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))))
+
+(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."
+  (password-read prompt (if notruncate
+                           key
+                         (pgg-truncate-key-identifier key))))
+
+(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 ((password-cache-expiry pgg-passphrase-cache-expiry))
-    (password-cache-add (setq key (pgg-truncate-key-identifier key))
+    (password-cache-add (if notruncate
+                           key
+                         (pgg-truncate-key-identifier key))
                        passphrase)))
 
-(defun pgg-remove-passphrase-cache (key)
-  (password-cache-remove key))
+(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."
+  (password-cache-remove (if notruncate
+                            key
+                          (pgg-truncate-key-identifier key))))
 
 (defmacro pgg-convert-lbt-region (start end lbt)
   `(let ((pgg-conversion-end (set-marker (make-marker) ,end)))
 ;;;
 
 ;;;###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 (rcpts &optional sign start end)
+(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 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 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 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.
@@ -266,7 +365,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)))
@@ -298,7 +397,8 @@ within the region."
        (with-output-to-temp-buffer pgg-echo-buffer
          (set-buffer standard-output)
          (insert-buffer-substring (if status pgg-output-buffer
-                                    pgg-errors-buffer)))))))
+                                    pgg-errors-buffer)))))
+    status))
 
 ;;;###autoload
 (defun pgg-insert-key ()
@@ -327,7 +427,6 @@ within the region."
 
 (defun pgg-insert-url-with-w3 (url)
   (ignore-errors
-    (require 'w3)
     (require 'url)
     (let (buffer-file-name)
       (url-insert-file-contents url))))