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 (require 'raw-io)
  43 (eval-when-compile (require 'static))
  44
  45 (defgroup smime ()
  46   "S/MIME interface"
  47   :group 'mime)
  48
  49 (defcustom smime-program "smime"
  50   "The S/MIME executable."
  51   :group 'smime
  52   :type 'string)
  53
  54 (defcustom smime-shell-file-name "/bin/sh"
  55   "File name to load inferior shells from.  Bourne shell or its equivalent
  56 \(not tcsh) is needed for \"2>\"."
  57   :group 'smime
  58   :type 'string)
  59
  60 (defcustom smime-shell-command-switch "-c"
  61   "Switch used to have the shell execute its command line argument."
  62   :group 'smime
  63   :type 'string)
  64
  65 (defcustom smime-x509-program
  66   (let ((file (exec-installed-p "openssl")))
  67     (and file (list file "x509" "-noout")))
  68   "External program for x509 parser."
  69   :group 'smime
  70   :type 'string)
  71
  72 (defcustom smime-cache-passphrase t
  73   "Cache passphrase."
  74   :group 'smime
  75   :type 'boolean)
  76
  77 (defcustom smime-certificate-directory "~/.w3/certs"
  78   "Certificate directory."
  79   :group 'smime
  80   :type 'directory)
  81
  82 (defcustom smime-public-key-file nil
  83   "Public key file."
  84   :group 'smime
  85   :type 'boolean)
  86
  87 (defcustom smime-private-key-file nil
  88   "Private key file."
  89   :group 'smime
  90   :type 'boolean)
  91
  92 (defvar smime-errors-buffer " *S/MIME errors*")
  93 (defvar smime-output-buffer " *S/MIME output*")
  94
  95 ;;; @ utility functions
  96 ;;;
  97 (put 'smime-process-when-success 'lisp-indent-function 0)
  98
  99 (defmacro smime-process-when-success (&rest body)
 100   `(with-current-buffer smime-output-buffer
 101      (if (zerop (buffer-size)) nil ,@body t)))
 102
 103 (defvar smime-passphrase-cache-expiry 16)
 104 (defvar smime-passphrase-cache (make-vector 7 0))
 105
 106 (defvar smime-read-passphrase nil)
 107 (defun smime-read-passphrase (prompt &optional key)
 108   (if (not smime-read-passphrase)
 109       (if (functionp 'read-passwd)
 110           (setq smime-read-passphrase 'read-passwd)
 111         (if (load "passwd" t)
 112             (setq smime-read-passphrase 'read-passwd)
 113           (autoload 'ange-ftp-read-passwd "ange-ftp")
 114           (setq smime-read-passphrase 'ange-ftp-read-passwd))))
 115   (or (and smime-cache-passphrase
 116            (symbol-value (intern-soft key smime-passphrase-cache)))
 117       (funcall smime-read-passphrase prompt)))
 118
 119 (defun smime-add-passphrase-cache (key passphrase)
 120   (set (intern key smime-passphrase-cache)
 121        passphrase)
 122   (run-at-time smime-passphrase-cache-expiry nil
 123                #'smime-remove-passphrase-cache
 124                key))
 125
 126 (defun smime-remove-passphrase-cache (key)
 127   (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
 128     (when passphrase
 129       (fillarray passphrase ?_)
 130       (unintern key smime-passphrase-cache))))
 131
 132 (defsubst smime-parse-attribute (string)
 133   (delq nil (mapcar
 134              (lambda (attr)
 135                (if (string-match "=" attr)
 136                    (cons (intern (substring attr 0 (match-beginning 0)))
 137                          (substring attr (match-end 0)))
 138                  nil))
 139              (split-string string "/"))))
 140
 141 (defsubst smime-query-signer (start end)
 142   (smime-process-region start end smime-program (list "-qs"))
 143   (with-current-buffer smime-output-buffer
 144     (if (zerop (buffer-size)) nil
 145       (goto-char (point-min))
 146       (when (re-search-forward "^/" nil t)
 147         (smime-parse-attribute
 148          (buffer-substring (point) (progn (end-of-line)(point)))))
 149       )))
 150
 151 (defsubst smime-x509-hash (cert-file)
 152   (with-current-buffer (get-buffer-create smime-output-buffer)
 153     (buffer-disable-undo)
 154     (erase-buffer)
 155     (apply #'call-process (car smime-x509-program) nil t nil
 156            (append (cdr smime-x509-program)
 157                    (list "-hash" "-in" cert-file)))
 158     (if (zerop (buffer-size)) nil
 159       (buffer-substring (point-min) (1- (point-max))))))
 160
 161 (defsubst smime-x509-subject (cert-file)
 162   (with-current-buffer (get-buffer-create smime-output-buffer)
 163     (buffer-disable-undo)
 164     (erase-buffer)
 165     (apply #'call-process (car smime-x509-program) nil t nil
 166            (append (cdr smime-x509-program)
 167                    (list "-subject" "-in" cert-file)))
 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-find-certificate (attr)
 175   (let ((files
 176          (and (file-directory-p smime-certificate-directory)
 177               (delq nil (mapcar (lambda (file)
 178                                   (if (file-directory-p file) nil
 179                                     file))
 180                                 (directory-files
 181                                  smime-certificate-directory
 182                                  'full))))))
 183     (catch 'found
 184       (while files
 185         (if (or (string-equal
 186                  (cdr (assq 'CN (smime-x509-subject (car files))))
 187                  (cdr (assq 'CN attr)))
 188                 (string-equal
 189                  (cdr (assq 'Email (smime-x509-subject (car files))))
 190                  (cdr (assq 'Email attr))))
 191             (throw 'found (car files)))
 192         (pop files)))))
 193
 194 (defun smime-process-region (start end program args)
 195   (let* ((errors-file-name
 196           (concat temporary-file-directory
 197                   (make-temp-name "smime-errors")))
 198          (args (append args (list (concat "2>" errors-file-name))))
 199          (shell-file-name smime-shell-file-name)
 200          (shell-command-switch smime-shell-command-switch)
 201          (process-connection-type nil)
 202          process status exit-status)
 203     (with-current-buffer (get-buffer-create smime-output-buffer)
 204       (buffer-disable-undo)
 205       (erase-buffer))
 206     (setq process
 207           (apply #'binary-start-process-shell-command "*S/MIME*"
 208                  smime-output-buffer program args))
 209     (set-process-sentinel process 'ignore)
 210     (process-send-region process start end)
 211     (process-send-eof process)
 212     (while (eq 'run (process-status process))
 213       (accept-process-output process 5))
 214     (setq status (process-status process)
 215           exit-status (process-exit-status process))
 216     (delete-process process)
 217     (with-current-buffer smime-output-buffer
 218       (goto-char (point-min))
 219       (while (re-search-forward "\r$" (point-max) t)
 220         (replace-match ""))
 221
 222       (if (memq status '(stop signal))
 223           (error "%s exited abnormally: '%s'" program exit-status))
 224       (if (= 127 exit-status)
 225           (error "%s could not be found" program))
 226
 227       (set-buffer (get-buffer-create smime-errors-buffer))
 228       (buffer-disable-undo)
 229       (erase-buffer)
 230       (insert-file-contents errors-file-name)
 231       (delete-file errors-file-name)
 232
 233       (if (and process (eq 'run (process-status process)))
 234           (interrupt-process process))
 235       )
 236     ))
 237
 238 ;;; @ interface functions
 239 ;;;
 240
 241 ;;;###autoload
 242 (defun smime-encrypt-region (start end)
 243   "Encrypt the current region between START and END."
 244   (let* ((key-file
 245           (or smime-private-key-file
 246               (expand-file-name (read-file-name "Public key file: "))))
 247          (args (list "-e" key-file)))
 248     (smime-process-region start end smime-program args)
 249     (smime-process-when-success
 250       (goto-char (point-min))
 251       (delete-region (point-min) (progn
 252                                    (re-search-forward "^$" nil t)
 253                                    (1+ (point)))))))
 254
 255 ;;;###autoload
 256 (defun smime-decrypt-region (start end)
 257   "Decrypt the current region between START and END."
 258   (let* ((key-file
 259           (or smime-private-key-file
 260               (expand-file-name (read-file-name "Private key file: "))))
 261          (hash (smime-x509-hash key-file))
 262          (passphrase (smime-read-passphrase
 263                       (format "S/MIME passphrase for %s: " hash)
 264                       hash))
 265          (args (list "-d" key-file passphrase)))
 266     (smime-process-region start end smime-program args)
 267     (smime-process-when-success
 268       (when smime-cache-passphrase
 269         (smime-add-passphrase-cache hash passphrase)))))
 270
 271 ;;;###autoload
 272 (defun smime-sign-region (start end &optional cleartext)
 273   "Make the signature from text between START and END.
 274 If the optional 3rd argument CLEARTEXT is non-nil, it does not create
 275 a detached signature."
 276   (let* ((key-file
 277           (or smime-private-key-file
 278               (expand-file-name (read-file-name "Private key file: "))))
 279          (hash (smime-x509-hash key-file))
 280          (passphrase (smime-read-passphrase
 281                       (format "S/MIME passphrase for %s: " hash)
 282                       hash))
 283          (args (list "-ds" key-file passphrase)))
 284     (smime-process-region start end smime-program args)
 285     (smime-process-when-success
 286       (goto-char (point-min))
 287       (delete-region (point-min) (progn
 288                                    (re-search-forward "^$" nil t)
 289                                    (1+ (point))))
 290       (when smime-cache-passphrase
 291         (smime-add-passphrase-cache hash passphrase)))))
 292
 293 ;;;###autoload
 294 (defun smime-verify-region (start end signature)
 295   "Verify the current region between START and END.
 296 If the optional 3rd argument SIGNATURE is non-nil, it is treated as
 297 the detached signature of the current region."
 298   (let* ((basename (expand-file-name "smime" temporary-file-directory))
 299          (orig-file (make-temp-name basename))
 300          (orig-mode (default-file-modes)))
 301     (unwind-protect
 302         (progn
 303           (set-default-file-modes 448)
 304           (binary-write-region start end orig-file))
 305       (set-default-file-modes orig-mode))
 306     (with-temp-buffer
 307       (binary-insert-file-contents signature)
 308       (goto-char (point-max))
 309       (binary-insert-file-contents
 310        (or (smime-find-certificate
 311             (smime-query-signer (point-min)(point-max)))
 312            (expand-file-name
 313             (read-file-name "Certificate file: "))))
 314       (smime-process-region (point-min)(point-max) smime-program
 315                             (list "-dv" orig-file)))
 316     (smime-process-when-success nil)))
 317
 318 (provide 'smime)
 319
 320 ;;; smime.el ends here