Checks if a specified connection matches a set of rules.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

76 lines
1.9KB

  1. #!perl -T
  2. use 5.006;
  3. use strict;
  4. use warnings;
  5. use Test::More;
  6. use Net::Connection;
  7. BEGIN {
  8. use_ok( 'Net::Connection::Match::Protos' ) || print "Bail out!\n";
  9. }
  10. my $connection_args={
  11. foreign_host=>'10.0.0.1',
  12. foreign_port=>'22',
  13. local_host=>'10.0.0.2',
  14. local_port=>'12322',
  15. proto=>'tcp4',
  16. state=>'LISTEN',
  17. };
  18. my %args=(
  19. protos=>[
  20. 'tcp4',
  21. ],
  22. );
  23. my $checker;
  24. # makes sure we error with empty args
  25. my $worked=0;
  26. eval{
  27. $checker=Net::Connection::Match::Protos->new();
  28. $worked=1;
  29. };
  30. ok( $worked eq '0', 'empty init check') or diag('Calling new with empty args worked');
  31. # makes sure we can init with good args
  32. $worked=0;
  33. eval{
  34. $checker=Net::Connection::Match::Protos->new( \%args );
  35. $worked=1;
  36. };
  37. ok( $worked eq '1', 'init check') or diag('Calling Net::Connection::Match::Protos->new resulted in... '.$@);
  38. # make sure it will not accept null input
  39. my $returned=1;
  40. eval{
  41. $returned=$checker->match;
  42. };
  43. ok( $returned eq '0', 'proto undef check') or diag('match accepted undefined input');
  44. # make sure it will not accept a improper ref type
  45. $returned=1;
  46. eval{
  47. $returned=$checker->match($checker);
  48. };
  49. ok( $returned eq '0', 'match improper ref check') or diag('match accepted a ref other than Net::Connection');
  50. # Create a connection with a matching protocol and see if it matches
  51. my $conn=Net::Connection->new( $connection_args );
  52. $returned=0;
  53. eval{
  54. $returned=$checker->match( $conn );
  55. };
  56. ok( $returned eq '1', 'proto match check') or diag('Failed to match a matching good protocol');
  57. # Create a connection with a non-matching protocol and make sure it does not match
  58. $connection_args->{proto}='udp4';
  59. $conn=Net::Connection->new( $connection_args );
  60. $returned=1;
  61. eval{
  62. $returned=$checker->match( $conn );
  63. };
  64. ok( $returned eq '0', 'proto non-match check') or diag('Matched a protocol that it should not of');
  65. done_testing(7);