274 lines
9.6 KiB
Scheme
274 lines
9.6 KiB
Scheme
;; conditions with sub-conditions
|
|
|
|
(define-condition-type &ldap-error &condition
|
|
ldap-error?)
|
|
|
|
(define-condition-type &ldap-data-error &ldap-error
|
|
ldap-data-error?
|
|
(code ldap-error-code)
|
|
(session ldap-error-session))
|
|
|
|
(define-condition-type &ldap-security-error &ldap-error
|
|
ldap-security-error?
|
|
(code ldap-error-code)
|
|
(session ldap-error-session))
|
|
|
|
(define-condition-type &ldap-service-error &ldap-error
|
|
ldap-service-error?
|
|
(code ldap-error-code)
|
|
(session ldap-error-session))
|
|
|
|
(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-service-error
|
|
ldap-busy?)
|
|
|
|
(define-condition-type &ldap-unavailable &ldap-service-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-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?)
|
|
|
|
(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-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?)
|
|
|
|
(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?)
|
|
|
|
;; ldap filter conditions
|
|
|
|
(define-condition-type &ldap-filter-error &ldap-error
|
|
ldap-filter-error?)
|
|
|
|
(define-condition-type &ldap-filter-wrong-type &ldap-filter-error
|
|
ldap-filter-wrong-type?
|
|
(expected ldap-filter-wrong-type-expected)
|
|
(value ldap-filter-wrong-type-value))
|
|
|
|
(define-condition-type &ldap-filter-internal-error &ldap-filter-error
|
|
ldap-filter-internal-error?
|
|
(what ldap-filter-internal-error-what))
|
|
|
|
(define raise-ldap-condition
|
|
(let ((alist
|
|
`((,(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 ldap-session)
|
|
(cond
|
|
((assoc return-object alist)
|
|
=> (lambda (p)
|
|
(let ((the-condition (cadr p)))
|
|
(if (ldap-bindings-error? the-condition)
|
|
(raise (condition (the-condition)))
|
|
(raise (condition (the-condition
|
|
(code return-object)
|
|
(session ldap-session))))))))
|
|
(else
|
|
(raise
|
|
(condition (&ldap-bindings-internal-error
|
|
(code return-object)))))))))
|
|
|
|
; conditions raised in ldap-filter
|
|
|
|
(define-condition-type &ldap-filter-wrong-type &ldap-error
|
|
ldap-filter-wrong-type?
|
|
(expected ldap-filter-wrong-type-expected)
|
|
(value ldap-filter-wrong-type-value))
|
|
|
|
(define-condition-type &ldap-filter-internal-error &ldap-error
|
|
ldap-filter-internal-error?
|
|
(what ldap-filter-internal-error-what))
|
|
|