#!/usr/bin/perl -wT
use strict;
use IO::Socket;
use IO::Select;
use lib 'lib';
use Interface6051::LinuxHack;
use Locomotive;
use Data::Dumper;

$ENV{PATH} = '/usr/bin:/bin';
local $SIG{PIPE} = 'IGNORE';

my $VERSION = '0.2';
my $verbose = 0;
print "Train Operations Protocol Server $VERSION\n";

my $switchDataName = 'switches.dat';

my $interface = new Interface6051::LinuxHack;
my $trains = {};
my $switches = {};
my $sensors = {};
my $paused = 0;
my $uncoupler = undef;

if (-f $switchDataName) {
    print "Reading state...\n";
    open(my $switchData, '<', $switchDataName) or die "Could not read switch states: $!\n";
    local $/ = undef;
    my $data = <$switchData>;
    $data =~ m/^(.*)$/os;
    $switches = eval $1;
    close($switchData);
    foreach my $switch (keys %$switches) {
        print "SWITCH $switch $switches->{$switch}\n";
        $interface->switch($switch, $switches->{$switch} eq 'OPEN');
    }
}
my $active = 1;
$SIG{'HUP'} = $SIG{'INT'} = $SIG{'TERM'} = sub { $active = 0; };

my $server = IO::Socket::INET->new(LocalPort => 6051, Proto => 'tcp', Listen => 5, ReuseAddr => 1);
die "Could not establish listening socket: $! $@\n" unless $server;
my $sockets = IO::Select->new($server);
my $clients = {};

print "Server ready.\n";
while ($active) {
    print "." if $verbose;
    my @pendingData = $sockets->can_read(1.0);
    foreach my $socket (@pendingData) {
        if ($socket == $server) {
            $socket = $server->accept;
            if ($socket) {
                $socket->syswrite("TOP2 Train Server $VERSION\n");
                $sockets->add($socket);
                my $ip = $socket->peerhost . ':' . $socket->peerport;
                $clients->{$socket->fileno} = {
                    buffer => '',
                    state => 0,
                    socket => $socket,
                    ip => $ip,
                    name => 'unknown',
                    user => '',
                };
                # print "$ip: Connecting...\n";
            } else {
                print "Error while accepting connection: $!\n";
            }
        } else {
            eval {
                my $client = $clients->{$socket->fileno};
                my $data = '';
                $socket->sysread($data, 1) or die "$client->{ip} ($client->{name}): Connection closed.\n";
                if ($data eq "\n") {
                    print "$client->{ip} ($client->{name}): Received '$client->{buffer}'\n";
                    my($reply, $close) = process($client);
                    $client->{buffer} = '';
                    print "$client->{ip} ($client->{name}): Sending 'ERROR $reply'\n" if defined $reply;
                    $socket->syswrite("ERROR $reply\n") if defined $reply;
                    die "$client->{ip} ($client->{name}): Connection closed.\n" if $close;
                } else {
                    $clients->{$socket->fileno}->{buffer} .= $data;
                }
            };
            if ($@) {
                warn "$@";
                $sockets->remove($socket);
                $socket->shutdown(2) if $socket->connected; # close socket
                close($socket);
            }
        }
    }
    if (not @pendingData) {
        my $lastSensors = $sensors;
        $sensors = {};
        foreach my $sensor (getSensors()) {
            if ($lastSensors->{$sensor}) {
                broadcast("SENSOR $sensor ON STILL");
            } else {
                broadcast("SENSOR $sensor ON");
            }
            $sensors->{$sensor} = 1;
            delete $lastSensors->{$sensor};
        }
        foreach my $sensor (keys %$lastSensors) {
            broadcast("SENSOR $sensor OFF");
        }
        if ($interface->resetSolenoids() and $uncoupler) {
            broadcast("UNCOUPLER $uncoupler OFF");
            broadcast("UNCOUPLER OFF");
            $uncoupler = undef;
        }
    }
}

print "Terminating and saving state...\n";

$server->shutdown(2); # close socket

open(my $switchData, '>', $switchDataName) or die "Could not save switch states: $!\n";
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 0;
print $switchData Data::Dumper->Dump([$switches]);
close($switchData);

print "Server terminated.\n";

