$ ./server.pl 18359 PrlServerAPI/Server
PrlServerAPI/J02
Copyright Matthew Caswell, 2012
set up hostname PrlServerAPI/Server
createServer-socket ()
createServer-setsockopt ()
createServer-bin ()
Use of uninitialized value in subroutine entry at /usr/lib/perl5/5.10/i686-cygwin/Socket.pm line 386.
Bad arg length for Socket::pack_sockaddr_in, length is 0, should be 4 at /usr/lib/perl5/5.10/i686-cygwin/Socket.pm line 3866.

#!/usr/bin/perl -w
#$Source: Volumes://MATEOR/prlserverapi/server.pl$
#$Revision: 0.01-0a$
#$Date: January 02, 2013$
#
#-------------
# PrlServerAPI Copyright Matthew Caswell, 2012
#-------------
#

use strict;
use Socket;
use Storable;
use Define;
use PrlServer::API qw( $API_release );

my $SERVER = PrlServer::API->new (
  proto => 'tcp',
  host => $ARGV[1],
  port => $ARGV[0],
  ip => 127.0.0.1,
);

$SERVER->debugOn ();
#$SERVER->debug ($SERVER->{ipOfServer});
#$SERVER->debug (127.0.0.1);

$SERVER->{account} = retrieve ('psalogin.rc');
$SERVER->{AUTH} = retrieve ('psauser.rc');
$SERVER->{DECOY} = {
  AUTH => retrieve ('psauser.rc')
};

my($ebp, $esp, $ebx, $eax, $esi, $edi, $efs, $egs, $ecx, $eci, $edp);

unless ($#ARGV == 1) {
  die "usage: $0 <port> <hostname>\n";
}

$ebp = &Define::String($ebp, '0:1', 'LOGIC');
$ebp = &Define::String($ebp, '0', 'LOGIC}->{LOW');
$ebp = &Define::String($ebp, '1', 'LOGIC}->{HIGH');

$esp = &Define::String($esp, 0x0F, 'HALT');
$esp = &Define::String($esp, 0xFF, 'NO}->{SE}->{PERMITE');

print STDERR "PrlServerAPI/$API_release\nCopyright Matthew Caswell, 2012\n";


if (defined $SERVER->{serverHost}) {
  print STDERR "Set up hostname \e[0;36m$SERVER->{serverHost}\e[0m\n";
} else {
  die "Could not set up host name!  Have you run the \"hostname.pl\" utility yet?\n";
}

$SERVER->createServer ();

print STDERR "PrlServerAPI server \e[1;32mstarted\e[0m on port \e[0;35m$SERVER->{serverPort}\e[0m\n";

