diff --git a/c/ldap.c b/c/ldap.c index d4a4000..d672af1 100644 --- a/c/ldap.c +++ b/c/ldap.c @@ -1,5 +1,9 @@ #include "scsh-ldap.h" +/* prototypes */ +s48_value scsh_enter_string_list(char **list); +char** scsh_extract_string_vector(s48_value vector); + s48_value scsh_enter_ldap(LDAP *ldap) { s48_value rec = S48_FALSE; @@ -68,7 +72,18 @@ s48_value scsh_ldap_simple_bind_s(s48_value ldap, s48_value user, s48_value cred r = ldap_simple_bind_s(scsh_extract_ldap(ldap), s48_extract_string(user), s48_extract_string(cred)); S48_GC_UNPROTECT(); - return r; + return s48_enter_integer(r); +} + +s48_value scsh_ldap_kerberos_bind_s(s48_value ldap, s48_value dn) +{ + int r; + S48_DECLARE_GC_PROTECT(2); + + S48_GC_PROTECT_2(ldap, dn); + r = ldap_kerberos_bind_s(scsh_extract_ldap(ldap), s48_extract_string(dn)); + S48_GC_UNPROTECT(); + return s48_enter_integer(r); } s48_value scsh_ldap_unbind_s(s48_value ldap) @@ -105,6 +120,161 @@ s48_value scsh_ldap_msgfree(s48_value ldapmsg) return S48_UNSPECIFIC; } +s48_value scsh_ldap_search_s(s48_value ldap, s48_value base, + s48_value scope, s48_value filter, + s48_value attrs, s48_value attrsonly) +{ + int r; + char** a; + LDAPMessage **msg; + s48_value res; + S48_DECLARE_GC_PROTECT(7); + + S48_GC_PROTECT_7(ldap, base, scope, filter, attrs, attrsonly, res); + a = scsh_extract_string_vector(attrs); + r = ldap_search_s(scsh_extract_ldap(ldap), + s48_extract_string(base), + s48_extract_integer(scope), + s48_extract_string(filter), + a, + S48_TRUE_P(attrsonly), + msg); + free(a); + res = s48_list_2(s48_enter_integer(r), scsh_enter_ldapmessage(*msg)); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_ldap_search_st(s48_value ldap, s48_value base, + s48_value scope, s48_value filter, + s48_value attrs, s48_value attrsonly, + s48_value timeout_sec, s48_value timeout_usec) +{ + int r; + char** a; + LDAPMessage **msg; + struct timeval timeout; + s48_value res = S48_FALSE; + S48_DECLARE_GC_PROTECT(9); + + S48_GC_PROTECT_4(ldap, base, scope, filter); + S48_GC_PROTECT_3(attrs, attrsonly, res); + S48_GC_PROTECT_2(timeout_sec, timeout_usec); + timeout.tv_sec = s48_extract_integer(timeout_sec); + timeout.tv_usec = s48_extract_integer(timeout_usec); + a = scsh_extract_string_vector(attrs); + r = ldap_search_st(scsh_extract_ldap(ldap), s48_extract_string(base), + s48_extract_integer(scope), s48_extract_string(filter), + a, S48_TRUE_P(attrsonly), &timeout, msg); + free(a); + res = s48_list_2(s48_enter_integer(r), scsh_enter_ldapmessage(*msg)); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_ldap_count_entries(s48_value ldap, s48_value lm) +{ + int r; + S48_DECLARE_GC_PROTECT(2); + + S48_GC_PROTECT_2(ldap, lm); + r = ldap_count_entries(scsh_extract_ldap(ldap), + scsh_extract_ldapmessage(lm)); + S48_GC_UNPROTECT(); + return r; +} + +s48_value scsh_ldap_first_entry(s48_value ldap, s48_value lm) +{ + LDAPMessage *lm_new; + s48_value res = S48_FALSE; + S48_DECLARE_GC_PROTECT(3); + + S48_GC_PROTECT_3(ldap, lm, res); + lm_new = ldap_first_entry(scsh_extract_ldap(ldap), + scsh_extract_ldapmessage(lm)); + res = scsh_enter_ldapmessage(lm_new); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_ldap_next_entry(s48_value ldap, s48_value lm) +{ + LDAPMessage *lm_new; + s48_value res = S48_FALSE; + S48_DECLARE_GC_PROTECT(3); + + S48_GC_PROTECT_3(ldap, lm, res); + lm_new = ldap_next_entry(scsh_extract_ldap(ldap), + scsh_extract_ldapmessage(lm)); + res = scsh_enter_ldapmessage(lm_new); + S48_GC_UNPROTECT(); + return res; +} + +s48_value scsh_ldap_msgtype(s48_value lm) +{ + int r; + + r = ldap_msgtype(scsh_extract_ldapmessage(lm)); + return s48_enter_integer(r); +} + +s48_value scsh_ldap_msgid(s48_value lm) +{ + int r; + + r = ldap_msgid(scsh_extract_ldapmessage(lm)); + return s48_enter_integer(r); +} + +s48_value scsh_ldap_get_values(s48_value ldap, s48_value entry, + s48_value attr) +{ + char **val; + s48_value res = S48_FALSE; + S48_DECLARE_GC_PROTECT(4); + + S48_GC_PROTECT_4(ldap, entry, attr, res); + val = ldap_get_values(scsh_extract_ldap(ldap), + scsh_extract_ldapmessage(entry), + s48_extract_string(attr)); + res = scsh_enter_string_list(val); + ldap_value_free(val); + S48_GC_UNPROTECT(); + return res; +} +/* TODO: ldap_get_values_len() -- for binary attribute values */ + +s48_value scsh_enter_string_list(char **list) +{ + int i; + s48_value res = S48_NULL; + S48_DECLARE_GC_PROTECT(1); + + S48_GC_PROTECT_1(res); + for (i = 0; list[i] != NULL; i++) + res = s48_cons(s48_enter_string(list[i]), res); + S48_GC_UNPROTECT(); + return res; +} + +char** scsh_extract_string_vector(s48_value vector) +{ + char** a; + int l, i; + S48_DECLARE_GC_PROTECT(1); + + S48_GC_PROTECT_1(vector); + l = S48_VECTOR_LENGTH(vector); + if ((a = calloc (l, sizeof(char *))) == NULL) + RAISE_MEMORY_ALLOC_ERROR("scsh_extract_string_vector"); + for (i = 0; i < l; i++) + a[i] = s48_extract_string(S48_VECTOR_REF(vector, i)); + S48_GC_UNPROTECT(); + return a; +} + void scsh_ldap_main(void) { S48_GC_PROTECT_GLOBAL(scsh_ldap_record_type); @@ -113,14 +283,26 @@ void scsh_ldap_main(void) S48_GC_PROTECT_GLOBAL(scsh_ldapmessage_record_type); scsh_ldapmessage_record_type = s48_get_imported_binding("ldap-message"); + S48_GC_PROTECT_GLOBAL(raise_ldap_memory_alloc_error); + raise_ldap_memory_alloc_error = s48_get_imported_binding("raise-ldap-memory-alloc-error"); + S48_EXPORT_FUNCTION(scsh_ldap_open); S48_EXPORT_FUNCTION(scsh_ldap_init); S48_EXPORT_FUNCTION(scsh_ldap_bind_s); S48_EXPORT_FUNCTION(scsh_ldap_simple_bind_s); + S48_EXPORT_FUNCTION(scsh_ldap_kerberos_bind_s); S48_EXPORT_FUNCTION(scsh_ldap_unbind_s); S48_EXPORT_FUNCTION(scsh_ldap_error_string); S48_EXPORT_FUNCTION(scsh_ldap_result_error); S48_EXPORT_FUNCTION(scsh_ldap_memfree); S48_EXPORT_FUNCTION(scsh_ldap_msgfree); + S48_EXPORT_FUNCTION(scsh_ldap_search_s); + S48_EXPORT_FUNCTION(scsh_ldap_search_st); + S48_EXPORT_FUNCTION(scsh_ldap_count_entries); + S48_EXPORT_FUNCTION(scsh_ldap_first_entry); + S48_EXPORT_FUNCTION(scsh_ldap_next_entry); + S48_EXPORT_FUNCTION(scsh_ldap_msgtype); + S48_EXPORT_FUNCTION(scsh_ldap_msgid); + S48_EXPORT_FUNCTION(scsh_ldap_get_values); } diff --git a/c/scsh-ldap.h b/c/scsh-ldap.h index 2b7f920..098416b 100644 --- a/c/scsh-ldap.h +++ b/c/scsh-ldap.h @@ -1,5 +1,8 @@ #include "scheme48.h" -#include + +#include +#include + #include static s48_value scsh_ldap_record_type = S48_FALSE; @@ -15,5 +18,14 @@ s48_value scsh_enter_ldapmessage(LDAPMessage *lm); ((LDAPMessage *) \ s48_extract_integer(S48_RECORD_REF(x, 0))) +/* conditions */ +static s48_value raise_ldap_memory_alloc_error = S48_FALSE; + +#define RAISE_MEMORY_ALLOC_ERROR(FUNNAME) \ +s48_call_scheme(S48_SHARED_BINDING_REF(raise_ldap_memory_alloc_error), \ + 1, s48_enter_string(FUNNAME)); + +char** scsh_extract_string_vector(s48_value vector); + void scsh_ldap_main(void); diff --git a/scheme/ldap.scm b/scheme/ldap.scm index 91507bb..568c57d 100644 --- a/scheme/ldap.scm +++ b/scheme/ldap.scm @@ -30,15 +30,19 @@ (host port) "scsh_ldap_init") -(import-lambda-definition ldap-bind-sync +(import-lambda-definition ldap-bind (ldap user password method) "scsh_ldap_bind_s") -(import-lambda-definition ldap-simple-bind-sync +(import-lambda-definition ldap-simple-bind (ldap user password) "scsh_ldap_simple_bind_s") -(import-lambda-definition ldap-unbind-sync +(import-lambda-definition ldap-kerberos-bind + (ldap dn) + "scsh_ldap_kerberos_bind_s") + +(import-lambda-definition ldap-unbind (ldap) "scsh_ldap_unbind_s") @@ -57,3 +61,38 @@ (import-lambda-definition ldap-msgfree (ldap) "scsh_ldap_msgfree") + +(import-lambda-definition ldap-search + (ldap base scope filter attributes attributes-only?) + "scsh_ldap_search_s") + +(import-lambda-definition ldap-search-timeout + (ldap base scope filter attributes attributes-only? + timeout-secs timeout-usecs) + "scsh_ldap_search_st") + +(import-lambda-definition ldap-count-entries + (ldap message) + "scsh_ldap_count_entries") + +(import-lambda-definition ldap-first-entry + (ldap message) + "scsh_ldap_first_entry") + +(import-lambda-definition ldap-next-entry + (ldap message) + "scsh_ldap_next_entry") + +(import-lambda-definition ldap-message-type + (message) + "scsh_ldap_msgtype") + +(import-lambda-definition ldap-message-id + (message) + "scsh_ldap_msgid") + +(import-lambda-definition ldap-get-values + (ldap message attribute) + "scsh_ldap_get_values") + +