143 lines
4.5 KiB
Scheme
143 lines
4.5 KiB
Scheme
;;; weak lists
|
|
|
|
(define (cons-weak obj list)
|
|
(cons (make-weak-pointer obj) list))
|
|
|
|
(define (filter-collected list)
|
|
(filter (lambda (weak-pointer)
|
|
(not (weak-pointer-ref weak-pointer)))
|
|
list))
|
|
|
|
;;; ldap-session
|
|
|
|
(define-record-type ldap-session :ldap-session
|
|
(make-ldap-session c-pointer bound? options weak-list)
|
|
ldap-session?
|
|
(c-pointer ldap-session-c-pointer)
|
|
(bound? ldap-session-bound? set-ldap-session-bound?!)
|
|
(options ldap-session-options set-ldap-session-options!)
|
|
(weak-list ldap-session-weak-list set-ldap-session-weak-list!))
|
|
|
|
(define-record-discloser :ldap-session
|
|
(lambda (r)
|
|
`(ldap-session (struct ,(ldap-session-c-pointer r))
|
|
(bound? ,(ldap-session-bound? r)))))
|
|
|
|
(define (ldap-session-weak-list-add! session thing)
|
|
(set-ldap-session-weak-list!
|
|
session (cons-weak thing (ldap-session-weak-list session))))
|
|
|
|
(define (ldap-session-weak-list-filter! session)
|
|
(set-ldap-session-weak-list!
|
|
session (filter-collected (ldap-session-weak-list session))))
|
|
|
|
(define-exported-binding "ldap-session" :ldap-session)
|
|
|
|
;;; ldap session options
|
|
|
|
(define-record-type session-options :session-options
|
|
(make-session-options implicit-unbind-ok? auto-unbind?)
|
|
session-options?
|
|
(implicit-unbind-ok? session-options-implicit-unbind-ok?)
|
|
(auto-unbind? session-options-auto-unbind?))
|
|
|
|
(define (ldap-session-implicit-unbind-ok? session)
|
|
(session-options-implicit-unbind-ok? (ldap-session-options session)))
|
|
|
|
(define (ldap-session-auto-unbind? session)
|
|
(session-options-auto-unbind? (ldap-session-options session)))
|
|
|
|
(define (ldap-session=? session-a session-b)
|
|
(equal? (ldap-session-c-pointer session-a)
|
|
(ldap-session-c-pointer session-b)))
|
|
|
|
;;; This is the basic type
|
|
(define-record-type ldap-message :ldap-message
|
|
(make-ldap-message c-pointer session result)
|
|
ldap-message?
|
|
(c-pointer ldap-message-c-pointer)
|
|
;; the following fields are needed to implement automatic
|
|
;; deallocation of ldap structures in C code
|
|
(session ldap-message-session set-ldap-message-session!)
|
|
(result ldap-message-result set-ldap-message-result!))
|
|
|
|
(define-exported-binding "ldap-message" :ldap-message)
|
|
|
|
(define-record-discloser :ldap-message
|
|
(lambda (r)
|
|
`(ldap-message (struct ,(ldap-message-c-pointer r)))))
|
|
|
|
(define (ldap-message=? session-a session-b)
|
|
(equal? (ldap-message-c-pointer session-a)
|
|
(ldap-message-c-pointer session-b)))
|
|
|
|
(define-record-type ldap-modification :ldap-modification
|
|
(really-make-ldap-modification operator type value-list)
|
|
ldap-modification?
|
|
(operator really-ldap-modification-operator)
|
|
(type ldap-modification-type)
|
|
(value-list ldap-modification-value-list))
|
|
|
|
(define-exported-binding "ldap-modification" :ldap-modification)
|
|
|
|
(define-record-discloser :ldap-modification
|
|
(lambda (r)
|
|
`(ldap-modification (operator ,(ldap-modification-operator r))
|
|
(type ,(ldap-modification-type r))
|
|
(values ,(ldap-modification-value-list r)))))
|
|
|
|
(define (make-ldap-modification operator type value-list)
|
|
(really-make-ldap-modification
|
|
(ldap-operation-id operator) type value-list))
|
|
|
|
(define (ldap-modification-operator ldap-modification)
|
|
(convert-ldap-operation
|
|
(really-make-ldap-modification ldap-modification)))
|
|
|
|
(define-record-type ldap-api-info :ldap-api-info
|
|
(make-ldap-api-info c-pointer)
|
|
ldap-api-info?
|
|
(c-pointer ldap-api-info-c-pointer))
|
|
|
|
(define-exported-binding "ldap-api-info" :ldap-api-info)
|
|
|
|
(import-lambda-definition ldap-api-info-info-version
|
|
(ldap-ai)
|
|
"scsh_ldapapiinfo_get_info_version")
|
|
|
|
(import-lambda-definition ldap-api-info-api-version
|
|
(ldap-ai)
|
|
"scsh_ldapapiinfo_get_api_version")
|
|
|
|
(import-lambda-definition ldap-api-info-protocol-version
|
|
(ldap-ai)
|
|
"scsh_ldapapiinfo_get_protocol_version")
|
|
|
|
(import-lambda-definition ldap-api-info-vendor-name
|
|
(ldap-ai)
|
|
"scsh_ldapapiinfo_get_vendor_name")
|
|
|
|
(import-lambda-definition ldap-api-info-vendor-version
|
|
(ldap-ai)
|
|
"scsh_ldapapiinfo_get_vendor_version")
|
|
|
|
(define-record-type ber-element :ber-element
|
|
(make-ber-element c-pointer)
|
|
ber-element?
|
|
(c-pointer ber-element-c-pointer))
|
|
|
|
(define-exported-binding "ber-element" :ber-element)
|
|
|
|
(define (ldap-success? obj)
|
|
(equal? (ldap-return success) obj))
|
|
|
|
(define convert-ldap-return-code
|
|
(make-finite-type-import-function 'ldap-return ldap-return-elements ldap-return-id))
|
|
|
|
(define convert-ldap-message-type
|
|
(make-finite-type-import-function
|
|
'ldap-message-types ldap-message-types-elements ldap-message-types-id))
|
|
|
|
(define convert-ldap-operation
|
|
(make-finite-type-import-function
|
|
'ldap-operation ldap-operation-elements ldap-operation-id)) |