#!/usr/bin/perl
# Copyright(c)2007 by Hiroaki Sengoku <sengoku@gcd.org>
# 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, 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.
use strict;
use warnings;
use English;
use Getopt::Std;
use POE qw(Component::Server::TCP Filter::Stream);

our ($opt_v);
getopts('v') || &help;
my $Verbose = $opt_v;
&help unless @ARGV == 1;
my $Port = shift;
my $PollID;
my $PollHeap;
my $PollBuf;
my $PollHeader;
my %SID;
my %Heap;
my %Buf;
my $NextSID = 0;

POE::Component::Server::TCP->new
    (
     Port => $Port,
     ClientInput => sub {
	 my ($heap, $input, $id) = @_[HEAP, ARG0, ARG1];
	 if (defined $PollID && $id == $PollID) {
	     $PollHeap = $heap;
	     $PollBuf .= $input;
	     &doPoll;
	 } elsif (defined $SID{$id}) {
	     my $sid = $SID{$id};
	     $Heap{$sid} = $heap;
	     $Buf{$sid} .= $input;
	     &doSession($sid);
	 } elsif ($input =~ m@^GET /KLAB/poll @) {
	     if (defined $PollID) {
		 $heap->{client}->
		     put("HTTP/1.1 503 Service Unavailable\r\n\r\n");
		 $heap->{client}->shutdown_output;
		 return;
	     }
	     $PollID = $id;
	     $PollHeap = $heap;
	     $PollBuf = $input;
	     &doPoll;
	 } else {
	     $SID{$id} = $NextSID;
	     $NextSID = ($NextSID + 1) & 0xFFFF;
	     my $sid = $SID{$id};
	     $Heap{$sid} = $heap;
	     $Buf{$sid} = $input;
	     &doSession($sid);
	 }
     },
     ClientDisconnected => sub {
	 my $heap = $_[HEAP];
	 my $id = $heap->{client}->ID;
	 if (defined $PollID && $id == $PollID) {
	     undef $PollHeap;
	     undef $PollBuf;
	     undef $PollHeader;
	     undef $PollID;
	 } elsif (defined $SID{$id}) {
	     my $sid = $SID{$id};
	     undef $SID{$id};
	     undef $Heap{$sid};
	     undef $Buf{$sid};
	 }
     },
     ClientFilter => POE::Filter::Stream->new(),
    );
POE::Kernel->run;
exit;

sub doPoll {
    do {
	if (! defined $PollHeader) {
	    if ($PollBuf =~ /\r\n\r\n/) {
		$PollHeader = $PREMATCH;
		$PollBuf = $POSTMATCH;
		print "header:\n$PollHeader\n" if $Verbose;
		$PollHeap->{client}->put("HTTP/1.1 200 OK\r\n\r\n");
	    }
	}
	return unless defined $PollHeader;
	my ($sid, $len, $data) = unpack("nna*", $PollBuf);
	return unless defined $sid && defined $len && $len ne "";
	if ($len > 32767) {
	    $len -= 65536;
	    $PollBuf = $data;
	    if ($len == -1) {
		print "ERR sid=$sid\n" if $Verbose;
		&doShutdown($sid);
	    } else {
		print "sid=$sid, len=$len\n" if $Verbose;
	    }
	} elsif ($len > 0) {
	    return unless defined $data && length($data) >= $len;
	    ($data, $PollBuf) = unpack "a${len}a*", $data;
	    print "sid=$sid, len=$len, data=$data\n" if $Verbose;
	    if (defined $Heap{$sid}) {
		$Heap{$sid}->{client}->put($data);
	    }
	} else {	# len == 0
	    $PollBuf = $data;
	    print "EOF sid=$sid, len=$len\n" if $Verbose;
	    &doShutdown($sid);
	}
    } while ($PollBuf ne "");
}

sub doSession {
    my ($sid) = @_;
    if (defined $PollHeap) {
	my $req = $Buf{$sid};
	$Buf{$sid} = "";
	for my $block (unpack "(a2048)*", $req) {
	    print "sending req $sid:\n$block\n" if $Verbose;
	    $PollHeap->{client}->
		put(pack("nna*", $sid, length($block), $block));
	}
    }
}

sub doShutdown {
    my ($sid) = @_;
    if (defined $Heap{$sid}) {
	$Heap{$sid}->{client}->shutdown_input;
    }
}

sub help {
    print STDERR <<EOF;
Usage relayserver <opt> <port>
opt:   -v              ; verbose mode
EOF
    exit 1;
}