225 lines
7.3 KiB
Scheme
225 lines
7.3 KiB
Scheme
|
;; conditions with sub-conditions
|
||
|
|
|
||
|
|
(define-condition-type &ldap-error &condition
|
||
|
|
ldap-error?
|
||
|
|
(code ldap-error-code)
|
||
|
|
(session ldap-error-session))
|
||
|
|
|
||
|
|
(define-condition-type &ldap-data-error &ldap-error
|
||
|
|
ldap-data-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-security-error &ldap-error
|
||
|
|
ldap-security-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-service-error &ldap-error
|
||
|
|
ldap-service-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-bindings-error &ldap-error
|
||
|
|
ldap-bindings-error?)
|
||
|
|
|
||
|
|
;; conditions without sub-conditions
|
||
|
|
|
||
|
|
(define-condition-type &ldap-bindings-internal-error &ldap-bindings-error
|
||
|
|
ldap-bindings-internal-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-bindings-not-implemented &ldap-bindings-error
|
||
|
|
ldap-bindings-not-implemented?
|
||
|
|
(what ldap-bindings-not-implemented-what))
|
||
|
|
|
||
|
|
(define-condition-type &ldap-session-option-error &ldap-error
|
||
|
|
ldap-session-option-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-implicit-unbind &ldap-error
|
||
|
|
ldap-implicit-unbind?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-operations-error &ldap-error
|
||
|
|
ldap-operations-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-protocol-error &ldap-error
|
||
|
|
ldap-protocol-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-timelimit-exceeded &ldap-error
|
||
|
|
ldap-timelimit-exceeded?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-sizelimit-exceeded &ldap-error
|
||
|
|
ldap-sizelimit-exceeded?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-strong-auth-not-supported &ldap-security-error
|
||
|
|
ldap-strong-auth-not-supported?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-strong-auth-required &ldap-security-error
|
||
|
|
ldap-strong-auth-required?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-adminlimit-exceeded &ldap-error
|
||
|
|
ldap-adminlimit-exceeded?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-critical-extension-unavailable &ldap-error
|
||
|
|
ldap-critical-extension-unavailable?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-confidentiality-required &ldap-security-error
|
||
|
|
ldap-confidentiality-required?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-sasl-bind-in-progress &ldap-security-error
|
||
|
|
ldap-sasl-bind-in-progress?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-no-such-attribute &ldap-data-error
|
||
|
|
ldap-no-such-attribute?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-undefined-type &ldap-data-error
|
||
|
|
ldap-undefined-type?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-inappropriate-type &ldap-data-error
|
||
|
|
ldap-inappropriate-type?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-invalid-credentials &ldap-security-error
|
||
|
|
ldap-invalid-credentials?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-insufficient-access &ldap-security-error
|
||
|
|
ldap-insufficient-access?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-busy &ldap-connection-error
|
||
|
|
ldap-busy?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-unavailable &ldap-connection-error
|
||
|
|
ldap-unavailable?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-unwilling-to-perform &ldap-data-error
|
||
|
|
ldap-unwilling-to-perform?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-loop-detect &ldap-error
|
||
|
|
ldap-loop-detect?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-naming-violation &ldap-data-error
|
||
|
|
ldap-naming-violation?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-objectclass-violation &ldap-data-error
|
||
|
|
ldap-objectclass-violation?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-not-allowed-on-leaf &ldap-data-error
|
||
|
|
ldap-not-allowed-on-leaf?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-not-allowed-on-rdn &ldap-data-error
|
||
|
|
ldap-not-allowed-on-rdn?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-already-exists &ldap-data-error
|
||
|
|
ldap-already-exists?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-no-objectclass-mods &ldap-data-error
|
||
|
|
ldap-no-objectclass-mods?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-results-too-large &ldap-error
|
||
|
|
ldap-results-too-large?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-affects-multiple-dsas &ldap-data-error
|
||
|
|
ldap-affects-multiple-dsas?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-server-down &ldap-service-error
|
||
|
|
ldap-server-down?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-local-error &ldap-error
|
||
|
|
ldap-local-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-encoding-error &ldap-service-error
|
||
|
|
ldap-encoding-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-decoding-error &ldap-service-error
|
||
|
|
ldap-decoding-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-timeout-error &ldap-service-error
|
||
|
|
ldap-timeout-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-auth-unknown &ldap-security-error
|
||
|
|
ldap-auth-unknown?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-filter-error &ldap-data-error
|
||
|
|
ldap-filter-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-param-error &ldap-error
|
||
|
|
ldap-param-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-no-memory &ldap-error
|
||
|
|
ldap-no-memory?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-connect-error &ldap-service-error
|
||
|
|
ldap-connect-error?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-not-supported &ldap-error
|
||
|
|
ldap-not-supported?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-control-not-found &ldap-error
|
||
|
|
ldap-control-not-found?)
|
||
|
|
|
||
|
|
(define-condition-type &ldap-referral-limit-exceeded &ldap-error
|
||
|
|
ldap-referral-limit-exceeded?)
|
||
|
|
|
||
|
|
(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)))))
|
||
|
|
(lambda (return-object session)
|
||
|
|
(cond
|
||
|
|
((assoc return-object alist)
|
||
|
|
=> (lambda (p)
|
||
|
|
(let ((the-condition (cadr p)))
|
||
|
|
(raise (condition (the-condition
|
||
|
|
(code return-object)
|
||
|
|
(session session)))))))
|
||
|
|
(else
|
||
|
|
(raise
|
||
|
|
(condition (ldap-bindings-internal-error
|
||
|
|
(code return-object)))))))))
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|