#!/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::Client::TCP Filter::Stream);

my $version = "realyagent.pl 0.01";
my $IdleTimerMax = 6;	# 60 sec
our ($opt_v, $opt_h);
getopts('vh:') || &help;
my $Verbose = $opt_v;
my $VirtualHost = $opt_h;
&help unless @ARGV == 2;
&help unless shift =~ m/^(\S+):(\d+)$/;
my ($RelayHost, $RelayPort) = ($1, $2);
&help unless shift =~ m/^(\S+):(\d+)$/;
my ($WebHost, $WebPort) = ($1, $2);
my %WebHeap;
my %ReqBuf;
my $PollBuf;
my $PollHeap;
my $PollHeader;
my $IdleTimer;
my $DisconectTime = 0;

POE::Component::Client::TCP->new
    ( RemoteAddress => $RelayHost,
      RemotePort    => $RelayPort,
      Connected     => sub {
	  $PollHeap = $_[HEAP];
	  undef $PollHeader;
	  $PollBuf = "";
	  $IdleTimer = $IdleTimerMax;
	  $PollHeap->{server}->
	      put("GET /KLAB/poll HTTP/1.1\r\nX-Ver: $version\r\n\r\n");
      },
      ServerInput   => sub {
	  $PollHeap = $_[HEAP];
	  $PollBuf .= $_[ARG0];
	  &doPoll;
      },
      Filter        => POE::Filter::Stream->new(),
      Disconnected  => \&reconnectPoll,
    );
POE::Session->create
    ( inline_states =>
      { _start => sub {
	  $_[KERNEL]->delay( tick => 10 );
        },
        tick => sub {
	    if ($IdleTimer > 0) {
		if (--$IdleTimer <= 0) {
		    &sendControl(0, -2);	# keep alive
		}
	    }
            $_[KERNEL]->delay( tick => 10 );
        },
      },
    );
$poe_kernel->run;
exit;

sub reconnectPoll {
    undef $PollHeap;
    my $kernel = $_[KERNEL];
    my $now = time();
    if ($now - $DisconectTime > 60) {
	$kernel->yield("reconnect");
    } else {
	print STDERR "Disconnected repeatedly in ",
		($now - $DisconectTime), " sec\n";
	$kernel->delay( reconnect => 60 );
    }
    $DisconectTime = $now;
    print "Disconected\n" if $Verbose;
}

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

sub closeWeb {
    my ($id) = @_;
    undef $WebHeap{$id} if defined $WebHeap{$id};
    undef $ReqBuf{$id} if defined $ReqBuf{$id};
}

sub reqWeb {
    my ($id, $req) = @_;
    if (defined $VirtualHost) {
	if (! defined $WebHeap{$id} || defined $ReqBuf{$id}) {
	    $req = $ReqBuf{$id} . $req if defined $ReqBuf{$id};
	    if ($req =~ /\nHost:\s*(\S+)/i) {
		$req = $PREMATCH . "\nHost: $VirtualHost" . $POSTMATCH;
		undef $ReqBuf{$id};
	    } else {
		$ReqBuf{$id} = $req;
		return;
	    }
	}
    }
    print "req $id:\n$req\n" if $Verbose;
    if (defined $WebHeap{$id} && $WebHeap{$id}->{connected}) {
	$WebHeap{$id}->{server}->put($req);
    } else {
	POE::Component::Client::TCP->new
	    ( RemoteAddress => $WebHost,
	      RemotePort    => $WebPort,
	      Connected     => sub {
		  $WebHeap{$id} = $_[HEAP];
		  $WebHeap{$id}->{server}->put($req);
	      },
	      ServerInput   => sub {
		  $WebHeap{$id} = $_[HEAP];
		  &sendRes($id, $_[ARG0]);
	      },
	      Filter        => POE::Filter::Stream->new(),
	      Disconnected  => sub {
		  &sendControl($id, 0);
	      },
	    );
    }
}

sub sendRes {
    my ($id, $res) = @_;
    $IdleTimer = $IdleTimerMax;
    if (defined $PollHeap && $PollHeap->{connected}) {
	$ReqBuf{$id} = "";
	for my $block (unpack "(a2048)*", $res) {
	    print "sending res $id:\n$block\n" if $Verbose;
	    $PollHeap->{server}->
		put(pack("nna*", $id, length($block), $block));
	}
    }
}

sub sendControl {
    my ($id, $control) = @_;
    $control += 65536 if $control < 0;
    $IdleTimer = $IdleTimerMax;
    if (defined $PollHeap && $PollHeap->{connected}) {
	print "sending keep alive\n" if $Verbose;
	$PollHeap->{server}->put(pack("nn", $id, $control));
    }
}

sub help {
    print STDERR <<EOF;
Usage relayagent <opt> <relay>:<port> <www>:<port>
opt:   -v              ; verbose mode
       -h <hostname>   ; alter Host: field
EOF
    exit 1;
}