X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=elmo%2Fpldap.el;h=07722070968c778866cebb3b0fe7a74d669c150a;hb=64eb91d7fe775e78e0f1e6555b595e40f391260a;hp=265629cf3ea13e860403e0dfdd7cdba5b5f19021;hpb=806725e3db0748ddc973ba045053a6681e840287;p=elisp%2Fwanderlust.git diff --git a/elmo/pldap.el b/elmo/pldap.el index 265629c..0772207 100644 --- a/elmo/pldap.el +++ b/elmo/pldap.el @@ -1,4 +1,4 @@ -;;; pldap.el -- A portable LDAP support for Emacs. +;;; pldap.el --- A portable LDAP support for Emacs. ;; Copyright (C) 1998 Free Software Foundation, Inc. ;; Copyright (C) 2000 Yuuichi Teranishi @@ -34,11 +34,12 @@ ;;; Commentary: ;;; Code: -;; +;; (eval-when-compile (require 'cl)) (defmacro ldap-static-if (cond then &rest else) + "`if' expression but COND is evaluated at compile-time." (if (eval cond) then (` (progn (,@ else))))) @@ -55,7 +56,7 @@ ;; SAFE-CHAR = %x01-09 / %x0B-0C / %x0E-7F (defconst ldap-ldif-safe-char-regexp "[\000-\011\013\014\016-\177]" - "A Regexp for safe-char") + "A Regexp for safe-char.") ;; SAFE-INIT-CHAR = %x01-09 / %x0B-0C / %x0E-1F / ;; %x21-39 / %x3B / %x3D-7F (defconst ldap-ldif-safe-init-char-regexp @@ -66,7 +67,7 @@ (concat ldap-ldif-safe-init-char-regexp ldap-ldif-safe-char-regexp "*") "A Regexp for safe-string.") -(defconst ldap-ldif-field-name-regexp "[a-zA-Z][a-zA-Z0-9-]*" +(defconst ldap-ldif-field-name-regexp "[a-zA-Z][a-zA-Z0-9-;]*" "A Regexp for field name.") (defconst ldap-ldif-field-head-regexp @@ -98,11 +99,13 @@ (defvar ldap-modify-program "ldapmodify" "LDAP modify program.") -(defcustom ldap-search-program-arguments '("-L" "-B") +(defcustom ldap-search-program-arguments '("-LL" "-x") "*A list of additional arguments to pass to `ldapsearch'. It is recommended to use the `-T' switch with Nescape's implementation to avoid line wrapping. `-L' is needed to get LDIF outout. +(`-LL' is needed to get rid of comments from OpenLDAP's ldapsearch.) +`-x' is needed to use simple authentication. The `-B' switch should be used to enable the retrieval of binary values." :type '(repeat :tag "`ldapsearch' Arguments" @@ -110,9 +113,7 @@ binary values." :group 'ldap) (defcustom ldap-default-host nil - "*Default LDAP server hostname. -A TCP port number can be appended to that name using a colon as -a separator." + "*Default LDAP server hostname." :type '(choice (string :tag "Host name") (const :tag "Use library default" nil)) :group 'ldap) @@ -234,8 +235,7 @@ Valid properties include: :type 'symbol :group 'ldap) -(defcustom ldap-coding-system (if (boundp 'NEMACS) 0 - nil) +(defcustom ldap-coding-system nil "*Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8. Mule support is needed for this." @@ -688,7 +688,10 @@ entry according to the value of WITHDN." (list filter) attrs))) (if (and (integerp ret) - (not (zerop ret))) + (not (zerop ret)) + ;; When openldap's `ldapsearch' exceeds response size limit, + ;; it's exit status becomes `4'. + (/= ret 4)) (error "LDAP error: \"No such object\"")) (goto-char (point-min)) (setq start (point)) @@ -727,7 +730,7 @@ entry according to the value of WITHDN." (if (not (eobp)) (forward-char 1)) (setq start (point))) (if verbose - (message "Parsing ldap results...done.")) + (message "Parsing ldap results...done")) (delq nil (nreverse result))))) (defun ldap/field-end () @@ -746,7 +749,9 @@ entry according to the value of WITHDN." (let ((case-fold-search t) (field-body nil) body) - (while (re-search-forward (concat "^" name ":[ \t]*") nil t) + ;; search for the line which have name with options. + (while (re-search-forward (concat "^" name + "\\(;[a-zA-Z0-9-]+\\)?:[ \t]*") nil t) ;; Base64 (if (string-match "^:[ \t]*" (setq body (buffer-substring-no-properties @@ -760,10 +765,15 @@ entry according to the value of WITHDN." "Collect fields without WITHOUT." (goto-char (point-min)) (let ((regexp (concat "\\(" ldap-ldif-field-head-regexp "\\)[ \t]*")) - dest name body entry) + dest name name-option body entry) (while (re-search-forward regexp nil t) - (setq name (downcase (buffer-substring-no-properties - (match-beginning 1)(1- (match-end 1))))) + ;; name with options. + (setq name-option (split-string (downcase (buffer-substring-no-properties + (match-beginning 1) + (1- (match-end 1)))) + ";")) + ;; XXX options are discarded. + (setq name (car name-option)) (setq body (buffer-substring-no-properties (match-end 0) (ldap/field-end))) (if (string-match "^:[ \t]*" body) @@ -791,7 +801,7 @@ entry according to the value of WITHDN." nil) (t (error "Wrong LDAP boolean string: %s" str)))) - + (defun ldap-encode-country-string (str) "Encode STR to LDAP country string." ;; We should do something useful here... @@ -800,13 +810,17 @@ entry according to the value of WITHDN." (defun ldap-decode-string (str) "Decode LDAP STR." - (if (fboundp 'decode-coding-string) - (decode-coding-string str ldap-coding-system))) + (if (and (fboundp 'decode-coding-string) + ldap-coding-system) + (decode-coding-string str ldap-coding-system) + str)) (defun ldap-encode-string (str) "Encode LDAP STR." - (if (fboundp 'encode-coding-string) - (encode-coding-string str ldap-coding-system))) + (if (and (fboundp 'encode-coding-string) + ldap-coding-system) + (encode-coding-string str ldap-coding-system) + str)) (defun ldap-decode-address (str) "Decode LDAP address STR." @@ -821,7 +835,7 @@ entry according to the value of WITHDN." "$")) ;;; LDAP protocol functions -;; +;; (defun ldap-get-host-parameter (host parameter) "Get HOST's PARAMETER in `ldap-host-parameters-alist'." (plist-get (cdr (assoc host ldap-host-parameters-alist)) @@ -844,7 +858,7 @@ and the corresponding decoder is then retrieved from (if encoder (cons name (mapcar encoder values)) attr))) - + (defun ldap-decode-attribute (attr) "Decode the attribute/value pair ATTR according to LDAP rules. The attribute name is looked up in `ldap-attribute-syntaxes-alist' @@ -864,7 +878,7 @@ and the corresponding decoder is then retrieved from (cons name (mapcar decoder values)) attr)) attr)) - + (defun ldap-search (arg1 &rest args) "Perform an LDAP search.if ARG1 is LDAP object, invoke `ldap-search-basic'. Otherwise, invoke `ldap-search-entries'. ARGS are passed to each function." @@ -903,7 +917,7 @@ entry according to the value of WITHDN." (setq ldap (ldap-open host host-plist)) (if ldap-verbose (message "Searching with LDAP on %s..." host)) - (setq result (ldap-search ldap filter + (setq result (ldap-search ldap (ldap-encode-string filter) (plist-get host-plist 'base) (plist-get host-plist 'scope) attributes attrsonly withdn