From 3cc749dc0dac0f1f3a1b9629147e7e3cb939abea Mon Sep 17 00:00:00 2001 From: tmorioka Date: Thu, 27 Feb 1997 08:03:48 +0000 Subject: [PATCH] *** empty log message *** --- mime-mc.el | 165 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 165 insertions(+) create mode 100644 mime-mc.el diff --git a/mime-mc.el b/mime-mc.el new file mode 100644 index 0000000..75ba129 --- /dev/null +++ b/mime-mc.el @@ -0,0 +1,165 @@ +;;; mime-mc.el --- Mailcrypt interface for SEMI + +;; Copyright (C) 1996,1997 MORIOKA Tomohiko + +;; Author: MORIOKA Tomohiko +;; Version: $Id: mime-mc.el,v 0.0 1997-02-27 08:03:48 tmorioka Exp $ +;; Keywords: PGP, security, MIME, multimedia, mail, news + +;; This file is part of SEMI (SEMI is Emacs MIME Interfaces). + +;; 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., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'mailcrypt) +(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 -- 1.7.10.4