From mboxrd@z Thu Jan 1 00:00:00 1970 X-Msuck: nntp://news.gmane.io/gmane.emacs.gnus.general/59812 Path: main.gmane.org!not-for-mail From: =?utf-8?Q?Arne_J=C3=B8rgensen?= Newsgroups: gmane.emacs.gnus.general Subject: Re: Get certificate from LDAP for S/MIME encryption (patch) Date: Sun, 13 Feb 2005 17:10:30 +0100 Organization: Arne Joergensen -- http://arnested.dk/ Message-ID: <878y5sfnk9.fsf@seamus.arnested.dk> References: <87u0ohv8vg.fsf@seamus.arnested.dk> NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: sea.gmane.org 1108509106 27388 80.91.229.2 (15 Feb 2005 23:11:46 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Tue, 15 Feb 2005 23:11:46 +0000 (UTC) Original-X-From: ding-owner+M8354@lists.math.uh.edu Wed Feb 16 00:11:46 2005 Original-Received: from malifon.math.uh.edu ([129.7.128.13] ident=mail) by ciao.gmane.org with esmtp (Exim 4.43) id 1D1Bqw-0001rM-Au for ding-account@gmane.org; Wed, 16 Feb 2005 00:11:35 +0100 Original-Received: from localhost ([127.0.0.1] helo=lists.math.uh.edu ident=lists) by malifon.math.uh.edu with smtp (Exim 3.20 #1) id 1D1BtD-0000gN-00; Tue, 15 Feb 2005 17:13:55 -0600 Original-Received: from util2.math.uh.edu ([129.7.128.23]) by malifon.math.uh.edu with esmtp (Exim 3.20 #1) id 1D18xu-0000MB-08 for ding@lists.math.uh.edu; Tue, 15 Feb 2005 14:06:34 -0600 Original-Received: from quimby.gnus.org ([80.91.224.244]) by util2.math.uh.edu with esmtp (Exim 4.30) id 1D0MKb-0003aa-25 for ding@lists.math.uh.edu; Sun, 13 Feb 2005 10:10:45 -0600 Original-Received: from main.gmane.org ([80.91.229.2] helo=ciao.gmane.org) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1D0MKZ-0000JU-00 for ; Sun, 13 Feb 2005 17:10:43 +0100 Original-Received: from list by ciao.gmane.org with local (Exim 4.43) id 1D0MIN-0002gL-8n for ding@gnus.org; Sun, 13 Feb 2005 17:08:27 +0100 Original-Received: from 213.237.94.152 ([213.237.94.152]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 13 Feb 2005 17:08:27 +0100 Original-Received: from arne by 213.237.94.152 with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 13 Feb 2005 17:08:27 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-To: ding@gnus.org Original-Lines: 462 Original-X-Complaints-To: usenet@sea.gmane.org X-Gmane-NNTP-Posting-Host: 213.237.94.152 X-Face: 5t,7/Y$&<1A_t.$vC2{pWZ{m@3_06;kcm]no{hgEL/}Uz(>XV6cl4}xO\v?-h3%>znNaZtq `~rf,GY1T%r=a.zH`hOb(-]'x)nI088Z&|e;V^h;/TShou User-Agent: Gnus/5.110003 (No Gnus v0.3) Emacs/22.0.50 (gnu/linux) Cancel-Lock: sha1:6VGw9hYECDPJVLkA9tvPpQAXKrA= X-Spam-Score: -4.9 (----) Precedence: bulk Original-Sender: ding-owner@lists.math.uh.edu X-MailScanner-From: ding-owner+m8354@lists.math.uh.edu X-MailScanner-To: ding-account@gmane.org Xref: main.gmane.org gmane.emacs.gnus.general:59812 X-Report-Spam: http://spam.gmane.org/gmane.emacs.gnus.general:59812 --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit Simon Josefsson writes: > Arne Jørgensen 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 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=smime.patch Content-Description: Patch for mml-smime.el and smime.el 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 ;; 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 ;; 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*") --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=smime-ldap.el Content-Transfer-Encoding: quoted-printable Content-Description: Slightly changed version of ldap-search for Emacs 21 ;;; smime-ldap.el --- client interface to LDAP for Emacs ;; Copyright (C) 1998, 1999, 2000, 2005 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo ;; Maintainer: Arne J=1B,Ax=1B(Brgensen ;; Created: February 2005 ;; Keywords: comm ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; 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. ;;; Commentary: ;; This file has a slightly changed implementation of Emacs 21.3's ;; ldap-search and ldap-search-internal from ldap.el. The changes are ;; made to achieve compatibility with OpenLDAP v2 and to make it ;; possible to retrieve LDAP attributes that are tagged ie ";binary". ;; When Gnus drops support for Emacs 21.x this file can be removed and ;; smime.el changed to ;; - (require 'smime-ldap) =3D> (require 'ldap) ;; - (smime-ldap-search ...) =3D> (ldap-search ...) ;; If we are running in Emacs 22 or newer it just uses the build-in ;; version of ldap-search. ;;; Code: (load-library "net/ldap") (defun smime-ldap-search (filter &optional host attributes attrsonly withdn) "Perform an LDAP search. FILTER is the search filter in RFC1558 syntax. HOST is the LDAP host on which to perform the search. ATTRIBUTES are the specific attributes to retrieve, nil means=20 retrieve all. ATTRSONLY, if non-nil, retrieves the attributes only, without=20 the associated values. If WITHDN is non-nil, each entry in the result will be prepended with its distinguished name WITHDN. Additional search parameters can be specified through=20 `ldap-host-parameters-alist', which see." (interactive "sFilter:") (if (>=3D emacs-major-version 22) (ldap-search filter host attributes attrsonly) (or host (setq host ldap-default-host) (error "No LDAP host specified")) (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) result) (setq result (smime-ldap-search-internal (append host-plist (list 'host host 'filter filter 'attributes attributes=20 'attrsonly attrsonly 'withdn withdn)))) (if ldap-ignore-attribute-codings result (mapcar (function (lambda (record) (mapcar 'ldap-decode-attribute record))) result))))) =20=20 (defun smime-ldap-search-internal (search-plist) "Perform a search on a LDAP server. SEARCH-PLIST is a property list describing the search request. Valid keys in that list are: `host' is a string naming one or more (blank-separated) LDAP servers to to try to connect to. Each host name may optionally be of the form HOST:PO= RT. `filter' is a filter string for the search as described in RFC 1558. `attributes' is a list of strings indicating which attributes to retrieve for each matching entry. If nil, return all available attributes. `attrsonly', if non-nil, indicates that only attributes are retrieved, not their associated values. `base' is the base for the search as described in RFC 1779. `scope' is one of the three symbols `sub', `base' or `one'. `binddn' is the distinguished name of the user to bind as (in RFC 1779 sy= ntax). `passwd' is the password to use for simple authentication. `deref' is one of the symbols `never', `always', `search' or `find'. `timelimit' is the timeout limit for the connection in seconds. `sizelimit' is the maximum number of matches to return. `withdn' if non-nil each entry in the result will be prepended with its distinguished name DN. The function returns a list of matching entries. Each entry is itself an alist of attribute/value pairs." (let ((buf (get-buffer-create " *ldap-search*")) (bufval (get-buffer-create " *ldap-value*")) (host (or (plist-get search-plist 'host) ldap-default-host)) (filter (plist-get search-plist 'filter)) (attributes (plist-get search-plist 'attributes)) (attrsonly (plist-get search-plist 'attrsonly)) (base (or (plist-get search-plist 'base) ldap-default-base)) (scope (plist-get search-plist 'scope)) (binddn (plist-get search-plist 'binddn)) (passwd (plist-get search-plist 'passwd)) (deref (plist-get search-plist 'deref)) (timelimit (plist-get search-plist 'timelimit)) (sizelimit (plist-get search-plist 'sizelimit)) (withdn (plist-get search-plist 'withdn)) (numres 0) arglist dn name value record result) (if (or (null filter) (equal "" filter)) (error "No search filter")) (setq filter (cons filter attributes)) (save-excursion (set-buffer buf) (erase-buffer) (if (and host (not (equal "" host))) (setq arglist (nconc arglist (list (format "-h%s" host))))) (if (and attrsonly (not (equal "" attrsonly))) (setq arglist (nconc arglist (list "-A")))) (if (and base (not (equal "" base))) (setq arglist (nconc arglist (list (format "-b%s" base))))) (if (and scope (not (equal "" scope))) (setq arglist (nconc arglist (list (format "-s%s" scope))))) (if (and binddn (not (equal "" binddn))) (setq arglist (nconc arglist (list (format "-D%s" binddn))))) (if (and passwd (not (equal "" passwd))) (setq arglist (nconc arglist (list (format "-w%s" passwd))))) (if (and deref (not (equal "" deref))) (setq arglist (nconc arglist (list (format "-a%s" deref))))) (if (and timelimit (not (equal "" timelimit))) (setq arglist (nconc arglist (list (format "-l%s" timelimit))))) (if (and sizelimit (not (equal "" sizelimit))) (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) (eval `(call-process ldap-ldapsearch-prog nil buf nil=09=20=20 ,@arglist "-tt" ; Write values to temp files "-x" "-LL" ; ,@ldap-ldapsearch-args ,@filter)) (insert "\n") (goto-char (point-min)) =20=20=20=20=20=20 (while (re-search-forward "[\t\n\f]+ " nil t) (replace-match "" nil nil)) (goto-char (point-min)) =20=20=20=20=20=20 (if (looking-at "usage") (error "Incorrect ldapsearch invocation") (message "Parsing results... ") (while (progn=20 (skip-chars-forward " \t\n") (not (eobp))) (setq dn (buffer-substring (point) (save-excursion=20 (end-of-line) (point)))) (forward-line 1) (while (looking-at "^\\(\\w*\\)\\(;\\w*\\)?[=3D:\t ]+\\(<[\t ]*file://\\= )?\\(.*\\)$") (setq name (match-string 1) value (match-string 4)) (save-excursion (set-buffer bufval) (erase-buffer) (insert-file-contents-literally value) (delete-file value) (setq value (buffer-substring (point-min) (point-max)))) (setq record (cons (list name value) record)) (forward-line 1)) (setq result (cons (if withdn=20 (cons dn (nreverse record)) (nreverse record)) result)) (setq record nil) (skip-chars-forward " \t\n")=20=20=20=20=20=20 (message "Parsing results... %d" numres) (1+ numres)) (message "Parsing results... done") (nreverse result))))) (provide 'smime-ldap) ;;; smime-ldap.el ends here --=-=-=--