X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/590a6e6c11ce070845e234c4bcf5eac8d856fcd1..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/net/ldap.el?ds=sidebyside diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 1724d9b1ea..f093fb1cbc 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, 1999, 2000, 2002 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 02, 2004 Free Software Foundation, Inc. -;; Author: Oscar Figueiredo -;; Maintainer: Oscar Figueiredo +;; Author: Oscar Figueiredo +;; Maintainer: Pavel Janík ;; Created: April 1998 ;; Keywords: comm @@ -36,6 +36,7 @@ ;;; Code: (require 'custom) +(eval-when-compile (require 'cl)) (defgroup ldap nil "Lightweight Directory Access Protocol." @@ -70,7 +71,7 @@ Acme organization in the United States." (defcustom ldap-host-parameters-alist nil "*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 +HOST is the hostname of an LDAP server (with an optional TCP port number appended to it using a colon as a separator). PROPn and VALn are property/value pairs describing parameters for the server. Valid properties include: @@ -152,12 +153,8 @@ Valid properties include: :type '(string :tag "`ldapsearch' Program") :group 'ldap) -(defcustom ldap-ldapsearch-args '("-B") - "*A list of additional arguments to pass to `ldapsearch'. -It is recommended to use the `-T' switch with Netscape's -implementation to avoid line wrapping. -The `-B' switch should be used to enable the retrieval of -binary values." +(defcustom ldap-ldapsearch-args '("-LL" "-tt" "-x") + "*A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument")) :group 'ldap) @@ -468,17 +465,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)))) @@ -558,18 +554,24 @@ 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 - "-t" ; Write values to temp files ,@ldap-ldapsearch-args ,@filter)) (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... ") + ;; Skip error message when retrieving attribute list + (if (looking-at "Size limit exceeded") + (forward-line 1)) (while (progn (skip-chars-forward " \t\n") (not (eobp))) @@ -580,13 +582,21 @@ an alist of attribute/value pairs." (while (looking-at "^\\(\\w*\\)[=:\t ]+\\(<[\t ]*file://\\)?\\(.*\\)$") (setq name (match-string 1) value (match-string 3)) - (save-excursion - (set-buffer bufval) - (erase-buffer) - (set-buffer-multibyte nil) - (insert-file-contents-literally value) - (delete-file value) - (setq value (buffer-string))) + ;; 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 " ") + (save-excursion + (set-buffer bufval) + (erase-buffer) + (set-buffer-multibyte nil) + (insert-file-contents-literally value) + (delete-file value) + (setq value (buffer-string)))) (setq record (cons (list name value) record)) (forward-line 1)) @@ -602,4 +612,5 @@ an alist of attribute/value pairs." (provide 'ldap) +;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here