#!/usr/bin/perl

## CONFIGURABLE SETTINGS
my $serverIP=0x7f000001;
my $serverPort=2593;

my $numServers=2;
my $serverPrefix="Server #";

my $numCharacters=2;
my $charPrefix="Char #";

my $numLocations=3;
my $townPrefix="Loc #";
my $townDescPrefix="Desc #";

my $playerSerial=0x01000064;
my $playerBody=0x190;
my $playerX=420;
my $playerY=500;
my $playerZ=2;
my $playerDir=1;
my $playerFlags=0;
my $playerColor=0;

### END OF CONFIGURABLE SETTINGS

use IO::Socket;
use IO::Select;

my %status;

sub mainLoop
{
  $server=new IO::Socket::INET(Proto=>'tcp',
  	LocalPort=>$serverPort,
		Listen=>SOMAXCONN,
		Reuse=>1);

	die "server bind error" unless $server;


	$clients=new IO::Select($server);

	print "[Server $0 accepting clients]\n";
  while (1)
  {
    my @active=$clients->can_read;
    foreach $client (@active)
    {
      if ($client==$server) {
        $client=$client->accept;
  	    print "[".$client->peerhost."] Connected\n";
        $clients->add($client); 
        my (%obj)=(loggedin=>0); 
        $status{$client->peerport}=\%obj;
      }
      else
      {
        if (!handlePacket($client))
        {
  	      print "[".$client->peerhost."] Disconnected\n";
          $clients->remove($client);
          close($client);
        }
      }
    }
  }
  close $server;
}


sub handlePacket
{
  my ($client)=@_;
  if (!$status{$client->peerport}{loggedin})
	{
		return 0 if (!$client->read($id,4));
    $status{$client->peerport}{loggedin}=1;
	}
  return 0 if (!$client->read($packet,1));

  $packet=sprintf("%02X",ord($packet));
  eval("\$function=\\&packet$packet;");

  if (defined(&$function)) {&$function($client);} else
	{nopacket($packet,$client);}
#  eval("packet$packet(\$client);");
}

sub nopacket
{
  my ($packet,$client)=@_;
  print "Unknown Packet: $packet\n";
}

#walk
sub packet02
{
  my ($client)=@_;
  return 0 if (!$client->read($walk,6));
  $dir=ord(substr($walk,0,1));
  $seq=ord(substr($walk,1,2));
  @dirs=("North","Northeast","East","Southeast","South","Southwest","West","Northwest");
  print "[".$client->peerhost."] Walking ".$dirs[$dir]."\n";

# accept move request
  $packet=chr(0x22);
  $packet.=chr($seq);
  $packet.=chr(0);

# reject move request
#  $packet=chr(0x21);
#  $packet.=chr($seq);
#  $packet.=chr($newX>>8);
#  $packet.=chr($newX&255);
#  $packet.=chr($newY>>8);
#  $packet.=chr($newY&255);
#  $packet.=chr($newDir);
#  $packet.=chr($newZ);

  $client->send(compress($packet),0); 
}

#speech
sub packet03
{
  my ($client)=@_;
  return 0 if (!$client->read($size,2));
  return 0 if (!$client->read($mode,1));
  return 0 if (!$client->read($color,2));
  return 0 if (!$client->read($font,2));
  $size=getWord($size,0);
  return 0 if (!$client->read($text,$size-8));
  print "[".$client->peerhost."] \"$text\"\n";
}

#char selection
sub packet5D
{
  my ($client)=@_;
  return 0 if (!$client->read($edededed,4));
  return 0 if (!$client->read($unk,3));
  return 0 if (!$client->read($name,60));
  return 0 if (!$client->read($player,1));
  return 0 if (!$client->read($unk,4));
  print "[".$client->peerhost."] $charPrefix".(ord($player)+1)." joined\n";
#loginConfirm
	$packet=chr(0x1b);
	$packet.=chr(($playerSerial>>24)&255);
	$packet.=chr(($playerSerial>>16)&255);
	$packet.=chr(($playerSerial>>8)&255);
	$packet.=chr($playerSerial&255);
	$packet.=chr(0).chr(0).chr(0).chr(0);
	$packet.=chr($playerBody>>8); $packet.=chr($playerBody&255);
	$packet.=chr($playerX>>8); $packet.=chr($playerX&255);
	$packet.=chr($playerY>>8); $packet.=chr($playerY&255);
	$packet.=chr($playerZ>>8); $packet.=chr($playerZ&255);
	$packet.=chr($playerDir);
	$packet.=chr(0).chr(0).chr(0).chr(0x7f).chr(0).chr(0).chr(0).chr(0).chr(0).chr(7);
	$packet.=chr($playerFlags);
	$packet.=chr($playerColor>>8); $packet.=chr($playerColor&255);
	$packet.=chr(0).chr(0).chr(0).chr(0).chr(0).chr(0);
  $client->send(compress($packet),0); 

	$packet=chr(0x55);
	$client->send(compress($packet),0);

  message($client,"Welcome to UO Stub");

  return 1;
}

