/[pdpsoft]/trunk/nl.nikhef.ndpf.tools/foundry-tracl/tr-acl.pl
ViewVC logotype

Contents of /trunk/nl.nikhef.ndpf.tools/foundry-tracl/tr-acl.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 45 - (show annotations) (download) (as text)
Thu Jan 8 08:04:06 2009 UTC (13 years ago) by davidg
File MIME type: text/x-prolog
File size: 11075 byte(s)
Added guess for L4 CAM usage

1 #! /usr/bin/perl -w
2 #
3 # @(#)$Id$
4 #
5 use strict;
6 use Socket;
7 use Getopt::Long qw(:config no_ignore_case bundling);
8
9 use vars qw/ $help $verb /;
10 my $help = undef;
11 my $verb = 0;
12
13 GetOptions( "h|help" => \$help, "verbose|v+" => \$verb );
14
15 if ( $help ) {
16 print STDERR <<EOF;
17 Usage: $0 [-h] [-v] [ruleset]
18
19 Generate a set of named extended ACLs for Foundry Network devices to be
20 applied to the inbound dirction of an interface. The ruleset is expressed
21 in bi-directional semantics: based on the list of connected networks to
22 each interface a full complement of access control entries is generated
23 such that only 'allowed' traffic in permitted to enter the logical routing
24 core and thus from there go unfiltered to one of the connected networks.
25 This script can only process and generate IPv4 ACLs.
26
27 -h Give this help
28 -v Give verbose diagnostics on STDERR
29
30 Syntax (see also the example file):
31
32 interface <name>
33 connects <ipv4-net>
34 [connects <ipv4-net> ...]
35 [excludes <ipv4-net> ...]
36 [prepend <ruledef> ...]
37 [append <ruledef> ...]
38 end
39
40 stanza <name> [<in-line-replacement>]
41 [<next-line-replacement> ...]
42 end
43
44 ruleset
45 [<rule-in-FN-EACL-syntax> ...]
46 end
47
48 end
49
50 The "stanza" lines act as macros and can be invoked by \$macro([args])
51 later in the rule set. Any "\$variable" instances are replaced by their
52 value given between the parentheses. Stanzas can be recursive.
53
54 EOF
55
56 exit(0);
57 }
58
59 sub addr_word($) {
60 my ($mask) = @_;
61 my ($bmask,$i)=(0,0);
62
63 if ( length($mask) <= 2 ) {
64 for ($i=0;$i<$mask;$i++) { $bmask|=1<<(31-$i); }
65 } else {
66 foreach (split /\./,$mask) { $bmask|=(($_)<<(8*(3-($i++)))); }
67 }
68 return $bmask;
69 }
70
71 sub netmatch($$) {
72 my ($a,$b) = @_;
73
74 my ($ipa,$maska) = split(/\//,$a,2);
75 my ($ipb,$maskb) = split(/\//,$b,2);
76
77 my $bmaska = &addr_word($maska);
78 my $bmaskb = &addr_word($maskb);
79 my $shortestmask = $bmaska & $bmaskb;
80
81 my $addra=&addr_word($ipa);
82 my $addrb=&addr_word($ipb);
83
84 $verb>2 and print "\n shortest mask: $shortestmask for $ipa $ipb\n";
85 $verb>2 and print " with addra = $addra and addrb = $addrb\n";
86
87 return 1 unless (($addra & $shortestmask) ^ ($addrb & $shortestmask));
88 return 0;
89 }
90
91 sub netwithin($$) {
92 my ($a,$b) = @_;
93
94 my ($ipa,$maska) = split(/\//,$a,2);
95 my ($ipb,$maskb) = split(/\//,$b,2);
96
97 my $bmaska = &addr_word($maska);
98 my $bmaskb = &addr_word($maskb);
99 my $shortestmask = $bmaska & $bmaskb;
100
101 my $neta=&addr_word($ipa) & $bmaskb & $bmaska;
102 my $netb=&addr_word($ipb) & $bmaskb;
103
104 $verb>3 and printf "neta=%04x, netb=%04x, XOR=%04x, maska=%04x, maskb=%04x\n",$neta,$netb,$netb^$neta,$bmaska,$bmaskb;
105 if ( (($netb^$neta)==0) || ($netb==$neta) ) { # they are equal, so may be subset?
106 # now depends on netmask length
107 my $allones=4294967295;
108 if ( ($bmaskb==$bmaska) || (($bmaskb^$allones) & $bmaska) ) { return 1; }
109 }
110 return 0;
111 }
112
113 sub matchtest($$) {
114 my ($a,$b) = @_;
115 print "Testing if $a matches $b: ";
116 if (&netmatch($a,$b)) { print " YES"; } else { print " NO"; }
117 print "\n";
118 }
119
120 #&matchtest("127.0.0.0/8","127.0.0.0/8");
121 #&matchtest("172.16.0.0/12","172.20.0.0/16");
122 #&matchtest("172.16.0.0/12","172.20.0.0/255.255.0.0");
123 #&matchtest("192.16.199.0/24","172.20.0.0/16");
124 #&matchtest("172.21.0.0/16","172.20.0.0/16");
125
126 my (%interface,@rules,%stanza,@oldlines);
127
128 sub readline() {
129 my ($line);
130
131 # are there old lines to feed?
132 if ( defined $oldlines[0] ) {
133 $line = shift @oldlines;
134 chomp($line); $line =~ s/^\s+//;
135 $_ = $line;
136 return $line;
137 }
138
139 while ( $line = <> ) {
140 chomp($line); $line =~ s/^\s+//;
141 $line =~ /^!/ and next;
142 $line =~/^$/ and next;
143 last;
144 }
145
146 if ( defined $line ) {
147 while ( $line =~ m/\$([-\w\d]+)\(([^\)]*)\)/ ) {
148 my ($name,$args) = ($1,$2);
149 die "Stanza $name undefined\n" unless defined $stanza{$name};
150 my $instance = $stanza{$name};
151 foreach my $argdef ( split /,/,$args ) {
152 my ($key,$value) = split /=/,$argdef;
153 $instance =~ s/\$$key([^\(\w])/$value$1/isg;
154 }
155 $line =~ s/\$([-\w\d]+)\(([^\)]*)\)/$instance/;
156 }
157 push @oldlines,split(/\n/,$line);
158 }
159 return undef if not defined $line;
160
161 $line = shift @oldlines;
162
163 $_ = $line;
164 return $line;
165 }
166
167 sub parse_interface($) {
168 my ($name) = @_;
169 my (@networks,@excludes);
170
171 $interface{$name}{"name"} = $name;
172
173 push @networks,"127.0.0.0/8";
174
175 while(&readline) {
176 /^end/ and do {
177 $interface{$name}{"network"} = \@networks;
178 $interface{$name}{"excludes"} = \@excludes;
179 return 0;
180 };
181 /^prepend/ and do {
182 my ($kw,$rule) = split /\s+/,$_,2;
183 push @{$interface{$name}{"prepend"}}, $rule;
184 };
185 /^append/ and do {
186 my ($kw,$rule) = split /\s+/,$_,2;
187 push @{$interface{$name}{"append"}}, $rule;
188 };
189 /^connects/ and do {
190 my ($kw,$network) = split;
191 push @networks,$network;
192 };
193 /^excludes/ and do {
194 my ($kw,$network) = split;
195 push @excludes,$network;
196 };
197 }
198 die "Syntax error in input aroud line $.: \n".
199 "no end statement found in interface definition $name\n";
200 }
201
202 sub parse_ruleset() {
203 while (&readline) {
204 /^end/ and return 0;
205 /^(permit|deny)/ and do {
206 my ($kw,$rule) = split /\s+/,$_,2;
207 my %ruledef = &parse_rule($_);
208 push @rules,\%ruledef;
209 };
210 }
211 }
212
213 sub parse_stanza($) {
214 my ($def) = @_;
215 my ($name,$value) = split /\s/,$def,2;
216
217 $stanza{$name} = $value;
218 while(&readline) {
219 /^end/ and return 0;
220 $stanza{$name}.=$_."\n";
221 }
222 die "Stanza $name unterminated around line $.\n";
223 }
224
225 sub parse_rule($) {
226 my ($str) = @_;
227 my (%rule);
228 my ($i) = 0;
229
230 my @tok = split /\s+/,$str;
231 $rule{"text"} = $str;
232 $rule{"sense"} = $tok[$i++];
233 $rule{"proto"} = $tok[$i++];
234
235 # source IP address
236 if ( $tok[$i] eq "any" ) {
237 $rule{"src"} = "0.0.0.0/0";
238 } elsif ( $tok[$i] eq "host" ) {
239 $i++;
240 $rule{"src"} = $tok[$i]."/32";
241 } elsif ( $tok[$i] =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
242 die "Syntax error at line $.: $_\n"
243 unless $tok[$i+1] =~ /^\d+\.\d+\.\d+\.\d+$/;
244 $rule{"src"} = $tok[$i]."/".$tok[$i+1];
245 $i++;
246 } elsif ( $tok[$i] =~ /^\d+\.\d+\.\d+\.\d+\/.*/ ) {
247 $rule{"src"} = $tok[$i];
248 } else {
249 die "Syntax error in line $.: $_\n";
250 }
251 $i++;
252
253 # optional port
254 if ($tok[$i] =~ /^(eq|gt|lt|neq)$/ ) {
255 $i+=2;
256 }
257 if ($tok[$i] =~ /^established$/ ) {
258 $i++;
259 }
260 if ($tok[$i] =~ /^range$/ ) {
261 $i+=3;
262 }
263
264 # destination IP address
265 if ( $tok[$i] eq "any" ) {
266 $rule{"dst"} = "0.0.0.0/0";
267 } elsif ( $tok[$i] eq "host" ) {
268 $i++;
269 $rule{"dst"} = $tok[$i]."/32";
270 } elsif ( $tok[$i] =~ /^\d+\.\d+\.\d+\.\d+$/ ) {
271 die "Syntax error at line $.: $_\n"
272 unless $tok[$i+1] =~ /^\d+\.\d+\.\d+\.\d+$/;
273 $rule{"dst"} = $tok[$i]."/".$tok[$i+1];
274 $i++;
275 } elsif ( $tok[$i] =~ /^\d+\.\d+\.\d+\.\d+\/.*/ ) {
276 $rule{"dst"} = $tok[$i];
277 } else {
278 die "Syntax error in line $.: $_\n";
279 }
280 $i++;
281
282 return %rule;
283 }
284
285 sub rule_issimple($) {
286 my ($rule) = @_;
287 my @elements = split(/\s+/,$rule);
288 return ($#elements==3?1:0);
289 }
290
291 sub rule_isonesided($) {
292 my ($rule) = @_;
293 my @elements = split(/\s+/,$rule);
294 return ($#elements==5?1:0);
295 }
296
297 sub rule_istwosided($) {
298 my ($rule) = @_;
299 my @elements = split(/\s+/,$rule);
300 return ($#elements==8?1:0);
301 }
302
303 sub rule_iscomplex($) {
304 my ($rule) = @_;
305 return ($rule=~/established/?1:0);
306 }
307
308 sub generate_acls() {
309 print "!\n! generated ACLs for inbound direction\n!\n";
310 foreach my $iface ( sort keys %interface ) {
311 my $aclcount=0;
312 my $aclc_simple=0;
313 my $aclc_one=0;
314 my $aclc_two=0;
315 my $aclc_complex=0;
316 print "no ip access-list extended $iface\n";
317 print "ip access-list extended $iface\n";
318 foreach my $rule (@{$interface{$iface}{"prepend"}} ) {
319 print " $rule\n";
320 $aclcount++;
321 $aclc_simple++ if rule_issimple($rule);
322 $aclc_one++ if rule_isonesided($rule);
323 $aclc_two++ if rule_istwosided($rule);
324 $aclc_complex++ if rule_iscomplex($rule);
325 }
326
327 $verb and do {
328 print "! this interface connects:";
329 foreach my $net ( @{$interface{$iface}{"network"}} ) {
330 print " $net";
331 }
332 print "\n";
333 print "! except for:";
334 foreach my $net ( @{$interface{$iface}{"excludes"}} ) {
335 print " $net";
336 }
337 print "\n";
338 };
339
340 foreach my $rule ( @rules ) {
341 # is it applicable?
342 my $matched = 0;
343
344 foreach my $net (@{$interface{$iface}{"network"}} ) {
345 $verb and
346 print " ! matching source ".$rule->{"src"}."\n";
347 &netmatch($net,$rule->{"src"}) and $matched++;
348 }
349
350 # permit to self-only is useless, but there's not good algo to keep it out
351 my ($nnetworks,$nselfmatches)=(0,0);
352 foreach my $net (@{$interface{$iface}{"network"}} ) {
353 $net eq "127.0.0.0/8" and next;
354 $nnetworks++;
355 if ( &netwithin($rule->{"dst"},$net) ) {
356 $nselfmatches++;
357 $verb and
358 print " ! from source ".$rule->{"src"}.
359 " to dest ".$rule->{"dst"}.
360 " entirely within $net\n";
361 }
362 }
363 if ( $nnetworks == $nselfmatches ) {
364 $matched = 0;
365 $verb and
366 print " ! killed $nselfmatches: ".
367 $rule->{"text"}."\n";
368 }
369
370 foreach my $net (@{$interface{$iface}{"excludes"}} ) {
371 $verb and print " ! $net matching source ".
372 $rule->{"src"}."\n";
373 if ( &netwithin($rule->{"src"},$net) ) {
374 $matched=0;
375 $verb and print " ! killed ".$rule->{"text"}."\n";
376 $verb and print " ! source ".$rule->{"src"}." entirely within $net\n";
377 }
378 }
379 print " ".$rule->{"text"}."\n" if $matched;
380 $aclcount++ if $matched;
381 $aclc_simple++ if $matched and rule_issimple($rule->{"text"});
382 $aclc_one++ if $matched and rule_isonesided($rule->{"text"});
383 $aclc_two++ if $matched and rule_istwosided($rule->{"text"});
384 $aclc_complex++ if $matched and rule_iscomplex($rule->{"text"});
385 $verb and print " ! suppressed: ".$rule->{"text"}."\n" unless $matched;
386 }
387 foreach my $rule (@{$interface{$iface}{"append"}} ) {
388 print " $rule\n";
389 $aclcount++;
390 $aclc_simple++ if rule_issimple($rule);
391 $aclc_one++ if rule_isonesided($rule);
392 $aclc_two++ if rule_istwosided($rule);
393 $aclc_complex++ if rule_iscomplex($rule);
394 }
395 print "! ACL for $iface contains $aclcount ACEs\n";
396 print "! of which simple=$aclc_simple onesided=$aclc_one twosided=$aclc_two complex=$aclc_complex\n";
397 my $words = 2*$aclc_simple + 4*$aclc_one +
398 4*$aclc_two + 4 * $aclc_complex;
399 print "! Untested: $iface may use $words words of CAM\n!\n";
400 }
401 }
402
403 while (&readline) {
404 my ($kw,$name) = split /\s+/,$_,2;
405
406 $kw =~ /^stanza/ and &parse_stanza($name);
407 $kw =~ /^interface/ and &parse_interface($name);
408 $kw =~ /^ruleset/ and &parse_ruleset;
409 $kw =~ /^end/ and &generate_acls;
410 };
411
412 0;
413
414

Properties

Name Value
svn:executable *

grid.support@nikhef.nl
ViewVC Help
Powered by ViewVC 1.1.28