(function (lambda (elem) (apply 'autoload elem)))
'(
(mc-gpg-debug-print "mc-gpg")
+
(mc-gpg-encrypt-region "mc-gpg")
+ (mc-gpg-fetch-key "mc-gpg")
(mc-gpg-lookup-key "mc-gpg")
+ (mc-gpg-sign-region "mc-gpg")
+
(mc-pgp50-encrypt-region "mc-pgp5")
+ (mc-pgp50-fetch-key "mc-pgp5")
(mc-pgp50-lookup-key "mc-pgp5")
+ (mc-pgp50-sign-region "mc-pgp5")
+
(mc-pgp-encrypt-region "mc-pgp")
+ (mc-pgp-fetch-key "mc-pgp")
(mc-pgp-lookup-key "mc-pgp")
+ (mc-pgp-sign-region "mc-pgp")
+
(mc-snarf-keys "mc-toplev")
)))
+(defgroup mime-mc nil
+ "Mailcrypt interface for SEMI."
+ :prefix "mime-mc-"
+ :group 'mime)
+
(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
+ :group 'mime-mc
:type 'file)
+(defcustom mime-mc-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'mime-mc
+ :type 'string)
+
(defcustom mime-mc-omit-micalg nil
"Non-nil value means to omit the micalg parameter for multipart/signed.
See draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) for more information."
- :group 'mime
+ :group 'mime-mc
:type 'boolean)
(defcustom mime-mc-comment-alist
(cons 'pgp string)))
"Alist of the schemes and strings of the comment field to appear in ASCII
armor output."
- :group 'mime
+ :group 'mime-mc
:type '(repeat (cons :format "%v"
(choice (choice-item :tag "GnuPG" gpg)
(choice-item :tag "PGP 5.0i" pgp50)
(choice-item :tag "PGP 2.6" pgp))
(string :tag "Comment"))))
+(defvar mime-mc-symbol-format-alist
+ '((comment . "mc-%s-comment")
+ (fetch-key . "mc-%s-fetch-key")
+ (insert-key . "mc-%s-insert-public-key")
+ (mime-encrypt . "mime-mc-%s-encrypt-region")
+ (mime-sign . "mime-mc-%s-sign-region")
+ (scheme . "mc-scheme-%s")
+ (traditional-sign . "mc-%s-sign-region")
+ )
+ "Alist of service names and corresponding format strings.")
+
+(defmacro mime-mc-symbol (service)
+ (` (intern
+ (format (cdr (assq (, service) mime-mc-symbol-format-alist))
+ pgp-version))))
+
(defmacro mime-mc-comment ()
"Return a string of the comment field."
'(or (cdr (assq pgp-version mime-mc-comment-alist))
- (symbol-value (intern (format "mc-%s-comment" pgp-version)))))
+ (symbol-value (mime-mc-symbol 'comment))
+ ))
;;; @ Internal variable
)))
(point-max)))))
-(defun mime-mc-insert-public-key (&optional userid)
- (let ((not-loaded (not (fboundp (intern (format "mc-%s-insert-public-key"
- pgp-version)))))
- (comment (mime-mc-comment))
- (scheme (intern (format "mc-scheme-%s" pgp-version))))
- (cond ((eq 'gpg pgp-version)
- (if not-loaded
- (load "mc-gpg")
- )
- (let ((mc-gpg-comment (if comment "DUMMY")))
- (mc-insert-public-key userid scheme))
- )
- ((eq 'pgp50 pgp-version)
- (if not-loaded
- (load "mc-pgp5")
- )
- (let ((mc-pgp50-comment (if comment "DUMMY")))
- (mc-insert-public-key userid scheme))
- )
- (t
- (if not-loaded
- (load "mc-pgp")
- )
- (let ((mc-pgp-comment (if comment "DUMMY")))
- (mc-insert-public-key userid scheme))
- ))
- (if comment
- (mime-mc-replace-comment-field comment)
- )))
-
(defun mime-mc-verify ()
- (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+ "Verify a message in the current buffer. Exact behavior depends on
+current major mode."
+ (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
(mc-verify)
))
(defun mime-mc-decrypt ()
- (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+ "Decrypt a message in the current buffer. Exact behavior depends on
+current major mode."
+ (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
(mc-decrypt)
))
+(defun mime-mc-fetch-key (&optional id)
+ "Attempt to fetch a key for addition to PGP or GnuPG keyring.
+Interactively, prompt for string matching key to fetch.
+
+Non-interactively, ID must be a pair. The CAR must be a bare Email
+address and the CDR a keyID (with \"0x\" prefix). Either, but not
+both, may be nil.
+
+Return t if we think we were successful; nil otherwise. Note that nil
+is not necessarily an error, since we may have merely fired off an Email
+request for the key."
+ (funcall (mime-mc-symbol 'fetch-key) id)
+ )
+
(defun mime-mc-snarf-keys ()
- (let ((mc-default-scheme (intern (format "mc-scheme-%s" pgp-version))))
+ "Add all public keys in the buffer to your keyring."
+ (let ((mc-default-scheme (mime-mc-symbol 'scheme)))
(mc-snarf-keys)
))
+(defun mime-mc-sign-region (start end &optional id unclear boundary)
+ (funcall (mime-mc-symbol 'mime-sign) start end id unclear boundary)
+ )
+
+(defun mime-mc-traditional-sign-region (start end &optional id unclear)
+ (funcall (mime-mc-symbol 'traditional-sign) start end id unclear)
+ )
+
+(defun mime-mc-encrypt-region (recipients start end &optional id sign)
+ (funcall (mime-mc-symbol 'mime-encrypt) recipients start end id sign)
+ )
+
+(defun mime-mc-insert-public-key (&optional userid)
+ "Insert your public key at point."
+ (or (fboundp (mime-mc-symbol 'insert-key))
+ (load (concat "mc-" (cdr (assq pgp-version '((gpg . "gpg")
+ (pgp50 . "pgp5")
+ (pgp . "pgp")))))))
+ (let ((mc-comment (mime-mc-symbol 'comment))
+ (comment (mime-mc-comment))
+ (scheme (mime-mc-symbol 'scheme)))
+ (eval (` (let (((, mc-comment) (if (, comment) "DUMMY")))
+ (mc-insert-public-key (, userid) (quote (, scheme)))
+ )))
+ (if comment
+ (mime-mc-replace-comment-field comment)
+ )))
+
;;; @ GnuPG functions
;;;
(let ((obuf (current-buffer))
(process-connection-type nil)
(shell-file-name mime-mc-shell-file-name)
+ (shell-command-switch mime-mc-shell-command-switch)
; other local vars
mybuf
stderr-tempfilename stderr-buf
proc rc status parser-result
)
(mc-gpg-debug-print (format
- "(mime-mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s boundary=%s comment=%s)"
- beg end passwd program args parser bufferdummy
- boundary comment))
+ "(mime-mc-gpg-process-region beg=%s end=%s passwd=%s program=%s args=%s parser=%s bufferdummy=%s boundary=%s comment=%s)"
+ beg end passwd program args parser bufferdummy boundary comment))
(setq stderr-tempfilename
(make-temp-name (expand-file-name "mailcrypt-gpg-stderr-"
mc-temp-directory)))
(make-temp-name (expand-file-name "mailcrypt-gpg-status-"
mc-temp-directory)))
(unwind-protect
- (progn
+ (catch ;; Returns non-nil if success, otherwise nil with error message.
+ 'mime-mc-gpg-process-region-done
+
;; get output places ready
(setq mybuf (get-buffer-create " *mailcrypt stdout temp"))
(set-buffer mybuf)
;; ponder process death: signal, not just rc!=0
(if (or (eq 'stop status) (eq 'signal status))
;; process died
- (error "%s exited abnormally: '%s'" program rc) ;;is rc a string?
- )
+ (progn
+ (message
+ "%s exited abnormally: '%s'" program rc) ;; is rc a string?
+ (throw 'mime-mc-gpg-process-region-done nil)
+ ))
(if (= 127 rc)
- (error "%s could not be found" program) ;; at least on my system
- )
+ (progn
+ (message
+ "%s could not be found" program) ;; at least on my system
+ (throw 'mime-mc-gpg-process-region-done nil)
+ ))
;; fill stderr buf
(setq stderr-buf (get-buffer-create " *mailcrypt stderr temp"))
)
;; feed the parser
- (setq parser-result (funcall parser mybuf stderr-buf status-buf rc))
+ (condition-case err
+ (setq parser-result
+ (funcall parser mybuf stderr-buf status-buf rc)
+ )
+ (error
+ (message "%s" err)
+ (throw 'mime-mc-gpg-process-region-done nil)
+ ))
(mc-gpg-debug-print (format " parser returned %s" parser-result))
;; what did the parser tell us?
(with-temp-buffer
(message "Detecting the value of `micalg'...")
(insert "\n")
- (let ((mc-passwd-timeout 60)) ;; Don't deactivate passwd.
- (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"))
+ (if (let ((mc-passwd-timeout 60)) ;; Don't deactivate passwd.
+ (mime-mc-gpg-process-region
+ 1 2 passwd pgp-path
+ (list "--clearsign" "--armor" "--batch" "--textmode"
+ "--verbose" "--local-user" (cdr key))
+ parser buffer nil)
)
- (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 comment)
+ (progn
+ (std11-narrow-to-header)
+ (setq micalg
+ (downcase (or (std11-fetch-field "Hash") "md5"))
+ )
+ (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
+ )
+ (or mc-passwd-timeout (mc-deactivate-passwd t))
+ ))
+ )))
+ (if (or mime-mc-omit-micalg micalg)
(progn
- (if boundary
+ (message "Signing as %s ..." (car key))
+ (if (mime-mc-gpg-process-region
+ start end passwd pgp-path args parser buffer boundary comment)
(progn
- (goto-char (point-min))
- (insert
- (format "\
+ (if boundary
+ (progn
+ (goto-char (point-min))
+ (insert
+ (format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
boundary=\"%s\"%s][7bit]]\n"
- boundary
- (if mime-mc-omit-micalg
- ""
- (concat "; micalg=pgp-" micalg)
- )
- ))))
- (message "Signing as %s ... Done." (car key))
- t)
+ boundary
+ (if mime-mc-omit-micalg
+ ""
+ (concat "; micalg=pgp-" micalg)
+ )
+ ))))
+ (message "Signing as %s ... Done." (car key))
+ t)
+ nil)
+ )
nil)))
(defun mime-mc-gpg-encrypt-region (recipients start end &optional id sign)
(let ((obuf (current-buffer))
(process-connection-type nil)
(shell-file-name mime-mc-shell-file-name)
+ (shell-command-switch mime-mc-shell-command-switch)
mybuf result rgn proc results)
(if comment
(setq args (cons "+comment=DUMMY" args))
)
(unwind-protect
- (progn
+ (catch ;; Returns non-nil if success, otherwise nil with error message.
+ 'mime-mc-pgp50-process-region-done
+
(setq mybuf (or buffer (generate-new-buffer " *mailcrypt temp")))
(set-buffer mybuf)
(erase-buffer)
;; Now hand the process to the parser, which returns the exit
;; status of the dead process and the limits of the region
;; containing the PGP results.
- (setq results (funcall parser proc obuf beg end mybuf passwd))
+ (condition-case err
+ (setq results (funcall parser proc obuf beg end mybuf passwd))
+ (error
+ (message "%s" err)
+ (throw 'mime-mc-pgp50-process-region-done nil)
+ ))
(setq result (car results))
(setq rgn (cadr results))
(set-buffer mybuf)
;; replace comment string
- (if comment
+ (if (and comment (consp rgn))
(setcdr rgn (mime-mc-replace-comment-field
comment (car rgn) (cdr rgn)))
)
(with-temp-buffer
(message "Detecting the value of `micalg'...")
(insert "\n")
- (let ((mc-passwd-timeout 60)) ;; Don't deactivate passwd.
- (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 comment)
+ (if (let ((mc-passwd-timeout 60)) ;; Don't deactivate passwd.
+ (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)
+ )
+ (progn
+ (std11-narrow-to-header)
+ (setq micalg (downcase (or (std11-fetch-field "Hash") "md5")))
+ (set-alist 'mime-mc-micalg-alist (cdr key) micalg)
+ )
+ (or mc-passwd-timeout (mc-deactivate-passwd t))
+ ))
+ )
+ (if (or mime-mc-omit-micalg micalg)
(progn
- (if boundary
+ (message "Signing as %s ..." (car key))
+ (if (mime-mc-pgp50-process-region
+ start end passwd pgp-path args parser buffer boundary comment)
(progn
- (goto-char (point-min))
- (insert
- (format "\
+ (if boundary
+ (progn
+ (goto-char (point-min))
+ (insert
+ (format "\
--[[multipart/signed; protocol=\"application/pgp-signature\";
boundary=\"%s\"%s][7bit]]\n"
- boundary
- (if mime-mc-omit-micalg
- ""
- (concat "; micalg=pgp-" micalg)
- )
- ))))
- (message "Signing as %s ... Done." (car key))
- t)
+ boundary
+ (if mime-mc-omit-micalg
+ ""
+ (concat "; micalg=pgp-" micalg)
+ )
+ ))))
+ (message "Signing as %s ... Done." (car key))
+ t)
+ nil)
+ )
nil)))
(defun mime-mc-pgp50-encrypt-region (recipients start end &optional id sign)
projects / elisp / semi.git / blobdiff