]>
jfr.im git - irc/quakenet/snircd.git/blob - tools/iauth-test
2 # iauth-test: test script for IRC authorization (iauth) protocol
3 # Copyright 2006 Michael Poole
5 # This program is free software; you can redistribute it and/or modify
6 # it under the terms of the GNU General Public License version 2 as
7 # published by the Free Software Foundation.
9 require 5.008; # We assume deferred signal handlers, new in 5.008.
12 use vars
qw(%pending);
14 use Config
; # for $Config{sig_name} and $Config{sig_num}
15 use FileHandle
; # for autoflush method on file handles
17 # This script is intended to help test an implementation of the iauth
18 # protocol by exercising every command in the protocol and by
19 # exercising most distinct combinations of commands. It assumes IPv4
20 # support in the server and POSIX real-time signal support in the OS
21 # (recognized and supported by Perl).
23 # Certain behavior is triggered by receipt of real-time signals.
24 # SIGRTMIN + 0 -> Send server notice ('>').
25 # SIGRTMIN + 1 -> Toggle debug level ('G').
26 # SIGRTMIN + 2 -> Set policy options ('O').
27 # SIGRTMIN + 3 -> Simulate config change ('a', 'A').
28 # SIGRTMIN + 4 -> Simulate statistics change ('s', 'S').
30 # In the following discussion, sX means message X from the server, and
31 # iX means message X from iauth. The hard part is the ordering of
32 # various events during client registration. This includes sC, sP,
33 # sU, su, sn, sN/d, sH and sT; and o/U/u, iN, iI, iC and iD/R/k/K.
35 # sC is first, sD/sT/iD/R/k/K is last. If sH is sent, no more sU, su,
36 # sn, sN, sd or sH messages may be sent. If iI is sent, iN should
37 # also be sent (either before or after iI). Multiple sP, sU and iC
38 # messages may be sent. Otherwse, the ordering of unrelated messages
39 # from either source are not constrained, but only one message from
40 # each set of alternatives may be sent.
42 # This means the sets of commands with interesting orderings are:
47 # 127.x.y.z IP addresses are used to exercise these orderings; see the
48 # %handlers variable below.
55 my ($msg, $client, $extra) = @_;
57 if (not defined $msg) {
58 # Accept this for easier handling of client reply messages.
60 } elsif (ref $msg eq '') {
61 $msg =~ s/^(.) ?/$1 $client->{id} $client->{ip} $client->{port} / if $client;
64 } elsif (ref $msg eq 'ARRAY') {
65 grep { reply
($_, $client, $extra); } @$msg;
66 } elsif (ref $msg eq 'CODE') {
67 &$msg($client, $extra);
69 die "Unknown reply message type.";
73 # Find the names of signals with values SIGRTMIN+1, +2, etc.
78 sub populate_signals
() {
80 unless $Config{sig_name
} and $Config{sig_num
};
81 my @names = split ' ', $Config{sig_name
};
82 @sig_num{@names} = split ' ', $Config{sig_num
};
83 foreach (@names) { $sig_name[$sig_num{$_}] ||= $_; }
86 sub assign_signal_handlers
() {
87 my $sigrtmin = $sig_num{RTMIN
};
88 die "No realtime signals?"
90 $SIG{$sig_name[$sigrtmin+0]} = \
&send_server_notice
;
91 $SIG{$sig_name[$sigrtmin+1]} = \
&toggle_debug_level
;
92 $SIG{$sig_name[$sigrtmin+2]} = \
&set_policy_options
;
93 $SIG{$sig_name[$sigrtmin+3]} = \
&sim_config_changed
;
94 $SIG{$sig_name[$sigrtmin+4]} = \
&sim_stats_change
;
100 my $max_debug_level = 2;
102 sub toggle_debug_level
() {
103 if (++$debug_level > $max_debug_level) {
106 reply
"G $debug_level";
118 sub set_policy_options
() {
119 $policy = $rotation{$policy};
127 sub sim_config_changed
() {
129 reply
"A config $generation";
137 sub sim_stats_change
() {
139 reply
"S stats $generation";
144 sub send_server_notice
() {
145 reply
"> :Hello the server!";
149 # Default handliner: immediately report done.
150 'default' => { C_reply
=> 'D' },
151 # 127.0.0.x: various timings for iD/iR/ik/iK.
152 '127.0.0.1' => { C_reply
=> 'D' },
153 '127.0.0.2' => { C_reply
=> 'R account-1' },
154 '127.0.0.3' => { C_reply
=> 'k' },
155 '127.0.0.4' => { C_reply
=> 'K' },
157 '127.0.0.16' => { H_reply
=> 'D' },
158 '127.0.0.17' => { H_reply
=> 'R account-2' },
159 '127.0.0.18' => { H_reply
=> 'k' },
160 '127.0.0.19' => { H_reply
=> 'K' },
161 '127.0.0.32' => { T_reply
=> 'D' },
162 '127.0.0.33' => { T_reply
=> 'R account-3' },
163 '127.0.0.34' => { T_reply
=> 'k' },
164 '127.0.0.35' => { T_reply
=> 'K' },
165 # 127.0.1.x: io/iU/iu functionality.
166 '127.0.1.0' => { C_reply
=> 'o forced',
168 '127.0.1.1' => { C_reply
=> 'U trusted',
170 '127.0.1.2' => { C_reply
=> 'u untrusted',
172 # 127.0.2.x: iI/iN functionality.
173 '127.0.2.0' => { C_reply
=> 'N iauth.assigned.host',
175 '127.0.2.1' => { C_reply
=> \
&ip_change
},
176 # 127.0.3.x: iC/sP functionality.
177 '127.0.3.0' => { C_reply
=> 'C :Please enter the password.',
178 P_reply
=> \
&passwd_check
},
181 sub handle_new_client
($$$$) {
182 my ($id, $ip, $port, $extra) = @_;
183 my $handler = $handlers{$ip} || $handlers{default};
184 my $client = { id
=> $id, ip
=> $ip, port
=> $port, handler
=> $handler };
186 # If we have any deferred reply handlers, we must save the client.
187 $pending{$id} = $client if grep /^[^C]_reply$/, keys %$handler;
188 reply
$client->{handler
}->{C_reply
}, $client, $extra;
192 my ($client, $extra) = @_;
193 reply
'I 127.255.255.254', $client;
194 $client->{ip
} = '127.255.255.254';
195 reply
'N other.assigned.host', $client;
199 sub passwd_check
($$) {
200 my ($client, $extra) = @_;
201 if ($extra eq 'secret') {
204 reply
'C :Bad password', $client;
208 open LOG
, ">> iauth.log";
210 assign_signal_handlers
();
214 dolog
"IAuth starting " . scalar(localtime(time));
219 # Chomp newline and log incoming message.
223 # If there's an ID at the start of the line, parse it out.
224 if (s/^(\d+) //) { $id = $1; $client = $pending{$id}; }
226 # Figure out how to handle the command.
227 if (/^C (\S+) (\S+) (.+)$/) {
228 handle_new_client
($id, $1, $2, $3);
229 } elsif (/^([DT])/ and $client) {
230 reply
$client->{handler
}->{"${1}_reply"}, $client;
231 delete $pending{$id};
232 } elsif (/^([d])/ and $client) {
233 reply
$client->{handler
}->{"${1}_reply"}, $client;
234 } elsif (/^([HNPUu]) (.+)/ and $client) {
235 reply
$client->{handler
}->{"${1}_reply"}, $client, $2;