#login packet
sub packet80
{
  my ($client)=@_;

  return 0 if (!$client->read($username,30));
  return 0 if (!$client->read($password,30));
  return 0 if (!$client->read($tag,1));
  print "[".$client->peerhost."] $username signing on\n";
  $packet=chr(0xA8);
  $size=6+$numServers*40;
  $packet.=chr($size>>8);
  $packet.=chr($size&255);
  $packet.=chr(0xff);
  $packet.=chr($numServers>>8);
  $packet.=chr($numServers&255);
  for ($i=0;$i<$numServers;$i++)
  {
    $packet.=chr(($i+1)>>8);
    $packet.=chr(($i+1)&255);
    $serverName=$serverPrefix.($i+1);
    $packet.=$serverName;
    for ($j=length($serverName);$j<32;$j++)
    {
      $packet.=chr(0);
    }
    $packet.=chr(0x49);
    $packet.=chr(0x05);
    $packet.=chr($serverIP&255);
    $packet.=chr(($serverIP>>8)&255);
    $packet.=chr(($serverIP>>16)&255);
    $packet.=chr(($serverIP>>24)&255);
  }
  open F,">test";
  print F $packet;
  close F;
  $client->send($packet,0); 
  return 1;
}

#secondlogin
sub packet91
{
  my ($client)=@_;
  $status{$client->peerport}{compress}=1;
  return 0 if (!$client->read($ip,4));
  return 0 if (!$client->read($username,30));
  return 0 if (!$client->read($password,30));
  print "[".$client->peerhost."] $username logged in\n";
  $packet=chr(0xA9);
  $size=305+63*$numLocations;
  $packet.=chr($size>>8);
  $packet.=chr($size&255);
  $packet.=chr($numCharacters);
  for ($i=0;$i<$numCharacters;$i++)
  {
    $name=$charPrefix.($i+1);
    $packet.=$name;
    for ($j=length($name);$j<60;$j++)
    {
      $packet.=chr(0);
    }
  }
  for ($i=$numCharacters;$i<5;$i++)
  {
    for ($j=0;$j<60;$j++)
    {
      $packet.=chr(0);
    }
  }
  $packet.=$numLocations;
  for ($i=0;$i<$numLocations;$i++)
  {
    $packet.=chr($i);
    $name=$townPrefix.($i+1);
    $packet.=$name;
    for ($j=length($name);$j<30;$j++)
    {
      $packet.=chr(0);
    }
    $name=$townDescPrefix.($i+1);
    $packet.=$name;
    for ($j=length($name);$j<32;$j++)
    {
      $packet.=chr(0);
    }
  }
  open F,">test";
  print F $packet;
  close F;
  $client->send(compress($packet),0); 
  return 1;
}

#serverselection
sub packetA0
{
  my ($client)=@_;
  return 0 if (!$client->read($serverID,2));
  $serverID=getWord($serverID,0);
  print "[".$client->peerhost."] $serverPrefix".($serverID)." selected\n";
  $packet=chr(0x8c);
  $packet.=chr(($serverIP>>24)&255);
  $packet.=chr(($serverIP>>16)&255);
  $packet.=chr(($serverIP>>8)&255);
  $packet.=chr($serverIP&255);
  $packet.=chr($serverPort>>8);
  $packet.=chr($serverPort&255);
  $packet.=chr(($serverIP>>24)&255);
  $packet.=chr(($serverIP>>16)&255);
  $packet.=chr(($serverIP>>8)&255);
  $packet.=chr($serverIP&255);

  $client->send($packet,0); 
  return 1;
}

sub message
{
  my ($client,$msg)=@_;
  $msg.=chr(0);
  $packet=chr(0x1c);
  $size=14+30+length($msg);
  $packet.=chr($size>>8);
  $packet.=chr($size&255);
  $packet.=chr(0xff).chr(0xff).chr(0xff).chr(0xff);  #speaker id
  $packet.=chr(0xff).chr(0xff);  #speaker model
  $packet.=chr(0x6);  # type
  $packet.=chr(0x00); $packet.=chr(0x40); # color
  $packet.=chr(0x00); $packet.=chr(0x03); # font
  $name="System";
  $packet.=$name;
  for ($i=length($name);$i<30;$i++)
  {
    $packet.=chr(0x00);
  } 
  $packet.=$msg;

  $client->send(compress($packet),0); 
  return 1;
}

