--- /dev/null
+;;; smime.el --- S/MIME interface.
+
+;; Copyright (C) 1999 Daiki Ueno
+
+;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Created: 1999/12/08
+;; Keywords: S/MIME, OpenSSL
+
+;; This file is part of SEMI (Secure Emacs MIME Interface).
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; This module is based on
+
+;; [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
+;; by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
+;; Pawling, J. and Schaad, J. (1999/06)
+
+;; [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
+;; by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
+;; and L. Repka. (1998/03)
+
+;;; Code:
+
+(require 'path-util)
+
+(defgroup smime ()
+ "S/MIME interface"
+ :group 'mime)
+
+(defcustom smime-program "smime"
+ "The S/MIME executable."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-file-name "/bin/sh"
+ "File name to load inferior shells from. Bourne shell or its equivalent
+\(not tcsh) is needed for \"2>\"."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-shell-command-switch "-c"
+ "Switch used to have the shell execute its command line argument."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-x509-program
+ (let ((file (exec-installed-p "openssl")))
+ (and file (list file "x509" "-noout")))
+ "External program for x509 parser."
+ :group 'smime
+ :type 'string)
+
+(defcustom smime-cache-passphrase t
+ "Cache passphrase."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-certificate-directory "~/.w3/certs"
+ "Certificate directory."
+ :group 'smime
+ :type 'directory)
+
+(defcustom smime-public-key-file nil
+ "Public key file."
+ :group 'smime
+ :type 'boolean)
+
+(defcustom smime-private-key-file nil
+ "Private key file."
+ :group 'smime
+ :type 'boolean)
+
+(defvar smime-errors-buffer " *S/MIME errors*")
+(defvar smime-output-buffer " *S/MIME output*")
+
+;;; @ utility functions
+;;;
+(put 'smime-process-when-success 'lisp-indent-function 0)
+
+(defmacro smime-process-when-success (&rest body)
+ `(with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil ,@body t)))
+
+(defvar smime-passphrase-cache-expiry 16)
+(defvar smime-passphrase-cache (make-vector 7 0))
+
+(defvar smime-read-passphrase nil)
+(defun smime-read-passphrase (prompt &optional key)
+ (if (not smime-read-passphrase)
+ (if (functionp 'read-passwd)
+ (setq smime-read-passphrase 'read-passwd)
+ (if (load "passwd" t)
+ (setq smime-read-passphrase 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq smime-read-passphrase 'ange-ftp-read-passwd))))
+ (or (and smime-cache-passphrase
+ (symbol-value (intern-soft key smime-passphrase-cache)))
+ (funcall smime-read-passphrase prompt)))
+
+(defun smime-add-passphrase-cache (key passphrase)
+ (set (intern key smime-passphrase-cache)
+ passphrase)
+ (run-at-time smime-passphrase-cache-expiry nil
+ #'smime-remove-passphrase-cache
+ key))
+
+(defun smime-remove-passphrase-cache (key)
+ (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
+ (when passphrase
+ (fillarray passphrase ?_)
+ (unintern key smime-passphrase-cache))))
+
+(defsubst smime-parse-attribute (string)
+ (delq nil (mapcar
+ (lambda (attr)
+ (if (string-match "=" attr)
+ (cons (intern (substring attr 0 (match-beginning 0)))
+ (substring attr (match-end 0)))
+ nil))
+ (split-string string "/"))))
+
+(defsubst smime-query-signer (start end)
+ (smime-process-region start end smime-program (list "-qs"))
+ (with-current-buffer smime-output-buffer
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^/" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point) (progn (end-of-line)(point)))))
+ )))
+
+(defsubst smime-x509-hash (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents cert-file)
+ (apply #'call-process-region
+ (point-min)(point-max) (car smime-x509-program)
+ t t nil (cons "-hash" (cdr smime-x509-program)))
+ (if (zerop (buffer-size)) nil
+ (buffer-substring (point-min) (1- (point-max))))))
+
+(defsubst smime-x509-subject (cert-file)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents cert-file)
+ (apply #'call-process-region
+ (point-min)(point-max) (car smime-x509-program)
+ t t nil (cons "-subject" (cdr smime-x509-program)))
+ (if (zerop (buffer-size)) nil
+ (goto-char (point-min))
+ (when (re-search-forward "^subject=" nil t)
+ (smime-parse-attribute
+ (buffer-substring (point)(progn (end-of-line)(point))))))))
+
+(defsubst smime-search-certificate (attr)
+ (let ((files (if (file-directory-p smime-certificate-directory)
+ (directory-files smime-certificate-directory)
+ nil)))
+ (catch 'found
+ (while files
+ (if (or (string-equal
+ (cdr (assq 'CN (smime-x509-subject (car files))))
+ (cdr (assq 'CN attr)))
+ (string-equal
+ (cdr (assq 'Email (smime-x509-subject (car files))))
+ (cdr (assq 'Email attr))))
+ (throw 'found (car files)))
+ (pop files)))))
+
+(defun smime-process-region (start end program args)
+ (let* ((errors-file-name
+ (concat temporary-file-directory
+ (make-temp-name "smime-errors")))
+ (args (append args (list (concat "2>" errors-file-name))))
+ (shell-file-name smime-shell-file-name)
+ (shell-command-switch smime-shell-command-switch)
+ (process-connection-type nil)
+ process status exit-status)
+ (with-current-buffer (get-buffer-create smime-output-buffer)
+ (buffer-disable-undo)
+ (erase-buffer))
+ (as-binary-process
+ (setq process
+ (apply #'start-process-shell-command "*S/MIME*"
+ smime-output-buffer program args)))
+ (set-process-sentinel process 'ignore)
+ (process-send-region process start end)
+ (process-send-eof process)
+ (while (eq 'run (process-status process))
+ (accept-process-output process 5))
+ (setq status (process-status process)
+ exit-status (process-exit-status process))
+ (delete-process process)
+ (with-current-buffer smime-output-buffer
+ (goto-char (point-min))
+ (while (re-search-forward "\r$" (point-max) t)
+ (replace-match ""))
+
+ (if (memq status '(stop signal))
+ (error "%s exited abnormally: '%s'" program exit-status))
+ (if (= 127 exit-status)
+ (error "%s could not be found" program))
+
+ (set-buffer (get-buffer-create smime-errors-buffer))
+ (buffer-disable-undo)
+ (erase-buffer)
+ (insert-file-contents errors-file-name)
+ (delete-file errors-file-name)
+
+ (if (and process (eq 'run (process-status process)))
+ (interrupt-process process))
+ )
+ ))
+
+;;; @ interface functions
+;;;
+
+;;;###autoload
+(defun smime-encrypt-region (start end)
+ "Encrypt the current region between START and END."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Public key file: "))))
+ (args (list "-e" key-file)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success nil)))
+
+;;;###autoload
+(defun smime-decrypt-region (start end)
+ "Decrypt the current region between START and END."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Private key file: "))))
+ (hash (smime-x509-hash key-file))
+ (passphrase (smime-read-passphrase
+ (format "S/MIME passphrase for %s: " hash)
+ hash))
+ (args (list "-d" key-file passphrase)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success
+ (when smime-cache-passphrase
+ (smime-add-passphrase-cache hash passphrase)))))
+
+;;;###autoload
+(defun smime-sign-region (start end &optional cleartext)
+ "Make the signature from text between START and END.
+If the optional 3rd argument CLEARTEXT is non-nil, it does not create
+a detached signature."
+ (let* ((key-file
+ (or smime-private-key-file
+ (expand-file-name (read-file-name "Private key file: "))))
+ (hash (smime-x509-hash key-file))
+ (passphrase (smime-read-passphrase
+ (format "S/MIME passphrase for %s: " hash)
+ hash))
+ (args (list "-ds" key-file passphrase)))
+ (smime-process-region start end smime-program args)
+ (smime-process-when-success
+ (when smime-cache-passphrase
+ (smime-add-passphrase-cache hash passphrase)))))
+
+;;;###autoload
+(defun smime-verify-region (start end signature)
+ "Verify the current region between START and END.
+If the optional 3rd argument SIGNATURE is non-nil, it is treated as
+the detached signature of the current region."
+ (let* ((basename (expand-file-name "smime" temporary-file-directory))
+ (orig-file (make-temp-name basename))
+ (args (list "-qs" signature))
+ (orig-mode (default-file-modes))
+ cert-file)
+ (unwind-protect
+ (progn
+ (set-default-file-modes 448)
+ (write-region-as-binary start end orig-file)
+ )
+ (set-default-file-modes orig-mode))
+ (with-temp-buffer
+ (insert-file-contents-as-binary signature)
+ (goto-char (point-max))
+ (insert "\n")
+ (insert-file-contents-as-binary
+ (or (smime-search-certificate
+ (smime-query-signer (point-min)(point-max)))
+ (expand-file-name
+ (read-file-name "Certificate file: "))))
+ (smime-process-region (point-min)(point-max) smime-program args))
+ (smime-process-when-success
+ (when smime-cache-passphrase
+ (smime-add-passphrase-cache hash passphrase)))
+ ))
+
+(provide 'smime)
+
+;;; smime.el ends here
projects / elisp / semi.git / commitdiff