#!/usr/bin/perl

# XWISP 1.0 beta written by Charles Jones a.k.a. Blazer, Blazer0x. blazer0x@gmail.com
# Copyright Blackhand Studios Inc. 2006
# This program may be distributed under the terms of the GNU General Public License
# Copyleft:
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
# --------------------------------------------------------------------------------
# Thanks to:
# Scorpio9a  : Testing and knowledge of WOL protocol
# v00d00     : Testing and knowledge of WOL protocol
# jonwil     : Adding code to scripts.dll to enable UDP response and binary patches
# inetknight : Testing and knowledge of WOL protocol
# Silent_Kane: C version of apgar cipher, binary patch locations
# mac        : created "macrem", which I had to code support for :)
# Crimson    : Being the ownage, and I Love her!
###################################################################################
# Features:
# * XWISP is written in Perl and will work on any distribution of Linux that the LFDS
#   works on.
#
# * XWISP allows the Linux FDS to be on both Gamespy and XWIS simulataneously
#
# * XWISP gives the LFDS all of the WOL/XWIS functionality of the Win32 FDS, except
#   for ladder support (will #probably never be added for security reasons).
#
# * XWISP adds a few features like notifying when a player is loading the map, a 
#   pre-ban list, and detection/banning of IP harvesting bots and people using "relays"
#   to block unauthorized joining of your server channel.
#
# * XWISP supports "macrem" and so is compatible with BrenBot.
#
# * XWISP encapsulates the LFDS. When you launch XWISP, it launches renegade for you
#   and all console I/O is passed through XWISP.
#
# * XWISP has an optional (I may remove it for the final release unless people want
#   it to stay) IRC interface so that the server admin can observe the XWIS protocol
#   exchanges and send raw XWIS commands.
#
# * XWISP parses the renegade server.ini and svrcfg_cnc.ini. This greatly reduces
#   the amount of user configuration. The result is the only thing you have to 
#   configure is in xwisp.conf, which mostly has options to specify the bots IRC
#   information. This also means that XWISP does not require you to provide your
#   encrypted password, it will read your standard password from server.ini and
#   encrypt it to the apgar format needed for transmission to xwis.
#
# * XWISP has an optiona full-ANSI console mode. This allows the console to have an
#   IRC-like mode, where text starts near the bottom and scrolls upwards, with a
#   protected area at the bottom of the screen for typing commands.
#
# * WOL functionality includes:
#   - full support for NAT players
#   - sending and receiving of PAGE commands
#   - xwis channel administration (kicks and bans)
#   - auto-kick of people who idle at the start screen (with configurable delay)
#   - proper format of XWIS channel topic including correct non-static ping values

use warnings;
use strict;

use IO::Socket;
use String::CRC32;
use POSIX;
use POE::Wheel::ReadWrite;
use POE::Wheel::Run;
use POE::Filter::Stream;
use POE::Component::IRC;
use POE::Component::Client::TCP;
use POE::Component::Server::TCP;
use POE;
use Time::HiRes qw(time);

