Back to index

openldap  2.4.31
Classes | Defines | Typedefs | Functions
neoXldap.c File Reference
#include "tclExtend.h"
#include <lber.h>
#include <ldap.h>
#include <string.h>
#include <sys/time.h>
#include <math.h>
#include "ldaptclerr.h"

Go to the source code of this file.

Classes

struct  ldaptclobj

Defines

#define STREQU(str1, str2)   (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))
#define STRNEQU(str1, str2, n)   (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))
#define OPEN_LDAP   1
#define ldap_memfree(p)   free(p)
#define ldap_get_lderrno(ld)   (ld->ld_errno)
#define LDAP_ERR_STRING(ld)   ldap_err2string(ldap_get_lderrno(ld))
#define LDAPTCL_INTERRCODES   0x001
#define LDAP_BIND(ldap, dn, pw, method)   ldap_simple_bind_s(ldap, dn, pw)

Typedefs

typedef struct ldaptclobj LDAPTCL

Functions

static LDAP_SetErrorCode (LDAPTCL *ldaptcl, int code, Tcl_Interp *interp)
static LDAP_ErrorStringToCode (Tcl_Interp *interp, char *s)
int LDAP_ProcessOneSearchResult (Tcl_Interp *interp, LDAP *ldap, LDAPMessage *entry, Tcl_Obj *destArrayNameObj, Tcl_Obj *evalCodeObj)
int LDAP_PerformSearch (Tcl_Interp *interp, LDAPTCL *ldaptcl, char *base, int scope, char **attrs, char *filtpatt, char *value, Tcl_Obj *destArrayNameObj, Tcl_Obj *evalCodeObj, struct timeval *timeout_p, int all, char *sortattr)
int NeoX_LdapTargetObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
static void NeoX_LdapObjDeleteCmd (ClientData clientData)
static int NeoX_LdapObjCmd (ClientData clientData, Tcl_Interp *interp, int objc, objv)
int Ldaptcl_Init (Tcl_Interp *interp)

Class Documentation

struct ldaptclobj

Definition at line 107 of file neoXldap.c.

Class Members
int caching
int flags
LDAP * ldap
long maxmem
long timeout
Tcl_Obj * trapCmdObj
int * traplist

Define Documentation

#define LDAP_BIND (   ldap,
  dn,
  pw,
  method 
)    ldap_simple_bind_s(ldap, dn, pw)

Definition at line 87 of file neoXldap.c.

#define ldap_get_lderrno (   ld)    (ld->ld_errno)

Definition at line 85 of file neoXldap.c.

#define ldap_memfree (   p)    free(p)

Definition at line 80 of file neoXldap.c.

#define LDAPTCL_INTERRCODES   0x001

Definition at line 118 of file neoXldap.c.

#define OPEN_LDAP   1

Definition at line 70 of file neoXldap.c.

#define STREQU (   str1,
  str2 
)    (((str1) [0] == (str2) [0]) && (strcmp (str1, str2) == 0))

Definition at line 58 of file neoXldap.c.

#define STRNEQU (   str1,
  str2,
  n 
)    (((str1) [0] == (str2) [0]) && (strncmp (str1, str2, n) == 0))

Definition at line 60 of file neoXldap.c.


Typedef Documentation

typedef struct ldaptclobj LDAPTCL

Function Documentation

static LDAP_ErrorStringToCode ( Tcl_Interp *  interp,
char *  s 
) [static]

Definition at line 152 of file neoXldap.c.

