* pldap.el (ldap-default-attribute-encoder): New user option.

(ldap/field-body): Decode base64 string.
(ldap/collect-field): Ditto.
(ldap-encode-attribute): New function.
(ldap-add-entries): Use it.
(ldap-modify-entries): Ditto.

* elmo-util.el (elmo-folder-identical-system-p): Eliminated name space checking.

diff --git a/elmo/ChangeLog b/elmo/ChangeLog
index 9117753..65e3062 100644 (file)
--- a/elmo/ChangeLog
+++ b/elmo/ChangeLog
@@ -1,5 +1,15 @@
 2000-06-15  Yuuichi Teranishi  <teranisi@gohome.org>
 
+       * pldap.el (ldap-default-attribute-encoder): New user option.
+       (ldap/field-body): Decode base64 string.
+       (ldap/collect-field): Ditto.
+       (ldap-encode-attribute): New function.
+       (ldap-add-entries): Use it.
+       (ldap-modify-entries): Ditto.
+
+       * elmo-util.el (elmo-folder-identical-system-p):
+       Eliminated name space checking.
+
        * pldap.el: New module.
        toplevel: Changed condition to detect built-in ldap feature.
        (ldap-delete): Enclosed call-process with `with-temp-buffer'.

diff --git a/elmo/elmo-util.el b/elmo/elmo-util.el
index 28e5afe..9e8b456 100644 (file)
--- a/elmo/elmo-util.el
+++ b/elmo/elmo-util.el
@@ -4,7 +4,7 @@
 
 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
 ;; Keywords: mail, net news
-;; Time-stamp: <2000-03-29 09:42:41 teranisi>
+;; Time-stamp: <00/06/15 15:30:58 teranisi>
 
 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
 
@@ -1187,12 +1187,12 @@ Otherwise treat \\ in NEWTEXT string as special:
   (cond ((eq (elmo-folder-get-type folder1) 'imap4)
         (let ((spec1 (elmo-folder-get-spec folder1))
               (spec2 (elmo-folder-get-spec folder2)))
-          (and (elmo-imap4-identical-name-space-p
-                (nth 1 spec1) (nth 1 spec2))
-               (string= (elmo-imap4-spec-hostname spec1)
-                        (elmo-imap4-spec-hostname spec2))    ; hostname
-               (string= (elmo-imap4-spec-username spec1)
-                        (elmo-imap4-spec-username spec2))))) ; username
+          (and ;(elmo-imap4-identical-name-space-p ;; No use.
+               ; (nth 1 spec1) (nth 1 spec2))
+           (string= (elmo-imap4-spec-hostname spec1)
+                    (elmo-imap4-spec-hostname spec2))    ; hostname
+           (string= (elmo-imap4-spec-username spec1)
+                    (elmo-imap4-spec-username spec2))))) ; username
        (t
         (elmo-folder-direct-copy-p folder1 folder2))))
 

diff --git a/elmo/pldap.el b/elmo/pldap.el
index 803912f..ad3bb98 100644 (file)
--- a/elmo/pldap.el
+++ b/elmo/pldap.el
@@ -193,6 +193,11 @@ Valid properties include:
   :type 'boolean
   :group 'ldap)
 
+(defcustom ldap-default-attribute-encoder nil
+  "*Encoder function to use for attributes whose syntax is unknown."
+  :type 'symbol
+  :group 'ldap)
+
 (defcustom ldap-default-attribute-decoder nil
   "*Decoder function to use for attributes whose syntax is unknown."
   :type 'symbol
@@ -686,12 +691,14 @@ entry according to the value of WITHDN."
   (save-excursion
     (goto-char (point-min))
     (let ((case-fold-search t)
-         (field-body nil))
+         (field-body nil)
+         body)
       (while (re-search-forward (concat "^" name ":[ \t]*") nil t)
-       (setq field-body
-             (nconc field-body
-                    (list (buffer-substring-no-properties
-                           (match-end 0) (std11-field-end))))))
+       ;; Base64
+       (if (string-match "^:[ \t]*" (setq body (buffer-substring-no-properties
+                                           (match-end 0) (std11-field-end))))
+           (setq body (base64-decode-string (substring body (match-end 0)))))
+       (setq field-body (nconc field-body (list body))))
       field-body)))
 
 (defun ldap/collect-field (without)
@@ -704,6 +711,8 @@ entry according to the value of WITHDN."
                            (match-beginning 1)(1- (match-end 1)))))
       (setq body (buffer-substring-no-properties
                  (match-end 0) (std11-field-end)))
+      (if (string-match "^:[ \t]*" body)
+         (setq body (base64-decode-string (substring body (match-end 0)))))
       (unless (string= name without)
        (if (setq entry (assoc name dest))
            (nconc entry (list body))
@@ -741,8 +750,8 @@ entry according to the value of WITHDN."
 
 (defun ldap-encode-string (str)
   "Encode LDAP STR."
-   (if (fboundp 'encode-coding-string)
-       (encode-coding-string str ldap-coding-system)))
+  (if (fboundp 'encode-coding-string)
+      (encode-coding-string str ldap-coding-system)))
 
 (defun ldap-decode-address (str)
   "Decode LDAP address STR."
@@ -762,6 +771,24 @@ entry according to the value of WITHDN."
   "Get HOST's PARAMETER in `ldap-host-parameters-alist'."
   (plist-get (cdr (assoc host ldap-host-parameters-alist))
             parameter))