our %Server_Config;
our %XWISP_Config;
our %Server_Ini;
our $ServerIP;
our $ServerPort;
our $FDS_Dir;
our $IRC_Server_Name;
our $IRC_Nick;
our $IRC_Username;
our $IRC_Fullname;
our $IRC_Server_Port;
our $IRC_Channel;
our $IRC_Nickserv_Pass;
our $XWIS_Host="c.xwis.net"; #This shouldn't change, so not in config file
our $XWIS_Port="4010"; #This shouldn't change, so not in config file
our $kernel  = $_[KERNEL];
our $heap    = $_[HEAP];
our $session = $_[SESSION];
our $FlagBytes;
our $TOPIC;
our $MAPNAME;
our $MAPNAME_CRC;
our $EXEKEY;
our $xwisnick;
our $player_joingame;
our $player_rginfo;
our $player_nat;
our $player_port;
our $player_ip;
our $console;
our $xwis;
our $player_nat_status;
our $player_nat_port;
our $hexip;
our $hexport;
our $glog=0;
our @playerinfo_temp;
our @playerinfo;
our %gameinfo_temp;
our %gameinfo;
our $gameinfo;
our @visitors;
our $input_buffer;
our @banned;
our $firstrun=1;
our %users;
our $ping;
our $pings;
sub Init {

 my $xwisp_conf = "./xwisp.conf";
    open (XWISP_CONFIG,$xwisp_conf) or die "Error opening $xwisp_conf : $! - did you remember to copy xwisp.conf-template to xwisp.conf and edit it? RTFM!";
    print "Reading $xwisp_conf file\n";
    while (<XWISP_CONFIG>) {
       chomp;                  # no newline
       s/\^#.*//;              # no comments
       s/^\s+//;               # no leading white
       s/\s+$//;               # no trailing white
       next unless length;     # anything left?
       my ($xwisp_var, $xwisp_value) = split(/\s*=\s*/, $_, 2);
       $XWISP_Config{$xwisp_var} = $xwisp_value;
    }
    close XWISP_CONFIG;
    $FDS_Dir=$XWISP_Config{'FDS_Dir'};
    chdir "$FDS_Dir" or die "Cannot chdir to $FDS_Dir $!";
    $ENV{LD_PRELOAD}="$FDS_Dir/scripts.so";

# Read in config file options
    chdir "$FDS_Dir" or die "Cannot chdir to $FDS_Dir $!";
    my $filename="$FDS_Dir/data/svrcfg_cnc.ini";
    open (CONFIG,$filename) or die "Cannot open $filename: $!";
    while (<CONFIG>) {
       chomp;                  # no newline
       s/#.*//;                # no comments
       s/^\s+//;               # no leading white
       s/\s+$//;               # no trailing white
       next unless length;     # anything left?
       my ($var, $value) = split(/\s*=\s*/, $_, 2);
       $Server_Config{$var} = $value;
#       print "Debug: Setting \$Server_Config{$var} = $value\n";
    }

# Compute and build the Flag Bytes
    my $FlagByte1 = 96;
    if ($Server_Config{'IsClanGame'} =~ /yes/i)              {$FlagByte1+=1}
    if ($Server_Config{'IsTeamChangingAllowed'} =~ /yes/i)   {$FlagByte1+=2}
    if ($Server_Config{'RemixTeams'} =~ /yes/i)              {$FlagByte1+=4}
    if ($Server_Config{'IsFriendlyFirePermitted'} =~ /yes/i) {$FlagByte1+=8}
    my $FlagByte2 = 32; 
    if ($Server_Config{'DriverIsAlwaysGunner'} =~ /yes/i)    {$FlagByte2+=1}
    if ($Server_Config{'CanRepairBuildings'} =~ /yes/i)      {$FlagByte2+=2}
    if ($Server_Config{'SpawnWeapons'} =~ /yes/i)            {$FlagByte2+=4}
    $FlagBytes = (chr($FlagByte1) . chr($FlagByte2));
#    print "[DEBUG]: FLAGS = $FlagBytes\n";
# Set first mapname
    $MAPNAME=$Server_Config{'MapName'};
    close CONFIG;
    my $bans = "$FDS_Dir/xwisp/xwisp-bans.conf";
    open (BANS,$bans) or die "Error opening $bans : $!";
    print "Reading $bans file\n";
    while (<BANS>) {
       chomp;                  # no newline
       s/#.*//;                # no comments
       s/^\s+//;               # no leading white
       s/\s+$//;               # no trailing white
       next unless length;     # anything left?
       my ($ban) = $_;
       if ( (length($ban)) > 9 ) {
          print "Error. XWIS usernames cannot be longer than 9 chars, like [$ban] is.\n";
          die "Fix long names in $bans";
       }
       print "Adding $ban to pre-ban list.\n";
       push @banned,$ban; 
    }
    close BANS;

# Read in config file options
    chdir "$FDS_Dir" or die "Cannot chdir to $FDS_Dir $!";
    my $ini="$FDS_Dir/server.ini";
    open (INI,$ini) or die "Cannot open $ini: $!";
    while (<INI>) {
       chomp;                  # no newline
       s/#.*//;                # no comments
       s/^;.*//;               # no comments
       s/^\s+//;               # no leading white
       s/\s+$//;               # no trailing white
       s/^\[.*//;              # no [headings]
       next unless length;     # anything left?
       my ($var, $value) = split(/\s*=\s*/, $_, 2);
       if (!($Server_Ini{$var})) # Don't overwrite existing values
          {
            $Server_Ini{$var} = $value;
#            print "Debug: Setting \$Server_Ini{$var} = $value\n";
          }
    }

$ServerPort=$Server_Ini{'Port'};  
$ServerIP=$Server_Ini{'RemoteAdminIP'} or die "ERROR: RemoteAdminIP must be set in $FDS_Dir/server.ini!";
$xwisnick=$Server_Ini{'Nickname'} or die "ERROR: Nickname (WOL/XWIS name) must be set in $FDS_Dir/server.ini!";
if (length($xwisnick) > 9) 
   {
    die "ERROR: Nickname in server.ini cannot exceed 9 characters in length!";
   }
}

sub BuildTopic {
$MAPNAME_CRC=sprintf("%.8X", crc32(uc($MAPNAME)));
$TOPIC=":g"; # g=gameplay in progress G=gameplay pending
$TOPIC.="2"; # Unknown static
$TOPIC.=chr(($Server_Config{'MaxPlayers'}*2 + 49)); # Max Players
$TOPIC.="T"; # Unknown static 
$TOPIC.="4F453BA3"; # EXE Key static
$TOPIC.=$MAPNAME_CRC; # CRC of uppercase mapname, in hex
$TOPIC.="00000000000000002"; # Unknown static
$TOPIC.=$FlagBytes." "; # Game server settings
$TOPIC.=chr((length($Server_Config{'bGameTitle'})+32)); # Title Length
$TOPIC.=$Server_Config{'bGameTitle'}; # Server Title
$TOPIC.=chr(length(substr($MAPNAME,0,16))+32); # Map Name Length Byte
$TOPIC.=substr($MAPNAME,0,16); # Max map length is 16 chars max
$TOPIC.=$pings; # pings, 4 words
#print "[DEBUG] TOPIC: [$TOPIC]\n";
}

sub hex2ip {
#   This is a steaming pile of shit kludge
    my $hex=shift;
    $hex =~ s/(\w\w)(\w\w)(\w\w)(\w\w)/hex($4).".".hex($3).".".hex($2).".".hex($1)/eg; 
    return $hex;
}

sub ip2hex {
#   This is a steaming pile of shit kludge
    my $ip=shift;
    $ip=~s/(\d+)\.(\d+)\.(\d+)\.(\d+)/sprintf("%02x",$4).sprintf("%02x",$3).sprintf("%02x",$2).sprintf("%02x",$1)/eg;
    return $ip;
}

sub dec2hex($){
my ($dec) = shift;
return sprintf("%lx", $dec);
}

sub macrem_connect {
    my ( $session, $heap, $input ) = @_[ SESSION, HEAP, ARG0 ];
    my $session_id=$session->ID();
    # Should probably send this to a logfile...
    if ( ($heap->{remote_ip}) ne ($Server_Ini{'RemoteAdminIP'}))
       { # Warn of remote admin connects from other IPs
         print "[NOTICE] Possible unauthorized Remote admin connection $session_id from: $heap->{remote_ip}\n";
       }
    $heap->{client}->put("password");
}

sub macrem_input {
    my ( $session, $heap, $input ) = @_[ SESSION, HEAP, ARG0 ];
    my $session_id = $session->ID();
    our $users;
#    print "[NOTICE] Remote admin Session $session_id got input: $input\n";
        if ($input eq $Server_Ini{'RemoteAdminPassword'})
           {
             $heap->{client}->put("accepted");
             $users->{$session_id}->{'authenticated'} = 1;
             return;
           }
        if ( $users->{$session_id}->{'authenticated'} ) #if they are authed
           {
             $console->{program}->put("\n$input\n"); #Send command to console
             if ($input =~ /page (\w+) (.+)/) # Transform page request to XWIS
               {
                print "sending page $1 : $2\n";
                $xwis->{server}->put("PAGE $1 :$2");
               }
             if ($input =~ /ban (.+)/) # Pass along ban request to XWIS
               {
                $xwis->{server}->put("MODE #$xwisnick +b $1");
                $xwis->{server}->put("KICK #$xwisnick $1");
               }
             if ($input =~ /allow (.+)/) # Unban a n00b from XWIS
               {
                $xwis->{server}->put("MODE #$xwisnick -b $1");
               }
           }
        else
          {
           print "[NOTICE] Invalid Remote Admin Authentication from $heap->{remote_ip}\n";
           $heap->{client}->put("Invalid Authentication. Failed access attempt logged.");
           $_[KERNEL]->yield("shutdown"); # Then disconnect the remote admin
           delete $users->{$session_id}; # Cleanup session vars;;
          }
}

sub macrem_disconnect {
    my ( $session, $heap, $input ) = @_[ SESSION, HEAP, ARG0 ];
    our $users;
    my $session_id = $session->ID();
    delete $users->{$session_id};
    print "[NOTICE] Disconnected remote Session $session_id\n";
}

sub CHANNEL () { "$XWISP_Config{'IRC_Channel'}" }

sub bot_start {
    $poe_kernel->post( IRC => register => "all" );
    print "IRC Initialization...\n";
    my $nick = $XWISP_Config{'IRC_Nick'};
    $poe_kernel->post( IRC => connect =>
          { Nick => $nick,
            Username => $XWISP_Config{'IRC_Nick'},
            Ircname  => $XWISP_Config{'IRC_Fullname'},
            Server   => $XWISP_Config{'IRC_Server_Name'},
            Port     => $XWISP_Config{'IRC_Server_Port'},
            Flood    => 1,
          }
    );
}

sub on_connect {
    print "[Notice] Connected to IRC.\n";
}

sub on_disconnect
    {
        print "[NOTICE] Doh! We got disconnected!  Trying to reconnect.\n";
        $poe_kernel->post( IRC => connect =>
                            {
                                Nick     => $XWISP_Config{'IRC_Nick'},
                                Username => $XWISP_Config{'IRC_Username'},
                                Ircname  => $XWISP_Config{'IRC_Fullname'},
                                Server   => $XWISP_Config{'IRC_Server_Name'},
                                Port     => $XWISP_Config{'IRC_Server_Port'},
                                Flood    => 1,
                            }
                         );
    }

sub on_welcome {
print "Got Server Welcome Message...\n";
print "Identifying with Nickserv using password $XWISP_Config{'IRC_Nickserv_Pass'}\n";
$poe_kernel->post( IRC => privmsg => "nickserv", "identify".$XWISP_Config{'IRC_Nickserv_Pass'} );
#sleep(3);
print "Joining IRC Channel...\n";
$poe_kernel->post( IRC => join => CHANNEL );
$poe_kernel->post( IRC => privmsg => CHANNEL, "XWISP 1.00b Ready" );
}

sub on_error {
    print "[NOTICE] An unknown error has occured while connecting to IRC\n";
}

sub on_public { #This is just for testing purposes
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    if ( $who =~ /(.+)\!(.+)\@(.+)/ ) {
       my $nick=$1;
       my $user=$2;
       my $host=$3;
       my $channel = $where->[0];
       print "<$nick> $msg\n";
       # $who = Blazer!blazer@the-ownage.com
       if ( $msg =~ /^\!xwis (.+)/i ) {
          ParsePublicCommand($1);
       }
     }
}

sub on_private {
    my ( $kernel, $who, $where, $msg ) = @_[ KERNEL, ARG0, ARG1, ARG2 ];
    if ( $who =~ /(.+)\!(.+)\@(.+)/ ) {
       my $nick=$1;
       my $user=$2;
       my $host=$3;
       my $channel = $where->[0];
       print "*$nick* $msg\n";
       # $who = Blazer!blazer@the-ownage.com
       if ( $msg =~ /^\.(.+)/ ) {# commands via PM disabled
          ParsePrivateCommand($nick,$user,$host,$msg);
       }
    }
}

sub ParsePublicCommand {
    my ($command) = @_;
    $poe_kernel->post( IRC => privmsg => CHANNEL, "Sending Command To Server: $command" );
    XWIS_Command($command);
}

sub ParsePrivateCommand {# commands via PM disabled, send warning of any PMs
    my ($nick,$user,$host,$command) = @_;
    $poe_kernel->post( IRC => privmsg => CHANNEL, "PRIVMSG from $nick!$user\@$host: $command" );
}

sub XWIS_Command {

    my $command = shift;
    $heap->{server}->put("$command");
}

#sub FDS_Login
#    {
#        print "Connected to FDS\n";
#        $poe_kernel->post( IRC => privmsg => CHANNEL, "Connected to FDS TCP Log.");
#    }

sub apgar_enc { # Convert plaintext pass to apgar crypted format for XWIS
  my @v = map ord, split //, shift;
  my @r;
  my $U="abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./";
  for (my $i = 0; $i < 8; $i++) {
    my $a = $v[$i];
    my $index=(($a & 1
                ? $a << ($a & 1) & $v[8-$i]
                : $a ^ $v[8-$i])
                & 0x3f);
    push @r, substr($U,$index,1)
  }
  join '', @r;
}

sub XWIS_Login {
    my $joingame_maxplayers=$Server_Config{'MaxPlayers'} * 2 + 1;
    $xwis=$_[HEAP];
    my $apgar=apgar_enc($Server_Ini{'Password'});
    print "[DEBUG]: Logging into XWIS Server with Nick: $xwisnick Pass: $Server_Ini{'Password'}/$apgar\n";
    $_[HEAP]->{server}->put("CVERS 11020 12288");
    $_[HEAP]->{server}->put("PASS supersecret");
    $_[HEAP]->{server}->put("NICK $xwisnick");
    $_[HEAP]->{server}->put("apgar $apgar 0");
    $_[HEAP]->{server}->put("SERIAL $Server_Ini{'Serial'}");
    $_[HEAP]->{server}->put("USER UserName HostName irc.westwood.com :RealName");
    $_[HEAP]->{server}->put("verchk 32512 720916");
    $_[HEAP]->{server}->put("SETOPT 17,33");

### Post Login
    $poe_kernel->post( IRC => privmsg => CHANNEL, "Attempting to create game channel..." );
    $_[HEAP]->{server}->put("SETOPT 17,33");
    $_[HEAP]->{server}->put("GETINSIDER $xwisnick");
    $_[HEAP]->{server}->put("TIME");
    $_[HEAP]->{server}->put("SETCODEPAGE 1252");
    my $pass; 
    if ($Server_Config{'IsPassworded'} =~ /yes/i) { $pass = ' '.$Server_Config{'bPassword'}; }
    $_[HEAP]->{server}->put("JOINGAME #$xwisnick 2 $joingame_maxplayers 12 3 1 0 0$pass");
    $_[HEAP]->{server}->put("TOPIC #$xwisnick $TOPIC");
    $_[HEAP]->{server}->put("USERIP $xwisnick");
    $_[HEAP]->{server}->put("STARTG #$xwisnick $xwisnick");
    $_[HEAP]->{server}->put("CLANBYNAME $xwisnick");
    $_[HEAP]->{server}->put("GETLOCALE $xwisnick");
    $_[HEAP]->{server}->put("GETCODEPAGE $xwisnick");
    if ($firstrun) { # If this is initial startup...
       &do_prebans; # Preban the n00bs
    }
}

sub XWIS_Disconnected {
#TODO: Auto-reconnect
    $poe_kernel->post( IRC => privmsg => CHANNEL, "Damn, something broke my connection!" );
    die "Ownt!";
}

sub xwis_goterror {
    my ($error)=@_;
    print "[DEBUG]: Got ERROR with XWIS [$error]\n";
}

#sub xwis_gotline {
#    my ($line) = @_;
#    $poe_kernel->post( IRC => privmsg => CHANNEL, "[XWIS] $line" );
#}

sub xwis_ping { # Collect ping stat for channel topic
    my $results=qx(/bin/ping -c 1 c.xwis.net) or die "cannot execute /bin/ping\n";
    $results=~/(\d+) ms/;                                                           print "Ping time to c.xwis.net is $1 ms\n";
    return $1;
}

sub do_prebans {
    foreach (@banned) {
     if ($_ eq $xwisnick) {
        die "You n00b! Why would you ban the server itself?? Fix the xwis-bans.conf!";
     }
     print "Pre-Banning XWIS user: $_\n";
     $xwis->{server}->put("MODE #$xwisnick +b $_"); 
    }
} 
     

sub visitors_remove {
    my $leaver=shift;
    my $element=0;
    foreach (@visitors) { #Scan all of the visitors
      if ($_->{'name'} eq $leaver) #If the person who left is on the list
         {
          splice @visitors,$element,1; #Remove their hash from the array
          print "[DEBUG]: Removed vistor $leaver from watchlist\n";
          return;
         }
      $element++;
    }
}

sub visitors_reap {
    my $element=0;
    foreach (@visitors) { # Scan all of the vistors
      if ( (time - $_->{'time'}) > $XWISP_Config{'Idle_Timeout'} ) { # If the visitor has been hanging around too long 
           print "[NOTICE] Kicking $_->{'name'} for idling in the channel too long\n";
           $xwis->{server}->put("KICK #$xwisnick $_->{'name'}");
           $xwis->{server}->put("PAGE $_->{'name'} :[XWISP] You were kicked for idling in the server channel.");
           $console->{program}->put("\nmsg [XWISP] $_->{'name'} was kicked for idling at the start screen.\n");
           splice @visitors,$element,1; #Remove their hash from the array
           return;
         }
      $element++; 
    }
}

sub do_updates {
        print "[DEBUG] Updatating dynamic data structures.\n";
        $console->{program}->put("\ngame_info\n");
        print "[DEBUG] Updating XWIS server channel topic.\n";
        BuildTopic;
#        print "[DEBUG]: setting topic via \"TOPIC #$xwisnick $TOPIC\"\n";
        $xwis->{server}->put("TOPIC #$xwisnick $TOPIC");
}

sub Send_GINFO {
#  Time : 0.30.00
    my ($hours,$mins) = $gameinfo{'time'} =~ /(\d+)\.(\d+)\.\d+/;
    my $gametime = sprintf("%4.4f",((($hours/60)+ $mins))*60);
    my $RGINFO_REPLY = "GAMEOPT $player_rginfo :GINFO:$MAPNAME_CRC $gametime";
    print "$RGINFO_REPLY\n";
    $heap->{server}->put("$RGINFO_REPLY");
}   
    

sub Send_TINFO {
    my $NODscore = $gameinfo{'nodpoints'};
    my $GDIscore = $gameinfo{'gdipoints'};
    if (!($NODscore)) {$NODscore=0};
    if (!($GDIscore)) {$GDIscore=0};
    print "GAMEOPT $player_rginfo :TINFO:0 $NODscore\n";
    $xwis->{server}->put("GAMEOPT $player_rginfo :TINFO:0 $NODscore");
    print "GAMEOPT $player_rginfo :TINFO:1 $GDIscore\n";
    $xwis->{server}->put("GAMEOPT $player_rginfo :TINFO:1 $GDIscore");
}


sub Send_PINFO {
foreach (@playerinfo)
        {
          print "[DEBUG]: Send_PINFO : \@playerinfo contains (@playerinfo) entries\n";
          print "GAMEOPT $player_rginfo :PINFO:$_->{'name'} $_->{'team'} $_->{'rank'} $_->{'kills'} $_->{'deaths'} $_->{'score'}\n";
          $xwis->{server}->put("GAMEOPT $player_rginfo :PINFO:$_->{'name'} $_->{'team'} $_->{'rank'} $_->{'kills'} $_->{'deaths'} $_->{'score'}");
        }
}

sub Handle_Page { # Received an XWISP page, print and append it to the renlog 
      my ($pager,$message) = @_;
      print "[DEBUG]: got a page from $pager : $message\n";
      my ($second, $minute, $hour, $dayOfMonth, $month, $yearOffset, $dayOfWeek, $dayOfYear, $daylightSavings) = localtime();
      my $renlog="$FDS_Dir/renlog_$month-$dayOfMonth-$yearOffset.txt";
      my $timestamp=sprintf("[%02d:%02d:%02d]",$hour,$minute,$second);
      open (RENLOG,">>$renlog") or die "Cannot open $renlog: $!" ;
      print RENLOG "$timestamp [Page] $pager: $message\n";
      print "[Page] $pager: $message\n";
      close RENLOG;
}

sub XWIS_Input {
    our ($heap, $data) = @_[ HEAP, ARG0 ];
    my %visitors;
#    print "[DEBUG]: data is: [$data]\n";
    print "\[$data\]\n";
    if ($data ne "PING ") #Don't spam the channel with PINGs
       {
        $poe_kernel->post( IRC => privmsg => CHANNEL, "[XWIS] $data" );
       }
    if ($data =~ /:(.+?)\!u\@h PAGE u :(.+)/) # Page received
       {
         Handle_Page($1,$2);
       }

#   Detect non-game clients (bots/humans)
#   :iamakoti!u@h JOIN :0,0 #wlbot2
    if ($data =~ /:(.+)\!u\@h JOIN :/)
       {
        print "[WARNING] Probable BOT \[$1\] joined server channel.\n";
        $poe_kernel->post( IRC => privmsg => CHANNEL, "[XWIS] Probable BOT \[$1\] joined server channel." );
        $heap->{server}->put("KICK #$xwisnick $1");
        $poe_kernel->post( IRC => privmsg => CHANNEL, "[XWIS] Kicked $1 from server channel." ); 
        $heap->{server}->put("PAGE $1 :Bots and humans are not allowed. You have been 0wn3d by XWISP");
       }
#   Normal Player join server channel  
#   :genlkozar!u@h JOINGAME 2 33 12 1 0 1155853071 0 :#blaz3r0x
    if ($data =~ /:(.+)\!u\@h JOINGAME/)
       {
        $player_joingame = $1;
        print "Player $player_joingame joined server channel\n";
        $heap->{server}->put("GETCODEPAGE $player_joingame");
        do_updates;
        $visitors{'name'}=$player_joingame;
        $visitors{'time'}=time;
        if ($player_joingame ne $xwisnick) # We dont want the server itself on the list
           {
             push @visitors,\%visitors; #Keep timestamps of when people join channel
           }
       }

#   Player sends RGINFO 
    if ($data =~ /:(.+)\!u\@h GAMEOPT $xwisnick :RGINFO/)
       {
        $player_rginfo = $1;
        print "[NOTICE] Got RGINFO from $player_rginfo\n";
#       GAMEOPT genlkozar :GINFO:dbae41cb 1800.0000
#       GAMEOPT genlkozar :TINFO:0 0
#       GAMEOPT genlkozar :TINFO:1 0
#       GAMEOPT blazer0x :PINFO:genlkozar 1 1 0 0 0
        Send_GINFO;
        Send_TINFO;
        Send_PINFO;
       }

#    Player sends NAT
#    :Scorpio9a!u@h GAMEOPT wlbot2 :NAT:hScorpio9a
     if ($data =~ /:(.+)\!u\@h GAMEOPT $xwisnick :NAT:h(.+)$/)
        {
         $player_nat=$1;
#        print "[DEBUG]: \$player_nat=\[$player_nat\]\n";
         $hexip=ip2hex($ServerIP);
         $hexport=dec2hex($ServerPort);
#        GAMEOPT genlkozar :NAT:b0300a8c0,0ab7,0febe444,00000001,0000
         print "[NOTICE] GAMEOPT $player_nat :NAT:b$hexip,$hexport,$hexip,00000001,0000\n";
         $heap->{server}->put("GAMEOPT $player_nat :NAT:b$hexip,$hexport,$hexip,00000001,0000");
         print "[NOTICE] $2 is joining the game from XWIS/WOL\n";
         $console->{program}->put("\nmsg [XWISP] $2 is loading the map to join the game\n");
        }

#   :blazer0x!u@h GAMEOPT wlbot2 :NAT:c0300a8c0,6987,0febe444,00000001
#   :rinoxbot1!u@h GAMEOPT wlbot2 :NAT:c9902a8c0,0ecd,4bb8cecd,00000012
    if ($data =~ /:(.+)\!u\@h GAMEOPT $xwisnick :NAT:c.+,(.+),(.+),(.+)/)
       {
         $player_nat=$1;
         $player_port=$2;
         $player_ip=$3;
         $player_nat_status=$4;
         print "[DEBUG]: Client NAT name:$player_nat IP:$player_ip PORT:$player_port\n";
         print "[NOTICE] GAMEOPT $player_nat :NAT:f00\n";
         $heap->{server}->put("GAMEOPT $player_nat :NAT:f00");
         if (!($player_nat_status =~ /01$/))
            {
              print "[DEBUG]: $player_nat is NAT player\n";
              print "GAMEOPT $player_nat :NAT:d$hexport,$xwisnick\n";
              $heap->{server}->put("GAMEOPT $player_nat :NAT:d$hexport,$xwisnick");
            }
         if ($player_nat_status =~ /1$/)
           {
             print "[DEBUG]: $player_nat is a non-NAT player\n";
#             UDP_Reply($xwisnick,$player_ip,$player_port); 
             print "GAMEOPT $player_nat :NAT:el,$player_port,$xwisnick\n";
             $heap->{server}->put("GAMEOPT $player_nat :NAT:el,$player_port,$xwisnick");

           }

       }

# :Scorpio9a!u@h GAMEOPT wlbot2 :NAT:d4ba8,Scorpio9a
     if ($data =~ /:(.+)\!u\@h GAMEOPT $xwisnick :NAT:d(.+),(.+)/)
        {
         $player_nat=$1;
         $player_nat_port=$2;
         print "[DEBUG]: Client NAT name:$player_nat IP:$player_ip NAT_PORT:$player_nat_port ... a dreaded NAT:d player!\n";
#         UDP_Reply($xwisnick,$player_ip,$player_nat_port);
         print "GAMEOPT $player_nat :NAT:el,$player_nat_port,$xwisnick\n";
         $heap->{server}->put("GAMEOPT $player_nat :NAT:el,$player_nat_port,$xwisnick");
#         UDP_Reply($xwisnick,$player_ip,$player_nat_port);
#         Don't need this anymore since I got jonwil to add func to scripts.dll
      } 
    
    if ($data =~ /:(.+)\!u\@h PART #$xwisnick/) 
       { 
       visitors_remove($1); # Remove them from the watchlist
       do_updates;
       }
}


### Handle the _start event.  This sets things in motion.

sub handle_start {
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];

    # Set a signal handler.

    $kernel->sig( CHLD => "got_sigchld" );

    # Save the original terminal settings so they can be restored later.

    $heap->{stdin_tio} = POSIX::Termios->new();
    $heap->{stdin_tio}->getattr(0);
    $heap->{stdout_tio} = POSIX::Termios->new();
    $heap->{stdout_tio}->getattr(1);
    $heap->{stderr_tio} = POSIX::Termios->new();
    $heap->{stderr_tio}->getattr(2);

    # Put the terminal into raw input mode.  Otherwise discrete
    # keystrokes will not be read immediately.

    my $tio = POSIX::Termios->new();
    $tio->getattr(0);
    my $lflag = $tio->getlflag;
    $lflag &= ~( ECHO | ECHOE | ECHOK | ECHONL | ICANON | IEXTEN | ISIG );
    $tio->setlflag($lflag);
    my $iflag = $tio->getiflag;
    $iflag &= ~( BRKINT | INPCK | ISTRIP | IXON );
    $tio->setiflag($iflag);
    my $cflag = $tio->getcflag;
    $cflag &= ~( CSIZE | PARENB );
    $tio->setcflag($cflag);
    $tio->setattr( 0, TCSANOW );

    # Start the terminal reader/writer.
    $heap->{stdio} = POE::Wheel::ReadWrite->new
      ( InputHandle => \*STDIN,
        OutputHandle => \*STDOUT,
        InputEvent   => "got_terminal_stdin",
        Filter       => POE::Filter::Stream->new(),
      );

    # Start the asynchronous child process.
    $heap->{program} = POE::Wheel::Run->new
      ( Program => "$FDS_Dir/renegade",
        Conduit     => "pty",
        StdoutEvent => "got_child_stdout",
        StdioFilter => POE::Filter::Stream->new(),
      );
    our $console=$heap;
    print "Unique wheel ID is : ", $console->{program}->ID;
if ($XWISP_Config{'ANSI'}) #If ANSI mode is on
   { 
     my $window=(`tput lines` -1); # Set no-scroll area for IRC-like effect
     $heap->{stdio}->put("\e[1;${window}r"); # Move cursor down to bottom of no-scroll area
   }
$console->{program}->put("\ngame_info\n");# Initial info update
}

### Handle the _stop event.  This restores the original terminal
### settings when we're done.  That's very important.

sub handle_stop {
    my $heap = $_[HEAP];
    $heap->{stdin_tio}->setattr( 0,  TCSANOW );
    $heap->{stdout_tio}->setattr( 1, TCSANOW );
    $heap->{stderr_tio}->setattr( 2, TCSANOW );
}

### Handle terminal STDIN.  Send it to the background program's STDIN.
### If the user presses ^C, then also go berserk a little.

sub handle_terminal_stdin {
    my ( $heap, $input ) = @_[ HEAP, ARG0 ];

    if ( $input =~ m/\003/g ) { # User pressed ctrl-c
          print "[NOTICE] Ctrl-C detected. XWISP shutting down.\n";
          print "[NOTICE] Killing LFDS process. Note that sometimes LFDS process can zombie.\n";
          print "[NOTICE] Preferred shutdown method is to type \"quit\" at console.\n";
          print "[NOTICE] Note: sometimes terminal settings get hosed upon exit. If you cannot see what you are typing, or other terminal weirdness, type \"reset\".\n";
          $heap->{program}->kill(9);
          exit 1;
    }

    $input_buffer.=$input; #add to the buffer
    $input_buffer=substr($input_buffer,0,128); # Don't let the buffer grow too large
    $heap->{program}->put($input);

#   We must intercept XWIS-specific commands like page, ban, and allow
#   and send them to XWIS in the proper format.
#   TODO: Make calls to existing subs like Handle_Page()
    if ($input_buffer =~ /page (\w+) (.+)\n/) # Send a page
       {
        print "sending page $1 : $2\n";
        $xwis->{server}->put("PAGE $1 :$2");
        $input_buffer="";
       }
    if ($input_buffer =~ /ban (.+)\n/) # Ban a n00b
       {
        $xwis->{server}->put("MODE #$xwisnick +b $1");
        $xwis->{server}->put("KICK #$xwisnick $1");
        $input_buffer="";
       }
    if ($input_buffer =~ /allow (.+)\n/) # Unban a n00b
       {
        $xwis->{server}->put("MODE #$xwisnick -b $1");
        $input_buffer="";
       }
}

# Handle STDOUT from the child program.  Send it to the terminal's
# STDOUT. Highlight anytime someone says the word "cheat". 

sub handle_child_stdout {
    my ( $heap, $input ) = @_[ HEAP, ARG0 ];
    $input =~ s/cheat/\e[1mcheat\e[0m/g;
    $input =~ s/Console mode active/\e[1mXWISP Console mode active - BlackHand Studios Inc. 2007\e[0m/;
    $input =~ s/Loading level (.+)/Loading level \e[1m$1\e[0m/g;
    $heap->{stdio}->put($input);
    if ($input =~ /Renegade Free Dedicated Server/)
       {
        print "\n[NOTICE] Setting LFDS XWIS nickname to: $Server_Ini{'Nickname'}\n";
        $console->{program}->put("\nwolname $Server_Ini{'Nickname'}\n");
        $firstrun=0;
       }
    if ($input =~ /Player (.+) (joined|left) the game/)  
       {
        visitors_remove($1); # Remove them from the watchlist
        print "[DEBUG] Removing $1 from watchlist\n";
        do_updates;
       }
 
    if ($input =~ /Connection broken/)
       {# Play a "noooo!" sound when someones connection breaks
        $console->{program}->put("snda M00FFIRE_002IN_GCF1_SND.WAV\n");
        do_updates;
       }
    if ($input =~ /Level loaded OK/)
       {
        do_updates;
       }

#pinfo
#Start PInfo output
#1,blazer0x,0,0,139,68.128.120.62;3995,7,1,0,0,350,-1.000000
#End PInfo output
        while ($input =~ /(\d+),(.+),(\d+),(\d+),(\d+),(\d+\.\d+\.\d+\.\d+);\d+,(\d+),(\d+),(\d+),(\d+),(\d+),(.+)/g)
           {
               my %player;
               $player{'id'} = $1;
               $player{'name'} = $2;
               $player{'score'} = $3;
               $player{'team'} = $4;
               $player{'ping'} = $5;
               $player{'ip'} = $6;
               $player{'kbs'} = $7;
               $player{'rank'} = $8;
               $player{'kills'} = $9;
               $player{'deaths'} = $10;
               $player{'credits'} = $11;
               $player{'kd'} = $12;
               print "\n[DEBUG]: pushing $player{'name'} into array\n";
               push @playerinfo_temp,\%player;
               print "[DEBUG]post-push: \@playerinfo_temp contains (@playerinfo_temp)\n";
           }

    if ($input =~ /End PInfo output/) #End of playerinfo
       {
#        print "\nDEBUG: Saw playerinfo footer\n";
        @playerinfo=@playerinfo_temp; #Swap in the newly collected data
#        print "[DEBUG]: \@playerinfo contains (@playerinfo) entries\n";
        @playerinfo_temp=(); # Make sure temp array is clean
#        print "DEBUG-arrayswitch: \@playerinfo now contains: @playerinfo\n";
       } 

#GLOG
#GameSpy mode active since Sun Mar 12 17:13:35 2006
#Gameplay Pending
#     Map : C&C_Field.mix
#    Time : 0.30.00
#     Fps : 56
#     GDI : 0/32 players      0 points
#     NOD : 0/32 players      0 points

   if ($input =~ /mode active since/) #Start of gameinfo
      { 
#       print "\nDEBUG: Saw gameinfo header\n";
       $glog=1;
      }
   if ($glog)
      {
       if ($input =~ /Map : (.+)/) {$gameinfo_temp{'map'}=$1;$MAPNAME=$1}
       if ($input =~ /Time : (.+)/) {$gameinfo_temp{'time'}=$1}
       if ($input =~ /Fps : (\d+)/) {$gameinfo_temp{'fps'}=$1}
       if ($input =~ /GDI : (\d+)\/\d+ players\s+(\d+) points/)
          {
            $gameinfo_temp{'gdiplayers'}=$1;
            $gameinfo_temp{'gdipoints'}=$2;
          }
       if ($input =~ /NOD : (\d+)\/\d+ players\s+(\d+) points/)
          {
#            print "\nDEBUG: Saw gameinfo footer\n";
            $gameinfo_temp{'nodplayers'}=$1;
            $gameinfo_temp{'nodpoints'}=$2;
            %gameinfo=%gameinfo_temp; #Swap in the newly collected info
            %gameinfo_temp=(); #Purge temp variable
            $glog=0;
            $heap->{program}->put("\nplayer_info\npinfo\n"); #Update all info
            BuildTopic;
            $xwis->{server}->put("TOPIC #$xwisnick $TOPIC");
          }
       }
}

### Handle SIGCHLD.  Shut down if the exiting child process was the
### one we've been managing.

sub handle_sigchld {
    my ( $heap, $child_pid ) = @_[ HEAP, ARG1 ];
    if ( $child_pid == $heap->{program}->PID ) {
        delete $heap->{program};
        delete $heap->{stdio};
        print "[XWISP] Hmmm...it looks like the FDS process has ended.\n";
        print "[XWISP] XWISP is shutting down.\n";
        print "[XWISP] Note: sometimes terminal settings get hosed upon exit. If you cannot see what you are typing, or other terminal weirdness, type \"reset\".\n";
        exit 1;
    }
    return 0;
}

####################
#   MAIN PROGRAM   #
####################
Init;
$ping=xwis_ping(); # Get ping to xwis
$ping=sprintf("%d",($ping/3.90625)); # Fit into one byte per ren source
$ping=dec2hex($ping); # Convert it to Hex
$pings="$ping"."$ping"."$ping"."$ping"."$ping"."$ping"."$ping"."$ping";
BuildTopic;
### Start a session to handle sub process
POE::Session->create
  ( inline_states =>
      { _start             => \&handle_start,
        _stop              => \&handle_stop,
        got_terminal_stdin => \&handle_terminal_stdin,
        got_child_stdout   => \&handle_child_stdout,
        got_sigchld        => \&handle_sigchld,
      },
  );
################
POE::Component::IRC->new("IRC"); # Initialize POE IRC
POE::Session->create
     (
     inline_states => {
       _start           => \&bot_start,
       irc_001          => \&on_welcome,
       irc_connected    => \&on_connect,
       irc_public       => \&on_public,
       irc_msg          => \&on_private,
       irc_disconnected => \&on_disconnect,
       irc_error        => \&on_error,
    },
   );
################
POE::Component::Client::TCP->new
    (
        BindAddress     => "$Server_Ini{'RemoteAdminIP'}",
        RemoteAddress   => $XWIS_Host,
        RemotePort      => $XWIS_Port,
        Connected       => \&XWIS_Login,
        Disconnected    => \&XWIS_Disconnected,
        ServerInput     => \&XWIS_Input,
        Alias           => "XWIS",
    );
################
POE::Session->create  # Check for channel idlers every 5 seconds
  ( inline_states =>
      { _start => sub {
            $_[KERNEL]->delay( tick => 5 );
        },
        tick => sub {
#            print "tick at ", time(), "\n";
            $_[KERNEL]->delay( tick => 5 );
            &visitors_reap;
        },
      },
  );
################
POE::Component::Server::TCP->new
  ( Alias            => "macrem",
    Address          => "$Server_Ini{'RemoteAdminIP'}",
    Port             => $Server_Ini{'RemoteAdminPort'},
    ClientConnected  => \&macrem_connect,
    ClientInput      => \&macrem_input,
    ClientDisconnected => \&macrem_disconnect,
  );
### Start POE's main loop, which runs the session until it's done.
$poe_kernel->run();
exit 1;