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

* scheme/ldap.scm (ldap-search): unpack finite type before calling 

C code
(ldap-search): make return value of type ldap-entry
(ldap-get-error-return-object): convert code to finite type
(ldap-first-attribute): unwrap ldap-entry
(ldap-next-attribute session): unwrap ldap-entry

* scheme/ldap.scm (ldap-init): Set initial value for
ldap-session-messages
This commit is contained in:
eknauel 2004-02-12 12:44:46 +00:00
parent 2c206b2023
commit e27edaaed3
1 changed files with 9 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
scheme/ldap.scm
View File

@ -28,6 +28,7 @@
(add-finalizer! session ldap-session-finalizer)
(set-ldap-session-bound?! session #f)
(set-ldap-session-options! session options)
(set-ldap-session-messages! session '())
session))))
;;; SIMPLE_BIND_S
@ -105,9 +106,9 @@
(apply values
(if (not timeout-seconds)
(ldap-search-internal
session base scope filter attr-list attributes-only?)
session base scope-id filter attr-list attributes-only?)
(ldap-search-with-timeout-internal
session base scope filter attr-list attributes-only?
session base scope-id filter attr-list attributes-only?
timeout-seconds (or timeout-microseconds 0)))))
(lambda (ret-code message)
(let ((ret-obj
@ -116,7 +117,7 @@
(begin
(ldap-session-messages-adjoin! session message)
(add-finalizer! message ldap-message-finalizer)
message)
(make-ldap-entry message))
(raise-ldap-condition ret-obj session))))))))
;;; GET/SET session options
@ -156,8 +157,9 @@
"scsh_ldap_error_string")
(define (ldap-get-error-return-object session)
(ldap-session-option session
(ldap-session-option-value error-number)))
(convert-ldap-return-code
(ldap-session-option
session (ldap-session-option-value error-number))))
;;; FIRST/NEXT_MESSAGE, COUNT_MESSAGES
@ -232,7 +234,7 @@
(call-with-values
(lambda ()
(apply values
(ldap-first-attribute-internal session entry)))
(ldap-first-attribute-internal session (ldap-entry-message entry))))
(lambda (attribute-name ber-element)
(if attribute-name
(begin
@ -241,7 +243,7 @@
(raise-ldap-condition (ldap-get-error-return-object session) session)))))
(define (ldap-next-attribute session entry ber-element)
(or (ldap-next-attribute-internal session entry ber-element)
(or (ldap-next-attribute-internal session (ldap-entry-message entry) ber-element)
(let ((ret-obj (ldap-get-error-return-object session)))
(if (ldap-success? ret-obj)
#f