tags/0.4.3.1-pre2/tests/inspConnect.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4
   5 use IO::Socket;
   6 use Time::HiRes qw(gettimeofday);
   7 my $socket = IO::Socket::INET->new(PeerAddr => '127.0.0.1',
   8                 PeerPort => 7000,
   9                 Proto    => "tcp")
  10                 or die "Couldn't connect to localhost:7000 : $@\n";
  11 $socket->autoflush(1);
  12 &connected;
  13 my @serverlist;
  14 my %users;
  15 while ( <$socket> ) {
  16         print "-> $_";
  17         parsemsg($_);
  18 }
  19
  20 sub connected {
  21         # SERVER servername password hopcount id :description
  22         print $socket "SERVER services.test.net polarbears 0 00A :Services \n";
  23 }
  24 sub parsemsg {
  25         my $msg = $_;
  26         $msg =~ s/[\r\n]//g;
  27         if ($msg =~ /^SERVER (.*) (.*) (.*) (.*) :(.+)/) {
  28                 push @serverlist, $4;
  29                 ircsend(":00A BURST");
  30                 ircsend(":services.test.net VERSION :SurrealServices 00A");
  31                 ircsend(":00A UID 00AAAAAAB ".time." NickServ services.test.net services.test.net NickServ 0.0.0.0 ".time." +io :Nickname Services");
  32                 ircsend(":00AAAAAAB OPERTYPE Services");
  33                 ircsend(":00A UID 00AAAAAAC ".time." ChanServ services.test.net services.test.net ChanServ 0.0.0.0 ".time." +io :Channel Services");
  34                 ircsend(":00AAAAAAC OPERTYPE Services");
  35                 ircsend(":00A UID 00AAAAAAD ".time." MemoServ services.test.net services.test.net MemoServ 0.0.0.0 ".time." +io :Memo Services");
  36                 ircsend(":00AAAAAAD OPERTYPE Services");
  37                 ircsend(":00A UID 00AAAAAAE ".time." OperServ services.test.net services.test.net OperServ 0.0.0.0 ".time." +io :Oper Services");
  38                 ircsend(":00AAAAAAE OPERTYPE Services");
  39                 ircsend(":00A ENDBURST");
  40                 ircsend(":00A PING 00A $serverlist[0]");
  41         }
  42         if ($msg =~ /^:(.*) PING (.*) (.*)$/) {
  43                 if ($1 eq $serverlist[0]) {
  44                         ircsend(":00A PONG 00A $serverlist[0]");
  45                 }
  46         }
  47         if ($msg =~ /^:(.*) FJOIN (.*) (.*) (.+) :?(.+)$/) {
  48                 parse_fjoin($1,$2,$3,$4,$5);
  49         }
  50         if ($msg =~ /^:(.*) IDLE (.*)$/) {
  51                 parse_idle($1,$2);
  52         }
  53         if ($msg =~ /^:(.*) UID (\S+) (\d+) (\S+) (\S+) (\S+) (\S+) (\S+) (\S+) (.+) :(.+)$/) {
  54                 parse_uid($1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11);
  55         }
  56         if ($msg =~ /^:(.*) PRIVMSG (\S+) :(.+)$/) {
  57                 parse_privmsg($1,$2,$3);
  58         }
  59 }
  60 sub ircsend {
  61         my $msg = shift;
  62         print "<- $msg\n";
  63         $msg .= " \n";
  64         print $socket $msg;
  65 }
  66
  67 sub parse_fjoin {
  68         #:431 FJOIN #test 1246571540 +nt :,431AAAAAC ,431AAAAAA
  69         my ($src, $chan, $ts, $modes, $users) = @_;
  70         if ($chan eq "#test") {
  71                 print "!!! aa - $modes\n";
  72                 ircsend(":00A FJOIN $chan $ts $modes :o,00AAAAAAB o,00AAAAAAC o,00AAAAAAD o,00AAAAAAE");
  73         }
  74 }
  75 sub parse_idle {
  76         my ($src, $target) = @_;
  77         ircsend(":$target IDLE $users{$src}{'nick'} ".time." 0");
  78 }
  79 sub parse_uid {
  80         #:431 UID 431AAAAAA 1246349244 MusashiX90 127.0.0.1 netadmin.omega.org.za nano 127.0.0.1 1246349249 +Wios +ACJKLNOQacdfgjklnoqtx :mwt
  81         my ($src, $uid, $ts, $nick, $hostname, $cloak, $ident, $ip, $signon, $modes, $realname) = @_;
  82         print "DEBUG: Added '$nick' to users\n";
  83         $users{$uid}{'nick'} = $nick;
  84 }
  85
  86 sub parse_privmsg {
  87         my ($src, $target, $msg) = @_;
  88         # PRIVMSG sent to MemoServ
  89         if ($target eq "00AAAAAAD") {
  90                 ircsend(":$target NOTICE $src :Received your message");
  91         }
  92 }