;;; mime-mc.el --- Mailcrypt interface for SEMI
;; Copyright (C) 1996,1997,1998 MORIOKA Tomohiko
;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
;; Keywords: PGP, security, MIME, multimedia, mail, news
;; This file is part of SEMI (Secure Emacs MIME Interface).
;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Code:
(require 'mailcrypt)
(eval-and-compile (load "mc-pgp"))
(defun mime-mc-pgp-generic-parser (result)
(let ((ret (mc-pgp-generic-parser result)))
(if (consp ret)
(vector (car ret)(cdr ret))
)))
(defun mime-mc-process-region
(beg end passwd program args parser &optional buffer boundary)
(let ((obuf (current-buffer))
(process-connection-type nil)
mybuf result rgn proc)
(unwind-protect
(progn
(setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
(set-buffer mybuf)
(erase-buffer)
(set-buffer obuf)
(buffer-disable-undo mybuf)
(setq proc
(apply 'start-process "*PGP*" mybuf program args))
(if passwd
(progn
(process-send-string proc (concat passwd "\n"))
(or mc-passwd-timeout (mc-deactivate-passwd t))))
(process-send-region proc beg end)
(process-send-eof proc)
(while (eq 'run (process-status proc))
(accept-process-output proc 5))
(setq result (process-exit-status proc))
;; Hack to force a status_notify() in Emacs 19.29
(delete-process proc)
(set-buffer mybuf)
(goto-char (point-max))
(if (re-search-backward "\nProcess \\*PGP.*\n\\'" nil t)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-min))
;; CRNL -> NL
(while (search-forward "\r\n" nil t)
(replace-match "\n"))
;; Hurm. FIXME; must get better result codes.
(if (stringp result)
(error "%s exited abnormally: '%s'" program result)
(setq rgn (funcall parser result))
;; If the parser found something, migrate it
(if (consp rgn)
(progn
(set-buffer obuf)
(if boundary
(save-restriction
(narrow-to-region beg end)
(goto-char beg)
(insert (format "--%s\n" boundary))
(goto-char (point-max))
(insert (format "\n--%s
Content-Type: application/pgp-signature
Content-Transfer-Encoding: 7bit
" boundary))
(insert-buffer-substring mybuf (car rgn) (cdr rgn))
(goto-char (point-max))
(insert (format "\n--%s--\n" boundary))
)
(delete-region beg end)
(goto-char beg)
(insert-buffer-substring mybuf (car rgn) (cdr rgn))
)
(set-buffer mybuf)
(delete-region (car rgn) (cdr rgn)))))
;; Return nil on failure and exit code on success
(if rgn result))
;; Cleanup even on nonlocal exit
(if (and proc (eq 'run (process-status proc)))
(interrupt-process proc))
(set-buffer obuf)
(or buffer (null mybuf) (kill-buffer mybuf)))))
(defun mime-mc-pgp-sign-region (start end &optional id unclear boundary)
;; (if (not (boundp 'mc-pgp-user-id))
;; (load "mc-pgp")
;; )
(let ((process-environment process-environment)
(buffer (get-buffer-create mc-buffer-name))
passwd args key
(parser (function mc-pgp-generic-parser))
(pgp-path mc-pgp-path)
)
(setq key (mc-pgp-lookup-key (or id mc-pgp-user-id)))
(setq passwd
(mc-activate-passwd
(cdr key)
(format "PGP passphrase for %s (%s): " (car key) (cdr key))))
(setenv "PGPPASSFD" "0")
(setq args
(cons
(if boundary
"-fbast"
"-fast")
(list "+verbose=1" "+language=en"
(format "+clearsig=%s" (if unclear "off" "on"))
"+batchmode" "-u" (cdr key))))
(if mc-pgp-comment
(setq args (cons (format "+comment=%s" mc-pgp-comment) args))
)
(message "Signing as %s..." (car key))
(if (mime-mc-process-region
start end passwd pgp-path args parser buffer boundary)
(progn
(if boundary
(progn
(goto-char (point-min))
(insert
(format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
))
(message "Signing as %s...done" (car key))
t)
nil)))
(defun mime-mc-pgp-encrypt-region (recipients start end &optional id sign)
(let ((mc-pgp-always-sign (if (eq sign 'maybe)
mc-pgp-always-sign
'never)))
(mc-pgp-encrypt-region
(mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
start end id nil)
))
;;; @ end
;;;
(provide 'mime-mc)
;;; mime-mc.el ends here