smime.el

   1 ;;; smime.el --- S/MIME interface.
   2
   3 ;; Copyright (C) 1999 Daiki Ueno
   4
   5 ;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
   6 ;; Created: 1999/12/08
   7 ;; Keywords: S/MIME, OpenSSL
   8
   9 ;; This file is part of SEMI (Secure Emacs MIME Interface).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26
  27 ;;; Commentary:
  28
  29 ;;    This module is based on
  30
  31 ;;      [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
  32 ;;          by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
  33 ;;          Pawling, J. and Schaad, J. (1999/06)
  34
  35 ;;      [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
  36 ;;          by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
  37 ;;          and L. Repka. (1998/03)
  38
  39 ;;; Code:
  40
  41 (require 'path-util)
  42
  43 (defgroup smime ()
  44   "S/MIME interface"
  45   :group 'mime)
  46
  47 (defcustom smime-program "smime"
  48   "The S/MIME executable."
  49   :group 'smime
  50   :type 'string)
  51
  52 (defcustom smime-shell-file-name "/bin/sh"
  53   "File name to load inferior shells from.  Bourne shell or its equivalent
  54 \(not tcsh) is needed for \"2>\"."
  55   :group 'smime
  56   :type 'string)
  57
  58 (defcustom smime-shell-command-switch "-c"
  59   "Switch used to have the shell execute its command line argument."
  60   :group 'smime
  61   :type 'string)
  62
  63 (defcustom smime-x509-program
  64   (let ((file (exec-installed-p "openssl")))
  65     (and file (list file "x509" "-noout")))
  66   "External program for x509 parser."
  67   :group 'smime
  68   :type 'string)
  69
  70 (defcustom smime-cache-passphrase t
  71   "Cache passphrase."
  72   :group 'smime
  73   :type 'boolean)
  74
  75 (defcustom smime-certificate-directory "~/.w3/certs"
  76   "Certificate directory."
  77   :group 'smime
  78   :type 'directory)
  79
  80 (defcustom smime-public-key-file nil
  81   "Public key file."
  82   :group 'smime
  83   :type 'boolean)
  84
  85 (defcustom smime-private-key-file nil
  86   "Private key file."
  87   :group 'smime
  88   :type 'boolean)
  89
  90 (defvar smime-errors-buffer " *S/MIME errors*")
  91 (defvar smime-output-buffer " *S/MIME output*")
  92
  93 ;;; @ utility functions
  94 ;;;
  95 (put 'smime-process-when-success 'lisp-indent-function 0)
  96
  97 (defmacro smime-process-when-success (&rest body)
  98   `(with-current-buffer smime-output-buffer
  99      (if (zerop (buffer-size)) nil ,@body t)))
 100
 101 (defvar smime-passphrase-cache-expiry 16)
 102 (defvar smime-passphrase-cache (make-vector 7 0))
 103
 104 (defvar smime-read-passphrase nil)
 105 (defun smime-read-passphrase (prompt &optional key)
 106   (if (not smime-read-passphrase)
 107       (if (functionp 'read-passwd)
 108           (setq smime-read-passphrase 'read-passwd)
 109         (if (load "passwd" t)
 110             (setq smime-read-passphrase 'read-passwd)
 111           (autoload 'ange-ftp-read-passwd "ange-ftp")
 112           (setq smime-read-passphrase 'ange-ftp-read-passwd))))
 113   (or (and smime-cache-passphrase
 114            (symbol-value (intern-soft key smime-passphrase-cache)))
 115       (funcall smime-read-passphrase prompt)))
 116
 117 (defun smime-add-passphrase-cache (key passphrase)
 118   (set (intern key smime-passphrase-cache)
 119        passphrase)
 120   (run-at-time smime-passphrase-cache-expiry nil
 121                #'smime-remove-passphrase-cache
 122                key))
 123
 124 (defun smime-remove-passphrase-cache (key)
 125   (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
 126     (when passphrase
 127       (fillarray passphrase ?_)
 128       (unintern key smime-passphrase-cache))))
 129
 130 (defsubst smime-parse-attribute (string)
 131   (delq nil (mapcar
 132              (lambda (attr)
 133                (if (string-match "=" attr)
 134                    (cons (intern (substring attr 0 (match-beginning 0)))
 135                          (substring attr (match-end 0)))
 136                  nil))
 137              (split-string string "/"))))
 138
 139 (defsubst smime-query-signer (start end)
 140   (smime-process-region start end smime-program (list "-qs"))
 141   (with-current-buffer smime-output-buffer
 142     (if (zerop (buffer-size)) nil
 143       (goto-char (point-min))
 144       (when (re-search-forward "^/" nil t)
 145         (smime-parse-attribute
 146          (buffer-substring (point) (progn (end-of-line)(point)))))
 147       )))
 148
 149 (defsubst smime-x509-hash (cert-file)
 150   (with-current-buffer (get-buffer-create smime-output-buffer)
 151     (buffer-disable-undo)
 152     (erase-buffer)
 153     (insert-file-contents cert-file)
 154     (apply #'call-process-region
 155            (point-min)(point-max) (car smime-x509-program)
 156            t t nil (cons "-hash" (cdr smime-x509-program)))
 157     (if (zerop (buffer-size)) nil
 158       (buffer-substring (point-min) (1- (point-max))))))
 159
 160 (defsubst smime-x509-subject (cert-file)
 161   (with-current-buffer (get-buffer-create smime-output-buffer)
 162     (buffer-disable-undo)
 163     (erase-buffer)
 164     (insert-file-contents cert-file)
 165     (apply #'call-process-region
 166            (point-min)(point-max) (car smime-x509-program)
 167            t t nil (cons "-subject" (cdr smime-x509-program)))
 168     (if (zerop (buffer-size)) nil
 169       (goto-char (point-min))
 170       (when (re-search-forward "^subject=" nil t)
 171         (smime-parse-attribute
 172          (buffer-substring (point)(progn (end-of-line)(point))))))))
 173
 174 (defsubst smime-search-certificate (attr)
 175   (let ((files (if (file-directory-p smime-certificate-directory)
 176                    (directory-files smime-certificate-directory)
 177                  nil)))
 178     (catch 'found
 179       (while files
 180         (if (or (string-equal
 181                  (cdr (assq 'CN (smime-x509-subject (car files))))
 182                  (cdr (assq 'CN attr)))
 183                 (string-equal
 184                  (cdr (assq 'Email (smime-x509-subject (car files))))
 185                  (cdr (assq 'Email attr))))
 186             (throw 'found (car files)))
 187         (pop files)))))
 188
 189 (defun smime-process-region (start end program args)
 190   (let* ((errors-file-name
 191           (concat temporary-file-directory
 192                   (make-temp-name "smime-errors")))
 193          (args (append args (list (concat "2>" errors-file-name))))
 194          (shell-file-name smime-shell-file-name)
 195          (shell-command-switch smime-shell-command-switch)
 196          (process-connection-type nil)
 197          process status exit-status)
 198     (with-current-buffer (get-buffer-create smime-output-buffer)
 199       (buffer-disable-undo)
 200       (erase-buffer))
 201     (as-binary-process
 202      (setq process
 203            (apply #'start-process-shell-command "*S/MIME*"
 204                   smime-output-buffer program args)))
 205     (set-process-sentinel process 'ignore)
 206     (process-send-region process start end)
 207     (process-send-eof process)
 208     (while (eq 'run (process-status process))
 209       (accept-process-output process 5))
 210     (setq status (process-status process)
 211           exit-status (process-exit-status process))
 212     (delete-process process)
 213     (with-current-buffer smime-output-buffer
 214       (goto-char (point-min))
 215       (while (re-search-forward "\r$" (point-max) t)
 216         (replace-match ""))
 217
 218       (if (memq status '(stop signal))
 219           (error "%s exited abnormally: '%s'" program exit-status))
 220       (if (= 127 exit-status)
 221           (error "%s could not be found" program))
 222
 223       (set-buffer (get-buffer-create smime-errors-buffer))
 224       (buffer-disable-undo)
 225       (erase-buffer)
 226       (insert-file-contents errors-file-name)
 227       (delete-file errors-file-name)
 228
 229       (if (and process (eq 'run (process-status process)))
 230           (interrupt-process process))
 231       )
 232     ))
 233
 234 ;;; @ interface functions
 235 ;;;
 236
 237 ;;;###autoload
 238 (defun smime-encrypt-region (start end)
 239   "Encrypt the current region between START and END."
 240   (let* ((key-file
 241           (or smime-private-key-file
 242               (expand-file-name (read-file-name "Public key file: "))))
 243          (args (list "-e" key-file)))
 244     (smime-process-region start end smime-program args)
 245     (smime-process-when-success nil)))
 246
 247 ;;;###autoload
 248 (defun smime-decrypt-region (start end)
 249   "Decrypt the current region between START and END."
 250   (let* ((key-file
 251           (or smime-private-key-file
 252               (expand-file-name (read-file-name "Private key file: "))))
 253          (hash (smime-x509-hash key-file))
 254          (passphrase (smime-read-passphrase
 255                       (format "S/MIME passphrase for %s: " hash)
 256                       hash))
 257          (args (list "-d" key-file passphrase)))
 258     (smime-process-region start end smime-program args)
 259     (smime-process-when-success
 260       (when smime-cache-passphrase
 261         (smime-add-passphrase-cache hash passphrase)))))
 262
 263 ;;;###autoload
 264 (defun smime-sign-region (start end &optional cleartext)
 265   "Make the signature from text between START and END.
 266 If the optional 3rd argument CLEARTEXT is non-nil, it does not create
 267 a detached signature."
 268   (let* ((key-file
 269           (or smime-private-key-file
 270               (expand-file-name (read-file-name "Private key file: "))))
 271          (hash (smime-x509-hash key-file))
 272          (passphrase (smime-read-passphrase
 273                       (format "S/MIME passphrase for %s: " hash)
 274                       hash))
 275          (args (list "-ds" key-file passphrase)))
 276     (smime-process-region start end smime-program args)
 277     (smime-process-when-success
 278       (when smime-cache-passphrase
 279         (smime-add-passphrase-cache hash passphrase)))))
 280
 281 ;;;###autoload
 282 (defun smime-verify-region (start end signature)
 283   "Verify the current region between START and END.
 284 If the optional 3rd argument SIGNATURE is non-nil, it is treated as
 285 the detached signature of the current region."
 286   (let* ((basename (expand-file-name "smime" temporary-file-directory))
 287          (orig-file (make-temp-name basename))
 288          (args (list "-qs" signature))
 289          (orig-mode (default-file-modes))
 290          cert-file)
 291     (unwind-protect
 292         (progn
 293           (set-default-file-modes 448)
 294           (write-region-as-binary start end orig-file)
 295           )
 296       (set-default-file-modes orig-mode))
 297     (with-temp-buffer
 298       (insert-file-contents-as-binary signature)
 299       (goto-char (point-max))
 300       (insert "\n")
 301       (insert-file-contents-as-binary
 302        (or (smime-search-certificate
 303             (smime-query-signer (point-min)(point-max)))
 304            (expand-file-name
 305             (read-file-name "Certificate file: "))))
 306       (smime-process-region (point-min)(point-max) smime-program args))
 307     (smime-process-when-success
 308       (when smime-cache-passphrase
 309         (smime-add-passphrase-cache hash passphrase)))
 310     ))
 311
 312 (provide 'smime)
 313
 314 ;;; smime.el ends here