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.
28 (eval-when-compile (require 'cl))
31 (defvar mml2015-decrypt-function 'mailcrypt-decrypt)
32 (defvar mml2015-verify-function 'mailcrypt-verify)
33 (defvar mml2015-encrypt-function 'mml2015-mailcrypt-encrypt)
34 (defvar mml2015-sign-function 'mml2015-mailcrypt-sign)
37 (defun mml2015-decrypt (handle ctl)
38 (let (child handles result)
39 (unless (setq child (mm-find-part-by-type (cdr handle)
40 "application/octet-stream"))
41 (error "Corrupted pgp-encrypted part."))
43 (mm-insert-part child)
44 (setq result (funcall mml2015-decrypt-function))
46 (error "Decrypting error."))
47 (setq handles (mm-dissect-buffer t)))
48 (mm-destroy-parts handle)
49 (if (listp (car handles))
53 (defun mml2015-fix-micalg (alg)
55 (if (and alg (string-match "^pgp-" alg))
56 (substring alg (match-end 0))
60 (defun mml2015-verify (handle ctl)
62 (unless (setq part (mm-find-raw-part-by-type
63 ctl "application/pgp-signature" t))
64 (error "Corrupted pgp-signature part."))
66 (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
67 (insert (format "Hash: %s\n\n"
68 (or (mml2015-fix-micalg
69 (mail-content-type-get ctl 'micalg))
72 (goto-char (point-max))
73 (unless (setq part (mm-find-part-by-type
74 (cdr handle) "application/pgp-signature"))
75 (error "Corrupted pgp-signature part."))
77 (unless (funcall mml2015-verify-function)
78 (error "Verify error.")))))
81 (autoload 'mc-encrypt-generic "mc-toplev")
82 (autoload 'mc-cleanup-recipient-headers "mc-toplev")
83 (autoload 'mc-sign-generic "mc-toplev"))
86 (defvar mc-default-scheme)
89 (defun mml2015-mailcrypt-sign (cont)
90 (mc-sign-generic (message-options-get 'message-sender)
93 (funcall mml-boundary-function (incf mml-multipart-number)))
94 (scheme-alist (funcall (or mc-default-scheme
95 (cdr (car mc-schemes)))))
97 (goto-char (point-min))
98 (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist)))
99 (error "Cannot find signed begin line." ))
100 (goto-char (match-beginning 0))
102 (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
103 (error "Cannot not find PGP hash." ))
104 (setq hash (match-string 1))
105 (unless (re-search-forward "^$" nil t)
106 (error "Cannot not find PGP message." ))
108 (delete-region (point-min) (point))
109 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
111 (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
113 (insert (format "\n--%s\n" boundary))
114 (goto-char (point-max))
115 (unless (re-search-backward (cdr (assq 'signed-end-line scheme-alist)))
116 (error "Cannot find signature part." ))
117 (goto-char (match-beginning 0))
118 (unless (re-search-backward "^-+BEGIN" nil t)
119 (error "Cannot find signature part." ))
120 (goto-char (match-beginning 0))
121 (insert (format "--%s\n" boundary))
122 (insert "Content-Type: application/pgp-signature\n\n")
123 (goto-char (point-max))
124 (insert (format "--%s--\n" boundary))
125 (goto-char (point-max))))
127 (defun mml2015-mailcrypt-encrypt (cont)
129 (or (message-options-get 'message-recipients)
130 (message-options-set 'message-recipients
131 (mc-cleanup-recipient-headers
132 (read-string "Recipients: ")))))
134 (funcall mml-boundary-function (incf mml-multipart-number))))
135 (goto-char (point-min))
136 (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
138 (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
139 (insert (format "--%s\n" boundary))
140 (insert "Content-Type: application/pgp-encrypted\n\n")
141 (insert "Version: 1\n\n")
142 (insert (format "--%s\n" boundary))
143 (insert "Content-Type: application/octet-stream\n\n")
144 (goto-char (point-max))
145 (insert (format "--%s--\n" boundary))
146 (goto-char (point-max))))
149 (defun mml2015-encrypt (cont)
150 (funcall mml2015-encrypt-function cont))
153 (defun mml2015-sign (cont)
154 (funcall mml2015-sign-function cont))
158 ;;; mml2015.el ends here