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