X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=tm-pgp.el;h=cafdb9fe508bc4b9a6b7f84e70b4eaa2e51ee1c9;hb=a7388c9a369504a8de494bed38b72f386e5e004d;hp=4e8635e850d6f052ddcccbc5a9faf1d0219c4ba4;hpb=8ad5dcf75c50e1db649758764f802afef3e3bbd6;p=elisp%2Ftm.git diff --git a/tm-pgp.el b/tm-pgp.el index 4e8635e..cafdb9f 100644 --- a/tm-pgp.el +++ b/tm-pgp.el @@ -1,48 +1,64 @@ -;;; ;;; tm-pgp.el --- tm-view internal methods for PGP. -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; Maintainer: MORIOKA Tomohiko -;;; Created: 1995/12/7 -;;; Version: -;;; $Id: tm-pgp.el,v 7.18 1996/07/15 14:03:34 morioka Exp $ -;;; Keywords: mail, news, MIME, multimedia, PGP, security -;;; -;;; This file is part of tm (Tools for MIME). -;;; -;;; 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. -;;; -;;; 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. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; Created: 1995/12/7 +;; Version: $Id: tm-pgp.el,v 7.28 1997/01/29 15:18:53 morioka Exp $ +;; Keywords: mail, news, MIME, multimedia, PGP, security + +;; This file is part of tm (Tools for MIME). + +;; 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. + +;; 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. + +;; 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. + ;;; Commentary: -;;; This module is based on 2 drafts about PGP MIME integration: -;;; - draft-elkins-pem-pgp-02.txt -;;; ``MIME Security with Pretty Good Privacy (PGP)'' -;;; by Michael Elkins (1995/11) -;;; - draft-kazu-pgp-mime-00.txt -;;; ``PGP MIME Integration'' -;;; by Kazuhiko Yamamoto (1995/10) -;;; These drafts may be contrary to each other. You should decide -;;; which you support. -;;; + +;; This module is based on 2 drafts about PGP MIME integration: + +;; - RFC 2015: "MIME Security with Pretty Good Privacy (PGP)" +;; by Michael Elkins (1996/6) +;; +;; - draft-kazu-pgp-mime-00.txt: "PGP MIME Integration" +;; by Kazuhiko Yamamoto +;; (1995/10; expired) +;; +;; These drafts may be contrary to each other. You should decide +;; which you support. (Maybe you should use PGP/MIME) + ;;; Code: -(require 'mailcrypt) (require 'tm-play) +(defvar pgp-verify-function + 'mc-verify "*PGP verify function.") + +(defvar pgp-decrypt-function + 'mc-decrypt "*PGP decrypt function.") + +(defvar pgp-fetch-key-function + 'mc-pgp-fetch-key "*PGP fetch key function.") + +(defvar pgp-snarf-keys-function + 'mc-snarf-keys "*PGP snarf keys function.") + +(autoload pgp-verify-function "mc-toplev") +(autoload pgp-decrypt-function "mc-toplev") +(autoload pgp-fetch-key-function "mc-toplev") +(autoload pgp-snarf-keys-function "mc-toplev") + ;;; @ internal method for application/pgp ;;; @@ -54,8 +70,9 @@ (new-name (format "%s-%s" (buffer-name) cnum)) (mother mime::article/preview-buffer) (mode major-mode) - code-converter str) - (setq str (buffer-substring beg end)) + code-converter + (str (buffer-substring beg end)) + ) (switch-to-buffer new-name) (erase-buffer) (insert str) @@ -63,7 +80,7 @@ (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t) ) - (mc-verify) + (funcall pgp-verify-function) (goto-char (point-min)) (delete-region (point-min) @@ -89,13 +106,13 @@ (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t) ) - (as-binary-process (mc-decrypt)) + (as-binary-process (funcall pgp-decrypt-function)) (goto-char (point-min)) (delete-region (point-min) (and (search-forward "\n\n") (match-end 0))) - (setq code-converter (function mime-charset-decode-region)) + (setq code-converter (function mime-charset/decode-buffer)) )) (setq major-mode 'mime/show-message-mode) (setq mime::article/code-converter code-converter) @@ -115,30 +132,46 @@ ;;; @ Internal method for application/pgp-signature ;;; -;;; It is based on draft-elkins-pem-pgp-02.txt +;;; It is based on RFC 2015. + +(defvar tm-pgp::default-language 'en + "*Symbol of language for pgp. +It should be ISO 639 2 letter language code such as en, ja, ...") -(defvar tm-pgp::good-signature-regexp "Good signature from user.*$") +(defvar tm-pgp::good-signature-regexp-alist + '((en . "Good signature from user.*$")) + "Alist of language vs regexp to detect ``Good signature''.") -(defvar tm-pgp::key-expected-regexp - "Key matching expected Key ID \\(\\S +\\) not found") +(defvar tm-pgp::key-expected-regexp-alist + '((en . "Key matching expected Key ID \\(\\S +\\) not found")) + "Alist of language vs regexp to detect ``Key expected''.") (defun mime::article/call-pgp-to-check-signature (output-buffer orig-file) (save-excursion (set-buffer output-buffer) (erase-buffer) ) - (let ((status - (call-process-region (point-min)(point-max) - "pgp" nil output-buffer nil orig-file))) + (let* ((lang (or tm-pgp::default-language 'en)) + (status + (call-process-region (point-min)(point-max) + "pgp" nil output-buffer nil orig-file + (format "+language=%s" lang) + )) + (regexp (cdr (assq lang tm-pgp::good-signature-regexp-alist))) + ) (if (= status 0) (save-excursion (set-buffer output-buffer) (goto-char (point-min)) (message - (if (re-search-forward tm-pgp::good-signature-regexp nil t) - (buffer-substring (match-beginning 0) (match-end 0)) - "Bad signature" - )) + (cond ((not (stringp regexp)) + "Please specify right regexp for specified language") + ((re-search-forward regexp nil t) + (buffer-substring (match-beginning 0) (match-end 0)) + ) + (t + "Bad signature" + ))) )))) (defun mime-article/check-pgp-signature (beg end cal) @@ -168,15 +201,7 @@ (while (re-search-forward "\n" nil t) (replace-match "\r\n") ) - (let ((mc-flag nil) ; for Mule - (file-coding-system *noconv*) - kanji-flag ; for NEmacs - (emx-binary-mode t) ; for OS/2 - jka-compr-compression-info-list ; for jka-compr - jam-zcat-filename-list ; for jam-zcat - require-final-newline) - (write-file orig-file) - ) + (as-binary-output-file (write-file orig-file)) (kill-buffer (current-buffer)) ) (save-excursion @@ -192,33 +217,34 @@ (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name))) (insert str) (mime-decode-region (point-min)(point-max) encoding) - (let ((mc-flag nil) ; for Mule - (file-coding-system *noconv*) - kanji-flag ; for NEmacs - (emx-binary-mode t) ; for OS/2 - jka-compr-compression-info-list ; for jka-compr - jam-zcat-filename-list ; for jam-zcat - require-final-newline) - (write-file sig-file) - ) - ;;(get-buffer-create mime/output-buffer-name) + (as-binary-output-file (write-file sig-file)) (or (mime::article/call-pgp-to-check-signature mime/output-buffer-name orig-file) (let (pgp-id) (save-excursion (set-buffer mime/output-buffer-name) (goto-char (point-min)) - (if (re-search-forward tm-pgp::key-expected-regexp nil t) - (setq pgp-id - (concat "0x" (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))) - )) - (y-or-n-p - (format "Key %s not found; attempt to fetch? " pgp-id)) - (mc-pgp-fetch-key (cons nil pgp-id)) - (mime::article/call-pgp-to-check-signature - mime/output-buffer-name orig-file) + (let ((regexp (cdr (assq (or tm-pgp::default-language 'en) + tm-pgp::key-expected-regexp-alist)))) + (cond ((not (stringp regexp)) + (message + "Please specify right regexp for specified language") + ) + ((re-search-forward regexp nil t) + (setq pgp-id + (concat "0x" (buffer-substring-no-properties + (match-beginning 1) + (match-end 1)))) + )))) + (if (and pgp-id + (y-or-n-p + (format "Key %s not found; attempt to fetch? " pgp-id)) + ) + (progn + (funcall pgp-fetch-key-function (cons nil pgp-id)) + (mime::article/call-pgp-to-check-signature + mime/output-buffer-name orig-file) + )) )) (let ((other-window-scroll-buffer mime/output-buffer-name)) (scroll-other-window 8) @@ -236,7 +262,7 @@ ;;; @ Internal method for application/pgp-encrypted ;;; -;;; It is based on draft-elkins-pem-pgp-02.txt +;;; It is based on RFC 2015. (defun mime-article/decrypt-pgp (beg end cal) (let* ((cnum (mime-article/point-content-number beg)) @@ -262,9 +288,7 @@ ;;; @ Internal method for application/pgp-keys ;;; -;;; It is based on draft-elkins-pem-pgp-02.txt - -(autoload 'mc-snarf-keys "mc-toplev") +;;; It is based on RFC 2015. (defun mime-article/add-pgp-keys (beg end cal) (let* ((cnum (mime-article/point-content-number beg)) @@ -285,7 +309,7 @@ (delete-region (point-min) (match-end 0)) ) (mime-decode-region (point-min)(point-max) encoding) - (mc-snarf-keys) + (funcall pgp-snarf-keys-function) (kill-buffer (current-buffer)) )) @@ -300,4 +324,6 @@ (provide 'tm-pgp) +(run-hooks 'tm-pgp-load-hook) + ;;; tm-pgp.el ends here