Lots of changes to fix structure ldap-types and ldap-condtions
This commit is contained in:
eknauel
parent
b1f1aede59
commit
feae1fa4a9
|
|
@ -77,10 +77,10 @@
|
|||
(define-condition-type &ldap-insufficient-access &ldap-security-error
|
||||
ldap-insufficient-access?)
|
||||
|
||||
(define-condition-type &ldap-busy &ldap-connection-error
|
||||
(define-condition-type &ldap-busy &ldap-service-error
|
||||
ldap-busy?)
|
||||
|
||||
(define-condition-type &ldap-unavailable &ldap-connection-error
|
||||
(define-condition-type &ldap-unavailable &ldap-service-error
|
||||
ldap-unavailable?)
|
||||
|
||||
(define-condition-type &ldap-unwilling-to-perform &ldap-data-error
|
||||
|
|
@ -89,9 +89,21 @@
|
|||
(define-condition-type &ldap-loop-detect &ldap-error
|
||||
ldap-loop-detect?)
|
||||
|
||||
(define-condition-type &ldap-invalid-syntax &ldap-error
|
||||
ldap-invalid-syntax?)
|
||||
|
||||
(define-condition-type &ldap-invalid-dn-syntax &ldap-error
|
||||
ldap-invalid-dn-syntax?)
|
||||
|
||||
(define-condition-type &ldap-naming-violation &ldap-data-error
|
||||
ldap-naming-violation?)
|
||||
|
||||
(define-condition-type &ldap-constraint-violation &ldap-data-error
|
||||
ldap-constraint-violation?)
|
||||
|
||||
(define-condition-type &ldap-type-or-value-exists &ldap-data-error
|
||||
ldap-type-or-value-exists?)
|
||||
|
||||
(define-condition-type &ldap-objectclass-violation &ldap-data-error
|
||||
ldap-objectclass-violation?)
|
||||
|
||||
|
|
@ -104,6 +116,18 @@
|
|||
(define-condition-type &ldap-already-exists &ldap-data-error
|
||||
ldap-already-exists?)
|
||||
|
||||
(define-condition-type &ldap-no-such-object &ldap-data-error
|
||||
ldap-no-such-object?)
|
||||
|
||||
(define-condition-type &ldap-alias-problem &ldap-data-error
|
||||
ldap-alias-problem?)
|
||||
|
||||
(define-condition-type &ldap-alias-deref-problem &ldap-data-error
|
||||
ldap-alias-deref-problem?)
|
||||
|
||||
(define-condition-type &ldap-referral-limit-exceeded &ldap-data-error
|
||||
ldap-referral-limit-exceeded?)
|
||||
|
||||
(define-condition-type &ldap-no-objectclass-mods &ldap-data-error
|
||||
ldap-no-objectclass-mods?)
|
||||
|
||||
|
|
@ -154,59 +178,56 @@
|
|||
|
||||
(define raise-ldap-condition
|
||||
(let ((alist
|
||||
(map
|
||||
(lambda (p) (cons (ldap-return (car p)) (cadr p)))
|
||||
'((operations-error &ldap-operations-error)
|
||||
(protocol-error &ldap-protocol-error)
|
||||
(timelimit-exceeded &ldap-timelimit-exceeded)
|
||||
(sizelimit-exceeded &ldap-sizelimit-exceeded)
|
||||
(strong-auth-not-supported &ldap-strong-auth-not-supported)
|
||||
(strong-auth-required &ldap-strong-auth-required)
|
||||
(adminlimit-exceeded &ldap-adminlimit-exceeded)
|
||||
(unavailable-critical-extension &ldap-critical-extension-unavailable)
|
||||
(confidentiality-required &ldap-confidentiality-required)
|
||||
(sasl-bind-in-progress &ldap-sasl-bind-in-progress)
|
||||
(no-such-attribute &ldap-no-such-attribute)
|
||||
(undefined-type &ldap-undefined-type)
|
||||
(inappropriate-type &ldap-inappropriate-type)
|
||||
(constraint-violation &ldap-constaint-violation)
|
||||
(type-or-value-exists &ldap-type-or-value-exists)
|
||||
(invalid-syntax &ldap-invalid-syntax)
|
||||
(no-such-object &ldap-no-such-object)
|
||||
(alias-problem &ldap-alias-problem)
|
||||
(invalid-dn-syntax &ldap-invalid-dn-syntax)
|
||||
(is-leaf &ldap-is-leaf)
|
||||
(alias-deref-problem &ldap-alias-deref-problem)
|
||||
(inappropriate-auth &ldap-inappropriate-auth)
|
||||
(invalid-credentials &ldap-invalid-credentials)
|
||||
(insufficient-access &ldap-insufficient-access)
|
||||
(busy &ldap-busy)
|
||||
(unavailable &ldap-unavailable)
|
||||
(unwilling-to-perform &ldap-unwilling-to-perform)
|
||||
(loop-detect &ldap-loop-detect)
|
||||
(naming-violation &ldap-naming-violation)
|
||||
(object-class-violation &ldap-object-class-violation)
|
||||
(not-allowed-on-leaf &ldap-not-allowed-on-leaf)
|
||||
(not-allowed-on-rdn &ldap-not-allowed-on-rdn)
|
||||
(already-exists &ldap-already-exists)
|
||||
(no-object-class-mods &ldap-no-object-class-mods)
|
||||
(results-too-large &ldap-results-too-large)
|
||||
(affects-multiple-dsas &ldap-affects-multiple-dsas)
|
||||
(other &ldap-other)
|
||||
(server-down &ldap-server-down)
|
||||
(local-error &ldap-local-error)
|
||||
(encoding-error &ldap-encoding-error)
|
||||
(decoding-error &ldap-decoding-error)
|
||||
(timeout &ldap-timeout)
|
||||
(auth-unknown &ldap-auth-unknown)
|
||||
(filter-error &ldap-filter-error)
|
||||
(user-cancelled &ldap-user-cancelled)
|
||||
(param-error &ldap-param-error)
|
||||
(no-memory &ldap-no-memory)
|
||||
(connect-error &ldap-connect-error)
|
||||
(not-supported &ldap-not-supported)
|
||||
(control-not-found &ldap-control-not-found)
|
||||
(referral-limit-exceeded &ldap-referral-limit-execeeded)))))
|
||||
`(((ldap-return operations-error) ,&ldap-operations-error)
|
||||
((ldap-return protocol-error) ,&ldap-protocol-error)
|
||||
((ldap-return timelimit-exceeded) ,&ldap-timelimit-exceeded)
|
||||
((ldap-return sizelimit-exceeded) ,&ldap-sizelimit-exceeded)
|
||||
((ldap-return strong-auth-not-supported) ,&ldap-strong-auth-not-supported)
|
||||
((ldap-return strong-auth-required) ,&ldap-strong-auth-required)
|
||||
((ldap-return adminlimit-exceeded) ,&ldap-adminlimit-exceeded)
|
||||
((ldap-return unavailable-critical-extension) ,&ldap-critical-extension-unavailable)
|
||||
((ldap-return confidentiality-required) ,&ldap-confidentiality-required)
|
||||
((ldap-return sasl-bind-in-progress) ,&ldap-sasl-bind-in-progress)
|
||||
((ldap-return no-such-attribute) ,&ldap-no-such-attribute)
|
||||
((ldap-return undefined-type) ,&ldap-undefined-type)
|
||||
((ldap-return inappropriate-type) ,&ldap-inappropriate-type)
|
||||
((ldap-return constraint-violation) ,&ldap-constraint-violation)
|
||||
((ldap-return type-or-value-exists) ,&ldap-type-or-value-exists)
|
||||
((ldap-return invalid-syntax) ,&ldap-invalid-syntax)
|
||||
((ldap-return no-such-object) ,&ldap-no-such-object)
|
||||
((ldap-return alias-problem) ,&ldap-alias-problem)
|
||||
((ldap-return invalid-dn-syntax) ,&ldap-invalid-dn-syntax)
|
||||
((ldap-return is-leaf) ,&ldap-not-allowed-on-leaf)
|
||||
((ldap-return alias-deref-problem) ,&ldap-alias-deref-problem)
|
||||
((ldap-return inappropriate-auth) ,&ldap-auth-unknown)
|
||||
((ldap-return invalid-credentials) ,&ldap-invalid-credentials)
|
||||
((ldap-return insufficient-access) ,&ldap-insufficient-access)
|
||||
((ldap-return busy) ,&ldap-busy)
|
||||
((ldap-return unavailable) ,&ldap-unavailable)
|
||||
((ldap-return unwilling-to-perform) ,&ldap-unwilling-to-perform)
|
||||
((ldap-return loop-detect) ,&ldap-loop-detect)
|
||||
((ldap-return naming-violation) ,&ldap-naming-violation)
|
||||
((ldap-return object-class-violation) ,&ldap-objectclass-violation)
|
||||
((ldap-return not-allowed-on-leaf) ,&ldap-not-allowed-on-leaf)
|
||||
((ldap-return not-allowed-on-rdn) ,&ldap-not-allowed-on-rdn)
|
||||
((ldap-return already-exists) ,&ldap-already-exists)
|
||||
((ldap-return no-object-class-mods) ,&ldap-no-objectclass-mods)
|
||||
((ldap-return results-too-large) ,&ldap-results-too-large)
|
||||
((ldap-return affects-multiple-dsas) ,&ldap-affects-multiple-dsas)
|
||||
((ldap-return other) ,&ldap-error)
|
||||
((ldap-return server-down) ,&ldap-server-down)
|
||||
((ldap-return local-error) ,&ldap-local-error)
|
||||
((ldap-return encoding-error) ,&ldap-encoding-error)
|
||||
((ldap-return decoding-error) ,&ldap-decoding-error)
|
||||
((ldap-return timeout) ,&ldap-timeout-error)
|
||||
((ldap-return auth-unknown) ,&ldap-auth-unknown)
|
||||
((ldap-return filter-error) ,&ldap-filter-error)
|
||||
((ldap-return param-error) ,&ldap-param-error)
|
||||
((ldap-return no-memory) ,&ldap-no-memory)
|
||||
((ldap-return connect-error) ,&ldap-connect-error)
|
||||
((ldap-return not-supported) ,&ldap-not-supported)
|
||||
((ldap-return control-not-found) ,&ldap-control-not-found)
|
||||
((ldap-return referral-limit-exceeded) ,&ldap-referral-limit-exceeded))))
|
||||
(lambda (return-object session)
|
||||
(cond
|
||||
((assoc return-object alist)
|
||||
|
|
@ -217,9 +238,5 @@
|
|||
(session session)))))))
|
||||
(else
|
||||
(raise
|
||||
(condition (ldap-bindings-internal-error
|
||||
(condition (&ldap-bindings-internal-error
|
||||
(code return-object)))))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -7,27 +7,11 @@
|
|||
ldap-error-string
|
||||
ldap-result-error))
|
||||
|
||||
(define-interface ldap-types-interface
|
||||
(export
|
||||
ldap-session?
|
||||
ldap-message?
|
||||
ldap-modification?
|
||||
|
||||
ldap-api-info?
|
||||
ldap-api-info-info-version
|
||||
ldap-api-info-api-version
|
||||
ldap-api-info-protocol-version
|
||||
ldap-api-info-vendor-name
|
||||
ldap-api-info-vendor-version
|
||||
|
||||
ldap-return-object?
|
||||
ldap-return-elements))
|
||||
|
||||
(define-interface ldap-conditions-interface
|
||||
(export
|
||||
&ldap-error ldap-error? ldap-error-code ldap-error-session
|
||||
&ldap-security-error ldap-security-error?
|
||||
&ldap-connection-error ldap-connection-error?
|
||||
&ldap-service-error ldap-service-error?
|
||||
&ldap-data-error ldap-data-error?
|
||||
|
||||
&ldap-bindings-internal-error ldap-bindings-internal-error?
|
||||
|
|
@ -52,11 +36,19 @@
|
|||
&ldap-unavailable ldap-unavailable?
|
||||
&ldap-unwilling-to-perform ldap-unwilling-to-perform?
|
||||
&ldap-loop-detect ldap-loop-detect?
|
||||
&ldap-invalid-syntax ldap-invalid-syntax?
|
||||
&ldap-invalid-dn-syntax ldap-invalid-dn-syntax?
|
||||
&ldap-naming-violation ldap-naming-violation?
|
||||
&ldap-constraint-violation ldap-constraint-violation?
|
||||
&ldap-type-or-value-exists ldap-type-or-value-exists?
|
||||
&ldap-objectclass-violation ldap-objectclass-violation?
|
||||
&ldap-not-allowed-on-leaf ldap-not-allowed-on-leaf?
|
||||
&ldap-not-allowed-on-rdn ldap-not-allowed-on-rdn?
|
||||
&ldap-already-exists ldap-already-exists?
|
||||
&ldap-no-such-object ldap-no-such-object?
|
||||
&ldap-alias-problem ldap-alias-problem?
|
||||
&ldap-alias-deref-problem ldap-alias-deref-problem?
|
||||
&ldap-referral-limit-exceeded ldap-referral-limit-exceeded?
|
||||
&ldap-no-objectclass-mods ldap-no-objectclass-mods?
|
||||
&ldap-results-too-large ldap-results-too-large?
|
||||
&ldap-affects-multiple-dsas ldap-affects-multiple-dsas?
|
||||
|
|
@ -73,3 +65,67 @@
|
|||
&ldap-not-supported ldap-not-supported?
|
||||
&ldap-control-not-found ldap-control-not-found?
|
||||
&ldap-referral-limit-exceeded ldap-referral-limit-exceeded?))
|
||||
|
||||
(define-interface ldap-handle-types-interface
|
||||
(export
|
||||
ldap-session?
|
||||
ldap-message?
|
||||
ldap-modification?
|
||||
|
||||
ldap-api-info?
|
||||
ldap-api-info-info-version
|
||||
ldap-api-info-api-version
|
||||
ldap-api-info-protocol-version
|
||||
ldap-api-info-vendor-name
|
||||
ldap-api-info-vendor-version))
|
||||
|
||||
(define-interface ldap-return-interface
|
||||
(export
|
||||
ldap-return-object?
|
||||
ldap-return-elements
|
||||
ldap-return-name
|
||||
(ldap-return :syntax)))
|
||||
|
||||
(define-interface ldap-option-version-interface
|
||||
(export
|
||||
ldap-option-version-object?
|
||||
ldap-option-version-elements
|
||||
ldap-option-version-name
|
||||
(ldap-option-version :syntax)))
|
||||
|
||||
(define-interface ldap-scope-arguments-interface
|
||||
(export
|
||||
ldap-scope-arguments-object?
|
||||
ldap-scope-arguments-elements
|
||||
ldap-scope-arguments-name
|
||||
(ldap-scope-arguments :syntax)))
|
||||
|
||||
(define-interface ldap-session-option-values-interface
|
||||
(export
|
||||
ldap-session-option-value-object?
|
||||
ldap-session-option-value-elements
|
||||
ldap-session-option-value-name
|
||||
(ldap-session-option-value :syntax)))
|
||||
|
||||
(define-interface ldap-message-types-interface
|
||||
(export
|
||||
ldap-message-types-object?
|
||||
ldap-message-types-elements
|
||||
ldap-message-types-name
|
||||
(ldap-message-types :syntax)))
|
||||
|
||||
(define-interface ldap-attributes-special-values-interfaces
|
||||
(export
|
||||
ldap-attributes-no-attribute
|
||||
ldap-attributes-all-user-attributes))
|
||||
|
||||
(define-interface ldap-types-interface
|
||||
(compound-interface
|
||||
ldap-return-interface
|
||||
ldap-option-version-interface
|
||||
ldap-scope-arguments-interface
|
||||
ldap-session-option-values-interface
|
||||
ldap-message-types-interface
|
||||
ldap-attributes-special-values-interfaces
|
||||
;;
|
||||
ldap-handle-types-interface))
|
||||
|
|
|
|||
|
|
@ -78,7 +78,7 @@
|
|||
(map make-constant-from-c-name-integer
|
||||
'("LDAP_SCOPE_BASE" "LDAP_SCOPE_ONELEVEL" "LDAP_SCOPE_SUBTREE")))
|
||||
|
||||
(define ldap-session-options
|
||||
(define ldap-session-option-values
|
||||
(map make-constant-from-c-name-integer
|
||||
'("LDAP_OPT_API_INFO"
|
||||
"LDAP_OPT_DEREF"
|
||||
|
|
@ -120,7 +120,7 @@
|
|||
ldap-opt-protocol-version
|
||||
ldap-scope-arguments
|
||||
ldap-attribute-selectors
|
||||
ldap-session-options
|
||||
ldap-session-option-values
|
||||
ldap-message-types))
|
||||
|
||||
(define (write-source-file name string)
|
||||
|
|
@ -164,8 +164,8 @@
|
|||
ldap-scope-arguments)
|
||||
|
||||
(generate-finite-type-definition
|
||||
"ldap-session-options" (make-drop-common-prefix-name-converter "LDAP_OPT_")
|
||||
ldap-session-options)
|
||||
"ldap-session-option-value" (make-drop-common-prefix-name-converter "LDAP_OPT_")
|
||||
ldap-session-option-values)
|
||||
|
||||
(generate-finite-type-definition
|
||||
"ldap-message-types" (make-drop-common-prefix-name-converter "LDAP_RES_")
|
||||
|
|
|
|||
233
scheme/ldap.scm
233
scheme/ldap.scm
|
|
@ -27,7 +27,7 @@
|
|||
(set-ldap-session-options! session options)
|
||||
session)))
|
||||
|
||||
;;;
|
||||
;;; SIMPLE_BIND_S
|
||||
|
||||
(import-lambda-definition ldap-simple-bind-internal
|
||||
(session user cred)
|
||||
|
|
@ -41,7 +41,7 @@
|
|||
(set-ldap-session-bound?! session #t)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
|
||||
;;;
|
||||
;;; SASL_BIND_S
|
||||
|
||||
(import-lambda-definition ldap-sasl-bind-internal
|
||||
(session dn mechanism cred server-controls client-controls server-cred)
|
||||
|
|
@ -53,7 +53,7 @@
|
|||
(raise (condition (ldap-bindings-not-implemented
|
||||
(what '(ldap-sasl-bind ldap-controls))))))
|
||||
|
||||
;;;
|
||||
;;; UNBIND_S
|
||||
|
||||
(import-lambda-definition ldap-unbind-internal
|
||||
(session)
|
||||
|
|
@ -65,7 +65,7 @@
|
|||
(set-ldap-session-bound?! ldap #f)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
|
||||
;;;
|
||||
;;; SEARCH_S and SEARCH_ST
|
||||
|
||||
(import-lambda-definition ldap-search-internal
|
||||
(session base scope filter attribute-list attributes-only?)
|
||||
|
|
@ -111,7 +111,7 @@
|
|||
message)
|
||||
(raise-ldap-error ret-obj session))))))))
|
||||
|
||||
;;;
|
||||
;;; GET/SET session options
|
||||
|
||||
(import-lambda-definition ldap-get-set-option-internal
|
||||
(session option set? value)
|
||||
|
|
@ -120,8 +120,9 @@
|
|||
(define (set-ldap-session-option! session session-option value)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(apply values
|
||||
(ldap-get-set-option-internal
|
||||
session (ldap-session-options-id session-option) #t value))
|
||||
session (ldap-session-options-id session-option) #t value)))
|
||||
(lambda (call-successful? result)
|
||||
(if call-successful?
|
||||
result
|
||||
|
|
@ -131,8 +132,9 @@
|
|||
(define (ldap-session-option session session-option)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(apply values
|
||||
(ldap-get-set-option-internal
|
||||
session (ldap-session-options-id session-option) #f #f))
|
||||
session (ldap-session-options-id session-option) #f #f)))
|
||||
(lambda (call-successful? result)
|
||||
(if call-successful?
|
||||
result
|
||||
|
|
@ -150,7 +152,7 @@
|
|||
(ldap-session-option
|
||||
session (ldap-session-option error-number))))
|
||||
|
||||
;;;
|
||||
;;; FIRST/NEXT_MESSAGE, COUNT_MESSAGES
|
||||
|
||||
(import-lambda-definition ldap-first-message-internal
|
||||
(session message)
|
||||
|
|
@ -177,7 +179,88 @@
|
|||
(define (ldap-count-messages session message)
|
||||
(let ((ret (ldap-count-messages-internal session message)))
|
||||
(or ret
|
||||
(raise-ldap-error (ldap-get-error-code session) session))))
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-get-message-type-internal
|
||||
(message)
|
||||
"scsh_ldap_msgtype")
|
||||
|
||||
(define (ldap-get-message-type session message)
|
||||
(cond
|
||||
((ldap-get-message-type-internal message)
|
||||
=> (lambda (code) (ldap-message-type code)))
|
||||
(else
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-message-id-internal
|
||||
(message)
|
||||
"scsh_ldap_msgid")
|
||||
|
||||
(define (ldap-get-message-id session message)
|
||||
(or (ldap-get-message-id-internal message)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-first-attribute-internal
|
||||
(session entry)
|
||||
"scsh_ldap_first_attribute")
|
||||
|
||||
(import-lambda-definition ldap-next-attribute-internal
|
||||
(session entry ber-element)
|
||||
"scsh_ldap_next_attribute")
|
||||
|
||||
(import-lambda-definition ber-element-free
|
||||
(ber-element fbuf)
|
||||
"scsh_ldap_ber_free")
|
||||
|
||||
(define (ber-element-finalizer ber-element)
|
||||
(ber-element-free ber-element 1))
|
||||
|
||||
(define (ldap-first-attribute session entry)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(apply values
|
||||
(ldap-first-attribute-internal session entry)))
|
||||
(lambda (attribute-name ber-element)
|
||||
(if attribute-name
|
||||
(begin
|
||||
(add-finalizer! ber-element ber-element-finalizer)
|
||||
(values attribute-name ber-element))
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))))
|
||||
|
||||
(define (ldap-next-attribute session entry ber-element)
|
||||
(or (ldap-next-attribute-internal session entry ber-element)
|
||||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session)))))
|
||||
|
||||
(define (ldap-all-attributes session entry)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(ldap-first-attribute session entry))
|
||||
(lambda (first-attribute ber-element)
|
||||
(let loop ((next (ldap-next-attribute session entry ber-element))
|
||||
(attributes (list first-attribute)))
|
||||
(if next
|
||||
(loop (ldap-next-attribute session entry ber-element)
|
||||
(cons next attributes))
|
||||
attributes)))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-get-values-internal
|
||||
(session entry attribute)
|
||||
"scsh_ldap_get_values")
|
||||
|
||||
(define (ldap-get-values session entry attribute-name)
|
||||
(or (ldap-get-values-internal session entry attribute-name)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -194,9 +277,47 @@
|
|||
(equal? (ldap-return compare-true) ret-obj)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
|
||||
(import-lambda-definition ldap-result-error-internal
|
||||
(session error-code)
|
||||
"scsh_ldap_result")
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-get-dn-internal
|
||||
(session message)
|
||||
"scsh_ldap_get_dn")
|
||||
|
||||
(define (ldap-message-dn session entry)
|
||||
(or (ldap-get-dn-internal session entry)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-explode-dn-internal
|
||||
(dn no-types?)
|
||||
"scsh_ldap_explode_dn")
|
||||
|
||||
(define (ldap-explode-dn session dn no-types?)
|
||||
(or (ldap-explode-dn-internal dn no-types?)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-explode-rdn-internal
|
||||
(dn no-types?)
|
||||
"scsh_ldap_explode_rdn")
|
||||
|
||||
(define (ldap-explode-rdn session dn no-types?)
|
||||
(or (ldap-explode-rdn-internal dn no-types?)
|
||||
(raise-ldap-error (ldap-get-error-return-object session dn no-types?))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-dn2ufn-internal
|
||||
(dn)
|
||||
"scsh_ldap_dn2ufn")
|
||||
|
||||
(define (ldap-make-dn-userfriendly session dn)
|
||||
(or (ldap-dn2ufn-internal dn)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-count-entries-internal
|
||||
(session message)
|
||||
|
|
@ -210,6 +331,40 @@
|
|||
(session message)
|
||||
"scsh_ldap_next_entry")
|
||||
|
||||
(define (ldap-count-entries session message)
|
||||
(or (ldap-count-entries-internal session message)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
(define (ldap-first-entry session message)
|
||||
(cond
|
||||
((ldap-first-entry-internal session message)
|
||||
=> (lambda (new-message)
|
||||
(add-finalizer! new-message ldap-message-finalizer)
|
||||
new-message))
|
||||
(else
|
||||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
|
||||
(define (ldap-next-entry session message)
|
||||
(cond
|
||||
((ldap-next-entry-internal session message)
|
||||
=> (lambda (new-message)
|
||||
(add-finalizer! new-message ldap-message-finalizer)
|
||||
new-message))
|
||||
(else
|
||||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-count-references-internal
|
||||
(session message)
|
||||
"scsh_ldap_count_references")
|
||||
|
||||
(import-lambda-definition ldap-first-reference-internal
|
||||
(session message)
|
||||
"scsh_ldap_first_reference")
|
||||
|
|
@ -218,37 +373,35 @@
|
|||
(session message)
|
||||
"scsh_ldap_next_reference")
|
||||
|
||||
(import-lambda-definition ldap-count-references-internal
|
||||
(session message)
|
||||
"scsh_ldap_count_references")
|
||||
(define (ldap-count-references session message)
|
||||
(or (ldap-count-references-internal session message)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
|
||||
(import-lambda-definition ldap-message-type-internal
|
||||
(message)
|
||||
"scsh_ldap_msgtype")
|
||||
(define (ldap-first-reference session message)
|
||||
(cond
|
||||
((ldap-first-reference-internal session message)
|
||||
=> (lambda (new-message)
|
||||
(add-finalizer! new-message ldap-message-finalizer)
|
||||
new-message))
|
||||
(else
|
||||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
|
||||
(import-lambda-definition ldap-message-id-internal
|
||||
(message)
|
||||
"scsh_ldap_msgid")
|
||||
(define (ldap-next-reference session message)
|
||||
(cond
|
||||
((ldap-next-reference-internal session message)
|
||||
=> (lambda (new-message)
|
||||
(add-finalizer! new-message ldap-message-finalizer)
|
||||
new-message))
|
||||
(else
|
||||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
|
||||
(import-lambda-definition ldap-get-dn-internal
|
||||
(session message)
|
||||
"scsh_ldap_get_dn")
|
||||
|
||||
(import-lambda-definition ldap-explode-dn-internal
|
||||
(dn no-types?)
|
||||
"scsh_ldap_explode_dn")
|
||||
|
||||
(import-lambda-definition ldap-explode-rdn-internal
|
||||
(dn no-types?)
|
||||
"scsh_ldap_explode_rdn")
|
||||
|
||||
(import-lambda-definition ldap-dn2ufn-internal
|
||||
(dn)
|
||||
"scsh_ldap_dn2ufn")
|
||||
|
||||
(import-lambda-definition ldap-get-values-internal
|
||||
(session message attribute)
|
||||
"scsh_ldap_get_values")
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-modify-internal
|
||||
(session dn ldap-modification-vector)
|
||||
|
|
|
|||
|
|
@ -10,10 +10,14 @@
|
|||
(define-structure ldap-types ldap-types-interface
|
||||
(open scheme
|
||||
define-record-types
|
||||
external-calls)
|
||||
(files types const-gen))
|
||||
external-calls
|
||||
srfi-1
|
||||
finite-types
|
||||
ffi-tools-rts)
|
||||
(files const-gen types))
|
||||
|
||||
(define-structure ldap-conditions ldap-conditions-interface
|
||||
(open scheme
|
||||
srfi-34 srfi-35)
|
||||
srfi-34 srfi-35
|
||||
ldap-types)
|
||||
(files conditions))
|
||||
|
|
|
|||
|
|
@ -83,4 +83,4 @@
|
|||
|
||||
(define convert-ldap-message-type
|
||||
(make-finite-type-import-function
|
||||
'ldap-message-type ldap-message-type-elements ldap-message-type-id))
|
||||
'ldap-message-types ldap-message-types-elements ldap-message-types-id))
|
||||
|
|
|
|||
Loading…
Reference in New Issue