--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/eldap.c	Mon Aug 13 10:23:02 2007 +0200
@@ -0,0 +1,466 @@
+/* LDAP client interface for XEmacs.
+   Copyright (C) ***FIXME***
+
+This file is part of XEmacs.
+
+XEmacs is free software; you can redistribute it and/or modify it
+under the terms of the GNU General Public License as published by the
+Free Software Foundation; either version 2, or (at your option) any
+later version.
+
+XEmacs is distributed in the hope that it will be useful, but WITHOUT
+ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with XEmacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+Boston, MA 02111-1307, USA.  */
+
+/* Synched up with: Not in FSF. */
+
+/* Author: Oscar Figueiredo */
+
+/* This file provides lisp primitives for access to an LDAP library
+   conforming to the API defined in RFC 1823.
+   It has been tested with:
+   - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
+   - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
+
+
+
+#include <config.h>
+
+#if defined (HAVE_LDAP)
+
+/* The entire file is within this conditional */
+
+#include "lisp.h"
+
+#include "eldap.h"
+#include <lber.h>
+#include <ldap.h>
+
+#ifdef HAVE_NS_LDAP
+#define HAVE_LDAP_SET_OPTION 1
+#define HAVE_LDAP_GET_ERRNO 1
+#else
+#undef HAVE_LDAP_SET_OPTION
+#undef HAVE_LDAP_GET_ERRNO
+#endif
+
+static Lisp_Object Vldap_default_base;
+static Lisp_Object Vldap_default_host;
+
+/* ldap-search-internal plist keywords */
+static Lisp_Object Qhost, Qfilter, Qattributes, Qattrsonly, Qbase, Qscope,
+  Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
+/* Search scope limits */
+static Lisp_Object Qbase, Qonelevel, Qsubtree;
+/* Authentication methods */
+static Lisp_Object Qsimple;
+#ifdef LDAP_AUTH_KRBV41
+static Lisp_Object Qkrbv41;
+#endif
+#ifdef LDAP_AUTH_KRBV42
+static Lisp_Object Qkrbv42;
+#endif
+/* Deref policy */
+static Lisp_Object Qnever, Qalways, Qsearch, Qfind;
+
+DEFUN ("ldap-search-internal", Fldap_search_internal, 1, 1, 0, /*
+Perform a search on a LDAP server.
+SEARCH-PLIST is a property list describing the search request.
+Valid keys in that list are:
+  `host' is a string naming one or more (blank separated) LDAP servers to
+to try to connect to. Each host name may optionally be of the form host:port.
+  `filter' is a filter string for the search as described in RFC 1558
+  `attributes' is a list of strings indicating which attributes to retrieve
+for each matching entry. If nil return all available attributes.
+  `attrsonly' if non-nil indicates that only the attributes are retrieved, not
+the associated values.
+  `base' is the base for the search as described in RFC 1779.
+  `scope' is one of the three symbols `subtree', `base' or `onelevel'.
+  `auth' is the authentication method to use, possible values depend on
+the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
+  `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
+  `passwd' is the password to use for simple authentication.
+  `deref' is one of the symbols `never', `always', `search' or `find'.
+  `timelimit' is the timeout limit for the connection in seconds.
+  `sizelimit' is the maximum number of matches to return.
+The function returns a list of matching entries.  Each entry is itself
+an alist of attribute/values.
+*/
+       (search_plist))
+{
+ /* This function calls lisp */
+
+  /* Vars for query */
+  LDAP *ld;
+  LDAPMessage *res, *e;
+  BerElement *ptr;
+  char *a;
+  int i, rc, err;
+
+  char *ldap_host = NULL;
+  char *ldap_filter = NULL;
+  char **ldap_attributes = NULL;
+  int  ldap_attrsonly = 0;
+  char *ldap_base = NULL;
+  int  ldap_scope = LDAP_SCOPE_SUBTREE;
+  int  ldap_auth = LDAP_AUTH_SIMPLE;
+  char *ldap_binddn = NULL;
+  char *ldap_passwd = NULL;
+  int  ldap_deref = LDAP_DEREF_NEVER;
+  int  ldap_timelimit = 0;
+  int  ldap_sizelimit = 0;
+
+  char **vals = NULL;
+  int  matches;
+
+  Lisp_Object list, entry, result, keyword, value;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
+
+  list = entry = result = keyword = value = Qnil;
+  GCPRO5 (list, entry, result, keyword, value);
+
+
+  EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, search_plist)
+    {
+      /* Host */
+      if (EQ (keyword, Qhost))
+        {
+          CHECK_STRING (value);
+          ldap_host = alloca (XSTRING_LENGTH (value) + 1);
+          strcpy (ldap_host, (char *)XSTRING_DATA (value));
+        }
+      /* Filter */
+      else if (EQ (keyword, Qfilter))
+        {
+          CHECK_STRING (value);
+          ldap_filter = alloca (XSTRING_LENGTH (value) + 1);
+          strcpy (ldap_filter, (char *)XSTRING_DATA (value));
+        }
+      /* Attributes */
+      else if (EQ (keyword, Qattributes))
+        {
+          if (! NILP (value))
+            {
+              Lisp_Object attr_left = value;
+              struct gcpro ngcpro1;
+
+              NGCPRO1 (attr_left);
+              CHECK_CONS (value);
+
+              ldap_attributes = alloca ((XINT (Flength (value)) + 1)*sizeof (char *));
+
+              for (i=0; !NILP (attr_left); i++) {
+                CHECK_STRING (XCAR (attr_left));
+                ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
+                strcpy(ldap_attributes[i],
+                       (char *)(XSTRING_DATA( XCAR (attr_left))));
+                attr_left = XCDR (attr_left);
+              }
+              ldap_attributes[i] = NULL;
+              NUNGCPRO;
+            }
+        }
+      /* Attributes Only */
+      else if (EQ (keyword, Qattrsonly))
+        {
+          CHECK_SYMBOL (value);
+          ldap_attrsonly = NILP (value) ? 0 : 1;
+        }
+      /* Base */
+      else if (EQ (keyword, Qbase))
+        {
+          if (!NILP (value))
+            {
+              CHECK_STRING (value);
+              ldap_base = alloca (XSTRING_LENGTH (value) + 1);
+              strcpy (ldap_base, (char *)XSTRING_DATA (value));
+            }
+        }
+      /* Scope */
+      else if (EQ (keyword, Qscope))
+        {
+          CHECK_SYMBOL (value);
+
+          if (EQ (value, Qbase))
+            ldap_scope = LDAP_SCOPE_BASE;
+          else if (EQ (value, Qonelevel))
+            ldap_scope = LDAP_SCOPE_ONELEVEL;
+          else if (EQ (value, Qsubtree))
+            ldap_scope = LDAP_SCOPE_SUBTREE;
+          else
+            signal_simple_error ("Invalid scope", value);
+        }
+      /* Authentication method */
+      else if (EQ (keyword, Qauth))
+        {
+          CHECK_SYMBOL (value);
+
+          if (EQ (value, Qsimple))
+            ldap_auth = LDAP_AUTH_SIMPLE;
+#ifdef LDAP_AUTH_KRBV41
+          else if (EQ (value, Qkrbv41))
+            ldap_auth = LDAP_AUTH_KRBV41;
+#endif
+#ifdef LDAP_AUTH_KRBV42
+          else if (EQ (value, Qkrbv42))
+            ldap_auth = LDAP_AUTH_KRBV42;
+#endif
+          else
+            signal_simple_error ("Invalid authentication method", value);
+        }
+      /* Bind DN */
+      else if (EQ (keyword, Qbinddn))
+        {
+          if (!NILP (value))
+            {
+              CHECK_STRING (value);
+              ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
+              strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
+            }
+        }
+      /* Password */
+      else if (EQ (keyword, Qpasswd))
+        {
+          if (!NILP (value))
+            {
+              CHECK_STRING (value);
+              ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
+              strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
+            }
+        }
+      /* Deref */
+      else if (EQ (keyword, Qderef))
+        {
+          CHECK_SYMBOL (value);
+          if (EQ (value, Qnever))
+            ldap_deref = LDAP_DEREF_NEVER;
+          else if (EQ (value, Qsearch))
+            ldap_deref = LDAP_DEREF_SEARCHING;
+          else if (EQ (value, Qfind))
+            ldap_deref = LDAP_DEREF_FINDING;
+          else if (EQ (value, Qalways))
+            ldap_deref = LDAP_DEREF_ALWAYS;
+          else
+            signal_simple_error ("Invalid deref value", value);
+        }
+      /* Timelimit */
+      else if (EQ (keyword, Qtimelimit))
+        {
+          if (!NILP (value))
+            {
+              CHECK_INT (value);
+              ldap_timelimit = XINT (value);
+            }
+        }
+      /* Sizelimit */
+      else if (EQ (keyword, Qsizelimit))
+        {
+          if (!NILP (value))
+            {
+              CHECK_INT (value);
+              ldap_sizelimit = XINT (value);
+            }
+        }
+    }
+
+  /* Use ldap-default-base if no default base was given */
+  if (ldap_base == NULL && !NILP (Vldap_default_base))
+    {
+      CHECK_STRING (Vldap_default_base);
+      ldap_base = alloca (XSTRING_LENGTH (Vldap_default_base) + 1);
+      strcpy (ldap_base, (char *)XSTRING_DATA (Vldap_default_base));
+    }
+
+  /* Use ldap-default-host if no host was given */
+  if (ldap_host == NULL && !NILP (Vldap_default_host))
+    {
+      CHECK_STRING (Vldap_default_host);
+      ldap_host = alloca (XSTRING_LENGTH (Vldap_default_host) + 1);
+      strcpy (ldap_host, (char *)XSTRING_DATA (Vldap_default_host));
+    }
+
+  if (ldap_filter == NULL)
+    error ("Empty search filter");
+
+  /* Garbage collect before connecting (if using UMich lib).
+     This is ugly, I know, but without this, the UMich LDAP library 3.3
+     frequently reports "Can't contact LDAP server".  I really need to
+     check what happens inside that lib. Anyway this should be harmless to
+     XEmacs and makes things work. */
+#if defined (HAVE_UMICH_LDAP)
+  Fgarbage_collect ();
+#endif
+
+  /* Connect to the server and bind */
+  message ("Connecting to %s...", ldap_host);
+  if ( (ld = ldap_open (ldap_host, LDAP_PORT)) == NULL )
+     signal_simple_error ("Failed connecting to host",
+                          build_string (ldap_host));
+
+#if HAVE_LDAP_SET_OPTION
+  if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
+    error ("Failed to set deref option");
+  if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT, (void *)&ldap_timelimit) != LDAP_SUCCESS)
+    error ("Failed to set timelimit option");
+  if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT, (void *)&ldap_sizelimit) != LDAP_SUCCESS)
+    error ("Failed to set sizelimit option");
+  if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
+    error ("Failed to set referral option");
+#else /* HAVE_LDAP_SET_OPTION */
+  ld->ld_deref = ldap_deref;
+  ld->ld_timelimit = ldap_timelimit;
+  ld->ld_sizelimit = ldap_sizelimit;
+#ifdef LDAP_REFERRALS
+  ld->ld_options = LDAP_OPT_REFERRALS;
+#else /* LDAP_REFERRALS */
+  ld->ld_options = 0;
+#endif /* LDAP_REFERRALS */
+#endif /* HAVE_LDAP_SET_OPTION */
+
+  message ("Binding to %s...", ldap_host);
+  if ( (err = (ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth ))) != LDAP_SUCCESS )
+    signal_simple_error ("Failed binding to the server",
+                         build_string (ldap_err2string (err)));
+
+  /* Perform the search */
+  message ("Searching with LDAP on %s...", ldap_host);
+  if ( ldap_search (ld, ldap_base, ldap_scope, ldap_filter,
+                      ldap_attributes, ldap_attrsonly) == -1)
+    {
+      ldap_unbind (ld);
+#if HAVE_LDAP_GET_ERRNO
+      signal_simple_error ("Error during LDAP search",
+                           build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
+#else
+      signal_simple_error ("Error during LDAP search",
+                           build_string (ldap_err2string (ld->ld_errno)));
+#endif
+    }
+
+  /* Build the results list */
+  matches = 0;
+
+  while ( (rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res))
+          == LDAP_RES_SEARCH_ENTRY )
+    {
+      matches ++;
+      e = ldap_first_entry (ld, res);
+      message ("Parsing results... %d", matches);
+      entry = Qnil;
+      for (a= ldap_first_attribute (ld, e, &ptr);
+           a != NULL;
+           a= ldap_next_attribute (ld, e, ptr) )
+        {
+          list = Fcons (build_string (a), Qnil);
+          vals = ldap_get_values (ld, e, a);
+          if (vals != NULL)
+            {
+              for (i=0; vals[i]!=NULL; i++)
+                {
+                  list = Fcons (build_string (vals[i]),
+                                list);
+                }
+            }
+          entry = Fcons (Fnreverse (list),
+                         entry);
+          ldap_value_free (vals);
+        }
+      result = Fcons (Fnreverse (entry),
+                      result);
+      ldap_msgfree (res);
+    }
+
+  if (rc == -1)
+    {
+#if HAVE_LDAP_GET_ERRNO
+      signal_simple_error ("Error retrieving result",
+                           build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
+#else
+      signal_simple_error ("Error retrieving result",
+                           build_string (ldap_err2string (ld->ld_errno)));
+#endif
+    }
+
+  if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS)
+    {
+#if HAVE_LDAP_GET_ERRNO
+      signal_simple_error ("Error on result",
+                           build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
+#else
+      signal_simple_error ("Error on result",
+                           build_string (ldap_err2string (ld->ld_errno)));
+#endif
+    }
+
+  ldap_msgfree (res);
+  ldap_unbind (ld);
+  message ("Done.");
+
+  result = Fnreverse (result);
+  clear_message ();
+
+  UNGCPRO;
+  return result;
+}
+
+
+void
+syms_of_eldap (void)
+{
+  DEFSUBR(Fldap_search_internal);
+
+  defsymbol (&Qhost, "host");
+  defsymbol (&Qfilter, "filter");
+  defsymbol (&Qattributes, "attributes");
+  defsymbol (&Qattrsonly, "attrsonly");
+  defsymbol (&Qbase, "base");
+  defsymbol (&Qscope, "scope");
+  defsymbol (&Qauth, "auth");
+  defsymbol (&Qbinddn, "binddn");
+  defsymbol (&Qpasswd, "passwd");
+  defsymbol (&Qderef, "deref");
+  defsymbol (&Qtimelimit, "timelimit");
+  defsymbol (&Qsizelimit, "sizelimit");
+  defsymbol (&Qbase, "base");
+  defsymbol (&Qonelevel, "onelevel");
+  defsymbol (&Qsubtree, "subtree");
+  defsymbol (&Qsimple, "simple");
+#ifdef LDAP_AUTH_KRBV41
+  defsymbol (&Qkrbv41, "krbv41");
+#endif
+#ifdef LDAP_AUTH_KRBV42
+  defsymbol (&Qkrbv42, "krbv42");
+#endif
+  defsymbol (&Qnever, "never");
+  defsymbol (&Qalways, "always");
+  defsymbol (&Qsearch, "search");
+  defsymbol (&Qfind, "find");
+}
+
+void
+vars_of_eldap (void)
+{
+  Fprovide (intern ("ldap-internal"));
+
+  DEFVAR_LISP ("ldap-default-host", &Vldap_default_host /*
+Default LDAP host.
+*/ );
+
+  DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
+Default base for LDAP searches.
+This is a string using the syntax of RFC 1779.
+For instance, "o=ACME, c=US" limits the search to the
+Acme organization in the United States.
+*/ );
+
+  Vldap_default_host =  Qnil;
+  Vldap_default_base =  Qnil;
+}
+
+#endif /* HAVE_LDAP */