From b9e53e5cc6928788bb74c50451d67a0de7c3558d Mon Sep 17 00:00:00 2001
From: eknauel <eknauel>
Date: Mon, 16 Feb 2004 08:29:00 +0000
Subject: [PATCH] + changed condition hierachy: removed session and code fields
 from   root-condition because that information might not be available in  
 all cases.

+ added session and code fields to &ldap-data-error,
  &ldap-security-error and &ldap-service-error

+ fixed raise-ldap-condition to distinguish conditions with/without
  fields session and code
---
 scheme/conditions.scm | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/scheme/conditions.scm b/scheme/conditions.scm
index 77cef20..065383f 100644
--- a/scheme/conditions.scm
+++ b/scheme/conditions.scm
@@ -1,18 +1,22 @@
 ;; conditions with sub-conditions
 
 (define-condition-type &ldap-error &condition
-  ldap-error?
+  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-data-error &ldap-error
-  ldap-data-error?)
-
 (define-condition-type &ldap-security-error &ldap-error
-  ldap-security-error?)
+  ldap-security-error?
+  (code ldap-error-code)
+  (session ldap-error-session))
 
 (define-condition-type &ldap-service-error &ldap-error
-  ldap-service-error?)
+  ldap-service-error?
+  (code ldap-error-code)
+  (session ldap-error-session))
 
 (define-condition-type &ldap-bindings-error &ldap-error
   ldap-bindings-error?)
@@ -228,14 +232,16 @@
 	   (,(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 session)
+    (lambda (return-object ldap-session)
       (cond 
        ((assoc return-object alist)
 	=> (lambda (p)
 	     (let ((the-condition (cadr p)))
-	       (raise (condition (the-condition 
-				  (code return-object)
-				  (session session)))))))
+	       (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