Lots of changes to fix structure ldap-types and ldap-condtions

scheme/conditions.scm

@@ -77,10 +77,10 @@
 (define-condition-type &ldap-insufficient-access &ldap-security-error
   ldap-insufficient-access?)
 
-(define-condition-type &ldap-busy &ldap-connection-error
+(define-condition-type &ldap-busy &ldap-service-error
   ldap-busy?)
 
-(define-condition-type &ldap-unavailable &ldap-connection-error
+(define-condition-type &ldap-unavailable &ldap-service-error
   ldap-unavailable?)
 
 (define-condition-type &ldap-unwilling-to-perform &ldap-data-error
@@ -89,9 +89,21 @@
 (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?)
 
@@ -104,6 +116,18 @@
 (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?)
 
@@ -154,59 +178,56 @@
 
 (define raise-ldap-condition
   (let ((alist
-	 (map
+	 `(((ldap-return operations-error)		,&ldap-operations-error)
-	  (lambda (p) (cons (ldap-return (car p)) (cadr p)))
+	  ((ldap-return protocol-error)			,&ldap-protocol-error)
-	  '((operations-error			&ldap-operations-error)
+	  ((ldap-return timelimit-exceeded)		,&ldap-timelimit-exceeded)
-	    (protocol-error			&ldap-protocol-error)
+	  ((ldap-return sizelimit-exceeded)		,&ldap-sizelimit-exceeded)
-	    (timelimit-exceeded			&ldap-timelimit-exceeded)
+	  ((ldap-return strong-auth-not-supported)	,&ldap-strong-auth-not-supported)
-	    (sizelimit-exceeded			&ldap-sizelimit-exceeded)
+	  ((ldap-return strong-auth-required)		,&ldap-strong-auth-required)
-	    (strong-auth-not-supported		&ldap-strong-auth-not-supported)
+	  ((ldap-return adminlimit-exceeded)		,&ldap-adminlimit-exceeded)
-	    (strong-auth-required		&ldap-strong-auth-required)
+	  ((ldap-return unavailable-critical-extension) ,&ldap-critical-extension-unavailable)
-	    (adminlimit-exceeded		&ldap-adminlimit-exceeded)
+	  ((ldap-return confidentiality-required)	,&ldap-confidentiality-required)
-	    (unavailable-critical-extension	&ldap-critical-extension-unavailable)
+	  ((ldap-return sasl-bind-in-progress)		,&ldap-sasl-bind-in-progress)
-	    (confidentiality-required		&ldap-confidentiality-required)
+	  ((ldap-return no-such-attribute)		,&ldap-no-such-attribute)
-	    (sasl-bind-in-progress		&ldap-sasl-bind-in-progress)
+	  ((ldap-return undefined-type)			,&ldap-undefined-type)
-	    (no-such-attribute			&ldap-no-such-attribute)
+	  ((ldap-return inappropriate-type)		,&ldap-inappropriate-type)
-	    (undefined-type			&ldap-undefined-type)
+	  ((ldap-return constraint-violation)		,&ldap-constraint-violation)
-	    (inappropriate-type			&ldap-inappropriate-type)
+	  ((ldap-return type-or-value-exists)		,&ldap-type-or-value-exists)
-	    (constraint-violation		&ldap-constaint-violation)
+	  ((ldap-return invalid-syntax)			,&ldap-invalid-syntax)
-	    (type-or-value-exists		&ldap-type-or-value-exists)
+	  ((ldap-return no-such-object)			,&ldap-no-such-object)
-	    (invalid-syntax			&ldap-invalid-syntax)
+	  ((ldap-return alias-problem)			,&ldap-alias-problem)
-	    (no-such-object			&ldap-no-such-object)
+	  ((ldap-return invalid-dn-syntax)		,&ldap-invalid-dn-syntax)
-	    (alias-problem			&ldap-alias-problem)
+	  ((ldap-return is-leaf)			,&ldap-not-allowed-on-leaf)
-	    (invalid-dn-syntax			&ldap-invalid-dn-syntax)
+	  ((ldap-return alias-deref-problem)		,&ldap-alias-deref-problem)
-	    (is-leaf				&ldap-is-leaf)
+	  ((ldap-return inappropriate-auth)		,&ldap-auth-unknown)
-	    (alias-deref-problem		&ldap-alias-deref-problem)
+	  ((ldap-return invalid-credentials)		,&ldap-invalid-credentials)
-	    (inappropriate-auth			&ldap-inappropriate-auth)
+	  ((ldap-return insufficient-access)		,&ldap-insufficient-access)
-	    (invalid-credentials		&ldap-invalid-credentials)
+	  ((ldap-return busy)				,&ldap-busy)
-	    (insufficient-access		&ldap-insufficient-access)
+	  ((ldap-return unavailable)			,&ldap-unavailable)
-	    (busy				&ldap-busy)
+	  ((ldap-return unwilling-to-perform)		,&ldap-unwilling-to-perform)
-	    (unavailable			&ldap-unavailable)
+	  ((ldap-return loop-detect)			,&ldap-loop-detect)
-	    (unwilling-to-perform		&ldap-unwilling-to-perform)
+	  ((ldap-return naming-violation)		,&ldap-naming-violation)
-	    (loop-detect			&ldap-loop-detect)
+	  ((ldap-return object-class-violation)		,&ldap-objectclass-violation)
-	    (naming-violation			&ldap-naming-violation)
+	  ((ldap-return not-allowed-on-leaf)		,&ldap-not-allowed-on-leaf)
-	    (object-class-violation		&ldap-object-class-violation)
+	  ((ldap-return not-allowed-on-rdn)		,&ldap-not-allowed-on-rdn)
-	    (not-allowed-on-leaf		&ldap-not-allowed-on-leaf)
+	  ((ldap-return already-exists)			,&ldap-already-exists)
-	    (not-allowed-on-rdn			&ldap-not-allowed-on-rdn)
+	  ((ldap-return no-object-class-mods)		,&ldap-no-objectclass-mods)
-	    (already-exists			&ldap-already-exists)
+	  ((ldap-return results-too-large)		,&ldap-results-too-large)
-	    (no-object-class-mods		&ldap-no-object-class-mods)
+	  ((ldap-return affects-multiple-dsas)		,&ldap-affects-multiple-dsas)
-	    (results-too-large			&ldap-results-too-large)
+	  ((ldap-return other)				,&ldap-error)
-	    (affects-multiple-dsas		&ldap-affects-multiple-dsas)
+	  ((ldap-return server-down)			,&ldap-server-down)
-	    (other				&ldap-other)
+	  ((ldap-return local-error)			,&ldap-local-error)
-	    (server-down			&ldap-server-down)
+	  ((ldap-return encoding-error)			,&ldap-encoding-error)
-	    (local-error			&ldap-local-error)
+	  ((ldap-return decoding-error)			,&ldap-decoding-error)
-	    (encoding-error			&ldap-encoding-error)
+	  ((ldap-return timeout)			,&ldap-timeout-error)
-	    (decoding-error			&ldap-decoding-error)
+	  ((ldap-return auth-unknown)			,&ldap-auth-unknown)
-	    (timeout				&ldap-timeout)
+	  ((ldap-return filter-error)			,&ldap-filter-error)
-	    (auth-unknown			&ldap-auth-unknown)
+	  ((ldap-return param-error)			,&ldap-param-error)
-	    (filter-error			&ldap-filter-error)
+	  ((ldap-return no-memory)			,&ldap-no-memory)
-	    (user-cancelled			&ldap-user-cancelled)
+	  ((ldap-return connect-error)			,&ldap-connect-error)
-	    (param-error			&ldap-param-error)
+	  ((ldap-return not-supported)			,&ldap-not-supported)
-	    (no-memory				&ldap-no-memory)
+	  ((ldap-return control-not-found)		,&ldap-control-not-found)
-	    (connect-error			&ldap-connect-error)
+	  ((ldap-return referral-limit-exceeded)	,&ldap-referral-limit-exceeded))))
-	    (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)
@@ -217,9 +238,5 @@
 				  (session session)))))))
        (else 
 	(raise 
-	 (condition (ldap-bindings-internal-error 
+	 (condition (&ldap-bindings-internal-error 
 		     (code return-object)))))))))
-	       
-
-
-   

scheme/interfaces.scm

@@ -7,27 +7,11 @@
    ldap-error-string
    ldap-result-error))
 
-(define-interface ldap-types-interface
-  (export
-   ldap-session?
-   ldap-message?
-   ldap-modification?
-
-   ldap-api-info?
-   ldap-api-info-info-version
-   ldap-api-info-api-version
-   ldap-api-info-protocol-version
-   ldap-api-info-vendor-name
-   ldap-api-info-vendor-version
-
-   ldap-return-object?
-   ldap-return-elements))
-
 (define-interface ldap-conditions-interface
   (export
    &ldap-error ldap-error? ldap-error-code ldap-error-session
    &ldap-security-error ldap-security-error?
-   &ldap-connection-error ldap-connection-error?
+   &ldap-service-error ldap-service-error?
    &ldap-data-error ldap-data-error?
 
    &ldap-bindings-internal-error ldap-bindings-internal-error?
@@ -52,11 +36,19 @@
    &ldap-unavailable ldap-unavailable?
    &ldap-unwilling-to-perform ldap-unwilling-to-perform?
    &ldap-loop-detect ldap-loop-detect?
+   &ldap-invalid-syntax ldap-invalid-syntax?
+   &ldap-invalid-dn-syntax ldap-invalid-dn-syntax?
    &ldap-naming-violation ldap-naming-violation?
+   &ldap-constraint-violation ldap-constraint-violation?
+   &ldap-type-or-value-exists ldap-type-or-value-exists?
    &ldap-objectclass-violation ldap-objectclass-violation?
    &ldap-not-allowed-on-leaf ldap-not-allowed-on-leaf?
    &ldap-not-allowed-on-rdn ldap-not-allowed-on-rdn?
    &ldap-already-exists ldap-already-exists?
+   &ldap-no-such-object ldap-no-such-object?
+   &ldap-alias-problem ldap-alias-problem?
+   &ldap-alias-deref-problem ldap-alias-deref-problem?
+   &ldap-referral-limit-exceeded ldap-referral-limit-exceeded?
    &ldap-no-objectclass-mods ldap-no-objectclass-mods?
    &ldap-results-too-large ldap-results-too-large?
    &ldap-affects-multiple-dsas ldap-affects-multiple-dsas?
@@ -73,3 +65,67 @@
    &ldap-not-supported ldap-not-supported?
    &ldap-control-not-found ldap-control-not-found?
    &ldap-referral-limit-exceeded ldap-referral-limit-exceeded?))
+
+(define-interface ldap-handle-types-interface
+  (export
+   ldap-session?
+   ldap-message?
+   ldap-modification?
+
+   ldap-api-info?
+   ldap-api-info-info-version
+   ldap-api-info-api-version
+   ldap-api-info-protocol-version
+   ldap-api-info-vendor-name
+   ldap-api-info-vendor-version))
+
+(define-interface ldap-return-interface
+  (export
+   ldap-return-object?
+   ldap-return-elements
+   ldap-return-name
+   (ldap-return :syntax)))
+
+(define-interface ldap-option-version-interface
+  (export
+   ldap-option-version-object?
+   ldap-option-version-elements
+   ldap-option-version-name
+   (ldap-option-version :syntax)))
+
+(define-interface ldap-scope-arguments-interface
+  (export
+   ldap-scope-arguments-object?
+   ldap-scope-arguments-elements
+   ldap-scope-arguments-name
+   (ldap-scope-arguments :syntax)))
+
+(define-interface ldap-session-option-values-interface
+  (export
+   ldap-session-option-value-object?
+   ldap-session-option-value-elements
+   ldap-session-option-value-name
+   (ldap-session-option-value :syntax)))
+
+(define-interface ldap-message-types-interface
+  (export
+   ldap-message-types-object?
+   ldap-message-types-elements
+   ldap-message-types-name
+   (ldap-message-types :syntax)))
+
+(define-interface ldap-attributes-special-values-interfaces
+  (export 
+   ldap-attributes-no-attribute
+   ldap-attributes-all-user-attributes))
+
+(define-interface ldap-types-interface
+  (compound-interface
+   ldap-return-interface   
+   ldap-option-version-interface
+   ldap-scope-arguments-interface
+   ldap-session-option-values-interface
+   ldap-message-types-interface
+   ldap-attributes-special-values-interfaces
+   ;;
+   ldap-handle-types-interface))

scheme/ldap-constants.scm

@@ -78,7 +78,7 @@
       (map make-constant-from-c-name-integer
 	   '("LDAP_SCOPE_BASE" "LDAP_SCOPE_ONELEVEL" "LDAP_SCOPE_SUBTREE")))
 
-    (define ldap-session-options
+    (define ldap-session-option-values
       (map make-constant-from-c-name-integer
 	   '("LDAP_OPT_API_INFO" 
 	     "LDAP_OPT_DEREF" 
@@ -120,7 +120,7 @@
 	      ldap-opt-protocol-version
 	      ldap-scope-arguments
 	      ldap-attribute-selectors
-	      ldap-session-options
+	      ldap-session-option-values
 	      ldap-message-types))
 	   
     (define (write-source-file name string)
@@ -164,8 +164,8 @@
 	 ldap-scope-arguments)
 
 	(generate-finite-type-definition
-	 "ldap-session-options" (make-drop-common-prefix-name-converter "LDAP_OPT_")
+	 "ldap-session-option-value" (make-drop-common-prefix-name-converter "LDAP_OPT_")
-	 ldap-session-options)
+	 ldap-session-option-values)
 
 	(generate-finite-type-definition
 	 "ldap-message-types" (make-drop-common-prefix-name-converter "LDAP_RES_")

scheme/ldap.scm

@@ -27,7 +27,7 @@
       (set-ldap-session-options! session options)
       session)))
 
-;;;
+;;; SIMPLE_BIND_S
 
 (import-lambda-definition ldap-simple-bind-internal 
   (session user cred) 
@@ -41,7 +41,7 @@
 	(set-ldap-session-bound?! session #t)
 	(raise-ldap-error ret-obj session))))
 
-;;; 
+;;; SASL_BIND_S
 
 (import-lambda-definition ldap-sasl-bind-internal
   (session dn mechanism cred server-controls client-controls server-cred)
@@ -53,7 +53,7 @@
   (raise (condition (ldap-bindings-not-implemented 
 		     (what '(ldap-sasl-bind ldap-controls))))))
 
-;;;
+;;; UNBIND_S
 
 (import-lambda-definition ldap-unbind-internal 
   (session) 
@@ -65,7 +65,7 @@
 	(set-ldap-session-bound?! ldap #f)
 	(raise-ldap-error ret-obj session))))
 
-;;;
+;;; SEARCH_S and SEARCH_ST
 
 (import-lambda-definition ldap-search-internal
   (session base scope filter attribute-list attributes-only?)
@@ -111,7 +111,7 @@
 		 message)
 	       (raise-ldap-error ret-obj session))))))))
 
-;;;
+;;; GET/SET session options
 
 (import-lambda-definition ldap-get-set-option-internal
   (session option set? value)
@@ -120,8 +120,9 @@
 (define (set-ldap-session-option! session session-option value)
   (call-with-values
    (lambda ()
-     (ldap-get-set-option-internal 
+     (apply values
-      session (ldap-session-options-id session-option) #t value))
+	    (ldap-get-set-option-internal 
+	     session (ldap-session-options-id session-option) #t value)))
    (lambda (call-successful? result)
      (if call-successful?
 	 result
@@ -131,15 +132,16 @@
 (define (ldap-session-option session session-option)
   (call-with-values
    (lambda ()
-     (ldap-get-set-option-internal
+     (apply values
-      session (ldap-session-options-id session-option) #f #f))
+	    (ldap-get-set-option-internal
+	     session (ldap-session-options-id session-option) #f #f)))
    (lambda (call-successful? result)
      (if call-successful?
 	 result
 	 (raise
 	  (condition (&ldap-session-option-error (session session))))))))
 
-;;;
+;;; 
 
 (import-lambda-definition ldap-error-string-internal 
   (session error-code) 
@@ -150,7 +152,7 @@
    (ldap-session-option 
     session (ldap-session-option error-number))))
 
-;;;
+;;; FIRST/NEXT_MESSAGE, COUNT_MESSAGES
 
 (import-lambda-definition ldap-first-message-internal
   (session message) 
@@ -177,7 +179,88 @@
 (define (ldap-count-messages session message)
   (let ((ret (ldap-count-messages-internal session message)))
     (or ret
-	(raise-ldap-error (ldap-get-error-code session) session))))
+	(raise-ldap-error (ldap-get-error-return-object session) session))))
+
+;;;
+
+(import-lambda-definition ldap-get-message-type-internal
+  (message)
+  "scsh_ldap_msgtype")
+
+(define (ldap-get-message-type session message)
+  (cond 
+   ((ldap-get-message-type-internal message)
+    => (lambda (code) (ldap-message-type code)))
+   (else 
+    (raise-ldap-error (ldap-get-error-return-object session) session))))
+
+;;;
+
+(import-lambda-definition ldap-message-id-internal 
+  (message)
+  "scsh_ldap_msgid")
+
+(define (ldap-get-message-id session message)
+  (or (ldap-get-message-id-internal message)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
+			     
+;;;
+
+(import-lambda-definition ldap-first-attribute-internal
+  (session entry)
+  "scsh_ldap_first_attribute")
+
+(import-lambda-definition ldap-next-attribute-internal
+  (session entry ber-element)
+  "scsh_ldap_next_attribute")
+
+(import-lambda-definition ber-element-free
+  (ber-element fbuf)
+  "scsh_ldap_ber_free")
+
+(define (ber-element-finalizer ber-element)
+  (ber-element-free ber-element 1))
+
+(define (ldap-first-attribute session entry)
+  (call-with-values
+   (lambda ()
+     (apply values
+	    (ldap-first-attribute-internal session entry)))
+   (lambda (attribute-name ber-element)
+     (if attribute-name
+	 (begin
+	   (add-finalizer! ber-element ber-element-finalizer)
+	   (values attribute-name ber-element))
+	 (raise-ldap-error (ldap-get-error-return-object session) session)))))
+
+(define (ldap-next-attribute session entry ber-element)
+  (or (ldap-next-attribute-internal session entry ber-element)
+      (let ((ret-obj (ldap-get-error-return-object session)))
+	(if (ldap-success? ret-obj)
+	    #f
+	    (raise-ldap-error ret-obj session)))))
+
+(define (ldap-all-attributes session entry)
+  (call-with-values
+   (lambda ()
+     (ldap-first-attribute session entry))
+   (lambda (first-attribute ber-element)
+     (let loop ((next (ldap-next-attribute session entry ber-element))
+		(attributes (list first-attribute)))
+       (if next
+	   (loop (ldap-next-attribute session entry ber-element)
+		 (cons next attributes))
+	   attributes)))))
+
+;;;
+
+(import-lambda-definition ldap-get-values-internal
+  (session entry attribute)
+  "scsh_ldap_get_values")
+
+(define (ldap-get-values session entry attribute-name)
+  (or (ldap-get-values-internal session entry attribute-name)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
 
 ;;;
 
@@ -194,22 +277,94 @@
 	(equal? (ldap-return compare-true) ret-obj)
 	(raise-ldap-error ret-obj session))))
 
-(import-lambda-definition ldap-result-error-internal 
+;;;
-  (session error-code) 
-  "scsh_ldap_result")
 
-(import-lambda-definition ldap-count-entries-internal 
+(import-lambda-definition ldap-get-dn-internal
-  (session message) 
+  (session message)
+  "scsh_ldap_get_dn")
+
+(define (ldap-message-dn session entry)
+  (or (ldap-get-dn-internal session entry)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
+
+;;;
+
+(import-lambda-definition ldap-explode-dn-internal
+  (dn no-types?) 
+  "scsh_ldap_explode_dn")
+
+(define (ldap-explode-dn session dn no-types?)
+  (or (ldap-explode-dn-internal dn no-types?)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
+
+;;;
+
+(import-lambda-definition ldap-explode-rdn-internal
+  (dn no-types?) 
+  "scsh_ldap_explode_rdn")
+
+(define (ldap-explode-rdn session dn no-types?)
+  (or (ldap-explode-rdn-internal dn no-types?)
+      (raise-ldap-error (ldap-get-error-return-object session dn no-types?))))
+
+;;;
+
+(import-lambda-definition ldap-dn2ufn-internal
+  (dn)
+  "scsh_ldap_dn2ufn")
+
+(define (ldap-make-dn-userfriendly session dn)
+  (or (ldap-dn2ufn-internal dn)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
+
+;;;
+
+(import-lambda-definition ldap-count-entries-internal
+  (session message)
   "scsh_ldap_count_entries")
 
-(import-lambda-definition ldap-first-entry-internal 
+(import-lambda-definition ldap-first-entry-internal
-  (session message) 
+  (session message)
   "scsh_ldap_first_entry")
 
-(import-lambda-definition ldap-next-entry-internal 
+(import-lambda-definition ldap-next-entry-internal
-  (session message) 
+  (session message)
   "scsh_ldap_next_entry")
 
+(define (ldap-count-entries session message)
+  (or (ldap-count-entries-internal session message)
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
+
+(define (ldap-first-entry session message)
+  (cond 
+   ((ldap-first-entry-internal session message)
+    => (lambda (new-message)
+	 (add-finalizer! new-message ldap-message-finalizer)
+	 new-message))
+   (else
+    (let ((ret-obj (ldap-get-error-return-object session)))
+      (if (ldap-success? ret-obj)
+	  #f
+	  (raise-ldap-error ret-obj session))))))
+
+(define (ldap-next-entry session message)
+  (cond 
+   ((ldap-next-entry-internal session message)
+    => (lambda (new-message)
+	 (add-finalizer! new-message ldap-message-finalizer)
+	 new-message))
+   (else
+    (let ((ret-obj (ldap-get-error-return-object session)))
+      (if (ldap-success? ret-obj)
+	  #f
+	  (raise-ldap-error ret-obj session))))))
+
+;;;
+
+(import-lambda-definition ldap-count-references-internal
+  (session message)
+  "scsh_ldap_count_references")
+
 (import-lambda-definition ldap-first-reference-internal
   (session message) 
   "scsh_ldap_first_reference")
@@ -218,37 +373,35 @@
   (session message)
   "scsh_ldap_next_reference")
 
-(import-lambda-definition ldap-count-references-internal
+(define (ldap-count-references session message)
-  (session message)
+  (or (ldap-count-references-internal session message)
-  "scsh_ldap_count_references")
+      (raise-ldap-error (ldap-get-error-return-object session) session)))
 
-(import-lambda-definition ldap-message-type-internal
+(define (ldap-first-reference session message)
-  (message) 
+  (cond
-  "scsh_ldap_msgtype")
+   ((ldap-first-reference-internal session message)
+    => (lambda (new-message)
+	 (add-finalizer! new-message ldap-message-finalizer)
+	 new-message))
+   (else
+    (let ((ret-obj (ldap-get-error-return-object session)))
+      (if (ldap-success? ret-obj)
+	  #f
+	  (raise-ldap-error ret-obj session))))))
 
-(import-lambda-definition ldap-message-id-internal 
+(define (ldap-next-reference session message)
-  (message)
+  (cond 
-  "scsh_ldap_msgid")
+   ((ldap-next-reference-internal session message)
+    => (lambda (new-message)
+	 (add-finalizer! new-message ldap-message-finalizer)
+	 new-message))
+   (else
+    (let ((ret-obj (ldap-get-error-return-object session)))
+      (if (ldap-success? ret-obj)
+	  #f
+	  (raise-ldap-error ret-obj session))))))
 
-(import-lambda-definition ldap-get-dn-internal
+;;;
-  (session message)
-  "scsh_ldap_get_dn")
-
-(import-lambda-definition ldap-explode-dn-internal
-  (dn no-types?) 
-  "scsh_ldap_explode_dn")
-
-(import-lambda-definition ldap-explode-rdn-internal
-  (dn no-types?) 
-  "scsh_ldap_explode_rdn")
-
-(import-lambda-definition ldap-dn2ufn-internal
-  (dn)
-  "scsh_ldap_dn2ufn")
-
-(import-lambda-definition ldap-get-values-internal
-  (session message attribute)
-  "scsh_ldap_get_values")
 
 (import-lambda-definition ldap-modify-internal
   (session dn ldap-modification-vector)

scheme/packages.scm

@@ -9,11 +9,15 @@
 
 (define-structure ldap-types ldap-types-interface
   (open scheme
-	define-record-types
+	define-record-types	
-	external-calls)
+	external-calls
-  (files types const-gen))
+	srfi-1
+	finite-types
+	ffi-tools-rts)
+  (files const-gen types))
 
 (define-structure ldap-conditions ldap-conditions-interface
   (open scheme
-	srfi-34 srfi-35)
+	srfi-34 srfi-35
+	ldap-types)
   (files conditions))

scheme/types.scm

@@ -83,4 +83,4 @@
 
 (define convert-ldap-message-type
   (make-finite-type-import-function 
-   'ldap-message-type ldap-message-type-elements ldap-message-type-id))
+   'ldap-message-types ldap-message-types-elements ldap-message-types-id))