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