Checks if a specified connection matches a set of rules.
Вы не можете выбрать более 25 тем Темы должны начинаться с буквы или цифры, могут содержать дефисы(-) и должны содержать не более 35 символов.

233 lines
5.6KB

  1. package Net::Connection::Match::Protos;
  2. use 5.006;
  3. use strict;
  4. use warnings;
  5. =head1 NAME
  6. Net::Connection::Match::Protos - Runs a basic state check against a Net::Connection object.
  7. =head1 VERSION
  8. Version 0.0.0
  9. =cut
  10. our $VERSION = '0.0.0';
  11. =head1 SYNOPSIS
  12. use Net::Connection::Match::Protos;
  13. use Net::Connection;
  14. my $connection_args={
  15. foreign_host=>'10.0.0.1',
  16. foreign_port=>'22',
  17. local_host=>'10.0.0.2',
  18. local_port=>'12322',
  19. proto=>'tcp4',
  20. state=>'ESTABLISHED',
  21. };
  22. my $conn=Net::Connection->new( $connection_args );
  23. my %args=(
  24. protos=>[
  25. 'tcp4',
  26. 'tcp6',
  27. ],
  28. );
  29. my $checker=Net::Connection::Match::Protos->new( \%args );
  30. if ( $checker->match( $conn ) ){
  31. print "It matches.\n";
  32. }
  33. =head1 METHODS
  34. =head2 new
  35. This intiates the object.
  36. It takes a hash reference with one key. One key is required and
  37. that is 'protos', which is a array of protocols to match against.
  38. Atleast one state must be present.
  39. If the new method fails, it dies.
  40. my %args=(
  41. protos=>[
  42. 'tcp4',
  43. ],
  44. );
  45. my $checker=Net::Connection::Match::Protos->new( \%args );
  46. =cut
  47. sub new{
  48. my %args;
  49. if(defined($_[1])){
  50. %args= %{$_[1]};
  51. };
  52. # run some basic checks to make sure we have the minimum stuff required to work
  53. if ( ! defined( $args{protos} ) ){
  54. die ('No states key specified in the argument hash');
  55. }
  56. if ( ref( \$args{protos} ) eq 'ARRAY' ){
  57. die ('The states key is not a array');
  58. }
  59. if ( ! defined $args{protos}[0] ){
  60. die ('No states defined in the protos array');
  61. }
  62. my $self = {
  63. protos=>[],
  64. };
  65. bless $self;
  66. # make sure each cidr is valid before returning it
  67. my $protos_int=0;
  68. while( defined( $args{protos}[$protos_int] ) ){
  69. $self->{protos}[$protos_int]=lc( $args{protos}[$protos_int] );
  70. $protos_int++;
  71. }
  72. return $self;
  73. }
  74. =head2 match
  75. Checks if a single Net::Connection object matches the stack.
  76. One argument is taken and that is a Net::Connection object.
  77. The returned value is a boolean.
  78. if ( $checker->match( $conn ) ){
  79. print "The connection matches.\n";
  80. }
  81. =cut
  82. sub match{
  83. my $self=$_[0];
  84. my $object=$_[1];
  85. if ( !defined( $object ) ){
  86. return 0;
  87. }
  88. if ( ref( $object ) ne 'Net::Connection' ){
  89. return 0;
  90. }
  91. my $protos_int=0;
  92. while( defined( $self->{protos}[$protos_int] ) ){
  93. if ( $self->{protos}[$protos_int] eq lc( $object->proto ) ){
  94. return 1;
  95. }
  96. $protos_int++;
  97. }
  98. return 0;
  99. }
  100. =head1 AUTHOR
  101. Zane C. Bowers-Hadley, C<< <vvelox at vvelox.net> >>
  102. =head1 BUGS
  103. Please report any bugs or feature requests to C<bug-net-connection-match at rt.cpan.org>, or through
  104. the web interface at L<https://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-Connection-Match>. I will be notified, and then you'll
  105. automatically be notified of progress on your bug as I make changes.
  106. =head1 SUPPORT
  107. You can find documentation for this module with the perldoc command.
  108. perldoc Net::Connection::Match
  109. You can also look for information at:
  110. =over 4
  111. =item * RT: CPAN's request tracker (report bugs here)
  112. L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Connection-Match>
  113. =item * AnnoCPAN: Annotated CPAN documentation
  114. L<http://annocpan.org/dist/Net-Connection-Match>
  115. =item * CPAN Ratings
  116. L<https://cpanratings.perl.org/d/Net-Connection-Match>
  117. =item * Search CPAN
  118. L<https://metacpan.org/release/Net-Connection-Match>
  119. =back
  120. =head1 ACKNOWLEDGEMENTS
  121. =head1 LICENSE AND COPYRIGHT
  122. Copyright 2019 Zane C. Bowers-Hadley.
  123. This program is free software; you can redistribute it and/or modify it
  124. under the terms of the the Artistic License (2.0). You may obtain a
  125. copy of the full license at:
  126. L<http://www.perlfoundation.org/artistic_license_2_0>
  127. Any use, modification, and distribution of the Standard or Modified
  128. Versions is governed by this Artistic License. By using, modifying or
  129. distributing the Package, you accept this license. Do not use, modify,
  130. or distribute the Package, if you do not accept this license.
  131. If your Modified Version has been derived from a Modified Version made
  132. by someone other than you, you are nevertheless required to ensure that
  133. your Modified Version complies with the requirements of this license.
  134. This license does not grant you the right to use any trademark, service
  135. mark, tradename, or logo of the Copyright Holder.
  136. This license includes the non-exclusive, worldwide, free-of-charge
  137. patent license to make, have made, use, offer to sell, sell, import and
  138. otherwise transfer the Package with respect to any patent claims
  139. licensable by the Copyright Holder that are necessarily infringed by the
  140. Package. If you institute patent litigation (including a cross-claim or
  141. counterclaim) against any party alleging that the Package constitutes
  142. direct or contributory patent infringement, then this Artistic License
  143. to you shall terminate on the date that such litigation is filed.
  144. Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
  145. AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
  146. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
  147. PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
  148. YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
  149. CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
  150. CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
  151. EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  152. =cut
  153. 1; # End of Net::Connection::Match