From 5b9e04b8d040668dce91f8df619202c41fc3075a Mon Sep 17 00:00:00 2001 From: eknauel Date: Thu, 8 Jan 2004 07:43:13 +0000 Subject: [PATCH] + condition hierachy for ldap --- scheme/conditions.scm | 225 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 225 insertions(+) create mode 100644 scheme/conditions.scm diff --git a/scheme/conditions.scm b/scheme/conditions.scm new file mode 100644 index 0000000..6b20a2e --- /dev/null +++ b/scheme/conditions.scm @@ -0,0 +1,225 @@ +;; 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))))))))) + + + + \ No newline at end of file