Lots of functions missing in various interfaces
This commit is contained in:
eknauel
parent
1221026d00
commit
02f0884023
|
|
@ -1,14 +1,44 @@
|
|||
(define-interface ldap-low-interface
|
||||
(export
|
||||
ldap-open
|
||||
ldap-init
|
||||
ldap-bind-sync
|
||||
ldap-unbind-sync
|
||||
ldap-error-string
|
||||
ldap-result-error))
|
||||
ldap-simple-bind
|
||||
ldap-sasl-bind
|
||||
ldap-unbind
|
||||
ldap-search
|
||||
|
||||
set-ldap-session-option!
|
||||
ldap-session-option
|
||||
|
||||
ldap-first-message
|
||||
ldap-next-message
|
||||
ldap-count-messages
|
||||
|
||||
ldap-get-message-type
|
||||
ldap-get-message-id
|
||||
|
||||
ldap-first-attribute
|
||||
ldap-next-attribute
|
||||
ldap-all-attributes
|
||||
|
||||
ldap-get-values
|
||||
ldap-compare
|
||||
ldap-message-dn
|
||||
ldap-explode-dn
|
||||
ldap-explode-rdn
|
||||
ldap-make-dn-userfriendly
|
||||
|
||||
ldap-count-entries
|
||||
ldap-first-entry
|
||||
ldap-next-entry
|
||||
|
||||
ldap-count-references
|
||||
ldap-first-reference
|
||||
ldap-next-reference))
|
||||
|
||||
(define-interface ldap-conditions-interface
|
||||
(export
|
||||
raise-ldap-condition
|
||||
|
||||
&ldap-error ldap-error? ldap-error-code ldap-error-session
|
||||
&ldap-security-error ldap-security-error?
|
||||
&ldap-service-error ldap-service-error?
|
||||
|
|
@ -16,8 +46,8 @@
|
|||
|
||||
&ldap-bindings-internal-error ldap-bindings-internal-error?
|
||||
&ldap-bindings-not-implemented ldap-bindings-not-implemented?
|
||||
&ldap-session-option-error ldap-session-option-error?
|
||||
&ldap-implicit-unbind ldap-implicit-unbind?
|
||||
&ldap-session-option-error ldap-session-option-error?
|
||||
&ldap-operations-error ldap-operations-error?
|
||||
&ldap-protocol-error ldap-protocol-error?
|
||||
&ldap-timelimit-exceeded ldap-timelimit-exceeded?
|
||||
|
|
@ -69,6 +99,11 @@
|
|||
(define-interface ldap-handle-types-interface
|
||||
(export
|
||||
ldap-session?
|
||||
ldap-session-bound?
|
||||
set-ldap-session-bound?!
|
||||
ldap-session-options
|
||||
ldap-session-messages
|
||||
|
||||
ldap-message?
|
||||
ldap-modification?
|
||||
|
||||
|
|
@ -77,14 +112,24 @@
|
|||
ldap-api-info-api-version
|
||||
ldap-api-info-protocol-version
|
||||
ldap-api-info-vendor-name
|
||||
ldap-api-info-vendor-version))
|
||||
ldap-api-info-vendor-version
|
||||
|
||||
make-session-options
|
||||
set-ldap-session-options!
|
||||
ldap-session-implicit-unbind-ok?
|
||||
ldap-session-auto-unbind?
|
||||
|
||||
ldap-session-messages-adjoin!))
|
||||
|
||||
(define-interface ldap-return-interface
|
||||
(export
|
||||
ldap-return-object?
|
||||
ldap-return-elements
|
||||
ldap-return-name
|
||||
(ldap-return :syntax)))
|
||||
(ldap-return :syntax)
|
||||
convert-ldap-return-code
|
||||
ldap-success?))
|
||||
|
||||
|
||||
(define-interface ldap-option-version-interface
|
||||
(export
|
||||
|
|
@ -98,6 +143,7 @@
|
|||
ldap-scope-arguments-object?
|
||||
ldap-scope-arguments-elements
|
||||
ldap-scope-arguments-name
|
||||
ldap-scope-arguments-id
|
||||
(ldap-scope-arguments :syntax)))
|
||||
|
||||
(define-interface ldap-session-option-values-interface
|
||||
|
|
@ -105,6 +151,7 @@
|
|||
ldap-session-option-value-object?
|
||||
ldap-session-option-value-elements
|
||||
ldap-session-option-value-name
|
||||
ldap-session-option-value-id
|
||||
(ldap-session-option-value :syntax)))
|
||||
|
||||
(define-interface ldap-message-types-interface
|
||||
|
|
@ -112,7 +159,8 @@
|
|||
ldap-message-types-object?
|
||||
ldap-message-types-elements
|
||||
ldap-message-types-name
|
||||
(ldap-message-types :syntax)))
|
||||
(ldap-message-types :syntax)
|
||||
convert-ldap-message-type))
|
||||
|
||||
(define-interface ldap-attributes-special-values-interfaces
|
||||
(export
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
; ,open define-record-types external-calls
|
||||
|
||||
(import-lambda-definition ldap-session-free
|
||||
(session)
|
||||
|
|
@ -7,7 +6,7 @@
|
|||
(define (ldap-session-finalizer session)
|
||||
(if (ldap-session-bound? session)
|
||||
(if (not (ldap-session-implicit-unbind-ok? session))
|
||||
(raise (condition (ldap-implicit-unbind (session session))))
|
||||
(raise (condition (&ldap-implicit-unbind (session session))))
|
||||
(if (ldap-session-auto-unbind? session)
|
||||
(ldap-unbind session)))))
|
||||
|
||||
|
|
@ -35,11 +34,11 @@
|
|||
|
||||
(define (ldap-simple-bind session user password)
|
||||
(let ((ret-obj
|
||||
(ldap-return
|
||||
(convert-ldap-return-code
|
||||
(ldap-simple-bind-internal session user password))))
|
||||
(if (ldap-success? ret-obj)
|
||||
(set-ldap-session-bound?! session #t)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
(raise-ldap-condition ret-obj session))))
|
||||
|
||||
;;; SASL_BIND_S
|
||||
|
||||
|
|
@ -50,7 +49,7 @@
|
|||
(define (ldap-sasl-bind session dn mechanism cred
|
||||
server-controls client-controls
|
||||
credentials)
|
||||
(raise (condition (ldap-bindings-not-implemented
|
||||
(raise (condition (&ldap-bindings-not-implemented
|
||||
(what '(ldap-sasl-bind ldap-controls))))))
|
||||
|
||||
;;; UNBIND_S
|
||||
|
|
@ -60,10 +59,11 @@
|
|||
"scsh_ldap_unbind_s")
|
||||
|
||||
(define (ldap-unbind session)
|
||||
(let ((ret-obj (ldap-return (ldap-unbind-internal session))))
|
||||
(let ((ret-obj
|
||||
(convert-ldap-return-code (ldap-unbind-internal session))))
|
||||
(if (ldap-success? ret-obj)
|
||||
(set-ldap-session-bound?! ldap #f)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
(set-ldap-session-bound?! session #f)
|
||||
(raise-ldap-condition ret-obj session))))
|
||||
|
||||
;;; SEARCH_S and SEARCH_ST
|
||||
|
||||
|
|
@ -91,7 +91,7 @@
|
|||
|
||||
(define (ldap-search session base scope filter attribute-list attributes-only? . args)
|
||||
(let-optionals args ((timeout-seconds #f) (timeout-microseconds #f))
|
||||
(let ((scope-id (ldap-scope-id scope))
|
||||
(let ((scope-id (ldap-scope-arguments-id scope))
|
||||
(attr-list (ldap-attribute-list-kludge attribute-list)))
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
|
|
@ -103,13 +103,14 @@
|
|||
session base scope filter attr-list attributes-only?
|
||||
timeout-seconds (or timeout-microseconds 0)))))
|
||||
(lambda (ret-code message)
|
||||
(let ((ret-obj (ldap-return ret-code)))
|
||||
(let ((ret-obj
|
||||
(convert-ldap-return-code ret-code)))
|
||||
(if (ldap-success? ret-obj)
|
||||
(begin
|
||||
(ldap-session-messages-adjoin! session message)
|
||||
(add-finalizer! message ldap-message-finalizer)
|
||||
message)
|
||||
(raise-ldap-error ret-obj session))))))))
|
||||
(raise-ldap-condition ret-obj session))))))))
|
||||
|
||||
;;; GET/SET session options
|
||||
|
||||
|
|
@ -122,7 +123,7 @@
|
|||
(lambda ()
|
||||
(apply values
|
||||
(ldap-get-set-option-internal
|
||||
session (ldap-session-options-id session-option) #t value)))
|
||||
session (ldap-session-option-value-id session-option) #t value)))
|
||||
(lambda (call-successful? result)
|
||||
(if call-successful?
|
||||
result
|
||||
|
|
@ -134,7 +135,7 @@
|
|||
(lambda ()
|
||||
(apply values
|
||||
(ldap-get-set-option-internal
|
||||
session (ldap-session-options-id session-option) #f #f)))
|
||||
session (ldap-session-option-value-id session-option) #f #f)))
|
||||
(lambda (call-successful? result)
|
||||
(if call-successful?
|
||||
result
|
||||
|
|
@ -148,9 +149,8 @@
|
|||
"scsh_ldap_error_string")
|
||||
|
||||
(define (ldap-get-error-return-object session)
|
||||
(ldap-return
|
||||
(ldap-session-option
|
||||
session (ldap-session-option error-number))))
|
||||
(ldap-session-option session
|
||||
(ldap-session-option-value error-number)))
|
||||
|
||||
;;; FIRST/NEXT_MESSAGE, COUNT_MESSAGES
|
||||
|
||||
|
|
@ -160,7 +160,7 @@
|
|||
|
||||
(define (ldap-first-message session message)
|
||||
(or (ldap-first-message-internal session message)
|
||||
(raise-ldap-error
|
||||
(raise-ldap-condition
|
||||
(ldap-get-error-return-object session) session)))
|
||||
|
||||
(import-lambda-definition ldap-next-message-internal
|
||||
|
|
@ -169,7 +169,7 @@
|
|||
|
||||
(define (ldap-next-message session message)
|
||||
(or (ldap-next-message-internal session message)
|
||||
(raise-ldap-error
|
||||
(raise-ldap-condition
|
||||
(ldap-get-error-return-object session) session)))
|
||||
|
||||
(import-lambda-definition ldap-count-messages-internal
|
||||
|
|
@ -179,7 +179,7 @@
|
|||
(define (ldap-count-messages session message)
|
||||
(let ((ret (ldap-count-messages-internal session message)))
|
||||
(or ret
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session))))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -190,9 +190,9 @@
|
|||
(define (ldap-get-message-type session message)
|
||||
(cond
|
||||
((ldap-get-message-type-internal message)
|
||||
=> (lambda (code) (ldap-message-type code)))
|
||||
=> (lambda (code) (convert-ldap-message-type code)))
|
||||
(else
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session))))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -201,8 +201,8 @@
|
|||
"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)))
|
||||
(or (ldap-message-id-internal message)
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -231,14 +231,14 @@
|
|||
(begin
|
||||
(add-finalizer! ber-element ber-element-finalizer)
|
||||
(values attribute-name ber-element))
|
||||
(raise-ldap-error (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)
|
||||
(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)))))
|
||||
(raise-ldap-condition ret-obj session)))))
|
||||
|
||||
(define (ldap-all-attributes session entry)
|
||||
(call-with-values
|
||||
|
|
@ -260,7 +260,7 @@
|
|||
|
||||
(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)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -270,12 +270,12 @@
|
|||
|
||||
(define (ldap-compare session dn attribute value)
|
||||
(let ((ret-obj
|
||||
(ldap-return
|
||||
(convert-ldap-return-code
|
||||
(ldap-compare-internal session dn attribute value))))
|
||||
(if (or (equal? (ldap-return compare-true) ret-obj)
|
||||
(equal? (ldap-return compare-false) ret-obj))
|
||||
(equal? (ldap-return compare-true) ret-obj)
|
||||
(raise-ldap-error ret-obj session))))
|
||||
(raise-ldap-condition ret-obj session))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -285,7 +285,7 @@
|
|||
|
||||
(define (ldap-message-dn session entry)
|
||||
(or (ldap-get-dn-internal session entry)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -295,7 +295,7 @@
|
|||
|
||||
(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)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -305,7 +305,7 @@
|
|||
|
||||
(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?))))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session dn no-types?))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -315,7 +315,7 @@
|
|||
|
||||
(define (ldap-make-dn-userfriendly session dn)
|
||||
(or (ldap-dn2ufn-internal dn)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -333,7 +333,7 @@
|
|||
|
||||
(define (ldap-count-entries session message)
|
||||
(or (ldap-count-entries-internal session message)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
(define (ldap-first-entry session message)
|
||||
(cond
|
||||
|
|
@ -345,7 +345,7 @@
|
|||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
(raise-ldap-condition ret-obj session))))))
|
||||
|
||||
(define (ldap-next-entry session message)
|
||||
(cond
|
||||
|
|
@ -357,7 +357,7 @@
|
|||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
(raise-ldap-condition ret-obj session))))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -375,7 +375,7 @@
|
|||
|
||||
(define (ldap-count-references session message)
|
||||
(or (ldap-count-references-internal session message)
|
||||
(raise-ldap-error (ldap-get-error-return-object session) session)))
|
||||
(raise-ldap-condition (ldap-get-error-return-object session) session)))
|
||||
|
||||
(define (ldap-first-reference session message)
|
||||
(cond
|
||||
|
|
@ -387,7 +387,7 @@
|
|||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
(raise-ldap-condition ret-obj session))))))
|
||||
|
||||
(define (ldap-next-reference session message)
|
||||
(cond
|
||||
|
|
@ -399,7 +399,7 @@
|
|||
(let ((ret-obj (ldap-get-error-return-object session)))
|
||||
(if (ldap-success? ret-obj)
|
||||
#f
|
||||
(raise-ldap-error ret-obj session))))))
|
||||
(raise-ldap-condition ret-obj session))))))
|
||||
|
||||
;;;
|
||||
|
||||
|
|
@ -407,6 +407,17 @@
|
|||
(session dn ldap-modification-vector)
|
||||
"scsh_ldap_modify")
|
||||
|
||||
(define (ldap-modify session dn ldap-modifications)
|
||||
(let ((vec (if (list? ldap-modifications)
|
||||
(list->vector ldap-modifications)
|
||||
(vector ldap-modifications))))
|
||||
(let ((ret-obj
|
||||
(convert-ldap-return-code (ldap-modify-internal session dn vec))))
|
||||
(or (ldap-success? ret-obj)
|
||||
(raise-ldap-condition ret-obj session)))))
|
||||
|
||||
;;;
|
||||
|
||||
(import-lambda-definition ldap-add-internal
|
||||
(session dn ldap-modification-vector)
|
||||
"scsh_ldap_add")
|
||||
|
|
@ -418,10 +429,4 @@
|
|||
(import-lambda-definition ldap-abandon-internal
|
||||
(session message-id)
|
||||
"scsh_ldap_abandon")
|
||||
|
||||
;;; import functions from C
|
||||
(define c-value->ldap-success
|
||||
(make-finite-type-import-function
|
||||
'ldap-success ldap-success-elements ldap-success-id))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -3,8 +3,12 @@
|
|||
define-record-types
|
||||
primitives
|
||||
external-calls
|
||||
let-opt
|
||||
srfi-34 srfi-35
|
||||
ffi-tools-rts)
|
||||
ffi-tools-rts
|
||||
|
||||
ldap-conditions
|
||||
ldap-types)
|
||||
(files ldap))
|
||||
|
||||
(define-structure ldap-types ldap-types-interface
|
||||
|
|
|
|||
Loading…
Reference in New Issue