#!/usr/bin/perl

#Splitreflection's proxy, version 5.
#This is a complete rewrite, to work over standard http connections.

use strict;
use Socket;
use Carp;
use Fcntl;
use CGI qw(:standard);
use CGI::Carp qw/fatalsToBrowser/;
use POSIX 'setsid';
use URI::Escape;
use threads;
use threads::shared;
use Thread::Suspend;

my $serverURL = "/user-bin/proxy-server.pl";

if($credentials{'home'} =~ /(.*)/){$credentials{'home'} = $1;}

my %params;
my $proto = getprotobyname('tcp');

my $waitedpid;
$SIG{CHLD} = 'IGNORE';

my $request;
my $plaintext;
grep
{
  if ($_ eq "plaintext")
  { $plaintext = param($_); }
  else
  { $request .= "$_: ".param($_)."\n"; }
} param();

$plaintext =~ s/\n/\\\n/g;  # escape \n
$request .= "plaintext: $plaintext\n\n";

&readparams($request);

my $serverstate : shared = 1;
my $clientstate : shared = 1;
my $session_name : shared;
my @stamps2client : shared;
my %strings2client : shared;
$strings2client{"size"} = 0;
my @stamps2muck : shared;
my %strings2muck : shared;
my $lastaction : shared = time;
my $isidle : shared = 0;
my $server : shared;
my $port : shared;
my $idletime : shared;
my $idlecmd : shared;
my $discotime : shared;
my $unidlecmd : shared;

print "Content-type: text/plain\n".
      "Cache-control: no-cache\n\n";

if(uc($params{'command'}) eq 'OPEN')
{
  if($params{'session'} = fork)
  {
    $params{'command'} = "GET";
    $params{'sendstamp'} = "";
    $params{'base64'} = "";
    sleep 1;
  }
  else
  {
    setsid;
    open STDERR, "/dev/null";
    open STDOUT, "/dev/null";
    open STDIN, "/dev/null";

    $server = $params{'server'};
    $port = $params{'port'};
    $idletime = $params{'sendstamp'};
    $idlecmd = $params{'base64'};
    $unidlecmd = $params{'unidlecmd'};
#    $discotime = 60 * 60; # default to 1 hour.
#    if($params{'discotime'}){ $discotime = $params{'discotime'}; }
    $discotime = $params{'discotime'} || 60 * 60; # default to 1 hour.
    my $muckio = threads->new(\&muckthread);
    #my $accepter = threads->new(\&acceptthread);
    &acceptthread;

    #$muckio->join;
    #$accepter->join;
    exit;
  }
}

{
  if($params{'command'} eq 'LIST')
  {
    chomp $params{'base64'};
    print &response("LIST", "", "", &list_sessions(), "0", $serverURL, $params{'command'});
  }
  elsif($params{'command'} ne 'PUT' &&
     $params{'command'} ne 'GET' &&
     $params{'command'} ne 'CLOSE')
  {
    print &response("CLOSE","Invalid command: $params{'command'}","",$params{'session'}, "0", $serverURL, $params{'command'});
  }
  else
  {
    socket(Session_Forward, PF_UNIX, SOCK_STREAM, 0);
    if(connect(Session_Forward, sockaddr_un("$credentials{'home'}/.web/proxysessions/".$params{'session'})))
    {
      select Session_Forward; $| = 1;
      select STDOUT;
      print Session_Forward $request ;
      print join "", <Session_Forward>;
    }
    else
    {
      print &response("CLOSE",$!." $credentials{'home'}/.web/proxysessions/".$params{'session'},"",$params{'session'}, "0", $serverURL, $params{'command'});
    }
  }
}
exit;

sub logmsg
{
  open LOG, ">>$credentials{'home'}/.web/proxy.log";
  print LOG "$$: @_ at ", scalar localtime, "\n\n";
  close LOG;
}

sub readparams
{  # Reads a request, and fills out the %params hash. Returns 0 on success,
   # 1 on 'incomplete request'
  require MIME::Base64;MIME::Base64->import("decode_base64");
  undef %params;
  %params;
  my $request = shift;
  &logmsg("input: ------\n$request--------");

  if($request !~ /\n\n$/){return 1;}
  # divide request into metadata and plaintext data.
  my $plaintext;
  ($request, $plaintext) = split ("plaintext: ", $request, 2);
  my @lines = split "\n", $request;
  my $last;

  grep
  {
    if($_ =~ /^(\w+): (.*)$/)
    {
      $params{lc($1)} = $2;
      $last = $1;
    }
    else
    {
      $params{lc($last)} .= "\n".$_;
    }
  } @lines;

  if($params{'base64'} ne "") # still support old base64 style if client uses it.
  {
    $params{'base64'} = decode_base64($params{'base64'});
    $params{'base64'} .= "\r\n";
  }
  if ($plaintext ne "")
  {
    $plaintext =~ s/\\\n/\n/g;	# unexcape \n
    $params{'base64'} = $plaintext."\r\n";
  }

  return 0;
}

