--- a/modules/ldap/eldap.c	Mon Sep 09 21:53:43 2002 +0000
+++ b/modules/ldap/eldap.c	Tue Sep 10 15:27:39 2002 +0000
@@ -20,62 +20,193 @@
 
 /* Synched up with: Not in FSF. */
 
-/* Author: Oscar Figueiredo */
+/* Author: Oscar Figueiredo with lots of support from Hrvoje Niksic */
 
 /* 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) */
+   - OpenLDAP 1.2 (http://www.openldap.org/)
+   - Netscape's LDAP SDK (http://developer.netscape.com/) */
+
 
-#include <emodules.h>
+#include <config.h>
+#include "lisp.h"
+#include "opaque.h"
+#include "sysdep.h"
+#include "buffer.h"
+#include "process.h"		/* for report_process_error */
 
-#if defined (HAVE_LDAP)
-/* The entire file is within this conditional */
+#include <errno.h>
 
 #include "eldap.h"
-#include <lber.h>
-#include <ldap.h>
+
+static Fixnum ldap_default_port;
+static Lisp_Object Vldap_default_base;
+
+static Lisp_Object Qeldap;
 
-#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
+/* Needed by the lrecord definition */
+Lisp_Object Qldapp;
 
-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;
+/* ldap-open plist keywords */
+static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit, Qsizelimit;
 /* Search scope limits */
 static Lisp_Object Qbase, Qonelevel, Qsubtree;
 /* Authentication methods */
-#ifdef LDAP_AUTH_KRBV41
-static Lisp_Object Qkrbv41;
-#endif
-#ifdef LDAP_AUTH_KRBV42
-static Lisp_Object Qkrbv42;
-#endif
+static Lisp_Object Qkrbv41, Qkrbv42;
 /* Deref policy */
 static Lisp_Object Qnever, Qalways, Qfind;
+/* Modification types (Qdelete is defined in general.c) */
+static Lisp_Object Qadd, Qreplace;
 
-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.
+
+/************************************************************************/
+/*                         Utility Functions                            */
+/************************************************************************/
+
+static void
+signal_ldap_error (LDAP *ld, LDAPMessage *res, int ldap_err)
+{
+  if (ldap_err <= 0)
+    {
+#if defined HAVE_LDAP_PARSE_RESULT
+      int err;
+      ldap_err = ldap_parse_result (ld, res,
+                                    &err,
+                                    NULL, NULL, NULL, NULL, 0);
+      if (ldap_err == LDAP_SUCCESS)
+        ldap_err = err;
+#elif defined HAVE_LDAP_GET_LDERRNO
+      ldap_err = ldap_get_lderrno (ld, NULL, NULL);
+#elif defined HAVE_LDAP_RESULT2ERROR
+      ldap_err = ldap_result2error (ld, res, 0);
+#else
+      ldap_err = ld->ld_errno;
+#endif
+    }
+  invalid_operation ("LDAP error",
+		     build_string (ldap_err2string (ldap_err)));
+}
+
+
+/************************************************************************/
+/*                        ldap lrecord basic functions                  */
+/************************************************************************/
+
+static Lisp_Object
+make_ldap (Lisp_LDAP *ldap)
+{
+  return wrap_ldap (ldap);
+}
+
+#ifdef USE_KKCC
+static const struct lrecord_description ldap_description [] = {
+  { XD_LISP_OBJECT, offsetof (struct Lisp_LDAP, host) },
+  { XD_END }
+};
+#endif /* USE_KKCC */
+
+static Lisp_Object
+mark_ldap (Lisp_Object obj)
+{
+  return XLDAP (obj)->host;
+}
+
+static void
+print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
+{
+  Lisp_LDAP *ldap = XLDAP (obj);
+
+  if (print_readably)
+    printing_unreadable_object ("#<ldap %s>", XSTRING_DATA (ldap->host));
+
+  write_fmt_string_lisp (printcharfun, "#<ldap %S", 1, ldap->host);
+  if (!ldap->ld)
+    write_c_string (printcharfun,"(dead) ");
+  write_fmt_string (printcharfun, " 0x%lx>", (long)ldap);
+}
+
+static Lisp_LDAP *
+allocate_ldap (void)
+{
+  Lisp_LDAP *ldap = alloc_lcrecord_type (Lisp_LDAP, &lrecord_ldap);
+
+  ldap->ld = NULL;
+  ldap->host = Qnil;
+  return ldap;
+}
+
+static void
+finalize_ldap (void *header, int for_disksave)
+{
+  Lisp_LDAP *ldap = (Lisp_LDAP *) header;
+
+  if (for_disksave)
+    invalid_operation ("Can't dump an emacs containing LDAP objects",
+			 make_ldap (ldap));
+
+  if (ldap->ld)
+    ldap_unbind (ldap->ld);
+  ldap->ld = NULL;
+}
+
+#ifdef USE_KKCC
+DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
+			       0, /*dumpable-flag*/
+                               mark_ldap, print_ldap, finalize_ldap,
+                               NULL, NULL, ldap_description, Lisp_LDAP);
+#else /* not USE_KKCC */
+DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
+                               mark_ldap, print_ldap, finalize_ldap,
+                               NULL, NULL, 0, Lisp_LDAP);
+#endif /* not USE_KKCC */
+
+
+
+/************************************************************************/
+/*                        Basic ldap accessors                          */
+/************************************************************************/
+
+/* ###autoload */
+DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
+Return t if OBJECT is a LDAP connection.
+*/
+       (object))
+{
+  return LDAPP (object) ? Qt : Qnil;
+}
+
+DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
+Return the server host of the connection LDAP, as a string.
+*/
+       (ldap))
+{
+  CHECK_LDAP (ldap);
+  return (XLDAP (ldap))->host;
+}
+
+DEFUN ("ldap-live-p", Fldap_live_p, 1, 1, 0, /*
+Return t if LDAP is an active LDAP connection.
+*/
+       (ldap))
+{
+  CHECK_LDAP (ldap);
+  return (XLDAP (ldap))->ld ? Qt : Qnil;
+}
+
+/************************************************************************/
+/*                  Opening/Closing a LDAP connection                   */
+/************************************************************************/
+
+
+/* ###autoload */
+DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
+Open a LDAP connection to HOST.
+PLIST is a plist containing additional parameters for the connection.
 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'.
