scsh-conservatory
/
scsh-ldap
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use weak list

This commit is contained in:
eknauel 2004-04-15 14:23:27 +00:00
parent ef2a08540a
commit a440b8785b
1 changed files with 26 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
scheme/ldap.scm
View File

@ -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-free session))
(ldap-session-weak-list-filter! 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)))