git.chise.org Git - chise/xemacs-chise.git.1/blob - modules/ldap/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 */
  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    - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
  30
  31 #include <emodules.h>
  32
  33 #if defined (HAVE_LDAP)
  34 /* The entire file is within this conditional */
  35
  36 #include "eldap.h"
  37 #include <lber.h>
  38 /* #### NEEDS REWRITE!
  39    Thanks to Mats Lidell <matsl@xemacs.org> for the report & patch:
  40    <871wgnqunm.fsf@spencer.lidell.homelinux.net>
  41    "See http://www.openldap.org/faq/data/cache/1278.html.
  42    Temporary workaround would be use the deprecated interface. Long term
  43    solution is a rewrite." */
  44 #define LDAP_DEPRECATED 1
  45 #include <ldap.h>
  46
  47 #ifdef HAVE_NS_LDAP
  48 #define HAVE_LDAP_SET_OPTION 1
  49 #define HAVE_LDAP_GET_ERRNO 1
  50 #else
  51 #undef HAVE_LDAP_SET_OPTION
  52 #undef HAVE_LDAP_GET_ERRNO
  53 #endif
  54
  55 static Lisp_Object Vldap_default_base;
  56 static Lisp_Object Vldap_default_host;
  57
  58 /* ldap-search-internal plist keywords */
  59 static Lisp_Object Qhost, Qfilter, Qattributes, Qattrsonly, Qbase, Qscope,
  60   Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
  61 /* Search scope limits */
  62 static Lisp_Object Qbase, Qonelevel, Qsubtree;
  63 /* Authentication methods */
  64 #ifdef LDAP_AUTH_KRBV41
  65 static Lisp_Object Qkrbv41;
  66 #endif
  67 #ifdef LDAP_AUTH_KRBV42
  68 static Lisp_Object Qkrbv42;
  69 #endif
  70 /* Deref policy */
  71 static Lisp_Object Qnever, Qalways, Qfind;
  72
  73 DEFUN ("ldap-search-internal", Fldap_search_internal, 1, 1, 0, /*
  74 Perform a search on a LDAP server.
  75 SEARCH-PLIST is a property list describing the search request.
  76 Valid keys in that list are:
  77   `host' is a string naming one or more (blank separated) LDAP servers to
  78 to try to connect to. Each host name may optionally be of the form host:port.
  79   `filter' is a filter string for the search as described in RFC 1558
  80   `attributes' is a list of strings indicating which attributes to retrieve
  81 for each matching entry. If nil return all available attributes.
  82   `attrsonly' if non-nil indicates that only the attributes are retrieved, not
  83 the associated values.
  84   `base' is the base for the search as described in RFC 1779.
  85   `scope' is one of the three symbols `subtree', `base' or `onelevel'.
  86   `auth' is the authentication method to use, possible values depend on
  87 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
  88   `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
  89   `passwd' is the password to use for simple authentication.
  90   `deref' is one of the symbols `never', `always', `search' or `find'.
  91   `timelimit' is the timeout limit for the connection in seconds.
  92   `sizelimit' is the maximum number of matches to return.
  93 The function returns a list of matching entries.  Each entry is itself
  94 an alist of attribute/values.
  95 */
  96        (search_plist))
  97 {
  98  /* This function calls lisp */
  99
 100   /* Vars for query */
 101   LDAP *ld;
 102   LDAPMessage *res, *e;
 103   BerElement *ptr;
 104   char *a;
 105   int i, rc, err;
 106
 107   char *ldap_host = NULL;
 108   char *ldap_filter = NULL;
 109   char **ldap_attributes = NULL;
 110   int  ldap_attrsonly = 0;
 111   char *ldap_base = NULL;
 112   int  ldap_scope = LDAP_SCOPE_SUBTREE;
 113   int  ldap_auth = LDAP_AUTH_SIMPLE;
 114   char *ldap_binddn = NULL;
 115   char *ldap_passwd = NULL;
 116   int  ldap_deref = LDAP_DEREF_NEVER;
 117   int  ldap_timelimit = 0;
 118   int  ldap_sizelimit = 0;
 119
 120   char **vals = NULL;
 121   int  matches;
 122
 123   Lisp_Object list, entry, result, keyword, value;
 124   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
 125
 126   list = entry = result = keyword = value = Qnil;
 127   GCPRO5 (list, entry, result, keyword, value);
 128
 129
 130   EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
 131     {
 132       /* Host */
 133       if (EQ (keyword, Qhost))
 134         {
 135           CHECK_STRING (value);
 136           ldap_host = alloca (XSTRING_LENGTH (value) + 1);
 137           strcpy (ldap_host, (char *)XSTRING_DATA (value));
 138         }
 139       /* Filter */
 140       else if (EQ (keyword, Qfilter))
 141         {
 142           CHECK_STRING (value);
 143           ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
 144           strcpy (ldap_filter, (char *)XSTRING_DATA (value));
 145         }
 146       /* Attributes */
 147       else if (EQ (keyword, Qattributes))
 148         {
 149           if (! NILP (value))
 150             {
 151               Lisp_Object attr_left = value;
 152               struct gcpro ngcpro1;
 153
 154               NGCPRO1 (attr_left);
 155               CHECK_CONS (value);
 156
 157               ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
 158
 159               for (i=0; !NILP (attr_left); i++) {
 160                 CHECK_STRING (XCAR (attr_left));
 161                 ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
 162                 strcpy(ldap_attributes[i],
 163                        (char *)(XSTRING_DATA( XCAR (attr_left))));
 164                 attr_left = XCDR (attr_left);
 165               }
 166               ldap_attributes[i] = NULL;
 167               NUNGCPRO;
 168             }
 169         }
 170       /* Attributes Only */
 171       else if (EQ (keyword, Qattrsonly))
 172         {
 173           CHECK_SYMBOL (value);
 174           ldap_attrsonly = NILP (value) ? 0 : 1;
 175         }
 176       /* Base */
 177       else if (EQ (keyword, Qbase))
 178         {
 179           if (!NILP (value))
 180             {
 181               CHECK_STRING (value);
 182               ldap_base = alloca (XSTRING_LENGTH (value) + 1);
 183               strcpy (ldap_base, (char *)XSTRING_DATA (value));
 184             }
 185         }
 186       /* Scope */
 187       else if (EQ (keyword, Qscope))
 188         {
 189           CHECK_SYMBOL (value);
 190
 191           if (EQ (value, Qbase))
 192             ldap_scope = LDAP_SCOPE_BASE;
 193           else if (EQ (value, Qonelevel))
 194             ldap_scope = LDAP_SCOPE_ONELEVEL;
 195           else if (EQ (value, Qsubtree))
 196             ldap_scope = LDAP_SCOPE_SUBTREE;
 197           else
 198             signal_simple_error ("Invalid scope", value);
 199         }
 200       /* Authentication method */
 201       else if (EQ (keyword, Qauth))
 202         {
 203           CHECK_SYMBOL (value);
 204
 205           if (EQ (value, Qsimple))
 206             ldap_auth = LDAP_AUTH_SIMPLE;
 207 #ifdef LDAP_AUTH_KRBV41
 208           else if (EQ (value, Qkrbv41))
 209             ldap_auth = LDAP_AUTH_KRBV41;
 210 #endif
 211 #ifdef LDAP_AUTH_KRBV42
 212           else if (EQ (value, Qkrbv42))
 213             ldap_auth = LDAP_AUTH_KRBV42;
 214 #endif
 215           else
 216             signal_simple_error ("Invalid authentication method", value);
 217         }
 218       /* Bind DN */
 219       else if (EQ (keyword, Qbinddn))
 220         {
 221           if (!NILP (value))
 222             {
 223               CHECK_STRING (value);
 224               ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
 225               strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
 226             }
 227         }
 228       /* Password */
 229       else if (EQ (keyword, Qpasswd))
 230         {
 231           if (!NILP (value))
 232             {
 233               CHECK_STRING (value);
 234               ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
 235               strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
 236             }
 237         }
 238       /* Deref */
 239       else if (EQ (keyword, Qderef))
 240         {
 241           CHECK_SYMBOL (value);
 242           if (EQ (value, Qnever))
 243             ldap_deref = LDAP_DEREF_NEVER;
 244           else if (EQ (value, Qsearch))
 245             ldap_deref = LDAP_DEREF_SEARCHING;
 246           else if (EQ (value, Qfind))
 247             ldap_deref = LDAP_DEREF_FINDING;
 248           else if (EQ (value, Qalways))
 249             ldap_deref = LDAP_DEREF_ALWAYS;
 250           else
 251             signal_simple_error ("Invalid deref value", value);
 252         }
 253       /* Timelimit */
 254       else if (EQ (keyword, Qtimelimit))
 255         {
 256           if (!NILP (value))
 257             {
 258               CHECK_INT (value);
 259               ldap_timelimit = XINT (value);
 260             }
 261         }
 262       /* Sizelimit */
 263       else if (EQ (keyword, Qsizelimit))
 264         {
 265           if (!NILP (value))
 266             {
 267               CHECK_INT (value);
 268               ldap_sizelimit = XINT (value);
 269             }
 270         }
 271     }
 272
 273   /* Use ldap-default-base if no default base was given */
 274   if (ldap_base == NULL && !NILP (Vldap_default_base))
 275     {
 276       CHECK_STRING (Vldap_default_base);
 277       ldap_base = alloca (XSTRING_LENGTH (Vldap_default_base) + 1);
 278       strcpy (ldap_base, (char *)XSTRING_DATA (Vldap_default_base));
 279     }
 280
 281   /* Use ldap-default-host if no host was given */
 282   if (ldap_host == NULL && !NILP (Vldap_default_host))
 283     {
 284       CHECK_STRING (Vldap_default_host);
 285       ldap_host = alloca (XSTRING_LENGTH (Vldap_default_host) + 1);
 286       strcpy (ldap_host, (char *)XSTRING_DATA (Vldap_default_host));
 287     }
 288
 289   if (ldap_filter == NULL)
 290     error ("Empty search filter");
 291
 292   /* Garbage collect before connecting (if using UMich lib).
 293      This is ugly, I know, but without this, the UMich LDAP library 3.3
 294      frequently reports "Can't contact LDAP server".  I really need to
 295      check what happens inside that lib. Anyway this should be harmless to
 296      XEmacs and makes things work. */
 297 #if defined (HAVE_UMICH_LDAP)
 298   garbage_collect_1 ();
 299 #endif
 300
 301   /* Connect to the server and bind */
 302   message ("Connecting to %s...", ldap_host);
 303   if ( (ld = ldap_open (ldap_host, LDAP_PORT)) == NULL )
 304      signal_simple_error ("Failed connecting to host",
 305                           build_string (ldap_host));
 306
 307 #if HAVE_LDAP_SET_OPTION
 308   if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
 309     error ("Failed to set deref option");
 310   if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, (void *)&ldap_timelimit) != LDAP_SUCCESS)
 311     error ("Failed to set timelimit option");
 312   if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, (void *)&ldap_sizelimit) != LDAP_SUCCESS)
 313     error ("Failed to set sizelimit option");
 314   if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
 315     error ("Failed to set referral option");
 316 #else /* HAVE_LDAP_SET_OPTION */
 317   ld->ld_deref = ldap_deref;
 318   ld->ld_timelimit = ldap_timelimit;
 319   ld->ld_sizelimit = ldap_sizelimit;
 320 #ifdef LDAP_REFERRALS
 321   ld->ld_options = LDAP_OPT_REFERRALS;
 322 #else /* LDAP_REFERRALS */
 323   ld->ld_options = 0;
 324 #endif /* LDAP_REFERRALS */
 325 #endif /* HAVE_LDAP_SET_OPTION */
 326
 327   message ("Binding to %s...", ldap_host);
 328   if ( (err = (ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth ))) != LDAP_SUCCESS )
 329     signal_simple_error ("Failed binding to the server",
 330                          build_string (ldap_err2string (err)));
 331
 332   /* Perform the search */
 333   message ("Searching with LDAP on %s...", ldap_host);
 334   if ( ldap_search (ld, ldap_base, ldap_scope, ldap_filter,
 335                       ldap_attributes, ldap_attrsonly) == -1)
 336     {
 337       ldap_unbind (ld);
 338 #if HAVE_LDAP_GET_ERRNO
 339       signal_simple_error ("Error during LDAP search",
 340                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
 341 #else
 342       signal_simple_error ("Error during LDAP search",
 343                            build_string (ldap_err2string (ld->ld_errno)));
 344 #endif
 345     }
 346
 347   /* Build the results list */
 348   matches = 0;
 349
 350   while ( (rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res))
 351           == LDAP_RES_SEARCH_ENTRY )
 352     {
 353       matches ++;
 354       e = ldap_first_entry (ld, res);
 355       message ("Parsing results... %d", matches);
 356       entry = Qnil;
 357       for (a= ldap_first_attribute (ld, e, &ptr);
 358            a != NULL;
 359            a= ldap_next_attribute (ld, e, ptr) )
 360         {
 361           list = Fcons (build_string (a), Qnil);
 362           vals = ldap_get_values (ld, e, a);
 363           if (vals != NULL)
 364             {
 365               for (i=0; vals[i]!=NULL; i++)
 366                 {
 367                   list = Fcons (build_string (vals[i]),
 368                                 list);
 369                 }
 370             }
 371           entry = Fcons (Fnreverse (list),
 372                          entry);
 373           ldap_value_free (vals);
 374         }
 375       result = Fcons (Fnreverse (entry),
 376                       result);
 377       ldap_msgfree (res);
 378     }
 379
 380   if (rc == -1)
 381     {
 382 #if HAVE_LDAP_GET_ERRNO
 383       signal_simple_error ("Error retrieving result",
 384                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
 385 #else
 386       signal_simple_error ("Error retrieving result",
 387                            build_string (ldap_err2string (ld->ld_errno)));
 388 #endif
 389     }
 390
 391   if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS)
 392     {
 393 #if HAVE_LDAP_GET_ERRNO
 394       signal_simple_error ("Error on result",
 395                            build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
 396 #else
 397       signal_simple_error ("Error on result",
 398                            build_string (ldap_err2string (ld->ld_errno)));
 399 #endif
 400     }
 401
 402   ldap_msgfree (res);
 403   ldap_unbind (ld);
 404   message ("Done.");
 405
 406   result = Fnreverse (result);
 407   clear_message ();
 408
 409   UNGCPRO;
 410   return result;
 411 }
 412
 413 void
 414 syms_of_ldap (void)
 415 {
 416   DEFSUBR(Fldap_search_internal);
 417
 418   defsymbol (&Qhost, "host");
 419   defsymbol (&Qfilter, "filter");
 420   defsymbol (&Qattributes, "attributes");
 421   defsymbol (&Qattrsonly, "attrsonly");
 422   defsymbol (&Qbase, "base");
 423   defsymbol (&Qscope, "scope");
 424   defsymbol (&Qauth, "auth");
 425   defsymbol (&Qbinddn, "binddn");
 426   defsymbol (&Qpasswd, "passwd");
 427   defsymbol (&Qderef, "deref");
 428   defsymbol (&Qtimelimit, "timelimit");
 429   defsymbol (&Qsizelimit, "sizelimit");
 430   defsymbol (&Qbase, "base");
 431   defsymbol (&Qonelevel, "onelevel");
 432   defsymbol (&Qsubtree, "subtree");
 433 #ifdef LDAP_AUTH_KRBV41
 434   defsymbol (&Qkrbv41, "krbv41");
 435 #endif
 436 #ifdef LDAP_AUTH_KRBV42
 437   defsymbol (&Qkrbv42, "krbv42");
 438 #endif
 439   defsymbol (&Qnever, "never");
 440   defsymbol (&Qalways, "always");
 441   defsymbol (&Qfind, "find");
 442 }
 443
 444 void
 445 vars_of_ldap (void)
 446 {
 447   Fprovide (intern ("ldap-internal"));
 448
 449   DEFVAR_LISP ("ldap-default-host", &Vldap_default_host /*
 450 Default LDAP host.
 451 */ );
 452
 453   DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
 454 Default base for LDAP searches.
 455 This is a string using the syntax of RFC 1779.
 456 For instance, "o=ACME, c=US" limits the search to the
 457 Acme organization in the United States.
 458 */ );
 459
 460   Vldap_default_host =  Qnil;
 461   Vldap_default_base =  Qnil;
 462 }
 463
 464 #endif /* HAVE_LDAP */