+  `port' the TCP port to use for the connection if different from
+`ldap-default-port'.
   `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).
@@ -83,364 +214,643 @@
   `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))
+       (host, plist))
 {
- /* This function calls lisp */
-
-  /* Vars for query */
+  /* This function can GC */
+  Lisp_LDAP *ldap;
   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_port = 0;
   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);
-
+  int  err;
 
-  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 *));
+  CHECK_STRING (host);
 
-              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;
+  {
+    EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
+      {
+	/* TCP Port */
+	if (EQ (keyword, Qport))
+	  {
+	    CHECK_INT (value);
+	    ldap_port = XINT (value);
+	  }
+	/* Authentication method */
+	if (EQ (keyword, Qauth))
+	  {
+	    if (EQ (value, Qsimple))
+	      ldap_auth = LDAP_AUTH_SIMPLE;
 #ifdef LDAP_AUTH_KRBV41
-          else if (EQ (value, Qkrbv41))
-            ldap_auth = 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;
+	    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);
-            }
-        }
+	    else
+	      invalid_constant ("Invalid authentication method", value);
+	  }
+	/* Bind DN */
+	else if (EQ (keyword, Qbinddn))
+	  {
+	    CHECK_STRING (value);
+	    LISP_STRING_TO_EXTERNAL (value, ldap_binddn, Qnative);
+	  }
+	/* Password */
+	else if (EQ (keyword, Qpasswd))
+	  {
+	    CHECK_STRING (value);
+	    LISP_STRING_TO_EXTERNAL (value, ldap_passwd, Qnative);
+	  }
+	/* Deref */
+	else if (EQ (keyword, Qderef))
+	  {
+	    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
+	      invalid_constant ("Invalid deref value", value);
+	  }
+	/* Timelimit */
+	else if (EQ (keyword, Qtimelimit))
+	  {
+	    CHECK_INT (value);
+	    ldap_timelimit = XINT (value);
+	  }
+	/* Sizelimit */
+	else if (EQ (keyword, Qsizelimit))
+	  {
+	    CHECK_INT (value);
+	    ldap_sizelimit = XINT (value);
+	  }
+      }
+  }
+
+  if (ldap_port == 0)
+    {
+      ldap_port = ldap_default_port;
     }
 
