320 lines
10 KiB
EmacsLisp
320 lines
10 KiB
EmacsLisp
;;; 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)
|
|
(require 'mel)
|
|
;; binary-funcall, binary-write-decoded-region, binary-insert-encoded-file
|
|
(eval-when-compile (require 'static))
|
|
|
|
(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)
|
|
(apply #'call-process (car smime-x509-program) nil t nil
|
|
(append (cdr smime-x509-program)
|
|
(list "-hash" "-in" cert-file)))
|
|
(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)
|
|
(apply #'call-process (car smime-x509-program) nil t nil
|
|
(append (cdr smime-x509-program)
|
|
(list "-subject" "-in" cert-file)))
|
|
(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-find-certificate (attr)
|
|
(let ((files
|
|
(and (file-directory-p smime-certificate-directory)
|
|
(delq nil (mapcar (lambda (file)
|
|
(if (file-directory-p file) nil
|
|
file))
|
|
(directory-files
|
|
smime-certificate-directory
|
|
'full))))))
|
|
(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 (make-temp-file "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))
|
|
(setq process
|
|
(apply #'binary-funcall #'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
|
|
(goto-char (point-min))
|
|
(delete-region (point-min) (progn
|
|
(re-search-forward "^$" nil t)
|
|
(1+ (point)))))))
|
|
|
|
;;;###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
|
|
(goto-char (point-min))
|
|
(delete-region (point-min) (progn
|
|
(re-search-forward "^$" nil t)
|
|
(1+ (point))))
|
|
(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* ((orig-file (make-temp-file "smime"))
|
|
(orig-mode (default-file-modes)))
|
|
(unwind-protect
|
|
(progn
|
|
(set-default-file-modes 448)
|
|
(binary-write-decoded-region start end orig-file))
|
|
(set-default-file-modes orig-mode))
|
|
(with-temp-buffer
|
|
(binary-insert-encoded-file signature)
|
|
(goto-char (point-max))
|
|
(binary-insert-encoded-file
|
|
(or (smime-find-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
|
|
(list "-dv" orig-file)))
|
|
(smime-process-when-success nil)))
|
|
|
|
(provide 'smime)
|
|
|
|
;;; smime.el ends here
|