X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/01f91eb8509ca81a8088b1a6995ea8e0dec6a4bd..d35a5141a520f29b29ba5e5e7f1f2e339a719b5d:/lisp/net/ldap.el diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index 2d1f9a0a39..bff7cf7180 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -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, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. -;; Author: Oscar Figueiredo -;; Maintainer: Oscar Figueiredo +;; Author: Oscar Figueiredo +;; Maintainer: FSF ;; Created: April 1998 ;; Keywords: comm @@ -11,7 +12,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -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." @@ -152,12 +154,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") + "*A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument")) :group 'ldap) @@ -468,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)))) @@ -493,9 +490,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. @@ -515,6 +514,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)) @@ -544,6 +544,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))))) @@ -561,15 +564,21 @@ an alist of attribute/value pairs." buf 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))) @@ -577,16 +586,26 @@ an alist of attribute/value pairs." (end-of-line) (point)))) (forward-line 1) - (while (looking-at "^\\(\\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 3)) - (save-excursion - (set-buffer bufval) - (erase-buffer) - (set-buffer-multibyte nil) - (insert-file-contents-literally value) - (delete-file value) - (setq value (buffer-string))) + 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 " ") + (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 +621,5 @@ an alist of attribute/value pairs." (provide 'ldap) +;;; arch-tag: 47913a76-6155-42e6-ac58-6d28b5d50eb0 ;;; ldap.el ends here