X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fpgg.el;h=c9287ab8760edb77acd45be444c85e14d09c5704;hb=50dffefb002f44bbc1d0c1785d652801cddc0326;hp=9d1d46d0269ade8d7c09b4fd753cfa8ee9d1bbcc;hpb=f376dd28451d667df82a04d63b9a91b196265aec;p=gnus diff --git a/lisp/pgg.el b/lisp/pgg.el index 9d1d46d02..c9287ab87 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -1,53 +1,44 @@ ;;; pgg.el --- glue for the various PGP implementations. -;; Copyright (C) 1999,2000 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; Created: 1999/10/28 ;; Keywords: PGP -;; This file is part of SEMI (Secure Emacs MIME Interface). +;; This file is part of GNU Emacs. -;; This program 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. +;; 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. -;; This program is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; 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., 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: -;; ;;; Code: (require 'pgg-def) (require 'pgg-parse) +(require 'password) +;; Don't merge these two `eval-when-compile's. (eval-when-compile - (ignore-errors - (require 'w3) - (require 'url))) - -(defvar pgg-temporary-file-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/"))) + (require 'cl)) ;;; @ 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))) @@ -71,7 +62,8 @@ ,@body))) (defun pgg-temp-buffer-show-function (buffer) - (let ((window (split-window-vertically))) + (let ((window (or (get-buffer-window buffer 'visible) + (split-window-vertically)))) (set-window-buffer window buffer) (shrink-window-if-larger-than-buffer window))) @@ -87,36 +79,17 @@ (set-buffer standard-output) (insert-buffer-substring pgg-errors-buffer))))) -(defvar pgg-passphrase-cache-expiry 16) -(defvar pgg-passphrase-cache (make-vector 7 0)) - -(defvar pgg-read-passphrase nil) (defun pgg-read-passphrase (prompt &optional key) - (if (not pgg-read-passphrase) - (if (functionp 'read-passwd) - (setq pgg-read-passphrase 'read-passwd) - (if (load "passwd" t) - (setq pgg-read-passphrase 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pgg-read-passphrase 'ange-ftp-read-passwd)))) - (or (and pgg-cache-passphrase - key (setq key (pgg-truncate-key-identifier key)) - (symbol-value (intern-soft key pgg-passphrase-cache))) - (funcall pgg-read-passphrase prompt))) + (when pgg-cache-passphrase + (password-read prompt (setq key (pgg-truncate-key-identifier key))))) (defun pgg-add-passphrase-cache (key passphrase) - (setq key (pgg-truncate-key-identifier key)) - (set (intern key pgg-passphrase-cache) - passphrase) - (run-at-time pgg-passphrase-cache-expiry nil - #'pgg-remove-passphrase-cache - key)) + (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) - (let ((passphrase (symbol-value (intern-soft key pgg-passphrase-cache)))) - (when passphrase - (fillarray passphrase ?_) - (unintern key pgg-passphrase-cache)))) + (password-cache-remove key)) (defmacro pgg-convert-lbt-region (start end lbt) `(let ((pgg-conversion-end (set-marker (make-marker) ,end))) @@ -150,6 +123,19 @@ `(with-current-buffer pgg-output-buffer (if (zerop (buffer-size)) nil ,@body t))) +(defalias 'pgg-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) + (let ((file (expand-file-name + (make-temp-name prefix) + (if (fboundp 'temp-directory) + (temp-directory) + temporary-file-directory)))) + (if dir-flag + (make-directory file)) + file)))) + ;;; @ interface functions ;;; @@ -168,14 +154,42 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (pgg-display-output-buffer start end status)) status)) +;;;###autoload +(defun pgg-encrypt (rcpts &optional sign start end) + "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." + (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))) + (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." (interactive "r") - (let ((status - (pgg-save-coding-system start end - (pgg-invoke "decrypt-region" (or pgg-scheme pgg-default-scheme) - (point-min) (point-max))))) + (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))))) + (when (interactive-p) + (pgg-display-output-buffer start end status)) + status)) + +;;;###autoload +(defun pgg-decrypt (&optional start end) + "Decrypt the current buffer. +If optional arguments START and END are specified, only decrypt within +the region." + (interactive "") + (let* ((start (or start (point-min))) + (end (or end (point-max))) + (status (pgg-decrypt-region start end))) (when (interactive-p) (pgg-display-output-buffer start end status)) status)) @@ -184,7 +198,9 @@ If optional argument SIGN is non-nil, do a combined sign and encrypt." (defun pgg-sign-region (start end &optional cleartext) "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." +a detached signature. +If this function is called interactively, CLEARTEXT is enabled +and the the output is displayed." (interactive "r") (let ((status (pgg-save-coding-system start end (pgg-invoke "sign-region" (or pgg-scheme pgg-default-scheme) @@ -194,6 +210,23 @@ a detached signature." (pgg-display-output-buffer start end status)) status)) +;;;###autoload +(defun pgg-sign (&optional cleartext start end) + "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." + (interactive "") + (let* ((start (or start (point-min))) + (end (or end (point-max))) + (status (pgg-sign-region start end (or (interactive-p) cleartext)))) + (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. @@ -215,6 +248,7 @@ signer's public key from `pgg-default-keyserver-address'." (key (cdr (assq 'key-identifier packet))) status keyserver) (and (stringp key) + pgg-query-keyserver (setq key (concat "0x" (pgg-truncate-key-identifier key))) (null (pgg-lookup-key key)) (or fetch (interactive-p)) @@ -236,6 +270,28 @@ signer's public key from `pgg-default-keyserver-address'." pgg-errors-buffer))))) status)) +;;;###autoload +(defun pgg-verify (&optional signature fetch start end) + "Verify the current buffer. +If the optional argument SIGNATURE is non-nil, it is treated as +the detached signature of the current region. +If the optional argument FETCH is non-nil, we attempt to fetch the +signer's public key from `pgg-default-keyserver-address'. +If optional arguments START and END are specified, only verify data +within the region." + (interactive "") + (let* ((start (or start (point-min))) + (end (or end (point-max))) + (status (pgg-verify-region start end signature fetch))) + (when (interactive-p) + (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 (if status pgg-output-buffer + pgg-errors-buffer))))) + status)) + ;;;###autoload (defun pgg-insert-key () "Insert the ASCII armored public key." @@ -250,6 +306,12 @@ signer's public key from `pgg-default-keyserver-address'." (pgg-invoke "snarf-keys-region" (or pgg-scheme pgg-default-scheme) start end))) +;;;###autoload +(defun pgg-snarf-keys () + "Import public keys in the current buffer." + (interactive "") + (pgg-snarf-keys-region (point-min) (point-max))) + (defun pgg-lookup-key (string &optional type) (pgg-invoke "lookup-key" (or pgg-scheme pgg-default-scheme) string type)) @@ -257,7 +319,6 @@ signer's public key from `pgg-default-keyserver-address'." (defun pgg-insert-url-with-w3 (url) (ignore-errors - (require 'w3) (require 'url) (let (buffer-file-name) (url-insert-file-contents url)))) @@ -306,4 +367,5 @@ signer's public key from `pgg-default-keyserver-address'." (provide 'pgg) +;;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 ;;; pgg.el ends here