my $client;
my $line = 0;
THREADED:
while (1) {
  my $in = $SERVER->serverPortIn ();
  if (defined $in) {
    if ($in == 0x00) {
      print STDERR "Client connected.\n";
      $line = 1;
    } elsif ($in == 0x01) {
      print STDERR "Client disconnected.\n";
      $line = 0;
      print STDERR "Restarting thread...\n";
      last THREADED if defined $SERVER->{serverHost};
    } elsif ($in == 0x02) {
      $line = 2;
    }
  }else{
    print STDERR "\$in undef\n";
  }

  
  if ($line == 1) {
    $SERVER->serverPortOut ("You have connected to PrlServerAPI server at \e[0;35m");
    
    $SERVER->serverPortOut ($SERVER->{serverHost});
    
    $SERVER->serverPortOut ("\e[0m!\nThe server is running PrlServerAPI " . $API_release);

    $line = 0;
  } elsif ($line == 2 && defined $in) {
    my(@istream) = split(/\$/, $SERVER->serverPortIn ());
    $in = $istream[0];
    $SERVER->{uin} = $istream[1];
    print STDERR "\e[0;36m$SERVER->{uin}\e[0m issued command '$in'\n";
    
    if ($in eq 'help') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'help'\n";
      $SERVER->serverPortOut ("<SERVER>: help\nver\nwhatisthis\nexit\nhostname\nsendmsg\n" .
        "whatport\ncopyright\nlogin\n\@NEW_ACCOUNT\n\@PASSWD\n" .
        "\@GOTMAIL?\n\@GETMAIL\nhalt\n\@EMPTYMAIL\nstart\n");
      $line = 0;
    } elsif ($in eq 'ver') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'ver'\n";
      $SERVER->serverPortOut ("<SERVER>: PrlServerAPI release " . $API_release . ".\n");
      $line = 0;
    } elsif ($in eq 'whatisthis') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'whatisthis'\n";
      $SERVER->serverPortOut ("<SERVER>: I am running PrlServerAPI/" . $API_release . ".\n");
      $line = 0;
    } elsif ($in eq 'exit') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'exit'\n";
      $SERVER->serverPortOut ("\e[1;31m<SOCKET>: Killing your session...\e[0m\n<SOCKET>: Waiting for client to send 0x01...\n");
      $line = 0;
      print "Waiting for client to send 0x01...\n";
    } elsif ($in eq 'hostname') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'hostname'\n";
      $SERVER->serverPortOut ("<SERVER>: \e[0;36m$SERVER->{serverHost}\e[0m\n");
      $line = 0;
    } elsif ($in eq 'sendmsg') {
      print STDERR "*= \e[0;36m$SERVER->{uin}\e[0m is typing =*\n";
      $in = $SERVER->serverPortIn ();
      print STDERR "\e[1;31m$in\e[0m";
      $line = 0;
    } elsif ($in eq 'whatport') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'whatport'\n";
      $SERVER->serverPortOut ("<SERVER>: Port: \e[0;35m$SERVER->{serverPort}\e[0m\n");
      $line = 0;
    } elsif ($in eq 'copyright') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'copyright'\n";
      $SERVER->serverPortOut ("PrlServerAPI Copyright Matthew Caswell, 2013\n");
      $line = 0;
    } elsif ($in eq 'login') {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'login'\n";
      $SERVER->serverPortOut ("\e[1;34mlogin: ");
      $SERVER->{login}->{user} = $SERVER->serverPortIn ();
      chomp $SERVER->{login}->{user};
      print "\e[1;34mUsername: $SERVER->{login}->{user}\e[0m\n";
      if ($SERVER->{account}->{$SERVER->{login}->{user}}) {
        $SERVER->serverPortOut ("\e[1;42mpassword: \n8");
        
        $SERVER->{login}->{pw} = $SERVER->serverPortIn ();
        chomp $SERVER->{login}->{pw};
        
        if ($SERVER->{account}->{$SERVER->{login}->{user}} eq 
          $SERVER->{login}->{pw}) {
          $SERVER->serverPortOut ("\e[0m<SERVER>: \e[1;32mLogin successful.\e[0m\n1");
          $SERVER->{AUTH}->{$SERVER->{login}->{user}} = &Define::pull($ebp, 'LOGIC}->{HIGH');
          $line = 0;
        } else {
          print "\e[1;31mFailed login...\e[0m\n";
          $SERVER->serverPortOut ("\e[1;31m<SERVER>: Invalid password\e[0m\n-1");
          $line = 0;
        }
      } else {
        print "\e[1;31mFailed login...\e[0m\n";
        $SERVER->serverPortOut ("\e[1;31m<SERVER>: Invalid username\e[0m\n-1");
        $line = 0;
      }
    } elsif ($in eq "\@NEW_ACCOUNT") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command '\@NEW_ACCOUNT'\n";
      if ($SERVER->{AUTH}->{$SERVER->{uin}} == (&Define::pull($ebp, 'LOGIC}->{HIGH'))) {
        $SERVER->serverPortOut ("New user form:\n1");
        
        my @new = split(/\?/, $SERVER->serverPortIn ());
        my @contrasena = split(/\$/, $new[1]);
        $SERVER->{account}->{$new[0]} = $contrasena[0];
        print "\$SERVER->{account}->{$new[0]} = $contrasena[0];.\n";
        print "Writing data...\n";
        store $SERVER->{account}, 'psalogin.rc';
        $SERVER->{AUTH}->{$new[0]} = $SERVER->{DECOY}->{AUTH}->{$new[0]} = &Define::pull($ebp, 'LOGIC}->{LOW');
        store $SERVER->{DECOY}->{AUTH}, 'psauser.rc';
        $line = 0;
      } else {
        print "Client does not have clearance\n";
        $SERVER->serverPortOut ("\e[1;31mAccess Denied\e[0m\n0");
        $line = 0;
      }
    } elsif ($in eq "\@PASSWD") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command '\@PASSWD'\n";
      if ($SERVER->{AUTH}->{$SERVER->{uin}} == (&Define::pull($ebp, 'LOGIC}->{HIGH'))) {
        $SERVER->serverPortOut ("0x08\\Old password: ");
        my $old_user = $SERVER->serverPortIn ();
        print $old_user;
        if ($SERVER->{account}->{$SERVER->{uin}} eq $old_user) {
          print "[DEBUG]: CORRECT PASSW\n";
          $SERVER->serverPortOut ("0x08\\New password: ");
          my($new_user) = $SERVER->serverPortIn ();
          $SERVER->{account}->{$SERVER->{uin}} = $new_user;
          store $SERVER->{account}, 'psalogin.rc';
          $SERVER->serverPortOut ("<SERVER>: Done.\n");
        } else {
          $SERVER->serverPortOut ("0xFF\\<SERVER>: Wrong password.\n");
        }
      } else {
        $SERVER->serverPortOut ("0xFF\\<SERVER>: You are not logged in!\n");
      }
    } elsif ($in eq "\@GOTMAIL?") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command '\@GOTMAIL?'\n";
      my $MAIL = retrieve("AmericanMail.rc");
      if ($MAIL->{GETCH} == 0x04) {
        $SERVER->serverPortOut ("Yes.\n");
      } else {
        $SERVER->serverPortOut ("No.\n");
      }
      $line = 0;
    } elsif ($in eq "\@GETMAIL") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command '\@GETMAIL'\n";
      my $MAIL = retrieve("AmericanMail.rc");
      $SERVER->serverPortOut ("TO: $MAIL->{TO}\nFROM: $MAIL->{FROM}\n\n\t$MAIL->{BODY}\n");
      $line = 0;
    } elsif ($in eq "halt") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'halt'\n";
      if ($SERVER->{AUTH}->{$SERVER->{uin}} == (&Define::pull($ebp, 'LOGIC}->{HIGH'))) {
        $SERVER->serverPortOut ("<SERVER>: Halting server...\n");
        $SERVER->serverPortOut (&Define::pull($esp, 'HALT'));
        $line = 0;
        exit;
      } else {
        print "Client does not have clearance\n";
        $SERVER->serverPortOut ("<SERVER>: \e[1;31mAccess Denied.\e[0m  Login in first.\n");
        $SERVER->serverPortOut (&Define::pull($esp, 'NO}->{SE}->{PERMITE'));
        $line = 0;
      }
    } elsif ($in eq "\@EMPTYMAIL") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command '\@EMPTYMAIL'\n";
      my $zzz = `./emptymail.pl`;
      $SERVER->serverPortOut ("<SERVER>: Mail emptied.\n");
      $line = 0;
    } elsif ($in eq "start") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'start'\n";
      $SERVER->serverPortOut ("<SERVER Iniciando proc>\n");
      my $proc = $SERVER->serverPortIn ();
      my $shell = `$proc`;
      $line = 0;
    } elsif ($in eq "logout") {
      print "\e[0;36m$SERVER->{uin}\e[0m issued command 'logout'\n";
      if ($SERVER->{AUTH}->{$SERVER->{uin}} == (&Define::pull($ebp, 'LOGIC}->{HIGH'))) {
        print "Logging out \e[0;36m$SERVER->{uin}\e[0m...\n";
        $SERVER->{AUTH}->{$SERVER->{uin}} = &Define::pull($ebp, 'LOGIC}->{LOW');
        $SERVER->serverPortOut ("<SERVER>: Logged out.\n");
        $line = 0;
      } elsif ($SERVER->{AUTH}->{$SERVER->{uin}} == (&Define::pull($ebp, 'LOGIC}->{LOW'))) {
        print "Not logged in.\n";
        $SERVER->serverPortOut ("<SERVER>: You are not logged in!\n");
        $line = 0;
      }
    }
      else {
      print "\e[0;36m$SERVER->{uin}\e[0m issued an invalid command '$in'\n";
      $SERVER->serverPortOut ("<SERVER>: Invalid command.\n");
      $line = 0;
    }
  }
} goto THREADED;

