Browse Source

PTR stuff mostly done

tags/0.0.0
Zane C. B-H 1 month ago
parent
commit
bdc79e8cf4

+ 3
- 1
Net-Connection-Match/MANIFEST View File

@@ -2,7 +2,8 @@ Changes
2 2
 lib/Net/Connection/Match.pm
3 3
 lib/Net/Connection/Match/CIDR.pm
4 4
 lib/Net/Connection/Match/Ports.pm
5
-lib/Net/Connection/Match/Protos.pm
5
+lib/Net/Connection/Match/Protos.p
6
+lib/Net/Connection/Match/PTR.pmm
6 7
 lib/Net/Connection/Match/States.pm
7 8
 Makefile.PL
8 9
 MANIFEST			This list of files
@@ -12,6 +13,7 @@ t/01-load.t
12 13
 t/02-load.t
13 14
 t/03-load.t
14 15
 t/04-load.t
16
+t/05-load.t
15 17
 t/CIDR.t
16 18
 t/States.t
17 19
 t/manifest.t

+ 1
- 0
Net-Connection-Match/Makefile.PL View File

@@ -20,6 +20,7 @@ WriteMakefile(
20 20
 			  PREREQ_PM => {
21 21
 							'Net::CIDR'=>'0.20',
22 22
 							'Net::Connection'=>'0.0.0',
23
+							'Net::DNS'=>'1.20',
23 24
 							},
24 25
 			  dist  => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
25 26
 			  clean => { FILES => 'Net-Connection-Match-*' },

+ 341
- 0
Net-Connection-Match/lib/Net/Connection/Match/PTR.pm View File

@@ -0,0 +1,341 @@
1
+package Net::Connection::Match::PTR;
2
+
3
+use 5.006;
4
+use strict;
5
+use warnings;
6
+use Net::DNS;
7
+
8
+=head1 NAME
9
+
10
+Net::Connection::Match::PTR - Runs a PTR 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::PTR;
24
+    use Net::Connection;
25
+    
26
+    # The *_ptr feilds do not need populated.
27
+    # If left undef, they will be resulved using Net::DNS::Resolver
28
+    my $connection_args={
29
+                         foreign_host=>'10.0.0.1',
30
+                         foreign_port=>'22',
31
+                         foreign_ptr=>'foo.foo',
32
+                         local_host=>'10.0.0.2',
33
+                         local_port=>'12322',
34
+                         local_ptr=>'foo.bar',
35
+                         proto=>'tcp4',
36
+                         state=>'ESTABLISHED',
37
+                        };
38
+    
39
+    my $conn=Net::Connection->new( $connection_args );
40
+    
41
+    # All three don't need specified, but
42
+    # Atleast one of them must be and must not be a empty array.
43
+    my %args=(
44
+              ptrs=>[
45
+                     'foo.bar',
46
+                      ],
47
+              lptrs=>[
48
+                      'a.foo.bar',
49
+                       ],
50
+              fptrs=>[
51
+                      'b.foo.bar',
52
+                       ],
53
+              );
54
+    
55
+    my $checker=Net::Connection::Match::Ports->new( \%args );
56
+    
57
+    if ( $checker->match( $conn ) ){
58
+        print "It matches.\n";
59
+    }
60
+
61
+=head1 METHODS
62
+
63
+=head2 new
64
+
65
+This intiates the object.
66
+
67
+    my %args=(
68
+              ptrs=>[
69
+                     'foo.bar',
70
+                      ],
71
+              lptrs=>[
72
+                      'a.foo.bar',
73
+                       ],
74
+              fptrs=>[
75
+                      'b.foo.bar',
76
+                       ],
77
+              );
78
+    
79
+    my $checker=Net::Connection::Match::Ports->new( \%args );
80
+
81
+
82
+=head3 args
83
+
84
+Atleast one of the following need used.
85
+
86
+=keys ptrs
87
+
88
+This is a array of PTRs to match in for either foreign
89
+or local side.
90
+
91
+=keys fptrs
92
+
93
+This is a array of PTRs to match in for the foreign side.
94
+
95
+=keys lptrs
96
+
97
+This is a array of PTRs to match in for the local side.
98
+
99
+=cut
100
+
101
+sub new{
102
+	my %args;
103
+	if(defined($_[1])){
104
+		%args= %{$_[1]};
105
+	};
106
+
107
+	# run some basic checks to make sure we have the minimum stuff required to work
108
+	if (
109
+		( ! defined( $args{ptrs} ) ) &&
110
+		( ! defined( $args{fptrs} ) ) &&
111
+		( ! defined( $args{lptrs} ) )
112
+		){
113
+		die ('No [fl]ptrs key specified in the argument hash');
114
+	}
115
+	if (
116
+		(
117
+		 defined( $args{ptrs} ) &&
118
+		 ( ! defined( $args{ptrs}[0] ) )
119
+		 ) &&
120
+		(
121
+		 defined( $args{lptrs} ) &&
122
+		 ( ! defined( $args{lptrs}[0] ) )
123
+		 ) &&
124
+		(
125
+		 defined( $args{fptrs} ) &&
126
+		 ( ! defined( $args{fptrs}[0] ) )
127
+		 )
128
+		){
129
+		die ('No ports defined in the in any of the [fl]ptrs array');
130
+	}
131
+
132
+    my $self = {
133
+				ptrs=>{},
134
+				fptrs=>{},
135
+				lptrs=>{},
136
+				resolver=>Net::DNS::Resolver->new,
137
+				};
138
+    bless $self;
139
+
140
+	##
141
+	## These are all stored as lower case to make matching easier.
142
+	##
143
+
144
+	# Process the ports for matching either
145
+	my $ptrs_int=0;
146
+	if ( defined( $args{ptrs} ) ){
147
+		while (defined( $args{ptrs}[$ptrs_int] )) {
148
+			$self->{ptrs}{ $ptrs_int }=lc( $args{ptrs}[$ptrs_int] );
149
+
150
+			$ptrs_int++;
151
+		}
152
+	}
153
+
154
+	# Process the ports for matching local ports
155
+	$ptrs_int=0;
156
+	if ( defined( $args{lptrs} ) ){
157
+		while (defined( $args{lptrs}[$ptrs_int] )) {
158
+			$self->{lptrs}{ $ptrs_int }=lc( $args{lptrs}[$ptrs_int] );
159
+
160
+			$ptrs_int++;
161
+		}
162
+	}
163
+
164
+	# Process the ports for matching foreign ports
165
+	$ptrs_int=0;
166
+	if ( defined( $args{fptrs} ) ){
167
+		while (defined( $args{fptrs}[$ptrs_int] )) {
168
+			$self->{fptrs}{ $ptrs_int }=lc( $args{fptrs}[$ptrs_int] );
169
+
170
+			$ptrs_int++;
171
+		}
172
+	}
173
+
174
+	return $self;
175
+}
176
+
177
+=head2 match
178
+
179
+Checks if a single Net::Connection object matches the stack.
180
+
181
+One argument is taken and that is a Net::Connection object.
182
+
183
+The returned value is a boolean.
184
+
185
+If the *_ptr feilds for the object are undef, L<Net::DNS::Resolver>
186
+will be used for resolving the address.
187
+
188
+    if ( $checker->match( $conn ) ){
189
+        print "The connection matches.\n";
190
+    }
191
+
192
+=cut
193
+
194
+sub match{
195
+	my $self=$_[0];
196
+	my $object=$_[1];
197
+
198
+	if ( !defined( $object ) ){
199
+		return 0;
200
+	}
201
+
202
+	if ( ref( $object ) ne 'Net::Connection' ){
203
+		return 0;
204
+	}
205
+
206
+	my $l_ptr=$object->local_ptr;
207
+	my $f_ptr=$object->foreign_ptr;
208
+
209
+	if ( defined( $l_ptr ) ){
210
+		# If we have one, convert it to lower case for easier processing.
211
+		$l_ptr=lc( $l_ptr )
212
+	}else{
213
+		# We don't have it. Uppercase default will prevent it from being matched.
214
+		$l_ptr='NOTFOUND';
215
+		# See if we can look it up.
216
+		my $answer=$self->{resolver}->search( $object->local_host );
217
+		if ( defined( $answer->{answer}[0] ) &&
218
+			 ( ref( $answer->{answer}[0] ) eq 'Net::DNS::RR::PTR' )
219
+			){
220
+			$l_ptr=lc($answer->{answer}[0]->ptrdname);
221
+		}
222
+	}
223
+
224
+	if ( defined( $f_ptr ) ){
225
+		# If we have one, convert it to lower case for easier processing.
226
+		$f_ptr=lc( $f_ptr )
227
+	}else{
228
+		# We don't have it. Uppercase default will prevent it from being matched.
229
+		$f_ptr='NOTFOUND';
230
+		# See if we can look it up.
231
+		my $answer=$self->{resolver}->search( $object->foreign_host );
232
+		if ( defined( $answer->{answer}[0] ) &&
233
+			 ( ref( $answer->{answer}[0] ) eq 'Net::DNS::RR::PTR' )
234
+			){
235
+			$f_ptr=lc($answer->{answer}[0]->ptrdname);
236
+		}
237
+	}
238
+
239
+	# If we matched exactly, we found it.
240
+	if (
241
+		defined( $self->{ptrs}{ $l_ptr } ) ||
242
+		defined( $self->{ptrs}{ $f_ptr } ) ||
243
+		defined( $self->{lptrs}{ $l_ptr } ) ||
244
+		defined( $self->{fptrs}{ $f_ptr } )
245
+		){
246
+		return 1;
247
+	}
248
+
249
+	return 0;
250
+}
251
+
252
+=head1 AUTHOR
253
+
254
+Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
255
+
256
+=head1 BUGS
257
+
258
+Please report any bugs or feature requests to C<bug-net-connection-match at rt.cpan.org>, or through
259
+the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Connection-Match>.  I will be notified, and then you'll
260
+automatically be notified of progress on your bug as I make changes.
261
+
262
+
263
+
264
+
265
+=head1 SUPPORT
266
+
267
+You can find documentation for this module with the perldoc command.
268
+
269
+    perldoc Net::Connection::Match
270
+
271
+
272
+You can also look for information at:
273
+
274
+=over 4
275
+
276
+=item * RT: CPAN's request tracker (report bugs here)
277
+
278
+L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Connection-Match>
279
+
280
+=item * AnnoCPAN: Annotated CPAN documentation
281
+
282
+L<http://annocpan.org/dist/Net-Connection-Match>
283
+
284
+=item * CPAN Ratings
285
+
286
+L<https://cpanratings.perl.org/d/Net-Connection-Match>
287
+
288
+=item * Search CPAN
289
+
290
+L<https://metacpan.org/release/Net-Connection-Match>
291
+
292
+=back
293
+
294
+
295
+=head1 ACKNOWLEDGEMENTS
296
+
297
+
298
+=head1 LICENSE AND COPYRIGHT
299
+
300
+Copyright 2019 Zane C. Bowers-Hadley.
301
+
302
+This program is free software; you can redistribute it and/or modify it
303
+under the terms of the the Artistic License (2.0). You may obtain a
304
+copy of the full license at:
305
+
306
+L<http://www.perlfoundation.org/artistic_license_2_0>
307
+
308
+Any use, modification, and distribution of the Standard or Modified
309
+Versions is governed by this Artistic License. By using, modifying or
310
+distributing the Package, you accept this license. Do not use, modify,
311
+or distribute the Package, if you do not accept this license.
312
+
313
+If your Modified Version has been derived from a Modified Version made
314
+by someone other than you, you are nevertheless required to ensure that
315
+your Modified Version complies with the requirements of this license.
316
+
317
+This license does not grant you the right to use any trademark, service
318
+mark, tradename, or logo of the Copyright Holder.
319
+
320
+This license includes the non-exclusive, worldwide, free-of-charge
321
+patent license to make, have made, use, offer to sell, sell, import and
322
+otherwise transfer the Package with respect to any patent claims
323
+licensable by the Copyright Holder that are necessarily infringed by the
324
+Package. If you institute patent litigation (including a cross-claim or
325
+counterclaim) against any party alleging that the Package constitutes
326
+direct or contributory patent infringement, then this Artistic License
327
+to you shall terminate on the date that such litigation is filed.
328
+
329
+Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
330
+AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
331
+THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
332
+PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
333
+YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
334
+CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
335
+CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
336
+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
337
+
338
+
339
+=cut
340
+
341
+1; # End of Net::Connection::Match

+ 13
- 0
Net-Connection-Match/t/05-load.t View File

@@ -0,0 +1,13 @@
1
+#!perl -T
2
+use 5.006;
3
+use strict;
4
+use warnings;
5
+use Test::More;
6
+
7
+plan tests => 1;
8
+
9
+BEGIN {
10
+    use_ok( 'Net::Connection::Match::PTR' ) || print "Bail out!\n";
11
+}
12
+
13
+diag( "Testing Net::Connection::Match::PTR $Net::Connection::Match::PTR::VERSION, Perl $], $^X" );

Loading…
Cancel
Save