-  /* 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));
-    }
+  /* Connect to the server and bind */
+  slow_down_interrupts ();
+  ld = ldap_open ((char *) XSTRING_DATA (host), ldap_port);
+  speed_up_interrupts ();
 
-  /* 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");
+  if (ld == NULL )
+    report_process_error ("Failed connecting to host", host);
 
-  /* 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)
-  garbage_collect_1 ();
-#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 */
+#ifdef HAVE_LDAP_SET_OPTION
+  if ((err = ldap_set_option (ld, LDAP_OPT_DEREF,
+                              (void *)&ldap_deref)) != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, err);
+  if ((err = ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
+                              (void *)&ldap_timelimit)) != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, err);
+  if ((err = ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
+                              (void *)&ldap_sizelimit)) != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, err);
+  if ((err = ldap_set_option (ld, LDAP_OPT_REFERRALS,
+                              LDAP_OPT_ON)) != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, err);
+  if ((err = ldap_set_option (ld, LDAP_OPT_RESTART,
+                              LDAP_OPT_ON)) != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, err);
+#else  /* not 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 */
+#else /* not LDAP_REFERRALS */
   ld->ld_options = 0;
-#endif /* LDAP_REFERRALS */
-#endif /* HAVE_LDAP_SET_OPTION */
+#endif /* not LDAP_REFERRALS */
+  /* XEmacs uses interrupts (SIGIO,SIGALRM), LDAP calls need to ignore them */
+  ld->ld_options |= LDAP_OPT_RESTART;
+#endif /* not HAVE_LDAP_SET_OPTION */
+
+  err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
+  if (err != LDAP_SUCCESS)
+    {
+      Ibyte *interrmess;
+      EXTERNAL_TO_C_STRING (ldap_err2string (err), interrmess, Qnative);
+      signal_error (Qprocess_error, "Failed binding to the server",
+		    build_intstring (interrmess));
+    }
+
+  ldap = allocate_ldap ();
+  ldap->ld = ld;
+  ldap->host = host;
+
+  return make_ldap (ldap);
+}
+
+
+
+DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
+Close an LDAP connection.
+*/
+      (ldap))
+{
+  Lisp_LDAP *lldap;
+  CHECK_LIVE_LDAP (ldap);
+  lldap = XLDAP (ldap);
+  ldap_unbind (lldap->ld);
+  lldap->ld = NULL;
+  return Qnil;
+}
+
+
+
+/************************************************************************/
+/*                  Working on a LDAP connection                        */
+/************************************************************************/
+struct ldap_unwind_struct
+{
+  LDAPMessage *res;
+  struct berval **vals;
+};
+
+static Lisp_Object
+ldap_search_unwind (Lisp_Object unwind_obj)
+{
+  struct ldap_unwind_struct *unwind =
+    (struct ldap_unwind_struct *) get_opaque_ptr (unwind_obj);
+  if (unwind->res)
+    ldap_msgfree (unwind->res);
+  if (unwind->vals)
+    ldap_value_free_len (unwind->vals);
+  return Qnil;
+}
+
+/* The following function is called `ldap-search-basic' instead of      */
+/* plain `ldap-search' to maintain compatibility with the XEmacs 21.1   */
+/* API where `ldap-search' was the name of the high-level search        */
+/* function                                                             */
 
