couldn't find HOME environment variable to expand path
while executing
"file normalize $dir"
(procedure "cache" line 3)
invoked from within
"cache [file join ~ .critcl [platform::identify]]"
(procedure "setconfig" line 66)
invoked from within
"setconfig "" "
(procedure "readconfig" line 176)
invoked from within
"readconfig [file join $mydir Config]"
(procedure "::critcl::Initialize" line 39)
invoked from within
"::critcl::Initialize"
(file "/commun/linux/local/ActiveTcl-8.6.11/lib/tcl8.6/critcl3.1.17/critcl.tcl" line 5924)
invoked from within
"source /commun/linux/local/ActiveTcl-8.6.11/lib/tcl8.6/critcl3.1.17/critcl.tcl"
("package ifneeded critcl 3.1.17" script)
invoked from within
"package require critcl"
(in namespace eval "::request" script line 17)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
# Skip this for window and a specific version of Solaris
#
# This could do with an explanation -- why are we avoiding these platforms
# and perhaps using critcl's platform::platform command might be better?
#
if {[string equal $::tcl_platform(platform) windows] ||
([string equal $::tcl_platform(os) SunOS] &&
[string equal $::tcl_platform(osVersion) 5.6])
} {
# avoid warnings about nothing to compile
critcl::ccode {
/* nothing to do */
}
return
}
package require critcl;
namespace eval ::ip {
critcl::ccode {
#include
#include
#include
#include
#include
#include
#include
}
critcl::ccommand prefixToNativec {clientData interp objc objv} {
int elemLen, maskLen, ipLen, mask;
int rval,convertListc,i;
Tcl_Obj **convertListv;
Tcl_Obj *listPtr,*returnPtr, *addrList;
char *stringIP, *slashPos, *stringMask;
char v4HEX[11];
uint32_t inaddr;
listPtr = NULL;
/* printf ("\n in prefixToNativeC"); */
/* printf ("\n objc = %d",objc); */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "/");
return TCL_ERROR;
}
if (Tcl_ListObjGetElements (interp, objv[1],
&convertListc, &convertListv) != TCL_OK) {
return TCL_ERROR;
}
returnPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
for (i = 0; i < convertListc; i++) {
/* need to create a duplicate here because when we modify */
/* the stringIP it'll mess up the original in the calling */
/* context */
addrList = Tcl_DuplicateObj(convertListv[i]);
stringIP = Tcl_GetStringFromObj(addrList, &elemLen);
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
/* printf ("\n ### %s ### string \n", stringIP); */
/* split the ip address and mask */
slashPos = strchr(stringIP, (int) '/');
if (slashPos == NULL) {
/* straight ip address without mask */
mask = 0xffffffff;
ipLen = strlen(stringIP);
} else {
/* ipaddress has the mask, handle the mask and seperate out the */
/* ip address */
/* printf ("\n ** %d ",(uintptr_t)slashPos); */
stringMask = slashPos +1;
maskLen =strlen(stringMask);
/* put mask in hex form */
if (maskLen < 3) {
mask = atoi(stringMask);
mask = (0xFFFFFFFF << (32 - mask)) & 0xFFFFFFFF;
} else {
/* mask is in dotted form */
if ((rval = inet_pton(AF_INET,stringMask,&mask)) < 1 ) {
Tcl_AddErrorInfo(interp, "\n bad format encountered in mask conversion");
return TCL_ERROR;
}
mask = htonl(mask);
}
ipLen = (uintptr_t)slashPos - (uintptr_t)stringIP;
/* divide the string into ip and mask portion */
*slashPos = '\0';
/* printf("\n %d %d %d %d", (uintptr_t)stringMask, maskLen, (uintptr_t)stringIP, ipLen); */
}
if ( (rval = inet_pton(AF_INET,stringIP,&inaddr)) < 1) {
Tcl_AddErrorInfo(interp,
"\n bad format encountered in ip conversion");
return TCL_ERROR;
};
inaddr = htonl(inaddr);
/* apply the mask the to the ip portion, just to make sure */
/* what we return is cleaned up */
inaddr = inaddr & mask;
sprintf(v4HEX,"0x%08X",inaddr);
/* printf ("\n\n ### %s",v4HEX); */
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(v4HEX,-1));
sprintf(v4HEX,"0x%08X",mask);
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewStringObj(v4HEX,-1));
Tcl_ListObjAppendElement(interp, returnPtr, listPtr);
Tcl_DecrRefCount(addrList);
}
if (convertListc==1) {
Tcl_SetObjResult(interp,listPtr);
} else {
Tcl_SetObjResult(interp,returnPtr);
}
return TCL_OK;
}
critcl::ccommand isOverlapNativec {clientData interp objc objv} {
int i;
unsigned int ipaddr,ipMask, mask1mask2;
unsigned int ipaddr2,ipMask2;
int compareListc,comparePrefixMaskc;
int allSet,inlineSet,index;
Tcl_Obj **compareListv,**comparePrefixMaskv, *listPtr;
Tcl_Obj *result;
static CONST char *options[] = {
"-all", "-inline", "-ipv4", NULL
};
enum options {
OVERLAP_ALL, OVERLAP_INLINE, OVERLAP_IPV4
};
allSet = 0;
inlineSet = 0;
listPtr = NULL;
/* printf ("\n objc = %d",objc); */
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?options? ");
return TCL_ERROR;
}
for (i = 1; i < objc-3; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
!= TCL_OK) {
return TCL_ERROR;
}
switch (index) {
case OVERLAP_ALL:
allSet = 1;
/* printf ("\n all selected"); */
break;
case OVERLAP_INLINE:
inlineSet = 1;
/* printf ("\n inline selected"); */
break;
case OVERLAP_IPV4:
break;
}
}
/* options are parsed */
/* create return obj */
result = Tcl_GetObjResult (interp);
/* set ipaddr and ipmask */
Tcl_GetIntFromObj(interp,objv[objc-3],(int*)&ipaddr);
Tcl_GetIntFromObj(interp,objv[objc-2],(int*)&ipMask);
/* split the 3rd argument into pairs */
if (Tcl_ListObjGetElements (interp, objv[objc-1], &compareListc, &compareListv) != TCL_OK) {
return TCL_ERROR;
}
/* printf("comparing %x/%x \n",ipaddr,ipMask); */
if (allSet || inlineSet) {
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
}
for (i = 0; i < compareListc; i++) {
/* split the ipaddr2 and ipmask2 */
if (Tcl_ListObjGetElements (interp,
compareListv[i],
&comparePrefixMaskc,
&comparePrefixMaskv) != TCL_OK) {
return TCL_ERROR;
}
if (comparePrefixMaskc != 2) {
Tcl_AddErrorInfo(interp,"need format {{ } {