#posib() API.pm - Written by Matthew Caswell
#posib() Date: January 02, 2013
#posib() ------------
#posib() PrlServerAPI Copyright Matthew Caswell, 2013
#posib() ------------
#posib() This module contains the PrlServerAPI port functions.

package PrlServer::API;
use Exporter 'import';
our(@EXPORT_OK);
@EXPORT_OK = qw( $API_release );
use strict;
use warnings 'all';
use Socket;

our $API_release = "J02";

sub new{
  my($namespace, %args) = @_;
  
  my $class = {
    serverProtocol => (getprotobyname ($args{proto}))[2],
    serverHost => $args{host},
    serverPort => $args{port},
    ipOfServer => $args{ip},
    debug => 0
  };
  
  bless $class, 'PrlServer::API';
  
  $class->debug ("Created new PrlServer::API object\n");
  
  return $class;
}

sub createServer{
  my($self) = shift;
  
  $self->debug ("createServer-socket ()\n");
  socket ($self->{'SOCKET'}, PF_INET, SOCK_STREAM, $self->{serverProtocol})
    or die "Can't open socket!\n";
  
  $self->debug ("createServer-setsockopt ()\n");
  setsockopt ($self->{'SOCKET'}, SOL_SOCKET, SO_REUSEADDR, 1)
    or die "Can't set socket SO_REUSEADDR.\n";
  
  $self->debug ("createServer-bind ()\n");
  bind ($self->{'SOCKET'}, sockaddr_in ($self->{serverPort}, inet_aton ($self->{ipOfServer})))
    or die "Couldn't bind to port " . $self->{serverPort} . "\n";
  
  $self->debug ("createServer-listen ()\n");
  listen ($self->{'SOCKET'}, 5)
    or die "listen: $!\n";
}

