tm-pgp.el

   1 ;;; tm-pgp.el --- tm-view internal methods for PGP.
   2
   3 ;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Created: 1995/12/7
   7 ;; Version: $Id: tm-pgp.el,v 7.28 1997/01/29 15:18:53 morioka Exp $
   8 ;; Keywords: mail, news, MIME, multimedia, PGP, security
   9
  10 ;; This file is part of tm (Tools for MIME).
  11
  12 ;; This program is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 2, or (at
  15 ;; your option) any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful, but
  18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;    This module is based on 2 drafts about PGP MIME integration:
  30
  31 ;;      - RFC 2015: "MIME Security with Pretty Good Privacy (PGP)"
  32 ;;              by Michael Elkins <elkins@aero.org> (1996/6)
  33 ;;
  34 ;;      - draft-kazu-pgp-mime-00.txt: "PGP MIME Integration"
  35 ;;              by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp>
  36 ;;                      (1995/10; expired)
  37 ;;
  38 ;;    These drafts may be contrary to each other.  You should decide
  39 ;;  which you support.  (Maybe you should use PGP/MIME)
  40
  41 ;;; Code:
  42
  43 (require 'tm-play)
  44
  45 (defvar pgp-verify-function
  46   'mc-verify "*PGP verify function.")
  47
  48 (defvar pgp-decrypt-function
  49   'mc-decrypt "*PGP decrypt function.")
  50
  51 (defvar pgp-fetch-key-function
  52   'mc-pgp-fetch-key "*PGP fetch key function.")
  53
  54 (defvar pgp-snarf-keys-function
  55   'mc-snarf-keys "*PGP snarf keys function.")
  56
  57 (autoload pgp-verify-function           "mc-toplev")
  58 (autoload pgp-decrypt-function          "mc-toplev")
  59 (autoload pgp-fetch-key-function        "mc-toplev")
  60 (autoload pgp-snarf-keys-function       "mc-toplev")
  61
  62
  63 ;;; @ internal method for application/pgp
  64 ;;;
  65 ;;; It is based on draft-kazu-pgp-mime-00.txt
  66
  67 (defun mime-article/view-application/pgp (beg end cal)
  68   (let* ((cnum (mime-article/point-content-number beg))
  69          (cur-buf (current-buffer))
  70          (new-name (format "%s-%s" (buffer-name) cnum))
  71          (mother mime::article/preview-buffer)
  72          (mode major-mode)
  73          code-converter
  74          (str (buffer-substring beg end))
  75          )
  76     (switch-to-buffer new-name)
  77     (erase-buffer)
  78     (insert str)
  79     (cond ((progn
  80              (goto-char (point-min))
  81              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)
  82              )
  83            (funcall pgp-verify-function)
  84            (goto-char (point-min))
  85            (delete-region
  86             (point-min)
  87             (and
  88              (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n")
  89              (match-end 0))
  90             )
  91            (delete-region
  92             (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+")
  93                  (match-beginning 0))
  94             (point-max)
  95             )
  96            (goto-char (point-min))
  97            (while (re-search-forward "^- -" nil t)
  98              (replace-match "-")
  99              )
 100            (setq code-converter
 101                  (or
 102                   (cdr (assq mode mime-viewer/code-converter-alist))
 103                   (function mime-viewer/default-code-convert-region)))
 104            )
 105           ((progn
 106              (goto-char (point-min))
 107              (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)
 108              )
 109            (as-binary-process (funcall pgp-decrypt-function))
 110            (goto-char (point-min))
 111            (delete-region (point-min)
 112                           (and
 113                            (search-forward "\n\n")
 114                            (match-end 0)))
 115            (setq code-converter (function mime-charset/decode-buffer))
 116            ))
 117     (setq major-mode 'mime/show-message-mode)
 118     (setq mime::article/code-converter code-converter)
 119     (mime/viewer-mode mother)
 120     ))
 121
 122 (set-atype 'mime/content-decoding-condition
 123            '((type . "application/pgp")
 124              (method . mime-article/view-application/pgp)
 125              ))
 126
 127 (set-atype 'mime/content-decoding-condition
 128            '((type . "text/x-pgp")
 129              (method . mime-article/view-application/pgp)
 130              ))
 131
 132
 133 ;;; @ Internal method for application/pgp-signature
 134 ;;;
 135 ;;; It is based on RFC 2015.
 136
 137 (defvar tm-pgp::default-language 'en
 138   "*Symbol of language for pgp.
 139 It should be ISO 639 2 letter language code such as en, ja, ...")
 140
 141 (defvar tm-pgp::good-signature-regexp-alist
 142   '((en . "Good signature from user.*$"))
 143   "Alist of language vs regexp to detect ``Good signature''.")
 144
 145 (defvar tm-pgp::key-expected-regexp-alist
 146   '((en . "Key matching expected Key ID \\(\\S +\\) not found"))
 147   "Alist of language vs regexp to detect ``Key expected''.")
 148
 149 (defun mime::article/call-pgp-to-check-signature (output-buffer orig-file)
 150   (save-excursion
 151     (set-buffer output-buffer)
 152     (erase-buffer)
 153     )
 154   (let* ((lang (or tm-pgp::default-language 'en))
 155          (status
 156           (call-process-region (point-min)(point-max)
 157                                "pgp" nil output-buffer nil orig-file
 158                                (format "+language=%s" lang)
 159                                ))
 160          (regexp (cdr (assq lang tm-pgp::good-signature-regexp-alist)))
 161          )
 162     (if (= status 0)
 163         (save-excursion
 164           (set-buffer output-buffer)
 165           (goto-char (point-min))
 166           (message
 167            (cond ((not (stringp regexp))
 168                   "Please specify right regexp for specified language")
 169                  ((re-search-forward regexp nil t)
 170                   (buffer-substring (match-beginning 0) (match-end 0))
 171                   )
 172                  (t
 173                   "Bad signature"
 174                   )))
 175           ))))
 176
 177 (defun mime-article/check-pgp-signature (beg end cal)
 178   (let* ((encoding (cdr (assq 'encoding cal)))
 179          (cnum (mime-article/point-content-number beg))
 180          (rcnum (reverse cnum))
 181          (rmcnum (cdr rcnum))
 182          (knum (car rcnum))
 183          (onum (if (> knum 0)
 184                    (1- knum)
 185                  (1+ knum)))
 186          (oinfo (mime-article/rcnum-to-cinfo (cons onum rmcnum)
 187                                              mime::article/content-info))
 188          status str kbuf
 189          (basename (expand-file-name "tm" mime/tmp-dir))
 190          (orig-file (make-temp-name basename))
 191          (sig-file (concat orig-file ".sig"))
 192          )
 193     (save-excursion
 194       (setq str (buffer-substring
 195                  (mime::content-info/point-min oinfo)
 196                  (mime::content-info/point-max oinfo)
 197                  ))
 198       (set-buffer (get-buffer-create mime/temp-buffer-name))
 199       (insert str)
 200       (goto-char (point-min))
 201       (while (re-search-forward "\n" nil t)
 202         (replace-match "\r\n")
 203         )
 204       (as-binary-output-file (write-file orig-file))
 205       (kill-buffer (current-buffer))
 206       )
 207     (save-excursion
 208       (mime-article/show-output-buffer)
 209       )
 210     (save-excursion
 211       (setq str (buffer-substring
 212                  (save-excursion
 213                    (goto-char beg)
 214                    (and (search-forward "\n\n")
 215                         (match-end 0)))
 216                  end))
 217       (set-buffer (setq kbuf (get-buffer-create mime/temp-buffer-name)))
 218       (insert str)
 219       (mime-decode-region (point-min)(point-max) encoding)
 220       (as-binary-output-file (write-file sig-file))
 221       (or (mime::article/call-pgp-to-check-signature
 222            mime/output-buffer-name orig-file)
 223           (let (pgp-id)
 224             (save-excursion
 225               (set-buffer mime/output-buffer-name)
 226               (goto-char (point-min))
 227               (let ((regexp (cdr (assq (or tm-pgp::default-language 'en)
 228                                        tm-pgp::key-expected-regexp-alist))))
 229                 (cond ((not (stringp regexp))
 230                        (message
 231                         "Please specify right regexp for specified language")
 232                        )
 233                       ((re-search-forward regexp nil t)
 234                        (setq pgp-id
 235                              (concat "0x" (buffer-substring-no-properties
 236                                            (match-beginning 1)
 237                                            (match-end 1))))
 238                        ))))
 239             (if (and pgp-id
 240                      (y-or-n-p
 241                       (format "Key %s not found; attempt to fetch? " pgp-id))
 242                      )
 243                 (progn
 244                   (funcall pgp-fetch-key-function (cons nil pgp-id))
 245                   (mime::article/call-pgp-to-check-signature
 246                    mime/output-buffer-name orig-file)
 247                   ))
 248             ))
 249       (let ((other-window-scroll-buffer mime/output-buffer-name))
 250         (scroll-other-window 8)
 251         )
 252       (kill-buffer kbuf)
 253       (delete-file orig-file)
 254       (delete-file sig-file)
 255       )))
 256
 257 (set-atype 'mime/content-decoding-condition
 258            '((type . "application/pgp-signature")
 259              (method . mime-article/check-pgp-signature)
 260              ))
 261
 262
 263 ;;; @ Internal method for application/pgp-encrypted
 264 ;;;
 265 ;;; It is based on RFC 2015.
 266
 267 (defun mime-article/decrypt-pgp (beg end cal)
 268   (let* ((cnum (mime-article/point-content-number beg))
 269          (rcnum (reverse cnum))
 270          (rmcnum (cdr rcnum))
 271          (knum (car rcnum))
 272          (onum (if (> knum 0)
 273                    (1- knum)
 274                  (1+ knum)))
 275          (oinfo (mime-article/rcnum-to-cinfo (cons onum rmcnum)
 276                                              mime::article/content-info))
 277          (obeg (mime::content-info/point-min oinfo))
 278          (oend (mime::content-info/point-max oinfo))
 279          )
 280     (mime-article/view-application/pgp obeg oend cal)
 281     ))
 282
 283 (set-atype 'mime/content-decoding-condition
 284            '((type . "application/pgp-encrypted")
 285              (method . mime-article/decrypt-pgp)
 286              ))
 287
 288
 289 ;;; @ Internal method for application/pgp-keys
 290 ;;;
 291 ;;; It is based on RFC 2015.
 292
 293 (defun mime-article/add-pgp-keys (beg end cal)
 294   (let* ((cnum (mime-article/point-content-number beg))
 295          (cur-buf (current-buffer))
 296          (new-name (format "%s-%s" (buffer-name) cnum))
 297          (mother mime::article/preview-buffer)
 298          (charset (cdr (assoc "charset" cal)))
 299          (encoding (cdr (assq 'encoding cal)))
 300          (mode major-mode)
 301          str)
 302     (setq str (buffer-substring beg end))
 303     (switch-to-buffer new-name)
 304     (setq buffer-read-only nil)
 305     (erase-buffer)
 306     (insert str)
 307     (goto-char (point-min))
 308     (if (re-search-forward "^\n" nil t)
 309         (delete-region (point-min) (match-end 0))
 310       )
 311     (mime-decode-region (point-min)(point-max) encoding)
 312     (funcall pgp-snarf-keys-function)
 313     (kill-buffer (current-buffer))
 314     ))
 315
 316 (set-atype 'mime/content-decoding-condition
 317            '((type . "application/pgp-keys")
 318              (method . mime-article/add-pgp-keys)
 319              ))
 320
 321
 322 ;;; @ end
 323 ;;;
 324
 325 (provide 'tm-pgp)
 326
 327 (run-hooks 'tm-pgp-load-hook)
 328
 329 ;;; tm-pgp.el ends here