sub response
{  # response(<<reponsetype>>, <<errorstring>>, <<data>>, <<session>>)
   # returns a response string.
#  require MIME::Base64;MIME::Base64->import("encode_base64");
  my $cmd = (shift || "CLOSE");
  my $err = (shift || "");
  my $data = (shift || "");
  my $ssn = (shift || "");
  my $stmp = (shift || "");
  my $sURL = (shift || $serverURL);
  my $scmd = (shift || "");
  my $base64 = "";
  my $percentesc = "";
  #if($data ne "")
  #{
  #  $base64 = &encode_base64($data);
  #  $percentesc = ""; #&encode_pctesc($data);
  #}
  # $data =~ s/\n/\\\n/g; # escape \n?
  
  my $response = "Command: ".uc($cmd)."\n".
                 "SentCommand: $scmd\n".
                 "Error: $err\n".
                 "Session: $ssn\n".
		 "Stamp: $stmp\n".
		 "ServerURL: $sURL\n".
		 "PercentEsc: $percentesc\n".
#                 "Base64: $base64\n\n";
		"plaintext: $data\n\n";
  &logmsg("output: ------\n$response--------");
  return $response;
}

sub readdata
{
  my $max_size = 100 * 1024; # 100k
  my $fh = shift;
  my $data = join("", <$fh>);
  my $err = ($! + 0);
  if(length($data) > 0)
  {
    my $stamp = time;
    my $uid;
    lock(%strings2client);
    lock(@stamps2client);
    while($strings2client{$stamp + $uid})
    { $uid += .001; }
    push @stamps2client, $stamp + $uid;
    $strings2client{$stamp + $uid} = $data;
    $strings2client{"size"} += length($data);
    while($strings2client{"size"} > $max_size)
    {
      my $key = shift @stamps2client;
      $strings2client{"size"} -= length($strings2client{$key});
	$strings2client{"laststampidx"}--;
      delete $strings2client{$key};
    }
    while (threads->resume()) { }
  }
  return $err;
}

sub queuedata
{
  my $data = shift;
  if(length($data) > 0)
  {
    my $stamp = time;
    my $uid;
    lock(%strings2muck);
    lock(@stamps2muck);
    while($strings2muck{$stamp + $uid})
    { $uid += .001; }
    push @stamps2muck, $stamp + $uid;
    $strings2muck{$stamp + $uid} = $data;
  }
}

sub getdata
{
  my $send_limit = 1024; # 1k
  my $stamp = shift;
  my $retval;
  my $stmp;
  my $x;
  lock(@stamps2client);
  lock(%strings2client);

  if ($stamp >= $strings2client{'laststamp'})
  { $x = $strings2client{'laststampidx'}; }
  for(;$x < @stamps2client;$x++)
  {
    if (($stamps2client[$x] > $stamp) || ($stamps2client[$x] =~ /closed/))
    {
      $stmp = $stamps2client[$x];
      $retval .= $strings2client{$stamps2client[$x]};
      if(length($retval) > $send_limit)
      {last}
      $strings2client{'laststampidx'} = $x;
	$strings2client{'laststamp'} = $stmp;
    }
  }
  return $retval, $stmp;
}

sub writedata
{
  my $fh = shift;
  while(my $key = shift @stamps2muck)
  {
    lock(%strings2muck);
    lock(@stamps2muck);
    print $fh $strings2muck{$key};
    delete $strings2muck{$key};
  }
}

sub list_sessions
{
  my $sessiondir = "$credentials{'home'}/.web/proxysessions";
  opendir my $dh, $sessiondir;
  my @sessions = readdir $dh;
  closedir $dh;
  open my $fh, "/bin/netstat -an |";
  my $netstat = join "", <$fh>;
  close $fh;
  @sessions = grep($_ =~ /^[0-9]+$/, @sessions);
  @sessions = grep(-S "$sessiondir/$_", @sessions);
  @sessions = grep($netstat =~ /$sessiondir\/$_$/m, @sessions);
  grep
  {
    if(-f "$sessiondir/$_.metadata")
    {
      open my $fh, "<$sessiondir/$_.metadata";
      while(my $line = <$fh>)
      {
        chomp $line;
	my ($key, $value) = split /\s*=\s*/, $line;
	$_ .= "&".&encode_pctesc($key)."=".&encode_pctesc($value);
      }
      close $fh;
    }
  } @sessions;
  return join " ", @sessions;
}

sub encode_pctesc
{
  my $string = shift;
  $string =~ s/(.)/$URI::Escape::escapes{$1}/sg;
  return $string;
}

