#!/usr/bin/perl -w

# XXX -T

# strongly based on Randal Schwartz's anonymizing proxy
# from http://www.stonehenge.com/merlyn/WebTechniques/col11.listing.txt

# Original copyright:
## Copyright (c) 1996 by Randal L. Schwartz
## This program is free software; you can redistribute it
## and/or modify it under the same terms as Perl itself.

## Anonymous HTTP proxy (handles http:, gopher:, ftp:)
## requires LWP 5.04 or later
#


use strict;
$ENV{PATH} = join ":", qw(/bin /usr/bin /usr/local/bin);
$|++;


my $HOST = "0.0.0.0";
my $PORT = "4081";

my $fork = 1;
my $log = 1;

sub prefix {
  my $now = localtime;

  join "", map { "[$now] [${$}] $_\n" } split /\n/, join "", @_;
}

$SIG{__WARN__} = sub { warn prefix @_ };
$SIG{__DIE__}  = sub { die prefix @_ };
$SIG{CLD}      = sub { wait; };
$SIG{CHLD}     = sub { wait; };

my $AGENT;                      # global user agent (for efficiency)

BEGIN {
  use LWP::UserAgent;

  @MyAgent::ISA = qw(LWP::UserAgent); # set inheritance

  $AGENT = MyAgent->new;
  $AGENT->agent("RPTVProxy/0.1");
  $AGENT->env_proxy;
}

sub MyAgent::redirect_ok { 0 } # redirects should pass through

sub main {
  use HTTP::Daemon;

  my $master = new HTTP::Daemon
    LocalAddr => $HOST, LocalPort => $PORT
      or die "Couldn't get $PORT";
  warn "set your proxy to <URL:", $master->url, ">";
  my $slave;
  &handle_connection($slave) while $slave = $master->accept;
  exit 0;
}                               ### END MAIN ###

sub handle_connection {
  my $connection = shift;       # HTTP::Daemon::ClientConn
  my $time = time;
  my $pid;

  if ($fork) {
    $pid = fork;
  } else {
    $pid = 0;
  }
  if ($pid) {                   # spawn OK, and I'm the parent
    close $connection;
    return;
  }
  ## spawn failed, or I'm a good child
  my $request = $connection->get_request;

  if (defined($request)) {
    my $response = &fetch_request($request);
    if ($log) {
      open LOG,">logs/rnsproxy.$time.$$.log";
      print LOG $request->as_string();
      print LOG '-'x79, "\n";
      print LOG $response->as_string();
      close LOG;
    }
#   $connection->force_last_request();
    $connection->send_response($response);
    close $connection;				# XXX should support keep-alive
  }
  if ($fork) {
      exit 0 if defined $pid;       # exit if I'm a good child with a good parent
  } else {
      close $connection;
      return;
  }
}

sub fetch_request {
  my $request = shift;          # HTTP::Request

  use HTTP::Response;

  my $url = $request->url;
  warn "fetching $url";
  my $host = $request->header('host');
  if (not $host eq 'rns.replaytv.net') {
      my $res = HTTP::Response->new(403, "Forbidden");
      $res->content("Only rns.replaytv.net requests served\n");
      warn("non-rns.replaytv.net request: $host $url");
      $res;
  } elsif ($url->rel->netloc) {
    my $res = HTTP::Response->new(403, "Forbidden");
    $res->content("absolute URL not permitted\n");
    $res;
  } else {
    $request->uri("http://rns.replaytv.net/" . $url->rel);
    &fetch_validated_request($request);
  }
}

sub fetch_validated_request { # return HTTP::Response
  my $request = shift;  # HTTP::Request

  ## uses global $AGENT

# warn "Request: ", $request->uri, "<<<", $request->headers_as_string, ">>>";
  my $response = $AGENT->request($request);
# warn "Response: <<<", $response->headers_as_string, ">>>";

  if ($request->uri =~ m:getshellcmds: && -e 'shellcmds') {
      open CMDS,"<shellcmds";
      $/ = undef;
      my $cmds = <CMDS>;
      close CMDS;
      $/ = '\n';
      $response->header("Content-Length" => length($cmds));
      $response->content($cmds);
  }
  $response;
}

main();