From cca43c60f8669d72ef66a3cc8bd348adc17dbee8 Mon Sep 17 00:00:00 2001
From: Kurt Zeilenga <kurt@openldap.org>
Date: Wed, 30 May 2001 06:38:23 +0000
Subject: [PATCH] Update TCL API
---
contrib/ldaptcl/CHANGES | 19 +++
contrib/ldaptcl/configure | 6 +-
contrib/ldaptcl/configure.in | 6 +-
contrib/ldaptcl/ldap.n | 29 +++-
contrib/ldaptcl/neoXldap.c | 252 ++++++++++++++++++++++++++---------
5 files changed, 240 insertions(+), 72 deletions(-)
diff --git a/contrib/ldaptcl/CHANGES b/contrib/ldaptcl/CHANGES
index 2a7b8ce6ae..09e976c6be 100644
--- a/contrib/ldaptcl/CHANGES
+++ b/contrib/ldaptcl/CHANGES
@@ -1,3 +1,22 @@
+Package rersion 2.0:
+- Detects OpenLDAP 2.0 and builds correctly with it.
+- Increment major version to 2, library file to libldaptcl2.0.so.
+- Can now perform add/delete/replace modifications in a single command.
+- Replaced calls to TclX_WrongArgs with core Tcl_WrongNumArgs to reduce
+ dependency on Extended Tcl.
+- Wrap dereference search control with #ifdef LDAP_OPT_DEREF.
+- Deref during search should work.
+- Add protocol_version option to ldap init command.
+- Add LDAPTCL_PROTOCOL_VERSION_DEFAULT to allow specifying the default
+ protocol version used.
+- Add controlArray(timeout) to control timeouts during searches.
+- Add controlArray(cache) to control caching current search results.
+ (Experience has shown this to be not very useful or not working correctly.
+ Caching search results should probably be done in Ldaptcl rather than
+ letting the LDAP API do it.)
+- Add "compare" subcommand
+- Add experimental trap subcommand (undocumented -- use at your own risk).
+
Package version 1.2:
- Filter no longer a required controlArray member, defaults to objectclass=*.
diff --git a/contrib/ldaptcl/configure b/contrib/ldaptcl/configure
index e32da66e6b..5779bbd245 100755
--- a/contrib/ldaptcl/configure
+++ b/contrib/ldaptcl/configure
@@ -539,9 +539,9 @@ fi
# $OpenLDAP$
-NEO_VERSION=1.2
-NEO_MAJOR_VERSION=1
-NEO_MINOR_VERSION=2
+NEO_VERSION=2.0
+NEO_MAJOR_VERSION=2
+NEO_MINOR_VERSION=0
VERSION=${NEO_VERSION}
if test "${prefix}" = "NONE"; then
diff --git a/contrib/ldaptcl/configure.in b/contrib/ldaptcl/configure.in
index 8e59ffd5f3..804c39087f 100644
--- a/contrib/ldaptcl/configure.in
+++ b/contrib/ldaptcl/configure.in
@@ -4,9 +4,9 @@ dnl to configure the system for the local environment.
AC_INIT(neoXldap.c)
# $OpenLDAP$
-NEO_VERSION=1.2
-NEO_MAJOR_VERSION=1
-NEO_MINOR_VERSION=2
+NEO_VERSION=2.0
+NEO_MAJOR_VERSION=2
+NEO_MINOR_VERSION=0
VERSION=${NEO_VERSION}
if test "${prefix}" = "NONE"; then
diff --git a/contrib/ldaptcl/ldap.n b/contrib/ldaptcl/ldap.n
index 685540310f..267324f23c 100644
--- a/contrib/ldaptcl/ldap.n
+++ b/contrib/ldaptcl/ldap.n
@@ -13,7 +13,7 @@ ldap \- connect to and query an LDAP server
.SH SYNOPSIS
\fBldap \fBopen \fR \fIcommand\fR \fIhostlist\fR
.br
-\fBldap \fBinit \fR \fIcommand\fR \fIhostlist\fR
+\fBldap \fBinit \fR \fIcommand\fR \fIhostlist\fR ?protocol_version [2|3]?
.br
\fBldap \fBexplode ?-nonames|-list?\fR \fIdn\fR
.br
@@ -61,6 +61,11 @@ and make queries to the remote LDAP server.
Same as above, foo is created, but for "init", opening the connection is
deferred until we actually try to do something.
+The init command also allows some optional values to be set for the connection.
+Currently, the only useful option is \fBprotocol_version\fR which take a
+single argument to specify to use LDAP protocol 2 or 3. This may be required
+when connecting to older LDAP server.
+
For the purposes of this example, we're going to assume that "foo" is the
command created by opening a connection using "ldap open".
@@ -189,6 +194,12 @@ value list {bar snap}, and you delete using the attributePairList "foo bar",
If you provide an empty string ("") for the value list,
the entire attribute will be deleted.
+In Ldaptcl version 2.0, multiple operations may be combined into a single
+transaction, ie. as in:
+
+ foo add_attributes dn attributePairList replace attributePairList \
+ delete attributePairList
+
.SH SEARCHING
The Tcl interface to searching takes a control array, which contains
@@ -200,6 +211,7 @@ of matching DNs if none are specified) and values are stored.
The "code" part is executed repeatedly, once for each DN matching the
search criteria.
+.nf
foo search controlArray destArray code
Using data in the control array, a search is performed of the
@@ -222,15 +234,26 @@ search criteria.
controlArray(timeout) a timeout value in seconds (may contain
fractional values -- extremely very small values are useful
for forcing timeout conditions to test timeouts).
+.fi
- For each matching record, destArray is populated with none,
- some or all attribute-value pairs.
+For each matching record, destArray is populated with none,
+some or all attribute-value pairs as determined by the request and
+access control lists on the server.
Note: There are some additional parameters that can be set, such as
how long the synchronous version of the routines should wait before
timing out, the interfaces for which are not available in the current
version.
+.SH COMPARE
+
+ foo compare dn attribute value
+
+Interface to the ldap_compare_s() command.
+Compares the value of \fIattribute\fR in the object at \fIdn\fR to the
+\fIvalue\fR given in the command line. Returns an error if \fIdn\fR
+does not exist. Otherwise, a
+
.SH CACHING (Note: Netscape clients do not have caching interfaces).
The UMich and OpenLDAP client libraries offers the client application fairly
diff --git a/contrib/ldaptcl/neoXldap.c b/contrib/ldaptcl/neoXldap.c
index 305c290944..e347962a50 100644
--- a/contrib/ldaptcl/neoXldap.c
+++ b/contrib/ldaptcl/neoXldap.c
@@ -76,7 +76,9 @@
** In OpenLDAP 2.x-devel, its 2000 + the draft number, ie 2002.
** This section is for OPENLDAP.
*/
+#ifndef LDAP_API_FEATURE_X_OPENLDAP
#define ldap_memfree(p) free(p)
+#endif
#ifdef LDAP_OPT_ERROR_NUMBER
#define ldap_get_lderrno(ld) (ldap_get_option(ld, LDAP_OPT_ERROR_NUMBER, &lderrno), lderrno)
#else
@@ -429,13 +431,14 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
char *m, *s, *errmsg;
int errcode;
int tclResult;
+ int lderrno; /* might be used by LDAP_ERR_STRING macro */
Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
- if (objc < 2)
- return TclX_WrongArgs (interp,
- objv [0],
- "subcommand [args...]");
+ if (objc < 2) {
+ Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
+ return TCL_ERROR;
+ }
command = Tcl_GetStringFromObj (objv[0], NULL);
subCommand = Tcl_GetStringFromObj (objv[1], NULL);
@@ -448,8 +451,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
char *ldap_authString;
int ldap_authInt;
- if (objc != 5)
- return TclX_WrongArgs (interp, objv [0], "bind authtype dn passwd");
+ if (objc != 5) {
+ Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
+ return TCL_ERROR;
+ }
ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);
@@ -515,16 +520,20 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
}
if (STREQU (subCommand, "unbind")) {
- if (objc != 2)
- return TclX_WrongArgs (interp, objv [0], "unbind");
+ if (objc != 2) {
+ Tcl_WrongNumArgs (interp, 2, objv, "");
+ return TCL_ERROR;
+ }
return Tcl_DeleteCommand(interp, Tcl_GetStringFromObj(objv[0], NULL));
}
/* object delete dn */
if (STREQU (subCommand, "delete")) {
- if (objc != 3)
- return TclX_WrongArgs (interp, objv [0], "delete dn");
+ if (objc != 3) {
+ Tcl_WrongNumArgs (interp, 2, objv, "dn");
+ return TCL_ERROR;
+ }
dn = Tcl_GetStringFromObj (objv [2], NULL);
if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
@@ -544,10 +553,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
char *rdn;
int deleteOldRdn;
- if (objc != 4)
- return TclX_WrongArgs (interp,
- objv [0],
- "delete_rdn|modify_rdn dn rdn");
+ if (objc != 4) {
+ Tcl_WrongNumArgs (interp, 2, objv, "dn rdn");
+ return TCL_ERROR;
+ }
dn = Tcl_GetStringFromObj (objv [2], NULL);
rdn = Tcl_GetStringFromObj (objv [3], NULL);
@@ -598,13 +607,15 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
Tcl_Obj **attribObjv;
int valuesObjc;
Tcl_Obj **valuesObjv;
- int nPairs;
+ int nPairs, allPairs;
int i;
int j;
+ int pairIndex;
+ int modIndex;
Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
- if (objc != 4) {
+ if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
Tcl_AppendStringsToObj (resultObj,
"wrong # args: ",
Tcl_GetStringFromObj (objv [0], NULL),
@@ -612,37 +623,52 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
subCommand,
" dn attributePairList",
(char *)NULL);
+ if (!is_add)
+ Tcl_AppendStringsToObj (resultObj,
+ " ?[add|delete|replace] attributePairList ...?", (char *)NULL);
return TCL_ERROR;
}
dn = Tcl_GetStringFromObj (objv [2], NULL);
- if (Tcl_ListObjGetElements (interp, objv [3], &attribObjc, &attribObjv)
- == TCL_ERROR) {
- return TCL_ERROR;
+ allPairs = 0;
+ for (i = 3; i < objc; i += 2) {
+ if (Tcl_ListObjLength (interp, objv[i], &j) == TCL_ERROR)
+ return TCL_ERROR;
+ if (j & 1) {
+ Tcl_AppendStringsToObj (resultObj,
+ "attribute list does not contain an ",
+ "even number of key-value elements",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ allPairs += j / 2;
}
- if (attribObjc & 1) {
- Tcl_AppendStringsToObj (resultObj,
- "attribute list does not contain an ",
- "even number of key-value elements",
- (char *)NULL);
- return TCL_ERROR;
+ modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (allPairs + 1));
+
+ pairIndex = 3;
+ modIndex = 0;
+
+ do {
+
+ if (Tcl_ListObjGetElements (interp, objv [pairIndex], &attribObjc, &attribObjv)
+ == TCL_ERROR) {
+ mod_op = -1;
+ goto badop;
}
nPairs = attribObjc / 2;
- modArray = (LDAPMod **)malloc (sizeof(LDAPMod *) * (nPairs + 1));
- modArray[nPairs] = (LDAPMod *) NULL;
-
for (i = 0; i < nPairs; i++) {
- mod = modArray[i] = (LDAPMod *) malloc (sizeof(LDAPMod));
+ mod = modArray[modIndex++] = (LDAPMod *) malloc (sizeof(LDAPMod));
mod->mod_op = mod_op;
mod->mod_type = Tcl_GetStringFromObj (attribObjv [i * 2], NULL);
if (Tcl_ListObjGetElements (interp, attribObjv [i * 2 + 1], &valuesObjc, &valuesObjv) == TCL_ERROR) {
/* FIX: cleanup memory here */
- return TCL_ERROR;
+ mod_op = -1;
+ goto badop;
}
valPtrs = mod->mod_vals.modv_strvals = \
@@ -662,7 +688,30 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
}
}
- if (is_add) {
+ pairIndex += 2;
+ if (mod_op != -1 && pairIndex < objc) {
+ subCommand = Tcl_GetStringFromObj (objv[pairIndex - 1], NULL);
+ mod_op = -1;
+ if (STREQU (subCommand, "add")) {
+ mod_op = LDAP_MOD_ADD;
+ } else if (STREQU (subCommand, "replace")) {
+ mod_op = LDAP_MOD_REPLACE;
+ } else if (STREQU (subCommand, "delete")) {
+ mod_op = LDAP_MOD_DELETE;
+ }
+ if (mod_op == -1) {
+ Tcl_SetStringObj (resultObj,
+ "Additional operators must be one of"
+ " add, replace, or delete", -1);
+ mod_op = -1;
+ goto badop;
+ }
+ }
+
+ } while (mod_op != -1 && pairIndex < objc);
+ modArray[modIndex] = (LDAPMod *) NULL;
+
+ if (is_add) {
result = ldap_add_s (ldap, dn, modArray);
} else {
result = ldap_modify_s (ldap, dn, modArray);
@@ -671,12 +720,17 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
}
/* free the modArray elements, then the modArray itself. */
- for (i = 0; i < nPairs; i++) {
+badop:
+ for (i = 0; i < modIndex; i++) {
free ((char *) modArray[i]->mod_vals.modv_strvals);
free ((char *) modArray[i]);
}
free ((char *) modArray);
+ /* after modArray is allocated, mod_op = -1 upon error for cleanup */
+ if (mod_op == -1)
+ return TCL_ERROR;
+
/* FIX: memory cleanup required all over the place here */
if (result != LDAP_SUCCESS) {
Tcl_AppendStringsToObj (resultObj,
@@ -723,10 +777,11 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
Tcl_Obj *destArrayNameObj;
Tcl_Obj *evalCodeObj;
- if (objc != 5)
- return TclX_WrongArgs (interp,
- objv [0],
- "search controlArray destArray code");
+ if (objc != 5) {
+ Tcl_WrongNumArgs (interp, 2, objv,
+ "controlArray destArray code");
+ return TCL_ERROR;
+ }
controlArrayNameObj = objv [2];
controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);
@@ -783,13 +838,13 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
}
}
+#ifdef LDAP_OPT_DEREF
/* Fetch dereference control setting from control array.
* If it doesn't exist, default to never dereference. */
derefString = Tcl_GetVar2 (interp,
controlArrayName,
"deref",
0);
-
if (derefString == (char *)NULL) {
deref = LDAP_DEREF_NEVER;
} else {
@@ -812,6 +867,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
return TCL_ERROR;
}
}
+#endif
/* Fetch list of attribute names from control array.
* If entry doesn't exist, default to NULL (all).
@@ -887,7 +943,9 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
}
#endif
+#ifdef LDAP_OPT_DEREF
ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
+#endif
tclResult = LDAP_PerformSearch (interp,
ldaptcl,
@@ -910,8 +968,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
else
ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
}
+#ifdef LDAP_OPT_DEREF
deref = LDAP_DEREF_NEVER;
ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
+#endif
#endif
return tclResult;
}
@@ -924,10 +984,12 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
int result;
int lderrno;
- if (objc != 5)
- return TclX_WrongArgs (interp,
- objv [0],
- "compare dn attribute value");
+ if (objc != 5) {
+ Tcl_WrongNumArgs (interp,
+ 2, objv,
+ "dn attribute value");
+ return TCL_ERROR;
+ }
dn = Tcl_GetStringFromObj (objv[2], NULL);
attr = Tcl_GetStringFromObj (objv[3], NULL);
@@ -935,7 +997,7 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
result = ldap_compare_s (ldap, dn, attr, value);
if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
- Tcl_SetIntObj(resultObj, result == LDAP_COMPARE_TRUE);
+ Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
return TCL_OK;
}
LDAP_SetErrorCode(ldaptcl, result, interp);
@@ -946,25 +1008,27 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
return TCL_ERROR;
}
-#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
if (STREQU (subCommand, "cache")) {
+#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
char *cacheCommand;
- if (objc < 3)
+ if (objc < 3) {
badargs:
- return TclX_WrongArgs (interp,
- objv [0],
- "cache command [args...]");
+ Tcl_WrongNumArgs (interp, 2, objv [0], "command [args...]");
+ return TCL_ERROR;
+ }
cacheCommand = Tcl_GetStringFromObj (objv [2], NULL);
if (STREQU (cacheCommand, "uncache")) {
char *dn;
- if (objc != 4)
- return TclX_WrongArgs (interp,
- objv [0],
- "cache uncache dn");
+ if (objc != 4) {
+ Tcl_WrongNumArgs (interp,
+ 3, objv,
+ "dn");
+ return TCL_ERROR;
+ }
dn = Tcl_GetStringFromObj (objv [3], NULL);
ldap_uncache_entry (ldap, dn);
@@ -975,10 +1039,10 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
long timeout = ldaptcl->timeout;
long maxmem = ldaptcl->maxmem;
- if (objc > 5)
- return TclX_WrongArgs (interp,
- objv [0],
- "cache enable ?timeout? ?maxmem?");
+ if (objc > 5) {
+ Tcl_WrongNumArgs (interp, 3, objv, "?timeout? ?maxmem?");
+ return TCL_ERROR;
+ }
if (objc > 3) {
if (Tcl_GetLongFromObj (interp, objv [3], &timeout) == TCL_ERROR)
@@ -1055,15 +1119,19 @@ NeoX_LdapTargetObjCmd (clientData, interp, objc, objv)
" or \"all_errors\"",
(char *)NULL);
return TCL_ERROR;
- }
+#else
+ return TCL_OK;
#endif
+ }
if (STREQU (subCommand, "trap")) {
Tcl_Obj *listObj, *resultObj;
int *p, l, i, code;
- if (objc > 4)
- return TclX_WrongArgs (interp, objv [0],
- "trap command ?errorCode-list?");
+ if (objc > 4) {
+ Tcl_WrongNumArgs (interp, 2, objv,
+ "command ?errorCode-list?");
+ return TCL_ERROR;
+ }
if (objc == 2) {
if (!ldaptcl->trapCmdObj)
return TCL_OK;
@@ -1196,15 +1264,17 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
char *subCommand;
char *newCommand;
char *ldapHost;
- int ldapPort = 389;
+ int ldapPort = LDAP_PORT;
LDAP *ldap;
LDAPTCL *ldaptcl;
Tcl_Obj *resultObj = Tcl_GetObjResult (interp);
- if (objc < 3 || objc > 5)
- return TclX_WrongArgs (interp, objv [0],
+ if (objc < 3) {
+ Tcl_WrongNumArgs (interp, 1, objv,
"(open|init) new_command host [port]|explode dn");
+ return TCL_ERROR;
+ }
subCommand = Tcl_GetStringFromObj (objv[1], NULL);
@@ -1221,7 +1291,8 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
} else if (STREQU(param, "-list")) {
list = 1;
} else {
- return TclX_WrongArgs (interp, objv [0], "explode ?-nonames|-list? dn");
+ Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
+ return TCL_ERROR;
}
}
if (nonames || list)
@@ -1281,7 +1352,58 @@ NeoX_LdapObjCmd (clientData, interp, objc, objv)
if (STREQU (subCommand, "open")) {
ldap = ldap_open (ldapHost, ldapPort);
} else if (STREQU (subCommand, "init")) {
+ int version = -1;
+ int i;
+ int value;
+ char *subOption;
+ char *subValue;
+
+#if LDAPTCL_PROTOCOL_VERSION_DEFAULT
+ version = LDAPTCL_PROTOCOL_VERSION_DEFAULT;
+#endif
+
+ for (i = 6; i < objc; i += 2) {
+ subOption = Tcl_GetStringFromObj(objv[i-1], NULL);
+ if (STREQU (subOption, "protocol_version")) {
+#ifdef LDAP_OPT_PROTOCOL_VERSION
+ subValue = Tcl_GetStringFromObj(objv[i], NULL);
+ if (STREQU (subValue, "2")) {
+ version = LDAP_VERSION2;
+ }
+ else if (STREQU (subValue, "3")) {
+#ifdef LDAP_VERSION3
+ version = LDAP_VERSION3;
+#else
+ Tcl_SetStringObj (resultObj, "protocol_version 3 not supported", -1);
+ return TCL_ERROR;
+#endif
+ }
+ else {
+ Tcl_SetStringObj (resultObj, "protocol_version must be '2' or '3'", -1);
+ return TCL_ERROR;
+ }
+#else
+ Tcl_SetStringObj (resultObj, "protocol_version not supported", -1);
+ return TCL_ERROR;
+#endif
+ } else if (STREQU (subOption, "port")) {
+ if (Tcl_GetIntFromObj (interp, objv [i], &ldapPort) == TCL_ERROR) {
+ Tcl_AppendStringsToObj (resultObj,
+ "LDAP port number is non-numeric",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_SetStringObj (resultObj, "valid options: protocol_version, port", -1);
+ return TCL_ERROR;
+ }
+ }
ldap = ldap_init (ldapHost, ldapPort);
+
+#if LDAP_OPT_PROTOCOL_VERSION
+ if (version != -1)
+ ldap_set_option(ldap, LDAP_OPT_PROTOCOL_VERSION, &version);
+#endif
} else {
Tcl_AppendStringsToObj (resultObj,
"option was not \"open\" or \"init\"");
@@ -1331,6 +1453,10 @@ Tcl_Interp *interp;
NeoX_LdapObjCmd,
(ClientData) NULL,
(Tcl_CmdDeleteProc*) NULL);
+ /*
+ if (Neo_initLDAPX(interp) != TCL_OK)
+ return TCL_ERROR;
+ */
Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
return TCL_OK;
}
--
GitLab