{
    int offset;
    int code;

    offset = (strncasecmp(s, "LDAP_", 5) == 0) ? 0 : 5;
    for (code = 0; code < LDAPTCL_MAXERR; code++) {
       if (!ldaptclerrorcode[code]) continue;
       if (strcasecmp(s, ldaptclerrorcode[code]+offset) == 0)
           return code;
    }
    Tcl_ResetResult(interp);
    Tcl_AppendResult(interp, s, " is an invalid code", (char *) NULL);
    return -1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int LDAP_PerformSearch ( Tcl_Interp *  interp,
LDAPTCL ldaptcl,
char *  base,
int  scope,
char **  attrs,
char *  filtpatt,
char *  value,
Tcl_Obj *  destArrayNameObj,
Tcl_Obj *  evalCodeObj,
struct timeval *  timeout_p,
int  all,
char *  sortattr 
)

Definition at line 289 of file neoXldap.c.

{
    LDAP       *ldap = ldaptcl->ldap;
    char          filter[BUFSIZ];
    int           resultCode;
    int           errorCode;
    int                abandon;
    int                tclResult = TCL_OK;
    int                msgid;
    LDAPMessage  *resultMessage = 0;
    LDAPMessage  *entryMessage = 0;
    char        *sortKey;

    int                lderrno;

    sprintf(filter, filtpatt, value);

    fflush(stderr);
    if ((msgid = ldap_search (ldap, base, scope, filter, attrs, 0)) == -1) {
       Tcl_AppendResult (interp,
                             "LDAP start search error: ",
                                   LDAP_ERR_STRING(ldap),
                             (char *)NULL);
       LDAP_SetErrorCode(ldaptcl, -1, interp);
       return TCL_ERROR;
    }

    abandon = 0;
    if (sortattr)
       all = 1;
    tclResult = TCL_OK;
    while (!abandon) {
       resultCode = ldap_result (ldap, msgid, all, timeout_p, &resultMessage);
       if (resultCode != LDAP_RES_SEARCH_RESULT &&
           resultCode != LDAP_RES_SEARCH_ENTRY)
              break;

       if (sortattr) {
           sortKey = (strcasecmp(sortattr, "dn") == 0) ? NULL : sortattr;
           ldap_sort_entries(ldap, &resultMessage, sortKey, strcasecmp);
       }
       entryMessage = ldap_first_entry(ldap, resultMessage);

       while (entryMessage) {
           tclResult = LDAP_ProcessOneSearchResult  (interp, 
                                ldap, 
                                entryMessage,
                                destArrayNameObj,
                                evalCodeObj);
           if (tclResult != TCL_OK) {
              if (tclResult == TCL_CONTINUE) {
                  tclResult = TCL_OK;
              } else if (tclResult == TCL_BREAK) {
                  tclResult = TCL_OK;
                  abandon = 1;
                  break;
              } else if (tclResult == TCL_ERROR) {
                  char msg[100];
                  sprintf(msg, "\n    (\"search\" body line %d)",
                         interp->errorLine);
                  Tcl_AddObjErrorInfo(interp, msg, -1);
                  abandon = 1;
                  break;
              } else {
                  abandon = 1;
                  break;
              }
           }
           entryMessage = ldap_next_entry(ldap, entryMessage);
       }
       if (resultCode == LDAP_RES_SEARCH_RESULT || all)
           break;
       if (resultMessage)
       ldap_msgfree(resultMessage);
       resultMessage = NULL;
    }
    if (abandon) {
       if (resultMessage)
           ldap_msgfree(resultMessage);
       if (resultCode == LDAP_RES_SEARCH_ENTRY)
           ldap_abandon(ldap, msgid);
       return tclResult;
    }
    if (resultCode == -1) {
       Tcl_ResetResult (interp);
       Tcl_AppendResult (interp,
                            "LDAP result search error: ",
                            LDAP_ERR_STRING(ldap),
                            (char *)NULL);
       LDAP_SetErrorCode(ldaptcl, -1, interp);
       return TCL_ERROR;
    }

    if ((errorCode = ldap_result2error (ldap, resultMessage, 0))
      != LDAP_SUCCESS) {
      Tcl_ResetResult (interp);
      Tcl_AppendResult (interp,
                           "LDAP search error: ",
                           ldap_err2string(errorCode),
                           (char *)NULL);
      if (resultMessage)
         ldap_msgfree(resultMessage);
      LDAP_SetErrorCode(ldaptcl, errorCode, interp);
      return TCL_ERROR;
    }
    if (resultMessage)
       ldap_msgfree(resultMessage);
    return tclResult;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int LDAP_ProcessOneSearchResult ( Tcl_Interp *  interp,
LDAP *  ldap,
LDAPMessage *  entry,
Tcl_Obj *  destArrayNameObj,
Tcl_Obj *  evalCodeObj 
)

Definition at line 185 of file neoXldap.c.

{
    char           *attributeName;
    Tcl_Obj        *attributeNameObj;
    Tcl_Obj        *attributeDataObj;
    int             i; 
    BerElement     *ber; 
    struct berval **bvals;
    char         *dn;
    int                  lderrno;

    Tcl_UnsetVar (interp, Tcl_GetStringFromObj (destArrayNameObj, NULL), 0);

    dn = ldap_get_dn(ldap, entry);
    if (dn != NULL) {
       if (Tcl_SetVar2(interp,            /* set dn */
                     Tcl_GetStringFromObj(destArrayNameObj, NULL),
                     "dn",
                     dn,
                     TCL_LEAVE_ERR_MSG) == NULL)
           return TCL_ERROR;
       ldap_memfree(dn);
    }
    attributeNameObj = Tcl_NewObj();
    Tcl_IncrRefCount (attributeNameObj);

    /* Note that attributeName below is allocated for OL2+ libldap, so it
       must be freed with ldap_memfree().  Test below is admittedly a hack.
    */

    for (attributeName = ldap_first_attribute (ldap, entry, &ber); 
      attributeName != NULL;
      attributeName = ldap_next_attribute(ldap, entry, ber)) {

       bvals = ldap_get_values_len(ldap, entry, attributeName);

       if (bvals != NULL) {
           /* Note here that the U.of.M. ldap will return a null bvals
              when the last attribute value has been deleted, but still
              retains the attributeName.  Even though this is documented
              as an error, we ignore it to present a consistent interface
              with Netscape's server
           */
           attributeDataObj = Tcl_NewObj();
           Tcl_SetStringObj(attributeNameObj, attributeName, -1);
#if LDAP_API_VERSION >= 2004
           ldap_memfree(attributeName);   /* free if newer API */
#endif
           for (i = 0; bvals[i] != NULL; i++) {
              Tcl_Obj *singleAttributeValueObj;

              singleAttributeValueObj = Tcl_NewStringObj(bvals[i]->bv_val, bvals[i]->bv_len);
              if (Tcl_ListObjAppendElement (interp, 
                                         attributeDataObj, 
                                         singleAttributeValueObj) 
                == TCL_ERROR) {
                  ber_free(ber, 0);
                  return TCL_ERROR;
              }
           }

           ldap_value_free_len(bvals);

           if (Tcl_ObjSetVar2 (interp, 
                            destArrayNameObj,
                            attributeNameObj,
                            attributeDataObj,
                            TCL_LEAVE_ERR_MSG) == NULL) {
              return TCL_ERROR;
           }
       }
    }
    Tcl_DecrRefCount (attributeNameObj);
    return Tcl_EvalObj (interp, evalCodeObj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

static LDAP_SetErrorCode ( LDAPTCL ldaptcl,
int  code,
Tcl_Interp *  interp 
) [static]

Definition at line 123 of file neoXldap.c.

{
    char shortbuf[16];
    char *errp;
    int   lderrno;

    if (code == -1)
       code = ldap_get_lderrno(ldaptcl->ldap);
    if ((ldaptcl->flags & LDAPTCL_INTERRCODES) || code > LDAPTCL_MAXERR ||
      ldaptclerrorcode[code] == NULL) {
       sprintf(shortbuf, "0x%03x", code);
       errp = shortbuf;
    } else
       errp = ldaptclerrorcode[code];

    Tcl_SetErrorCode(interp, errp, NULL);
    if (ldaptcl->trapCmdObj) {
       int *i;
       Tcl_Obj *cmdObj;
       if (ldaptcl->traplist != NULL) {
           for (i = ldaptcl->traplist; *i && *i != code; i++)
              ;
           if (*i == 0) return;
       }
       (void) Tcl_EvalObj(interp, ldaptcl->trapCmdObj);
    }
}

Here is the call graph for this function:

Here is the caller graph for this function:

int Ldaptcl_Init ( Tcl_Interp *  interp)

Definition at line 1456 of file neoXldap.c.

{
    Tcl_CreateObjCommand (interp,
                       "ldap",
                          NeoX_LdapObjCmd,
                          (ClientData) NULL,
                          (Tcl_CmdDeleteProc*) NULL);
    /*
    if (Neo_initLDAPX(interp) != TCL_OK)
       return TCL_ERROR;
    */
    Tcl_PkgProvide(interp, "Ldaptcl", VERSION);
    return TCL_OK;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static int NeoX_LdapObjCmd ( ClientData  clientData,
Tcl_Interp *  interp,
int  objc,
objv   
) [static]

Definition at line 1265 of file neoXldap.c.

{
    extern int    errno;
    char         *subCommand;
    char         *newCommand;
    char         *ldapHost;
    int           ldapPort = LDAP_PORT;
    LDAP         *ldap;
    LDAPTCL    *ldaptcl;

    Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);

    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);

    if (STREQU(subCommand, "explode")) {
       char *param;
       int nonames = 0;
       int list = 0;
       char **exploded, **p;

       param = Tcl_GetStringFromObj (objv[2], NULL);
       if (param[0] == '-') {
           if (STREQU(param, "-nonames")) {
              nonames = 1;
           } else if (STREQU(param, "-list")) {
              list = 1;
           } else {
              Tcl_WrongNumArgs (interp, 1, objv, "explode ?-nonames|-list? dn");
              return TCL_ERROR;
           }
       }
       if (nonames || list)
           param = Tcl_GetStringFromObj (objv[3], NULL);
       exploded = ldap_explode_dn(param, nonames);
       for (p = exploded; *p; p++) {
           if (list) {
              char *q = strchr(*p, '=');
              if (!q) {
                  Tcl_SetObjLength(resultObj, 0);
                  Tcl_AppendStringsToObj(resultObj, "rdn ", *p,
                     " missing '='", NULL);
                  ldap_value_free(exploded);
                  return TCL_ERROR;
              }
              *q = '\0';
              if (Tcl_ListObjAppendElement(interp, resultObj,
                     Tcl_NewStringObj(*p, -1)) != TCL_OK ||
                     Tcl_ListObjAppendElement(interp, resultObj,
                     Tcl_NewStringObj(q+1, -1)) != TCL_OK) {
                  ldap_value_free(exploded);
                  return TCL_ERROR;
              }
           } else {
              if (Tcl_ListObjAppendElement(interp, resultObj,
                     Tcl_NewStringObj(*p, -1))) {
                  ldap_value_free(exploded);
                  return TCL_ERROR;
              }
           }
       }
       ldap_value_free(exploded);
       return TCL_OK;
    }

#ifdef UMICH_LDAP
    if (STREQU(subCommand, "friendly")) {
       char *friendly = ldap_dn2ufn(Tcl_GetStringFromObj(objv[2], NULL));
       Tcl_SetStringObj(resultObj, friendly, -1);
       free(friendly);
       return TCL_OK;
    }
#endif

    newCommand = Tcl_GetStringFromObj (objv[2], NULL);
    ldapHost = Tcl_GetStringFromObj (objv[3], NULL);

    if (objc == 5) {
       if (Tcl_GetIntFromObj (interp, objv [4], &ldapPort) == TCL_ERROR) {
           Tcl_AppendStringsToObj (resultObj,
                                "LDAP port number is non-numeric",
                                (char *)NULL);
            return TCL_ERROR;
       }
    }

    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);

#ifdef 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\"");
       return TCL_ERROR;
    }

    if (ldap == (LDAP *)NULL) {
       Tcl_SetErrno(errno);
       Tcl_AppendStringsToObj (resultObj, 
                            Tcl_PosixError (interp), 
                            (char *)NULL);
       return TCL_ERROR;
    }

#ifdef UMICH_LDAP
    ldap->ld_deref = LDAP_DEREF_NEVER;  /* Turn off alias dereferencing */
#endif

    ldaptcl = (LDAPTCL *) malloc(sizeof(LDAPTCL));
    ldaptcl->ldap = ldap;
    ldaptcl->caching = 0;
    ldaptcl->timeout = 0;
    ldaptcl->maxmem = 0;
    ldaptcl->trapCmdObj = NULL;
    ldaptcl->traplist = NULL;
    ldaptcl->flags = 0;

    Tcl_CreateObjCommand (interp,
                       newCommand,
                          NeoX_LdapTargetObjCmd,
                          (ClientData) ldaptcl,
                          NeoX_LdapObjDeleteCmd);
    return TCL_OK;
}

Here is the call graph for this function:

Here is the caller graph for this function:

static void NeoX_LdapObjDeleteCmd ( ClientData  clientData) [static]

Definition at line 1236 of file neoXldap.c.

{
    LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
    LDAP         *ldap = ldaptcl->ldap;

    if (ldaptcl->trapCmdObj)
       Tcl_DecrRefCount (ldaptcl->trapCmdObj);
    if (ldaptcl->traplist)
       free(ldaptcl->traplist);
    ldap_unbind(ldap);
    free((char*) ldaptcl);
}

Here is the call graph for this function:

Here is the caller graph for this function:

int NeoX_LdapTargetObjCmd ( ClientData  clientData,
Tcl_Interp *  interp,
int  objc,
objv   
)

Definition at line 425 of file neoXldap.c.

{
    char         *command;
    char         *subCommand;
    LDAPTCL      *ldaptcl = (LDAPTCL *)clientData;
    LDAP         *ldap = ldaptcl->ldap;
    char         *dn;
    int           is_add = 0;
    int           is_add_or_modify = 0;
    int           mod_op = 0;
    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) {
       Tcl_WrongNumArgs (interp, 1, objv, "subcommand [args...]");
       return TCL_ERROR;
    }

    command = Tcl_GetStringFromObj (objv[0], NULL);
    subCommand = Tcl_GetStringFromObj (objv[1], NULL);

    /* object bind authtype name password */
    if (STREQU (subCommand, "bind")) {
       char     *binddn;
       char     *passwd;
       int       stringLength;
       char     *ldap_authString;
       int       ldap_authInt;

       if (objc != 5) {
           Tcl_WrongNumArgs (interp, 2, objv, "authtype dn passwd");
           return TCL_ERROR;
       }

       ldap_authString = Tcl_GetStringFromObj (objv[2], NULL);

       if (STREQU (ldap_authString, "simple")) {
           ldap_authInt = LDAP_AUTH_SIMPLE;
       }
#ifdef UMICH_LDAP
       else if (STREQU (ldap_authString, "kerberos_ldap")) {
           ldap_authInt = LDAP_AUTH_KRBV41;
       } else if (STREQU (ldap_authString, "kerberos_dsa")) {
           ldap_authInt = LDAP_AUTH_KRBV42;
       } else if (STREQU (ldap_authString, "kerberos_both")) {
           ldap_authInt = LDAP_AUTH_KRBV4;
       }
#endif
       else {
           Tcl_AppendStringsToObj (resultObj,
                                "\"",
                                command,
                                " ",
                                subCommand, 
#ifdef UMICH_LDAP
                                "\" authtype must be one of \"simple\", ",
                                "\"kerberos_ldap\", \"kerberos_dsa\" ",
                                "or \"kerberos_both\"",
#else
                                "\" authtype must be \"simple\", ",
#endif
                                (char *)NULL);
           return TCL_ERROR;
       }

       binddn = Tcl_GetStringFromObj (objv[3], &stringLength);
       if (stringLength == 0)
           binddn = NULL;

       passwd = Tcl_GetStringFromObj (objv[4], &stringLength);
       if (stringLength == 0)
           passwd = NULL;

/*  ldap_bind_s(ldap, dn, pw, method) */

#ifdef UMICH_LDAP
#define LDAP_BIND(ldap, dn, pw, method) \
  ldap_bind_s(ldap, dn, pw, method)
#else
#define LDAP_BIND(ldap, dn, pw, method) \
  ldap_simple_bind_s(ldap, dn, pw)
#endif
       if ((errcode = LDAP_BIND (ldap, 
                      binddn, 
                      passwd, 
                      ldap_authInt)) != LDAP_SUCCESS) {

           Tcl_AppendStringsToObj (resultObj,
                                 "LDAP bind error: ",
                                ldap_err2string(errcode),
                                (char *)NULL);
           LDAP_SetErrorCode(ldaptcl, errcode, interp);
           return TCL_ERROR;
       }
       return TCL_OK;
    }

    if (STREQU (subCommand, "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) {
           Tcl_WrongNumArgs (interp, 2, objv, "dn");
           return TCL_ERROR;
       }

       dn = Tcl_GetStringFromObj (objv [2], NULL);
       if ((errcode = ldap_delete_s(ldap, dn)) != LDAP_SUCCESS) {
          Tcl_AppendStringsToObj (resultObj,
                                "LDAP delete error: ",
                               ldap_err2string(errcode),
                               (char *)NULL);
          LDAP_SetErrorCode(ldaptcl, errcode, interp);
          return TCL_ERROR;
       }
       return TCL_OK;
    }

    /* object rename_rdn dn rdn */
    /* object modify_rdn dn rdn */
    if (STREQU (subCommand, "rename_rdn") || STREQU (subCommand, "modify_rdn")) {
       char    *rdn;
       int      deleteOldRdn;

       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);

       deleteOldRdn = (*subCommand == 'r');

       if ((errcode = ldap_modrdn2_s (ldap, dn, rdn, deleteOldRdn)) != LDAP_SUCCESS) {
           Tcl_AppendStringsToObj (resultObj,
                                "LDAP ",
                                subCommand,
                                " error: ",
                                ldap_err2string(errcode),
                                (char *)NULL);
           LDAP_SetErrorCode(ldaptcl, errcode, interp);
           return TCL_ERROR;
       }
       return TCL_OK;
    }

    /* object add dn attributePairList */
    /* object add_attributes dn attributePairList */
    /* object replace_attributes dn attributePairList */
    /* object delete_attributes dn attributePairList */

    if (STREQU (subCommand, "add")) {
       is_add = 1;
       is_add_or_modify = 1;
    } else {
       is_add = 0;
       if (STREQU (subCommand, "add_attributes")) {
           is_add_or_modify = 1;
           mod_op = LDAP_MOD_ADD;
       } else if (STREQU (subCommand, "replace_attributes")) {
           is_add_or_modify = 1;
           mod_op = LDAP_MOD_REPLACE;
       } else if (STREQU (subCommand, "delete_attributes")) {
           is_add_or_modify = 1;
           mod_op = LDAP_MOD_DELETE;
       }
    }

    if (is_add_or_modify) {
       int          result;
       LDAPMod    **modArray;
       LDAPMod     *mod;
       char       **valPtrs = NULL;
       int          attribObjc;
       Tcl_Obj    **attribObjv;
       int          valuesObjc;
       Tcl_Obj    **valuesObjv;
       int          nPairs, allPairs;
       int          i;
       int          j;
       int         pairIndex;
       int         modIndex;

       Tcl_Obj      *resultObj = Tcl_GetObjResult (interp);

       if (objc < 4 || objc > 4 && is_add || is_add == 0 && objc&1) {
           Tcl_AppendStringsToObj (resultObj,
                                "wrong # args: ",
                                Tcl_GetStringFromObj (objv [0], NULL),
                                " ",
                                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);

       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;
       }

       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;

       for (i = 0; i < nPairs; i++) {
           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 */
              mod_op = -1;
              goto badop;
           }

           valPtrs = mod->mod_vals.modv_strvals = \
               (char **)malloc (sizeof (char *) * (valuesObjc + 1));
           valPtrs[valuesObjc] = (char *)NULL;

           for (j = 0; j < valuesObjc; j++) {
              valPtrs [j] = Tcl_GetStringFromObj (valuesObjv[j], NULL);

              /* If it's "delete" and value is an empty string, make
               * value be NULL to indicate entire attribute is to be 
               * deleted */
              if ((*valPtrs [j] == '\0') 
                  && (mod->mod_op == LDAP_MOD_DELETE || mod->mod_op == LDAP_MOD_REPLACE)) {
                     valPtrs [j] = NULL;
              }
           }
       }

       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);
           if (ldaptcl->caching)
              ldap_uncache_entry (ldap, dn);
       }

        /* free the modArray elements, then the modArray itself. */
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,
                                "LDAP ",
                                subCommand,
                                " error: ",
                                ldap_err2string(result),
                                (char *)NULL);
           LDAP_SetErrorCode(ldaptcl, result, interp);
           return TCL_ERROR;
       }
       return TCL_OK;
    }

    /* object search controlArray dn pattern */
    if (STREQU (subCommand, "search")) {
       char        *controlArrayName;
       Tcl_Obj     *controlArrayNameObj;

       char        *scopeString;
       int          scope;

       char        *derefString;
       int          deref;

       char        *baseString;

       char       **attributesArray;
       char        *attributesString;
       int          attributesArgc;

       char        *filterPatternString;

       char       *timeoutString;
       double             timeoutTime;
       struct timeval timeout, *timeout_p;

       char       *paramString;
       int         cacheThis = -1;
       int         all = 0;

       char       *sortattr;

       Tcl_Obj     *destArrayNameObj;
       Tcl_Obj     *evalCodeObj;

       if (objc != 5) {
           Tcl_WrongNumArgs (interp, 2, objv,
                               "controlArray destArray code");
           return TCL_ERROR;
       }

        controlArrayNameObj = objv [2];
       controlArrayName = Tcl_GetStringFromObj (controlArrayNameObj, NULL);

       destArrayNameObj = objv [3];

       evalCodeObj = objv [4];

       baseString = Tcl_GetVar2 (interp, 
                              controlArrayName, 
                              "base",
                              0);

       if (baseString == (char *)NULL) {
           Tcl_AppendStringsToObj (resultObj,
                                "required element \"base\" ",
                                "is missing from ldap control array \"",
                                controlArrayName,
                                "\"",
                                (char *)NULL);
           return TCL_ERROR;
       }

       filterPatternString = Tcl_GetVar2 (interp,
                                       controlArrayName,
                                       "filter",
                                       0);
       if (filterPatternString == (char *)NULL) {
           filterPatternString = "(objectclass=*)";
       }

       /* Fetch scope setting from control array.
        * If it doesn't exist, default to subtree scoping.
        */
       scopeString = Tcl_GetVar2 (interp, controlArrayName, "scope", 0);
       if (scopeString == NULL) {
           scope = LDAP_SCOPE_SUBTREE;
       } else {
           if (STREQU(scopeString, "base")) 
              scope = LDAP_SCOPE_BASE;
           else if (STRNEQU(scopeString, "one", 3))
              scope = LDAP_SCOPE_ONELEVEL;
           else if (STRNEQU(scopeString, "sub", 3))
              scope = LDAP_SCOPE_SUBTREE;
           else {
              Tcl_AppendStringsToObj (resultObj,
                                    "\"scope\" element of \"",
                                    controlArrayName,
                                    "\" array is not one of ",
                                    "\"base\", \"onelevel\", ",
                                   "or \"subtree\"",
                                  (char *) NULL);
              return TCL_ERROR;
           }
       }

#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 {
           if (STREQU(derefString, "never"))
              deref = LDAP_DEREF_NEVER;
           else if (STREQU(derefString, "search"))
              deref = LDAP_DEREF_SEARCHING;
           else if (STREQU(derefString, "find"))
              deref = LDAP_DEREF_FINDING;
           else if (STREQU(derefString, "always"))
              deref = LDAP_DEREF_ALWAYS;
           else {
              Tcl_AppendStringsToObj (resultObj,
                                    "\"deref\" element of \"",
                                    controlArrayName,
                                    "\" array is not one of ",
                                    "\"never\", \"search\", \"find\", ",
                                    "or \"always\"",
                                    (char *) NULL);
              return TCL_ERROR;
           }
       }
