use weak list

scheme/ldap.scm

@@ -18,6 +18,8 @@
 (define *object-table*
   (make-value-weak-table))
 
+;;; ldap session as a fluid
+
 (define $current-ldap-session (make-fluid #f))
 
 (define (current-ldap-session)
@@ -26,20 +28,32 @@
 (define (with-ldap-session session thunk)
   (let-fluid $current-ldap-session session thunk))
 
+;;; free ldap session handles
+
 (import-lambda-definition ldap-session-free
   (session) 
   "scsh_ldap_memfree")
 
+(define (ldap-session-finalizer-free session)
+  (ddisplay 'ldap-session-finalizer-free session)
+  (remove-from-weak-table! *object-table* 
+			   (ldap-session-c-pointer session))
+  (ldap-session-free session))
+
 (define (ldap-session-finalizer session)
-  (ddisplay "FREE ldap-session " session)
+  (ddisplay 'ldap-session-finalizer session)
   (if (ldap-session-bound? session)
       (if (not (ldap-session-implicit-unbind-ok? session))
 	  (raise (condition 
 		  (&ldap-implicit-unbind (code #f) (session session))))
 	  (if (ldap-session-auto-unbind? session)
 	      (ldap-unbind session))))
-  (remove-from-weak-table! *object-table* (ldap-session-c-pointer session))
+  (ldap-session-weak-list-filter! session)
-  (ldap-session-free session))
+  (if (null? (ldap-session-weak-list session))
+      (add-finalizer! session ldap-session-finalizer-free)
+      (add-finalizer! session ldap-session-finalizer)))
+
+;;; ldap init
 
 (import-lambda-definition ldap-init-internal 
   (host port) 
@@ -62,6 +76,7 @@
 	(add-finalizer! session ldap-session-finalizer)
 	(set-ldap-session-bound?! session #f)
 	(set-ldap-session-options! session options)
+	(set-ldap-session-weak-list! session '())
 	session))))
 
 ;;; SIMPLE_BIND_S
@@ -169,6 +184,7 @@
 		     (begin
 		       (ddisplay "ldap-search new object " message)
 		       (add-to-weak-table! *object-table* pointer message)
+		       (ldap-session-weak-list-add! session message)
 		       (set-ldap-message-session! message session)
 		       (set-ldap-message-result! message #f)
 		       (add-finalizer! message ldap-message-freeing-finalizer)
@@ -234,6 +250,7 @@
 	     (or (lookup-in-weak-table *object-table* pointer)
 		 (begin
 		   (add-to-weak-table! *object-table* pointer new-message)
+		   (ldap-session-weak-list-add! session new-message)
 		   (set-ldap-message-session! new-message session)
 		   (add-finalizer! new-message ldap-message-freeing-finalizer)
 		   new-message)))))
@@ -254,6 +271,7 @@
 	     (or (lookup-in-weak-table *object-table* pointer)
 		 (begin
 		   (add-to-weak-table! *object-table* pointer new-message)
+		   (ldap-session-weak-list-add! session new-message)
 		   (set-ldap-message-session! new-message session)
 		   (add-finalizer! new-message ldap-message-freeing-finalizer)
 		   new-message)))))
@@ -334,6 +352,7 @@
 		  (values attribute-name be)))
 	    (else
 	     (ddisplay "NEW ber-element (ldap-first-attribute) " ber-element)
+	     (ldap-session-weak-list-add! session ber-element)
 	     (add-finalizer! ber-element ber-element-finalizer)
 	     (values attribute-name ber-element)))
 	   (raise-ldap-condition 
@@ -481,6 +500,7 @@
 	       (ddisplay "NEW object (ldap-first-entry) result "
 			 result " new-message " new-message)
 	       (add-to-weak-table! *object-table* pointer new-message)
+	       (ldap-session-weak-list-add! session new-message)
 	       (set-ldap-message-session! new-message session)
 	       (set-ldap-message-result! new-message result)
 	       (add-finalizer! new-message ldap-message-unregister-object)
@@ -504,6 +524,7 @@
 		   ;; don't add a finalizer in this case, because
 		   ;; libldap will free the memory itself.
 		   (add-to-weak-table! *object-table* pointer new-message)
+		   (ldap-session-weak-list-add! session new-message)
 		   (set-ldap-message-session! new-message session)
 		   (set-ldap-message-result! new-message (ldap-message-result entry))
 		   (add-finalizer! new-message ldap-message-unregister-object)
@@ -540,6 +561,7 @@
      ((ldap-first-reference-internal session message)
       => (lambda (new-message)
 	   (add-finalizer! new-message ldap-message-freeing-finalizer)
+	   (ldap-session-weak-list-add! session new-message)
 	   new-message))
      (else
       (let ((ret-obj (ldap-get-error-return-object session)))
@@ -553,6 +575,7 @@
      ((ldap-next-reference-internal session message)
       => (lambda (new-message)
 	   (add-finalizer! new-message ldap-message-freeing-finalizer)
+	   (ldap-session-weak-list-add! session new-message)
 	   new-message))
      (else
       (let ((ret-obj (ldap-get-error-return-object session)))