Index: lisp/mml-smime.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/mml-smime.el,v
retrieving revision 7.3
diff -u -p -r7.3 mml-smime.el
--- lisp/mml-smime.el	20 May 2004 08:02:40 -0000	7.3
+++ lisp/mml-smime.el	13 Feb 2005 15:40:20 -0000
@@ -1,5 +1,5 @@
 ;;; mml-smime.el --- S/MIME support for MML
-;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: Gnus, MIME, S/MIME, MML
@@ -115,6 +115,25 @@
       (quit))
     result))
 
+(defun mml-smime-get-dns-ldap ()
+  ;; 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
@@ -122,9 +141,11 @@
     (while (not done)
       (ecase (read (gnus-completing-read-with-default
 		    "dns" "Fetch certificate from"
-		    '(("dns") ("file")) nil t))
+		    '(("dns") ("ldap") ("file")) nil t))
 	(dns (setq certs (append certs
 				 (mml-smime-get-dns-cert))))
+	(ldap (setq certs (append certs
+				 (mml-smime-get-dns-ldap))))
 	(file (setq certs (append certs
 				  (mml-smime-get-file-cert)))))
       (setq done (not (y-or-n-p "Add more recipients? "))))
Index: lisp/smime.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/smime.el,v
retrieving revision 7.5
diff -u -p -r7.5 smime.el
--- lisp/smime.el	19 Sep 2004 20:24:26 -0000	7.5
+++ lisp/smime.el	13 Feb 2005 15:40:21 -0000
@@ -1,5 +1,5 @@
 ;;; smime.el --- S/MIME support library
-;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc.
+;; Copyright (c) 2000, 2001, 2003, 2005 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: SMIME X.509 PEM OpenSSL
@@ -26,7 +26,7 @@
 ;; This library perform S/MIME operations from within Emacs.
 ;;
 ;; Functions for fetching certificates from public repositories are
-;; provided, currently only from DNS.  LDAP support (via EUDC) is planned.
+;; provided, currently from DNS and LDAP.
 ;;
 ;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
 ;; encryption and decryption.
@@ -115,10 +115,12 @@
 ;; 2000-06-05  initial version, committed to Gnus CVS contrib/
 ;; 2000-10-28  retrieve certificates via DNS CERT RRs
 ;; 2001-10-14  posted to gnu.emacs.sources
+;; 2005-02-13  retrieve certificates via LDAP
 
 ;;; Code:
 
 (require 'dig)
+(require 'smime-ldap)
 (eval-when-compile (require 'cl))
 
 (defgroup smime nil
@@ -215,6 +217,11 @@ If nil, use system defaults."
 		 string)
   :group 'smime)
 
+(defcustom smime-ldap-host-list nil
+  "A list of LDAP hosts with S/MIME user certificates."
+  :type '(repeat (string :tag "Host name"))
+  :group 'smime)
+
 (defvar smime-details-buffer "*OpenSSL output*")
 
 ;; Use mm-util?
@@ -555,6 +562,33 @@ A string or a list of strings is returne
       (kill-buffer digbuf)
       retbuf))
 
+(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))
+	(retbuf (generate-new-buffer (format "*certificate for %s*" mail))))
+    (if (> (length ldapresult) 1)
+	(with-current-buffer retbuf
+	  (set-buffer-multibyte nil)
+	  (insert (nth 1 (car (nth 1 ldapresult))))
+	  (goto-char (point-min))
+	  (if (smime-call-openssl-region (point-min) (point-max) t "x509" "-inform" "DER" "-outform" "PEM")
+	      (progn 
+		(delete-region (point) (point-max))
+		retbuf)
+	    (kill-buffer retbuf)
+	    nil))
+      (kill-buffer retbuf)
+      nil)))
+
+(defun smime-cert-by-ldap (mail)
+  "Find certificate for MAIL."
+  (if smime-ldap-host-list
+      (catch 'certbuf
+	(dolist (host smime-ldap-host-list)
+	  (let ((retbuf (smime-cert-by-ldap-1 mail host)))
+	    (when retbuf 
+	      (throw 'certbuf retbuf)))))))
+  
 ;; User interface.
 
 (defvar smime-buffer "*SMIME*")