]> code.delx.au - gnu-emacs/blobdiff - lisp/net/ldap.el
(goto-address-fontify): Put `follow-link' property on mail and url overlays.
[gnu-emacs] / lisp / net / ldap.el
index 03923eb4114289685e4c9b44025760a1cb04c8be..f8e99abd182cab11871890e23e32d2cec2f854d1 100644 (file)
@@ -1,9 +1,10 @@
 ;;; ldap.el --- client interface to LDAP for Emacs
 
-;; Copyright (C) 1998, 1999, 2000, 2002 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2002, 2003, 2004,
+;;   2005 Free Software Foundation, Inc.
 
 ;; Author: Oscar Figueiredo <oscar@cpe.fr>
-;; Maintainer: Pavel Janík <Pavel@Janik.cz>
+;; Maintainer: FSF
 ;; Created: April 1998
 ;; Keywords: comm
 
@@ -21,8 +22,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -36,6 +37,7 @@
 ;;; Code:
 
 (require 'custom)
+(eval-when-compile (require 'cl))
 
 (defgroup ldap nil
   "Lightweight Directory Access Protocol."
@@ -464,17 +466,16 @@ 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 (append host-plist
-                                              (list 'host host
-                                                    'filter filter
-                                                    'attributes attributes
-                                                    'attrsonly attrsonly
-                                                    'withdn withdn))))
+    (setq result (ldap-search-internal (list* 'host host
+                                             'filter filter
+                                             'attributes attributes
+                                             'attrsonly attrsonly
+                                             'withdn withdn
+                                             host-plist)))
     (if ldap-ignore-attribute-codings
        result
-      (mapcar (function
-              (lambda (record)
-                (mapcar 'ldap-decode-attribute record)))
+      (mapcar (lambda (record)
+               (mapcar 'ldap-decode-attribute record))
              result))))
 
 
@@ -554,7 +555,7 @@ an alist of attribute/value pairs."
          (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
       (eval `(call-process ldap-ldapsearch-prog
                           nil
-                          buf
+                          `(,buf nil)
                           nil
                           ,@arglist
                           ,@ldap-ldapsearch-args
@@ -562,6 +563,10 @@ an alist of attribute/value pairs."
       (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... ")
@@ -575,9 +580,14 @@ 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))
+            ;; Need to handle file:///D:/... as generated by OpenLDAP
+            ;; on DOS/Windows as local files.
+            (if (and (memq system-type '(windows-nt ms-dos))
+                     (eq (string-match "/\\(.:.*\\)$" value) 0))
+                (setq value (match-string 1 value)))
            ;; Do not try to open non-existent files
            (if (equal value "")
                (setq value " ")
@@ -603,4 +613,5 @@ an alist of attribute/value pairs."
 
 (provide 'ldap)
 
+;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0
 ;;; ldap.el ends here