#! /usr/bin/perl
# iauth-test: test script for IRC authorization (iauth) protocol
# Copyright 2006-2007 Michael Poole
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 as
# published by the Free Software Foundation.

require 5.008; # We assume deferred signal handlers, new in 5.008.
use strict;
use warnings;
use vars qw(%pending);

use FileHandle; # for autoflush method on file handles

# This script is an iauth helper script to help check for bugs in
# ircu's IAuth handling.

sub dolog ($) {
    print LOG "$_[0]\n";
}

sub reply ($;$$) {
    my ($msg, $client, $extra) = @_;

    if (not defined $msg) {
        # Accept this for easier handling of client reply messages.
        return;
    } elsif (ref $msg eq '') {
        $msg =~ s/^(.) ?/$1 $client->{id} $client->{ip} $client->{port} / if $client;
        dolog "< $msg";
        print "$msg\n";
    } elsif (ref $msg eq 'ARRAY') {
        grep { reply($_, $client, $extra); } @$msg;
    } elsif (ref $msg eq 'CODE') {
        &$msg($client, $extra);
    } else {
        die "Unknown reply message type.";
    }
}

open LOG, ">> iauth.log";
autoflush LOG 1;
autoflush STDOUT 1;
autoflush STDERR 1;
dolog "IAuth starting at " . scalar(localtime(time));
reply("O ARU");

while (<>) {
    # Chomp newline and log incoming message.
    s/\r?\n?\r?$//;
    dolog "> $_";

    # If there's an ID at the start of the line, parse it out.
    my $client = $pending{my $id = $1} if s/^(\d+) //;

    # Figure out how to handle the command.
    if (/^C (\S+) (\S+) (.+)$/) {
        $pending{$id} = { id => $id, ip => $1, port => $2 };
    } elsif (/^([DT])/ and $client) {
        delete $pending{$id};
    } elsif (/^n (.+)$/ and $client) {
        reply("C $client->{id} :Do not choke on missing parameters.") if $1 eq 'Bug1685648';
        reply("D", $client);
    }
}