/[suikacvs]/messaging/manakai/t/util-hostpermit.t
Suika

Contents of /messaging/manakai/t/util-hostpermit.t

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations) (download) (as text)
Fri Oct 31 08:39:27 2003 UTC (21 years, 1 month ago) by wakaba
Branch: MAIN
CVS Tags: before-dis2-200411, manakai-release-0-3-2, manakai-release-0-3-1, manakai-release-0-4-0, manakai-200612, HEAD
Branch point for: experimental-xml-parser-200401
Changes since 1.2: +7 -7 lines
File MIME type: application/x-troff
Some fix

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24