xemacs-beta: src/eldap.c comparison

comparison src/eldap.c @ 400:a86b2b5e0111 r21-2-30

Import from CVS: tag r21-2-30

author	cvs
date	Mon, 13 Aug 2007 11:14:34 +0200
parents	74fd4e045ea6
children	2f8bb876ab1d

comparison

equal deleted inserted replaced

-:376370fb5946
+:a86b2b5e0111
 static Lisp_Object Qbase, Qonelevel, Qsubtree;
 /* Authentication methods */
 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;
 /************************************************************************/
 /*                         Utility Functions                            */
 /************************************************************************/
 (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;
 ld->ld_sizelimit = ldap_sizelimit;
 #ifdef LDAP_REFERRALS
 ld->ld_options = LDAP_OPT_REFERRALS;
 #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 ();
 struct ldap_unwind_struct
 {
 LDAPMessage *res;
 struct berval **vals;
 };
 static Lisp_Object
 ldap_search_unwind (Lisp_Object unwind_obj)
 {
 struct ldap_unwind_struct *unwind =
 if (unwind->vals)
 ldap_value_free_len (unwind->vals);
 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.
 BASE is the distinguished name at which to start the search.
 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
 the scope of the search.
 ATTRS is a list of strings indicating which attributes to retrieve
 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 */
 /* Vars for query */
 LDAP *ld;
 make_opaque_ptr (&unwind));
 /* 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;
 matches ++;
 e = ldap_first_entry (ld, unwind.res);
 /* #### This call to message() is pretty fascist, because it
 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);
 result = Fcons (Fnreverse (entry),
 result);
 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 (&Qbinddn, "binddn");
 defsymbol (&Qpasswd, "passwd");
 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)
 {

Mercurial > hg > xemacs-beta

comparison src/eldap.c @ 400:a86b2b5e0111 r21-2-30