scsh-ldap/scheme/types.scm

;;; 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 (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 (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 (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))