;;; Code:
+(require 'alist)
+(require 'std11)
(require 'semi-def)
(require 'mailcrypt)
(mc-snarf-keys "mc-toplev")
)))
+(defcustom mime-mc-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'mime
+ :type 'file)
+
+(defcustom mime-mc-ommit-micalg nil
+ "Non-nil value means to ommit the micalg parameter for multipart/signed.
+See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information."
+ :group 'mime
+ :type 'boolean)
+
+
+;;; @ Internal variable
+;;;
+
+(defvar mime-mc-micalg-alist nil
+ "Alist of KeyID and the value of message integrity check algorithm.")
+
+
+;;; @ External variables (for avoid byte compile warnings)
+;;;
+
(defvar mc-gpg-comment)
(defvar mc-gpg-extra-args)
(defvar mc-gpg-path)
(defvar mc-pgp-path)
(defvar mc-pgp-user-id)
-(defcustom mime-mc-shell-file-name "/bin/sh"
- "File name to load inferior shells from. Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
- :group 'mime
- :type 'file)
-
;;; @ Generic functions
;;;
(defun mime-mc-gpg-process-region
(beg end passwd program args parser bufferdummy boundary)
+ "Similar to `mc-gpg-process-region', however enclose an processed data
+with BOUNDARY if it is specified."
(let ((obuf (current-buffer))
(process-connection-type nil)
(shell-file-name mime-mc-shell-file-name)
proc rc status parser-result
)
(mc-gpg-debug-print (format
- "(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s)"
- beg end passwd program args parser bufferdummy))
+ "(mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s boundary=%s)"
+ beg end passwd program args parser bufferdummy
+ boundary))
(setq stderr-tempfilename
(make-temp-name (expand-file-name "mailcrypt-gpg-stderr-"
mc-temp-directory)))
passwd args key
(parser (function mc-gpg-insert-parser))
(pgp-path mc-gpg-path)
- )
+ micalg)
(setq key (mc-gpg-lookup-key (or id mc-gpg-user-id)))
(setq passwd
(mc-activate-passwd
(cdr key)
(format "GnuPG passphrase for %s (%s): " (car key) (cdr key))))
- (setq args
- (cons
- (if boundary
- "--detach-sign"
- (if unclear
- "--sign"
- "--clearsign"))
- (list "--armor" "--batch" "--textmode" "--verbose"
- "--local-user" (cdr key))))
+ (setq args (cons
+ (if boundary
+ "--detach-sign"
+ (if unclear
+ "--sign"
+ "--clearsign")
+ )
+ (list "--armor" "--batch" "--textmode" "--verbose"
+ "--local-user" (cdr key))
+ ))
(if mc-gpg-comment
(setq args (nconc args
(list "--comment"
(format "\"%s\"" mc-gpg-comment))))
)
- (if (and boundary
- (string-match "^pgp-" boundary))
- (setq boundary
- (concat "gpg-" (substring boundary (match-end 0))))
- )
+ (if boundary
+ (progn
+ (if (string-match "^pgp-" boundary)
+ (setq boundary
+ (concat "gpg-" (substring boundary (match-end 0))))
+ )
+ (if (not (or mime-mc-ommit-micalg
+ (setq micalg
+ (cdr (assoc (cdr key) mime-mc-micalg-alist)))
+ ))
+ (with-temp-buffer
+ (message "Detecting the value of `micalg'...")
+ (insert "\n")
+ (mime-mc-gpg-process-region
+ 1 2 passwd pgp-path
+ (list "--clearsign" "--armor" "--batch" "--textmode"
+ "--verbose" "--local-user" (cdr key))
+ parser buffer nil
+ )
+ (std11-narrow-to-header)
+ (setq micalg
+ (downcase (or (std11-fetch-field "Hash") "md5"))
+ )
+ (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
+ ))
+ ))
(message "Signing as %s ..." (car key))
(if (mime-mc-gpg-process-region
start end passwd pgp-path args parser buffer boundary)
(insert
(format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
- boundary=\"%s\"; micalg=pgp-sha1][7bit]]\n" boundary))
- ))
+ boundary=\"%s\"%s][7bit]]\n"
+ boundary
+ (if mime-mc-ommit-micalg
+ ""
+ (concat "; micalg=pgp-" micalg)
+ )
+ ))))
(message "Signing as %s ... Done." (car key))
t)
nil)))
(defun mime-mc-pgp50-process-region
(beg end passwd program args parser &optional buffer boundary)
+ "Similar to `mc-pgp50-process-region', however enclose an processed data
+with BOUNDARY if it is specified."
(let ((obuf (current-buffer))
(process-connection-type nil)
(shell-file-name mime-mc-shell-file-name)
(function mime-mc-pgp50-sign-parser)
(function mc-pgp50-sign-parser)))
(pgp-path mc-pgp50-pgps-path)
- )
+ micalg)
(setq key (mc-pgp50-lookup-key (or id mc-pgp50-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
- "-fbat"
- "-fat")
- (list "+verbose=1" "+language=us"
- (format "+clearsig=%s" (if unclear "off" "on"))
- "+batchmode" "-u" (cdr key))))
+ (setq args (if boundary
+ (list "-fbat" "+verbose=1" "+language=us" "+batchmode"
+ "-u" (cdr key))
+ (list "-fat" "+verbose=1" "+language=us"
+ (format "+clearsig=%s" (if unclear "off" "on"))
+ "+batchmode" "-u" (cdr key))
+ ))
(if mc-pgp50-comment
(setq args (cons (format "+comment=\"%s\"" mc-pgp50-comment) args))
)
+ (if (and boundary
+ (not (or mime-mc-ommit-micalg
+ (setq micalg
+ (cdr (assoc (cdr key) mime-mc-micalg-alist)))
+ )))
+ (with-temp-buffer
+ (message "Detecting the value of `micalg'...")
+ (insert "\n")
+ (mime-mc-pgp50-process-region
+ 1 2 passwd pgp-path
+ (list "-fat" "+verbose=1" "+language=us" "+clearsig=on"
+ "+batchmode" "-u" (cdr key))
+ (function mc-pgp50-sign-parser) buffer nil)
+ (std11-narrow-to-header)
+ (setq micalg (downcase (or (std11-fetch-field "Hash") "md5")))
+ (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
+ ))
(message "Signing as %s ..." (car key))
(if (mime-mc-pgp50-process-region
start end passwd pgp-path args parser buffer boundary)
(insert
(format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
- boundary=\"%s\"; micalg=pgp-sha1][7bit]]\n" boundary))
- ))
+ boundary=\"%s\"%s][7bit]]\n"
+ boundary
+ (if mime-mc-ommit-micalg
+ ""
+ (concat "; micalg=pgp-" micalg)
+ )
+ ))))
(message "Signing as %s ... Done." (car key))
t)
nil)))
(defun mime-mc-process-region
(beg end passwd program args parser &optional buffer boundary)
+ "Similar to `mc-pgp-process-region', however enclose an processed data
+with BOUNDARY if it is specified."
(let ((obuf (current-buffer))
(process-connection-type nil)
mybuf result rgn proc)
(insert
(format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
- boundary=\"%s\"; micalg=pgp-md5][7bit]]\n" boundary))
- ))
+ boundary=\"%s\"%s][7bit]]\n"
+ boundary
+ (if mime-mc-ommit-micalg
+ ""
+ "; micalg=pgp-md5"
+ )
+ ))))
(message "Signing as %s ... Done." (car key))
t)
nil)))
;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
;; expired)
+;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
+;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
+;; <kazu@iijlab.net> (1998/1)
+
;;; Code:
(require 'std11)
(set-window-buffer p-win mime-preview-buffer)
))
-(defun mime-pgp-detect-version (entity)
- "Detect PGP version from detached signature."
- (with-temp-buffer
- (mime-insert-entity-content entity)
- (std11-narrow-to-header)
- (let ((version (std11-fetch-field "Version")))
- (cond ((not version)
- pgp-version)
- ((string-match "GnuPG" version)
- 'gpg)
- ((string-match "5\\.0i" version)
- 'pgp50)
- ((string-match "2\\.6" version)
- 'pgp)
- (t
- pgp-version)))))
-
;;; @ Internal method for application/pgp-signature
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
+
(defcustom mime-pgp-command-alist '((gpg . "gpg")
(pgp50 . "pgp")
(cdr (assq pgp-version mime-pgp-key-expected-regexp-alist))
)))
+(defun mime-pgp-detect-version (entity)
+ "Detect PGP version from detached signature."
+ (with-temp-buffer
+ (mime-insert-entity-content entity)
+ (std11-narrow-to-header)
+ (let ((version (std11-fetch-field "Version")))
+ (cond ((not version)
+ pgp-version)
+ ((string-match "GnuPG" version)
+ 'gpg)
+ ((string-match "5\\.0i" version)
+ 'pgp50)
+ ((string-match "2\\.6" version)
+ 'pgp)
+ (t
+ pgp-version)))))
+
(defun mime-pgp-check-signature (output-buffer orig-file)
(with-current-buffer output-buffer
(erase-buffer)
;;; @ Internal method for application/pgp-encrypted
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
(defun mime-decrypt-application/pgp-encrypted (entity situation)
(let* ((entity-node-id (mime-entity-node-id entity))
;;; @ Internal method for application/pgp-keys
;;;
-;;; It is based on RFC 2015 (PGP/MIME).
+;;; It is based on RFC 2015 (PGP/MIME) and
+;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
(defun mime-add-application/pgp-keys (entity situation)
(let* ((start (mime-entity-point-min entity))
projects / elisp / semi.git / commitdiff