conforming to the API defined in RFC 1823.
It has been tested with:
- UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
- - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
+ - OpenLDAP 1.2 (http://www.openldap.org/)
+ - Netscape's LDAP SDK (http://developer.netscape.com/) */
#include <config.h>
#include "lisp.h"
#include "opaque.h"
#include "sysdep.h"
+#include "buffer.h"
#include <errno.h>
#include "eldap.h"
-#ifdef HAVE_NS_LDAP
-# define HAVE_LDAP_SET_OPTION 1
-# define HAVE_LDAP_GET_ERRNO 1
-#else
-# undef HAVE_LDAP_SET_OPTION
-# undef HAVE_LDAP_GET_ERRNO
-#endif
-
static int ldap_default_port;
static Lisp_Object Vldap_default_base;
Lisp_Object Qldapp;
/* ldap-open plist keywords */
-extern Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
- Qsizelimit;
+static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
/* Search scope limits */
-extern Lisp_Object Qbase, Qonelevel, Qsubtree;
+static Lisp_Object Qbase, Qonelevel, Qsubtree;
/* Authentication methods */
-extern Lisp_Object Qkrbv41, Qkrbv42;
+static Lisp_Object Qkrbv41, Qkrbv42;
/* Deref policy */
-extern Lisp_Object Qnever, Qalways, Qfind;
+static Lisp_Object Qnever, Qalways, Qfind;
+/* Modification types (Qdelete is defined in general.c) */
+static Lisp_Object Qadd, Qreplace;
+
\f
/************************************************************************/
/* Utility Functions */
/************************************************************************/
static void
-signal_ldap_error (LDAP *ld)
+signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err)
{
-#ifdef HAVE_LDAP_GET_ERRNO
- signal_simple_error
- ("LDAP error",
- build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
+ if (ldap_err <= 0)
+ {
+#if defined HAVE_LDAP_PARSE_RESULT
+ int err;
+ ldap_err = ldap_parse_result (ld, res,
+ &err,
+ NULL, NULL, NULL, NULL, 0);
+ if (ldap_err == LDAP_SUCCESS)
+ ldap_err = err;
+#elif defined HAVE_LDAP_GET_LDERRNO
+ ldap_err = ldap_get_lderrno (ld, NULL, NULL);
+#elif defined HAVE_LDAP_RESULT2ERROR
+ ldap_err = ldap_result2error (ld, res, 0);
#else
- signal_simple_error ("LDAP error",
- build_string (ldap_err2string (ld->ld_errno)));
+ ldap_err = ld->ld_errno;
#endif
+ }
+ signal_simple_error ("LDAP error",
+ build_string (ldap_err2string (ldap_err)));
}
\f
/************************************************************************/
static Lisp_Object
-make_ldap (struct Lisp_LDAP *ldap)
+make_ldap (Lisp_LDAP *ldap)
{
Lisp_Object lisp_ldap;
XSETLDAP (lisp_ldap, ldap);
}
static Lisp_Object
-mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_ldap (Lisp_Object obj)
{
return XLDAP (obj)->host;
}
{
char buf[32];
- struct Lisp_LDAP *ldap = XLDAP (obj);
+ Lisp_LDAP *ldap = XLDAP (obj);
if (print_readably)
error ("printing unreadable object #<ldap %s>",
write_c_string ("#<ldap ", printcharfun);
print_internal (ldap->host, printcharfun, 1);
- if (!ldap->livep)
+ if (!ldap->ld)
write_c_string ("(dead) ",printcharfun);
- sprintf (buf, " 0x%x>", (unsigned int)ldap);
+ sprintf (buf, " 0x%lx>", (long)ldap);
write_c_string (buf, printcharfun);
}
-static struct Lisp_LDAP *
+static Lisp_LDAP *
allocate_ldap (void)
{
- struct Lisp_LDAP *ldap =
- alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap);
+ Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap);
ldap->ld = NULL;
ldap->host = Qnil;
- ldap->livep = 0;
return ldap;
}
static void
finalize_ldap (void *header, int for_disksave)
{
- struct Lisp_LDAP *ldap = (struct Lisp_LDAP *) header;
+ Lisp_LDAP *ldap = (Lisp_LDAP *) header;
if (for_disksave)
signal_simple_error ("Can't dump an emacs containing LDAP objects",
make_ldap (ldap));
- if (ldap->livep)
+ if (ldap->ld)
ldap_unbind (ldap->ld);
+ ldap->ld = NULL;
}
DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
mark_ldap, print_ldap, finalize_ldap,
- NULL, NULL, struct Lisp_LDAP);
+ NULL, NULL, 0, Lisp_LDAP);
(ldap))
{
CHECK_LDAP (ldap);
- return (XLDAP (ldap))->livep ? Qt : Qnil;
+ return (XLDAP (ldap))->ld ? Qt : Qnil;
}
\f
/************************************************************************/
(host, plist))
{
/* This function can GC */
- struct Lisp_LDAP *ldap;
+ Lisp_LDAP *ldap;
LDAP *ld;
int ldap_port = 0;
int ldap_auth = LDAP_AUTH_SIMPLE;
int ldap_sizelimit = 0;
int err;
- Lisp_Object list, keyword, value;
-
CHECK_STRING (host);
- EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
- {
- /* TCP Port */
- if (EQ (keyword, Qport))
- {
- CHECK_INT (value);
- ldap_port = XINT (value);
- }
- /* Authentication method */
- if (EQ (keyword, Qauth))
- {
- if (EQ (value, Qsimple))
- ldap_auth = LDAP_AUTH_SIMPLE;
+ {
+ EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
+ {
+ /* TCP Port */
+ if (EQ (keyword, Qport))
+ {
+ CHECK_INT (value);
+ ldap_port = XINT (value);
+ }
+ /* Authentication method */
+ if (EQ (keyword, Qauth))
+ {
+ if (EQ (value, Qsimple))
+ ldap_auth = LDAP_AUTH_SIMPLE;
#ifdef LDAP_AUTH_KRBV41
- else if (EQ (value, Qkrbv41))
- ldap_auth = LDAP_AUTH_KRBV41;
+ else if (EQ (value, Qkrbv41))
+ ldap_auth = LDAP_AUTH_KRBV41;
#endif
#ifdef LDAP_AUTH_KRBV42
- else if (EQ (value, Qkrbv42))
- ldap_auth = LDAP_AUTH_KRBV42;
+ else if (EQ (value, Qkrbv42))
+ ldap_auth = LDAP_AUTH_KRBV42;
#endif
- else
- signal_simple_error ("Invalid authentication method", value);
- }
- /* Bind DN */
- else if (EQ (keyword, Qbinddn))
- {
- CHECK_STRING (value);
- ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
- strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
- }
- /* Password */
- else if (EQ (keyword, Qpasswd))
- {
- CHECK_STRING (value);
- ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
- strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
- }
- /* Deref */
- else if (EQ (keyword, Qderef))
- {
- if (EQ (value, Qnever))
- ldap_deref = LDAP_DEREF_NEVER;
- else if (EQ (value, Qsearch))
- ldap_deref = LDAP_DEREF_SEARCHING;
- else if (EQ (value, Qfind))
- ldap_deref = LDAP_DEREF_FINDING;
- else if (EQ (value, Qalways))
- ldap_deref = LDAP_DEREF_ALWAYS;
- else
- signal_simple_error ("Invalid deref value", value);
- }
- /* Timelimit */
- else if (EQ (keyword, Qtimelimit))
- {
- CHECK_INT (value);
- ldap_timelimit = XINT (value);
- }
- /* Sizelimit */
- else if (EQ (keyword, Qsizelimit))
- {
- CHECK_INT (value);
- ldap_sizelimit = XINT (value);
- }
- }
+ else
+ signal_simple_error ("Invalid authentication method", value);
+ }
+ /* Bind DN */
+ else if (EQ (keyword, Qbinddn))
+ {
+ CHECK_STRING (value);
+ LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative);
+ }
+ /* Password */
+ else if (EQ (keyword, Qpasswd))
+ {
+ CHECK_STRING (value);
+ LISP_STRING_TO_EXTERNAL (value, ldap_passwd, Qnative);
+ }
+ /* Deref */
+ else if (EQ (keyword, Qderef))
+ {
+ if (EQ (value, Qnever))
+ ldap_deref = LDAP_DEREF_NEVER;
+ else if (EQ (value, Qsearch))
+ ldap_deref = LDAP_DEREF_SEARCHING;
+ else if (EQ (value, Qfind))
+ ldap_deref = LDAP_DEREF_FINDING;
+ else if (EQ (value, Qalways))
+ ldap_deref = LDAP_DEREF_ALWAYS;
+ else
+ signal_simple_error ("Invalid deref value", value);
+ }
+ /* Timelimit */
+ else if (EQ (keyword, Qtimelimit))
+ {
+ CHECK_INT (value);
+ ldap_timelimit = XINT (value);
+ }
+ /* Sizelimit */
+ else if (EQ (keyword, Qsizelimit))
+ {
+ CHECK_INT (value);
+ ldap_sizelimit = XINT (value);
+ }
+ }
+ }
if (ldap_port == 0)
{
}
/* Connect to the server and bind */
- ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
+ slow_down_interrupts ();
+ ld = ldap_open ((char *) XSTRING_DATA (host), ldap_port);
+ speed_up_interrupts ();
+
if (ld == NULL )
signal_simple_error_2 ("Failed connecting to host",
host,
#ifdef HAVE_LDAP_SET_OPTION
- if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
- signal_ldap_error (ld);
- if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
- (void *)&ldap_timelimit) != LDAP_SUCCESS)
- signal_ldap_error (ld);
- if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
- (void *)&ldap_sizelimit) != LDAP_SUCCESS)
- signal_ldap_error (ld);
- if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
- signal_ldap_error (ld);
+ if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
+ (void *)&ldap_deref)) != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, err);
+ if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
+ (void *)&ldap_timelimit)) != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, err);
+ if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
+ (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, err);
+ if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
+ LDAP_OPT_ON)) != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, err);
+ if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
+ LDAP_OPT_ON)) != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, err);
#else /* not HAVE_LDAP_SET_OPTION */
ld->ld_deref = ldap_deref;
ld->ld_timelimit = ldap_timelimit;
#else /* not LDAP_REFERRALS */
ld->ld_options = 0;
#endif /* not LDAP_REFERRALS */
+ /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
+ ld->ld_options |= LDAP_OPT_RESTART;
#endif /* not HAVE_LDAP_SET_OPTION */
- /* ldap_bind_s calls select and may be wedged by SIGIO. */
- slow_down_interrupts ();
err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
- speed_up_interrupts ();
if (err != LDAP_SUCCESS)
signal_simple_error ("Failed binding to the server",
build_string (ldap_err2string (err)));
ldap = allocate_ldap ();
ldap->ld = ld;
ldap->host = host;
- ldap->livep = 1;
return make_ldap (ldap);
}
*/
(ldap))
{
- struct Lisp_LDAP *lldap;
+ Lisp_LDAP *lldap;
CHECK_LIVE_LDAP (ldap);
lldap = XLDAP (ldap);
ldap_unbind (lldap->ld);
- lldap->livep = 0;
+ lldap->ld = NULL;
return Qnil;
}
struct ldap_unwind_struct
{
LDAPMessage *res;
- char **vals;
+ struct berval **vals;
};
-
static Lisp_Object
ldap_search_unwind (Lisp_Object unwind_obj)
{
if (unwind->res)
ldap_msgfree (unwind->res);
if (unwind->vals)
- ldap_value_free (unwind->vals);
+ ldap_value_free_len (unwind->vals);
return Qnil;
}
-DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /*
+/* The following function is called `ldap-search-basic' instead of */
+/* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */
+/* API where `ldap-search' was the name of the high-level search */
+/* function */
+
+DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
Perform a search on an open LDAP connection.
LDAP is an LDAP connection object created with `ldap-open'.
FILTER is a filter string for the search as described in RFC 1558.
for each matching entry. If nil return all available attributes.
If ATTRSONLY is non-nil then only the attributes are retrieved, not
the associated values.
+If WITHDN is non-nil each entry in the result will be prepended with
+its distinguished name DN.
+If VERBOSE is non-nil progress messages will be echoed.
The function returns a list of matching entries. Each entry is itself
-an alist of attribute/values.
+an alist of attribute/value pairs optionally preceded by the DN of the
+entry according to the value of WITHDN.
*/
- (ldap, filter, base, scope, attrs, attrsonly))
+ (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
{
/* This function can GC */
LDAP *ld;
LDAPMessage *e;
BerElement *ptr;
- char *a;
+ char *a, *dn;
int i, rc;
int matches;
struct ldap_unwind_struct unwind;
int speccount = specpdl_depth ();
- Lisp_Object list, entry, result;
+ Lisp_Object list = Qnil;
+ Lisp_Object entry = Qnil;
+ Lisp_Object result = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
- list = entry = result = Qnil;
GCPRO3 (list, entry, result);
unwind.res = NULL;
{
Lisp_Object current = XCAR (attrs);
CHECK_STRING (current);
- ldap_attributes[i] =
- alloca_array (char, 1 + XSTRING_LENGTH (current));
- /* XSTRING_LENGTH is increased by one in order to copy the final 0 */
- memcpy (ldap_attributes[i],
- XSTRING_DATA (current), 1 + XSTRING_LENGTH (current));
+ LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative);
++i;
}
ldap_attributes[i] = NULL;
/* Perform the search */
if (ldap_search (ld,
- NILP (base) ? "" : (char *) XSTRING_DATA (base),
+ NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base),
ldap_scope,
- NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
+ NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter),
ldap_attributes,
NILP (attrsonly) ? 0 : 1)
- == -1)
+ == -1)
{
- signal_ldap_error (ld);
+ signal_ldap_error (ld, NULL, 0);
}
/* Ensure we don't exit without cleaning up */
/* Build the results list */
matches = 0;
- /* ldap_result calls select() and can get wedged by EINTR signals */
- slow_down_interrupts ();
rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
- speed_up_interrupts ();
+
while (rc == LDAP_RES_SEARCH_ENTRY)
{
QUIT;
destroys the current echo area contents, even when invoked
from Lisp. It should use echo_area_message() instead, and
restore the old echo area contents later. */
- message ("Parsing ldap results... %d", matches);
+ if (! NILP (verbose))
+ message ("Parsing ldap results... %d", matches);
entry = Qnil;
+ /* Get the DN if required */
+ if (! NILP (withdn))
+ {
+ dn = ldap_get_dn (ld, e);
+ if (dn == NULL)
+ signal_ldap_error (ld, e, 0);
+ entry = Fcons (build_ext_string (dn, Qnative), Qnil);
+ }
for (a= ldap_first_attribute (ld, e, &ptr);
a != NULL;
- a= ldap_next_attribute (ld, e, ptr) )
+ a = ldap_next_attribute (ld, e, ptr) )
{
- list = Fcons (build_ext_string (a, FORMAT_OS), Qnil);
- unwind.vals = ldap_get_values (ld, e, a);
+ list = Fcons (build_ext_string (a, Qnative), Qnil);
+ unwind.vals = ldap_get_values_len (ld, e, a);
if (unwind.vals != NULL)
{
for (i = 0; unwind.vals[i] != NULL; i++)
{
- list = Fcons (build_ext_string (unwind.vals[i], FORMAT_OS),
+ list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val,
+ unwind.vals[i]->bv_len,
+ Qnative),
list);
}
}
entry = Fcons (Fnreverse (list),
entry);
- ldap_value_free (unwind.vals);
+ ldap_value_free_len (unwind.vals);
unwind.vals = NULL;
}
result = Fcons (Fnreverse (entry),
ldap_msgfree (unwind.res);
unwind.res = NULL;
- slow_down_interrupts ();
rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
- speed_up_interrupts ();
}
+#if defined HAVE_LDAP_PARSE_RESULT
+ {
+ int rc2 = ldap_parse_result (ld, unwind.res,
+ &rc,
+ NULL, NULL, NULL, NULL, 0);
+ if (rc2 != LDAP_SUCCESS)
+ rc = rc2;
+ }
+#else
+ if (rc == 0)
+ signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
+
if (rc == -1)
- {
- signal_ldap_error (ld);
- }
+ signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0);
+
+#if defined HAVE_LDAP_RESULT2ERROR
rc = ldap_result2error (ld, unwind.res, 0);
- if ((rc != LDAP_SUCCESS) &&
- (rc != LDAP_SIZELIMIT_EXCEEDED))
- {
- signal_ldap_error (ld);
- }
+#endif
+#endif
+
+ if (rc != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, rc);
ldap_msgfree (unwind.res);
unwind.res = (LDAPMessage *)NULL;
+
/* #### See above for calling message(). */
- message ("Parsing ldap results... done");
+ if (! NILP (verbose))
+ message ("Parsing ldap results... done");
unbind_to (speccount, Qnil);
UNGCPRO;
return Fnreverse (result);
}
+DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
+Add an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to add.
+ENTRY is an entry specification, i.e., a list of cons cells
+containing attribute/value string pairs.
+*/
+ (ldap, dn, entry))
+{
+ LDAP *ld;
+ LDAPMod *ldap_mods, **ldap_mods_ptrs;
+ struct berval *bervals;
+ int rc;
+ int i, j;
+ size_t len;
+
+ Lisp_Object current = Qnil;
+ Lisp_Object values = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ GCPRO2 (current, values);
+
+ /* Do all the parameter checking */
+ CHECK_LIVE_LDAP (ldap);
+ ld = XLDAP (ldap)->ld;
+
+ /* Check the DN */
+ CHECK_STRING (dn);
+
+ /* Check the entry */
+ CHECK_CONS (entry);
+ if (NILP (entry))
+ signal_simple_error ("Cannot add void entry", entry);
+
+ /* Build the ldap_mods array */
+ len = XINT (Flength (entry));
+ ldap_mods = alloca_array (LDAPMod, len);
+ ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+ i = 0;
+ EXTERNAL_LIST_LOOP (entry, entry)
+ {
+ current = XCAR (entry);
+ CHECK_CONS (current);
+ CHECK_STRING (XCAR (current));
+ ldap_mods_ptrs[i] = &(ldap_mods[i]);
+ LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
+ ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
+ values = XCDR (current);
+ if (CONSP (values))
+ {
+ len = XINT (Flength (values));
+ bervals = alloca_array (struct berval, len);
+ ldap_mods[i].mod_vals.modv_bvals =
+ alloca_array (struct berval *, 1 + len);
+ j = 0;
+ EXTERNAL_LIST_LOOP (values, values)
+ {
+ current = XCAR (values);
+ CHECK_STRING (current);
+ ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+ TO_EXTERNAL_FORMAT (LISP_STRING, current,
+ ALLOCA, (bervals[j].bv_val,
+ bervals[j].bv_len),
+ Qnative);
+ j++;
+ }
+ ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+ }
+ else
+ {
+ CHECK_STRING (values);
+ bervals = alloca_array (struct berval, 1);
+ ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, 2);
+ ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
+ TO_EXTERNAL_FORMAT (LISP_STRING, values,
+ ALLOCA, (bervals[0].bv_val,
+ bervals[0].bv_len),
+ Qnative);
+ ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
+ }
+ i++;
+ }
+ ldap_mods_ptrs[i] = NULL;
+ rc = ldap_add_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
+ if (rc != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, rc);
+
+ UNGCPRO;
+ return Qnil;
+}
+
+DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
+Add an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to modify.
+MODS is a list of modifications to apply.
+A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
+MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
+MOD-OP is the type of modification, one of the symbols `add', `delete'
+or `replace'. ATTR is the LDAP attribute type to modify.
+*/
+ (ldap, dn, mods))
+{
+ LDAP *ld;
+ LDAPMod *ldap_mods, **ldap_mods_ptrs;
+ struct berval *bervals;
+ int i, j, rc;
+ Lisp_Object mod_op;
+ size_t len;
+
+ Lisp_Object current = Qnil;
+ Lisp_Object values = Qnil;
+ struct gcpro gcpro1, gcpro2;
+
+ /* Do all the parameter checking */
+ CHECK_LIVE_LDAP (ldap);
+ ld = XLDAP (ldap)->ld;
+
+ /* Check the DN */
+ CHECK_STRING (dn);
+
+ /* Check the entry */
+ CHECK_CONS (mods);
+ if (NILP (mods))
+ return Qnil;
+
+ /* Build the ldap_mods array */
+ len = XINT (Flength (mods));
+ ldap_mods = alloca_array (LDAPMod, len);
+ ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+ i = 0;
+
+ GCPRO2 (current, values);
+ EXTERNAL_LIST_LOOP (mods, mods)
+ {
+ current = XCAR (mods);
+ CHECK_CONS (current);
+ CHECK_SYMBOL (XCAR (current));
+ mod_op = XCAR (current);
+ ldap_mods_ptrs[i] = &(ldap_mods[i]);
+ ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
+ if (EQ (mod_op, Qadd))
+ ldap_mods[i].mod_op |= LDAP_MOD_ADD;
+ else if (EQ (mod_op, Qdelete))
+ ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
+ else if (EQ (mod_op, Qreplace))
+ ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
+ else
+ signal_simple_error ("Invalid LDAP modification type", mod_op);
+ current = XCDR (current);
+ CHECK_STRING (XCAR (current));
+ LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
+ values = XCDR (current);
+ len = XINT (Flength (values));
+ bervals = alloca_array (struct berval, len);
+ ldap_mods[i].mod_vals.modv_bvals =
+ alloca_array (struct berval *, 1 + len);
+ j = 0;
+ EXTERNAL_LIST_LOOP (values, values)
+ {
+ current = XCAR (values);
+ CHECK_STRING (current);
+ ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+ TO_EXTERNAL_FORMAT (LISP_STRING, current,
+ ALLOCA, (bervals[j].bv_val,
+ bervals[j].bv_len),
+ Qnative);
+ j++;
+ }
+ ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+ i++;
+ }
+ ldap_mods_ptrs[i] = NULL;
+ rc = ldap_modify_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
+ if (rc != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, rc);
+
+ UNGCPRO;
+ return Qnil;
+}
+
+
+DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
+Delete an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to delete.
+*/
+ (ldap, dn))
+{
+ LDAP *ld;
+ int rc;
+
+ /* Check parameters */
+ CHECK_LIVE_LDAP (ldap);
+ ld = XLDAP (ldap)->ld;
+ CHECK_STRING (dn);
+
+ rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn));
+ if (rc != LDAP_SUCCESS)
+ signal_ldap_error (ld, NULL, rc);
+
+ return Qnil;
+}
void
syms_of_eldap (void)
{
+ INIT_LRECORD_IMPLEMENTATION (ldap);
+
defsymbol (&Qldapp, "ldapp");
+ defsymbol (&Qport, "port");
+ defsymbol (&Qauth, "auth");
+ defsymbol (&Qbinddn, "binddn");
+ defsymbol (&Qpasswd, "passwd");
+ defsymbol (&Qderef, "deref");
+ defsymbol (&Qtimelimit, "timelimit");
+ defsymbol (&Qsizelimit, "sizelimit");
+ defsymbol (&Qbase, "base");
+ defsymbol (&Qonelevel, "onelevel");
+ defsymbol (&Qsubtree, "subtree");
+ defsymbol (&Qkrbv41, "krbv41");
+ defsymbol (&Qkrbv42, "krbv42");
+ defsymbol (&Qnever, "never");
+ defsymbol (&Qalways, "always");
+ defsymbol (&Qfind, "find");
+ defsymbol (&Qadd, "add");
+ defsymbol (&Qreplace, "replace");
+
DEFSUBR (Fldapp);
DEFSUBR (Fldap_host);
DEFSUBR (Fldap_status);
DEFSUBR (Fldap_open);
DEFSUBR (Fldap_close);
- DEFSUBR (Fldap_search_internal);
+ DEFSUBR (Fldap_search_basic);
+ DEFSUBR (Fldap_add);
+ DEFSUBR (Fldap_modify);
+ DEFSUBR (Fldap_delete);
}
void
vars_of_eldap (void)
{
- Fprovide (intern ("ldap"));
ldap_default_port = LDAP_PORT;
Vldap_default_base = Qnil;