sub broadcast {
    my($message, $exception) = @_;
    $exception = 0 unless defined $exception;
    print "Broadcasting: $message\n";
    foreach my $socket ($sockets->handles) {
        $socket->syswrite("$message\n") if $socket != $server and $socket->connected and $exception != $socket;
    }
}

sub process {
    my($client) = @_;
    my $message = $client->{buffer};
    if ($client->{state} == 0) {
        if ($message =~ m/^TOP2 (.+)$/os) {
            $client->{name} = $1;
        } else {
            return ('Incorrect handshake (expected TOP2). Disconnecting.', 1);
        }
        $client->{state} = 1;
    } elsif ($client->{state} == 1) {
        if ($message =~ m/^USER (.+)$/os) {
            $client->{user} = $1;
        } else {
            return ('Incorrect handshake (expected USER). Disconnecting.', 1);
        }
        $client->{state} = 2;
    } elsif ($client->{state} == 2) {
        if ($message =~ m/^PASSWORD (.+)$/os) {
            # XXX for now accept all connections
            # return ('Incorrect password. Disconnecting.', 1);
        } else {
            return ('Incorrect handshake (expected PASSWORD). Disconnecting.', 1);
        }
        $client->{state} = 3;
    } elsif ($client->{state} == 3) {
        if ($message eq 'STATUS') {
            print "$client->{ip} ($client->{name}): Transmitting state data.\n";
            foreach my $n (keys %$switches) {
                $client->{socket}->syswrite("SWITCH $n $switches->{$n}\n");
            }
            if ($uncoupler) {
                $client->{socket}->syswrite("UNCOUPLER $uncoupler ON\n");
            }
            foreach my $n (keys %$trains) {
                $client->{socket}->syswrite("REVERSE $n\n") if $trains->{$n}->direction;
                $client->{socket}->syswrite(sprintf("SPEED $n %d\n", $trains->{$n}->speed));
                $client->{socket}->syswrite(sprintf("FUNCTION $n 0 %s\n", $trains->{$n}->f0 ? 'ON' : 'OFF'));
                $client->{socket}->syswrite(sprintf("FUNCTION $n 1 %s\n", $trains->{$n}->f1 ? 'ON' : 'OFF'));
                $client->{socket}->syswrite(sprintf("FUNCTION $n 2 %s\n", $trains->{$n}->f2 ? 'ON' : 'OFF'));
                $client->{socket}->syswrite(sprintf("FUNCTION $n 3 %s\n", $trains->{$n}->f3 ? 'ON' : 'OFF'));
                $client->{socket}->syswrite(sprintf("FUNCTION $n 4 %s\n", $trains->{$n}->f4 ? 'ON' : 'OFF'));
            }
            if ($paused) {
                $client->{socket}->syswrite("STOP\n");
            } else {
                $client->{socket}->syswrite("GO\n");
            }
        } elsif ($message =~ m/^PING( .*)?$/) {
            my $data = $1 || '';
            $client->{socket}->syswrite("PONG$data\n");
        } elsif ($message =~ m/^MESSAGE (.+)$/os) {
            broadcast("MESSAGE $1", $client);
        } elsif ($message eq 'STOP') {
            $interface->stop();
            broadcast('STOP');
            if ($uncoupler) {
                broadcast('UNCOUPLER OFF');
                broadcast("UNCOUPLER $uncoupler OFF");
                $uncoupler = undef;
            }
            $paused = 1;
        } elsif ($message eq 'GO') {
            $interface->start();
            broadcast('GO');
            $paused = 0;
        } elsif ($message =~ m/^SWITCH ([0-9]+) (OPEN|CLOSED)$/os) {
            my $switch = $1;
            my $state = $2;
            return ('Incorrect switch designation.', 0) if $switch < 1 or $switch > 256;
            $interface->switch($switch, $state eq 'OPEN');
            broadcast("SWITCH $switch $state");
            $switches->{$switch} = $state;
        } elsif ($message =~ m/^UNCOUPLER ([0-9]+) (RED|GREEN)$/os) {
            my $id1 = $1;
            my $id2 = $2;
            return ('Incorrect uncoupler designation.', 0) if $id1 < 1 or $id1 > 256;
            $interface->uncoupler($id1, $id2 eq 'RED');
            broadcast("UNCOUPLER $id1 $id2");
            if ($uncoupler) {
                broadcast("UNCOUPLER $uncoupler OFF");
            }
            $uncoupler = "$id1 $id2";
            broadcast("UNCOUPLER $uncoupler ON");
        } elsif ($message =~ m/^UNCOUPLER OFF$/os) {
            broadcast('UNCOUPLER OFF');
            if ($uncoupler) {
                $interface->uncouplerOff();
                broadcast("UNCOUPLER $uncoupler OFF");
                $uncoupler = undef;
            }
        } elsif ($message =~ m/^SPEED ([0-9]+) ([0-9]+)$/os) {
            my $train = $1;
            unless ($train = getTrain($train)) {
                return ('Incorrect train designation.', 0);
            }
            my $speed = $2;
            return ('Incorrect speed designation.', 0) if $speed > 14;
            $train->speed($speed);
            broadcast("SPEED $train $speed");
        } elsif ($message =~ m/^REVERSE ([0-9]+)$/os) {
            my $train = $1;
            unless ($train = getTrain($train)) {
                return ('Incorrect train designation.', 0);
            }
            $train->invert();
            broadcast("SPEED $train 0");
            broadcast("REVERSE $train");
        } elsif ($message =~ m/^FUNCTION ([0-9]+) ([0-4]) (ON|OFF)$/os) {
            my $train = $1;
            unless ($train = getTrain($train)) {
                return ('Incorrect train designation.', 0);
            }
            my $function = $2;
            my $state = $3;
            my $f = "f$function";
            $train->$f($state eq 'ON');
            broadcast("FUNCTION $train $function $state");
        } else {
            return ('Unrecognised command.', 0);
        }
    }  else {
        return ('Internal server error (bogus internal state). Disconnecting.', 1);
    }
    return (undef, 0);
}

