git.chise.org Git - chise/xemacs-chise.git.1/blob - src/eldap.c

   1 /* LDAP client interface for XEmacs.
   2    Copyright (C) 1998 Free Software Foundation, Inc.
   3
   4 This file is part of XEmacs.
   5
   6 XEmacs is free software; you can redistribute it and/or modify it
   7 under the terms of the GNU General Public License as published by the
   8 Free Software Foundation; either version 2, or (at your option) any
   9 later version.
  10
  11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 for more details.
  15
  16 You should have received a copy of the GNU General Public License
  17 along with XEmacs; see the file COPYING.  If not, write to
  18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  19 Boston, MA 02111-1307, USA.  */
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 /* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */
  24
  25 /* This file provides lisp primitives for access to an LDAP library
  26    conforming to the API defined in RFC 1823.
  27    It has been tested with:
  28    - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
  29    - OpenLDAP 1.2 (http://www.openldap.org/)
  30    - Netscape's LDAP SDK (http://developer.netscape.com/) */
  31
  32
  33 #include <config.h>
  34 #include "lisp.h"
  35 #include "opaque.h"
  36 #include "sysdep.h"
  37 #include "buffer.h"
  38
  39 #include <errno.h>
  40
  41 #include "eldap.h"
  42
  43 static int ldap_default_port;
  44 static Lisp_Object Vldap_default_base;
  45
  46 /* Needed by the lrecord definition */
  47 Lisp_Object Qldapp;
  48
  49 /* ldap-open plist keywords */
  50 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
  51 /* Search scope limits */
  52 static Lisp_Object Qbase, Qonelevel, Qsubtree;
  53 /* Authentication methods */
  54 static Lisp_Object Qkrbv41, Qkrbv42;
  55 /* Deref policy */
  56 static Lisp_Object Qnever, Qalways, Qfind;
  57 /* Modification types (Qdelete is defined in general.c) */
  58 static Lisp_Object Qadd, Qreplace;
  59
  60 \f
  61 /************************************************************************/
  62 /*                         Utility Functions                            */
  63 /************************************************************************/
  64
  65 static void
  66 signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err)
  67 {
  68   if (ldap_err <= 0)
  69     {
  70 #if defined HAVE_LDAP_PARSE_RESULT
  71       int err;
  72       ldap_err = ldap_parse_result (ld, res,
  73                                     &err,
  74                                     NULL, NULL, NULL, NULL, 0);
  75       if (ldap_err == LDAP_SUCCESS)
  76         ldap_err = err;
  77 #elif defined HAVE_LDAP_GET_LDERRNO
  78       ldap_err = ldap_get_lderrno (ld, NULL, NULL);
  79 #elif defined HAVE_LDAP_RESULT2ERROR
  80       ldap_err = ldap_result2error (ld, res, 0);
  81 #else
  82       ldap_err = ld->ld_errno;
  83 #endif
  84     }
  85   signal_simple_error ("LDAP error",
  86                        build_string (ldap_err2string (ldap_err)));
  87 }
  88
  89 \f
  90 /************************************************************************/
  91 /*                        ldap lrecord basic functions                  */
  92 /************************************************************************/
  93
  94 static Lisp_Object
  95 make_ldap (Lisp_LDAP *ldap)
  96 {
  97   Lisp_Object lisp_ldap;
  98   XSETLDAP (lisp_ldap, ldap);
  99   return lisp_ldap;
 100 }
 101
 102 static Lisp_Object
 103 mark_ldap (Lisp_Object obj)
 104 {
 105   return XLDAP (obj)->host;
 106 }
 107
 108 static void
 109 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 110 {
 111   char buf[32];
 112
 113   Lisp_LDAP *ldap = XLDAP (obj);
 114
 115   if (print_readably)
 116     error ("printing unreadable object #<ldap %s>",
 117            XSTRING_DATA (ldap->host));
 118
 119   write_c_string ("#<ldap ", printcharfun);
 120   print_internal (ldap->host, printcharfun, 1);
 121   if (!ldap->ld)
 122     write_c_string ("(dead) ",printcharfun);
 123   sprintf (buf, " 0x%x>", (unsigned int)ldap);
 124   write_c_string (buf, printcharfun);
 125 }
 126
 127 static Lisp_LDAP *
 128 allocate_ldap (void)
 129 {
 130   Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap);
 131
 132   ldap->ld = NULL;
 133   ldap->host = Qnil;
 134   return ldap;
 135 }
 136
 137 static void
 138 finalize_ldap (void *header, int for_disksave)
 139 {
 140   Lisp_LDAP *ldap = (Lisp_LDAP *) header;
 141
 142   if (for_disksave)
 143     signal_simple_error ("Can't dump an emacs containing LDAP objects",
 144                          make_ldap (ldap));
 145
 146   if (ldap->ld)
 147     ldap_unbind (ldap->ld);
 148   ldap->ld = NULL;
 149 }
 150
 151 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
 152                                mark_ldap, print_ldap, finalize_ldap,
 153                                NULL, NULL, 0, Lisp_LDAP);
 154
 155
 156
 157 \f
 158 /************************************************************************/
 159 /*                        Basic ldap accessors                          */
 160 /************************************************************************/
 161
 162 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
 163 Return t if OBJECT is a LDAP connection.
 164 */
 165        (object))
 166 {
 167   return LDAPP (object) ? Qt : Qnil;
 168 }
 169
 170 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
 171 Return the server host of the connection LDAP, as a string.
 172 */
 173        (ldap))
 174 {
 175   CHECK_LDAP (ldap);
 176   return (XLDAP (ldap))->host;
 177 }
 178
 179 DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /*
 180 Return t if LDAP is an active LDAP connection.
 181 */
 182        (ldap))
 183 {
 184   CHECK_LDAP (ldap);
 185   return (XLDAP (ldap))->ld ? Qt : Qnil;
 186 }
 187 \f
 188 /************************************************************************/
 189 /*                  Opening/Closing a LDAP connection                   */
 190 /************************************************************************/
 191
 192
 193 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
 194 Open a LDAP connection to HOST.
 195 PLIST is a plist containing additional parameters for the connection.
 196 Valid keys in that list are:
 197   `port' the TCP port to use for the connection if different from
 198 `ldap-default-port'.
 199   `auth' is the authentication method to use, possible values depend on
 200 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
 201   `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
 202   `passwd' is the password to use for simple authentication.
 203   `deref' is one of the symbols `never', `always', `search' or `find'.
 204   `timelimit' is the timeout limit for the connection in seconds.
 205   `sizelimit' is the maximum number of matches to return.
 206 */
 207        (host, plist))
 208 {
 209   /* This function can GC */
 210   Lisp_LDAP *ldap;
 211   LDAP *ld;
 212   int  ldap_port = 0;
 213   int  ldap_auth = LDAP_AUTH_SIMPLE;
 214   char *ldap_binddn = NULL;
 215   char *ldap_passwd = NULL;
 216   int  ldap_deref = LDAP_DEREF_NEVER;
 217   int  ldap_timelimit = 0;
 218   int  ldap_sizelimit = 0;
 219   int  err;
 220
 221   Lisp_Object list, keyword, value;
 222
 223   CHECK_STRING (host);
 224
 225   EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
 226     {
 227       /* TCP Port */
 228       if (EQ (keyword, Qport))
 229         {
 230           CHECK_INT (value);
 231           ldap_port = XINT (value);
 232         }
 233       /* Authentication method */
 234       if (EQ (keyword, Qauth))
 235         {
 236           if (EQ (value, Qsimple))
 237             ldap_auth = LDAP_AUTH_SIMPLE;
 238 #ifdef LDAP_AUTH_KRBV41
 239           else if (EQ (value, Qkrbv41))
 240             ldap_auth = LDAP_AUTH_KRBV41;
 241 #endif
 242 #ifdef LDAP_AUTH_KRBV42
 243           else if (EQ (value, Qkrbv42))
 244             ldap_auth = LDAP_AUTH_KRBV42;
 245 #endif
 246           else
 247             signal_simple_error ("Invalid authentication method", value);
 248         }
 249       /* Bind DN */
 250       else if (EQ (keyword, Qbinddn))
 251         {
 252           CHECK_STRING (value);
 253           TO_EXTERNAL_FORMAT (LISP_STRING, value,
 254                               C_STRING_ALLOCA, ldap_binddn,
 255                               Qnative);
 256         }
 257       /* Password */
 258       else if (EQ (keyword, Qpasswd))
 259         {
 260           CHECK_STRING (value);
 261           TO_EXTERNAL_FORMAT (LISP_STRING, value,
 262                               C_STRING_ALLOCA, ldap_passwd,
 263                               Qnative);
 264         }
 265       /* Deref */
 266       else if (EQ (keyword, Qderef))
 267         {
 268           if (EQ (value, Qnever))
 269             ldap_deref = LDAP_DEREF_NEVER;
 270           else if (EQ (value, Qsearch))
 271             ldap_deref = LDAP_DEREF_SEARCHING;
 272           else if (EQ (value, Qfind))
 273             ldap_deref = LDAP_DEREF_FINDING;
 274           else if (EQ (value, Qalways))
 275             ldap_deref = LDAP_DEREF_ALWAYS;
 276           else
 277             signal_simple_error ("Invalid deref value", value);
 278         }
 279       /* Timelimit */
 280       else if (EQ (keyword, Qtimelimit))
 281         {
 282           CHECK_INT (value);
 283           ldap_timelimit = XINT (value);
 284         }
 285       /* Sizelimit */
 286       else if (EQ (keyword, Qsizelimit))
 287         {
 288           CHECK_INT (value);
 289           ldap_sizelimit = XINT (value);
 290         }
 291     }
 292
 293   if (ldap_port == 0)
 294     {
 295       ldap_port = ldap_default_port;
 296     }
 297
 298   /* Connect to the server and bind */
 299   slow_down_interrupts ();
 300   ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
 301   speed_up_interrupts ();
 302
 303   if (ld == NULL )
 304     signal_simple_error_2 ("Failed connecting to host",
 305                            host,
 306                            lisp_strerror (errno));
 307
 308
 309 #ifdef HAVE_LDAP_SET_OPTION
 310   if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
 311                               (void *)&ldap_deref)) != LDAP_SUCCESS)
 312     signal_ldap_error (ld, NULL, err);
 313   if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
 314                               (void *)&ldap_timelimit)) != LDAP_SUCCESS)
 315     signal_ldap_error (ld, NULL, err);
 316   if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
 317                               (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
 318     signal_ldap_error (ld, NULL, err);
 319   if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
 320                               LDAP_OPT_ON)) != LDAP_SUCCESS)
 321     signal_ldap_error (ld, NULL, err);
 322   if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
 323                               LDAP_OPT_ON)) != LDAP_SUCCESS)
 324     signal_ldap_error (ld, NULL, err);
 325 #else  /* not HAVE_LDAP_SET_OPTION */
 326   ld->ld_deref = ldap_deref;
 327   ld->ld_timelimit = ldap_timelimit;
 328   ld->ld_sizelimit = ldap_sizelimit;
 329 #ifdef LDAP_REFERRALS
 330   ld->ld_options = LDAP_OPT_REFERRALS;
 331 #else /* not LDAP_REFERRALS */
 332   ld->ld_options = 0;
 333 #endif /* not LDAP_REFERRALS */
 334   /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
 335   ld->ld_options |= LDAP_OPT_RESTART;
 336 #endif /* not HAVE_LDAP_SET_OPTION */
 337
 338   err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
 339   if (err != LDAP_SUCCESS)
 340     signal_simple_error ("Failed binding to the server",
 341                          build_string (ldap_err2string (err)));
 342
 343   ldap = allocate_ldap ();
 344   ldap->ld = ld;
 345   ldap->host = host;
 346
 347   return make_ldap (ldap);
 348 }
 349
 350
 351
 352 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
 353 Close an LDAP connection.
 354 */
 355       (ldap))
 356 {
 357   Lisp_LDAP *lldap;
 358   CHECK_LIVE_LDAP (ldap);
 359   lldap = XLDAP (ldap);
 360   ldap_unbind (lldap->ld);
 361   lldap->ld = NULL;
 362   return Qnil;
 363 }
 364
 365
 366 \f
 367 /************************************************************************/
 368 /*                  Working on a LDAP connection                        */
 369 /************************************************************************/
 370 struct ldap_unwind_struct
 371 {
 372   LDAPMessage *res;
 373   struct berval **vals;
 374 };
 375
 376 static Lisp_Object
 377 ldap_search_unwind (Lisp_Object unwind_obj)
 378 {
 379   struct ldap_unwind_struct *unwind =
 380     (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
 381   if (unwind->res)
 382     ldap_msgfree (unwind->res);
 383   if (unwind->vals)
 384     ldap_value_free_len (unwind->vals);
 385   return Qnil;
 386 }
 387
 388 /* The following function is called `ldap-search-basic' instead of      */
 389 /* plain `ldap-search' to maintain compatibility with the XEmacs 21.1   */
 390 /* API where `ldap-search' was the name of the high-level search        */
 391 /* function                                                             */
 392
 393 DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
 394 Perform a search on an open LDAP connection.
 395 LDAP is an LDAP connection object created with `ldap-open'.
 396 FILTER is a filter string for the search as described in RFC 1558.
 397 BASE is the distinguished name at which to start the search.
 398 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
 399 the scope of the search.
 400 ATTRS is a list of strings indicating which attributes to retrieve
 401  for each matching entry. If nil return all available attributes.
 402 If ATTRSONLY is non-nil then only the attributes are retrieved, not
 403 the associated values.
 404 If WITHDN is non-nil each entry in the result will be prepended with
 405 its distinguished name DN.
 406 If VERBOSE is non-nil progress messages will be echoed.
 407 The function returns a list of matching entries.  Each entry is itself
 408 an alist of attribute/value pairs optionally preceded by the DN of the
 409 entry according to the value of WITHDN.
 410 */
 411        (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
 412 {
 413   /* This function can GC */
 414
 415   /* Vars for query */
 416   LDAP *ld;
 417   LDAPMessage *e;
 418   BerElement *ptr;
 419   char *a, *dn;
 420   int i, rc;
 421   int  matches;
 422   struct ldap_unwind_struct unwind;
 423
 424   int  ldap_scope = LDAP_SCOPE_SUBTREE;
 425   char **ldap_attributes = NULL;
 426
 427   int speccount = specpdl_depth ();
 428
 429   Lisp_Object list   = Qnil;
 430   Lisp_Object entry  = Qnil;
 431   Lisp_Object result = Qnil;
 432   struct gcpro gcpro1, gcpro2, gcpro3;
 433
 434   GCPRO3 (list, entry, result);
 435
 436   unwind.res = NULL;
 437   unwind.vals = NULL;
 438
 439   /* Do all the parameter checking  */
 440   CHECK_LIVE_LDAP (ldap);
 441   ld = XLDAP (ldap)->ld;
 442
 443   /* Filter */
 444   CHECK_STRING (filter);
 445
 446   /* Search base */
 447   if (NILP (base))
 448     {
 449       base = Vldap_default_base;
 450     }
 451   if (!NILP (base))
 452     {
 453       CHECK_STRING (base);
 454     }
 455
 456   /* Search scope */
 457   if (!NILP (scope))
 458     {
 459       if (EQ (scope, Qbase))
 460         ldap_scope = LDAP_SCOPE_BASE;
 461       else if (EQ (scope, Qonelevel))
 462         ldap_scope = LDAP_SCOPE_ONELEVEL;
 463       else if (EQ (scope, Qsubtree))
 464         ldap_scope = LDAP_SCOPE_SUBTREE;
 465       else
 466         signal_simple_error ("Invalid scope", scope);
 467     }
 468
 469   /* Attributes to search */
 470   if (!NILP (attrs))
 471     {
 472       CHECK_CONS (attrs);
 473       ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
 474
 475       i = 0;
 476       EXTERNAL_LIST_LOOP (attrs, attrs)
 477         {
 478           Lisp_Object current = XCAR (attrs);
 479           CHECK_STRING (current);
 480           TO_EXTERNAL_FORMAT (LISP_STRING, current,
 481                               C_STRING_ALLOCA, ldap_attributes[i],
 482                               Qnative);
 483           ++i;
 484         }
 485       ldap_attributes[i] = NULL;
 486     }
 487
 488   /* Attributes only ? */
 489   CHECK_SYMBOL (attrsonly);
 490
 491   /* Perform the search */
 492   if (ldap_search (ld,
 493                    NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base),
 494                    ldap_scope,
 495                    NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter),
 496                    ldap_attributes,
 497                    NILP (attrsonly) ? 0 : 1)
 498       == -1)
 499     {
 500       signal_ldap_error (ld, NULL, 0);
 501     }
 502
 503   /* Ensure we don't exit without cleaning up */
 504   record_unwind_protect (ldap_search_unwind,
 505                          make_opaque_ptr (&unwind));
 506
 507   /* Build the results list */
 508   matches = 0;
 509
 510   rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
 511
 512   while (rc == LDAP_RES_SEARCH_ENTRY)
 513     {
 514       QUIT;
 515       matches ++;
 516       e = ldap_first_entry (ld, unwind.res);
 517       /* #### This call to message() is pretty fascist, because it
 518          destroys the current echo area contents, even when invoked
 519          from Lisp.  It should use echo_area_message() instead, and
 520          restore the old echo area contents later.  */
 521       if (! NILP (verbose))
 522         message ("Parsing ldap results... %d", matches);
 523       entry = Qnil;
 524       /* Get the DN if required */
 525       if (! NILP (withdn))
 526         {
 527           dn = ldap_get_dn (ld, e);
 528           if (dn == NULL)
 529             signal_ldap_error (ld, e, 0);
 530           entry = Fcons (build_ext_string (dn, Qnative), Qnil);
 531         }
 532       for (a= ldap_first_attribute (ld, e, &ptr);
 533            a != NULL;
 534            a = ldap_next_attribute (ld, e, ptr) )
 535         {
 536           list = Fcons (build_ext_string (a, Qnative), Qnil);
 537           unwind.vals = ldap_get_values_len (ld, e, a);
 538           if (unwind.vals != NULL)
 539             {
 540               for (i = 0; unwind.vals[i] != NULL; i++)
 541                 {
 542                   list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val,
 543                                                  unwind.vals[i]->bv_len,
 544                                                  Qnative),
 545                                 list);
 546                 }
 547             }
 548           entry = Fcons (Fnreverse (list),
 549                          entry);
 550           ldap_value_free_len (unwind.vals);
 551           unwind.vals = NULL;
 552         }
 553       result = Fcons (Fnreverse (entry),
 554                       result);
 555       ldap_msgfree (unwind.res);
 556       unwind.res = NULL;
 557
 558       rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
 559     }
 560
 561 #if defined HAVE_LDAP_PARSE_RESULT
 562   {
 563     int rc2 = ldap_parse_result (ld, unwind.res,
 564                                  &rc,
 565                                  NULL, NULL, NULL, NULL, 0);
 566     if (rc2 != LDAP_SUCCESS)
 567       rc = rc2;
 568   }
 569 #else
 570   if (rc == 0)
 571     signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
 572
 573   if (rc == -1)
 574     signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0);
 575
 576 #if defined HAVE_LDAP_RESULT2ERROR
 577   rc = ldap_result2error (ld, unwind.res, 0);
 578 #endif
 579 #endif
 580
 581   if (rc != LDAP_SUCCESS)
 582     signal_ldap_error (ld, NULL, rc);
 583
 584   ldap_msgfree (unwind.res);
 585   unwind.res = (LDAPMessage *)NULL;
 586
 587   /* #### See above for calling message().  */
 588   if (! NILP (verbose))
 589     message ("Parsing ldap results... done");
 590
 591   unbind_to (speccount, Qnil);
 592   UNGCPRO;
 593   return Fnreverse (result);
 594 }
 595
 596 DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
 597 Add an entry to an LDAP directory.
 598 LDAP is an LDAP connection object created with `ldap-open'.
 599 DN is the distinguished name of the entry to add.
 600 ENTRY is an entry specification, i.e., a list of cons cells
 601 containing attribute/value string pairs.
 602 */
 603        (ldap, dn, entry))
 604 {
 605   LDAP *ld;
 606   LDAPMod *ldap_mods, **ldap_mods_ptrs;
 607   struct berval *bervals;
 608   int rc;
 609   int i, j;
 610   size_t len;
 611
 612   Lisp_Object current = Qnil;
 613   Lisp_Object values  = Qnil;
 614   struct gcpro gcpro1, gcpro2;
 615
 616   GCPRO2 (current, values);
 617
 618   /* Do all the parameter checking  */
 619   CHECK_LIVE_LDAP (ldap);
 620   ld = XLDAP (ldap)->ld;
 621
 622   /* Check the DN */
 623   CHECK_STRING (dn);
 624
 625   /* Check the entry */
 626   CHECK_CONS (entry);
 627   if (NILP (entry))
 628     signal_simple_error ("Cannot add void entry", entry);
 629
 630   /* Build the ldap_mods array */
 631   len = XINT (Flength (entry));
 632   ldap_mods = alloca_array (LDAPMod, len);
 633   ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
 634   i = 0;
 635   EXTERNAL_LIST_LOOP (entry, entry)
 636     {
 637       current = XCAR (entry);
 638       CHECK_CONS (current);
 639       CHECK_STRING (XCAR (current));
 640       ldap_mods_ptrs[i] = &(ldap_mods[i]);
 641       TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
 642                           C_STRING_ALLOCA, ldap_mods[i].mod_type,
 643                           Qnative);
 644       ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
 645       values = XCDR (current);
 646       if (CONSP (values))
 647         {
 648           len = XINT (Flength (values));
 649           bervals = alloca_array (struct berval, len);
 650           ldap_mods[i].mod_vals.modv_bvals =
 651             alloca_array (struct berval *, 1 + len);
 652           j = 0;
 653           EXTERNAL_LIST_LOOP (values, values)
 654             {
 655               current = XCAR (values);
 656               CHECK_STRING (current);
 657               ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
 658               TO_EXTERNAL_FORMAT (LISP_STRING, current,
 659                                   ALLOCA, (bervals[j].bv_val,
 660                                            bervals[j].bv_len),
 661                                   Qnative);
 662               j++;
 663             }
 664           ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
 665         }
 666       else
 667         {
 668           CHECK_STRING (values);
 669           bervals = alloca_array (struct berval, 1);
 670           ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, 2);
 671           ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
 672           TO_EXTERNAL_FORMAT (LISP_STRING, values,
 673                               ALLOCA, (bervals[0].bv_val,
 674                                        bervals[0].bv_len),
 675                               Qnative);
 676           ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
 677         }
 678       i++;
 679     }
 680   ldap_mods_ptrs[i] = NULL;
 681   rc = ldap_add_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
 682   if (rc != LDAP_SUCCESS)
 683     signal_ldap_error (ld, NULL, rc);
 684
 685   UNGCPRO;
 686   return Qnil;
 687 }
 688
 689 DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
 690 Add an entry to an LDAP directory.
 691 LDAP is an LDAP connection object created with `ldap-open'.
 692 DN is the distinguished name of the entry to modify.
 693 MODS is a list of modifications to apply.
 694 A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
 695 MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
 696 MOD-OP is the type of modification, one of the symbols `add', `delete'
 697 or `replace'. ATTR is the LDAP attribute type to modify.
 698 */
 699        (ldap, dn, mods))
 700 {
 701   LDAP *ld;
 702   LDAPMod *ldap_mods, **ldap_mods_ptrs;
 703   struct berval *bervals;
 704   int i, j, rc;
 705   Lisp_Object mod_op;
 706   size_t len;
 707
 708   Lisp_Object current = Qnil;
 709   Lisp_Object values  = Qnil;
 710   struct gcpro gcpro1, gcpro2;
 711
 712   GCPRO2 (current, values);
 713
 714   /* Do all the parameter checking  */
 715   CHECK_LIVE_LDAP (ldap);
 716   ld = XLDAP (ldap)->ld;
 717
 718   /* Check the DN */
 719   CHECK_STRING (dn);
 720
 721   /* Check the entry */
 722   CHECK_CONS (mods);
 723   if (NILP (mods))
 724     return Qnil;
 725
 726   /* Build the ldap_mods array */
 727   len = XINT (Flength (mods));
 728   ldap_mods = alloca_array (LDAPMod, len);
 729   ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
 730   i = 0;
 731   EXTERNAL_LIST_LOOP (mods, mods)
 732     {
 733       current = XCAR (mods);
 734       CHECK_CONS (current);
 735       CHECK_SYMBOL (XCAR (current));
 736       mod_op = XCAR (current);
 737       ldap_mods_ptrs[i] = &(ldap_mods[i]);
 738       ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
 739       if (EQ (mod_op, Qadd))
 740         ldap_mods[i].mod_op |= LDAP_MOD_ADD;
 741       else if (EQ (mod_op, Qdelete))
 742         ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
 743       else if (EQ (mod_op, Qreplace))
 744         ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
 745       else
 746         signal_simple_error ("Invalid LDAP modification type", mod_op);
 747       current = XCDR (current);
 748       CHECK_STRING (XCAR (current));
 749       TO_EXTERNAL_FORMAT (LISP_STRING, XCAR (current),
 750                           C_STRING_ALLOCA, ldap_mods[i].mod_type,
 751                           Qnative);
 752       values = XCDR (current);
 753       len = XINT (Flength (values));
 754       bervals = alloca_array (struct berval, len);
 755       ldap_mods[i].mod_vals.modv_bvals =
 756         alloca_array (struct berval *, 1 + len);
 757       j = 0;
 758       EXTERNAL_LIST_LOOP (values, values)
 759         {
 760           current = XCAR (values);
 761           CHECK_STRING (current);
 762           ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
 763           TO_EXTERNAL_FORMAT (LISP_STRING, current,
 764                               ALLOCA, (bervals[j].bv_val,
 765                                        bervals[j].bv_len),
 766                               Qnative);
 767           j++;
 768         }
 769       ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
 770       i++;
 771     }
 772   ldap_mods_ptrs[i] = NULL;
 773   rc = ldap_modify_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
 774   if (rc != LDAP_SUCCESS)
 775     signal_ldap_error (ld, NULL, rc);
 776
 777   UNGCPRO;
 778   return Qnil;
 779 }
 780
 781
 782 DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
 783 Delete an entry to an LDAP directory.
 784 LDAP is an LDAP connection object created with `ldap-open'.
 785 DN is the distinguished name of the entry to delete.
 786 */
 787        (ldap, dn))
 788 {
 789   LDAP *ld;
 790   int rc;
 791
 792   /* Check parameters */
 793   CHECK_LIVE_LDAP (ldap);
 794   ld = XLDAP (ldap)->ld;
 795   CHECK_STRING (dn);
 796
 797   rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn));
 798   if (rc != LDAP_SUCCESS)
 799     signal_ldap_error (ld, NULL, rc);
 800
 801   return Qnil;
 802 }
 803
 804 void
 805 syms_of_eldap (void)
 806 {
 807   INIT_LRECORD_IMPLEMENTATION (ldap);
 808
 809   defsymbol (&Qldapp, "ldapp");
 810   defsymbol (&Qport, "port");
 811   defsymbol (&Qauth, "auth");
 812   defsymbol (&Qbinddn, "binddn");
 813   defsymbol (&Qpasswd, "passwd");
 814   defsymbol (&Qderef, "deref");
 815   defsymbol (&Qtimelimit, "timelimit");
 816   defsymbol (&Qsizelimit, "sizelimit");
 817   defsymbol (&Qbase, "base");
 818   defsymbol (&Qonelevel, "onelevel");
 819   defsymbol (&Qsubtree, "subtree");
 820   defsymbol (&Qkrbv41, "krbv41");
 821   defsymbol (&Qkrbv42, "krbv42");
 822   defsymbol (&Qnever, "never");
 823   defsymbol (&Qalways, "always");
 824   defsymbol (&Qfind, "find");
 825   defsymbol (&Qadd, "add");
 826   defsymbol (&Qreplace, "replace");
 827
 828   DEFSUBR (Fldapp);
 829   DEFSUBR (Fldap_host);
 830   DEFSUBR (Fldap_status);
 831   DEFSUBR (Fldap_open);
 832   DEFSUBR (Fldap_close);
 833   DEFSUBR (Fldap_search_basic);
 834   DEFSUBR (Fldap_add);
 835   DEFSUBR (Fldap_modify);
 836   DEFSUBR (Fldap_delete);
 837 }
 838
 839 void
 840 vars_of_eldap (void)
 841 {
 842
 843   ldap_default_port = LDAP_PORT;
 844   Vldap_default_base =  Qnil;
 845
 846   DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
 847 Default TCP port for LDAP connections.
 848 Initialized from the LDAP library. Default value is 389.
 849 */ );
 850
 851   DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
 852 Default base for LDAP searches.
 853 This is a string using the syntax of RFC 1779.
 854 For instance, "o=ACME, c=US" limits the search to the
 855 Acme organization in the United States.
 856 */ );
 857
 858 }
 859
 860