static Lisp_Object Qkrbv41, Qkrbv42;
/* Deref policy */
static Lisp_Object Qnever, Qalways, Qfind;
+/* Modification types (Qdelete is defined in general.c) */
+static Lisp_Object Qadd, Qreplace;
+
\f
/************************************************************************/
/* Utility Functions */
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)));
struct berval **vals;
};
-
static Lisp_Object
ldap_search_unwind (Lisp_Object unwind_obj)
{
return Qnil;
}
-DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 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 prepennded with
+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/value pairs optionally preceded by the DN of the
entry according to the value of WITHDN.
*/
- (ldap, filter, base, scope, attrs, attrsonly, withdn))
+ (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
{
/* This function can GC */
/* 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))
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 (rc == -1)
- signal_ldap_error (ld, unwind.res, 0);
-
- if (rc == 0)
- signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
-
#if defined HAVE_LDAP_PARSE_RESULT
rc2 = ldap_parse_result (ld, unwind.res,
&rc,
NULL, NULL, NULL, NULL, 0);
if (rc2 != LDAP_SUCCESS)
rc = rc2;
-#elif defined HAVE_LDAP_RESULT2ERROR
+#else
+ if (rc == 0)
+ signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
+
+ if (rc == -1)
+ 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);
#endif
- if ((rc != LDAP_SUCCESS) && (rc != LDAP_SIZELIMIT_EXCEEDED))
+#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;
+
+ Lisp_Object current, values;
+ 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 */
+ ldap_mods = alloca_array (LDAPMod, XINT (Flength (entry)));
+ ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + XINT (Flength (entry)));
+ i = 0;
+ EXTERNAL_LIST_LOOP (entry, entry)
+ {
+ current = XCAR (entry);
+ CHECK_CONS (current);
+ CHECK_STRING (XCAR (current));
+ ldap_mods_ptrs[i] = &(ldap_mods[i]);
+ TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
+ C_STRING_ALLOCA, ldap_mods[i].mod_type,
+ Qnative);
+ ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
+ values = XCDR (current);
+ if (CONSP (values))
+ {
+ bervals =
+ alloca_array (struct berval, XINT (Flength (values)));
+ ldap_mods[i].mod_vals.modv_bvals =
+ alloca_array (struct berval *, 1 + XINT (Flength (values)));
+ 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;
+}
+
+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 current, mod_op, values;
+ 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 (mods);
+ if (NILP (mods))
+ return Qnil;
+
+ /* Build the ldap_mods array */
+ ldap_mods = alloca_array (LDAPMod, XINT (Flength (mods)));
+ ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + XINT (Flength (mods)));
+ i = 0;
+ 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));
+ TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
+ C_STRING_ALLOCA, ldap_mods[i].mod_type,
+ Qnative);
+ values = XCDR (current);
+ bervals = alloca_array (struct berval, XINT (Flength (values)));
+ ldap_mods[i].mod_vals.modv_bvals =
+ alloca_array (struct berval *, 1 + XINT (Flength (values)));
+ 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;
+}
+
+
+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);
+}
void
syms_of_eldap (void)
{
+ INIT_LRECORD_IMPLEMENTATION (ldap);
+
defsymbol (&Qldapp, "ldapp");
defsymbol (&Qport, "port");
defsymbol (&Qauth, "auth");
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
projects / chise / xemacs-chise.git.1 / blobdiff