1 ;;; smime-card.el --- Make smime.el work with card readers
3 ;; Copyright (C) 2005 Brailcom, o.p.s.
4 ;; Author: Milan Zamazal <pdm@zamazal.org>
8 ;; This program is free software; you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by the Free
10 ;; Software Foundation; either version 2, or (at your option) any later
13 ;; This program is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
15 ;; or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program; if not, write to the Free Software
20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
24 ;; This is a simple wrapper around smime.el allowing to use private keys stored
27 ;; To use it, just put (require 'smime-card) to you Emacs startup file and
28 ;; customize the variable `smime-card-file-keys'.
36 (defcustom smime-card-file-keys
'()
37 "Alist of certificate files and their corresponding private key card ids.
38 Each element of the list is of the form (FILE . KEY-ID), where FILE is a
39 certificate file stored on a regular file system and KEY-ID is the identifier
40 of the corresponding private key stored on the card.
41 If FILE begins with the prefix `card:', the certificate is retrieved from the
42 card under the id following the `card:' prefix in FILE."
43 :type
'(alist :key-type
(file :tag
"Certificate file")
44 :value-type
(string :tag
"Key identifier"))
47 (defcustom smime-card-fetch-certificates nil
48 "If non-nil, fetch certificates from the card before verifying messages."
54 (defvar smime-card-key nil
)
56 (defun smime-card-key (keyfile)
57 (cdr (assoc keyfile smime-card-file-keys
)))
59 (defvar smime-card-engine-command
60 "engine dynamic -pre SO_PATH:/usr/lib/opensc/engine_pkcs11.so -pre ID:pkcs11 -pre LIST_ADD:1 -pre LOAD\n")
62 (defvar smime-card-process-output
"")
64 (defun smime-card-process-filter (process string
)
65 (setq smime-card-process-output
(concat smime-card-process-output string
)))
67 (defun smime-card-wait-for-prompt (process)
68 (while (not (string-match "\\(OpenSSL> \\|PIN: \\)$"
69 smime-card-process-output
))
70 (unless (accept-process-output process
5)
71 (message "OpenSSL: Timeout")
73 (prog1 (if (string= (match-string 1 smime-card-process-output
) "PIN: ")
76 (setq smime-card-process-output
"")))
78 (defun smime-card-call-openssl-region (b e buf
&rest args
)
79 (let* ((infile (make-temp-file "smime-card-in"))
80 (outfile (make-temp-file "smime-card-out"))
81 (cert-on-card (and (string-match "^card:\\(.*\\)$" keyfile
)
82 (match-string 1 keyfile
)))
83 (certfile (and cert-on-card
(make-temp-file "smime-card-cert")))
85 (list "-engine" "pkcs11"
87 "-inkey" smime-card-key
88 "-in" infile
"-out" outfile
)))
89 (process (start-process "openssl" " *openssl*" smime-openssl-program
)))
93 (unless (= (call-process "pkcs15-tool" nil nil nil
94 "-r" cert-on-card
"-o" certfile
)
96 (message "pkcs15: Error")
99 (while (and args
* (not (string= (car args
*) "-signer")))
100 (setq args
* (cdr args
*)))
101 (setq args
* (cdr args
*))
103 (setcar args
* certfile
))))
104 (setq smime-card-process-output
"")
105 (set-process-filter process
'smime-card-process-filter
)
106 (unless (eq (smime-card-wait-for-prompt process
) t
)
107 (message "OpenSSL: Error on startup")
109 (process-send-string process smime-card-engine-command
)
110 (unless (eq (smime-card-wait-for-prompt process
) t
)
111 (message "OpenSSL: Error in pkcs11 loading")
113 (write-region b e infile nil
0)
114 (process-send-string process
115 (concat (mapconcat 'identity args
" ") "\n"))
116 (let ((answer (smime-card-wait-for-prompt process
)))
119 (process-send-string process
(concat (read-passwd "Smartcard PIN: ") "\n"))
120 (unless (eq (smime-card-wait-for-prompt process
) t
)
121 (message "OpenSSL: Error after passphrase")
126 (message "OpenSSL: Error in processing")
127 (throw 'error nil
))))
128 (process-send-eof process
)
129 (with-current-buffer (car buf
)
130 (when (= (cadr (insert-file-contents outfile
)) 0)
131 (message "OpenSSL: Empty output")
135 (delete-file outfile
)
136 (when certfile
(delete-file certfile
))
137 (delete-process process
)
138 (kill-buffer " *openssl*"))))
142 (defadvice smime-sign-region
(around smime-card-sign-region activate
)
143 (let ((smime-card-key (smime-card-key (ad-get-arg 2))))
146 (defadvice smime-decrypt-region
(around smime-card-decrypt-region activate
)
147 (let ((smime-card-key (smime-card-key (ad-get-arg 2))))
150 (defadvice smime-call-openssl-region
(around smime-card-openssl activate
)
152 (setq ad-return-value
153 (apply 'smime-card-call-openssl-region
(ad-get-args 0)))
156 (defadvice smime-verify-region
(around smime-card-verify-region activate
)
157 (if smime-card-fetch-certificates
158 (let ((cert-ids '()))
160 (unless (= (call-process
161 "pkcs15-tool" nil t nil
"--list-certificates")
163 (error "pkcs15: Certificate listing"))
164 (goto-char (point-min))
165 (while (re-search-forward "^[\t ]+ID[ ]+: \\([0-9]+\\) *$" nil t
)
166 (setq cert-ids
(cons (match-string 1) cert-ids
))))
167 (let ((certfile (make-temp-file "smime-card")))
170 (with-temp-file certfile
172 (insert-file-contents smime-CA-file
))
174 (unless (= (call-process "pkcs15-tool" nil t nil
177 (error "pkcs15: Certificat read")))
179 (let ((smime-CA-file certfile
))
181 (delete-file certfile
))))
184 (defadvice mml-smime-verify
(around smime-card-mml-smime-verify activate
)
185 ;; If both smime-CA-directory and smime-CA-file are unset, `mml-smime-verify'
186 ;; refuses to perform certificate verification.
187 (let ((smime-CA-file (if smime-card-fetch-certificates
188 (or smime-CA-file
"/dev/null")
194 (provide 'smime-card
)
196 ;;; smime-card.el ends here