Mercurial > hg > xemacs-beta

comparison src/eldap.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
52 static Lisp_Object Qbase, Qonelevel, Qsubtree; 52 static Lisp_Object Qbase, Qonelevel, Qsubtree;
53 /* Authentication methods */ 53 /* Authentication methods */
54 static Lisp_Object Qkrbv41, Qkrbv42; 54 static Lisp_Object Qkrbv41, Qkrbv42;
55 /* Deref policy */ 55 /* Deref policy */
56 static Lisp_Object Qnever, Qalways, Qfind; 56 static Lisp_Object Qnever, Qalways, Qfind;
57 /* Modification types (Qdelete is defined in general.c) */
58 static Lisp_Object Qadd, Qreplace;
59
57 60
58 /************************************************************************/ 61 /************************************************************************/
59 /* Utility Functions */ 62 /* Utility Functions */
60 /************************************************************************/ 63 /************************************************************************/
61 64
213 int ldap_deref = LDAP_DEREF_NEVER; 216 int ldap_deref = LDAP_DEREF_NEVER;
214 int ldap_timelimit = 0; 217 int ldap_timelimit = 0;
215 int ldap_sizelimit = 0; 218 int ldap_sizelimit = 0;
216 int err; 219 int err;
217 220
218 Lisp_Object list, keyword, value;
219
220 CHECK_STRING (host); 221 CHECK_STRING (host);
221 222
222 EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist) 223 {
223 { 224 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
224 /* TCP Port */ 225 {
225 if (EQ (keyword, Qport)) 226 /* TCP Port */
226 { 227 if (EQ (keyword, Qport))
227 CHECK_INT (value); 228 {
228 ldap_port = XINT (value); 229 CHECK_INT (value);
229 } 230 ldap_port = XINT (value);
230 /* Authentication method */ 231 }
231 if (EQ (keyword, Qauth)) 232 /* Authentication method */
232 { 233 if (EQ (keyword, Qauth))
233 if (EQ (value, Qsimple)) 234 {
234 ldap_auth = LDAP_AUTH_SIMPLE; 235 if (EQ (value, Qsimple))
236 ldap_auth = LDAP_AUTH_SIMPLE;
235 #ifdef LDAP_AUTH_KRBV41 237 #ifdef LDAP_AUTH_KRBV41
236 else if (EQ (value, Qkrbv41)) 238 else if (EQ (value, Qkrbv41))
237 ldap_auth = LDAP_AUTH_KRBV41; 239 ldap_auth = LDAP_AUTH_KRBV41;
238 #endif 240 #endif
239 #ifdef LDAP_AUTH_KRBV42 241 #ifdef LDAP_AUTH_KRBV42
240 else if (EQ (value, Qkrbv42)) 242 else if (EQ (value, Qkrbv42))
241 ldap_auth = LDAP_AUTH_KRBV42; 243 ldap_auth = LDAP_AUTH_KRBV42;
242 #endif 244 #endif
243 else 245 else
244 signal_simple_error ("Invalid authentication method", value); 246 signal_simple_error ("Invalid authentication method", value);
245 } 247 }
246 /* Bind DN */ 248 /* Bind DN */
247 else if (EQ (keyword, Qbinddn)) 249 else if (EQ (keyword, Qbinddn))
248 { 250 {
249 CHECK_STRING (value); 251 CHECK_STRING (value);
250 TO_EXTERNAL_FORMAT (LISP_STRING, value, 252 LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative);
251 C_STRING_ALLOCA, ldap_binddn, 253 }
252 Qnative); 254 /* Password */
253 } 255 else if (EQ (keyword, Qpasswd))
254 /* Password */ 256 {
255 else if (EQ (keyword, Qpasswd)) 257 CHECK_STRING (value);
256 { 258 LISP_STRING_TO_EXTERNAL (value, ldap_passwd, Qnative);
257 CHECK_STRING (value); 259 }
258 TO_EXTERNAL_FORMAT (LISP_STRING, value, 260 /* Deref */
259 C_STRING_ALLOCA, ldap_passwd, 261 else if (EQ (keyword, Qderef))
260 Qnative); 262 {
261 } 263 if (EQ (value, Qnever))
262 /* Deref */ 264 ldap_deref = LDAP_DEREF_NEVER;
263 else if (EQ (keyword, Qderef)) 265 else if (EQ (value, Qsearch))
264 { 266 ldap_deref = LDAP_DEREF_SEARCHING;
265 if (EQ (value, Qnever)) 267 else if (EQ (value, Qfind))
266 ldap_deref = LDAP_DEREF_NEVER; 268 ldap_deref = LDAP_DEREF_FINDING;
267 else if (EQ (value, Qsearch)) 269 else if (EQ (value, Qalways))
268 ldap_deref = LDAP_DEREF_SEARCHING; 270 ldap_deref = LDAP_DEREF_ALWAYS;
269 else if (EQ (value, Qfind)) 271 else
270 ldap_deref = LDAP_DEREF_FINDING; 272 signal_simple_error ("Invalid deref value", value);
271 else if (EQ (value, Qalways)) 273 }
272 ldap_deref = LDAP_DEREF_ALWAYS; 274 /* Timelimit */
273 else 275 else if (EQ (keyword, Qtimelimit))
274 signal_simple_error ("Invalid deref value", value); 276 {
275 } 277 CHECK_INT (value);
276 /* Timelimit */ 278 ldap_timelimit = XINT (value);
277 else if (EQ (keyword, Qtimelimit)) 279 }
278 { 280 /* Sizelimit */
279 CHECK_INT (value); 281 else if (EQ (keyword, Qsizelimit))
280 ldap_timelimit = XINT (value); 282 {
281 } 283 CHECK_INT (value);
282 /* Sizelimit */ 284 ldap_sizelimit = XINT (value);
283 else if (EQ (keyword, Qsizelimit)) 285 }
284 { 286 }
285 CHECK_INT (value); 287 }
286 ldap_sizelimit = XINT (value);
287 }
288 }
289 288
290 if (ldap_port == 0) 289 if (ldap_port == 0)
291 { 290 {
292 ldap_port = ldap_default_port; 291 ldap_port = ldap_default_port;
293 } 292 }
294 293
295 /* Connect to the server and bind */ 294 /* Connect to the server and bind */
296 slow_down_interrupts (); 295 slow_down_interrupts ();
297 ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port); 296 ld = ldap_open ((char *) XSTRING_DATA (host), ldap_port);
298 speed_up_interrupts (); 297 speed_up_interrupts ();
299 298
300 if (ld == NULL ) 299 if (ld == NULL )
301 signal_simple_error_2 ("Failed connecting to host", 300 signal_simple_error_2 ("Failed connecting to host",
302 host, 301 host,
314 (void *)&ldap_sizelimit)) != LDAP_SUCCESS) 313 (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
315 signal_ldap_error (ld, NULL, err); 314 signal_ldap_error (ld, NULL, err);
316 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS, 315 if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
317 LDAP_OPT_ON)) != LDAP_SUCCESS) 316 LDAP_OPT_ON)) != LDAP_SUCCESS)
318 signal_ldap_error (ld, NULL, err); 317 signal_ldap_error (ld, NULL, err);
318 if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
319 LDAP_OPT_ON)) != LDAP_SUCCESS)
320 signal_ldap_error (ld, NULL, err);
319 #else /* not HAVE_LDAP_SET_OPTION */ 321 #else /* not HAVE_LDAP_SET_OPTION */
320 ld->ld_deref = ldap_deref; 322 ld->ld_deref = ldap_deref;
321 ld->ld_timelimit = ldap_timelimit; 323 ld->ld_timelimit = ldap_timelimit;
322 ld->ld_sizelimit = ldap_sizelimit; 324 ld->ld_sizelimit = ldap_sizelimit;
323 #ifdef LDAP_REFERRALS 325 #ifdef LDAP_REFERRALS
324 ld->ld_options = LDAP_OPT_REFERRALS; 326 ld->ld_options = LDAP_OPT_REFERRALS;
325 #else /* not LDAP_REFERRALS */ 327 #else /* not LDAP_REFERRALS */
326 ld->ld_options = 0; 328 ld->ld_options = 0;
327 #endif /* not LDAP_REFERRALS */ 329 #endif /* not LDAP_REFERRALS */
330 /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
331 ld->ld_options |= LDAP_OPT_RESTART;
328 #endif /* not HAVE_LDAP_SET_OPTION */ 332 #endif /* not HAVE_LDAP_SET_OPTION */
329 333
330 /* ldap_bind_s calls select and may be wedged by SIGIO. */
331 slow_down_interrupts ();
332 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth); 334 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
333 speed_up_interrupts ();
334 if (err != LDAP_SUCCESS) 335 if (err != LDAP_SUCCESS)
335 signal_simple_error ("Failed binding to the server", 336 signal_simple_error ("Failed binding to the server",
336 build_string (ldap_err2string (err))); 337 build_string (ldap_err2string (err)));
337 338
338 ldap = allocate_ldap (); 339 ldap = allocate_ldap ();
365 struct ldap_unwind_struct 366 struct ldap_unwind_struct
366 { 367 {
367 LDAPMessage *res; 368 LDAPMessage *res;
368 struct berval **vals; 369 struct berval **vals;
369 }; 370 };
370
371 371
372 static Lisp_Object 372 static Lisp_Object
373 ldap_search_unwind (Lisp_Object unwind_obj) 373 ldap_search_unwind (Lisp_Object unwind_obj)
374 { 374 {
375 struct ldap_unwind_struct *unwind = 375 struct ldap_unwind_struct *unwind =
379 if (unwind->vals) 379 if (unwind->vals)
380 ldap_value_free_len (unwind->vals); 380 ldap_value_free_len (unwind->vals);
381 return Qnil; 381 return Qnil;
382 } 382 }
383 383
384 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 0, /* 384 /* The following function is called `ldap-search-basic' instead of */
385 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1 */
386 /* API where `ldap-search' was the name of the high-level search */
387 /* function */
388
389 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
385 Perform a search on an open LDAP connection. 390 Perform a search on an open LDAP connection.
386 LDAP is an LDAP connection object created with `ldap-open'. 391 LDAP is an LDAP connection object created with `ldap-open'.
387 FILTER is a filter string for the search as described in RFC 1558. 392 FILTER is a filter string for the search as described in RFC 1558.
388 BASE is the distinguished name at which to start the search. 393 BASE is the distinguished name at which to start the search.
389 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating 394 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
390 the scope of the search. 395 the scope of the search.
391 ATTRS is a list of strings indicating which attributes to retrieve 396 ATTRS is a list of strings indicating which attributes to retrieve
392 for each matching entry. If nil return all available attributes. 397 for each matching entry. If nil return all available attributes.
393 If ATTRSONLY is non-nil then only the attributes are retrieved, not 398 If ATTRSONLY is non-nil then only the attributes are retrieved, not
394 the associated values. 399 the associated values.
395 If WITHDN is non-nil each entry in the result will be prepennded with 400 If WITHDN is non-nil each entry in the result will be prepended with
396 its distinguished name DN. 401 its distinguished name DN.
402 If VERBOSE is non-nil progress messages will be echoed.
397 The function returns a list of matching entries. Each entry is itself 403 The function returns a list of matching entries. Each entry is itself
398 an alist of attribute/value pairs optionally preceded by the DN of the 404 an alist of attribute/value pairs optionally preceded by the DN of the
399 entry according to the value of WITHDN. 405 entry according to the value of WITHDN.
400 */ 406 */
401 (ldap, filter, base, scope, attrs, attrsonly, withdn)) 407 (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
402 { 408 {
403 /* This function can GC */ 409 /* This function can GC */
404 410
405 /* Vars for query */ 411 /* Vars for query */
406 LDAP *ld; 412 LDAP *ld;
407 LDAPMessage *e; 413 LDAPMessage *e;
408 BerElement *ptr; 414 BerElement *ptr;
409 char *a, *dn; 415 char *a, *dn;
410 int i, rc, rc2; 416 int i, rc;
411 int matches; 417 int matches;
412 struct ldap_unwind_struct unwind; 418 struct ldap_unwind_struct unwind;
413 419
414 int ldap_scope = LDAP_SCOPE_SUBTREE; 420 int ldap_scope = LDAP_SCOPE_SUBTREE;
415 char **ldap_attributes = NULL; 421 char **ldap_attributes = NULL;
416 422
417 int speccount = specpdl_depth (); 423 int speccount = specpdl_depth ();
418 424
419 Lisp_Object list, entry, result; 425 Lisp_Object list = Qnil;
426 Lisp_Object entry = Qnil;
427 Lisp_Object result = Qnil;
420 struct gcpro gcpro1, gcpro2, gcpro3; 428 struct gcpro gcpro1, gcpro2, gcpro3;
421 429
422 list = entry = result = Qnil;
423 GCPRO3 (list, entry, result); 430 GCPRO3 (list, entry, result);
424 431
425 unwind.res = NULL; 432 unwind.res = NULL;
426 unwind.vals = NULL; 433 unwind.vals = NULL;
427 434
464 i = 0; 471 i = 0;
465 EXTERNAL_LIST_LOOP (attrs, attrs) 472 EXTERNAL_LIST_LOOP (attrs, attrs)
466 { 473 {
467 Lisp_Object current = XCAR (attrs); 474 Lisp_Object current = XCAR (attrs);
468 CHECK_STRING (current); 475 CHECK_STRING (current);
469 TO_EXTERNAL_FORMAT (LISP_STRING, current, 476 LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative);
470 C_STRING_ALLOCA, ldap_attributes[i],
471 Qnative);
472 ++i; 477 ++i;
473 } 478 }
474 ldap_attributes[i] = NULL; 479 ldap_attributes[i] = NULL;
475 } 480 }
476 481
477 /* Attributes only ? */ 482 /* Attributes only ? */
478 CHECK_SYMBOL (attrsonly); 483 CHECK_SYMBOL (attrsonly);
479 484
480 /* Perform the search */ 485 /* Perform the search */
481 if (ldap_search (ld, 486 if (ldap_search (ld,
482 NILP (base) ? "" : (char *) XSTRING_DATA (base), 487 NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base),
483 ldap_scope, 488 ldap_scope,
484 NILP (filter) ? "" : (char *) XSTRING_DATA (filter), 489 NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter),
485 ldap_attributes, 490 ldap_attributes,
486 NILP (attrsonly) ? 0 : 1) 491 NILP (attrsonly) ? 0 : 1)
487 == -1) 492 == -1)
488 { 493 {
489 signal_ldap_error (ld, NULL, 0); 494 signal_ldap_error (ld, NULL, 0);
494 make_opaque_ptr (&unwind)); 499 make_opaque_ptr (&unwind));
495 500
496 /* Build the results list */ 501 /* Build the results list */
497 matches = 0; 502 matches = 0;
498 503
499 /* ldap_result calls select() and can get wedged by EINTR signals */
500 slow_down_interrupts ();
501 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res); 504 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
502 speed_up_interrupts (); 505
503 while (rc == LDAP_RES_SEARCH_ENTRY) 506 while (rc == LDAP_RES_SEARCH_ENTRY)
504 { 507 {
505 QUIT; 508 QUIT;
506 matches ++; 509 matches ++;
507 e = ldap_first_entry (ld, unwind.res); 510 e = ldap_first_entry (ld, unwind.res);
508 /* #### This call to message() is pretty fascist, because it 511 /* #### This call to message() is pretty fascist, because it
509 destroys the current echo area contents, even when invoked 512 destroys the current echo area contents, even when invoked
510 from Lisp. It should use echo_area_message() instead, and 513 from Lisp. It should use echo_area_message() instead, and
511 restore the old echo area contents later. */ 514 restore the old echo area contents later. */
512 message ("Parsing ldap results... %d", matches); 515 if (! NILP (verbose))
516 message ("Parsing ldap results... %d", matches);
513 entry = Qnil; 517 entry = Qnil;
514 /* Get the DN if required */ 518 /* Get the DN if required */
515 if (! NILP (withdn)) 519 if (! NILP (withdn))
516 { 520 {
517 dn = ldap_get_dn (ld, e); 521 dn = ldap_get_dn (ld, e);
527 unwind.vals = ldap_get_values_len (ld, e, a); 531 unwind.vals = ldap_get_values_len (ld, e, a);
528 if (unwind.vals != NULL) 532 if (unwind.vals != NULL)
529 { 533 {
530 for (i = 0; unwind.vals[i] != NULL; i++) 534 for (i = 0; unwind.vals[i] != NULL; i++)
531 { 535 {
532 list = Fcons (make_ext_string (unwind.vals[i]->bv_val, 536 list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val,
533 unwind.vals[i]->bv_len, 537 unwind.vals[i]->bv_len,
534 Qnative), 538 Qnative),
535 list); 539 list);
536 } 540 }
537 } 541 }
543 result = Fcons (Fnreverse (entry), 547 result = Fcons (Fnreverse (entry),
544 result); 548 result);
545 ldap_msgfree (unwind.res); 549 ldap_msgfree (unwind.res);
546 unwind.res = NULL; 550 unwind.res = NULL;
547 551
548 slow_down_interrupts ();
549 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res)); 552 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
550 speed_up_interrupts (); 553 }
551 } 554
552 555 #if defined HAVE_LDAP_PARSE_RESULT
553 if (rc == -1) 556 {
554 signal_ldap_error (ld, unwind.res, 0); 557 int rc2 = ldap_parse_result (ld, unwind.res,
555 558 &rc,
559 NULL, NULL, NULL, NULL, 0);
560 if (rc2 != LDAP_SUCCESS)
561 rc = rc2;
562 }
563 #else
556 if (rc == 0) 564 if (rc == 0)
557 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED); 565 signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
558 566
559 #if defined HAVE_LDAP_PARSE_RESULT 567 if (rc == -1)
560 rc2 = ldap_parse_result (ld, unwind.res, 568 signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0);
561 &rc, 569
562 NULL, NULL, NULL, NULL, 0); 570 #if defined HAVE_LDAP_RESULT2ERROR
563 if (rc2 != LDAP_SUCCESS)
564 rc = rc2;
565 #elif defined HAVE_LDAP_RESULT2ERROR
566 rc = ldap_result2error (ld, unwind.res, 0); 571 rc = ldap_result2error (ld, unwind.res, 0);
567 #endif 572 #endif
568 if ((rc != LDAP_SUCCESS) && (rc != LDAP_SIZELIMIT_EXCEEDED)) 573 #endif
574
575 if (rc != LDAP_SUCCESS)
569 signal_ldap_error (ld, NULL, rc); 576 signal_ldap_error (ld, NULL, rc);
570 577
571 ldap_msgfree (unwind.res); 578 ldap_msgfree (unwind.res);
572 unwind.res = (LDAPMessage *)NULL; 579 unwind.res = (LDAPMessage *)NULL;
580
573 /* #### See above for calling message(). */ 581 /* #### See above for calling message(). */
574 message ("Parsing ldap results... done"); 582 if (! NILP (verbose))
583 message ("Parsing ldap results... done");
575 584
576 unbind_to (speccount, Qnil); 585 unbind_to (speccount, Qnil);
577 UNGCPRO; 586 UNGCPRO;
578 return Fnreverse (result); 587 return Fnreverse (result);
579 } 588 }
580 589
590 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
591 Add an entry to an LDAP directory.
592 LDAP is an LDAP connection object created with `ldap-open'.
593 DN is the distinguished name of the entry to add.
594 ENTRY is an entry specification, i.e., a list of cons cells
595 containing attribute/value string pairs.
596 */
597 (ldap, dn, entry))
598 {
599 LDAP *ld;
600 LDAPMod *ldap_mods, **ldap_mods_ptrs;
601 struct berval *bervals;
602 int rc;
603 int i, j;
604 size_t len;
605
606 Lisp_Object current = Qnil;
607 Lisp_Object values = Qnil;
608 struct gcpro gcpro1, gcpro2;
609
610 GCPRO2 (current, values);
611
612 /* Do all the parameter checking */
613 CHECK_LIVE_LDAP (ldap);
614 ld = XLDAP (ldap)->ld;
615
616 /* Check the DN */
617 CHECK_STRING (dn);
618
619 /* Check the entry */
620 CHECK_CONS (entry);
621 if (NILP (entry))
622 signal_simple_error ("Cannot add void entry", entry);
623
624 /* Build the ldap_mods array */
625 len = XINT (Flength (entry));
626 ldap_mods = alloca_array (LDAPMod, len);
627 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
628 i = 0;
629 EXTERNAL_LIST_LOOP (entry, entry)
630 {
631 current = XCAR (entry);
632 CHECK_CONS (current);
633 CHECK_STRING (XCAR (current));
634 ldap_mods_ptrs[i] = &(ldap_mods[i]);
635 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
636 ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
637 values = XCDR (current);
638 if (CONSP (values))
639 {
640 len = XINT (Flength (values));
641 bervals = alloca_array (struct berval, len);
642 ldap_mods[i].mod_vals.modv_bvals =
643 alloca_array (struct berval *, 1 + len);
644 j = 0;
645 EXTERNAL_LIST_LOOP (values, values)
646 {
647 current = XCAR (values);
648 CHECK_STRING (current);
649 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
650 TO_EXTERNAL_FORMAT (LISP_STRING, current,
651 ALLOCA, (bervals[j].bv_val,
652 bervals[j].bv_len),
653 Qnative);
654 j++;
655 }
656 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
657 }
658 else
659 {
660 CHECK_STRING (values);
661 bervals = alloca_array (struct berval, 1);
662 ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, 2);
663 ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
664 TO_EXTERNAL_FORMAT (LISP_STRING, values,
665 ALLOCA, (bervals[0].bv_val,
666 bervals[0].bv_len),
667 Qnative);
668 ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
669 }
670 i++;
671 }
672 ldap_mods_ptrs[i] = NULL;
673 rc = ldap_add_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
674 if (rc != LDAP_SUCCESS)
675 signal_ldap_error (ld, NULL, rc);
676
677 UNGCPRO;
678 return Qnil;
679 }
680
681 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
682 Add an entry to an LDAP directory.
683 LDAP is an LDAP connection object created with `ldap-open'.
684 DN is the distinguished name of the entry to modify.
685 MODS is a list of modifications to apply.
686 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
687 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
688 MOD-OP is the type of modification, one of the symbols `add', `delete'
689 or `replace'. ATTR is the LDAP attribute type to modify.
690 */
691 (ldap, dn, mods))
692 {
693 LDAP *ld;
694 LDAPMod *ldap_mods, **ldap_mods_ptrs;
695 struct berval *bervals;
696 int i, j, rc;
697 Lisp_Object mod_op;
698 size_t len;
699
700 Lisp_Object current = Qnil;
701 Lisp_Object values = Qnil;
702 struct gcpro gcpro1, gcpro2;
703
704 GCPRO2 (current, values);
705
706 /* Do all the parameter checking */
707 CHECK_LIVE_LDAP (ldap);
708 ld = XLDAP (ldap)->ld;
709
710 /* Check the DN */
711 CHECK_STRING (dn);
712
713 /* Check the entry */
714 CHECK_CONS (mods);
715 if (NILP (mods))
716 return Qnil;
717
718 /* Build the ldap_mods array */
719 len = XINT (Flength (mods));
720 ldap_mods = alloca_array (LDAPMod, len);
721 ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
722 i = 0;
723 EXTERNAL_LIST_LOOP (mods, mods)
724 {
725 current = XCAR (mods);
726 CHECK_CONS (current);
727 CHECK_SYMBOL (XCAR (current));
728 mod_op = XCAR (current);
729 ldap_mods_ptrs[i] = &(ldap_mods[i]);
730 ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
731 if (EQ (mod_op, Qadd))
732 ldap_mods[i].mod_op |= LDAP_MOD_ADD;
733 else if (EQ (mod_op, Qdelete))
734 ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
735 else if (EQ (mod_op, Qreplace))
736 ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
737 else
738 signal_simple_error ("Invalid LDAP modification type", mod_op);
739 current = XCDR (current);
740 CHECK_STRING (XCAR (current));
741 LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
742 values = XCDR (current);
743 len = XINT (Flength (values));
744 bervals = alloca_array (struct berval, len);
745 ldap_mods[i].mod_vals.modv_bvals =
746 alloca_array (struct berval *, 1 + len);
747 j = 0;
748 EXTERNAL_LIST_LOOP (values, values)
749 {
750 current = XCAR (values);
751 CHECK_STRING (current);
752 ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
753 TO_EXTERNAL_FORMAT (LISP_STRING, current,
754 ALLOCA, (bervals[j].bv_val,
755 bervals[j].bv_len),
756 Qnative);
757 j++;
758 }
759 ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
760 i++;
761 }
762 ldap_mods_ptrs[i] = NULL;
763 rc = ldap_modify_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
764 if (rc != LDAP_SUCCESS)
765 signal_ldap_error (ld, NULL, rc);
766
767 UNGCPRO;
768 return Qnil;
769 }
770
771
772 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
773 Delete an entry to an LDAP directory.
774 LDAP is an LDAP connection object created with `ldap-open'.
775 DN is the distinguished name of the entry to delete.
776 */
777 (ldap, dn))
778 {
779 LDAP *ld;
780 int rc;
781
782 /* Check parameters */
783 CHECK_LIVE_LDAP (ldap);
784 ld = XLDAP (ldap)->ld;
785 CHECK_STRING (dn);
786
787 rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn));
788 if (rc != LDAP_SUCCESS)
789 signal_ldap_error (ld, NULL, rc);
790
791 return Qnil;
792 }
581 793
582 void 794 void
583 syms_of_eldap (void) 795 syms_of_eldap (void)
584 { 796 {
797 INIT_LRECORD_IMPLEMENTATION (ldap);
798
585 defsymbol (&Qldapp, "ldapp"); 799 defsymbol (&Qldapp, "ldapp");
586 defsymbol (&Qport, "port"); 800 defsymbol (&Qport, "port");
587 defsymbol (&Qauth, "auth"); 801 defsymbol (&Qauth, "auth");
588 defsymbol (&Qbinddn, "binddn"); 802 defsymbol (&Qbinddn, "binddn");
589 defsymbol (&Qpasswd, "passwd"); 803 defsymbol (&Qpasswd, "passwd");
596 defsymbol (&Qkrbv41, "krbv41"); 810 defsymbol (&Qkrbv41, "krbv41");
597 defsymbol (&Qkrbv42, "krbv42"); 811 defsymbol (&Qkrbv42, "krbv42");
598 defsymbol (&Qnever, "never"); 812 defsymbol (&Qnever, "never");
599 defsymbol (&Qalways, "always"); 813 defsymbol (&Qalways, "always");
600 defsymbol (&Qfind, "find"); 814 defsymbol (&Qfind, "find");
815 defsymbol (&Qadd, "add");
816 defsymbol (&Qreplace, "replace");
601 817
602 DEFSUBR (Fldapp); 818 DEFSUBR (Fldapp);
603 DEFSUBR (Fldap_host); 819 DEFSUBR (Fldap_host);
604 DEFSUBR (Fldap_status); 820 DEFSUBR (Fldap_status);
605 DEFSUBR (Fldap_open); 821 DEFSUBR (Fldap_open);
606 DEFSUBR (Fldap_close); 822 DEFSUBR (Fldap_close);
607 DEFSUBR (Fldap_search_internal); 823 DEFSUBR (Fldap_search_basic);
824 DEFSUBR (Fldap_add);
825 DEFSUBR (Fldap_modify);
826 DEFSUBR (Fldap_delete);
608 } 827 }
609 828
610 void 829 void
611 vars_of_eldap (void) 830 vars_of_eldap (void)
612 { 831 {