;; 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)))))))))