-  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)));
+DEFUN ("ldap-search-basic", Fldap_search_basic, 2, 8, 0, /*
+Perform a search on an open LDAP connection.
+LDAP is an LDAP connection object created with `ldap-open'.
+FILTER is a filter string for the search as described in RFC 1558.
+BASE is the distinguished name at which to start the search.
+SCOPE is one of the symbols `base', `onelevel' or `subtree' indicating
+the scope of the search.
+ATTRS is a list of strings indicating which attributes to retrieve
+ for each matching entry. If nil return all available attributes.
+If ATTRSONLY is non-nil then only the attributes are retrieved, not
+the associated values.
+If WITHDN is non-nil each entry in the result will be prepended with
+its distinguished name DN.
+If VERBOSE is non-nil progress messages will be echoed.
+The function returns a list of matching entries.  Each entry is itself
+an alist of attribute/value pairs optionally preceded by the DN of the
+entry according to the value of WITHDN.
+*/
+       (ldap, filter, base, scope, attrs, attrsonly, withdn, verbose))
+{
+  /* This function can GC */
+
+  /* Vars for query */
+  LDAP *ld;
+  LDAPMessage *e;
+  BerElement *ptr;
+  char *a, *dn;
+  int i, rc;
+  int  matches;
+  struct ldap_unwind_struct unwind;
+
+  int  ldap_scope = LDAP_SCOPE_SUBTREE;
+  char **ldap_attributes = NULL;
+
+  int speccount = specpdl_depth ();
+
+  Lisp_Object list   = Qnil;
+  Lisp_Object entry  = Qnil;
+  Lisp_Object result = Qnil;
+  struct gcpro gcpro1, gcpro2, gcpro3;
+
+  GCPRO3 (list, entry, result);
+
+  unwind.res = NULL;
+  unwind.vals = NULL;
+
+  /* Do all the parameter checking  */
+  CHECK_LIVE_LDAP (ldap);
+  ld = XLDAP (ldap)->ld;
+
+  /* Filter */
+  CHECK_STRING (filter);
+
+  /* Search base */
+  if (NILP (base))
+    {
+      base = Vldap_default_base;
+    }
+  if (!NILP (base))
+    {
+      CHECK_STRING (base);
+    }
+
+  /* Search scope */
+  if (!NILP (scope))
+    {
+      if (EQ (scope, Qbase))
+        ldap_scope = LDAP_SCOPE_BASE;
+      else if (EQ (scope, Qonelevel))
+        ldap_scope = LDAP_SCOPE_ONELEVEL;
+      else if (EQ (scope, Qsubtree))
+        ldap_scope = LDAP_SCOPE_SUBTREE;
+      else
+        invalid_constant ("Invalid scope", scope);
+    }
+
+  /* Attributes to search */
+  if (!NILP (attrs))
+    {
+      CHECK_CONS (attrs);
+      ldap_attributes = alloca_array (char *, 1 + XINT (Flength (attrs)));
+
+      i = 0;
+      EXTERNAL_LIST_LOOP (attrs, attrs)
+	{
+	  Lisp_Object current = XCAR (attrs);
+	  CHECK_STRING (current);
+	  LISP_STRING_TO_EXTERNAL (current, ldap_attributes[i], Qnative);
+	  ++i;
+	}
+      ldap_attributes[i] = NULL;
+    }
+
+  /* Attributes only ? */
+  CHECK_SYMBOL (attrsonly);
 
   /* 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)
+  if (ldap_search (ld,
+                   NILP (base) ? (char *) "" : (char *) XSTRING_DATA (base),
+                   ldap_scope,
+                   NILP (filter) ? (char *) "" : (char *) XSTRING_DATA (filter),
+                   ldap_attributes,
+                   NILP (attrsonly) ? 0 : 1)
+      == -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
+      signal_ldap_error (ld, NULL, 0);
     }
 
+  /* Ensure we don't exit without cleaning up */
+  record_unwind_protect (ldap_search_unwind,
+                         make_opaque_ptr (&unwind));
+
   /* Build the results list */
   matches = 0;
 
-  while ( (rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res))
-          == LDAP_RES_SEARCH_ENTRY )
+  rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &unwind.res);
+
+  while (rc == LDAP_RES_SEARCH_ENTRY)
     {
+      QUIT;
       matches ++;
-      e = ldap_first_entry (ld, res);
-      message ("Parsing results... %d", matches);
+      e = ldap_first_entry (ld, unwind.res);
+      /* #### This call to message() is pretty fascist, because it
+         destroys the current echo area contents, even when invoked
+         from Lisp.  It should use echo_area_message() instead, and
+         restore the old echo area contents later.  */
+      if (! NILP (verbose))
+        message ("Parsing ldap results... %d", matches);
       entry = Qnil;
+      /* Get the DN if required */
+      if (! NILP (withdn))
+        {
+          dn = ldap_get_dn (ld, e);
+          if (dn == NULL)
+            signal_ldap_error (ld, e, 0);
+          entry = Fcons (build_ext_string (dn, Qnative), Qnil);
+        }
       for (a= ldap_first_attribute (ld, e, &ptr);
            a != NULL;
-           a= ldap_next_attribute (ld, e, ptr) )
+           a = ldap_next_attribute (ld, e, ptr) )
         {
-          list = Fcons (build_string (a), Qnil);
-          vals = ldap_get_values (ld, e, a);
-          if (vals != NULL)
+          list = Fcons (build_ext_string (a, Qnative), Qnil);
+          unwind.vals = ldap_get_values_len (ld, e, a);
+          if (unwind.vals != NULL)
             {
-              for (i=0; vals[i]!=NULL; i++)
+              for (i = 0; unwind.vals[i] != NULL; i++)
                 {
-                  list = Fcons (build_string (vals[i]),
+                  list = Fcons (make_ext_string ((Extbyte *) unwind.vals[i]->bv_val,
+                                                 unwind.vals[i]->bv_len,
+                                                 Qnative),
                                 list);
                 }
             }
           entry = Fcons (Fnreverse (list),
                          entry);
-          ldap_value_free (vals);
+          ldap_value_free_len (unwind.vals);
+          unwind.vals = NULL;
         }
       result = Fcons (Fnreverse (entry),
                       result);
-      ldap_msgfree (res);
-    }
+      ldap_msgfree (unwind.res);
+      unwind.res = NULL;
 
-  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
+      rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &(unwind.res));
     }
 
-  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))));
+#if defined HAVE_LDAP_PARSE_RESULT
+  {
+    int rc2 = ldap_parse_result (ld, unwind.res,
+				 &rc,
+				 NULL, NULL, NULL, NULL, 0);
+    if (rc2 != LDAP_SUCCESS)
+      rc = rc2;
+  }
 #else
-      signal_simple_error ("Error on result",
-                           build_string (ldap_err2string (ld->ld_errno)));
+  if (rc == 0)
+    signal_ldap_error (ld, NULL, LDAP_TIMELIMIT_EXCEEDED);
+
+  if (rc == -1)
+    signal_ldap_error (ld, unwind.res, (unwind.res==NULL) ? ld->ld_errno : 0);
+
+#if defined HAVE_LDAP_RESULT2ERROR
+  rc = ldap_result2error (ld, unwind.res, 0);
+#endif
 #endif
-    }
+
+  if (rc != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, rc);
+
+  ldap_msgfree (unwind.res);
+  unwind.res = (LDAPMessage *)NULL;
+
+  /* #### See above for calling message().  */
+  if (! NILP (verbose))
+    message ("Parsing ldap results... done");
+
+  unbind_to (speccount);
+  UNGCPRO;
+  return Fnreverse (result);
+}
+
+DEFUN ("ldap-add", Fldap_add, 3, 3, 0, /*
+Add an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to add.
+ENTRY is an entry specification, i.e., a list of cons cells
+containing attribute/value string pairs.
+*/
+       (ldap, dn, entry))
+{
+  LDAP *ld;
+  LDAPMod *ldap_mods, **ldap_mods_ptrs;
+  struct berval *bervals;
+  int rc;
+  int i, j;
+  Elemcount len;
+
+  Lisp_Object current = Qnil;
+  Lisp_Object values  = Qnil;
+  struct gcpro gcpro1, gcpro2;
+
+  GCPRO2 (current, values);
+
+  /* Do all the parameter checking  */
+  CHECK_LIVE_LDAP (ldap);
+  ld = XLDAP (ldap)->ld;
+
+  /* Check the DN */
+  CHECK_STRING (dn);
+
+  /* Check the entry */
+  CHECK_CONS (entry);
+  if (NILP (entry))
+    invalid_operation ("Cannot add void entry", entry);
 
-  ldap_msgfree (res);
-  ldap_unbind (ld);
-  message ("Done.");
-
-  result = Fnreverse (result);
-  clear_message ();
+  /* Build the ldap_mods array */
+  len = (Elemcount) XINT (Flength (entry));
+  ldap_mods = alloca_array (LDAPMod, len);
+  ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+  i = 0;
+  EXTERNAL_LIST_LOOP (entry, entry)
+    {
+      current = XCAR (entry);
+      CHECK_CONS (current);
+      CHECK_STRING (XCAR (current));
+      ldap_mods_ptrs[i] = &(ldap_mods[i]);
+      LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
+      ldap_mods[i].mod_op = LDAP_MOD_ADD | LDAP_MOD_BVALUES;
+      values = XCDR (current);
+      if (CONSP (values))
+        {
+	  len = (Elemcount) XINT (Flength (values));
+          bervals = alloca_array (struct berval, len);
+          ldap_mods[i].mod_vals.modv_bvals =
+            alloca_array (struct berval *, 1 + len);
+          j = 0;
+          EXTERNAL_LIST_LOOP (values, values)
+            {
+              current = XCAR (values);
+              CHECK_STRING (current);
+              ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+	      TO_EXTERNAL_FORMAT (LISP_STRING, current,
+				  ALLOCA, (bervals[j].bv_val,
+					   bervals[j].bv_len),
+				  Qnative);
+              j++;
+            }
+          ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+        }
+      else
+        {
+          CHECK_STRING (values);
+          bervals = alloca_array (struct berval, 1);
+          ldap_mods[i].mod_vals.modv_bvals = alloca_array (struct berval *, 2);
+          ldap_mods[i].mod_vals.modv_bvals[0] = &(bervals[0]);
+	  TO_EXTERNAL_FORMAT (LISP_STRING, values,
+			      ALLOCA, (bervals[0].bv_val,
+				       bervals[0].bv_len),
+			      Qnative);
+          ldap_mods[i].mod_vals.modv_bvals[1] = NULL;
+        }
+      i++;
+    }
+  ldap_mods_ptrs[i] = NULL;
+  rc = ldap_add_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
+  if (rc != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, rc);
 
   UNGCPRO;
-  return result;
+  return Qnil;
+}
+
+DEFUN ("ldap-modify", Fldap_modify, 3, 3, 0, /*
+Add an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to modify.
+MODS is a list of modifications to apply.
+A modification is a list of the form (MOD-OP ATTR VALUE1 VALUE2 ...)
+MOD-OP and ATTR are mandatory, VALUEs are optional depending on MOD-OP.
+MOD-OP is the type of modification, one of the symbols `add', `delete'
+or `replace'. ATTR is the LDAP attribute type to modify.
+*/
+       (ldap, dn, mods))
+{
+  LDAP *ld;
+  LDAPMod *ldap_mods, **ldap_mods_ptrs;
+  struct berval *bervals;
+  int i, j, rc;
+  Lisp_Object mod_op;
+  Elemcount len;
+
+  Lisp_Object current = Qnil;
+  Lisp_Object values  = Qnil;
+  struct gcpro gcpro1, gcpro2;
+
+  /* Do all the parameter checking  */
+  CHECK_LIVE_LDAP (ldap);
+  ld = XLDAP (ldap)->ld;
+
+  /* Check the DN */
+  CHECK_STRING (dn);
+
+  /* Check the entry */
+  CHECK_CONS (mods);
+  if (NILP (mods))
+    return Qnil;
+
+  /* Build the ldap_mods array */
+  len = (Elemcount) XINT (Flength (mods));
+  ldap_mods = alloca_array (LDAPMod, len);
+  ldap_mods_ptrs = alloca_array (LDAPMod *, 1 + len);
+  i = 0;
+
+  GCPRO2 (current, values);
+  EXTERNAL_LIST_LOOP (mods, mods)
+    {
+      current = XCAR (mods);
+      CHECK_CONS (current);
+      CHECK_SYMBOL (XCAR (current));
+      mod_op = XCAR (current);
+      ldap_mods_ptrs[i] = &(ldap_mods[i]);
+      ldap_mods[i].mod_op = LDAP_MOD_BVALUES;
+      if (EQ (mod_op, Qadd))
+        ldap_mods[i].mod_op |= LDAP_MOD_ADD;
+      else if (EQ (mod_op, Qdelete))
+        ldap_mods[i].mod_op |= LDAP_MOD_DELETE;
+      else if (EQ (mod_op, Qreplace))
+        ldap_mods[i].mod_op |= LDAP_MOD_REPLACE;
+      else
+        invalid_constant ("Invalid LDAP modification type", mod_op);
+      current = XCDR (current);
+      CHECK_STRING (XCAR (current));
+      LISP_STRING_TO_EXTERNAL (XCAR (current), ldap_mods[i].mod_type, Qnative);
+      values = XCDR (current);
+      len = (Elemcount) XINT (Flength (values));
+      bervals = alloca_array (struct berval, len);
+      ldap_mods[i].mod_vals.modv_bvals =
+        alloca_array (struct berval *, 1 + len);
+      j = 0;
+      EXTERNAL_LIST_LOOP (values, values)
+        {
+          current = XCAR (values);
+          CHECK_STRING (current);
+          ldap_mods[i].mod_vals.modv_bvals[j] = &(bervals[j]);
+	  TO_EXTERNAL_FORMAT (LISP_STRING, current,
+			      ALLOCA, (bervals[j].bv_val,
+				       bervals[j].bv_len),
+			      Qnative);
+          j++;
+        }
+      ldap_mods[i].mod_vals.modv_bvals[j] = NULL;
+      i++;
+    }
+  ldap_mods_ptrs[i] = NULL;
+  rc = ldap_modify_s (ld, (char *) XSTRING_DATA (dn), ldap_mods_ptrs);
+  if (rc != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, rc);
+
+  UNGCPRO;
+  return Qnil;
+}
+
+
+DEFUN ("ldap-delete", Fldap_delete, 2, 2, 0, /*
+Delete an entry to an LDAP directory.
+LDAP is an LDAP connection object created with `ldap-open'.
+DN is the distinguished name of the entry to delete.
+*/
+       (ldap, dn))
+{
+  LDAP *ld;
+  int rc;
+
+  /* Check parameters */
+  CHECK_LIVE_LDAP (ldap);
+  ld = XLDAP (ldap)->ld;
+  CHECK_STRING (dn);
+
+  rc = ldap_delete_s (ld, (char *) XSTRING_DATA (dn));
+  if (rc != LDAP_SUCCESS)
+    signal_ldap_error (ld, NULL, rc);
+
+  return Qnil;
 }
 
 void
