tests/iauth-test

   1 #! /usr/bin/perl
   2 # iauth-test: test script for IRC authorization (iauth) protocol
   3 # Copyright 2006-2007 Michael Poole
   4 #
   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.
   8
   9 require 5.008; # We assume deferred signal handlers, new in 5.008.
  10 use strict;
  11 use warnings;
  12 use vars qw(%pending);
  13
  14 use FileHandle; # for autoflush method on file handles
  15
  16 # This script is an iauth helper script to help check for bugs in
  17 # ircu's IAuth handling.
  18
  19 sub dolog ($) {
  20     print LOG "$_[0]\n";
  21 }
  22
  23 sub reply ($;$$) {
  24     my ($msg, $client, $extra) = @_;
  25
  26     if (not defined $msg) {
  27         # Accept this for easier handling of client reply messages.
  28         return;
  29     } elsif (ref $msg eq '') {
  30         $msg =~ s/^(.) ?/$1 $client->{id} $client->{ip} $client->{port} / if $client;
  31         dolog "< $msg";
  32         print "$msg\n";
  33     } elsif (ref $msg eq 'ARRAY') {
  34         grep { reply($_, $client, $extra); } @$msg;
  35     } elsif (ref $msg eq 'CODE') {
  36         &$msg($client, $extra);
  37     } else {
  38         die "Unknown reply message type.";
  39     }
  40 }
  41
  42 open LOG, ">> iauth.log";
  43 autoflush LOG 1;
  44 autoflush STDOUT 1;
  45 autoflush STDERR 1;
  46 dolog "IAuth starting at " . scalar(localtime(time));
  47 reply("O ARU");
  48
  49 while (<>) {
  50     # Chomp newline and log incoming message.
  51     s/\r?\n?\r?$//;
  52     dolog "> $_";
  53
  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+) //;
  56
  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) {
  61         delete $pending{$id};
  62     } elsif (/^n (.+)$/ and $client) {
  63         reply("C $client->{id} :Do not choke on missing parameters.") if $1 eq 'Bug1685648';
  64         reply("D", $client);
  65     }
  66 }