1 ;;; mime-mc.el --- Mailcrypt interface for SEMI
3 ;; Copyright (C) 1996,1997,1998 MORIOKA Tomohiko
5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
6 ;; Keywords: PGP, security, MIME, multimedia, mail, news
8 ;; This file is part of SEMI (Secure Emacs MIME Interface).
10 ;; This program is free software; you can redistribute it and/or
11 ;; modify it under the terms of the GNU General Public License as
12 ;; published by the Free Software Foundation; either version 2, or (at
13 ;; your option) any later version.
15 ;; This program is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
23 ;; Boston, MA 02110-1301, USA.
28 (eval-and-compile (load "mc-pgp"))
30 (defun mime-mc-pgp-generic-parser (result)
31 (let ((ret (mc-pgp-generic-parser result)))
33 (vector (car ret)(cdr ret)))))
35 (defun mime-mc-process-region
36 (beg end passwd program args parser &optional buffer boundary)
37 (let ((obuf (current-buffer))
38 (process-connection-type nil)
39 mybuf result rgn proc)
42 (setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
46 (buffer-disable-undo mybuf)
48 (apply 'start-process "*PGP*" mybuf program args))
51 (process-send-string proc (concat passwd "\n"))
52 (or mc-passwd-timeout (mc-deactivate-passwd t))))
53 (process-send-region proc beg end)
54 (process-send-eof proc)
55 (while (eq 'run (process-status proc))
56 (accept-process-output proc 5))
57 (setq result (process-exit-status proc))
58 ;; Hack to force a status_notify() in Emacs 19.29
61 (goto-char (point-max))
62 (if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
63 (delete-region (match-beginning 0) (match-end 0)))
64 (goto-char (point-min))
66 (while (search-forward "\r\n" nil t)
68 ;; Hurm. FIXME; must get better result codes.
70 (error "%s exited abnormally: '%s'" program result)
71 (setq rgn (funcall parser result))
72 ;; If the parser found something, migrate it
78 (narrow-to-region beg end)
80 (insert (format "--%s\n" boundary))
81 (goto-char (point-max))
82 (insert (format "\n--%s
83 Content-Type: application/pgp-signature
84 Content-Transfer-Encoding: 7bit
87 (insert-buffer-substring mybuf (car rgn) (cdr rgn))
88 (goto-char (point-max))
89 (insert (format "\n--%s--\n" boundary)))
90 (delete-region beg end)
92 (insert-buffer-substring mybuf (car rgn) (cdr rgn)))
94 (delete-region (car rgn) (cdr rgn)))))
95 ;; Return nil on failure and exit code on success
97 ;; Cleanup even on nonlocal exit
98 (if (and proc (eq 'run (process-status proc)))
99 (interrupt-process proc))
101 (or buffer (null mybuf) (kill-buffer mybuf)))))
103 (defun mime-mc-pgp-sign-region (start end &optional id unclear boundary)
104 ;; (if (not (boundp 'mc-pgp-user-id))
107 (let ((process-environment process-environment)
108 (buffer (get-buffer-create mc-buffer-name))
110 (parser (function mc-pgp-generic-parser))
111 (pgp-path mc-pgp-path))
112 (setq key (mc-pgp-lookup-key (or id mc-pgp-user-id)))
116 (format "PGP passphrase for %s (%s): " (car key) (cdr key))))
117 (setenv "PGPPASSFD" "0")
123 (list "+verbose=1" "+language=en"
124 (format "+clearsig=%s" (if unclear "off" "on"))
125 "+batchmode" "-u" (cdr key))))
127 (setq args (cons (format "+comment=%s" mc-pgp-comment) args)))
128 (message "Signing as %s..." (car key))
129 (if (mime-mc-process-region
130 start end passwd pgp-path args parser buffer boundary)
134 (goto-char (point-min))
137 --[[multipart/signed; protocol=\"application/pgp-signature\";
138 boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
140 (message "Signing as %s...done" (car key))
144 (defun mime-mc-pgp-encrypt-region (recipients start end &optional id sign)
145 (let ((mc-pgp-always-sign (if (eq sign 'maybe)
148 (mc-pgp-encrypt-region
149 (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
158 ;;; mime-mc.el ends here