source: tol/tolsh/tolsh.vfs/lib/tcllib1.10/dns/ipMoreC.tcl

devel
Last change on this file was 8597867d, checked in by Jorge Pérez <josp.jorge@…>, 16 years ago

closes #976, se incluye tcllib1.10, base64 debe eliminarse del raiz de lib ya que esta incluido en tcllib

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@2556 be4846ae-f051-483a-831f-b64e7d08527f
  • Property mode set to 100644
File size: 7.2 KB
Line 
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
241package provide ipMorec 1.0
Note: See TracBrowser for help on using the repository browser.