X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Feldap.c;h=99c5d537ee960493825b468d761f509d8d767161;hp=1f8e2c7474495f90261b608abf484ecf57ffc757;hb=3890a2e3064a7f562107c58e59d928284ec04741;hpb=a4106e305f464a1d09e395329e2426f7759a4281 diff --git a/src/eldap.c b/src/eldap.c index 1f8e2c7..99c5d53 100644 --- a/src/eldap.c +++ b/src/eldap.c @@ -54,6 +54,9 @@ static Lisp_Object Qbase, Qonelevel, Qsubtree; 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 */ @@ -316,6 +319,9 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. 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; @@ -325,12 +331,11 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. #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))); @@ -368,7 +373,6 @@ struct ldap_unwind_struct struct berval **vals; }; - static Lisp_Object ldap_search_unwind (Lisp_Object unwind_obj) { @@ -381,7 +385,12 @@ 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. @@ -392,13 +401,14 @@ 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 */ @@ -496,10 +506,8 @@ entry according to the value of WITHDN. /* 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; @@ -509,7 +517,8 @@ entry according to the value of WITHDN. 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)) @@ -545,43 +554,242 @@ entry according to the value of 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"); @@ -598,13 +806,18 @@ syms_of_eldap (void) 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