cgit.sxemacs.org Git - gnus/blob - lisp/smime.el

   1 ;;; smime.el --- S/MIME support library
   2
   3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 Free Software Foundation, Inc.
   5
   6 ;; Author: Simon Josefsson <simon@josefsson.org>
   7 ;; Keywords: SMIME X.509 PEM OpenSSL
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published
  13 ;; by the Free Software Foundation; either version 3, or (at your
  14 ;; option) any later version.
  15
  16 ;; GNU Emacs 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., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This library perform S/MIME operations from within Emacs.
  29 ;;
  30 ;; Functions for fetching certificates from public repositories are
  31 ;; provided, currently from DNS and LDAP.
  32 ;;
  33 ;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
  34 ;; encryption and decryption.
  35 ;;
  36 ;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is
  37 ;; probably required to use this library in any useful way.
  38 ;; Especially, don't expect this library to buy security for you.  If
  39 ;; you don't understand what you are doing, you're as likely to lose
  40 ;; security than gain any by using this library.
  41 ;;
  42 ;; This library is not intended to provide a "raw" API for S/MIME,
  43 ;; PKCSx or similar, it's intended to perform common operations
  44 ;; done on messages encoded in these formats.  The terminology chosen
  45 ;; reflect this.
  46 ;;
  47 ;; The home of this file is in Gnus CVS, but also available from
  48 ;; http://josefsson.org/smime.html.
  49
  50 ;;; Quick introduction:
  51
  52 ;; Get your S/MIME certificate from VeriSign or someplace.  I used
  53 ;; Netscape to generate the key and certificate request and stuff, and
  54 ;; Netscape can export the key into PKCS#12 format.
  55 ;;
  56 ;; Enter OpenSSL.  To be able to use this library, it need to have the
  57 ;; SMIME key readable in PEM format.  OpenSSL is used to convert the
  58 ;; key:
  59 ;;
  60 ;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem
  61 ;; ...
  62 ;;
  63 ;; Now, use M-x customize-variable smime-keys and add mykey.pem as
  64 ;; a key.
  65 ;;
  66 ;; Now you should be able to sign messages!  Create a buffer and write
  67 ;; something and run M-x smime-sign-buffer RET RET and you should see
  68 ;; your message MIME armoured and a signature.  Encryption, M-x
  69 ;; smime-encrypt-buffer, should also work.
  70 ;;
  71 ;; To be able to verify messages you need to build up trust with
  72 ;; someone.  Perhaps you trust the CA that issued your certificate, at
  73 ;; least I did, so I export it's certificates from my PKCS#12
  74 ;; certificate with:
  75 ;;
  76 ;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem
  77 ;; ...
  78 ;;
  79 ;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a
  80 ;; CA certificate.
  81 ;;
  82 ;; You should now be able to sign messages, and even verify messages
  83 ;; sent by others that use the same CA as you.
  84
  85 ;; Bugs:
  86 ;;
  87 ;; Don't complain that this package doesn't do encrypted PEM files,
  88 ;; submit a patch instead.  I store my keys in a safe place, so I
  89 ;; didn't need the encryption.  Also, programming was made easier by
  90 ;; that decision.  One might think that this even influenced were I
  91 ;; store my keys, and one would probably be right. :-)
  92 ;;
  93 ;; Update: Mathias Herberts sent the patch.  However, it uses
  94 ;; environment variables to pass the password to OpenSSL, which is
  95 ;; slightly insecure. Hence a new todo: use a better -passin method.
  96 ;;
  97 ;; Cache password for e.g. 1h
  98 ;;
  99 ;; Suggestions and comments are appreciated, mail me at simon@josefsson.org.
 100
 101 ;; begin rant
 102 ;;
 103 ;; I would include pointers to introductory text on concepts used in
 104 ;; this library here, but the material I've read are so horrible I
 105 ;; don't want to recomend them.
 106 ;;
 107 ;; Why can't someone write a simple introduction to all this stuff?
 108 ;; Until then, much of this resemble security by obscurity.
 109 ;;
 110 ;; Also, I'm not going to mention anything about the wonders of
 111 ;; cryptopolitics.  Oops, I just did.
 112 ;;
 113 ;; end rant
 114
 115 ;;; Revision history:
 116
 117 ;; 2000-06-05  initial version, committed to Gnus CVS contrib/
 118 ;; 2000-10-28  retrieve certificates via DNS CERT RRs
 119 ;; 2001-10-14  posted to gnu.emacs.sources
 120 ;; 2005-02-13  retrieve certificates via LDAP
 121
 122 ;;; Code:
 123
 124 ;; For Emacs < 22.2.
 125 (eval-and-compile
 126   (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
 127 (require 'dig)
 128 (or (require 'password-cache nil t)
 129     (require 'password))
 130 (eval-when-compile (require 'cl))
 131
 132 (eval-and-compile
 133   (cond
 134    ((fboundp 'replace-in-string)
 135     (defalias 'smime-replace-in-string 'replace-in-string))
 136    ((fboundp 'replace-regexp-in-string)
 137     (defun smime-replace-in-string  (string regexp newtext &optional literal)
 138       "Replace all matches for REGEXP with NEWTEXT in STRING.
 139 If LITERAL is non-nil, insert NEWTEXT literally.  Return a new
 140 string containing the replacements.
 141
 142 This is a compatibility function for different Emacsen."
 143       (replace-regexp-in-string regexp newtext string nil literal)))))
 144
 145 (defgroup smime nil
 146   "S/MIME configuration."
 147   :group 'mime)
 148
 149 (defcustom smime-keys nil
 150   "*Map mail addresses to a file containing Certificate (and private key).
 151 The file is assumed to be in PEM format. You can also associate additional
 152 certificates to be sent with every message to each address."
 153   :type '(repeat (list (string :tag "Mail address")
 154                        (file :tag "File name")
 155                        (repeat :tag "Additional certificate files"
 156                                (file :tag "File name"))))
 157   :group 'smime)
 158
 159 (defcustom smime-CA-directory nil
 160   "*Directory containing certificates for CAs you trust.
 161 Directory should contain files (in PEM format) named to the X.509
 162 hash of the certificate.  This can be done using OpenSSL such as:
 163
 164 $ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0
 165
 166 where `ca.pem' is the file containing a PEM encoded X.509 CA
 167 certificate."
 168   :type '(choice (const :tag "none" nil)
 169                  directory)
 170   :group 'smime)
 171
 172 (defcustom smime-CA-file nil
 173   "*Files containing certificates for CAs you trust.
 174 File should contain certificates in PEM format."
 175   :version "22.1"
 176   :type '(choice (const :tag "none" nil)
 177                  file)
 178   :group 'smime)
 179
 180 (defcustom smime-certificate-directory "~/Mail/certs/"
 181   "*Directory containing other people's certificates.
 182 It should contain files named to the X.509 hash of the certificate,
 183 and the files themself should be in PEM format."
 184 ;The S/MIME library provide simple functionality for fetching
 185 ;certificates into this directory, so there is no need to populate it
 186 ;manually.
 187   :type 'directory
 188   :group 'smime)
 189
 190 (defcustom smime-openssl-program
 191   (and (condition-case ()
 192            (eq 0 (call-process "openssl" nil nil nil "version"))
 193          (error nil))
 194        "openssl")
 195   "*Name of OpenSSL binary."
 196   :type 'string
 197   :group 'smime)
 198
 199 ;; OpenSSL option to select the encryption cipher
 200
 201 (defcustom smime-encrypt-cipher "-des3"
 202   "*Cipher algorithm used for encryption."
 203   :version "22.1"
 204   :type '(choice (const :tag "Triple DES" "-des3")
 205                  (const :tag "DES"  "-des")
 206                  (const :tag "RC2 40 bits" "-rc2-40")
 207                  (const :tag "RC2 64 bits" "-rc2-64")
 208                  (const :tag "RC2 128 bits" "-rc2-128"))
 209   :group 'smime)
 210
 211 (defcustom smime-crl-check nil
 212   "*Check revocation status of signers certificate using CRLs.
 213 Enabling this will have OpenSSL check the signers certificate
 214 against a certificate revocation list (CRL).
 215
 216 For this to work the CRL must be up-to-date and since they are
 217 normally updated quite often (ie. several times a day) you
 218 probably need some tool to keep them up-to-date. Unfortunately
 219 Gnus cannot do this for you.
 220
 221 The CRL should either be appended (in PEM format) to your
 222 `smime-CA-file' or be located in a file (also in PEM format) in
 223 your `smime-certificate-directory' named to the X.509 hash of the
 224 certificate with .r0 as file name extension.
 225
 226 At least OpenSSL version 0.9.7 is required for this to work."
 227   :type '(choice (const :tag "No check" nil)
 228                  (const :tag "Check certificate" "-crl_check")
 229                  (const :tag "Check certificate chain" "-crl_check_all"))
 230   :group 'smime)
 231
 232 (defcustom smime-dns-server nil
 233   "*DNS server to query certificates from.
 234 If nil, use system defaults."
 235   :version "22.1"
 236   :type '(choice (const :tag "System defaults")
 237                  string)
 238   :group 'smime)
 239
 240 (defcustom smime-ldap-host-list nil
 241   "A list of LDAP hosts with S/MIME user certificates.
 242 If needed search base, binddn, passwd, etc. for the LDAP host
 243 must be set in `ldap-host-parameters-alist'."
 244   :type '(repeat (string :tag "Host name"))
 245   :version "23.0" ;; No Gnus
 246   :group 'smime)
 247
 248 (defvar smime-details-buffer "*OpenSSL output*")
 249
 250 ;; Use mm-util?
 251 (eval-and-compile
 252   (defalias 'smime-make-temp-file
 253     (if (fboundp 'make-temp-file)
 254         'make-temp-file
 255       (lambda (prefix &optional dir-flag) ;; Simple implementation
 256         (expand-file-name
 257          (make-temp-name prefix)
 258          (if (fboundp 'temp-directory)
 259              (temp-directory)
 260            temporary-file-directory))))))
 261
 262 ;; Password dialog function
 263 (declare-function password-read-and-add "password-cache" (prompt &optional key))
 264
 265 (defun smime-ask-passphrase (&optional cache-key)
 266   "Asks the passphrase to unlock the secret key.
 267 If `cache-key' and `password-cache' is non-nil then cache the
 268 password under `cache-key'."
 269   (let ((passphrase
 270          (password-read-and-add
 271           "Passphrase for secret key (RET for no passphrase): " cache-key)))
 272     (if (string= passphrase "")
 273         nil
 274       passphrase)))
 275
 276 ;; OpenSSL wrappers.
 277
 278 (defun smime-call-openssl-region (b e buf &rest args)
 279   (case (apply 'call-process-region b e smime-openssl-program nil buf nil args)
 280     (0 t)
 281     (1 (message "OpenSSL: An error occurred parsing the command options.") nil)
 282     (2 (message "OpenSSL: One of the input files could not be read.") nil)
 283     (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil)
 284     (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil)
 285     (t (error "Unknown OpenSSL exitcode") nil)))
 286
 287 (defun smime-make-certfiles (certfiles)
 288   (if certfiles
 289       (append (list "-certfile" (expand-file-name (car certfiles)))
 290               (smime-make-certfiles (cdr certfiles)))))
 291
 292 ;; Sign+encrypt region
 293
 294 (defun smime-sign-region (b e keyfile)
 295   "Sign region with certified key in KEYFILE.
 296 If signing fails, the buffer is not modified.  Region is assumed to
 297 have proper MIME tags.  KEYFILE is expected to contain a PEM encoded
 298 private key and certificate as its car, and a list of additional
 299 certificates to include in its caar.  If no additional certificates is
 300 included, KEYFILE may be the file containing the PEM encoded private
 301 key and certificate itself."
 302   (smime-new-details-buffer)
 303   (let* ((certfiles (and (cdr-safe keyfile) (cadr keyfile)))
 304          (keyfile (or (car-safe keyfile) keyfile))
 305          (buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
 306          (passphrase (smime-ask-passphrase (expand-file-name keyfile)))
 307          (tmpfile (smime-make-temp-file "smime")))
 308     (if passphrase
 309         (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
 310     (prog1
 311         (when (prog1
 312                   (apply 'smime-call-openssl-region b e (list buffer tmpfile)
 313                          "smime" "-sign" "-signer" (expand-file-name keyfile)
 314                          (append
 315                           (smime-make-certfiles certfiles)
 316                           (if passphrase
 317                               (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))))
 318                 (if passphrase
 319                     (setenv "GNUS_SMIME_PASSPHRASE" "" t))
 320                 (with-current-buffer smime-details-buffer
 321                   (insert-file-contents tmpfile)
 322                   (delete-file tmpfile)))
 323           (delete-region b e)
 324           (insert-buffer-substring buffer)
 325           (goto-char b)
 326           (when (looking-at "^MIME-Version: 1.0$")
 327             (delete-region (point) (progn (forward-line 1) (point))))
 328           t)
 329       (with-current-buffer smime-details-buffer
 330         (goto-char (point-max))
 331         (insert-buffer-substring buffer))
 332       (kill-buffer buffer))))
 333
 334 (defun smime-encrypt-region (b e certfiles)
 335   "Encrypt region for recipients specified in CERTFILES.
 336 If encryption fails, the buffer is not modified.  Region is assumed to
 337 have proper MIME tags.  CERTFILES is a list of filenames, each file
 338 is expected to contain of a PEM encoded certificate."
 339   (smime-new-details-buffer)
 340   (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
 341         (tmpfile (smime-make-temp-file "smime")))
 342     (prog1
 343         (when (prog1
 344                   (apply 'smime-call-openssl-region b e (list buffer tmpfile)
 345                          "smime" "-encrypt" smime-encrypt-cipher
 346                          (mapcar 'expand-file-name certfiles))
 347                 (with-current-buffer smime-details-buffer
 348                   (insert-file-contents tmpfile)
 349                   (delete-file tmpfile)))
 350           (delete-region b e)
 351           (insert-buffer-substring buffer)
 352           (goto-char b)
 353           (when (looking-at "^MIME-Version: 1.0$")
 354             (delete-region (point) (progn (forward-line 1) (point))))
 355           t)
 356       (with-current-buffer smime-details-buffer
 357         (goto-char (point-max))
 358         (insert-buffer-substring buffer))
 359       (kill-buffer buffer))))
 360
 361 ;; Sign+encrypt buffer
 362
 363 (defun smime-sign-buffer (&optional keyfile buffer)
 364   "S/MIME sign BUFFER with key in KEYFILE.
 365 KEYFILE should contain a PEM encoded key and certificate."
 366   (interactive)
 367   (with-current-buffer (or buffer (current-buffer))
 368     (unless (smime-sign-region
 369              (point-min) (point-max)
 370              (if keyfile
 371                  keyfile
 372                (smime-get-key-with-certs-by-email
 373                 (completing-read
 374                  (concat "Sign using key"
 375                          (if smime-keys
 376                              (concat " (default " (caar smime-keys) "): ")
 377                            ": "))
 378                  smime-keys nil nil (car-safe (car-safe smime-keys))))))
 379       (error "Signing failed"))))
 380
 381 (defun smime-encrypt-buffer (&optional certfiles buffer)
 382   "S/MIME encrypt BUFFER for recipients specified in CERTFILES.
 383 CERTFILES is a list of filenames, each file is expected to consist of
 384 a PEM encoded key and certificate.  Uses current buffer if BUFFER is
 385 nil."
 386   (interactive)
 387   (with-current-buffer (or buffer (current-buffer))
 388     (unless (smime-encrypt-region
 389              (point-min) (point-max)
 390              (or certfiles
 391                  (list (read-file-name "Recipient's S/MIME certificate: "
 392                                        smime-certificate-directory nil))))
 393       (error "Encryption failed"))))
 394
 395 ;; Verify+decrypt region
 396
 397 (defun smime-verify-region (b e)
 398   "Verify S/MIME message in region between B and E.
 399 Returns non-nil on success.
 400 Any details (stdout and stderr) are left in the buffer specified by
 401 `smime-details-buffer'."
 402   (smime-new-details-buffer)
 403   (let ((CAs (append (if smime-CA-file
 404                          (list "-CAfile"
 405                                (expand-file-name smime-CA-file)))
 406                      (if smime-CA-directory
 407                          (list "-CApath"
 408                                (expand-file-name smime-CA-directory))))))
 409     (unless CAs
 410       (error "No CA configured"))
 411     (if smime-crl-check
 412         (add-to-list 'CAs smime-crl-check))
 413     (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
 414                "smime" "-verify" "-out" "/dev/null" CAs)
 415         t
 416       (insert-buffer-substring smime-details-buffer)
 417       nil)))
 418
 419 (defun smime-noverify-region (b e)
 420   "Verify integrity of S/MIME message in region between B and E.
 421 Returns non-nil on success.
 422 Any details (stdout and stderr) are left in the buffer specified by
 423 `smime-details-buffer'."
 424   (smime-new-details-buffer)
 425   (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
 426              "smime" "-verify" "-noverify" "-out" '("/dev/null"))
 427       t
 428     (insert-buffer-substring smime-details-buffer)
 429     nil))
 430
 431 (defvar from)
 432
 433 (defun smime-decrypt-region (b e keyfile)
 434   "Decrypt S/MIME message in region between B and E with key in KEYFILE.
 435 On success, replaces region with decrypted data and return non-nil.
 436 Any details (stderr on success, stdout and stderr on error) are left
 437 in the buffer specified by `smime-details-buffer'."
 438   (smime-new-details-buffer)
 439   (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
 440         CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile)))
 441         (tmpfile (smime-make-temp-file "smime")))
 442     (if passphrase
 443         (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
 444     (if (prog1
 445             (apply 'smime-call-openssl-region b e
 446                    (list buffer tmpfile)
 447                    "smime" "-decrypt" "-recip" (expand-file-name keyfile)
 448                    (if passphrase
 449                        (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))
 450           (if passphrase
 451               (setenv "GNUS_SMIME_PASSPHRASE" "" t))
 452           (with-current-buffer smime-details-buffer
 453             (insert-file-contents tmpfile)
 454             (delete-file tmpfile)))
 455         (progn
 456           (delete-region b e)
 457           (when (boundp 'from)
 458             ;; `from' is dynamically bound in mm-dissect.
 459             (insert "From: " from "\n"))
 460           (insert-buffer-substring buffer)
 461           (kill-buffer buffer)
 462           t)
 463       (with-current-buffer smime-details-buffer
 464         (insert-buffer-substring buffer))
 465       (kill-buffer buffer)
 466       (delete-region b e)
 467       (insert-buffer-substring smime-details-buffer)
 468       nil)))
 469
 470 ;; Verify+Decrypt buffer
 471
 472 (defun smime-verify-buffer (&optional buffer)
 473   "Verify integrity of S/MIME message in BUFFER.
 474 Uses current buffer if BUFFER is nil. Returns non-nil on success.
 475 Any details (stdout and stderr) are left in the buffer specified by
 476 `smime-details-buffer'."
 477   (interactive)
 478   (with-current-buffer (or buffer (current-buffer))
 479     (smime-verify-region (point-min) (point-max))))
 480
 481 (defun smime-noverify-buffer (&optional buffer)
 482   "Verify integrity of S/MIME message in BUFFER.
 483 Does NOT verify validity of certificate (only message integrity).
 484 Uses current buffer if BUFFER is nil. Returns non-nil on success.
 485 Any details (stdout and stderr) are left in the buffer specified by
 486 `smime-details-buffer'."
 487   (interactive)
 488   (with-current-buffer (or buffer (current-buffer))
 489     (smime-noverify-region (point-min) (point-max))))
 490
 491 (defun smime-decrypt-buffer (&optional buffer keyfile)
 492   "Decrypt S/MIME message in BUFFER using KEYFILE.
 493 Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil.
 494 On success, replaces data in buffer and return non-nil.
 495 Any details (stderr on success, stdout and stderr on error) are left
 496 in the buffer specified by `smime-details-buffer'."
 497   (interactive)
 498   (with-current-buffer (or buffer (current-buffer))
 499     (smime-decrypt-region
 500      (point-min) (point-max)
 501      (expand-file-name
 502       (or keyfile
 503           (smime-get-key-by-email
 504            (completing-read
 505             (concat "Decipher using key"
 506                     (if smime-keys (concat " (default " (caar smime-keys) "): ")
 507                       ": "))
 508             smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
 509
 510 ;; Various operations
 511
 512 (defun smime-new-details-buffer ()
 513   (with-current-buffer (get-buffer-create smime-details-buffer)
 514     (erase-buffer)))
 515
 516 (defun smime-pkcs7-region (b e)
 517   "Convert S/MIME message between points B and E into a PKCS7 message."
 518   (smime-new-details-buffer)
 519   (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out")
 520     (delete-region b e)
 521     (insert-buffer-substring smime-details-buffer)
 522     t))
 523
 524 (defun smime-pkcs7-certificates-region (b e)
 525   "Extract any certificates enclosed in PKCS7 message between points B and E."
 526   (smime-new-details-buffer)
 527   (when (smime-call-openssl-region
 528          b e smime-details-buffer "pkcs7" "-print_certs" "-text")
 529     (delete-region b e)
 530     (insert-buffer-substring smime-details-buffer)
 531     t))
 532
 533 (defun smime-pkcs7-email-region (b e)
 534   "Get email addresses contained in certificate between points B and E.
 535 A string or a list of strings is returned."
 536   (smime-new-details-buffer)
 537   (when (smime-call-openssl-region
 538          b e smime-details-buffer "x509" "-email" "-noout")
 539     (delete-region b e)
 540     (insert-buffer-substring smime-details-buffer)
 541     t))
 542
 543 ;; Utility functions
 544
 545 (defun smime-get-certfiles (keyfile keys)
 546   (if keys
 547       (let ((curkey (car keys))
 548             (otherkeys (cdr keys)))
 549         (if (string= keyfile (cadr curkey))
 550             (caddr curkey)
 551           (smime-get-certfiles keyfile otherkeys)))))
 552
 553 (defun smime-buffer-as-string-region (b e)
 554   "Return each line in region between B and E as a list of strings."
 555   (save-excursion
 556     (goto-char b)
 557     (let (res)
 558       (while (< (point) e)
 559         (let ((str (buffer-substring (point) (point-at-eol))))
 560           (unless (string= "" str)
 561             (push str res)))
 562         (forward-line))
 563       res)))
 564
 565 ;; Find certificates
 566
 567 (defun smime-mail-to-domain (mailaddr)
 568   (if (string-match "@" mailaddr)
 569       (replace-match "." 'fixedcase 'literal mailaddr)
 570     mailaddr))
 571
 572 (defun smime-cert-by-dns (mail)
 573   "Find certificate via DNS for address MAIL."
 574   (let* ((dig-dns-server smime-dns-server)
 575          (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
 576          (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
 577          (certrr (with-current-buffer digbuf
 578                    (dig-extract-rr (smime-mail-to-domain mail) "cert")))
 579          (cert (and certrr (dig-rr-get-pkix-cert certrr))))
 580       (if cert
 581           (with-current-buffer retbuf
 582             (insert "-----BEGIN CERTIFICATE-----\n")
 583             (let ((i 0) (len (length cert)))
 584               (while (> (- len 64) i)
 585                 (insert (substring cert i (+ i 64)) "\n")
 586                 (setq i (+ i 64)))
 587               (insert (substring cert i len) "\n"))
 588             (insert "-----END CERTIFICATE-----\n"))
 589         (kill-buffer retbuf)
 590         (setq retbuf nil))
 591       (kill-buffer digbuf)
 592       retbuf))
 593
 594 (defun smime-cert-by-ldap-1 (mail host)
 595   "Get cetificate for MAIL from the ldap server at HOST."
 596   (let ((ldapresult
 597          (funcall
 598           (if (or (featurep 'xemacs)
 599                   ;; For Emacs >= 22 we don't need smime-ldap.el
 600                   (< emacs-major-version 22))
 601               (progn
 602                 (require 'smime-ldap)
 603                 'smime-ldap-search)
 604             'ldap-search)
 605           (concat "mail=" mail)
 606           host '("userCertificate") nil))
 607         (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
 608         cert)
 609     (if (and (>= (length ldapresult) 1)
 610              (> (length (cadaar ldapresult)) 0))
 611         (with-current-buffer retbuf
 612           ;; Certificates on LDAP servers _should_ be in DER format,
 613           ;; but there are some servers out there that distributes the
 614           ;; certificates in PEM format (with or without
 615           ;; header/footer) so we try to handle them anyway.
 616           (if (or (string= (substring (cadaar ldapresult) 0 27)
 617                            "-----BEGIN CERTIFICATE-----")
 618                   (string= (substring (cadaar ldapresult) 0 3)
 619                            "MII"))
 620               (setq cert
 621                     (smime-replace-in-string
 622                      (cadaar ldapresult)
 623                      (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|"
 624                              "-----END CERTIFICATE-----\\)")
 625                      "" t))
 626             (setq cert (base64-encode-string (cadaar ldapresult) t)))
 627           (insert "-----BEGIN CERTIFICATE-----\n")
 628           (let ((i 0) (len (length cert)))
 629             (while (> (- len 64) i)
 630               (insert (substring cert i (+ i 64)) "\n")
 631               (setq i (+ i 64)))
 632             (insert (substring cert i len) "\n"))
 633           (insert "-----END CERTIFICATE-----\n"))
 634       (kill-buffer retbuf)
 635       (setq retbuf nil))
 636     retbuf))
 637
 638 (defun smime-cert-by-ldap (mail)
 639   "Find certificate via LDAP for address MAIL."
 640   (if smime-ldap-host-list
 641       (catch 'certbuf
 642         (dolist (host smime-ldap-host-list)
 643           (let ((retbuf (smime-cert-by-ldap-1 mail host)))
 644             (when retbuf
 645               (throw 'certbuf retbuf)))))))
 646
 647 ;; User interface.
 648
 649 (defvar smime-buffer "*SMIME*")
 650
 651 (defvar smime-mode-map nil)
 652 (put 'smime-mode 'mode-class 'special)
 653
 654 (unless smime-mode-map
 655   (setq smime-mode-map (make-sparse-keymap))
 656   (suppress-keymap smime-mode-map)
 657
 658   (define-key smime-mode-map "q" 'smime-exit)
 659   (define-key smime-mode-map "f" 'smime-certificate-info))
 660
 661 (defun smime-mode ()
 662   "Major mode for browsing, viewing and fetching certificates.
 663
 664 All normal editing commands are switched off.
 665 \\<smime-mode-map>
 666
 667 The following commands are available:
 668
 669 \\{smime-mode-map}"
 670   (interactive)
 671   (kill-all-local-variables)
 672   (setq major-mode 'smime-mode)
 673   (setq mode-name "SMIME")
 674   (setq mode-line-process nil)
 675   (use-local-map smime-mode-map)
 676   (buffer-disable-undo)
 677   (setq truncate-lines t)
 678   (setq buffer-read-only t)
 679   (gnus-run-mode-hooks 'smime-mode-hook))
 680
 681 (defun smime-certificate-info (certfile)
 682   (interactive "fCertificate file: ")
 683   (let ((buffer (get-buffer-create (format "*certificate %s*" certfile))))
 684     (switch-to-buffer buffer)
 685     (erase-buffer)
 686     (call-process smime-openssl-program nil buffer 'display
 687                   "x509" "-in" (expand-file-name certfile) "-text")
 688     (fundamental-mode)
 689     (set-buffer-modified-p nil)
 690     (toggle-read-only t)
 691     (goto-char (point-min))))
 692
 693 (defun smime-draw-buffer ()
 694   (with-current-buffer smime-buffer
 695     (let (buffer-read-only)
 696       (erase-buffer)
 697       (insert "\nYour keys:\n")
 698       (dolist (key smime-keys)
 699         (insert
 700          (format "\t\t%s: %s\n" (car key) (cadr key))))
 701       (insert "\nTrusted Certificate Authoritys:\n")
 702       (insert "\nKnown Certificates:\n"))))
 703
 704 (defun smime ()
 705   "Go to the SMIME buffer."
 706   (interactive)
 707   (unless (get-buffer smime-buffer)
 708     (save-excursion
 709       (set-buffer (get-buffer-create smime-buffer))
 710       (smime-mode)))
 711   (smime-draw-buffer)
 712   (switch-to-buffer smime-buffer))
 713
 714 (defun smime-exit ()
 715   "Quit the S/MIME buffer."
 716   (interactive)
 717   (kill-buffer (current-buffer)))
 718
 719 ;; Other functions
 720
 721 (defun smime-get-key-by-email (email)
 722   (cadr (assoc email smime-keys)))
 723
 724 (defun smime-get-key-with-certs-by-email (email)
 725   (cdr (assoc email smime-keys)))
 726
 727 (provide 'smime)
 728
 729 ;;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e
 730 ;;; smime.el ends here