| 1 | use strict; | 
| 2 | require Test::Simple; | 
| 3 | no warnings 'deprecated'; # v-string is deprecated | 
| 4 | require Message::Util::HostPermit; | 
| 5 | sub ok ($;$); | 
| 6 | sub new_checker () { | 
| 7 | new Message::Util::HostPermit; | 
| 8 | } | 
| 9 |  | 
| 10 | my @test = ( | 
| 11 | sub { | 
| 12 | my $checker = new_checker; | 
| 13 | ok $checker->match_host ('foo', 'foo'); | 
| 14 | ok $checker->match_host ('bar', 'bar'); | 
| 15 | ok !$checker->match_host ('foo', 'bar'); | 
| 16 | ok $checker->match_host ('*', 'foo'); | 
| 17 | ok $checker->match_host ('*.test', 'foo.test'); | 
| 18 | ok !$checker->match_host ('*.test', 'foo.example'); | 
| 19 | ok $checker->match_host ('*.test', 'www.foo.test'); | 
| 20 | ok $checker->match_host ('*.foo.test', 'www.foo.test'); | 
| 21 | ok !$checker->match_host ('foo.bar.foo.test', 'test'); | 
| 22 | ok !$checker->match_host ('foo.bar.foo.test', 'foo.test'); | 
| 23 | ok !$checker->match_host ('test', 'foo.bar.foo.test'); | 
| 24 | ok !$checker->match_host ('*.foo.test', 'foo.test'); | 
| 25 | ok $checker->match_host ('*.foo.test', 'foo.bar.foo.test'); | 
| 26 |  | 
| 27 | ok !$checker->match_host ('*', ''), 'invalid host'; | 
| 28 | ok $checker->match_host ('*', 'foo..bar'), 'invalid host'; | 
| 29 | ok $checker->match_host ('*.', 'foo'), 'invalid pattern'; | 
| 30 | ok !$checker->match_host ('', 'foo'), 'invalid pattern'; | 
| 31 |  | 
| 32 | ok !$checker->match_host ('bar.*.test', 'foo.test'), 'unsupported pattern'; | 
| 33 | ok $checker->match_host ('bar.*.test', 'foo.foo.test'), 'unsupported pattern'; | 
| 34 | ok !$checker->match_host ('bar.*.test', 'foo.example'), 'unsupported pattern'; | 
| 35 | },2..20, | 
| 36 | sub { | 
| 37 | my $checker = new_checker; | 
| 38 | ok $checker->match_ipv4 ('1.1.1.1', '1.1.1.1'); | 
| 39 | ok $checker->match_ipv4 ('1.1.1.1', 1.1.1.1); | 
| 40 | ok $checker->match_ipv4 (1.1.1.1, 1.1.1.1); | 
| 41 |  | 
| 42 | ok $checker->match_ipv4 ('1.1.1.1/29', '1.1.1.1'); | 
| 43 | ok !$checker->match_ipv4 ('1.1.1.1/29', '1.1.1.45'); | 
| 44 | ok $checker->match_ipv4 ('1.1.1.1/29', '1.1.1.0'); | 
| 45 | ok $checker->match_ipv4 ('1.1.1.1/29', '1.1.1.7'); | 
| 46 | ok !$checker->match_ipv4 ('1.1.1.1/29', '1.1.1.8'); | 
| 47 | ok !$checker->match_ipv4 ('1.1.1.1/29', '1.1.32.0'); | 
| 48 | ok !$checker->match_ipv4 ('1.1.1.1/29', '1.43.32.0'); | 
| 49 | ok !$checker->match_ipv4 ('1.1.1.1/29', '41.153.32.0'); | 
| 50 | ok $checker->match_ipv4 ('1.1.1.1/24', '1.1.1.1'); | 
| 51 | ok $checker->match_ipv4 ('1.1.1.1/24', '1.1.1.45'); | 
| 52 | ok $checker->match_ipv4 ('1.1.1.1/24', '1.1.1.0'); | 
| 53 | ok !$checker->match_ipv4 ('1.1.1.1/24', '1.1.32.0'); | 
| 54 | ok !$checker->match_ipv4 ('1.1.1.1/24', '1.43.32.0'); | 
| 55 | ok !$checker->match_ipv4 ('1.1.1.1/24', '41.153.32.0'); | 
| 56 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.1.1'); | 
| 57 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.1.45'); | 
| 58 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.1.0'); | 
| 59 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.13.0'); | 
| 60 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.21.0'); | 
| 61 | ok $checker->match_ipv4 ('1.1.1.1/19', '1.1.31.0'); | 
| 62 | ok !$checker->match_ipv4 ('1.1.1.1/19', '1.1.32.0'); | 
| 63 | ok !$checker->match_ipv4 ('1.1.1.1/19', '1.43.32.0'); | 
| 64 | ok !$checker->match_ipv4 ('1.1.1.1/19', '41.153.32.0'); | 
| 65 | ok $checker->match_ipv4 ('1.1.1.1/16', '1.1.1.1'); | 
| 66 | ok $checker->match_ipv4 ('1.1.1.1/16', '1.1.1.45'); | 
| 67 | ok $checker->match_ipv4 ('1.1.1.1/16', '1.1.32.0'); | 
| 68 | ok !$checker->match_ipv4 ('1.1.1.1/16', '1.43.32.0'); | 
| 69 | ok !$checker->match_ipv4 ('1.1.1.1/16', '41.153.32.0'); | 
| 70 | ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.1.1'); | 
| 71 | ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.1.45'); | 
| 72 | ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.32.0'); | 
| 73 | ok $checker->match_ipv4 ('1.1.1.1/8', '1.153.32.0'); | 
| 74 | ok !$checker->match_ipv4 ('1.1.1.1/8', '41.153.32.0'); | 
| 75 | ok $checker->match_ipv4 ('1.1.1.1/0', '1.1.1.1'); | 
| 76 | ok $checker->match_ipv4 ('1.1.1.1/0', '1.1.1.0'); | 
| 77 | ok $checker->match_ipv4 ('1.1.1.1/0', '123.43.56.23'); | 
| 78 |  | 
| 79 | ok do {$checker->match_ipv4 (1.1.1.1, 1.1.1455.1); 1}, 'invalid addr'; | 
| 80 | ok do {$checker->match_ipv4 (1.1.1.1, '1.1.1455.1'); 1}, 'invalid addr'; | 
| 81 | ok do {$checker->match_ipv4 (1.1.1455.1, v1.1.1.1); 1}, 'invalid pattern'; | 
| 82 | ok do {$checker->match_ipv4 ('1.1.1455.1', v1.1.1.1); 1}, 'invalid pattern'; | 
| 83 | ok do {$checker->match_ipv4 ('123', '44.44.3.2'); 1}, 'invalid pattern'; | 
| 84 | ok do {$checker->match_ipv4 ('*.12.3.1', '5.4.3.2'); 1}, 'invalid pattern'; | 
| 85 | ok do {$checker->match_ipv4 ('12.3/32', '5.4.3.2'); 1}, 'invalid pattern'; | 
| 86 | ok do {$checker->match_ipv4 (v1.1.1.1, '12.3.3'); 1}, 'invalid addr'; | 
| 87 | ok do {$checker->match_ipv4 ('1.1.1.1/39', '1.1.1.0'); 1}, 'invalid pattern'; | 
| 88 |  | 
| 89 | },2..49, | 
| 90 | sub { | 
| 91 | my $checker = new_checker; | 
| 92 | ok !$checker->match_ipv6 ('something', 'something'), 'IPv6 : not implemented yet'; | 
| 93 | }, | 
| 94 | sub { | 
| 95 | my $checker = new_checker; | 
| 96 | $checker->add_rule ("Allow host=example.com | 
| 97 | Deny host=example.org | 
| 98 | Allow host=example.net | 
| 99 | Allow ipv4=12.34.5.6 | 
| 100 | Allow host=www.example.com port=80 | 
| 101 | Deny host=* | 
| 102 | Deny ipv4=0.0.0.0/0 | 
| 103 | Deny ipv6=0::0/0"); | 
| 104 | ok $checker->check ('example.com'); | 
| 105 | ok !$checker->check ('example.org'); | 
| 106 | ok $checker->check ('example.net'); | 
| 107 | ok !$checker->check ('example.edu'); | 
| 108 | ok !$checker->check ('not.exist.invalid'); | 
| 109 | ok !$checker->check ('localhost'); | 
| 110 | ok !$checker->check (undef); | 
| 111 | ok !$checker->check ('in]va"li)d'); | 
| 112 | ok $checker->check ('12.34.5.6'); | 
| 113 | ok !$checker->check ('127.43.3.4'); | 
| 114 | ok !$checker->check ('0::2'); | 
| 115 |  | 
| 116 | ok $checker->check ('example.com', 80); | 
| 117 | ok $checker->check ('example.net', 80); | 
| 118 | ok !$checker->check ('example.org', 80); | 
| 119 | ok $checker->check ('www.example.com', 80); | 
| 120 | ok !$checker->check ('www.example.com', 8080); | 
| 121 | },2..15, | 
| 122 | ); | 
| 123 |  | 
| 124 | Test::Simple->import (tests => scalar @test); | 
| 125 |  | 
| 126 | for (@test) { | 
| 127 | &{$_} if ref $_; | 
| 128 | } | 
| 129 |  | 
| 130 |  | 
| 131 | =head1 LICENSE | 
| 132 |  | 
| 133 | Copyright 2003 Wakaba <w@suika.fam.cx> | 
| 134 |  | 
| 135 | This program is free software; you can redistribute it and/or | 
| 136 | modify it under the same terms as Perl itself. | 
| 137 |  | 
| 138 | =cut | 
| 139 |  | 
| 140 | 1; # $Date: 2003/09/27 07:59:11 $ | 
| 141 |  | 
| 142 |  |