From: yamaoka Date: Wed, 14 Apr 1999 07:40:30 +0000 (+0000) Subject: * mime-pgp.el (mime-pgp-fetch-key, mime-pgp-show-fetched-key-for-pgp, X-Git-Tag: semi-pgpgpg_09 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=ac7b98981306d342784491570ec4d14e87906dc8;p=elisp%2Fsemi.git * mime-pgp.el (mime-pgp-fetch-key, mime-pgp-show-fetched-key-for-pgp, mime-pgp-show-fetched-key-for-pgp50, mime-pgp-show-fetched-key-for-gpg): New functions. (mime-pgp-show-fetched-key): New macro. (mime-pgp-fetch-timeout, mime-pgp-http-proxy-server-port, mime-pgp-http-proxy-server-address, mime-pgp-http-proxy-url-template, mime-pgp-keyserver-port, mime-pgp-keyserver-address, mime-pgp-keyserver-url-template): New user options. (mime-pgp-key-expected-regexp-alist, mime-pgp-bad-signature-regexp-alist, mime-pgp-good-signature-regexp-alist, mime-pgp-default-language-alist, mime-pgp-command-alist): Change the customization group to `mime-pgp'. (mime-pgp): New group for customization. * mime-mc.el (mime-mc-pgp50-process-region, mime-mc-gpg-process-region): Deactivate passwd if detecting the value of `micalg' is failed and `mc-passwd-timeout' is nil; remove useless `progn's. (mime-mc-comment-alist, mime-mc-omit-micalg, mime-mc-shell-file-name): Change the customization group to `mime-mc'. (mime-mc): New group for customization. --- diff --git a/ChangeLog b/ChangeLog index 6eb18a0..d27de64 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,33 @@ 1999-04-14 Katsumi Yamaoka + * mime-pgp.el (mime-pgp-fetch-key, + mime-pgp-show-fetched-key-for-pgp, + mime-pgp-show-fetched-key-for-pgp50, + mime-pgp-show-fetched-key-for-gpg): New functions. + (mime-pgp-show-fetched-key): New macro. + (mime-pgp-fetch-timeout, mime-pgp-http-proxy-server-port, + mime-pgp-http-proxy-server-address, + mime-pgp-http-proxy-url-template, mime-pgp-keyserver-port, + mime-pgp-keyserver-address, mime-pgp-keyserver-url-template): New + user options. + (mime-pgp-key-expected-regexp-alist, + mime-pgp-bad-signature-regexp-alist, + mime-pgp-good-signature-regexp-alist, + mime-pgp-default-language-alist, mime-pgp-command-alist): Change + the customization group to `mime-pgp'. + (mime-pgp): New group for customization. + + * mime-mc.el (mime-mc-pgp50-process-region, + mime-mc-gpg-process-region): Deactivate passwd if detecting the + value of `micalg' is failed and `mc-passwd-timeout' is nil; remove + useless `progn's. + (mime-mc-comment-alist, mime-mc-omit-micalg, + mime-mc-shell-file-name): Change the customization group to + `mime-mc'. + (mime-mc): New group for customization. + +1999-04-14 Katsumi Yamaoka + * mime-mc.el (mime-mc-pgp50-sign-region, mime-mc-gpg-sign-region): Return nil if an erorr has occurred during detecting the value of `micalg'. diff --git a/mime-mc.el b/mime-mc.el index c645323..7835ae2 100644 --- a/mime-mc.el +++ b/mime-mc.el @@ -49,16 +49,21 @@ (mc-snarf-keys "mc-toplev") ))) +(defgroup mime-mc nil + "Mailcrypt interface for SEMI." + :prefix "mime-mc-" + :group 'mime) + (defcustom mime-mc-shell-file-name "/bin/sh" "File name to load inferior shells from. Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." - :group 'mime + :group 'mime-mc :type 'file) (defcustom mime-mc-omit-micalg nil "Non-nil value means to omit the micalg parameter for multipart/signed. See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information." - :group 'mime + :group 'mime-mc :type 'boolean) (defcustom mime-mc-comment-alist @@ -79,7 +84,7 @@ See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information." (cons 'pgp string))) "Alist of the schemes and strings of the comment field to appear in ASCII armor output." - :group 'mime + :group 'mime-mc :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -238,9 +243,8 @@ optional argument COMMENT if it is specified." (make-temp-name (expand-file-name "mailcrypt-gpg-status-" mc-temp-directory))) (unwind-protect - (progn - ;; Returns non-nil if success, otherwise nil with error message. - (catch 'mime-mc-gpg-process-region-done + (catch ;; Returns non-nil if success, otherwise nil with error message. + 'mime-mc-gpg-process-region-done ;; get output places ready (setq mybuf (get-buffer-create " *mailcrypt stdout temp")) @@ -375,7 +379,7 @@ Content-Transfer-Encoding: 7bit ;; return result (cdr parser-result) - )) + ) ;; cleanup forms (if (and proc (eq 'run (process-status proc))) ;; it is still running. kill it. @@ -448,6 +452,7 @@ Content-Transfer-Encoding: 7bit ) (set-alist 'mime-mc-micalg-alist (cdr key) micalg) ) + (or mc-passwd-timeout (mc-deactivate-passwd t)) )) ))) (if (or mime-mc-omit-micalg micalg) @@ -508,9 +513,8 @@ optional argument COMMENT if it is specified." (setq args (cons "+comment=DUMMY" args)) ) (unwind-protect - (progn - ;; Returns non-nil if success, otherwise nil with error message. - (catch 'mime-mc-pgp50-process-region-done + (catch ;; Returns non-nil if success, otherwise nil with error message. + 'mime-mc-pgp50-process-region-done (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp"))) (set-buffer mybuf) @@ -576,7 +580,7 @@ Content-Transfer-Encoding: 7bit (delete-region (car rgn) (cdr rgn)))) ;; Return nil on failure and exit code on success - (if rgn result nil))) + (if rgn result nil)) ;; Cleanup even on nonlocal exit (if (and proc (eq 'run (process-status proc))) @@ -736,6 +740,7 @@ Content-Transfer-Encoding: 7bit (setq micalg (downcase (or (std11-fetch-field "Hash") "md5"))) (set-alist 'mime-mc-micalg-alist (cdr key) micalg) ) + (or mc-passwd-timeout (mc-deactivate-passwd t)) )) ) (if (or mime-mc-omit-micalg micalg) diff --git a/mime-pgp.el b/mime-pgp.el index 956801f..115e9e7 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -52,6 +52,10 @@ (require 'semi-def) (require 'mime-play) +(defgroup mime-pgp nil + "Internal methods for either PGP or GnuPG." + :prefix "mime-pgp-" + :group 'mime) ;;; @ Internal method for multipart/signed ;;; @@ -124,7 +128,6 @@ ;;; It is based on RFC 2015 (PGP/MIME) and ;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME). - (defcustom mime-pgp-command-alist '((gpg . "gpg") (pgp50 . "pgp") (pgp . "pgp")) @@ -136,7 +139,7 @@ COMMAND for `pgp50' must *NOT* have a suffix, like neither \"pgpe\", \"pgpk\", \"pgps\" nor \"pgpv\"." - :group 'mime + :group 'mime-pgp :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -149,7 +152,7 @@ COMMAND for `pgp50' must *NOT* have a suffix, like neither \"pgpe\", \"pgpk\", "Alist of the schemes and the symbol of languages. It should be ISO 639 2 letter language code such as en, ja, ... Each element looks like \(SCHEME . SYMBOL). See also `mime-pgp-command-alist' for valid SCHEMEs." - :group 'mime + :group 'mime-pgp :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -172,7 +175,7 @@ detecting ``Good signature''. The optional symbol of the post processing function for arranging the output message can be specified in each element. It will be called just after re-search is done successfully, and it is expected that the function returns a string for messaging." - :group 'mime + :group 'mime-pgp :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -198,7 +201,7 @@ detecting ``BAD signature''. The optional symbol of the post processing function for arranging the output message can be specified in each element. It will be called just after re-search is done successfully, and it is expected that the function returns a string for messaging." - :group 'mime + :group 'mime-pgp :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -222,7 +225,7 @@ expected that the function returns a string for messaging." )) "Alist of the schemes and alist of the languages and regexps for detecting ``Key expected''." - :group 'mime + :group 'mime-pgp :type '(repeat (cons :format "%v" (choice (choice-item :tag "GnuPG" gpg) (choice-item :tag "PGP 5.0i" pgp50) @@ -508,6 +511,221 @@ key-ID if it is found." )) +;;; @ Internal method for fetching a public key +;;; + +(defcustom mime-pgp-keyserver-url-template "/pks/lookup?op=get&search=%s" + "The URL to pass to the keyserver." + :group 'mime-pgp + :type 'string) + +(defcustom mime-pgp-keyserver-address "pgp.nic.ad.jp" + "Host name of keyserver." + :group 'mime-pgp + :type 'string) + +(defcustom mime-pgp-keyserver-port 11371 + "Port on which the keyserver's HTTP daemon lives." + :group 'mime-pgp + :type 'integer) + +(defcustom mime-pgp-http-proxy-url-template + "/cgi-bin/pgpsearchkey.pl?op=get&search=%s" + "The URL to pass to the keyserver via HTTP proxy." + :group 'mime-pgp + :type 'string) + +(defcustom mime-pgp-http-proxy-server-address nil + "Host name of HTTP proxy server. If you are behind firewalls, set the +values of this variable and `mime-pgp-http-proxy-server-port' appropriately." + :group 'mime-pgp + :type 'string) + +(defcustom mime-pgp-http-proxy-server-port 8080 + "Port on which the proxy server's HTTP daemon lives." + :group 'mime-pgp + :type 'integer) + +(defcustom mime-pgp-fetch-timeout 20 + "Timeout, in seconds, for any particular key fetch operation." + :group 'mime-pgp + :type 'integer) + +(defmacro mime-pgp-show-fetched-key (key scroll &rest args) + (` (let ((buffer (get-buffer-create "*fetched keys*")) + start) + (with-current-buffer buffer + (erase-buffer) + (insert (, key)) + (as-binary-process + (call-process-region + (point-min) (point-max) (mime-pgp-command 'v) t t (,@ args)) + ) + (goto-char (point-min)) + (forward-line (, scroll)) + (setq start (point)) + ) + (display-buffer buffer) + (set-window-start (get-buffer-window buffer) start) + ))) + +(defun mime-pgp-show-fetched-key-for-gpg (key) + (mime-pgp-show-fetched-key key 0) + ) + +(defun mime-pgp-show-fetched-key-for-pgp50 (key) + (let ((buffer (get-buffer-create "*fetched keys*")) + (process-environment process-environment) + process-connection-type process start) + (setenv "PGPPASSFD" nil) + (with-current-buffer buffer + (erase-buffer) + (setq process + (start-process "*show fetched keys*" + buffer (mime-pgp-command 'v) + "-f" "+batchmode=0" "+language=us") + ) + (set-process-coding-system process 'binary 'binary) + (process-send-string process key) + (process-send-eof process) + (while + (progn + (accept-process-output process 1) + (goto-char (point-min)) + (not + (re-search-forward + "^Add these keys to your keyring\\? \\[Y/n\\] " + nil t)) + )) + (delete-process process) + (goto-char (point-min)) + (forward-line 10) + (setq start (point)) + ) + (display-buffer buffer) + (set-window-start (get-buffer-window buffer) start) + )) + +(defun mime-pgp-show-fetched-key-for-pgp (key) + (mime-pgp-show-fetched-key key 7 "-f" "+language=en") + ) + +(defun mime-pgp-fetch-key (&optional id) + "Attempt to fetch a key via HTTP for addition to PGP or GnuPG keyring. +Interactively, prompt for string matching key to fetch. + +Non-interactively, ID must be a pair. The CAR must be a bare Email +address and the CDR a keyID (with \"0x\" prefix). Either, but not +both, may be nil. + +Return t if we think we were successful; nil otherwise. Note that nil +is not necessarily an error, since we may have merely fired off an Email +request for the key. + +If you want to use this function for verifying a message of PGP/MIME, +for example, please put the following lines in your startup file: + + (eval-after-load \"semi-def\" + '(progn (require 'alist) + (set-alist 'pgp-function-alist 'fetch-key + '(mime-pgp-fetch-key \"mime-pgp\")) + (autoload 'mime-pgp-fetch-key \"mime-pgp\" nil t) + )) + +In addition, if you are behind firewalls, please set the values of +`mime-pgp-http-proxy-server-address' and `mime-pgp-http-proxy-server-port' +appropriately." + (interactive) + (let ((buffer (get-buffer-create "*key fetch*")) + (server (or mime-pgp-http-proxy-server-address + mime-pgp-keyserver-address)) + (port (or mime-pgp-http-proxy-server-port + mime-pgp-keyserver-port)) + (url-template + (if mime-pgp-http-proxy-server-address + (concat "http://" + mime-pgp-keyserver-address + mime-pgp-http-proxy-url-template + " HTTP/1.0\r\n") + mime-pgp-keyserver-url-template)) + (show-function (intern (format "mime-pgp-show-fetched-key-for-%s" + pgp-version))) + (snarf-function (pgp-function 'snarf-keys)) + (window-config (current-window-configuration)) + case-fold-search process-connection-type process) + (unwind-protect + (catch 'mime-pgp-fetch-key-done + (cond ((interactive-p) + (setq id (read-string "Fetch key for: ")) + (cond ((string-equal "" id) + (message "Aborted") + (throw 'mime-pgp-fetch-key-done nil) + ) + ((string-match "^0[Xx]" id) + (setq id (cons nil id)) + ) + (t + (setq id (cons id nil)) + ))) + ((or (null id) + (not (or (stringp (car id)) (stringp (cdr id))))) + (message "Aborted") + (throw 'mime-pgp-fetch-key-done nil) + )) + (with-current-buffer buffer + (erase-buffer) + (message "Fetching %s via HTTP to %s..." + (or (cdr id) (car id)) + mime-pgp-keyserver-address + ) + (condition-case err + (setq process (open-network-stream-as-binary + "*key fetch*" buffer server port) + ) + (error + (message "%s" err) + (throw 'mime-pgp-fetch-key-done nil) + )) + (if (not process) + (progn + (message "Can't connect to %s%s." + mime-pgp-keyserver-address + (if mime-pgp-http-proxy-server-address + (concat "via " + mime-pgp-http-proxy-server-address) + "")) + (throw 'mime-pgp-fetch-key-done nil) + ) + (process-send-string + process + (concat "GET " (format url-template + (or (cdr id) (car id))) "\r\n") + ) + (while (and (eq 'open (process-status process)) + (accept-process-output process + mime-pgp-fetch-timeout) + )) + (delete-process process) + (goto-char (point-min)) + (if (and (re-search-forward + "^-----BEGIN PGP PUBLIC KEY BLOCK-----\r?$" nil t) + (progn + (delete-region (point-min) (match-beginning 0)) + (re-search-forward + "^-----END PGP PUBLIC KEY BLOCK-----\r?$" nil t) + )) + (progn + (delete-region (1+ (match-end 0)) (point-max)) + (funcall show-function (buffer-string)) + (if (y-or-n-p "Add this key to keyring? ") + (funcall snarf-function) + )) + (message "Key not found.") + nil)))) + (set-window-configuration window-config) + ))) + + ;;; @ end ;;;