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 \f
  58 /************************************************************************/
  59 /*                         Utility Functions                            */
  60 /************************************************************************/
  61
  62 static void
  63 signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err)
  64 {
  65   if (ldap_err <= 0)
  66     {
  67 #if defined HAVE_LDAP_PARSE_RESULT
  68       int err;
  69       ldap_err = ldap_parse_result (ld, res,
  70                                     &err,
  71                                     NULL, NULL, NULL, NULL, 0);
  72       if (ldap_err == LDAP_SUCCESS)
  73         ldap_err = err;
  74 #elif defined HAVE_LDAP_GET_LDERRNO
  75       ldap_err = ldap_get_lderrno (ld, NULL, NULL);
  76 #elif defined HAVE_LDAP_RESULT2ERROR
  77       ldap_err = ldap_result2error (ld, res, 0);
  78 #else
  79       ldap_err = ld->ld_errno;
  80 #endif
  81     }
  82   signal_simple_error ("LDAP error",
  83                        build_string (ldap_err2string (ldap_err)));
  84 }
  85
  86 \f
  87 /************************************************************************/
  88 /*                        ldap lrecord basic functions                  */
  89 /************************************************************************/
  90
  91 static Lisp_Object
  92 make_ldap (Lisp_LDAP *ldap)
  93 {
  94   Lisp_Object lisp_ldap;
  95   XSETLDAP (lisp_ldap, ldap);
  96   return lisp_ldap;
  97 }
  98
  99 static Lisp_Object
 100 mark_ldap (Lisp_Object obj)
 101 {
 102   return XLDAP (obj)->host;
 103 }
 104
 105 static void
 106 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 107 {
 108   char buf[32];
 109
 110   Lisp_LDAP *ldap = XLDAP (obj);
 111
 112   if (print_readably)
 113     error ("printing unreadable object #<ldap %s>",
 114            XSTRING_DATA (ldap->host));
 115
 116   write_c_string ("#<ldap ", printcharfun);
 117   print_internal (ldap->host, printcharfun, 1);
 118   if (!ldap->ld)
 119     write_c_string ("(dead) ",printcharfun);
 120   sprintf (buf, " 0x%x>", (unsigned int)ldap);
 121   write_c_string (buf, printcharfun);
 122 }
 123
 124 static Lisp_LDAP *
 125 allocate_ldap (void)
 126 {
 127   Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap);
 128
 129   ldap->ld = NULL;
 130   ldap->host = Qnil;
 131   return ldap;
 132 }
 133
 134 static void
 135 finalize_ldap (void *header, int for_disksave)
 136 {
 137   Lisp_LDAP *ldap = (Lisp_LDAP *) header;
 138
 139   if (for_disksave)
 140     signal_simple_error ("Can't dump an emacs containing LDAP objects",
 141                          make_ldap (ldap));
 142
 143   if (ldap->ld)
 144     ldap_unbind (ldap->ld);
 145   ldap->ld = NULL;
 146 }
 147
 148 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
 149                                mark_ldap, print_ldap, finalize_ldap,
 150                                NULL, NULL, 0, Lisp_LDAP);
 151
 152
 153
 154 \f
 155 /************************************************************************/
 156 /*                        Basic ldap accessors                          */
 157 /************************************************************************/
 158
 159 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
 160 Return t if OBJECT is a LDAP connection.
 161 */
 162        (object))
 163 {
 164   return LDAPP (object) ? Qt : Qnil;
 165 }
 166
 167 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
 168 Return the server host of the connection LDAP, as a string.
 169 */
 170        (ldap))
 171 {
 172   CHECK_LDAP (ldap);
 173   return (XLDAP (ldap))->host;
 174 }
 175
 176 DEFUN ("ldap-live-p", Fldap_status, 1, 1, 0, /*
 177 Return t if LDAP is an active LDAP connection.
 178 */
 179        (ldap))
 180 {
 181   CHECK_LDAP (ldap);
 182   return (XLDAP (ldap))->ld ? Qt : Qnil;
 183 }
 184 \f
 185 /************************************************************************/
 186 /*                  Opening/Closing a LDAP connection                   */
 187 /************************************************************************/
 188
 189
 190 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
 191 Open a LDAP connection to HOST.
 192 PLIST is a plist containing additional parameters for the connection.
 193 Valid keys in that list are:
 194   `port' the TCP port to use for the connection if different from
 195 `ldap-default-port'.
 196   `auth' is the authentication method to use, possible values depend on
 197 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
 198   `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
 199   `passwd' is the password to use for simple authentication.
 200   `deref' is one of the symbols `never', `always', `search' or `find'.
 201   `timelimit' is the timeout limit for the connection in seconds.
 202   `sizelimit' is the maximum number of matches to return.
 203 */
 204        (host, plist))
 205 {
 206   /* This function can GC */
 207   Lisp_LDAP *ldap;
 208   LDAP *ld;
 209   int  ldap_port = 0;
 210   int  ldap_auth = LDAP_AUTH_SIMPLE;
 211   char *ldap_binddn = NULL;
 212   char *ldap_passwd = NULL;
 213   int  ldap_deref = LDAP_DEREF_NEVER;
 214   int  ldap_timelimit = 0;
 215   int  ldap_sizelimit = 0;
 216   int  err;
 217
 218   Lisp_Object list, keyword, value;
 219
 220   CHECK_STRING (host);
 221
 222   EXTERNAL_PROPERTY_LIST_LOOP (list, keyword, value, plist)
 223     {
 224       /* TCP Port */
 225       if (EQ (keyword, Qport))
 226         {
 227           CHECK_INT (value);
 228           ldap_port = XINT (value);
 229         }
 230       /* Authentication method */
 231       if (EQ (keyword, Qauth))
 232         {
 233           if (EQ (value, Qsimple))
 234             ldap_auth = LDAP_AUTH_SIMPLE;
 235 #ifdef LDAP_AUTH_KRBV41
 236           else if (EQ (value, Qkrbv41))
 237             ldap_auth = LDAP_AUTH_KRBV41;
 238 #endif
 239 #ifdef LDAP_AUTH_KRBV42
 240           else if (EQ (value, Qkrbv42))
 241             ldap_auth = LDAP_AUTH_KRBV42;
 242 #endif
 243           else
 244             signal_simple_error ("Invalid authentication method", value);
 245         }
 246       /* Bind DN */
 247       else if (EQ (keyword, Qbinddn))
 248         {
 249           CHECK_STRING (value);
 250           TO_EXTERNAL_FORMAT (LISP_STRING, value,
 251                               C_STRING_ALLOCA, ldap_binddn,
 252                               Qnative);
 253         }
 254       /* Password */
 255       else if (EQ (keyword, Qpasswd))
 256         {
 257           CHECK_STRING (value);
 258           TO_EXTERNAL_FORMAT (LISP_STRING, value,
 259                               C_STRING_ALLOCA, ldap_passwd,
 260                               Qnative);
 261         }
 262       /* Deref */
 263       else if (EQ (keyword, Qderef))
 264         {
 265           if (EQ (value, Qnever))
 266             ldap_deref = LDAP_DEREF_NEVER;
 267           else if (EQ (value, Qsearch))
 268             ldap_deref = LDAP_DEREF_SEARCHING;
 269           else if (EQ (value, Qfind))
 270             ldap_deref = LDAP_DEREF_FINDING;
 271           else if (EQ (value, Qalways))
 272             ldap_deref = LDAP_DEREF_ALWAYS;
 273           else
 274             signal_simple_error ("Invalid deref value", value);
 275         }
 276       /* Timelimit */
 277       else if (EQ (keyword, Qtimelimit))
 278         {
 279           CHECK_INT (value);
 280           ldap_timelimit = XINT (value);
 281         }
 282       /* Sizelimit */
 283       else if (EQ (keyword, Qsizelimit))
 284         {
 285           CHECK_INT (value);
 286           ldap_sizelimit = XINT (value);
 287         }
 288     }
 289
 290   if (ldap_port == 0)
 291     {
 292       ldap_port = ldap_default_port;
 293     }
 294
 295   /* Connect to the server and bind */
 296   slow_down_interrupts ();
 297   ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
 298   speed_up_interrupts ();
 299
 300   if (ld == NULL )
 301     signal_simple_error_2 ("Failed connecting to host",
 302                            host,
 303                            lisp_strerror (errno));
 304
 305
 306 #ifdef HAVE_LDAP_SET_OPTION
 307   if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
 308                               (void *)&ldap_deref)) != LDAP_SUCCESS)
 309     signal_ldap_error (ld, NULL, err);
 310   if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
 311                               (void *)&ldap_timelimit)) != LDAP_SUCCESS)
 312     signal_ldap_error (ld, NULL, err);
 313   if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
 314                               (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
 315     signal_ldap_error (ld, NULL, err);
 316   if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
 317                               LDAP_OPT_ON)) != LDAP_SUCCESS)
 318     signal_ldap_error (ld, NULL, err);
 319 #else  /* not HAVE_LDAP_SET_OPTION */
 320   ld->ld_deref = ldap_deref;
 321   ld->ld_timelimit = ldap_timelimit;
 322   ld->ld_sizelimit = ldap_sizelimit;
 323 #ifdef LDAP_REFERRALS
 324   ld->ld_options = LDAP_OPT_REFERRALS;
 325 #else /* not LDAP_REFERRALS */
 326   ld->ld_options = 0;
 327 #endif /* not LDAP_REFERRALS */
 328 #endif /* not HAVE_LDAP_SET_OPTION */
 329
 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);
 333   speed_up_interrupts ();
 334   if (err != LDAP_SUCCESS)
 335     signal_simple_error ("Failed binding to the server",
 336                          build_string (ldap_err2string (err)));
 337
 338   ldap = allocate_ldap ();
 339   ldap->ld = ld;
 340   ldap->host = host;
 341
 342   return make_ldap (ldap);
 343 }
 344
 345
 346
 347 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
 348 Close an LDAP connection.
 349 */
 350       (ldap))
 351 {
 352   Lisp_LDAP *lldap;
 353   CHECK_LIVE_LDAP (ldap);
 354   lldap = XLDAP (ldap);
 355   ldap_unbind (lldap->ld);
 356   lldap->ld = NULL;
 357   return Qnil;
 358 }
 359
 360
 361 \f
 362 /************************************************************************/
 363 /*                  Working on a LDAP connection                        */
 364 /************************************************************************/
 365 struct ldap_unwind_struct
 366 {
 367   LDAPMessage *res;
 368   struct berval **vals;
 369 };
 370
 371
 372 static Lisp_Object
 373 ldap_search_unwind (Lisp_Object unwind_obj)
 374 {
 375   struct ldap_unwind_struct *unwind =
 376     (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
 377   if (unwind->res)
 378     ldap_msgfree (unwind->res);
 379   if (unwind->vals)
 380     ldap_value_free_len (unwind->vals);
 381   return Qnil;
 382 }
 383
 384 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 7, 0, /*
 385 Perform a search on an open LDAP connection.
 386 LDAP is an LDAP connection object created with `ldap-open'.
 387 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.
 389 SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
 390 the scope of the search.
 391 ATTRS is a list of strings indicating which attributes to retrieve
 392  for each matching entry. If nil return all available attributes.
 393 If ATTRSONLY is non-nil then only the attributes are retrieved, not
 394 the associated values.
 395 If WITHDN is non-nil each entry in the result will be prepennded with
 396 its distinguished name DN.
 397 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
 399 entry according to the value of WITHDN.
 400 */
 401        (ldap, filter, base, scope, attrs, attrsonly, withdn))
 402 {
 403   /* This function can GC */
 404
 405   /* Vars for query */
 406   LDAP *ld;
 407   LDAPMessage *e;
 408   BerElement *ptr;
 409   char *a, *dn;
 410   int i, rc, rc2;
 411   int  matches;
 412   struct ldap_unwind_struct unwind;
 413
 414   int  ldap_scope = LDAP_SCOPE_SUBTREE;
 415   char **ldap_attributes = NULL;
 416
 417   int speccount = specpdl_depth ();
 418
 419   Lisp_Object list, entry, result;
 420   struct gcpro gcpro1, gcpro2, gcpro3;
 421
 422   list = entry = result = Qnil;
 423   GCPRO3 (list, entry, result);
 424
 425   unwind.res = NULL;
 426   unwind.vals = NULL;
 427
 428   /* Do all the parameter checking  */
 429   CHECK_LIVE_LDAP (ldap);
 430   ld = XLDAP (ldap)->ld;
 431
 432   /* Filter */
 433   CHECK_STRING (filter);
 434
 435   /* Search base */
 436   if (NILP (base))
 437     {
 438       base = Vldap_default_base;
 439     }
 440   if (!NILP (base))
 441     {
 442       CHECK_STRING (base);
 443     }
 444
 445   /* Search scope */
 446   if (!NILP (scope))
 447     {
 448       if (EQ (scope, Qbase))
 449         ldap_scope = LDAP_SCOPE_BASE;
 450       else if (EQ (scope, Qonelevel))
 451         ldap_scope = LDAP_SCOPE_ONELEVEL;
 452       else if (EQ (scope, Qsubtree))
 453         ldap_scope = LDAP_SCOPE_SUBTREE;
 454       else
 455         signal_simple_error ("Invalid scope", scope);
 456     }
 457
 458   /* Attributes to search */
 459   if (!NILP (attrs))
 460     {
 461       CHECK_CONS (attrs);
 462       ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
 463
 464       i = 0;
 465       EXTERNAL_LIST_LOOP (attrs, attrs)
 466         {
 467           Lisp_Object current = XCAR (attrs);
 468           CHECK_STRING (current);
 469           TO_EXTERNAL_FORMAT (LISP_STRING, current,
 470                               C_STRING_ALLOCA, ldap_attributes[i],
 471                               Qnative);
 472           ++i;
 473         }
 474       ldap_attributes[i] = NULL;
 475     }
 476
 477   /* Attributes only ? */
 478   CHECK_SYMBOL (attrsonly);
 479
 480   /* Perform the search */
 481   if (ldap_search (ld,
 482                    NILP (base) ? "" : (char *) XSTRING_DATA (base),
 483                    ldap_scope,
 484                    NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
 485                    ldap_attributes,
 486                    NILP (attrsonly) ? 0 : 1)
 487       == -1)
 488     {
 489       signal_ldap_error (ld, NULL, 0);
 490     }
 491
 492   /* Ensure we don't exit without cleaning up */
 493   record_unwind_protect (ldap_search_unwind,
 494                          make_opaque_ptr (&unwind));
 495
 496   /* Build the results list */
 497   matches = 0;
 498
 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);
 502   speed_up_interrupts ();
 503   while (rc == LDAP_RES_SEARCH_ENTRY)
 504     {
 505       QUIT;
 506       matches ++;
 507       e = ldap_first_entry (ld, unwind.res);
 508       /* #### This call to message() is pretty fascist, because it
 509          destroys the current echo area contents, even when invoked
 510          from Lisp.  It should use echo_area_message() instead, and
 511          restore the old echo area contents later.  */
 512       message ("Parsing ldap results... %d", matches);
 513       entry = Qnil;
 514       /* Get the DN if required */
 515       if (! NILP (withdn))
 516         {
 517           dn = ldap_get_dn (ld, e);
 518           if (dn == NULL)
 519             signal_ldap_error (ld, e, 0);
 520           entry = Fcons (build_ext_string (dn, Qnative), Qnil);
 521         }
 522       for (a= ldap_first_attribute (ld, e, &ptr);
 523            a != NULL;
 524            a = ldap_next_attribute (ld, e, ptr) )
 525         {
 526           list = Fcons (build_ext_string (a, Qnative), Qnil);
 527           unwind.vals = ldap_get_values_len (ld, e, a);
 528           if (unwind.vals != NULL)
 529             {
 530               for (i = 0; unwind.vals[i] != NULL; i++)
 531                 {
 532                   list = Fcons (make_ext_string (unwind.vals[i]->bv_val,
 533                                                  unwind.vals[i]->bv_len,
 534                                                  Qnative),
 535                                 list);
 536                 }
 537             }
 538           entry = Fcons (Fnreverse (list),
 539                          entry);
 540           ldap_value_free_len (unwind.vals);
 541           unwind.vals = NULL;
 542         }
 543       result = Fcons (Fnreverse (entry),
 544                       result);
 545       ldap_msgfree (unwind.res);
 546       unwind.res = NULL;
 547
 548       slow_down_interrupts ();
 549       rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
 550       speed_up_interrupts ();
 551     }
 552
 553   if (rc == -1)
 554     signal_ldap_error (ld, unwind.res, 0);
 555
 556   if (rc == 0)
 557     signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
 558
 559 #if defined HAVE_LDAP_PARSE_RESULT
 560   rc2 = ldap_parse_result (ld, unwind.res,
 561                            &rc,
 562                            NULL, NULL, NULL, NULL, 0);
 563   if (rc2 != LDAP_SUCCESS)
 564     rc = rc2;
 565 #elif defined HAVE_LDAP_RESULT2ERROR
 566   rc = ldap_result2error (ld, unwind.res, 0);
 567 #endif
 568   if ((rc != LDAP_SUCCESS) && (rc != LDAP_SIZELIMIT_EXCEEDED))
 569     signal_ldap_error (ld, NULL, rc);
 570
 571   ldap_msgfree (unwind.res);
 572   unwind.res = (LDAPMessage *)NULL;
 573   /* #### See above for calling message().  */
 574   message ("Parsing ldap results... done");
 575
 576   unbind_to (speccount, Qnil);
 577   UNGCPRO;
 578   return Fnreverse (result);
 579 }
 580
 581
 582 void
 583 syms_of_eldap (void)
 584 {
 585   defsymbol (&Qldapp, "ldapp");
 586   defsymbol (&Qport, "port");
 587   defsymbol (&Qauth, "auth");
 588   defsymbol (&Qbinddn, "binddn");
 589   defsymbol (&Qpasswd, "passwd");
 590   defsymbol (&Qderef, "deref");
 591   defsymbol (&Qtimelimit, "timelimit");
 592   defsymbol (&Qsizelimit, "sizelimit");
 593   defsymbol (&Qbase, "base");
 594   defsymbol (&Qonelevel, "onelevel");
 595   defsymbol (&Qsubtree, "subtree");
 596   defsymbol (&Qkrbv41, "krbv41");
 597   defsymbol (&Qkrbv42, "krbv42");
 598   defsymbol (&Qnever, "never");
 599   defsymbol (&Qalways, "always");
 600   defsymbol (&Qfind, "find");
 601
 602   DEFSUBR (Fldapp);
 603   DEFSUBR (Fldap_host);
 604   DEFSUBR (Fldap_status);
 605   DEFSUBR (Fldap_open);
 606   DEFSUBR (Fldap_close);
 607   DEFSUBR (Fldap_search_internal);
 608 }
 609
 610 void
 611 vars_of_eldap (void)
 612 {
 613
 614   ldap_default_port = LDAP_PORT;
 615   Vldap_default_base =  Qnil;
 616
 617   DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
 618 Default TCP port for LDAP connections.
 619 Initialized from the LDAP library. Default value is 389.
 620 */ );
 621
 622   DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
 623 Default base for LDAP searches.
 624 This is a string using the syntax of RFC 1779.
 625 For instance, "o=ACME, c=US" limits the search to the
 626 Acme organization in the United States.
 627 */ );
 628
 629 }
 630
 631