ipMoreC.tcl

Go to the documentation of this file.

/*  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 ::ip {

critcl::ccode {
/* include <stdlib.h>*/
/* include <stdio.h>*/
/* include <tcl.h>*/
/* include <inttypes.h>*/
/* include <arpa/inet.h>*/
/* include <string.h>*/
/* include <sys/socket.h>*/
}

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, "<ipaddress>/<mask>");
        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? <hexIP> <hexMask> <hexList>");
                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);

        /*  ipaddr =  and ipmask */
        Tcl_GetIntFromObj(interp,objv[objc-3],&ipaddr);
        Tcl_GetIntFromObj(interp,objv[objc-2],&ipMask);

        /* split the 3rd argument into <ipaddr> <mask> 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 {{<ipaddr> <mask>} {<ipad..}}");
                        return TCL_ERROR;
                }
                Tcl_GetIntFromObj(interp,comparePrefixMaskv[0],&ipaddr2);
                Tcl_GetIntFromObj(interp,comparePrefixMaskv[1],&ipMask2);
/*               printf(" with %x/%x \n",ipaddr2,ipMask2); */
                mask1mask2 = ipMask & ipMask2;
/*               printf("  mask1mask2 %x \n",mask1mask2); */
/*               printf("  ipaddr & mask1mask2  %x\n",ipaddr & mask1mask2); */
/*               printf("  ipaddr2 & mask1mask2 %x\n",ipaddr2 & mask1mask2); */
                if ((ipaddr & mask1mask2) == (ipaddr2 & mask1mask2)) {
            if (allSet) {
            if (inlineSet) {
                Tcl_ListObjAppendElement(interp, listPtr,
                             compareListv[i]);
            } else {
                /* printf("\n appending %d",i+1); */
                Tcl_ListObjAppendElement(interp, listPtr,
                             Tcl_NewIntObj(i+1));
            };
            } else {
            if (inlineSet) {
                Tcl_ListObjAppendElement(interp, listPtr,
                             compareListv[i]);
                Tcl_SetObjResult(interp,listPtr);
            } else {
                Tcl_SetIntObj (result, i+1);
            }
            return TCL_OK;
            };
                };
                    };

        if (allSet || inlineSet) {
                Tcl_SetObjResult(interp, listPtr);
                return TCL_OK;
        } else {
                Tcl_SetIntObj (result, 0);
                return TCL_OK;
        }
        return TCL_OK;



}


}

package provide ipMorec 1.0