#endif

       /* Fetch list of attribute names from control array.
        * If entry doesn't exist, default to NULL (all).
        */
       attributesString = Tcl_GetVar2 (interp,
                                    controlArrayName,
                                    "attributes", 
                                    0);
       if (attributesString == (char *)NULL) {
           attributesArray = NULL;
       } else {
           if ((Tcl_SplitList (interp, 
                            attributesString,
                            &attributesArgc, 
                            &attributesArray)) != TCL_OK) {
              return TCL_ERROR;
           }
       }

       /* Fetch timeout value if there is one
        */
       timeoutString = Tcl_GetVar2 (interp,
                                    controlArrayName,
                                    "timeout", 
                                    0);
       timeout.tv_usec = 0;
       if (timeoutString == (char *)NULL) {
           timeout_p = NULL;
           timeout.tv_sec = 0;
       } else {
           if (Tcl_GetDouble(interp, timeoutString, &timeoutTime) != TCL_OK)
              return TCL_ERROR;
           timeout.tv_sec = floor(timeoutTime);
           timeout.tv_usec = (timeoutTime-timeout.tv_sec) * 1000000;
           timeout_p = &timeout;
       }

       paramString = Tcl_GetVar2 (interp, controlArrayName, "cache", 0);
       if (paramString) {
           if (Tcl_GetInt(interp, paramString, &cacheThis) == TCL_ERROR)
              return TCL_ERROR;
       }

       paramString = Tcl_GetVar2 (interp, controlArrayName, "all", 0);
       if (paramString) {
           if (Tcl_GetInt(interp, paramString, &all) == TCL_ERROR)
              return TCL_ERROR;
       }

       sortattr = Tcl_GetVar2 (interp, controlArrayName, "sort", 0);

