line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
# $Id: Prefix.pm,v 1.9 2003/06/06 18:45:02 unimlo Exp $ |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
package Net::ACL::Match::Prefix; |
6
|
|
|
|
|
|
|
|
7
|
2
|
|
|
2
|
|
21010
|
use strict; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
76
|
|
8
|
2
|
|
|
2
|
|
11
|
use vars qw( $VERSION @ISA ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
146
|
|
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
## Inheritance and Versioning ## |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
@ISA = qw( Net::ACL::Match::IP ); |
13
|
|
|
|
|
|
|
$VERSION = '0.07'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
## Module Imports ## |
16
|
|
|
|
|
|
|
|
17
|
2
|
|
|
2
|
|
11
|
use Carp; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
151
|
|
18
|
2
|
|
|
2
|
|
830
|
use Net::ACL::Match::IP; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
80
|
|
19
|
2
|
|
|
2
|
|
11
|
use Net::ACL::Rule qw( :rc ); |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
201
|
|
20
|
2
|
|
|
2
|
|
12
|
use Scalar::Util qw(blessed); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
108
|
|
21
|
2
|
|
|
2
|
|
13
|
use Net::Netmask; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
1364
|
|
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
## Public Class Methods ## |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new |
26
|
|
|
|
|
|
|
{ |
27
|
8
|
|
|
8
|
1
|
2977
|
my $proto = shift; |
28
|
8
|
|
33
|
|
|
39
|
my $class = ref $proto || $proto; |
29
|
8
|
|
|
|
|
12
|
my $size; |
30
|
8
|
|
|
|
|
12
|
my $mode = 0; |
31
|
8
|
|
|
|
|
18
|
my @arg = @_; |
32
|
8
|
100
|
|
|
|
56
|
if ($arg[$#arg] =~ s/\W*([gl]e)\W+(\d+)$//i) |
33
|
|
|
|
|
|
|
{ |
34
|
3
|
|
|
|
|
9
|
$mode = lc($1); |
35
|
3
|
|
|
|
|
7
|
$size = $2; |
36
|
3
|
50
|
|
|
|
11
|
pop(@arg) if $arg[$#arg] eq ''; |
37
|
|
|
|
|
|
|
}; |
38
|
|
|
|
|
|
|
# How to do this with out hardcoding name? This doesn't work! |
39
|
|
|
|
|
|
|
# my $this = SUPER::new(@arg); |
40
|
8
|
|
|
|
|
39
|
my $this = new Net::ACL::Match::IP(@arg); |
41
|
8
|
|
|
|
|
19
|
$this->{_size} = $size; |
42
|
8
|
|
|
|
|
12
|
$this->{_mode} = $mode; |
43
|
8
|
|
|
|
|
54
|
return bless($this,$class); |
44
|
|
|
|
|
|
|
}; |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
## Public Object Methods ## |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub match |
49
|
|
|
|
|
|
|
{ |
50
|
16
|
|
|
16
|
1
|
968
|
my $this = shift; |
51
|
16
|
|
|
|
|
62
|
my $other = $_[$this->index]; |
52
|
16
|
50
|
33
|
|
|
117
|
$other = (blessed $other && $other->isa('Net::Netmask')) ? $other : new Net::Netmask($other); |
53
|
|
|
|
|
|
|
|
54
|
16
|
100
|
|
|
|
1226
|
unless ($this->{_mode}) |
55
|
|
|
|
|
|
|
{ # Normal mode of operation! |
56
|
4
|
100
|
66
|
|
|
17
|
return ($this->{_net}->base eq $other->base) |
57
|
|
|
|
|
|
|
&& ($this->{_net}->bits == $other->bits) ? ACL_MATCH : ACL_NOMATCH; |
58
|
|
|
|
|
|
|
}; |
59
|
12
|
100
|
|
|
|
50
|
return ACL_NOMATCH unless $this->{_net}->match($other->base); # Not within! |
60
|
9
|
50
|
|
|
|
410
|
return ACL_NOMATCH if $this->{_net}->bits > $other->bits; # Larger then this! |
61
|
9
|
50
|
|
|
|
103
|
return ACL_MATCH if $this->{_size} == $other->bits; # Right size! |
62
|
9
|
100
|
|
|
|
73
|
return ($this->{_size} < $other->bits) == ($this->{_mode} eq 'ge') ? ACL_MATCH : ACL_NOMATCH; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub mode |
66
|
|
|
|
|
|
|
{ |
67
|
4
|
|
|
4
|
1
|
5
|
my $this = shift; |
68
|
4
|
0
|
|
|
|
18
|
$this->{_mode} = @_ ? (shift =~ /([lg]e)/ ? $1 : 0) : $this->{_mode}; |
|
|
50
|
|
|
|
|
|
69
|
4
|
|
|
|
|
15
|
return $this->{_mode}; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub size |
73
|
|
|
|
|
|
|
{ |
74
|
0
|
|
|
0
|
1
|
|
my $this = shift; |
75
|
0
|
0
|
|
|
|
|
$this->{_size} = @_ ? shift : $this->{_size}; |
76
|
0
|
|
|
|
|
|
return $this->{_size}; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
## POD ## |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=pod |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head1 NAME |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Net::ACL::Match::Prefix - Class matching IP network prefixes. |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=head1 SYNOPSIS |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
use Net::ACL::Match::Prefix; |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# Constructor |
92
|
|
|
|
|
|
|
$match = new Net::ACL::Match::Prefix('10.0.0.0/8'); |
93
|
|
|
|
|
|
|
$match = new Net::ACL::Match::Prefix('10.0.0.0/8 ge 25'); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# Accessor Methods |
96
|
|
|
|
|
|
|
$rc = $match->match('10.0.0.0/16'); # ACL_NOMATCH |
97
|
|
|
|
|
|
|
$rc = $match->match('127.0.0.0/8'); # ACL_NOMATCH |
98
|
|
|
|
|
|
|
$rc = $match->match('10.0.0.0/8'); # ACL_MATCH |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
=head1 DESCRIPTION |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
This module is just a wrapper of the Net::Netmask module to allow it to |
103
|
|
|
|
|
|
|
operate automatically with L. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=head1 CONSTRUCTOR |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=over 4 |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=item new() - create a new Net::ACL::Match::Prefix object |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
$match = new Net::ACL::Match::Prefix(0,'10.0.0.0/8'); |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
This is the constructor for Net::ACL::Match::Prefix objects. It returns a |
114
|
|
|
|
|
|
|
reference to the newly created object. The first argument is the argument |
115
|
|
|
|
|
|
|
number of the match function that should be matched. |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
Normally the remaining arguments is parsed directly to the constructor of |
118
|
|
|
|
|
|
|
Net::Netmask. However if the last argument matches /(le|ge) \d+$/, the suffix |
119
|
|
|
|
|
|
|
will be removed before the Net::Netmask constructor is called and the digits |
120
|
|
|
|
|
|
|
will be used only allow prefixes greater then or equal (ge) OR less then or |
121
|
|
|
|
|
|
|
equal (le) then that prefix length to match. |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=back |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
=head1 ACCESSOR METHODS |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=over 4 |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=item match() |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
The method uses Net::Netmask to verify that the base address and the size of |
132
|
|
|
|
|
|
|
the prefixes are the same. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=item mode() |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
This method returns the mode of the prefix match object. The mode could be |
137
|
|
|
|
|
|
|
either 0 (normal), C for less then or equal compare, or C for |
138
|
|
|
|
|
|
|
greater then or equal compare. If called with a value, the mode is |
139
|
|
|
|
|
|
|
changed to that value. |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item size() |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
This method returns the size of the prefix to be matched if mode is C or |
144
|
|
|
|
|
|
|
C. If called with a value, the size is changed to that value. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=back |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head1 EXAMPLES |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
my $norm = new Net::ACL::Match::Prefix(0,'10.0.0.0/8'); |
151
|
|
|
|
|
|
|
my $ge24 = new Net::ACL::Match::Prefix(0,'10.0.0.0/8 ge 24'); |
152
|
|
|
|
|
|
|
my $le24 = new Net::ACL::Match::Prefix(0,'10.0.0.0/8 1e 24'); |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
$norm->match('10.0.0.0/8') == ACL_MATCH |
155
|
|
|
|
|
|
|
$ge24->match('10.0.0.0/8') == ACL_MATCH |
156
|
|
|
|
|
|
|
$le24->match('10.0.0.0/8') == ACL_MATCH |
157
|
|
|
|
|
|
|
$norm->match('10.1.0.0/16') == ACL_NOMATCH |
158
|
|
|
|
|
|
|
$ge24->match('10.1.0.0/16') == ACL_MATCH |
159
|
|
|
|
|
|
|
$le24->match('10.1.0.0/16') == ACL_MATCH |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
=head1 SEE ALSO |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
Net::Netmask, Net::ACL, |
164
|
|
|
|
|
|
|
Net::ACL::Rule, Net::ACL::Match::IP, Net::ACL::Match |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=head1 AUTHOR |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
Martin Lorensen |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=cut |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
## End Package Net::ACL::Match::Prefix ## |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
1; |