projects
/
elisp
/
wanderlust.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
* elmo.el (elmo-folder-list-unreads): Don't use msgdb API.
[elisp/wanderlust.git]
/
elmo
/
pldap.el
diff --git
a/elmo/pldap.el
b/elmo/pldap.el
index
6d3d383
..
1d6d65f
100644
(file)
--- 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.")
(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
"A Regexp for field name.")
(defconst ldap-ldif-field-head-regexp
@@
-99,11
+99,13
@@
(defvar ldap-modify-program "ldapmodify"
"LDAP modify program.")
(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.
"*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"
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
: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)
: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)
: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."
"*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))))
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)))
(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))
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.
(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))
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)
(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)
(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))
(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)
(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
;; 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]*"))
"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)
(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)
(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."
(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."
(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."
(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 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
(plist-get host-plist 'base)
(plist-get host-plist 'scope)
attributes attrsonly withdn