1# Skip this for window and a specific version of Solaris 2# 3# This could do with an explanation -- why are we avoiding these platforms 4# and perhaps using critcl's platform::platform command might be better? 5# 6if {[string equal $::tcl_platform(platform) windows] || 7 ([string equal $::tcl_platform(os) SunOS] && 8 [string equal $::tcl_platform(osVersion) 5.6]) 9} { 10 # avoid warnings about nothing to compile 11 critcl::ccode { 12 /* nothing to do */ 13 } 14 return 15} 16 17package require critcl; 18 19namespace eval ::ip { 20 21critcl::ccode { 22#include <stdlib.h> 23#include <stdio.h> 24#include <tcl.h> 25#include <inttypes.h> 26#include <arpa/inet.h> 27#include <string.h> 28#include <sys/socket.h> 29} 30 31critcl::ccommand prefixToNativec {clientData interp objc objv} { 32 int elemLen, maskLen, ipLen, mask; 33 int rval,convertListc,i; 34 Tcl_Obj **convertListv; 35 Tcl_Obj *listPtr,*returnPtr, *addrList; 36 char *stringIP, *slashPos, *stringMask; 37 char v4HEX[11]; 38 39 uint32_t inaddr; 40 listPtr = NULL; 41 42 /* printf ("\n in prefixToNativeC"); */ 43 /* printf ("\n objc = %d",objc); */ 44 45 if (objc != 2) { 46 Tcl_WrongNumArgs(interp, 1, objv, "<ipaddress>/<mask>"); 47 return TCL_ERROR; 48 } 49 50 51 if (Tcl_ListObjGetElements (interp, objv[1], 52 &convertListc, &convertListv) != TCL_OK) { 53 return TCL_ERROR; 54 } 55 returnPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); 56 for (i = 0; i < convertListc; i++) { 57 /* need to create a duplicate here because when we modify */ 58 /* the stringIP it'll mess up the original in the calling */ 59 /* context */ 60 addrList = Tcl_DuplicateObj(convertListv[i]); 61 stringIP = Tcl_GetStringFromObj(addrList, &elemLen); 62 listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); 63 /* printf ("\n ### %s ### string \n", stringIP); */ 64 /* split the ip address and mask */ 65 slashPos = strchr(stringIP, (int) '/'); 66 if (slashPos == NULL) { 67 /* straight ip address without mask */ 68 mask = 0xffffffff; 69 ipLen = strlen(stringIP); 70 } else { 71 /* ipaddress has the mask, handle the mask and seperate out the */ 72 /* ip address */ 73 /* printf ("\n ** %d ",(uintptr_t)slashPos); */ 74 stringMask = slashPos +1; 75 maskLen =strlen(stringMask); 76 /* put mask in hex form */ 77 if (maskLen < 3) { 78 mask = atoi(stringMask); 79 mask = (0xFFFFFFFF << (32 - mask)) & 0xFFFFFFFF; 80 } else { 81 /* mask is in dotted form */ 82 if ((rval = inet_pton(AF_INET,stringMask,&mask)) < 1 ) { 83 Tcl_AddErrorInfo(interp, "\n bad format encountered in mask conversion"); 84 return TCL_ERROR; 85 } 86 mask = htonl(mask); 87 } 88 ipLen = (uintptr_t)slashPos - (uintptr_t)stringIP; 89 /* divide the string into ip and mask portion */ 90 *slashPos = '\0'; 91 /* printf("\n %d %d %d %d", (uintptr_t)stringMask, maskLen, (uintptr_t)stringIP, ipLen); */ 92 } 93 if ( (rval = inet_pton(AF_INET,stringIP,&inaddr)) < 1) { 94 Tcl_AddErrorInfo(interp, 95 "\n bad format encountered in ip conversion"); 96 return TCL_ERROR; 97 }; 98 inaddr = htonl(inaddr); 99 /* apply the mask the to the ip portion, just to make sure */ 100 /* what we return is cleaned up */ 101 inaddr = inaddr & mask; 102 sprintf(v4HEX,"0x%08X",inaddr); 103 /* printf ("\n\n ### %s",v4HEX); */ 104 Tcl_ListObjAppendElement(interp, listPtr, 105 Tcl_NewStringObj(v4HEX,-1)); 106 sprintf(v4HEX,"0x%08X",mask); 107 Tcl_ListObjAppendElement(interp, listPtr, 108 Tcl_NewStringObj(v4HEX,-1)); 109 Tcl_ListObjAppendElement(interp, returnPtr, listPtr); 110 Tcl_DecrRefCount(addrList); 111 } 112 113 if (convertListc==1) { 114 Tcl_SetObjResult(interp,listPtr); 115 } else { 116 Tcl_SetObjResult(interp,returnPtr); 117 } 118 119 return TCL_OK; 120} 121 122critcl::ccommand isOverlapNativec {clientData interp objc objv} { 123 int i; 124 unsigned int ipaddr,ipMask, mask1mask2; 125 unsigned int ipaddr2,ipMask2; 126 int compareListc,comparePrefixMaskc; 127 int allSet,inlineSet,index; 128 Tcl_Obj **compareListv,**comparePrefixMaskv, *listPtr; 129 Tcl_Obj *result; 130 static CONST char *options[] = { 131 "-all", "-inline", "-ipv4", NULL 132 }; 133 enum options { 134 OVERLAP_ALL, OVERLAP_INLINE, OVERLAP_IPV4 135 }; 136 137 allSet = 0; 138 inlineSet = 0; 139 listPtr = NULL; 140 141 /* printf ("\n objc = %d",objc); */ 142 if (objc < 3) { 143 Tcl_WrongNumArgs(interp, 1, objv, "?options? <hexIP> <hexMask> <hexList>"); 144 return TCL_ERROR; 145 } 146 for (i = 1; i < objc-3; i++) { 147 if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index) 148 != TCL_OK) { 149 return TCL_ERROR; 150 } 151 switch (index) { 152 case OVERLAP_ALL: 153 allSet = 1; 154 /* printf ("\n all selected"); */ 155 break; 156 case OVERLAP_INLINE: 157 inlineSet = 1; 158 /* printf ("\n inline selected"); */ 159 break; 160 case OVERLAP_IPV4: 161 break; 162 } 163 } 164 /* options are parsed */ 165 166 /* create return obj */ 167 result = Tcl_GetObjResult (interp); 168 169 /* set ipaddr and ipmask */ 170 Tcl_GetIntFromObj(interp,objv[objc-3],&ipaddr); 171 Tcl_GetIntFromObj(interp,objv[objc-2],&ipMask); 172 173 /* split the 3rd argument into <ipaddr> <mask> pairs */ 174 if (Tcl_ListObjGetElements (interp, objv[objc-1], &compareListc, &compareListv) != TCL_OK) { 175 return TCL_ERROR; 176 } 177/* printf("comparing %x/%x \n",ipaddr,ipMask); */ 178 179 if (allSet || inlineSet) { 180 listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); 181 } 182 183 for (i = 0; i < compareListc; i++) { 184 /* split the ipaddr2 and ipmask2 */ 185 if (Tcl_ListObjGetElements (interp, 186 compareListv[i], 187 &comparePrefixMaskc, 188 &comparePrefixMaskv) != TCL_OK) { 189 return TCL_ERROR; 190 } 191 if (comparePrefixMaskc != 2) { 192 Tcl_AddErrorInfo(interp,"need format {{<ipaddr> <mask>} {<ipad..}}"); 193 return TCL_ERROR; 194 } 195 Tcl_GetIntFromObj(interp,comparePrefixMaskv[0],&ipaddr2); 196 Tcl_GetIntFromObj(interp,comparePrefixMaskv[1],&ipMask2); 197/* printf(" with %x/%x \n",ipaddr2,ipMask2); */ 198 mask1mask2 = ipMask & ipMask2; 199/* printf(" mask1mask2 %x \n",mask1mask2); */ 200/* printf(" ipaddr & mask1mask2 %x\n",ipaddr & mask1mask2); */ 201/* printf(" ipaddr2 & mask1mask2 %x\n",ipaddr2 & mask1mask2); */ 202 if ((ipaddr & mask1mask2) == (ipaddr2 & mask1mask2)) { 203 if (allSet) { 204 if (inlineSet) { 205 Tcl_ListObjAppendElement(interp, listPtr, 206 compareListv[i]); 207 } else { 208 /* printf("\n appending %d",i+1); */ 209 Tcl_ListObjAppendElement(interp, listPtr, 210 Tcl_NewIntObj(i+1)); 211 }; 212 } else { 213 if (inlineSet) { 214 Tcl_ListObjAppendElement(interp, listPtr, 215 compareListv[i]); 216 Tcl_SetObjResult(interp,listPtr); 217 } else { 218 Tcl_SetIntObj (result, i+1); 219 } 220 return TCL_OK; 221 }; 222 }; 223 }; 224 225 if (allSet || inlineSet) { 226 Tcl_SetObjResult(interp, listPtr); 227 return TCL_OK; 228 } else { 229 Tcl_SetIntObj (result, 0); 230 return TCL_OK; 231 } 232 return TCL_OK; 233 234 235 236} 237 238 239} 240 241# @sak notprovided ipMorec 242package provide ipMorec 1.0 243