Re: Get certificate from LDAP for S/MIME encryption (patch)

["Arne Jørgensen" <arne@arnested.dk>]

[-- Attachment #1: Type: text/plain, Size: 3725 bytes --]

Simon Josefsson <jas@extundo.com> writes:

> Arne Jørgensen <arne@arnested.dk> writes:
>
>> I have written a patch for smime.el and mml-smime.el that implements
>> this.
>
> Neat!
>
>> At the moment the functions are added to Gnus at the same places where
>> you will find the support for getting certificates via DNS. So the
>> functionality is only at hand if you choose to encrypt a part and not
>> a message. But this is general problem not directly related to LDAP
>> support.[1]
>
> This came up recently as well.  If you want to work on fixing that, it
> would be appreciated.

See below.

>> A major drawback is that it will only work with the Emacs 22 (the cvs
>> version). This is partly because Emacs 21.3's ldap.el is written
>> towards OpenLDAP v1 (and I think everybody uses OpenLDAP v2 these
>> days) and partly because a regexp in that ldap.el does not recognise
>> attribute description like the binary part of
>> "userCertificate;binary". A patch for Emacs 21.3's ldap.el is
>> attached.
>
> Can you post it to emacs-devel@gnu.org?  If nobody objects to it, but
> nobody apply it, ping me and I might be able to.

Well, CVS Emacs' ldap.el is already written towards OpenLDAP v2 and
I got the patches to retrieve ";binary" stuff applied about a week
ago.

There are no realeases planned in the 21.x series except for security
fixes (like the newly released 21.4). The next realease from cvs trunk
will be 22.

In stead I have implemented a `smime-ldap-search' that will just call
`ldap-search' when running in Emacs 22 an above, and use a slightly
rewritten version of the same function in Emacs 21. See attached file
and new patch to use it.

>> I have not tested it on 20.7 (is it still supported by Gnus?).  I
>> tried building No Gnus on 20.7, but that didn't work (this may be
>> because of a bad emacs installation on the machine with 20.7). It
>> will probably not work on 20.7 because as fare as I can see there is
>> no ldap.el in 20.7.
>
> CVS Gnus do not support 20.7.

Great. I hadn't noticed.

>> [1] Actually I will probably volunteer to reimplement the user
>>     interface to the S/MIME stuff. But before coding we should agree
>>     on how we would like it to be. (And PGP and S/MIME should probably
>>     share the same interface ideas and I know noting about PGP (yet)).
>
> Great.  What is there to agree on?  Is there something wrong with
> making the MML tag for individual parts work on the "global" security
> MML tag?

I don't think so. That was part of what I was thinking on.

Other thoughts are:

 - gnus should try to find the certificate without asking the user.
   Probably a list of preferred methods ('dns 'ldap 'file 'ask).

 - better access to locally cached certificates (this was mentioned in
   the recent thread on comp.emacs.gnus also). We could just store the
   certificates in a dir with the email adress as file name.

 - maybe wait until the messages is to be sent before we ask which
   certificates to use. At the moment you will not sign/encrypt to
   adresse added after you have put ind the mml tags. Dns and
   ldap stores the certificates in a temporary buffer - what happens
   if you file the mail as a draft and leave Emacs?

 - havent verified this recently, but I think gnus will send a message
   even though openssl fails (ie because of a typo in the password).
   This should probably be considered a security bug.

 - use password.el to cache passwords as you mentioned on
   comp.emacs.gnus.

> Have you assigned copyright on your work?  It is required before we
> can install your patch.

Yes. I signed papers for Gnus some time around christmas 2003.

> Thanks!

Always a pleasure.

Kind regards,
-- 
Arne Jørgensen <http://arnested.dk/>


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Patch for mml-smime.el and smime.el --]
[-- Type: text/x-patch, Size: 4647 bytes --]

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*")

[-- Attachment #3: Slightly changed version of ldap-search for Emacs 21 --]
[-- Type: application/emacs-lisp, Size: 7837 bytes --]