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