X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/14beddf4711854b01d400f36166dc71eb39435bb..7e09ef09a479731d01b1ca46e94ddadd73ac98e3:/lisp/net/ldap.el?ds=sidebyside

diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el
index 3ccad277ff..eb1b7589b4 100644
--- a/lisp/net/ldap.el
+++ b/lisp/net/ldap.el
@@ -1,9 +1,9 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
-;; Copyright (C) 1998-2011  Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Created: April 1998
 ;; Keywords: comm
 
@@ -34,7 +34,8 @@
 ;;; Code:
 
 (require 'custom)
-(eval-when-compile (require 'cl))
+
+(autoload 'auth-source-search "auth-source")
 
 (defgroup ldap nil
   "Lightweight Directory Access Protocol."
@@ -463,12 +464,12 @@ Additional search parameters can be specified through
       (error "No LDAP host specified"))
   (let ((host-plist (cdr (assoc host ldap-host-parameters-alist)))
 	result)
-    (setq result (ldap-search-internal (list* 'host host
-					      'filter filter
-					      'attributes attributes
-					      'attrsonly attrsonly
-					      'withdn withdn
-					      host-plist)))
+    (setq result (ldap-search-internal `(host ,host
+					 filter ,filter
+                                         attributes ,attributes
+                                         attrsonly ,attrsonly
+                                         withdn ,withdn
+                                         ,@host-plist)))
     (if ldap-ignore-attribute-codings
 	result
       (mapcar (lambda (record)
@@ -480,7 +481,23 @@ Additional search parameters can be specified through
   "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
+
+  `auth-source', if non-nil, will use `auth-source-search' and
+will grab the :host, :secret, :base, and (:user or :binddn)
+tokens into the `host', `passwd', `base', and `binddn' parameters
+respectively if they are not provided in SEARCH-PLIST.  So for
+instance *each* of these netrc lines has the same effect if you
+ask for the host \"ldapserver:2400\":
+
+  machine ldapserver:2400 login myDN secret myPassword base myBase
+  machine ldapserver:2400 binddn myDN secret myPassword port ldap
+  login myDN secret myPassword base myBase
+
+but if you have more than one in your netrc file, only the first
+matching one will be used.  Note the \"port ldap\" part is NOT
+required.
+
+  `host' is a string naming one or more (blank-separated) LDAP servers
 to try to connect to.  Each host name may optionally be of the form HOST:PORT.
   `filter' is a filter string for the search as described in RFC 1558.
   `attributes' is a list of strings indicating which attributes to retrieve
@@ -500,19 +517,34 @@ not their associated values.
 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*"))
+  (let* ((buf (get-buffer-create " *ldap-search*"))
 	(bufval (get-buffer-create " *ldap-value*"))
 	(host (or (plist-get search-plist 'host)
 		  ldap-default-host))
+         ;; find entries with port "ldap" that match the requested host if any
+         (asfound (when (plist-get search-plist 'auth-source)
+                    (nth 0 (auth-source-search :host (or host t)
+                                               :create t))))
+         ;; if no host was requested, get it from the auth-source entry
+         (host (or host (plist-get asfound :host)))
+         ;; get the password from the auth-source
+         (passwd (or (plist-get search-plist 'passwd)
+                     (plist-get asfound :secret)))
+         ;; convert the password from a function call if needed
+         (passwd (if (functionp passwd) (funcall passwd) passwd))
+         ;; get the binddn from the search-list or from the
+         ;; auth-source user or binddn tokens
+         (binddn (or (plist-get search-plist 'binddn)
+                     (plist-get asfound :user)
+                     (plist-get asfound :binddn)))
+         (base (or (plist-get search-plist 'base)
+                   (plist-get asfound :base)
+                   ldap-default-base))
 	(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))
         (auth (plist-get search-plist 'auth))
-	(passwd (plist-get search-plist 'passwd))
 	(deref (plist-get search-plist 'deref))
 	(timelimit (plist-get search-plist 'timelimit))
 	(sizelimit (plist-get search-plist 'sizelimit))
@@ -572,6 +604,7 @@ an alist of attribute/value pairs."
 	;; Skip error message when retrieving attribute list
 	(if (looking-at "Size limit exceeded")
 	    (forward-line 1))
+        (if (looking-at "version:") (forward-line 1)) ;bug#12724.
 	(while (progn
 		 (skip-chars-forward " \t\n")
 		 (not (eobp)))
@@ -599,9 +632,10 @@ an alist of attribute/value pairs."
 	    (setq record (cons (list name value)
 			       record))
 	    (forward-line 1))
-	  (push (if withdn
-		    (cons dn (nreverse record))
-		  (nreverse record)) result)
+	  (cond (withdn
+		 (push (cons dn (nreverse record)) result))
+		(record
+		 (push (nreverse record) result)))
 	  (setq record nil)
 	  (skip-chars-forward " \t\n")
 	  (message "Parsing results... %d" numres)