Gnus development mailing list
 help / color / mirror / Atom feed
* Get certificate from LDAP for S/MIME encryption (patch)
@ 2005-02-12 20:08 Arne Jørgensen
  2005-02-13  0:22 ` Simon Josefsson
  0 siblings, 1 reply; 13+ messages in thread
From: Arne Jørgensen @ 2005-02-12 20:08 UTC (permalink / raw)


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

Hi,

Downloading certificates for S/MIME encryption from LDAP servers has
been on the (at least my) wish list for at long time.

I have written a patch for smime.el and mml-smime.el that implements
this.

You need to set `smime-ldap-host-list' to a list of LDAP server to ask
for the certificate. (dir.certifikat.dk has my certificate ...)

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]

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.

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.

Kind regards,

Arne

[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)).
-- 
Arne Jørgensen <http://arnested.dk/>


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

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

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: Patch for Emacs 21.3's ldap.el --]
[-- Type: text/x-patch, Size: 1100 bytes --]

--- ldap.el~	2005-02-12 19:39:37.000000000 +0100
+++ ldap.el	2005-02-12 19:39:32.000000000 +0100
@@ -568,12 +568,18 @@ an alist of attribute/value pairs."
 			   buf
 			   nil	  
 			   ,@arglist
-			   "-t"		; Write values to temp files
+			   "-tt"		; Write values to temp files
+			   "-x"
+			   "-LL"
 			   ,@ldap-ldapsearch-args
 			   ,@filter))
       (insert "\n")
       (goto-char (point-min))
       
+      (while (re-search-forward "[\t\n\f]+ " nil t)
+	(replace-match "" nil nil))
+      (goto-char (point-min))
+
       (if (looking-at "usage")
 	  (error "Incorrect ldapsearch invocation")
 	(message "Parsing results... ")
@@ -584,9 +590,9 @@ an alist of attribute/value pairs."
 					       (end-of-line)
 					       (point))))
 	  (forward-line 1)
-	  (while (looking-at "^\\(\\w*\\)[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$")
+	  (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$")
 	    (setq name (match-string 1)
-		  value (match-string 3))
+		  value (match-string 4))
 	    (save-excursion
 	      (set-buffer bufval)
 	      (erase-buffer)

^ permalink raw reply	[flat|nested] 13+ messages in thread

end of thread, other threads:[~2005-02-22 16:57 UTC | newest]

Thread overview: 13+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2005-02-12 20:08 Get certificate from LDAP for S/MIME encryption (patch) Arne Jørgensen
2005-02-13  0:22 ` Simon Josefsson
2005-02-13 16:10   ` Arne Jørgensen
2005-02-17 23:32     ` Arne Jørgensen
2005-02-13 20:02   ` Arne Jørgensen
2005-02-14 13:42   ` Arne Jørgensen
     [not found]   ` <877jlbrzdq.fsf@seamus.arnested.dk>
2005-02-14 15:37     ` Simon Josefsson
2005-02-14 19:01       ` Arne Jørgensen
2005-02-14 22:36         ` Simon Josefsson
2005-02-14 22:50           ` Arne Jørgensen
2005-02-14 23:02             ` Simon Josefsson
2005-02-17 23:27           ` Arne Jørgensen
2005-02-22 16:57             ` Simon Josefsson

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).