1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
|
# 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 <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 maskLen, ipLen, mask;
int rval;
Tcl_Size elemLen, 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>"); /* OK tcl9 */
return TCL_ERROR;
}
if (Tcl_ListObjGetElements (interp, objv[1], /* OK tcl9 */
&convertListc, &convertListv) != TCL_OK) {
return TCL_ERROR;
}
returnPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* OK tcl9 */
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); /* OK tcl9 */
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); /* OK tcl9 */
/* 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)); /* OK tcl9 */
sprintf(v4HEX,"0x%08X",mask);
Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj(v4HEX,-1)); /* OK tcl9 */
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;
Tcl_Size 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>"); /* OK tcl9 */
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); /* OK tcl9 */
Tcl_GetIntFromObj(interp,objv[objc-2],(int*)&ipMask); /* OK tcl9 */
/* split the 3rd argument into <ipaddr> <mask> pairs */
if (Tcl_ListObjGetElements (interp, /* OK tcl9 */
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); /* OK tcl9 */
}
for (i = 0; i < compareListc; i++) {
/* split the ipaddr2 and ipmask2 */
if (Tcl_ListObjGetElements (interp, /* OK tcl9 */
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],(int*)&ipaddr2); /* OK tcl9 */
Tcl_GetIntFromObj(interp,comparePrefixMaskv[1],(int*)&ipMask2); /* OK tcl9 */
/* 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)); /* OK tcl9 */
};
} 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;
}
}
# @sak notprovided ipMorec
package provide ipMorec 1.0
|
