cgit.sxemacs.org Git - sxemacs/blob - src/database/eldap.c

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