sub getTrain {
    my $train = $_[0];
    if ($train < 1 or $train > 80) {
        return undef;
    }
    unless ($trains->{$train}) {
        $trains->{$train} = new Locomotive($interface, $train);
    }
    return $trains->{$train};
}

sub getSensors {
    my $state = $interface->getSensors(31);
    my $offset = 0;
    my $count = 0;
    my @results = ();
    foreach my $byte (split(//, $state)) {
        foreach my $bit (0..7) {
            if ((ord($byte) & (1 << $bit)) > 0) {
                my $id = $offset + $bit;
                push(@results, $id);
            }
        }
        $offset += 8;
    }
    return @results;
}

__END__

Train Operations Protocol
=========================

The Train Operations Protocol (TOP) is a line-based protocol
transmitted over TCP/IP port 6051.

Lines are delimitted by U+000A characters.

Handshake
---------

Client connects to port 6051 on the server.
Server sends:
   TOP2 <server>
Client sends:
   TOP2 <useragent>
   USER <user>
   PASSWORD <password>
...where <user> and <password> are strings the administrator has
provided the client with, and <useragent> and <server> are strings
uniquely identifying the UA and server instances respectively, for the
purposes of logging.

If the password is wrong, server sends an error message then
terminates the connection.

Commands
--------

Client can then send any of the following.
STATUS
STOP
GO
SWITCH <solenoid> OPEN
SWITCH <solenoid> CLOSED
UNCOUPLER <solenoid> RED
UNCOUPLER <solenoid> GREEN
UNCOUPLER OFF
SPEED <train> <speed>
REVERSE <train>
FUNCTION <train> <function> ON
FUNCTION <train> <function> OFF
MESSAGE <message>

Server will rebroadcast all of the above and also sometimes send the following:
SENSOR <sensor> ON
SENSOR <sensor> ON STILL
SENSOR <sensor> OFF
UNCOUPLER <solenoid> RED ON
UNCOUPLER <solenoid> RED OFF
UNCOUPLER <solenoid> GREEN ON
UNCOUPLER <solenoid> GREEN OFF
ERROR <message>

Clients can also send
PING <message>
...to which server will respond:
PONG <message>
..once all pending commands on that connection have been dealt with.

<solenoid> is 1..256
<train> is 1..80
<speed> is 0..14
<function> is 0..4
<message> is any string without a newline
<sensor> is 1..496 (?)

Correctly formatted messages sent to the server are rebroadcast to all clients with the following exceptions:
 STATUS  -- Status messages are only sent to originating client
 MESSAGE -- MESSAGE is only rebroadcast to other clients
 PING    -- PONG is only sent to originating client