-syms_of_ldap (void)
+syms_of_eldap (void)
 {
-  DEFSUBR(Fldap_search_internal);
+  INIT_LRECORD_IMPLEMENTATION (ldap);
 
-  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");
-#ifdef LDAP_AUTH_KRBV41
-  defsymbol (&Qkrbv41, "krbv41");
-#endif
-#ifdef LDAP_AUTH_KRBV42
-  defsymbol (&Qkrbv42, "krbv42");
-#endif
-  defsymbol (&Qnever, "never");
-  defsymbol (&Qalways, "always");
-  defsymbol (&Qfind, "find");
+  DEFSYMBOL (Qeldap);
+  DEFSYMBOL (Qldapp);
+  DEFSYMBOL (Qport);
+  DEFSYMBOL (Qauth);
+  DEFSYMBOL (Qbinddn);
+  DEFSYMBOL (Qpasswd);
+  DEFSYMBOL (Qderef);
+  DEFSYMBOL (Qtimelimit);
+  DEFSYMBOL (Qsizelimit);
+  DEFSYMBOL (Qbase);
+  DEFSYMBOL (Qonelevel);
+  DEFSYMBOL (Qsubtree);
+  DEFSYMBOL (Qkrbv41);
+  DEFSYMBOL (Qkrbv42);
+  DEFSYMBOL (Qnever);
+  DEFSYMBOL (Qalways);
+  DEFSYMBOL (Qfind);
+  DEFSYMBOL (Qadd);
+  DEFSYMBOL (Qreplace);
+
+  DEFSUBR (Fldapp);
+  DEFSUBR (Fldap_host);
+  DEFSUBR (Fldap_live_p);
+  DEFSUBR (Fldap_open);
+  DEFSUBR (Fldap_close);
+  DEFSUBR (Fldap_search_basic);
+  DEFSUBR (Fldap_add);
+  DEFSUBR (Fldap_modify);
+  DEFSUBR (Fldap_delete);
 }
 
 void
