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 12 Feb 2005 19:38:41 -0000 @@ -119,6 +119,7 @@ ;;; Code: (require 'dig) +(require 'ldap) (eval-when-compile (require 'cl)) (defgroup smime nil @@ -215,6 +216,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 +561,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 (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*") 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 12 Feb 2005 19:38:42 -0000 @@ -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? "))))