sub getWord
{
  my $str=shift;
  my $offset=shift;
  my $a1=substr($str,$offset,1);
  my $a2=substr($str,$offset+1,1);
  my $wd=(ord($a1)<<8)|ord($a2);
  $wd;
}


my @bitTable=(
0x02, 0x00,     0x05, 0x1F,     0x06, 0x22,     0x07, 0x34,     0x07, 0x75,     0x06, 0x28,     0x06, 0x3B,     0x07, 0x32,
        0x08, 0xE0,     0x08, 0x62,     0x07, 0x56,     0x08, 0x79,     0x09, 0x19D,    0x08, 0x97,     0x06, 0x2A,     0x07, 0x57,
        0x08, 0x71,     0x08, 0x5B,     0x09, 0x1CC,    0x08, 0xA7,     0x07, 0x25,     0x07, 0x4F,     0x08, 0x66,     0x08, 0x7D,
        0x09, 0x191,    0x09, 0x1CE,    0x07, 0x3F,     0x09, 0x90,     0x08, 0x59,     0x08, 0x7B,     0x08, 0x91,     0x08, 0xC6,
        0x06, 0x2D,     0x09, 0x186,    0x08, 0x6F,     0x09, 0x93,     0x0A, 0x1CC,    0x08, 0x5A,     0x0A, 0x1AE,    0x0A, 0x1C0,
        0x09, 0x148,    0x09, 0x14A,    0x09, 0x82,     0x0A, 0x19F,    0x09, 0x171,    0x09, 0x120,    0x09, 0xE7,     0x0A, 0x1F3,
        0x09, 0x14B,    0x09, 0x100,    0x09, 0x190,    0x06, 0x13,     0x09, 0x161,    0x09, 0x125,    0x09, 0x133,    0x09, 0x195,
        0x09, 0x173,    0x09, 0x1CA,    0x09, 0x86,     0x09, 0x1E9,    0x09, 0xDB,     0x09, 0x1EC,    0x09, 0x8B,     0x09, 0x85,
        0x05, 0x0A,     0x08, 0x96,     0x08, 0x9C,     0x09, 0x1C3,    0x09, 0x19C,    0x09, 0x8F,     0x09, 0x18F,    0x09, 0x91,
        0x09, 0x87,     0x09, 0xC6,     0x09, 0x177,    0x09, 0x89,     0x09, 0xD6,     0x09, 0x8C,     0x09, 0x1EE,    0x09, 0x1EB,
        0x09, 0x84,     0x09, 0x164,    0x09, 0x175,    0x09, 0x1CD,    0x08, 0x5E,     0x09, 0x88,     0x09, 0x12B,    0x09, 0x172,
        0x09, 0x10A,    0x09, 0x8D,     0x09, 0x13A,    0x09, 0x11C,    0x0A, 0x1E1,    0x0A, 0x1E0,    0x09, 0x187,    0x0A, 0x1DC,
        0x0A, 0x1DF,    0x07, 0x74,     0x09, 0x19F,    0x08, 0x8D,             0x08, 0xE4,     0x07, 0x79,     0x09, 0xEA,     0x09, 0xE1,
        0x08, 0x40,     0x07, 0x41,     0x09, 0x10B,    0x09, 0xB0,     0x08, 0x6A,     0x08, 0xC1,     0x07, 0x71,     0x07, 0x78,
        0x08, 0xB1,     0x09, 0x14C,    0x07, 0x43,     0x08, 0x76,     0x07, 0x66,     0x07, 0x4D,     0x09, 0x8A,     0x06, 0x2F,
        0x08, 0xC9,             0x09, 0xCE,     0x09, 0x149,    0x09, 0x160,    0x0A, 0x1BA,    0x0A, 0x19E,    0x0A, 0x39F,    0x09, 0xE5,
        0x09, 0x194,    0x09, 0x184,    0x09, 0x126,    0x07, 0x30,     0x08, 0x6C,     0x09, 0x121,    0x09, 0x1E8,    0x0A, 0x1C1,
        0x0A, 0x11D,    0x0A, 0x163,    0x0A, 0x385,    0x0A, 0x3DB,    0x0A, 0x17D,    0x0A, 0x106,    0x0A, 0x397,    0x0A, 0x24E,
        0x07, 0x2E,     0x08, 0x98,     0x0A, 0x33C,    0x0A, 0x32E,    0x0A, 0x1E9,    0x09, 0xBF,     0x0A, 0x3DF,    0x0A, 0x1DD,
      0x0A, 0x32D,    0x0A, 0x2ED,    0x0A, 0x30B,    0x0A, 0x107,    0x0A, 0x2E8,    0x0A, 0x3DE,    0x0A, 0x125,    0x0A, 0x1E8,
        0x09, 0xE9,     0x0A, 0x1CD,    0x0A, 0x1B5,    0x09, 0x165,    0x0A, 0x232,    0x0A, 0x2E1,    0x0B, 0x3AE,    0x0B, 0x3C6,
       0x0B, 0x3E2,    0x0A, 0x205,    0x0A, 0x29A,    0x0A, 0x248,    0x0A, 0x2CD,    0x0A, 0x23B,    0x0B, 0x3C5,    0x0A, 0x251,
        0x0A, 0x2E9,    0x0A, 0x252,    0x09, 0x1EA,    0x0B, 0x3A0,    0x0B, 0x391,    0x0A, 0x23C,    0x0B, 0x392,    0x0B, 0x3D5,
        0x0A, 0x233,    0x0A, 0x2CC,    0x0B, 0x390,    0x0A, 0x1BB,    0x0B, 0x3A1,    0x0B, 0x3C4,    0x0A, 0x211,    0x0A, 0x203,
        0x09, 0x12A,    0x0A, 0x231,    0x0B, 0x3E0,    0x0A, 0x29B,    0x0B, 0x3D7,    0x0A, 0x202,    0x0B, 0x3AD,    0x0A, 0x213,
        0x0A, 0x253,    0x0A, 0x32C,    0x0A, 0x23D,    0x0A, 0x23F,    0x0A, 0x32F,    0x0A, 0x11C,    0x0A, 0x384,    0x0A, 0x31C,
        0x0A, 0x17C,    0x0A, 0x30A,    0x0A, 0x2E0,    0x0A, 0x276,    0x0A, 0x250,    0x0B, 0x3E3,    0x0A, 0x396,    0x0A, 0x18F,
        0x0A, 0x204,    0x0A, 0x206,    0x0A, 0x230,    0x0A, 0x265,    0x0A, 0x212,    0x0A, 0x23E,    0x0B, 0x3AC,    0x0B, 0x393,
        0x0B, 0x3E1,    0x0A, 0x1DE,    0x0B, 0x3D6,    0x0A, 0x31D,    0x0B, 0x3E5,    0x0B, 0x3E4,    0x0A, 0x207,    0x0B, 0x3C7,
        0x0A, 0x277,    0x0B, 0x3D4,    0x08, 0xC0,             0x0A, 0x162,    0x0A, 0x3DA,    0x0A, 0x124,    0x0A, 0x1B4,    0x0A, 0x264,
    0x0A, 0x33D,    0x0A, 0x1D1,    0x0A, 0x1AF,    0x0A, 0x39E,    0x0A, 0x24F,    0x0B, 0x373,    0x0A, 0x249,    0x0B, 0x372,
        0x09, 0x167,    0x0A, 0x210,    0x0A, 0x23A,    0x0A, 0x1B8,    0x0B, 0x3AF,    0x0A, 0x18E,    0x0A, 0x2EC,    0x07, 0x62,
        0x04, 0x0D
);

sub compress
{
  my ($in)=@_;
  my $len=length($in);
  my $offset=0;
  my $out="";
  my $outP=0;
  my $bit=0;

  while ($len--)
  {
    $byte=ord(substr($in,$offset,1));
    $offset++;
    $bits=$bitTable[$byte*2];
    $value=$bitTable[$byte*2+1];
    while ($bits--)
    {
      $outP<<=1;
      $outP|=($value>>$bits)&1;
      $bit=($bit+1)&7;
      if (!$bit) { $out.=chr($outP); $outP=0; }
    }
  }
  $bits=$bitTable[256*2];
  $value=$bitTable[256*2+1];
  while ($bits--)
  {
    $outP<<=1;
    $outP|=($value>>$bits)&1;
    $bit=($bit+1)&7;
    if (!$bit) { $out.=chr($outP); $outP=0; }
  }
  if ($bit)
  {
    while ($bit<8)
    {
      $outP<<=1;
      $bit++;
    }
    $out.=chr($outP);
  }
  $out;
}

mainLoop();