File Coverage

blib/lib/Net/ACL/File/IPAccessExt.pm
Criterion Covered Total %
statement 62 64 96.8
branch 19 28 67.8
condition 2 3 66.6
subroutine 13 13 100.0
pod 2 2 100.0
total 98 110 89.0


line stmt bran cond sub pod time code
1             #!/usr/bin/perl
2              
3             # $Id: IPAccessExt.pm,v 1.11 2003/06/06 18:45:02 unimlo Exp $
4              
5             package Net::ACL::File::IPAccessExtRule;
6              
7 1     1   1344 use strict;
  1         2  
  1         38  
8 1     1   7 use vars qw( $VERSION @ISA );
  1         2  
  1         79  
9              
10             ## Inheritance ##
11              
12             @ISA = qw( Net::ACL::IPAccessExtRule );
13             $VERSION = '0.07';
14              
15             ## Module Imports ##
16              
17 1     1   694 use Net::ACL::IPAccessExtRule qw( :index );
  1         2  
  1         158  
18 1     1   6 use Carp;
  1         2  
  1         293  
19              
20             ## Public Object Methods ##
21              
22             sub asconfig
23             { # Don't check data - expect them to be constructed the right way!
24 4     4   6 my $this = shift;
25 4         9 my ($proto,$from,$to) = ('n/a','n/a','n/a');
26 4         4 foreach my $match (@{$this->{_match}})
  4         10  
27             {
28 12 100       95 if ($match->index == ACL_EIA_PROTO)
    100          
    50          
29             {
30 4         13 $proto = $match->value;
31             }
32             elsif ($match->index == ACL_EIA_FROM)
33             {
34 4         11 $from = $this->_getaddr($match->net);
35             }
36             elsif ($match->index == ACL_EIA_TO)
37             {
38 4         9 $to = $this->_getaddr($match->net);
39             };
40             };
41 4         95 return ' ' . $this->action_str . " $proto $from $to\n";
42             }
43              
44             ## Private object methods ##
45              
46             sub _getaddr
47             {
48 8     8   10 my ($this,$net) = @_;
49 8 100       24 return defined $net
    50          
    50          
50             ? ($net->bits == 32
51             ? 'host ' . $net->base
52             : ($net->bits == 0
53             ? 'any'
54             : $net->base . ' ' . $net->hostmask))
55             : '';
56             }
57              
58             ## End of Net::ACL::File::IPAccessExtRule ##
59              
60             package Net::ACL::File::IPAccessExt;
61              
62 1     1   7 use strict;
  1         1  
  1         40  
63 1     1   5 use vars qw( $VERSION @ISA );
  1         2  
  1         61  
64              
65             ## Inheritance ##
66              
67             @ISA = qw( Net::ACL::File::Standard );
68             $VERSION = '0.07';
69              
70             ## Module Imports ##
71              
72 1     1   6 use Net::ACL::File::Standard;
  1         2  
  1         100  
73 1     1   12 use Net::ACL::IPAccessExtRule qw( :index );
  1         4  
  1         123  
74 1     1   5 use Carp;
  1         2  
  1         628  
75              
76             ## Net::ACL::File Class Auto Registration Code ##
77              
78             Net::ACL::File->add_listtype('extended-access-list',__PACKAGE__,'ip access-list extended');
79              
80             ## Public Object Methods ##
81              
82             sub loadmatch
83             {
84 4     4 1 7 my ($this,$lines,$super) = @_;
85              
86 4 50       9 $lines = $lines->subs ? $lines->subs : $lines;
87              
88 4 50       160 foreach my $line ($lines =~ /\n./ ? $lines->all : $lines)
89             {
90 4         169 $line =~ s/ +/ /g;
91 4 50       320 croak "Configuration line format error in line: '$line'"
92             unless $line =~ /^ (permit|deny) ([^ ]+) (.*)$/i;
93 4         14 my ($action,$proto,$data) = ($1,$2,$3);
94 4         5 $data =~ s/^ //;
95 4         14 my @data = split(/ /,$data);
96 4         6 my $from = shift(@data);
97 4 50       15 if ($from eq 'host')
98             {
99 0         0 $from = shift(@data);
100             }
101             else
102             {
103 4 50       10 $from .= ' ' . shift(@data) unless ($from eq 'any');
104             };
105 4         13 my $to = shift(@data);
106 4 50       8 if ($to eq 'host')
107             {
108 0         0 $to = shift(@data);
109             }
110             else
111             {
112 4 100       13 $to .= ' ' . shift(@data) unless ($to eq 'any');
113             };
114 4         9 $to =~ s/ /#/;
115 4         6 $from =~ s/ /#/;
116 4         24 my $rule = new Net::ACL::File::IPAccessExtRule(
117             Action => $action
118             );
119 4         14 $rule->add_match($rule->autoconstruction('Match','Net::ACL::Match::Scalar','Scalar',ACL_EIA_PROTO,$proto));
120 4         11 $rule->add_match($rule->autoconstruction('Match','Net::ACL::Match::IP','IP',ACL_EIA_FROM,$from));
121 4         13 $rule->add_match($rule->autoconstruction('Match','Net::ACL::Match::IP','IP',ACL_EIA_TO,$to));
122 4         16 $this->add_rule($rule);
123 4 100 66     15 $this->name($1)
124             if ! defined($this->name)
125             && $super =~ /ip access-list extended (.*)$/;
126             }
127             }
128              
129             sub asconfig
130             {
131 2     2 1 690 my $this = shift;
132 2         6 return "ip access-list extended " . $this->name . "\n" . $this->SUPER::asconfig(@_) . "!\n";
133             }
134              
135             ## POD ##
136              
137             =pod
138              
139             =head1 NAME
140              
141             Net::ACL::File::IPAccessExt - Extended IP access-lists loaded from configuration string.
142              
143             =head1 DESCRIPTION
144              
145             This module extends the Net::ACL::File::Standard class to handle
146             community-lists. See L for
147             details.
148              
149             =head1 SEE ALSO
150              
151             Net::ACL, Net::ACL::File, Net::ACL::Standard, Net::ACL::IPAccessExtRule
152              
153             =head1 AUTHOR
154              
155             Martin Lorensen
156              
157             =cut
158              
159             ## End of Net::ACL::File::IPAccessExt ##
160              
161             1;