;;; Code:
+(eval-when-compile (require 'cl))
+(require 'mm-decode)
+
(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
(defvar mml2015-verify-function 'mailcrypt-verify)
-
-(defun mml2015-decrypt (handle)
- (let (child)
- (cond
- ((setq child (mm-find-part-by-type (cdr handle)
- "application/octet-stream"))
- (let (handles result)
- (with-temp-buffer
- (mm-insert-part child)
- (setq result (funcall mml2015-decrypt-function))
- (unless (car result)
- (error "Decrypting error."))
- (setq handles (mm-dissect-buffer t)))
- (setq gnus-article-mime-handles
- (append (if (listp (car gnus-article-mime-handles))
- gnus-article-mime-handles
- (list gnus-article-mime-handles))
- (if (listp (car handles))
- handles
- (list handles))))
- (gnus-mime-display-part handles)))
- (t
- (if (y-or-n-p "Corrupted pgp-encrypted part. Abort?" )
- (error "Corrupted pgp-encrypted part.")
- (gnus-mime-display-mixed (cdr handle)))))))
-
-;; FIXME: mm-dissect-buffer loses information of micalg and the
-;; original header of signed part.
-
-(defun mml2015-verify (handle)
- (if (y-or-n-p "Verify signed part?" )
- (let (child result hash)
- (with-temp-buffer
- (unless (setq child (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" t))
- (error "Corrupted pgp-signature part."))
- (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
- (insert (format "Hash: %s\n\n" (read-string "Hash: " "SHA1")))
- (mm-insert-part child)
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (unless (setq child (mm-find-part-by-type
- (cdr handle) "application/pgp-signature"))
- (error "Corrupted pgp-signature part."))
- (mm-insert-part child)
- (setq result (funcall mml2015-verify-function))
- (unless result
- (error "Verify error.")))))
- (gnus-mime-display-part
- (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" t)))
-
-(defvar mml2015-mailcrypt-prefix 0)
+(defvar mml2015-encrypt-function 'mml2015-mailcrypt-encrypt)
+(defvar mml2015-sign-function 'mml2015-mailcrypt-sign)
+
+;;;###autoload
+(defun mml2015-decrypt (handle ctl)
+ (let (child handles result)
+ (unless (setq child (mm-find-part-by-type (cdr handle)
+ "application/octet-stream"))
+ (error "Corrupted pgp-encrypted part."))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (setq result (funcall mml2015-decrypt-function))
+ (unless (car result)
+ (error "Decrypting error."))
+ (setq handles (mm-dissect-buffer t)))
+ (mm-destroy-parts handle)
+ (if (listp (car handles))
+ handles
+ (list handles))))
+
+(defun mml2015-fix-micalg (alg)
+ (if (and alg (string-match "^pgp-" alg))
+ (substring alg (match-end 0))
+ alg))
+
+;;;###autoload
+(defun mml2015-verify (handle ctl)
+ (let (part)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl "application/pgp-signature" t))
+ (error "Corrupted pgp-signature part."))
+ (with-temp-buffer
+ (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+ (insert (format "Hash: %s\n\n"
+ (or (mml2015-fix-micalg
+ (mail-content-type-get ctl 'micalg))
+ "SHA1")))
+ (insert part)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature"))
+ (error "Corrupted pgp-signature part."))
+ (mm-insert-part part)
+ (unless (funcall mml2015-verify-function)
+ (error "Verify error.")))))
+
+(eval-and-compile
+ (autoload 'mc-encrypt-generic "mc-toplev")
+ (autoload 'mc-cleanup-recipient-headers "mc-toplev")
+ (autoload 'mc-sign-generic "mc-toplev"))
+
+(eval-when-compile
+ (defvar mc-default-scheme)
+ (defvar mc-schemes))
(defun mml2015-mailcrypt-sign (cont)
- (mailcrypt-sign mml2015-mailcrypt-prefix)
+ (mc-sign-generic (message-options-get 'message-sender)
+ nil nil nil nil)
(let ((boundary
(funcall mml-boundary-function (incf mml-multipart-number)))
(scheme-alist (funcall (or mc-default-scheme
(insert (format "--%s--\n" boundary))
(goto-char (point-max))))
+
(defun mml2015-mailcrypt-encrypt (cont)
- ;; FIXME:
- ;; You have to input the receiptant.
- (mailcrypt-encrypt mml2015-mailcrypt-prefix)
+ (mc-encrypt-generic
+ (or (message-options-get 'message-recipients)
+ (message-options-set 'message-recipients
+ (mc-cleanup-recipient-headers
+ (read-string "Recipients: ")))))
(let ((boundary
(funcall mml-boundary-function (incf mml-multipart-number))))
(goto-char (point-min))
(insert (format "--%s--\n" boundary))
(goto-char (point-max))))
-;; The following code might be moved into mml.el or gnus-art.el.
-
-(defvar mml-postprocess-alist
- '(("pgp-sign" . mml2015-mailcrypt-sign)
- ("pgp-encrypt" . mml2015-mailcrypt-encrypt))
- "Alist of postprocess functions.")
+;;;###autoload
+(defun mml2015-encrypt (cont)
+ (funcall mml2015-encrypt-function cont))
-(defun mml-postprocess (cont)
- (let ((pp (cdr (or (assq 'postprocess cont)
- (assq 'pp cont))))
- item)
- (if (and pp (setq item (assoc pp mml-postprocess-alist)))
- (funcall (cdr item) cont))))
+;;;###autoload
+(defun mml2015-sign (cont)
+ (funcall mml2015-sign-function cont))
+;;;###autoload
(defun mml2015-setup ()
- (setq mml-generate-mime-postprocess-function 'mml-postprocess)
-; (push '("multipart/signed" . mml2015-verify)
-; gnus-mime-multipart-functions)
- (push '("multipart/encrypted" . mml2015-decrypt)
- gnus-mime-multipart-functions))
-
-;; The following code might be moved into mm-decode.el.
-
-(defun mm-find-part-by-type (handles type &optional notp)
- (let (handle)
- (while handles
- (if (if notp
- (not (equal (mm-handle-media-type (car handles)) type))
- (equal (mm-handle-media-type (car handles)) type))
- (setq handle (car handles)
- handles nil))
- (setq handles (cdr handles)))
- handle))
+ )
(provide 'mml2015)
projects / gnus / blobdiff