scsh-ldap/c/ldap.c

#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;
  S48_DECLARE_GC_PROTECT(1);

  S48_GC_PROTECT_1(rec);
  rec = s48_make_record(scsh_ldap_record_type);
  S48_RECORD_SET(rec, 0, s48_enter_integer((long) ldap));
  S48_GC_UNPROTECT();
  return rec;
}

s48_value scsh_enter_ldapmessage(LDAPMessage *lm)
{
  s48_value rec = S48_FALSE;
  S48_DECLARE_GC_PROTECT(1);

  S48_GC_PROTECT_1(rec);
  rec = s48_make_record(scsh_ldapmessage_record_type);
  S48_RECORD_SET(rec, 0, s48_enter_integer((long) lm));
  S48_GC_UNPROTECT();
  return rec;
}

s48_value scsh_ldap_open(s48_value host, s48_value port)
{
  LDAP *ldap;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(host, port);
  ldap = ldap_open(s48_extract_string(host), s48_extract_integer(port));
  S48_GC_UNPROTECT();
  return ldap == NULL ? S48_FALSE : scsh_enter_ldap(ldap);
}

s48_value scsh_ldap_init(s48_value host, s48_value port)
{
  LDAP *ldap;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(host, port);
  ldap = ldap_init(s48_extract_string(host), s48_extract_integer(port));
  S48_GC_UNPROTECT();
  return ldap == NULL ? S48_FALSE : scsh_enter_ldap(ldap);
}

s48_value scsh_ldap_bind_s(s48_value ldap, s48_value user, 
			   s48_value cred, s48_value method)
{
  int r;
  S48_DECLARE_GC_PROTECT(4);

  S48_GC_PROTECT_4(ldap, user, cred, method);
  r = ldap_bind_s(scsh_extract_ldap(ldap), s48_extract_string(user),
		  s48_extract_string(cred), s48_extract_integer(method));
  S48_GC_UNPROTECT();
  return s48_enter_integer(r);
}

s48_value scsh_ldap_simple_bind_s(s48_value ldap, s48_value user, s48_value cred)
{
  int r;
  S48_DECLARE_GC_PROTECT(3);

  S48_GC_PROTECT_3(ldap, user, cred);
  r = ldap_simple_bind_s(scsh_extract_ldap(ldap), s48_extract_string(user),
			 s48_extract_string(cred));
  S48_GC_UNPROTECT();
  return s48_enter_integer(r);
}

s48_value scsh_ldap_kerberos_bind_s(s48_value ldap, s48_value dn)
{
#if HAVE_LDAP_KERBEROS_BIND_S
  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);
#else
  return S48_FALSE;
#endif
}

s48_value scsh_ldap_unbind_s(s48_value ldap)
{
  return s48_enter_integer(ldap_unbind_s(scsh_extract_ldap(ldap)));
}

s48_value scsh_ldap_error_string(s48_value errcode)
{
  return s48_enter_string(ldap_err2string(s48_extract_integer(errcode)));
}

s48_value scsh_ldap_result_error(s48_value ldap, s48_value res)
{
  int r;
  S48_DECLARE_GC_PROTECT(2);
  
  S48_GC_PROTECT_2(ldap, res);
  r = s48_enter_integer(ldap_result2error(scsh_extract_ldap(ldap), 
					  scsh_extract_ldapmessage(res), 0));
  S48_GC_UNPROTECT();
  return s48_enter_integer(r);
}

s48_value scsh_ldap_memfree(s48_value ldap)
{
  ldap_memfree(scsh_extract_ldap(ldap));
  return S48_UNSPECIFIC;
}

s48_value scsh_ldap_msgfree(s48_value ldapmsg)
{
  ldap_msgfree(scsh_extract_ldapmessage(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);
  scsh_ldap_record_type = s48_get_imported_binding("ldap");

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