X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmml-smime.el;h=3b8e820922af34c44d0f4c9adf44bf369155dbb2;hb=5835aa3205a79608e81c5534e73826f3d6823c03;hp=dbcd1c1e461d1c5e9d4ec9938f36c542c99a8559;hpb=5ed79118a0312f8ab9d001ae0e84281ab46aeb8f;p=elisp%2Fgnus.git-

diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el
index dbcd1c1..3b8e820 100644
--- a/lisp/mml-smime.el
+++ b/lisp/mml-smime.el
@@ -1,5 +1,7 @@
 ;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+
+;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: Gnus, MIME, S/MIME, MML
@@ -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:
 
@@ -27,7 +29,10 @@
 
 (eval-when-compile (require 'cl))
 
-(require 'smime)
+;; EMIKO doesn't provide the smime.el module.
+(condition-case nil
+    (require 'smime)
+  (error))
 (require 'mm-decode)
 (autoload 'message-narrow-to-headers "message")
 (autoload 'message-fetch-field "message")
@@ -52,7 +57,7 @@
       (if (not (and (not (file-exists-p tmp))
 		    (get-buffer tmp)))
 	  (push tmp certfiles)
-	(setq file (mm-make-temp-file (expand-file-name "mml." 
+	(setq file (mm-make-temp-file (expand-file-name "mml."
 							mm-tmp-directory)))
 	(with-current-buffer tmp
 	  (write-region (point-min) (point-max) file))
@@ -77,7 +82,10 @@
   (list 'keyfile
 	(if (= (length smime-keys) 1)
 	    (cadar smime-keys)
-	  (or (let ((from (cadr (funcall gnus-extract-address-components
+	  (or (let ((from (cadr (funcall (if (boundp
+					      'gnus-extract-address-components)
+					     gnus-extract-address-components
+					   'mail-extract-address-components)
 					 (or (save-excursion
 					       (save-restriction
 						 (message-narrow-to-headers)
@@ -103,7 +111,10 @@
 	(while (not result)
 	  (setq who (read-from-minibuffer
 		     (format "%sLookup certificate for: " (or bad ""))
-		     (cadr (funcall gnus-extract-address-components
+		     (cadr (funcall (if (boundp
+					 'gnus-extract-address-components)
+					gnus-extract-address-components
+				      'mail-extract-address-components)
 				    (or (save-excursion
 					  (save-restriction
 					    (message-narrow-to-headers)
@@ -115,16 +126,36 @@
       (quit))
     result))
 
+(defun mml-smime-get-ldap-cert ()
+  ;; todo: deal with comma separated multiple recipients
+  (let (result who bad cert)
+    (condition-case ()
+	(while (not result)
+	  (setq who (read-from-minibuffer
+		     (format "%sLookup certificate for: " (or bad ""))
+		     (cadr (funcall gnus-extract-address-components
+				    (or (save-excursion
+					  (save-restriction
+					    (message-narrow-to-headers)
+					    (message-fetch-field "to")))
+					"")))))
+	  (if (setq cert (smime-cert-by-ldap who))
+	      (setq result (list 'certfile (buffer-name cert)))
+	    (setq bad (format "`%s' not found. " who))))
+      (quit))
+    result))
+
 (defun mml-smime-encrypt-query ()
-  ;; todo: add ldap support (xemacs ldap api?)
   ;; todo: try dns/ldap automatically first, before prompting user
   (let (certs done)
     (while (not done)
       (ecase (read (gnus-completing-read-with-default
-		    "dns" "Fetch certificate from"
-		    '(("dns") ("file")) nil t))
+		    "ldap" "Fetch certificate from"
+		    '(("dns") ("ldap") ("file")) nil t))
 	(dns (setq certs (append certs
 				 (mml-smime-get-dns-cert))))
+	(ldap (setq certs (append certs
+				  (mml-smime-get-ldap-cert))))
 	(file (setq certs (append certs
 				  (mml-smime-get-file-cert)))))
       (setq done (not (y-or-n-p "Add more recipients? "))))