sub serverPortIn{
  my($this) = shift;
  
  $this->debug ("serverPortIn-accept ()\n");
  my $in = accept (NET_SOCKET, $this->{'SOCKET'});
  
  $this->debug ("serverPortIn-<> \n");
  $this->{acceptReturned} = <NET_SOCKET>;
  
  $this->debug ("serverPortIn-close ()\n");
  close NET_SOCKET;
  
  $this->debug ("serverPortIn-return ()\n");
  return $this->{acceptReturned};
}

sub serverPortOut{
  my($this, $data) = @_;
  
  $this->debug ("serverPortOut-accept ()\n");
  my $out = accept (NET_SOCKET, $this->{'SOCKET'});
  
  $this->debug ("serverPortOut-print ()\n");
  print NET_SOCKET $data;
  
  $this->debug ("serverPortOut-close ()\n");
  close NET_SOCKET;
}

sub clientPortIn{
  my($this) = shift;
  
  my $bytes;
  
  $this->debug ("clientPortIn-socket ()\n");
  socket ($this->{'SOCKET'}, PF_INET, SOCK_STREAM, $this->{serverProtocol})
    or die "Can't create socket $!\n";
  
  $this->debug ("clientPortIn-connect ()\n");
  connect ($this->{'SOCKET'}, sockaddr_in ($this->{serverPort}, inet_aton ($this->{ipOfServer})))
    or die "Can't connect to port " . $this->{serverPort} . "\n";
  
  $this->debug ("clientPortIn-reassign\n");
  my $socket = $this->{'SOCKET'};
  
  $this->debug ("clientPortIn-read\n");
  while(<$socket>){
    $bytes .= $_;
  }
  
  $this->debug ("clientPortIn-close ()\n");
  close $this->{'SOCKET'};
  
  $this->debug ("clientPortIn-return ()\n");
  return $bytes;
}

sub clientPortOut{
  my($this, $data) = @_;
  
  $this->debug ("clientPortOut-socket ()\n");
  socket ($this->{'SOCKET'}, PF_INET, SOCK_STREAM, $this->{serverProtocol})
    or die "Can't create socket $!\n";
  
  $this->debug ("$this->{serverPort}\n");
  $this->debug ("$this->{ipOfServer}\n");
  $this->debug ("clientPortOut-connect ($this->{serverPort}, $this->{ipOfServer})\n");
  connect ($this->{'SOCKET'}, sockaddr_in ($this->{serverPort}, $this->{ipOfServer}))
    or die "Can't connect to port " . $this->{serverPort} . "\n";

  $this->debug ("clientPortOut-print ()\n");
  print {$this->{'SOCKET'}} $data;
  
  $this->debug ("clientPortOut-close ()\n");
  close $this->{'SOCKET'};
}

sub debug{
  my($this, $dbg) = @_;
  
  print STDERR $dbg if $this->{debug} == 1;
}

sub debugOff{
  my($this) = shift;
  
  $this->{debug} = 0;
}

sub debugOn{
  my($this) = shift;
  
  $this->{debug} = 1;
}

1;