1 ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
2 ;; Copyright (C) 2000 Free Software Foundation, Inc.
4 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
5 ;; Keywords: PGP MIME MML
7 ;; This file is part of GNU Emacs.
9 ;; GNU Emacs is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published
11 ;; by the Free Software Foundation; either version 2, or (at your
12 ;; option) any later version.
14 ;; GNU Emacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 ;; Boston, MA 02111-1307, USA.
26 ;; Installation: put the following statements in ~/.gnus:
28 ;; (require 'gnus-art)
30 ;; You may have to make sure that the directory where this file lives
31 ;; is mentioned in `load-path'.
33 ;; Insert an attribute, postprocess=pgp-sign (or pgp-encrypt), into
34 ;; the mml tag to be signed (or encrypted).
38 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
39 (defvar mml2015-verify-function 'mailcrypt-verify)
40 (defvar mml2015-encrypt-function 'mml2015-mailcrypt-encrypt)
41 (defvar mml2015-sign-function 'mml2015-mailcrypt-sign)
44 (defun mml2015-decrypt (handle)
47 ((setq child (mm-find-part-by-type (cdr handle)
48 "application/octet-stream"))
51 (mm-insert-part child)
52 (setq result (funcall mml2015-decrypt-function))
54 (error "Decrypting error."))
55 (setq handles (mm-dissect-buffer t)))
56 (setq gnus-article-mime-handles
57 (append (if (listp (car gnus-article-mime-handles))
58 gnus-article-mime-handles
59 (list gnus-article-mime-handles))
60 (if (listp (car handles))
63 (gnus-mime-display-part handles)))
65 (if (y-or-n-p "Corrupted pgp-encrypted part. Abort?" )
66 (error "Corrupted pgp-encrypted part.")
67 (gnus-mime-display-mixed (cdr handle)))))))
70 (defun mml2015-verify (handle)
71 ;; FIXME: mm-dissect-buffer loses information of micalg and the
72 ;; original header of signed part.
73 (if (y-or-n-p "Verify signed part?" )
74 (let (child result hash)
76 (unless (setq child (mm-find-part-by-type
77 (cdr handle) "application/pgp-signature" t))
78 (error "Corrupted pgp-signature part."))
79 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
80 (insert (format "Hash: %s\n\n" (read-string "Hash: " "SHA1")))
81 (mm-insert-part child)
82 (goto-char (point-max))
85 (unless (setq child (mm-find-part-by-type
86 (cdr handle) "application/pgp-signature"))
87 (error "Corrupted pgp-signature part."))
88 (mm-insert-part child)
89 (setq result (funcall mml2015-verify-function))
91 (error "Verify error.")))))
92 (gnus-mime-display-part
94 (cdr handle) "application/pgp-signature" t)))
96 (defvar mml2015-mailcrypt-prefix 0)
98 (defun mml2015-mailcrypt-sign (cont)
99 (mailcrypt-sign mml2015-mailcrypt-prefix)
101 (funcall mml-boundary-function (incf mml-multipart-number)))
102 (scheme-alist (funcall (or mc-default-scheme
103 (cdr (car mc-schemes)))))
105 (goto-char (point-min))
106 (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist)))
107 (error "Cannot find signed begin line." ))
108 (goto-char (match-beginning 0))
110 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
111 (error "Cannot not find PGP hash." ))
112 (setq hash (match-string 1))
113 (unless (re-search-forward "^$" nil t)
114 (error "Cannot not find PGP message." ))
116 (delete-region (point-min) (point))
117 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
119 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
122 (insert (format "--%s\n" boundary))
123 (unless (re-search-forward (cdr (assq 'signed-end-line scheme-alist)))
124 (error "Cannot find signature part." ))
125 (goto-char (match-beginning 0))
126 (unless (re-search-backward "^-+BEGIN" nil t)
127 (error "Cannot find signature part." ))
128 (goto-char (match-beginning 0))
129 (insert (format "--%s\n" boundary))
130 (insert "Content-Type: application/pgp-signature\n\n")
131 (goto-char (point-max))
132 (insert (format "--%s--\n" boundary))
133 (goto-char (point-max))))
135 (defun mml2015-mailcrypt-encrypt (cont)
138 (or (message-options-get 'message-recipients)
139 (message-options-set 'message-recipients
140 (mc-cleanup-recipient-headers
141 (read-string "Recipients: ")))))
143 (funcall mml-boundary-function (incf mml-multipart-number))))
144 (goto-char (point-min))
145 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
147 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
148 (insert (format "--%s\n" boundary))
149 (insert "Content-Type: application/pgp-encrypted\n\n")
150 (insert "Version: 1\n\n")
151 (insert (format "--%s\n" boundary))
152 (insert "Content-Type: application/octet-stream\n\n")
153 (goto-char (point-max))
154 (insert (format "--%s--\n" boundary))
155 (goto-char (point-max))))
158 (defun mml2015-encrypt (cont)
159 (funcall mml2015-encrypt-function cont))
162 (defun mml2015-sign (cont)
163 (funcall mml2015-sign-function cont))
166 (defun mml2015-setup ()
167 ;;(push '("multipart/signed" . mml2015-verify) gnus-mime-multipart-functions)
168 (push '("multipart/encrypted" . mml2015-decrypt)
169 gnus-mime-multipart-functions))
173 ;;; mml2015.el ends here