+
+(defun ldap-encode-attribute (attr)
+  "Encode the attribute/value pair ATTR according to LDAP rules.
+The attribute name is looked up in `ldap-attribute-syntaxes-alist'
+and the corresponding decoder is then retrieved from
+`ldap-attribute-syntax-encoders' and applied on the value(s)."
+  (let* ((name (car attr))
+        (values (cdr attr))
+        (syntax-id (cdr (assq (intern (downcase name))
+                              ldap-attribute-syntaxes-alist)))
+        encoder)
+    (if syntax-id
+       (setq encoder (aref ldap-attribute-syntax-encoders
+                           (1- syntax-id)))
+      (setq encoder ldap-default-attribute-encoder))
+    (if encoder
+       (cons name (mapcar encoder values))
+      attr)))
        
 (defun ldap-decode-attribute (attr)
   "Decode the attribute/value pair ATTR according to LDAP rules.
@@ -858,22 +885,31 @@ PASSWD is the corresponding password"
     (setq ldap (ldap-open host host-plist))
     (if ldap-verbose
        (message "Adding LDAP entries..."))
-    (mapcar (function
-            (lambda (thisentry)
-              (ldap-add ldap (car thisentry) (cdr thisentry))
-              (if ldap-verbose
-                  (message "%d added" i))
-              (setq i (1+ i))))
+    (mapcar (lambda (thisentry)
+             (setcdr thisentry
+                     (mapcar
+                      (lambda (add-spec)
+                        (setq add-spec (ldap-encode-attribute
+                                        (list (car add-spec)
+                                              (cdr add-spec))))
+                        (cons (nth 0 add-spec)
+                              (nth 1 add-spec)))
+                      (cdr thisentry)))
+             (setq thisentry (ldap-encode-attribute thisentry))
+             (ldap-add ldap (car thisentry) (cdr thisentry))
+             (if ldap-verbose
+                 (message "%d added" i))
+             (setq i (1+ i)))
            entries)
     (ldap-close ldap)))
 
 (defun ldap-modify-entries (entry-mods &optional host binddn passwd)
   "Modify entries of an LDAP directory.
 ENTRY-MODS is a list of entry modifications of the form
-  (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of
+  \(DN MOD-SPEC1 MOD-SPEC2 ...\) where DN is the distinguished name of
 the entry to modify, the following are modification specifications.
 A modification specification is itself a list of the form
-(MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory,
+\(MOD-OP ATTR VALUE1 VALUE2 ...\) MOD-OP and ATTR are mandatory,
 VALUEs are optional depending on MOD-OP.
 MOD-OP is the type of modification, one of the symbols `add', `delete'
 or `replace'.  ATTR is the LDAP attribute type to modify.
@@ -897,12 +933,20 @@ PASSWD is the corresponding password"
     (setq ldap (ldap-open host host-plist))
     (if ldap-verbose
        (message "Modifying LDAP entries..."))
-    (mapcar (function
-            (lambda (thisentry)
-              (ldap-modify ldap (car thisentry) (cdr thisentry))
-              (if ldap-verbose
-                  (message "%d modified" i))
-              (setq i (1+ i))))
+    (mapcar (lambda (thisentry)
+             (setcdr thisentry
+                     (mapcar
+                      (lambda (mod-spec)
+                        (if (or (eq (car mod-spec) 'add)
+                                (eq (car mod-spec) 'replace))
+                            (append (list (nth 0 mod-spec))
+                                    (ldap-encode-attribute
+                                     (cdr mod-spec)))))
+                      (cdr thisentry)))
+             (ldap-modify ldap (car thisentry) (cdr thisentry))
+             (if ldap-verbose
+                 (message "%d modified" i))
+             (setq i (1+ i)))
            entry-mods)
     (ldap-close ldap)))