sub muckthread
{
  #require Time::HiRes; Time::HiRes->import("usleep");
  undef %credentials;
  my $dest_iaddr = inet_aton($params{'server'});
  my $dest_paddr = sockaddr_in($params{'port'}, $dest_iaddr);
  socket(my $Dest_Socket, PF_INET, SOCK_STREAM, $proto);
  if(connect($Dest_Socket, $dest_paddr))
  {
    $serverstate = 1;
    fcntl($Dest_Socket, F_SETFL, O_NDELAY || O_NONBLOCK);
    select $Dest_Socket; $| = 1; select STDOUT;
    my $threadsleep = time;
    while(1)
    {
      &writedata($Dest_Socket);
      my $readerr = &readdata($Dest_Socket);
      if($readerr == 0)
      {
        $serverstate = 0;
        close $Dest_Socket;
#       unlink $session_name;
#       exit;
	  # note closed status to be processed when client gets there.
	  lock(@stamps2muck);
	  push @stamps2muck, 'closed';
      }

      # Timeout functions
      my $idle = time - $threadsleep;
      if($idle > 20)
      {
        while (threads->resume()) { }
	$threadsleep = time;
      }
      $idle = time - $lastaction;
      if($idletime && $idlecmd && $idle > $idletime && $isidle == 0)
      {
        #Send some kind of status to the muck?
        $isidle = 1;
        &queuedata($idlecmd);
      }
      if(!$clientstate || $idle > $discotime)
      {
        close $Dest_Socket;
        unlink $session_name;
        exit;
      }
      select(undef, undef, undef, 0.25);
      #usleep(250); # something of a hack, perhaps.
    }
  }
  $serverstate = 0;
  threads->self()->detach();
  threads->exit();
}

sub acceptthread
{
  if(! -d "$credentials{'home'}/.web/proxysessions/")
  { mkdir "$credentials{'home'}/.web/proxysessions/"; }

  $session_name = "$credentials{'home'}/.web/proxysessions/$$";
  my $session_uaddr = sockaddr_un($session_name);

  socket(Session_Server,PF_UNIX,SOCK_STREAM,0)        || die "$$ socket: $!";
  unlink($session_name);
  bind  (Session_Server, $session_uaddr)           || die "$$ bind: $!";
  listen(Session_Server,SOMAXCONN)                    || die "$$ listen: $!";
  chmod 0777, $session_name;

  while(accept(my $Session_Client,Session_Server))
  {
    my $client = threads->new(\&clientthread, $Session_Client);
  }
}

sub clientthread
{
  undef %credentials;
  my $Session_Client = shift;
  select $Session_Client; $| = 1;
  my $request;
  my ($data, $stamp, $cmd, $err);
  while(my $line = <$Session_Client>)
  {
    $request .= $line;
    if($line =~ /^$/){last;}
  }  
  &readparams($request);

  open my $fh, ">$session_name.metadata";
  print $fh
  "appid = $params{'appid'}\n".
  "server = $server\n".
  "port = $port\n".
  "tag = $params{'tag'}";
  close $fh;

  if(uc($params{'command'}) eq "CLOSE")
  {
    ($data, $stamp) = &getdata($params{'stamp'});
    print $Session_Client &response("CLOSE","Session closed by client",$data, $$, $stamp, $serverURL, $params{'command'});
    $clientstate = 0;
    close $Session_Client;
    close Session_Server;
    unlink $session_name;
    exit;
  }
  else #(uc($params{'command'}) ne "ALIVE?")
  {
    $lastaction = time;
    if($isidle && $unidlecmd){ $isidle = 0; &queuedata($unidlecmd); }
    if(uc($params{'command'}) eq "PUT")
    {
      &queuedata($params{'base64'});
      $cmd = "PUT";
      $err = "";
      $data = "";
      $stamp = "";
    }
    else
    {
      my $thistime = time;
      while(!$data && (time - $thistime) < 28) # Finish after 28 seconds.  Hopefully short enough for firewalls.
      {
        ($data, $stamp) = &getdata($params{'stamp'});

	  if ($stamp =~ /closed/)
	  { $cmd = "CLOSE";
	    $err = "Session closed by remote server.(1)";
	  }
	  elsif(!$data)
	  {
	    threads->self()->suspend();
	  }
      }
      $cmd = "PUT";
      $err = "";
      if(!$serverstate)
      {
        $cmd = "CLOSE";
        $err = "Session closed by remote server.";
      }
    }
    print $Session_Client &response($cmd,$err,$data,$$, $stamp, $serverURL, $params{'command'});
  }
  close $Session_Client;

  if(!$serverstate)
  {
    $clientstate = 0;
  }
  threads->self()->detach();
  threads->exit();
}

