##################################################
# Copyright 1999 University of California Berkeley
# No warranty or guarantee whatsoever, implicit
# or explicit.  Use at your own risk.
##################################################

$txbytes = 0; 
$linespeed = 28.8 * 1000 / 8;
$max_total_conns = 8;  # max number of outstanding connections
$server_timeout = 36000; # seconds
$read_chunk_size = 1500;

$SIG{"PIPE"} = \&BrokenPipeHandler;
$SIG{"INT"} = \&InterruptHandler;

###############################################
# Try starting proxy on $port
###############################################
$port = 12001;
for(;$port < 12050; $port++) {
  ###############################################
  # make sure no other service uses this port
  ###############################################
  while (getservbyport ($port, "tcp")) {
    $port++
  }

  ###############################################
  # Create, bind, listen on the server socket
  ###############################################
  print STDOUT "Trying port $port\n";
  ($d1, $d2, $protonum) = getprotobyname("tcp");
  ($d1, $d2, $d3, $d4, $servip) = gethostbyname('hostname');
  $servaddr = pack("Sna4x8", 2, $port, $servip); 
  socket(SSOCKET, 2, 1, $protonum) || die("No Socket");
  bind(SSOCKET, $servaddr) || next;
  listen(SSOCKET, 15) || die ("Can't listen.");
  select (SSOCKET);
  $| = 1;
  print STDOUT "Listening on port $port\n";


  ###############################################
  # Allocate a list of unique strings as 
  # indirect references to socks
  ###############################################
  @freesocks = ();
  @busysocks = ();
  for($i=0; $i<$max_total_conns; $i++) {
    push(@freesocks, "sock".$i);
  }

  ###############################################
  # Loop forever, accepting clients
  ###############################################
  for(;;) {
    if (scalar(@freesocks) == 0) {
       # service immediately
       goto SERVICE;
    }

    # Check for waiting connections
    print STDOUT "Non-blocking select.\n";
    $rin = $win = $ein = '';
    vec($rin,fileno(SSOCKET),1) = 1;
    $nfound = select($rin, $win, $ein, 0.1);
    if ($nfound == 0) {
      print STDOUT "No pending connection.\n";
      # no pending connection
SERVICE:
      if (scalar(@busysocks) > 0) {
        # busy sock waiting to be serviced
        # pick one busy sock to be serviced
        $sock = shift(@busysocks); # shift is first-come-first-served
        # $sock = pop(@busysocks); # pop is reverse FCFS
        $req_line = <$sock>;
        print STDOUT "Service $sock\n";
        serviceClient ($sock, $req_line);

        # return busy sock to free list
        push(@freesocks, $sock);
      } else {
        # no sock awaiting service
        # select() w/ infinite time out
        print STDOUT "Block until clients come.\n";
        $rin = $win = $ein = '';
        vec($rin,fileno(SSOCKET),1) = 1;
        $nfound = select($rin, $win, $ein, $server_timeout);
        if ($nfound == 0) { 
          print STDOUT "No activity for $server_timeout seconds, shutdown.\n";
          goto SHUTDOWN;
        }
        print STDOUT "Block returns \$nfound = $nfound.\n";
      }
    } else {
      print STDOUT "Connection pending.\n";
      # connection waiting to be accepted
      # pop sock from free socks (should succeed!!)
      die("No free sock to call accept") if (scalar(@freesocks) == 0);
      $sock = pop(@freesocks);

      # accept a new client
      print STDOUT "Accepting $sock...";
      $clientaddr = accept($sock, SSOCKET) or die ("Can't accept");
      ($remoteFamily, $remotePort, $remoteAddr) = unpack('Sna4x8',$clientaddr);
      print STDOUT "$sock accepted from $remoteAddr:$remotePort\n";
      
      # push sock into busy socks
      push(@busysocks, $sock);
    }
  }
  

SHUTDOWN:
  # Close proxy's listening socket
  close(SSOCKET);
  last;
}


sub serviceClient {

    my ($req_line, $client, $port, $path, $protonum);
    my ($webservip, $host, $webservaddr, $d1, $d2, $buffer);

    $client = $_[0];
    $req_line = $_[1];
    ($d1, $d2, $protonum) = getprotobyname("tcp");

    #print STDOUT "Request line: $req_line\n";
    if ($req_line =~ m{get http://([\w\-\.]*)(:(\d*))?(/.*)}i) {
      $host = $1;
      $port = $3 or $port = 80;
      $path = $4 or $path = "/";
    #  print STDOUT "Match!\n";
    #  print STDOUT "\$host=$host\n";
    #  print STDOUT "\$port=$port\n";
    #  print STDOUT "\$path=$path\n";
    } else { 
      print STDOUT "No match!\n";
      close($client); 
      return;
    }

    socket (SERVER, 2, 1, $protonum) || die("No socket.");
    ($d1, $d2, $d3, $d4, $webservip) = gethostbyname($host);
    $webservaddr = pack("Sna4x8", 2, $port, $webservip);
    connect (SERVER, $webservaddr) or die("connect: $!");

    select (SERVER);
    $| = 1;
    print SERVER ("GET $path\r\n\r\n");
    print STDOUT ("Sent request:GET $path\n");

    select ($client);
    $| = 1;
    #while (<SERVER>) {
    while (sysread(SERVER, $buffer, $read_chunk_size)) {
      $txbytes += length($buffer);
      print $client $buffer;
      # sleep for 0.2s for every $linespeed / 5 bytes trasmitted
      while ($txbytes >= ($linespeed/5)) { 
         select(undef, undef, undef, 0.2);
         $txbytes-=($linespeed/5); 
      }  
    }
    close (SERVER);
    print STDOUT "Finish downloading. ------------------------------\n";
   
    close($client);

}

sub BrokenPipeHandler {
  my($sig) = @_;
  print STDOUT "Caught a SIG$sig\n";
}

sub InterruptHandler {
  my($sig) = @_;
  print STDOUT "\nBye.\n";
  close(SSOCKET);
  exit(0);
}