]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ldap.el
Document some (perhaps incomplete) pixelwise window operations.
[gnu-emacs] / lisp / net / ldap.el
index afdb0fe3e13b1e7b80b9a82c635411d6b2c5639e..10ce7a78d358bf18d74bbfe9af9041f2ed8148b2 100644 (file)
@@ -1,10 +1,9 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: FSF
+;; Maintainer: emacs-devel@gnu.org
 ;; Created: April 1998
 ;; Keywords: comm
 
@@ -35,7 +34,8 @@
 ;;; Code:
 
 (require 'custom)
-(eval-when-compile (require 'cl))
+
+(autoload 'auth-source-search "auth-source")
 
 (defgroup ldap nil
   "Lightweight Directory Access Protocol."
@@ -43,7 +43,7 @@
   :group 'comm)
 
 (defcustom ldap-default-host nil
-  "*Default LDAP server.
+  "Default LDAP server.
 A TCP port number can be appended to that name using a colon as
 a separator."
   :type '(choice (string :tag "Host name")
@@ -51,14 +51,14 @@ a separator."
   :group 'ldap)
 
 (defcustom ldap-default-port nil
-  "*Default TCP port for LDAP connections.
+  "Default TCP port for LDAP connections.
 Initialized from the LDAP library at build time. Default value is 389."
   :type '(choice (const :tag "Use library default" nil)
                 (integer :tag "Port number"))
   :group 'ldap)
 
 (defcustom ldap-default-base nil
-  "*Default base for LDAP searches.
+  "Default base for LDAP searches.
 This is a string using the syntax of RFC 1779.
 For instance, \"o=ACME, c=US\" limits the search to the
 Acme organization in the United States."
@@ -68,7 +68,7 @@ Acme organization in the United States."
 
 
 (defcustom ldap-host-parameters-alist nil
-  "*Alist of host-specific options for LDAP transactions.
+  "Alist of host-specific options for LDAP transactions.
 The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...).
 HOST is the hostname of an LDAP server (with an optional TCP port number
 appended to it using a colon as a separator).
@@ -148,28 +148,28 @@ Valid properties include:
   :group 'ldap)
 
 (defcustom ldap-ldapsearch-prog "ldapsearch"
-  "*The name of the ldapsearch command line program."
+  "The name of the ldapsearch command line program."
   :type '(string :tag "`ldapsearch' Program")
   :group 'ldap)
 
 (defcustom ldap-ldapsearch-args '("-LL" "-tt")
-  "*A list of additional arguments to pass to `ldapsearch'."
+  "A list of additional arguments to pass to `ldapsearch'."
   :type '(repeat :tag "`ldapsearch' Arguments"
                 (string :tag "Argument"))
   :group 'ldap)
 
 (defcustom ldap-ignore-attribute-codings nil
-  "*If non-nil, do not encode/decode LDAP attribute values."
+  "If non-nil, do not encode/decode LDAP attribute values."
   :type 'boolean
   :group 'ldap)
 
 (defcustom ldap-default-attribute-decoder nil
-  "*Decoder function to use for attributes whose syntax is unknown."
+  "Decoder function to use for attributes whose syntax is unknown."
   :type 'symbol
   :group 'ldap)
 
 (defcustom ldap-coding-system 'utf-8
-  "*Coding system of LDAP string values.
+  "Coding system of LDAP string values.
 LDAP v3 specifies the coding system of strings to be UTF-8."
   :type 'symbol
   :group 'ldap)
@@ -464,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)
@@ -481,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
@@ -501,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))
@@ -556,13 +587,10 @@ an alist of attribute/value pairs."
       (if (and sizelimit
               (not (equal "" sizelimit)))
          (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
-      (eval `(call-process ldap-ldapsearch-prog
-                          nil
-                          buf
-                          nil
-                          ,@arglist
-                          ,@ldap-ldapsearch-args
-                          ,@filter))
+      (apply #'call-process ldap-ldapsearch-prog
+            ;; Ignore stderr, which can corrupt results
+            nil (list buf nil) nil
+            (append arglist ldap-ldapsearch-args filter))
       (insert "\n")
       (goto-char (point-min))
 
@@ -576,12 +604,11 @@ 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)))
-         (setq dn (buffer-substring (point) (save-excursion
-                                              (end-of-line)
-                                              (point))))
+         (setq dn (buffer-substring (point) (point-at-eol)))
          (forward-line 1)
           (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
 \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
@@ -605,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)
@@ -617,5 +645,4 @@ an alist of attribute/value pairs."
 
 (provide 'ldap)
 
-;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0
 ;;; ldap.el ends here