File Coverage

blib/lib/Net/Connection/Match/CIDR.pm
Criterion Covered Total %
statement 46 48 95.8
branch 16 18 88.8
condition 5 9 55.5
subroutine 6 6 100.0
pod 2 2 100.0
total 75 83 90.3


line stmt bran cond sub pod time code
1             package Net::Connection::Match::CIDR;
2              
3 2     2   225864 use 5.006;
  2         54  
4 2     2   11 use strict;
  2         4  
  2         60  
5 2     2   13 use warnings;
  2         4  
  2         56  
6 2     2   1107 use Net::CIDR;
  2         11666  
  2         801  
7              
8             =head1 NAME
9              
10             Net::Connection::Match::CIDR - Runs a basic CIDR check against a Net::Connection object.
11              
12             =head1 VERSION
13              
14             Version 0.0.0
15              
16             =cut
17              
18             our $VERSION = '0.0.0';
19              
20              
21             =head1 SYNOPSIS
22              
23             use Net::Connection::Match::CIDR;
24             use Net::Connection;
25            
26             my $connection_args={
27             foreign_host=>'10.0.0.1',
28             foreign_port=>'22',
29             local_host=>'10.0.0.2',
30             local_port=>'12322',
31             proto=>'tcp4',
32             state=>'ESTABLISHED',
33             };
34            
35             my $conn=Net::Connection->new( $connection_args );
36            
37             my %args=(
38             cidrs=>[
39             '127.0.0.0/24',
40             '192.168.0.0/16',
41             '10.0.0.0/8'
42             ],
43             );
44              
45             my $cidr_checker=Net::Connection::Match::CIDR->new( \%args );
46              
47             if ( $cidr_checker->match( $conn ) ){
48             print "It matches.\n";
49             }
50              
51             =head1 METHODS
52              
53             =head2 new
54              
55             This intiates the object.
56              
57             It takes a hash reference with one key. One key is required and
58             that is 'cidrs', which is a array of CIDRs to match against.
59              
60             Net::CIDR::cidrvalidate is used to validate the CIDRs.
61              
62             Atleast one CIDR must be present.
63              
64             If the new method fails, it dies.
65              
66             my %args=(
67             cidrs=>[
68             '127.0.0.0/24',
69             '192.168.0.0/16',
70             '10.0.0.0/8'
71             ],
72             );
73              
74             my $cidr_checker=Net::Connection::Match::CIDR->new( \%args );
75              
76             =cut
77              
78             sub new{
79 3     3 1 934 my %args;
80 3 100       11 if(defined($_[1])){
81 2         4 %args= %{$_[1]};
  2         9  
82             };
83              
84             # run some basic checks to make sure we have the minimum stuff required to work
85 3 100       10 if ( ! defined( $args{cidrs} ) ){
86 1         10 die ('No cidrs key specified in the argument hash');
87             }
88 2 50       7 if ( ref( \$args{cidrs} ) eq 'ARRAY' ){
89 0         0 die ('The cidrs key is not a array');
90             }
91 2 50       8 if ( ! defined $args{cidrs}[0] ){
92 0         0 die ('No CIDRs defined in the cidrs array');
93             }
94              
95 2         5 my $self = {
96             cidrs=>[],
97             };
98 2         4 bless $self;
99              
100             # make sure each cidr is valid before returning it
101 2         4 my $cidrs_int=0;
102 2         7 while( defined( $args{cidrs}[$cidrs_int] ) ){
103 4         5 my $cidr_good=0;
104 4         8 eval{
105 4 100       13 if ( Net::CIDR::cidrvalidate( $args{cidrs}[$cidrs_int] ) ){
106 3         1791 $cidr_good=1;
107             }
108             };
109              
110             # if good add it, otherwise die
111 4 100       690 if ( $cidr_good ){
112 3         10 $self->{cidrs}[$cidrs_int]=$args{cidrs}[$cidrs_int];
113             }else{
114 1         15 die('"'.$args{cidrs}[$cidrs_int].'" is not a CIDR according to Net::CIDR::cidrvalidate');
115             }
116              
117 3         8 $cidrs_int++;
118             }
119              
120 1         5 return $self;
121             }
122              
123             =head2 match
124              
125             Checks if a single Net::Connection object matches the stack.
126              
127             One argument is taken and that is a Net::Connection object.
128              
129             The returned value is a boolean.
130              
131             if ( $cidr_checker->match( $conn ) ){
132             print "The connection matches.\n";
133             }
134              
135             =cut
136              
137             sub match{
138 4     4 1 2120 my $self=$_[0];
139 4         8 my $object=$_[1];
140              
141 4 100       36 if ( !defined( $object ) ){
142 1         6 return 0;
143             }
144              
145 3 100       11 if ( ref( $object ) ne 'Net::Connection' ){
146 1         4 return 0;
147             }
148              
149 2         4 my $cidrs_int=0;
150 2         7 while( defined( $self->{cidrs}[$cidrs_int] ) ){
151 6 100 66     17 if (
      33        
      66        
152             (
153             ( $object->foreign_host ne '*' ) &&
154 6         32 ( eval{ Net::CIDR::cidrlookup( $object->foreign_host, $self->{cidrs}[$cidrs_int] ) })
155             ) ||
156             (
157             ( $object->local_host ne '*' ) &&
158 5         1377 ( eval{ Net::CIDR::cidrlookup( $object->local_host, $self->{cidrs}[$cidrs_int] ) })
159             )
160             ){
161 1         243 return 1;
162             }
163              
164 5         1221 $cidrs_int++;
165             }
166              
167 1         4 return 0;
168             }
169              
170             =head1 AUTHOR
171              
172             Zane C. Bowers-Hadley, C<< >>
173              
174             =head1 BUGS
175              
176             Please report any bugs or feature requests to C, or through
177             the web interface at L. I will be notified, and then you'll
178             automatically be notified of progress on your bug as I make changes.
179              
180              
181              
182              
183             =head1 SUPPORT
184              
185             You can find documentation for this module with the perldoc command.
186              
187             perldoc Net::Connection::Match
188              
189              
190             You can also look for information at:
191              
192             =over 4
193              
194             =item * RT: CPAN's request tracker (report bugs here)
195              
196             L
197              
198             =item * AnnoCPAN: Annotated CPAN documentation
199              
200             L
201              
202             =item * CPAN Ratings
203              
204             L
205              
206             =item * Search CPAN
207              
208             L
209              
210             =back
211              
212              
213             =head1 ACKNOWLEDGEMENTS
214              
215              
216             =head1 LICENSE AND COPYRIGHT
217              
218             Copyright 2019 Zane C. Bowers-Hadley.
219              
220             This program is free software; you can redistribute it and/or modify it
221             under the terms of the the Artistic License (2.0). You may obtain a
222             copy of the full license at:
223              
224             L
225              
226             Any use, modification, and distribution of the Standard or Modified
227             Versions is governed by this Artistic License. By using, modifying or
228             distributing the Package, you accept this license. Do not use, modify,
229             or distribute the Package, if you do not accept this license.
230              
231             If your Modified Version has been derived from a Modified Version made
232             by someone other than you, you are nevertheless required to ensure that
233             your Modified Version complies with the requirements of this license.
234              
235             This license does not grant you the right to use any trademark, service
236             mark, tradename, or logo of the Copyright Holder.
237              
238             This license includes the non-exclusive, worldwide, free-of-charge
239             patent license to make, have made, use, offer to sell, sell, import and
240             otherwise transfer the Package with respect to any patent claims
241             licensable by the Copyright Holder that are necessarily infringed by the
242             Package. If you institute patent litigation (including a cross-claim or
243             counterclaim) against any party alleging that the Package constitutes
244             direct or contributory patent infringement, then this Artistic License
245             to you shall terminate on the date that such litigation is filed.
246              
247             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
248             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
249             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
250             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
251             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
252             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
253             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
254             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
255              
256              
257             =cut
258              
259             1; # End of Net::Connection::Match