X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Feldap.c;h=16756e5749f3eacfc004c2f24b5581f02cd0fe1f;hp=a0dd5f726bb32b533b92e9a2997068aba45a7fa4;hb=9f7e1f8c96cb936ba2e2cb5db1185f9bc18c42cf;hpb=ea1ea793fe6e244ef5555ed983423a204101af13 diff --git a/src/eldap.c b/src/eldap.c index a0dd5f7..16756e5 100644 --- a/src/eldap.c +++ b/src/eldap.c @@ -40,7 +40,7 @@ Boston, MA 02111-1307, USA. */ #include "eldap.h" -static int ldap_default_port; +static Fixnum ldap_default_port; static Lisp_Object Vldap_default_base; /* Needed by the lrecord definition */ @@ -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 */ @@ -89,7 +92,7 @@ signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err) /************************************************************************/ static Lisp_Object -make_ldap (struct Lisp_LDAP *ldap) +make_ldap (Lisp_LDAP *ldap) { Lisp_Object lisp_ldap; XSETLDAP (lisp_ldap, ldap); @@ -107,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 #", @@ -117,15 +120,14 @@ print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) print_internal (ldap->host, printcharfun, 1); 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; @@ -135,7 +137,7 @@ allocate_ldap (void) 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", @@ -148,7 +150,7 @@ finalize_ldap (void *header, int for_disksave) DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap, mark_ldap, print_ldap, finalize_ldap, - NULL, NULL, 0, struct Lisp_LDAP); + NULL, NULL, 0, Lisp_LDAP); @@ -205,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; @@ -216,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) { @@ -291,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 ) @@ -313,6 +315,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; @@ -322,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))); @@ -346,7 +350,7 @@ Close an LDAP connection. */ (ldap)) { - struct Lisp_LDAP *lldap; + Lisp_LDAP *lldap; CHECK_LIVE_LDAP (ldap); lldap = XLDAP (ldap); ldap_unbind (lldap->ld); @@ -365,7 +369,6 @@ struct ldap_unwind_struct struct berval **vals; }; - static Lisp_Object ldap_search_unwind (Lisp_Object unwind_obj) { @@ -378,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. @@ -389,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 */ @@ -404,7 +413,7 @@ entry according to the value of WITHDN. LDAPMessage *e; BerElement *ptr; char *a, *dn; - int i, rc, rc2; + int i, rc; int matches; struct ldap_unwind_struct unwind; @@ -413,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; @@ -463,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; @@ -474,9 +484,9 @@ 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) @@ -491,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; @@ -504,7 +512,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)) @@ -512,21 +521,21 @@ entry according to the value of WITHDN. dn = ldap_get_dn (ld, e); if (dn == NULL) signal_ldap_error (ld, e, 0); - entry = Fcons (build_ext_string (dn, FORMAT_OS), Qnil); + 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); } } @@ -540,43 +549,253 @@ 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 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 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 + 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; + 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"); @@ -593,13 +812,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