;; Author: UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Version: $Revision: 7.36 $
+;; Version: $Revision: 7.37 $
;; Keywords: mail, news, MIME, multimedia, multilingual
;; This file is not part of GNU Emacs.
;; LCD Archive Entry:
;; mime|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
;; Simple MIME Composer|
-;; $Date: 1995/12/17 14:37:28 $|$Revision: 7.36 $|~/misc/mime.el.Z|
+;; $Date: 1995/12/19 17:47:16 $|$Revision: 7.37 $|~/misc/mime.el.Z|
;;; Code:
;;;
(defconst mime-editor/RCS-ID
- "$Id: tm-edit.el,v 7.36 1995/12/17 14:37:28 morioka Exp $")
+ "$Id: tm-edit.el,v 7.37 1995/12/19 17:47:16 morioka Exp $")
(defconst mime-editor/version (get-version-string mime-editor/RCS-ID))
(setq selective-display t)
;; I don't care about saving these.
(setq paragraph-start
- (concat mime-editor/single-part-tag-regexp "\\|" paragraph-start))
+ (regexp-or mime-editor/single-part-tag-regexp
+ paragraph-start))
(setq paragraph-separate
- (concat mime-editor/single-part-tag-regexp "\\|" paragraph-separate))
+ (regexp-or mime-editor/single-part-tag-regexp
+ paragraph-separate))
(run-hooks 'mime/editor-mode-hook)
(message
(substitute-command-keys
))
boundary))))
-(defun mc-tmpgp-generic-parser (result)
- (if (or (not (eq result 0))
- (mc-message "^\aError: +Bad pass phrase\\.$" (current-buffer))
- )
- (progn
- (mc-deactivate-passwd t)
- nil)
- result))
+(defun tm:mc-pgp-generic-parser (result)
+ (let ((ret (mc-pgp-generic-parser result)))
+ (if (consp ret)
+ (vector (car ret)(cdr ret))
+ )))
-(defvar mc-tmpgp-path "tmpgp")
+(autoload 'mc-pgp-lookup-key "mc-pgp")
+
+(defun tm: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 tm:mc-pgp-sign-region (start end &optional id unclear boundary)
(if (not (boundp 'mc-pgp-user-id))
)
(let ((process-environment process-environment)
(buffer (get-buffer-create mc-buffer-name))
- passwd args key parser pgp-path
- signature-file)
+ 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
(format "PGP passphrase for %s (%s): " (car key) (cdr key))))
(setenv "PGPPASSFD" "0")
(setq args
- (list "+verbose=1" "+language=en"
- (format "+clearsig=%s" (if unclear "off" "on"))
- "+batchmode" "-u" (cdr key)))
- (if boundary
- (progn
- (setq parser 'mc-tmpgp-generic-parser
- pgp-path mc-tmpgp-path
- signature-file (make-temp-name
- (expand-file-name "tm-sign" mime/tmp-dir))
- args (cons "-fbst" args))
- (if mc-pgp-comment
- (setq args (cons (format "+comment=%s" mc-pgp-comment) args))
- )
- (setq args (cons signature-file args))
- )
- (setq parser 'mc-pgp-generic-parser
- pgp-path mc-pgp-path
- args (cons "-fast" args)
- )
- (if mc-pgp-comment
- (setq args (cons (format "+comment=%s" mc-pgp-comment) 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 (mc-process-region start end passwd pgp-path args parser buffer)
+ (if (tm:mc-process-region
+ start end passwd pgp-path args parser buffer boundary)
(progn
(if boundary
(progn
(insert
(format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
- boundary=\"%s\"; micalg=pgp-md5][7bit]]
---%s\n" boundary boundary))
- (goto-char (point-max))
- (insert (format "\n--%s\n" boundary))
- (insert "Content-Type: application/pgp-signature
-Content-Transfer-Encoding: base64
-
-")
- (insert-file-contents signature-file)
- (goto-char (point-max))
- (insert (format "\n--%s--\n" boundary))
+ boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
))
- (delete-file signature-file)
(message "Signing as %s ... Done." (car key))
t)
nil)))
projects / elisp / tm.git / blobdiff