]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ldap.el
Convert consecutive FSF copyright years to ranges.
[gnu-emacs] / lisp / net / ldap.el
index f8e99abd182cab11871890e23e32d2cec2f854d1..3ccad277ffb48ef3a9330b7612774c1776fb1627 100644 (file)
@@ -1,7 +1,6 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
-;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
-;;   2005 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011  Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
 ;; Maintainer: FSF
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
@@ -21,9 +20,7 @@
 ;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -45,7 +42,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")
@@ -53,14 +50,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."
@@ -70,7 +67,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).
@@ -150,28 +147,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" "-x")
-  "*A list of additional arguments to pass to `ldapsearch'."
+(defcustom ldap-ldapsearch-args '("-LL" "-tt")
+  "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)
@@ -490,9 +487,11 @@ to try to connect to.  Each host name may optionally be of the form HOST:PORT.
 for each matching entry. If nil, return all available attributes.
   `attrsonly', if non-nil, indicates that only attributes are retrieved,
 not their associated values.
+  `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
   `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 syntax).
+  `auth' is one of the symbols `simple', `krbv41' or `krbv42'
   `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.
@@ -512,6 +511,7 @@ an alist of attribute/value pairs."
                  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))
@@ -523,8 +523,7 @@ an alist of attribute/value pairs."
            (equal "" filter))
        (error "No search filter"))
     (setq filter (cons filter attributes))
-    (save-excursion
-      (set-buffer buf)
+    (with-current-buffer buf
       (erase-buffer)
       (if (and host
               (not (equal "" host)))
@@ -541,6 +540,9 @@ an alist of attribute/value pairs."
       (if (and binddn
               (not (equal "" binddn)))
          (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
+      (if (and auth
+              (equal 'simple auth))
+         (setq arglist (nconc arglist (list "-x"))))
       (if (and passwd
               (not (equal "" passwd)))
          (setq arglist (nconc arglist (list (format "-w%s" passwd)))))
@@ -553,13 +555,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)
-                          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,11 +575,11 @@ an alist of attribute/value pairs."
        (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 "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$")
+          (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
+\\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
+\\(<[\t ]*file://\\)\\(.*\\)$")
            (setq name (match-string 1)
                  value (match-string 4))
             ;; Need to handle file:///D:/... as generated by OpenLDAP
@@ -591,8 +590,7 @@ an alist of attribute/value pairs."
            ;; Do not try to open non-existent files
            (if (equal value "")
                (setq value " ")
-             (save-excursion
-               (set-buffer bufval)
+             (with-current-buffer bufval
                (erase-buffer)
                (set-buffer-multibyte nil)
                (insert-file-contents-literally value)
@@ -601,9 +599,9 @@ an alist of attribute/value pairs."
            (setq record (cons (list name value)
                               record))
            (forward-line 1))
-         (setq result (cons (if withdn
-                                (cons dn (nreverse record))
-                              (nreverse record)) result))
+         (push (if withdn
+                   (cons dn (nreverse record))
+                 (nreverse record)) result)
          (setq record nil)
          (skip-chars-forward " \t\n")
          (message "Parsing results... %d" numres)
@@ -613,5 +611,4 @@ an alist of attribute/value pairs."
 
 (provide 'ldap)
 
-;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0
 ;;; ldap.el ends here