Fixed docstring.
[elisp/wanderlust.git] / elmo / pldap.el
index 2687c23..5d90138 100644 (file)
@@ -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 <teranisi@gohome.org>
 ;;; 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
 (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))
@@ -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