2 # iauth-test: test script for IRC authorization (iauth) protocol
3 # Copyright 2006-2007 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 FileHandle; # for autoflush method on file handles
16 # This script is an iauth helper script to help check for bugs in
17 # ircu's IAuth handling.
24 my ($msg, $client, $extra) = @_;
26 if (not defined $msg) {
27 # Accept this for easier handling of client reply messages.
29 } elsif (ref $msg eq '') {
30 $msg =~ s/^(.) ?/$1 $client->{id} $client->{ip} $client->{port} / if $client;
33 } elsif (ref $msg eq 'ARRAY') {
34 grep { reply($_, $client, $extra); } @$msg;
35 } elsif (ref $msg eq 'CODE') {
36 &$msg($client, $extra);
38 die "Unknown reply message type.";
42 open LOG, ">> iauth.log";
46 dolog "IAuth starting at " . scalar(localtime(time));
50 # Chomp newline and log incoming message.
54 # If there's an ID at the start of the line, parse it out.
55 my $client = $pending{my $id = $1} if s/^(\d+) //;
57 # Figure out how to handle the command.
58 if (/^C (\S+) (\S+) (.+)$/) {
59 $pending{$id} = { id => $id, ip => $1, port => $2 };
60 } elsif (/^([DT])/ and $client) {
62 } elsif (/^n (.+)$/ and $client) {
63 reply("C $client->{id} :Do not choke on missing parameters.") if $1 eq 'Bug1685648';