lisp/gnus/smime.el

0 ;;; smime.el --- S/MIME support library
48 ;; http://josefsson.org/smime.html.
63 ;; Now, use M-x customize-variable smime-keys and add mykey.pem as
67 ;; something and run M-x smime-sign-buffer RET RET and you should see
69 ;; smime-encrypt-buffer, should also work.
72 ;; someone.  Perhaps you trust the CA that issued your certificate, at
79 ;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a
80 ;; CA certificate.
83 ;; sent by others that use the same CA as you.
126 (defgroup smime nil
130 (defcustom smime-keys nil
138   :group 'smime)
140 (defcustom smime-CA-directory nil
147 where `ca.pem' is the file containing a PEM encoded X.509 CA
150 		 directory)
151   :group 'smime)
153 (defcustom smime-CA-file nil
159   :group 'smime)
161 (defcustom smime-certificate-directory "~/Mail/certs/"
166 ;certificates into this directory, so there is no need to populate it
168   :type 'directory
169   :group 'smime)
171 (defcustom smime-openssl-program
178   :group 'smime)
182 (defcustom smime-encrypt-cipher "-des3"
190   :group 'smime)
192 (defcustom smime-crl-check nil
203 `smime-CA-file' or be located in a file (also in PEM format) in
204 your `smime-certificate-directory' named to the X.509 hash of the
211   :group 'smime)
213 (defcustom smime-dns-server nil
219   :group 'smime)
221 (defvar smime-details-buffer "*OpenSSL output*")
225   (defalias 'smime-make-temp-file
231 	 (if (fboundp 'temp-directory)
232 	     (temp-directory)
233 	   temporary-file-directory))))))
237 (defun smime-ask-passphrase ()
248 (defun smime-call-openssl-region (b e buf &rest args)
249   (case (apply 'call-process-region b e smime-openssl-program nil buf nil args)
257 (defun smime-make-certfiles (certfiles)
260 	      (smime-make-certfiles (cdr certfiles)))))
264 (defun smime-sign-region (b e keyfile)
272   (smime-new-details-buffer)
275 	(buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
276 	(passphrase (smime-ask-passphrase))
277 	(tmpfile (smime-make-temp-file "smime")))
282 		  (apply 'smime-call-openssl-region b e (list buffer tmpfile)
283 			 "smime" "-sign" "-signer" (expand-file-name keyfile)
285 			  (smime-make-certfiles certfiles)
290 		(with-current-buffer smime-details-buffer
299       (with-current-buffer smime-details-buffer
304 (defun smime-encrypt-region (b e certfiles)
309   (smime-new-details-buffer)
310   (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
311 	(tmpfile (smime-make-temp-file "smime")))
314 		  (apply 'smime-call-openssl-region b e (list buffer tmpfile)
315 			 "smime" "-encrypt" smime-encrypt-cipher
317 		(with-current-buffer smime-details-buffer
326       (with-current-buffer smime-details-buffer
333 (defun smime-sign-buffer (&optional keyfile buffer)
338     (unless (smime-sign-region
342 	       (smime-get-key-with-certs-by-email
345 			 (if smime-keys
346 			     (concat " (default " (caar smime-keys) "): ")
348 		 smime-keys nil nil (car-safe (car-safe smime-keys))))))
351 (defun smime-encrypt-buffer (&optional certfiles buffer)
358     (unless (smime-encrypt-region
362 				       smime-certificate-directory nil))))
367 (defun smime-verify-region (b e)
371 `smime-details-buffer'."
372   (smime-new-details-buffer)
373   (let ((CAs (append (if smime-CA-file
375 			       (expand-file-name smime-CA-file)))
376 		     (if smime-CA-directory
378 			       (expand-file-name smime-CA-directory))))))
380       (error "No CA configured"))
381     (if smime-crl-check
382 	(add-to-list 'CAs smime-crl-check))
383     (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
384 	       "smime" "-verify" "-out" "/dev/null" CAs)
386       (insert-buffer-substring smime-details-buffer)
389 (defun smime-noverify-region (b e)
393 `smime-details-buffer'."
394   (smime-new-details-buffer)
395   (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
396 	     "smime" "-verify" "-noverify" "-out" '("/dev/null"))
398     (insert-buffer-substring smime-details-buffer)
404 (defun smime-decrypt-region (b e keyfile)
408 in the buffer specified by `smime-details-buffer'."
409   (smime-new-details-buffer)
410   (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
411 	CAs (passphrase (smime-ask-passphrase))
412 	(tmpfile (smime-make-temp-file "smime")))
416 	    (apply 'smime-call-openssl-region b e
418 		   "smime" "-decrypt" "-recip" (expand-file-name keyfile)
423 	  (with-current-buffer smime-details-buffer
434       (with-current-buffer smime-details-buffer
438       (insert-buffer-substring smime-details-buffer)
443 (defun smime-verify-buffer (&optional buffer)
447 `smime-details-buffer'."
450     (smime-verify-region (point-min) (point-max))))
452 (defun smime-noverify-buffer (&optional buffer)
457 `smime-details-buffer'."
460     (smime-noverify-region (point-min) (point-max))))
462 (defun smime-decrypt-buffer (&optional buffer keyfile)
467 in the buffer specified by `smime-details-buffer'."
470     (smime-decrypt-region
474 	  (smime-get-key-by-email
477 		    (if smime-keys (concat " (default " (caar smime-keys) "): ")
479 	    smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
483 (defun smime-new-details-buffer ()
484   (with-current-buffer (get-buffer-create smime-details-buffer)
487 (defun smime-pkcs7-region (b e)
489   (smime-new-details-buffer)
490   (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out")
492     (insert-buffer-substring smime-details-buffer)
495 (defun smime-pkcs7-certificates-region (b e)
497   (smime-new-details-buffer)
498   (when (smime-call-openssl-region
499 	 b e smime-details-buffer "pkcs7" "-print_certs" "-text")
501     (insert-buffer-substring smime-details-buffer)
504 (defun smime-pkcs7-email-region (b e)
507   (smime-new-details-buffer)
508   (when (smime-call-openssl-region
509 	 b e smime-details-buffer "x509" "-email" "-noout")
511     (insert-buffer-substring smime-details-buffer)
516 (defun smime-get-certfiles (keyfile keys)
522 	  (smime-get-certfiles keyfile otherkeys)))))
526   (defalias 'smime-point-at-eol
531 (defun smime-buffer-as-string-region (b e)
537 	(let ((str (buffer-substring (point) (smime-point-at-eol))))
545 (defun smime-mail-to-domain (mailaddr)
550 (defun smime-cert-by-dns (mail)
551   (let* ((dig-dns-server smime-dns-server)
552 	 (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
555 		   (dig-extract-rr (smime-mail-to-domain mail) "cert")))
573 (defvar smime-buffer "*SMIME*")
575 (defvar smime-mode-map nil)
576 (put 'smime-mode 'mode-class 'special)
578 (unless smime-mode-map
579   (setq smime-mode-map (make-sparse-keymap))
580   (suppress-keymap smime-mode-map)
582   (define-key smime-mode-map "q" 'smime-exit)
583   (define-key smime-mode-map "f" 'smime-certificate-info))
585 (defun smime-mode ()
589 \\<smime-mode-map>
593 \\{smime-mode-map}"
596   (setq major-mode 'smime-mode)
599   (use-local-map smime-mode-map)
603   (gnus-run-mode-hooks 'smime-mode-hook))
605 (defun smime-certificate-info (certfile)
610     (call-process smime-openssl-program nil buffer 'display
617 (defun smime-draw-buffer ()
618   (with-current-buffer smime-buffer
622       (dolist (key smime-keys)
628 (defun smime ()
631   (unless (get-buffer smime-buffer)
633       (set-buffer (get-buffer-create smime-buffer))
634       (smime-mode)))
635   (smime-draw-buffer)
636   (switch-to-buffer smime-buffer))
638 (defun smime-exit ()
645 (defun smime-get-key-by-email (email)
646   (cadr (assoc email smime-keys)))
648 (defun smime-get-key-with-certs-by-email (email)
649   (cdr (assoc email smime-keys)))
651 (provide 'smime)
654 ;;; smime.el ends here