X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Fpldap.el;h=1d6d65f712db37180124d2413a909d7d8af03af4;hb=fb40159a1fc3d4fb1400f8fe3befb1056bc75b8c;hp=6d3d38339aa57dfe38c6221c416ba444479e3ddb;hpb=51f9787799e1f8a5ad1f9cde0fd99489dae071c3;p=elisp%2Fwanderlust.git

diff --git a/elmo/pldap.el b/elmo/pldap.el
index 6d3d383..1d6d65f 100644
--- a/elmo/pldap.el
+++ b/elmo/pldap.el
@@ -67,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
@@ -99,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"
@@ -111,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)
@@ -235,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."
@@ -510,12 +509,12 @@ DN is the distinguished name of the entry to delete."
 		       nil (current-buffer) t
 		       (append arglist
 			       (list dn))))
-      (if (integerp ret)
-	  (if (not (zerop ret))
-	      (error (car (split-string (buffer-string) "\n"))))
-	(if (and (setq ret (buffer-string)); Nemacs
-		 (string-match "ldap_delete:" ret))
-	    (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+	     (or (zerop ret)
+		 (error "%s" (car (split-string (buffer-string) "\n")))))
+	    ((and (setq ret (buffer-string)); Nemacs
+		  (string-match "ldap_delete:" ret))
+	     (error "%s" (car (split-string ret "\n"))))))))
 
 (defmacro ldap/ldif-insert-field (attr value)
   (` (if (not (ldap/ldif-safe-string-p (, value)))
@@ -568,12 +567,12 @@ or `replace'.  ATTR is the LDAP attribute type to modify."
 		       ldap-modify-program
 		       t t nil
 		       arglist))
-      (if (integerp ret)
-	  (if (not (zerop ret))
-	      (error (car (split-string (buffer-string) "\n"))))
-	(if (and (setq ret (buffer-string)); Nemacs
-		 (string-match "ldap_modify:" ret))
-	    (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+	     (or (zerop ret)
+		 (error "%s" (car (split-string (buffer-string) "\n")))))
+	    ((and (setq ret (buffer-string)); Nemacs
+		  (string-match "ldap_modify:" ret))
+	     (error "%s" (car (split-string ret "\n"))))))))
 
 (defun ldap-add (ldap dn entry)
   "Add an entry to an LDAP directory.
@@ -608,12 +607,12 @@ containing attribute/value string pairs."
 		       ldap-add-program
 		       t t nil
 		       arglist))
-      (if (integerp ret)
-	  (if (not (zerop ret))
-	      (error (car (split-string (buffer-string) "\n"))))
-	(if (and (setq ret (buffer-string)) ; Nemacs
-		 (string-match "ldap_add:" ret))
-	    (error (car (split-string ret "\n"))))))))
+      (cond ((integerp ret)
+	     (or (zerop ret)
+		 (error "%s" (car (split-string (buffer-string) "\n")))))
+	    ((and (setq ret (buffer-string)) ; Nemacs
+		  (string-match "ldap_add:" ret))
+	     (error "%s" (car (split-string ret "\n"))))))))
 
 (defun ldap-search-basic (ldap filter base scope
 			       &optional attrs attrsonly withdn verbose)
@@ -689,7 +688,13 @@ 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)
+	       ;; When openldap's `ldapsearch' uses referral,
+	       ;; it's exit status becomes `32'.
+	       (/= ret 32))
 	  (error "LDAP error: \"No such object\""))
       (goto-char (point-min))
       (setq start (point))
@@ -747,7 +752,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
@@ -761,10 +768,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)
@@ -801,13 +813,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."
@@ -904,7 +920,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