#!/usr/bin/perl

use warnings;
use strict;

use Getopt::Long;
use Term::ANSIColor qw< :constants >;
use IO::Socket::INET;
use IO::Select;
sub debug($);
sub child(&);
local $_;

GetOptions(
  "cmd=s"    => \my $cmd,
  "listen=i" => \my $listen,
  "help"     => \&usage,
) or usage();
my @hops = @ARGV;
usage() unless @hops and (defined $cmd xor defined $listen);

for(@hops) {
  die "Error in hop specification (\"$_\"), see --help.\n"
    unless $_ =~ /^([^:]+):(\d+)$/;
}

debug join RESET, BOLD . RED . $0, " started.\n";

if(defined $cmd) {
  my $tsock = tunnel_sock();
  debug "Redirecting STDIN and STDOUT to the socket... ";
  open STDOUT, ">&", $tsock or die "Couldn't redirect STDOUT: $!\n";
  open STDIN,  "<&", $tsock or die "Couldn't redirect STDIN: $!\n";
  debug "done.\n";
  debug "exec()ing \"$cmd\"...\n";
  exec $cmd or die "Couldn't exec() \"$cmd\": $!\n";
} else {
  my $lsock = IO::Socket::INET->new(
    LocalPort => $listen,
    Proto     => "tcp",
    ReuseAddr => 1,
    Listen    => 5,
  ) or die "Couldn't create listening socket: $!\n";
  debug "Listening on localhost:$listen.\n";

  while(my $conn = $lsock->accept) {
    child {
      my $addr = join ":", $conn->peerhost, $conn->peerport;
      debug "New connection from " . BOLD . BLUE . $addr . RESET . "; establishing tunnel...\n";
      my $tsock = tunnel_sock();
      debug "Tunnel established, relaying...\n";

      my $s = IO::Select->new($conn, $tsock);
      my $closer;
      MAIN: while(my @r = $s->can_read) {
        foreach my $fh (@r) {
          if($fh == $conn) {
            relay($conn, $tsock) or $closer = "local host", last MAIN;
          } else {
            relay($tsock, $conn) or $closer = "remote host", last MAIN;
          }
        }
      }

      debug "Connection from " . BOLD . BLUE . $addr . RESET . " closed by $closer; exiting.\n";
    };
  }
}

sub relay {
  my ($from, $to) = @_;

  my $buf;
  my $ret = sysread $from, $buf, 8192;
  defined $ret or die "Couldn't read from socket: $!\n";
  $ret         or return;
  syswrite $to, $buf or die "Couldn't write to socket: $!\n";

  1;
}

sub tunnel_sock {
  my $first_proxy = $hops[0];
  debug "Connecting to " . pp(0) . " ";
  my $psock = IO::Socket::INET->new(
    PeerAddr => $first_proxy,
    Proto    => "tcp",
  ) or die "Couldn't create socket to first proxy: $!\n";
  debug BOLD . GREEN . "ok" . RESET . ".\n";

  foreach my $hopnum (1..$#hops) {
    my $hop = $hops[$hopnum];
    debug "CONNECTing to " . pp($hopnum) . " ";
    print $psock "CONNECT $hop HTTP/1.0\015\012Host: $hop\015\012\015\012";

    (my $line = <$psock>) =~ s/[\015\012]*$//; # hack
    if($line =~ /^HTTP\/\d\.\d 200/) {
      debug BOLD . GREEN . "200!" . RESET . " ";
      until($line eq "") {
        ($line = <$psock>) =~ s/[\015\012]*$//; # hack
      }
      debug "ok.\n";
    } else {
      debug BOLD . RED . "failed" . RESET . ": $line\n";
      exit;
    }
  }

  return $psock;
}

sub child(&) {
  my $sub = shift;

  my $pid = fork;
  die "Couldn't fork: $!\n" unless defined $pid;
  return $pid if $pid;

  $sub->();
  exit;
}

sub pp {
  my $hopnum = shift;
  my $hop    = $hops[$hopnum];

  my $str    = sprintf "[%s%d%s/%s%d%s]: %s%s%s...",
    BOLD . YELLOW, $hopnum + 1,  RESET,
    BOLD . YELLOW, scalar @hops, RESET,
    BOLD . BLUE,   $hop,         RESET;
  $str      .= " " x (70 - length $str);
}

sub usage { print STDERR <<USAGE; exit }
Usage: $0 options -- proxy1 proxy2 ... [target]

Available options:
  --cmd="nc -vvlp local-port"
    Executes the given command after establishing the tunnel.
  --listen=8000
    Specifies the port to listen on.
    Note that --cmd and --listen are mutually exclusive.
  --help
    Displays this help.

Give proxies in the format "host:port".
USAGE

# Nice debugging output.
{
  my $fresh;
  sub debug($) {
    my $msg = shift;

    print STDERR BOLD, BLUE, ":", RESET, "[", BOLD, BLUE, $$, RESET, "] " and $fresh++ unless $fresh;
    print STDERR $msg;
    $fresh = 0 if substr($msg, -1) eq "\n";
    1;
  }
}