X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fsmime.el;h=ce69cd5adb9fffe35ed0acece97c0000e47b2b49;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=d762fbe965910039643568f0319d44c293796d88;hpb=ca736d959c96aaa979f46d458340582e43dc735b;p=elisp%2Fgnus.git- diff --git a/lisp/smime.el b/lisp/smime.el index d762fbe..ce69cd5 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -41,6 +41,9 @@ ;; PKCSx or similar, it's intended to perform common operations ;; done on messages encoded in these formats. The terminology chosen ;; reflect this. +;; +;; The home of this file is in Gnus CVS, but also available from +;; http://josefsson.org/smime.html. ;;; Quick introduction: @@ -89,9 +92,11 @@ ;; environment variables to pass the password to OpenSSL, which is ;; slightly insecure. Hence a new todo: use a better -passin method. ;; +;; Cache password for e.g. 1h +;; ;; Suggestions and comments are appreciated, mail me at simon@josefsson.org. -;; +;; begin rant ;; ;; I would include pointers to introductory text on concepts used in ;; this library here, but the material I've read are so horrible I @@ -103,11 +108,13 @@ ;; Also, I'm not going to mention anything about the wonders of ;; cryptopolitics. Oops, I just did. ;; -;; +;; end rant ;;; Revision history: -;; version 0 not released +;; 2000-06-05 initial version, committed to Gnus CVS contrib/ +;; 2000-10-28 retrieve certificates via DNS CERT RRs +;; 2001-10-14 posted to gnu.emacs.sources ;;; Code: @@ -185,15 +192,17 @@ If nil, use system defaults." string) :group 'smime) -(defcustom smime-extra-arguments nil - "*List of additional arguments passed to OpenSSL. -For instance, if you don't have a /dev/random you might be forced -to set this to e.g. `(\"-rand\" \"/etc/entropy\")'." - :type '(repeat string) - :group 'smime) - (defvar smime-details-buffer "*OpenSSL output*") +(eval-and-compile + (defalias 'smime-make-temp-file + (if (fboundp 'make-temp-file) + 'make-temp-file + (lambda (prefix &optional dir-flag) ;; Simple implementation + (expand-file-name + (make-temp-name prefix) + temporary-file-directory))))) + ;; Password dialog function (defun smime-ask-passphrase () @@ -208,8 +217,7 @@ to set this to e.g. `(\"-rand\" \"/etc/entropy\")'." ;; OpenSSL wrappers. (defun smime-call-openssl-region (b e buf &rest args) - (case (apply 'call-process-region b e smime-openssl-program nil - buf nil (append smime-extra-arguments args)) + (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) (0 t) (1 (message "OpenSSL: An error occurred parsing the command options.") nil) (2 (message "OpenSSL: One of the input files could not be read.") nil) @@ -230,27 +238,34 @@ If signing fails, the buffer is not modified. Region is assumed to have proper MIME tags. KEYFILES is expected to contain a PEM encoded private key and certificate as its car, and a list of additional certificates to include in its caar." + (smime-new-details-buffer) (let ((keyfile (car keyfiles)) (certfiles (and (cdr keyfiles) (cadr keyfiles))) (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) - (passphrase (smime-ask-passphrase))) + (passphrase (smime-ask-passphrase)) + (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (prog1 - (when (apply 'smime-call-openssl-region b e buffer "smime" "-sign" - "-signer" (expand-file-name keyfile) - (append - (smime-make-certfiles certfiles) - (if passphrase - (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))) + (when (prog1 + (apply 'smime-call-openssl-region b e (list buffer tmpfile) + "smime" "-sign" "-signer" (expand-file-name keyfile) + (append + (smime-make-certfiles certfiles) + (if passphrase + (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))) + (if passphrase + (setenv "GNUS_SMIME_PASSPHRASE" "" t)) + (with-current-buffer smime-details-buffer + (insert-file-contents tmpfile) + (delete-file tmpfile))) (delete-region b e) (insert-buffer-substring buffer) + (goto-char b) (when (looking-at "^MIME-Version: 1.0$") (delete-region (point) (progn (forward-line 1) (point)))) t) - (if passphrase - (setenv "GNUS_SMIME_PASSPHRASE" "" t)) - (with-current-buffer (get-buffer-create smime-details-buffer) + (with-current-buffer smime-details-buffer (goto-char (point-max)) (insert-buffer-substring buffer)) (kill-buffer buffer)))) @@ -260,16 +275,24 @@ to include in its caar." If encryption fails, the buffer is not modified. Region is assumed to have proper MIME tags. CERTFILES is a list of filenames, each file is expected to contain of a PEM encoded certificate." - (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))) + (smime-new-details-buffer) + (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) + (tmpfile (smime-make-temp-file "smime"))) (prog1 - (when (apply 'smime-call-openssl-region b e buffer "smime" "-encrypt" - smime-encrypt-cipher (mapcar 'expand-file-name certfiles)) + (when (prog1 + (apply 'smime-call-openssl-region b e (list buffer tmpfile) + "smime" "-encrypt" smime-encrypt-cipher + (mapcar 'expand-file-name certfiles)) + (with-current-buffer smime-details-buffer + (insert-file-contents tmpfile) + (delete-file tmpfile))) (delete-region b e) (insert-buffer-substring buffer) + (goto-char b) (when (looking-at "^MIME-Version: 1.0$") (delete-region (point) (progn (forward-line 1) (point)))) t) - (with-current-buffer (get-buffer-create smime-details-buffer) + (with-current-buffer smime-details-buffer (goto-char (point-max)) (insert-buffer-substring buffer)) (kill-buffer buffer)))) @@ -345,7 +368,7 @@ in the buffer specified by `smime-details-buffer'." (smime-new-details-buffer) (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) CAs (passphrase (smime-ask-passphrase)) - (tmpfile (make-temp-file "smime"))) + (tmpfile (smime-make-temp-file "smime"))) (if passphrase (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) (if (prog1 @@ -452,10 +475,11 @@ A string or a list of strings is returned." (caddr curkey) (smime-get-certfiles keyfile otherkeys))))) -(defalias 'smime-point-at-eol - (if (fboundp 'point-at-eol) - 'point-at-eol - 'line-end-position)) +(eval-and-compile + (defalias 'smime-point-at-eol + (if (fboundp 'point-at-eol) + 'point-at-eol + 'line-end-position))) (defun smime-buffer-as-string-region (b e) "Return each line in region between B and E as a list of strings."