/[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.1 - (hide annotations) (download) (as text)
Wed Sep 17 02:34:18 2003 UTC (21 years, 2 months ago) by wakaba
Branch: MAIN
File MIME type: application/x-troff
New

1 wakaba 1.1 use strict;
2     require Test::Simple;
3    
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', v1.1.1.1);
40     ok $checker->match_ipv4 (v1.1.1.1, v1.1.1.1);
41    
42     ok $checker->match_ipv4 ('1.1.1.1/3', '1.1.1.1');
43     ok !$checker->match_ipv4 ('1.1.1.1/3', '1.1.1.45');
44     ok $checker->match_ipv4 ('1.1.1.1/3', '1.1.1.0');
45     ok $checker->match_ipv4 ('1.1.1.1/3', '1.1.1.7');
46     ok !$checker->match_ipv4 ('1.1.1.1/3', '1.1.1.8');
47     ok !$checker->match_ipv4 ('1.1.1.1/3', '1.1.32.0');
48     ok !$checker->match_ipv4 ('1.1.1.1/3', '1.43.32.0');
49     ok !$checker->match_ipv4 ('1.1.1.1/3', '41.153.32.0');
50     ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.1.1');
51     ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.1.45');
52     ok $checker->match_ipv4 ('1.1.1.1/8', '1.1.1.0');
53     ok !$checker->match_ipv4 ('1.1.1.1/8', '1.1.32.0');
54     ok !$checker->match_ipv4 ('1.1.1.1/8', '1.43.32.0');
55     ok !$checker->match_ipv4 ('1.1.1.1/8', '41.153.32.0');
56     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.1.1');
57     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.1.45');
58     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.1.0');
59     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.13.0');
60     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.21.0');
61     ok $checker->match_ipv4 ('1.1.1.1/13', '1.1.31.0');
62     ok !$checker->match_ipv4 ('1.1.1.1/13', '1.1.32.0');
63     ok !$checker->match_ipv4 ('1.1.1.1/13', '1.43.32.0');
64     ok !$checker->match_ipv4 ('1.1.1.1/13', '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/24', '1.1.1.1');
71     ok $checker->match_ipv4 ('1.1.1.1/24', '1.1.1.45');
72     ok $checker->match_ipv4 ('1.1.1.1/24', '1.1.32.0');
73     ok $checker->match_ipv4 ('1.1.1.1/24', '1.153.32.0');
74     ok !$checker->match_ipv4 ('1.1.1.1/24', '41.153.32.0');
75     ok $checker->match_ipv4 ('1.1.1.1/32', '1.1.1.1');
76     ok $checker->match_ipv4 ('1.1.1.1/32', '1.1.1.0');
77     ok $checker->match_ipv4 ('1.1.1.1/32', '123.43.56.23');
78    
79     ok !$checker->match_ipv4 (v1.1.1.1, v1.1.1455.1), 'invalid addr';
80     ok !$checker->match_ipv4 (v1.1.1.1, '1.1.1455.1'), 'invalid addr';
81     ok $checker->match_ipv4 (v1.1.1455.1, v1.1.1.1), 'invalid pattern';
82     ok $checker->match_ipv4 ('1.1.1455.1', v1.1.1.1), 'invalid pattern';
83     ok !$checker->match_ipv4 ('123', '44.44.3.2'), 'invalid pattern';
84     ok !$checker->match_ipv4 ('*.12.3.1', '5.4.3.2'), 'invalid pattern';
85     ok !$checker->match_ipv4 ('12.3/32', '5.4.3.2'), 'invalid pattern';
86     ok $checker->match_ipv4 (v1.1.1.1, '12.3.3'), 'invalid addr';
87     ok $checker->match_ipv4 (v1.1.1.1, '1.1.1.1/31'), 'invalid addr';
88     ok $checker->match_ipv4 ('1.1.1.1/39', '1.1.1.0'), 'invalid pattern';
89    
90     },2..49,
91     sub {
92     my $checker = new_checker;
93     ok !$checker->match_ipv6 ('something', 'something'), 'IPv6 : not implemented yet';
94     },
95     sub {
96     my $checker = new_checker;
97     $checker->add_rule ("Allow host=example.com
98     Deny host=example.org
99     Allow host=example.net
100     Allow ipv4=12.34.5.6
101     Deny host=*
102     Deny ipv4=0.0.0.0/32
103     Deny ipv6=0::0/128");
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.org', 80);
118     },2,3,4,5,6,7,8,9,10,11,12,
119     );
120    
121     Test::Simple->import (tests => scalar @test);
122    
123     for (@test) {
124     &{$_} if ref $_;
125     }
126    
127    
128     =head1 LICENSE
129    
130     Copyright 2003 Wakaba <w@suika.fam.cx>
131    
132     This program is free software; you can redistribute it and/or
133     modify it under the same terms as Perl itself.
134    
135     =cut
136    
137     1; # $Date: 2003/08/05 12:20:00 $
138    
139    

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24