;;; smime.el --- S/MIME support library
-;; Copyright (c) 2000 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: SMIME X.509 PEM OpenSSL
;; that decision. One might think that this even influenced were I
;; store my keys, and one would probably be right. :-)
;;
+;; Update: Mathias Herberts sent the patch. However, it uses
+;; environment variables to pass the password to OpenSSL, which is
+;; slightly insecure. Hence a new todo: use a better -passin method.
+;;
;; Suggestions and comments are appreciated, mail me at simon@josefsson.org.
;; <rant>
;;; Code:
(require 'dig)
+(require 'comint)
(eval-when-compile (require 'cl))
(defgroup smime nil
:type 'directory
:group 'smime)
-(defcustom smime-openssl-program
- (and (condition-case ()
+(defcustom smime-openssl-program
+ (and (condition-case ()
(eq 0 (call-process "openssl" nil nil nil "version"))
(error nil))
"openssl")
:type 'string
:group 'smime)
+;; OpenSSL option to select the encryption cipher
+
+(defcustom smime-encrypt-cipher "-des3"
+ "Cipher algorithm used for encryption."
+ :type '(choice (const :tag "Triple DES" "-des3")
+ (const :tag "DES" "-des")
+ (const :tag "RC2 40 bits" "-rc2-40")
+ (const :tag "RC2 64 bits" "-rc2-64")
+ (const :tag "RC2 128 bits" "-rc2-128"))
+ :group 'smime)
+
(defcustom smime-dns-server nil
"DNS server to query certificates from.
If nil, use system defaults."
(defvar smime-details-buffer "*OpenSSL output*")
+;; Password dialog function
+
+(defun smime-ask-passphrase ()
+ "Asks the passphrase to unlock the secret key."
+ (let ((passphrase
+ (comint-read-noecho
+ "Passphrase for secret key (RET for no passphrase): " t)))
+ (if (string= passphrase "")
+ nil
+ passphrase)))
+
;; OpenSSL wrappers.
(defun smime-call-openssl-region (b e buf &rest args)
If signing fails, the buffer is not modified. Region is assumed to
have proper MIME tags. KEYFILE is expected to contain a PEM encoded
private key and certificate."
- (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))))
+ (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
+ (passphrase (smime-ask-passphrase)))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
(prog1
- (when (smime-call-openssl-region b e buffer "smime" "-sign"
- "-signer" (expand-file-name keyfile))
+ (when (apply 'smime-call-openssl-region b e buffer "smime" "-sign"
+ "-signer" (expand-file-name keyfile)
+ (if passphrase
+ (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))
(delete-region b e)
(insert-buffer buffer)
(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)
(goto-char (point-max))
(insert-buffer buffer))
(let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))))
(prog1
(when (apply 'smime-call-openssl-region b e buffer "smime" "-encrypt"
- (mapcar 'expand-file-name certfiles))
+ smime-encrypt-cipher (mapcar 'expand-file-name certfiles))
(delete-region b e)
(insert-buffer buffer)
(when (looking-at "^MIME-Version: 1.0$")
(interactive)
(with-current-buffer (or buffer (current-buffer))
(smime-sign-region
- (point-min) (point-max)
+ (point-min) (point-max)
(or keyfile
(smime-get-key-by-email
(completing-read "Sign using which signature? " smime-keys nil nil
nil."
(interactive)
(with-current-buffer (or buffer (current-buffer))
- (smime-encrypt-region
+ (smime-encrypt-region
(point-min) (point-max)
(or certfiles
(list (read-file-name "Recipient's S/MIME certificate: "
(error "No CA configured.")))))
(with-current-buffer buffer
(erase-buffer))
- (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify"
+ (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify"
"-out" "/dev/null" CAs)
(message "S/MIME message verified succesfully.")
(message "S/MIME message NOT verified successfully.")
(let ((buffer (get-buffer-create smime-details-buffer)))
(with-current-buffer buffer
(erase-buffer))
- (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify"
+ (if (apply 'smime-call-openssl-region b e buffer "smime" "-verify"
"-noverify" "-out" '("/dev/null"))
(message "S/MIME message verified succesfully.")
(message "S/MIME message NOT verified successfully.")
(defun smime-decrypt-region (b e keyfile)
(let ((buffer (generate-new-buffer (generate-new-buffer-name "*smime*")))
- CAs)
- (when (apply 'smime-call-openssl-region b e buffer "smime" "-decrypt"
- "-recip" (list keyfile))
-
+ CAs (passphrase (smime-ask-passphrase)))
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
+ (when (apply 'smime-call-openssl-region
+ b e buffer "smime" "-decrypt"
+ "-recip" (list keyfile)
+ (if passphrase
+ (list "-passin" "env:GNUS_SMIME_PASSPHRASE" )))
)
+ (if passphrase
+ (setenv "GNUS_SMIME_PASSPHRASE" "" t))
(with-current-buffer (get-buffer-create smime-details-buffer)
(goto-char (point-max))
(insert-buffer buffer))
(kill-buffer buffer)))
-
+
;; Verify+Decrypt buffer
(defun smime-verify-buffer (&optional buffer)
Uses current buffer if BUFFER is nil, queries user of KEYFILE is nil."
(interactive)
(with-current-buffer (or buffer (current-buffer))
- (smime-decrypt-region
+ (smime-decrypt-region
(point-min) (point-max)
(expand-file-name
(or keyfile
(smime-get-key-by-email
(completing-read "Decrypt with which key? " smime-keys nil nil
- (and (listp (car-safe smime-keys))
+ (and (listp (car-safe smime-keys))
(caar smime-keys)))))))))
;; Various operations
(when (smime-call-openssl-region b e buffer "x509" "-email" "-noout")
(delete-region b e)
(insert-buffer-substring buffer)
- t)))
+ t)))
(defalias 'smime-point-at-eol
(if (fboundp 'point-at-eol)
(erase-buffer)
(insert "\nYour keys:\n")
(dolist (key smime-keys)
- (insert
+ (insert
(format "\t\t%s: %s\n" (car key) (cadr key))))
(insert "\nTrusted Certificate Authoritys:\n")
(insert "\nKnown Certificates:\n"))))
projects / elisp / gnus.git- / blobdiff