code.delx.au - gnu-emacs/blob - lisp/gnus/smime.el

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