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