1 ;;; smime.el --- S/MIME interface.
3 ;; Copyright (C) 1999 Daiki Ueno
5 ;; Author: Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
7 ;; Keywords: S/MIME, OpenSSL
9 ;; This file is part of SEMI (Secure Emacs MIME Interface).
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.
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.
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.
29 ;; This module is based on
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)
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)
42 (eval-when-compile (require 'static))
48 (defcustom smime-program "smime"
49 "The S/MIME executable."
53 (defcustom smime-shell-file-name "/bin/sh"
54 "File name to load inferior shells from. Bourne shell or its equivalent
55 \(not tcsh) is needed for \"2>\"."
59 (defcustom smime-shell-command-switch "-c"
60 "Switch used to have the shell execute its command line argument."
64 (defcustom smime-x509-program
65 (let ((file (exec-installed-p "openssl")))
66 (and file (list file "x509" "-noout")))
67 "External program for x509 parser."
71 (defcustom smime-cache-passphrase t
76 (defcustom smime-certificate-directory "~/.w3/certs"
77 "Certificate directory."
81 (defcustom smime-public-key-file nil
86 (defcustom smime-private-key-file nil
91 (defvar smime-errors-buffer " *S/MIME errors*")
92 (defvar smime-output-buffer " *S/MIME output*")
94 ;;; @ utility functions
96 (put 'smime-process-when-success 'lisp-indent-function 0)
98 (defmacro smime-process-when-success (&rest body)
99 `(with-current-buffer smime-output-buffer
100 (if (zerop (buffer-size)) nil ,@body t)))
102 (defvar smime-passphrase-cache-expiry 16)
103 (defvar smime-passphrase-cache (make-vector 7 0))
105 (defvar smime-read-passphrase nil)
106 (defun smime-read-passphrase (prompt &optional key)
107 (if (not smime-read-passphrase)
108 (if (functionp 'read-passwd)
109 (setq smime-read-passphrase 'read-passwd)
110 (if (load "passwd" t)
111 (setq smime-read-passphrase 'read-passwd)
112 (autoload 'ange-ftp-read-passwd "ange-ftp")
113 (setq smime-read-passphrase 'ange-ftp-read-passwd))))
114 (or (and smime-cache-passphrase
115 (symbol-value (intern-soft key smime-passphrase-cache)))
116 (funcall smime-read-passphrase prompt)))
118 (defun smime-add-passphrase-cache (key passphrase)
119 (set (intern key smime-passphrase-cache)
121 (run-at-time smime-passphrase-cache-expiry nil
122 #'smime-remove-passphrase-cache
125 (defun smime-remove-passphrase-cache (key)
126 (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
128 (fillarray passphrase ?_)
129 (unintern key smime-passphrase-cache))))
131 (defsubst smime-parse-attribute (string)
134 (if (string-match "=" attr)
135 (cons (intern (substring attr 0 (match-beginning 0)))
136 (substring attr (match-end 0)))
138 (split-string string "/"))))
140 (defsubst smime-query-signer (start end)
141 (smime-process-region start end smime-program (list "-qs"))
142 (with-current-buffer smime-output-buffer
143 (if (zerop (buffer-size)) nil
144 (goto-char (point-min))
145 (when (re-search-forward "^/" nil t)
146 (smime-parse-attribute
147 (buffer-substring (point) (progn (end-of-line)(point)))))
150 (defsubst smime-x509-hash (cert-file)
151 (with-current-buffer (get-buffer-create smime-output-buffer)
152 (buffer-disable-undo)
154 (apply #'call-process (car smime-x509-program) nil t nil
155 (append (cdr smime-x509-program)
156 (list "-hash" "-in" cert-file)))
157 (if (zerop (buffer-size)) nil
158 (buffer-substring (point-min) (1- (point-max))))))
160 (defsubst smime-x509-subject (cert-file)
161 (with-current-buffer (get-buffer-create smime-output-buffer)
162 (buffer-disable-undo)
164 (apply #'call-process (car smime-x509-program) nil t nil
165 (append (cdr smime-x509-program)
166 (list "-subject" "-in" cert-file)))
167 (if (zerop (buffer-size)) nil
168 (goto-char (point-min))
169 (when (re-search-forward "^subject=" nil t)
170 (smime-parse-attribute
171 (buffer-substring (point)(progn (end-of-line)(point))))))))
173 (defsubst smime-find-certificate (attr)
175 (and (file-directory-p smime-certificate-directory)
176 (delq nil (mapcar (lambda (file)
177 (if (file-directory-p file) nil
180 smime-certificate-directory
184 (if (or (string-equal
185 (cdr (assq 'CN (smime-x509-subject (car files))))
186 (cdr (assq 'CN attr)))
188 (cdr (assq 'Email (smime-x509-subject (car files))))
189 (cdr (assq 'Email attr))))
190 (throw 'found (car files)))
193 (defun smime-process-region (start end program args)
194 (let* ((errors-file-name
195 (concat temporary-file-directory
196 (make-temp-name "smime-errors")))
197 (args (append args (list (concat "2>" errors-file-name))))
198 (shell-file-name smime-shell-file-name)
199 (shell-command-switch smime-shell-command-switch)
200 (process-connection-type nil)
201 process status exit-status)
202 (with-current-buffer (get-buffer-create smime-output-buffer)
203 (buffer-disable-undo)
205 (let ((coding-system-for-read 'binary)
206 (coding-system-for-write 'binary))
208 (apply #'start-process-shell-command "*S/MIME*"
209 smime-output-buffer program args)))
210 (set-process-sentinel process 'ignore)
211 (process-send-region process start end)
212 (process-send-eof process)
213 (while (eq 'run (process-status process))
214 (accept-process-output process 5))
215 (setq status (process-status process)
216 exit-status (process-exit-status process))
217 (delete-process process)
218 (with-current-buffer smime-output-buffer
219 (goto-char (point-min))
220 (while (re-search-forward "\r$" (point-max) t)
223 (if (memq status '(stop signal))
224 (error "%s exited abnormally: '%s'" program exit-status))
225 (if (= 127 exit-status)
226 (error "%s could not be found" program))
228 (set-buffer (get-buffer-create smime-errors-buffer))
229 (buffer-disable-undo)
231 (insert-file-contents errors-file-name)
232 (delete-file errors-file-name)
234 (if (and process (eq 'run (process-status process)))
235 (interrupt-process process))
239 ;;; @ interface functions
243 (defun smime-encrypt-region (start end)
244 "Encrypt the current region between START and END."
246 (or smime-private-key-file
247 (expand-file-name (read-file-name "Public key file: "))))
248 (args (list "-e" key-file)))
249 (smime-process-region start end smime-program args)
250 (smime-process-when-success
251 (goto-char (point-min))
252 (delete-region (point-min) (progn
253 (re-search-forward "^$" nil t)
257 (defun smime-decrypt-region (start end)
258 "Decrypt the current region between START and END."
260 (or smime-private-key-file
261 (expand-file-name (read-file-name "Private key file: "))))
262 (hash (smime-x509-hash key-file))
263 (passphrase (smime-read-passphrase
264 (format "S/MIME passphrase for %s: " hash)
266 (args (list "-d" key-file passphrase)))
267 (smime-process-region start end smime-program args)
268 (smime-process-when-success
269 (when smime-cache-passphrase
270 (smime-add-passphrase-cache hash passphrase)))))
273 (defun smime-sign-region (start end &optional cleartext)
274 "Make the signature from text between START and END.
275 If the optional 3rd argument CLEARTEXT is non-nil, it does not create
276 a detached signature."
278 (or smime-private-key-file
279 (expand-file-name (read-file-name "Private key file: "))))
280 (hash (smime-x509-hash key-file))
281 (passphrase (smime-read-passphrase
282 (format "S/MIME passphrase for %s: " hash)
284 (args (list "-ds" key-file passphrase)))
285 (smime-process-region start end smime-program args)
286 (smime-process-when-success
287 (goto-char (point-min))
288 (delete-region (point-min) (progn
289 (re-search-forward "^$" nil t)
291 (when smime-cache-passphrase
292 (smime-add-passphrase-cache hash passphrase)))))
295 (defun smime-verify-region (start end signature)
296 "Verify the current region between START and END.
297 If the optional 3rd argument SIGNATURE is non-nil, it is treated as
298 the detached signature of the current region."
299 (let* ((basename (expand-file-name "smime" temporary-file-directory))
300 (orig-file (make-temp-name basename))
301 (orig-mode (default-file-modes)))
304 (set-default-file-modes 448)
305 (binary-write-region start end orig-file))
306 (set-default-file-modes orig-mode))
308 (binary-insert-file-contents signature)
309 (goto-char (point-max))
310 (binary-insert-file-contents
311 (or (smime-find-certificate
312 (smime-query-signer (point-min)(point-max)))
314 (read-file-name "Certificate file: "))))
315 (smime-process-region (point-min)(point-max) smime-program
316 (list "-dv" orig-file)))
317 (smime-process-when-success nil)))
321 ;;; smime.el ends here