X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fsmime.el;h=52774d69ac8c815359391cc88946de7f3b282966;hb=21bbb92f10a471ecf9eb2e75f1a96618e5436564;hp=037c4c4c134f12187cc0b6d069a801e5c07526b2;hpb=8aa94647911ea24d6fd04ff0416aef70340a6fe6;p=gnus diff --git a/lisp/smime.el b/lisp/smime.el index 037c4c4c1..52774d69a 100644 --- a/lisp/smime.el +++ b/lisp/smime.el @@ -1,5 +1,7 @@ ;;; smime.el --- S/MIME support library -;; Copyright (c) 2000, 2001, 2003, 2005 Free Software Foundation, Inc. + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007 Free Software Foundation, Inc. ;; Author: Simon Josefsson ;; Keywords: SMIME X.509 PEM OpenSSL @@ -8,7 +10,7 @@ ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 2, or (at your +;; by the Free Software Foundation; either version 3, or (at your ;; option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, but @@ -18,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -120,12 +122,25 @@ ;;; Code: (require 'dig) -(require 'smime-ldap) (require 'password) (eval-when-compile (require 'cl)) +(eval-and-compile + (cond + ((fboundp 'replace-in-string) + (defalias 'smime-replace-in-string 'replace-in-string)) + ((fboundp 'replace-regexp-in-string) + (defun smime-replace-in-string (string regexp newtext &optional literal) + "Replace all matches for REGEXP with NEWTEXT in STRING. +If LITERAL is non-nil, insert NEWTEXT literally. Return a new +string containing the replacements. + +This is a compatibility function for different Emacsen." + (replace-regexp-in-string regexp newtext string nil literal))))) + (defgroup smime nil - "S/MIME configuration.") + "S/MIME configuration." + :group 'mime) (defcustom smime-keys nil "*Map mail addresses to a file containing Certificate (and private key). @@ -223,6 +238,7 @@ If nil, use system defaults." If needed search base, binddn, passwd, etc. for the LDAP host must be set in `ldap-host-parameters-alist'." :type '(repeat (string :tag "Host name")) + :version "23.0" ;; No Gnus :group 'smime) (defvar smime-details-buffer "*OpenSSL output*") @@ -350,9 +366,10 @@ KEYFILE should contain a PEM encoded key and certificate." keyfile (smime-get-key-with-certs-by-email (completing-read - (concat "Sign using which key? " - (if smime-keys (concat "(default " (caar smime-keys) ") ") - "")) + (concat "Sign using key" + (if smime-keys + (concat " (default " (caar smime-keys) "): ") + ": ")) smime-keys nil nil (car-safe (car-safe smime-keys)))))) (error "Signing failed")))) @@ -481,9 +498,9 @@ in the buffer specified by `smime-details-buffer'." (or keyfile (smime-get-key-by-email (completing-read - (concat "Decipher using which key? " - (if smime-keys (concat "(default " (caar smime-keys) ") ") - "")) + (concat "Decipher using key" + (if smime-keys (concat " (default " (caar smime-keys) "): ") + ": ")) smime-keys nil nil (car-safe (car-safe smime-keys))))))))) ;; Various operations @@ -572,13 +589,37 @@ A string or a list of strings is returned." (defun smime-cert-by-ldap-1 (mail host) "Get cetificate for MAIL from the ldap server at HOST." - (let ((ldapresult (smime-ldap-search (concat "mail=" mail) - host '("userCertificate") nil)) + (let ((ldapresult + (funcall + (if (or (featurep 'xemacs) + ;; For Emacs >= 22 we don't need smime-ldap.el + (< emacs-major-version 22)) + (progn + (require 'smime-ldap) + 'smime-ldap-search) + 'ldap-search) + (concat "mail=" mail) + host '("userCertificate") nil)) (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) cert) - (if (> (length ldapresult) 1) + (if (and (>= (length ldapresult) 1) + (> (length (cadaar ldapresult)) 0)) (with-current-buffer retbuf - (setq cert (base64-encode-string (nth 1 (car (nth 1 ldapresult))) t)) + ;; Certificates on LDAP servers _should_ be in DER format, + ;; but there are some servers out there that distributes the + ;; certificates in PEM format (with or without + ;; header/footer) so we try to handle them anyway. + (if (or (string= (substring (cadaar ldapresult) 0 27) + "-----BEGIN CERTIFICATE-----") + (string= (substring (cadaar ldapresult) 0 3) + "MII")) + (setq cert + (smime-replace-in-string + (cadaar ldapresult) + (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" + "-----END CERTIFICATE-----\\)") + "" t)) + (setq cert (base64-encode-string (cadaar ldapresult) t))) (insert "-----BEGIN CERTIFICATE-----\n") (let ((i 0) (len (length cert))) (while (> (- len 64) i) @@ -630,7 +671,8 @@ The following commands are available: (use-local-map smime-mode-map) (buffer-disable-undo) (setq truncate-lines t) - (setq buffer-read-only t)) + (setq buffer-read-only t) + (gnus-run-mode-hooks 'smime-mode-hook)) (defun smime-certificate-info (certfile) (interactive "fCertificate file: ")