#ifdef UMICH_LDAP
       ldap->ld_deref = deref; 
       ldap->ld_timelimit = 0;
       ldap->ld_sizelimit = 0; 
       ldap->ld_options = 0;
#endif

       /* Caching control within the search: if the "cache" control array */
       /* value is set, disable/enable caching accordingly */

#if 0
       if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
           if (cacheThis) {
              if (ldaptcl->timeout == 0) {
                  Tcl_SetStringObj(resultObj, "Caching never before enabled, I have no timeout value to use", -1);
                  return TCL_ERROR;
              }
              ldap_enable_cache(ldap, ldaptcl->timeout, ldaptcl->maxmem);
           }
           else
              ldap_disable_cache(ldap);
       }
#endif

#ifdef LDAP_OPT_DEREF
       ldap_set_option(ldap, LDAP_OPT_DEREF, &deref);
#endif

       tclResult = LDAP_PerformSearch (interp, 
                                 ldaptcl, 
                                 baseString, 
                                 scope, 
                                 attributesArray, 
                                 filterPatternString, 
                                 "",
                                 destArrayNameObj,
                                 evalCodeObj,
                                timeout_p,
                                all,
                                sortattr);
       /* Following the search, if we changed the caching behavior, change */
       /* it back. */
#if 0
       if (cacheThis >= 0 && ldaptcl->caching != cacheThis) {
           if (cacheThis)
              ldap_disable_cache(ldap);
           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;
    }

    /* object compare dn attr value */
    if (STREQU (subCommand, "compare")) {
       char        *dn;
       char       *attr;
       char       *value;
       int         result;
       int         lderrno;

       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);
       value = Tcl_GetStringFromObj (objv[4], NULL);
       
       result = ldap_compare_s (ldap, dn, attr, value);
       if (result == LDAP_COMPARE_TRUE || result == LDAP_COMPARE_FALSE) {
           Tcl_SetBooleanObj(resultObj, result == LDAP_COMPARE_TRUE);
           return TCL_OK;
       }
       LDAP_SetErrorCode(ldaptcl, result, interp);
       Tcl_AppendStringsToObj (resultObj,
                            "LDAP compare error: ",
                            LDAP_ERR_STRING(ldap),
                            (char *)NULL);
       return TCL_ERROR;
    }

    if (STREQU (subCommand, "cache")) {
#if defined(UMICH_LDAP) || (defined(OPEN_LDAP) && !defined(LDAP_API_VERSION))
       char *cacheCommand;

       if (objc < 3) {
         badargs:
           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) {
              Tcl_WrongNumArgs (interp, 
                                   3, objv,
                                   "dn");
              return TCL_ERROR;
           }

            dn = Tcl_GetStringFromObj (objv [3], NULL);
           ldap_uncache_entry (ldap, dn);
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "enable")) {
           long   timeout = ldaptcl->timeout;
           long   maxmem = ldaptcl->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)
                  return TCL_ERROR;
           }
           if (timeout == 0) {
              Tcl_SetStringObj(resultObj,
                  objc > 3 ? "timeouts must be greater than 0" : 
                  "no previous timeout to reference", -1);
              return TCL_ERROR;
           }

           if (objc > 4)
              if (Tcl_GetLongFromObj (interp, objv [4], &maxmem) == TCL_ERROR)
                  return TCL_ERROR;

           if (ldap_enable_cache (ldap, timeout, maxmem) == -1) {
              Tcl_AppendStringsToObj (resultObj,
                                   "LDAP cache enable error: ",
                                   LDAP_ERR_STRING(ldap),
                                   (char *)NULL);
              LDAP_SetErrorCode(ldaptcl, -1, interp);
              return TCL_ERROR;
           }
           ldaptcl->caching = 1;
           ldaptcl->timeout = timeout;
           ldaptcl->maxmem = maxmem;
           return TCL_OK;
       }

       if (objc != 3) goto badargs;

       if (STREQU (cacheCommand, "disable")) {
           ldap_disable_cache (ldap);
           ldaptcl->caching = 0;
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "destroy")) {
           ldap_destroy_cache (ldap);
           ldaptcl->caching = 0;
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "flush")) {
           ldap_flush_cache (ldap);
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "no_errors")) {
           ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHENOERRS);
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "all_errors")) {
           ldap_set_cache_options (ldap, LDAP_CACHE_OPT_CACHEALLERRS);
           return TCL_OK;
       }

       if (STREQU (cacheCommand, "size_errors")) {
           ldap_set_cache_options (ldap, 0);
           return TCL_OK;
       }
       Tcl_AppendStringsToObj (resultObj,
                            "\"",
                            command,
                            " ",
                            subCommand, 
                            "\" subcommand", 
                            " must be one of \"enable\", ",
                            "\"disable\", ",
                            "\"destroy\", \"flush\", \"uncache\", ",
                            "\"no_errors\", \"size_errors\",",
                            " 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) {
           Tcl_WrongNumArgs (interp, 2, objv,
                               "command ?errorCode-list?");
           return TCL_ERROR;
       }
       if (objc == 2) {
           if (!ldaptcl->trapCmdObj)
              return TCL_OK;
           resultObj = Tcl_NewListObj(0, NULL);
           Tcl_ListObjAppendElement(interp, resultObj, ldaptcl->trapCmdObj);
           if (ldaptcl->traplist) {
              listObj = Tcl_NewObj();
              for (p = ldaptcl->traplist; *p; p++) {
                  Tcl_ListObjAppendElement(interp, listObj, 
                     Tcl_NewStringObj(ldaptclerrorcode[*p], -1));
              }
              Tcl_ListObjAppendElement(interp, resultObj, listObj);
           }
           Tcl_SetObjResult(interp, resultObj);
           return TCL_OK;
       }
       if (ldaptcl->trapCmdObj) {
           Tcl_DecrRefCount (ldaptcl->trapCmdObj);
           ldaptcl->trapCmdObj = NULL;
       }
       if (ldaptcl->traplist) {
           free(ldaptcl->traplist);
           ldaptcl->traplist = NULL;
       }
       Tcl_GetStringFromObj(objv[2], &l);
       if (l == 0)
           return TCL_OK;          /* just turn off trap */
       ldaptcl->trapCmdObj = objv[2];
       Tcl_IncrRefCount (ldaptcl->trapCmdObj);
       if (objc < 4)
           return TCL_OK;          /* no code list */
       if (Tcl_ListObjLength(interp, objv[3], &l) != TCL_OK)
           return TCL_ERROR;
       if (l == 0)
           return TCL_OK;          /* empty code list */
       ldaptcl->traplist = (int*)malloc(sizeof(int) * (l + 1));
       ldaptcl->traplist[l] = 0;
       for (i = 0; i < l; i++) {
           Tcl_ListObjIndex(interp, objv[3], i, &resultObj);
           code = LDAP_ErrorStringToCode(interp, Tcl_GetStringFromObj(resultObj, NULL));
           if (code == -1) {
              free(ldaptcl->traplist);
              ldaptcl->traplist = NULL;
              return TCL_ERROR;
           }
           ldaptcl->traplist[i] = code;
       }
       return TCL_OK;
    }
    if (STREQU (subCommand, "trapcodes")) {
       int code;
       Tcl_Obj *resultObj;
       Tcl_Obj *stringObj;
       resultObj = Tcl_GetObjResult(interp);

       for (code = 0; code < LDAPTCL_MAXERR; code++) {
           if (!ldaptclerrorcode[code]) continue;
           Tcl_ListObjAppendElement(interp, resultObj,
                     Tcl_NewStringObj(ldaptclerrorcode[code], -1));
       }
       return TCL_OK;
    }
#ifdef LDAP_DEBUG
    if (STREQU (subCommand, "debug")) {
       if (objc != 3) {
           Tcl_AppendStringsToObj(resultObj, "Wrong # of arguments",
              (char*)NULL);
           return TCL_ERROR;
       }
       return Tcl_GetIntFromObj(interp, objv[2], &ldap_debug);
    }
#endif

    /* FIX: this needs to enumerate all the possibilities */
    Tcl_AppendStringsToObj (resultObj,
                           "subcommand \"", 
                         subCommand, 
                         "\" must be one of \"add\", ",
                         "\"add_attributes\", ",
                         "\"bind\", \"cache\", \"delete\", ",
                         "\"delete_attributes\", \"modify\", ",
                         "\"modify_rdn\", \"rename_rdn\", ",
                         "\"replace_attributes\", ",
                         "\"search\" or \"unbind\".",
                           (char *)NULL);
    return TCL_ERROR;
}

Here is the call graph for this function:

Here is the caller graph for this function: