+ (if (catch 'mime-editor/error
+ (save-excursion
+ (run-hooks 'mime-editor/translate-buffer-hook)
+ ))
+ (progn
+ (undo)
+ (error "Translation error!")
+ )))
+
+(defun mime-editor/find-inmost ()
+ (goto-char (point-min))
+ (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
+ (let ((bb (match-beginning 0))
+ (be (match-end 0))
+ (type (buffer-substring (match-beginning 1)(match-end 1)))
+ end-exp eb ee)
+ (setq end-exp (format "--}-<<%s>>\n" type))
+ (widen)
+ (if (re-search-forward end-exp nil t)
+ (progn
+ (setq eb (match-beginning 0))
+ (setq ee (match-end 0))
+ )
+ (setq eb (point-max))
+ (setq ee (point-max))
+ )
+ (narrow-to-region be eb)
+ (goto-char be)
+ (if (re-search-forward mime-editor/multipart-beginning-regexp nil t)
+ (let (ret)
+ (narrow-to-region (match-beginning 0)(point-max))
+ (mime-editor/find-inmost)
+ )
+ (widen)
+ (list type bb be eb)
+ ))))
+
+(defun mime-editor/process-multipart-1 (boundary)
+ (let ((ret (mime-editor/find-inmost)))
+ (if ret
+ (let ((type (car ret))
+ (bb (nth 1 ret))(be (nth 2 ret))
+ (eb (nth 3 ret))
+ )
+ (narrow-to-region bb eb)
+ (delete-region bb be)
+ (setq bb (point-min))
+ (setq eb (point-max))
+ (widen)
+ (goto-char eb)
+ (if (looking-at mime-editor/multipart-end-regexp)
+ (let ((beg (match-beginning 0))
+ (end (match-end 0))
+ )
+ (delete-region beg end)
+ (or (looking-at mime-editor/beginning-tag-regexp)
+ (eobp)
+ (insert (concat (mime-make-text-tag) "\n"))
+ )))
+ (cond ((string-equal type "quote")
+ (mime-editor/enquote-region bb eb)
+ )
+ ((string-equal type "signed")
+ (cond ((eq mime-editor/signing-type 'pgp-elkins)
+ (mime-editor/sign-pgp-elkins bb eb boundary)
+ )
+ ((eq mime-editor/signing-type 'pgp-kazu)
+ (mime-editor/sign-pgp-kazu bb eb boundary)
+ ))
+ )
+ ((string-equal type "encrypted")
+ (cond ((eq mime-editor/encrypting-type 'pgp-elkins)
+ (mime-editor/encrypt-pgp-elkins bb eb boundary)
+ )
+ ((eq mime-editor/encrypting-type 'pgp-kazu)
+ (mime-editor/encrypt-pgp-kazu bb eb boundary)
+ )))
+ (t
+ (setq boundary
+ (nth 2 (mime-editor/translate-region bb eb
+ boundary t)))
+ (goto-char bb)
+ (insert
+ (format "--[[multipart/%s;
+ boundary=\"%s\"][7bit]]\n"
+ type boundary))
+ ))
+ boundary))))
+
+(defun mime-editor/enquote-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (while (re-search-forward mime-editor/single-part-tag-regexp nil t)
+ (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
+ (replace-match (concat "- " (substring tag 1)))
+ )))))
+
+(defun mime-editor/dequote-region (beg end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (while (re-search-forward
+ mime-editor/quoted-single-part-tag-regexp nil t)
+ (let ((tag (buffer-substring (match-beginning 0)(match-end 0))))
+ (replace-match (concat "-" (substring tag 2)))
+ )))))
+
+(autoload 'mc-pgp-lookup-key "mc-pgp")
+(autoload 'mc-pgp-sign-region "mc-pgp")
+(autoload 'mc-pgp-encrypt-region "mc-pgp")
+
+(defun tm:mc-pgp-generic-parser (result)
+ (let ((ret (mc-pgp-generic-parser result)))
+ (if (consp ret)
+ (vector (car ret)(cdr ret))
+ )))
+
+(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))
+ (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 (tm: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-editor/sign-pgp-elkins (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-editor/translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (parts (nth 3 ret))
+ (pgp-boundary (concat "pgp-sign-" boundary))
+ )
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (or (tm:mc-pgp-sign-region (point-min)(point-max)
+ nil nil pgp-boundary)
+ (throw 'mime-editor/error 'pgp-error)
+ )
+ ))))
+
+(defvar mime-editor/encrypt-recipient-fields-list '("To" "cc"))
+
+(defun mime-editor/make-encrypt-recipient-header ()
+ (let* ((names mime-editor/encrypt-recipient-fields-list)
+ (values
+ (std11-field-bodies (cons "From" names)
+ nil mail-header-separator))
+ (from (prog1
+ (car values)
+ (setq values (cdr values))))
+ (header (and (stringp from)
+ (if (string-equal from "")
+ ""
+ (format "From: %s\n" from)
+ )))
+ recipients)
+ (while (and names values)
+ (let ((name (car names))
+ (value (car values))
+ )
+ (and (stringp value)
+ (or (string-equal value "")
+ (progn
+ (setq header (concat header name ": " value "\n")
+ recipients (if recipients
+ (concat recipients " ," value)
+ value))
+ ))))
+ (setq names (cdr names)
+ values (cdr values))
+ )
+ (vector from recipients header)
+ ))
+
+(defun mime-editor/encrypt-pgp-elkins (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (let (from recipients header)
+ (let ((ret (mime-editor/make-encrypt-recipient-header)))
+ (setq from (aref ret 0)
+ recipients (aref ret 1)
+ header (aref ret 2))
+ )
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-editor/translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (parts (nth 3 ret))
+ (pgp-boundary (concat "pgp-" boundary))
+ )
+ (goto-char beg)
+ (insert header)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (if (null
+ (let ((mc-pgp-always-sign 'never))
+ (mc-pgp-encrypt-region
+ (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
+ (point-min) (point-max) from nil)
+ ))
+ (throw 'mime-editor/error 'pgp-error)
+ )
+ (goto-char beg)
+ (insert (format "--[[multipart/encrypted;
+ boundary=\"%s\";
+ protocol=\"application/pgp-encrypted\"][7bit]]
+--%s
+Content-Type: application/pgp-encrypted
+
+--%s
+Content-Type: application/octet-stream
+Content-Transfer-Encoding: 7bit
+
+" pgp-boundary pgp-boundary pgp-boundary))
+ (goto-char (point-max))
+ (insert (format "\n--%s--\n" pgp-boundary))
+ )))))
+
+(defun mime-editor/sign-pgp-kazu (beg end boundary)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-editor/translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (parts (nth 3 ret))
+ )
+ (goto-char beg)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (or (as-binary-process (mc-pgp-sign-region beg (point-max)))
+ (throw 'mime-editor/error 'pgp-error)
+ )
+ (goto-char beg)
+ (insert
+ "--[[application/pgp; format=mime][7bit]]\n")
+ ))
+ ))
+
+(defun mime-editor/encrypt-pgp-kazu (beg end boundary)
+ (save-excursion
+ (let (from recipients header)
+ (let ((ret (mime-editor/make-encrypt-recipient-header)))
+ (setq from (aref ret 0)
+ recipients (aref ret 1)
+ header (aref ret 2))
+ )
+ (save-restriction
+ (narrow-to-region beg end)
+ (let* ((ret
+ (mime-editor/translate-region beg end boundary))
+ (ctype (car ret))
+ (encoding (nth 1 ret))
+ (parts (nth 3 ret))
+ )
+ (goto-char beg)
+ (insert header)
+ (insert (format "Content-Type: %s\n" ctype))
+ (if encoding
+ (insert (format "Content-Transfer-Encoding: %s\n" encoding))
+ )
+ (insert "\n")
+ (or (as-binary-process
+ (mc-pgp-encrypt-region
+ (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)
+ beg (point-max))
+ )
+ (throw 'mime-editor/error 'pgp-error)
+ )
+ (goto-char beg)
+ (insert
+ "--[[application/pgp; format=mime][7bit]]\n")
+ ))
+ )))