X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Feldap.c;h=16756e5749f3eacfc004c2f24b5581f02cd0fe1f;hb=57bf633187a745973c8f0e0220e3aad79a83462f;hp=caea909c664b4c06ad1be2b0fa8a18991cd55665;hpb=976b002b16336930724ae22476014583ad022e7d;p=chise%2Fxemacs-chise.git.1 diff --git a/src/eldap.c b/src/eldap.c index caea909..16756e5 100644 --- a/src/eldap.c +++ b/src/eldap.c @@ -26,8 +26,8 @@ Boston, MA 02111-1307, USA. */ conforming to the API defined in RFC 1823. It has been tested with: - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/) - - OpenLDAP 1.0.3 (http://www.openldap.org/) - - 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 @@ -40,45 +40,50 @@ Boston, MA 02111-1307, USA. */ #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 Fixnum ldap_default_port; static Lisp_Object Vldap_default_base; /* Needed by the lrecord definition */ 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; + /************************************************************************/ /* 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))); } @@ -87,7 +92,7 @@ signal_ldap_error (LDAP *ld) /************************************************************************/ static Lisp_Object -make_ldap (struct Lisp_LDAP *ldap) +make_ldap (Lisp_LDAP *ldap) { Lisp_Object lisp_ldap; XSETLDAP (lisp_ldap, ldap); @@ -95,7 +100,7 @@ make_ldap (struct Lisp_LDAP *ldap) } static Lisp_Object -mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_ldap (Lisp_Object obj) { return XLDAP (obj)->host; } @@ -105,7 +110,7 @@ print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { char buf[32]; - struct Lisp_LDAP *ldap = XLDAP (obj); + Lisp_LDAP *ldap = XLDAP (obj); if (print_readably) error ("printing unreadable object #", @@ -113,40 +118,39 @@ print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) write_c_string ("#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); @@ -178,7 +182,7 @@ Return t if LDAP is an active LDAP connection. (ldap)) { CHECK_LDAP (ldap); - return (XLDAP (ldap))->livep ? Qt : Qnil; + return (XLDAP (ldap))->ld ? Qt : Qnil; } /************************************************************************/ @@ -203,7 +207,7 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. (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; @@ -214,73 +218,73 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. 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); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_binddn); - } - /* Password */ - else if (EQ (keyword, Qpasswd)) - { - CHECK_STRING (value); - GET_C_STRING_OS_DATA_ALLOCA (value, ldap_passwd); - } - /* 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) { @@ -289,7 +293,7 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. /* Connect to the server and bind */ slow_down_interrupts (); - ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port); + ld = ldap_open ((char *) XSTRING_DATA (host), ldap_port); speed_up_interrupts (); if (ld == NULL ) @@ -299,16 +303,21 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. #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; @@ -318,12 +327,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))); @@ -331,7 +339,6 @@ the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'. ldap = allocate_ldap (); ldap->ld = ld; ldap->host = host; - ldap->livep = 1; return make_ldap (ldap); } @@ -343,11 +350,11 @@ Close an LDAP connection. */ (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; } @@ -362,7 +369,6 @@ struct ldap_unwind_struct struct berval **vals; }; - static Lisp_Object ldap_search_unwind (Lisp_Object unwind_obj) { @@ -375,7 +381,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. @@ -386,13 +397,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 */ @@ -410,10 +422,11 @@ entry according to the value of WITHDN. 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; @@ -460,7 +473,7 @@ entry according to the value of WITHDN. { Lisp_Object current = XCAR (attrs); CHECK_STRING (current); - GET_C_STRING_OS_DATA_ALLOCA (current, ldap_attributes[i]); + LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative); ++i; } ldap_attributes[i] = NULL; @@ -471,14 +484,14 @@ entry according to the value of WITHDN. /* 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 */ @@ -488,10 +501,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; @@ -501,31 +512,30 @@ 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)) { dn = ldap_get_dn (ld, e); if (dn == NULL) - { - signal_ldap_error (ld); - } - entry = Fcons (build_ext_string (dn, FORMAT_OS), Qnil); + 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) ) { - list = Fcons (build_ext_string (a, FORMAT_OS), Qnil); + 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 (make_ext_string (unwind.vals[i]->bv_val, + list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val, unwind.vals[i]->bv_len, - FORMAT_OS), + Qnative), list); } } @@ -539,43 +549,281 @@ 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 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