-vars_of_ldap (void)
+vars_of_eldap (void)
 {
-  Fprovide (intern ("ldap-internal"));
+
+  Fprovide (Qeldap);
 
-  DEFVAR_LISP ("ldap-default-host", &Vldap_default_host /*
-Default LDAP host.
+  ldap_default_port = LDAP_PORT;
+  Vldap_default_base =  Qnil;
+
+  DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
+Default TCP port for LDAP connections.
+Initialized from the LDAP library. Default value is 389.
 */ );
 
   DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
@@ -450,8 +860,34 @@
 Acme organization in the United States.
 */ );
 
-  Vldap_default_host =  Qnil;
-  Vldap_default_base =  Qnil;
 }
 
-#endif /* HAVE_LDAP */
+#ifdef HAVE_SHLIB
+void
+unload_eldap (void)
+{
+  /* Remove defined types */
+  UNDEF_LRECORD_IMPLEMENTATION (ldap);
+
+  /* Remove staticpro'ing of symbols */
+  unstaticpro_nodump (&Qeldap);
+  unstaticpro_nodump (&Qldapp);
+  unstaticpro_nodump (&Qport);
+  unstaticpro_nodump (&Qauth);
+  unstaticpro_nodump (&Qbinddn);
+  unstaticpro_nodump (&Qpasswd);
+  unstaticpro_nodump (&Qderef);
+  unstaticpro_nodump (&Qtimelimit);
+  unstaticpro_nodump (&Qsizelimit);
+  unstaticpro_nodump (&Qbase);
+  unstaticpro_nodump (&Qonelevel);
+  unstaticpro_nodump (&Qsubtree);
+  unstaticpro_nodump (&Qkrbv41);
+  unstaticpro_nodump (&Qkrbv42);
+  unstaticpro_nodump (&Qnever);
+  unstaticpro_nodump (&Qalways);
+  unstaticpro_nodump (&Qfind);
+  unstaticpro_nodump (&Qadd);
+  unstaticpro_nodump (&Qreplace);
+}
+#endif /* HAVE_SHLIB */