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