#!/usr/bin/perl
#
#my $intro = "\nperlproxy15 - implementasi komplit proxy HTTP/1.1 ".
"[model select non-blocking low-buffering]"; print "$intro\n"; 
#
#my $author="Copyright (c) 2000 Dody Suria Wijaya"; print "$author\n\n";

# Not yet implemented:
# 1. count time-out for persistent connection
# 4. enable low-buffering transfer for chunked body
# 5. Access list
# 6. Advertisements blocking

use strict;
use IO::Socket;
use IO::Select;
use POSIX qw(F_SETFL O_NONBLOCK EAGAIN EPIPE);
use vars qw/$opt_d $opt_o $opt_p %st %debug/;

## uncomment below to get reliable localhost name (but memory consuming)
#use Sys::Hostname; my $hostname = hostname();
#my $MYIP = gethostbyname($hostname) or die "Couldn't resolve $hostname: $!";
#$MYIP = inet_ntoa($MYIP);

my $MYIP = `uname -n`; $MYIP =~ s/\n//;

use Getopt::Std;
#d = debug, p = next hop proxy address:port, o = this proxy port
getopts('dp:o:'); 

# declare global var
my $VERSION = "1.5.2";
my $sl_read = new IO::Select;
my $sl_write = new IO::Select;
my $port = $opt_o? $opt_o : 8888;
my $proxy = $opt_p if defined $opt_p;
my $viastring = "1.1 legalif proxymultiplekser";
my %reason = (500=>'Internal Server Error',501=>'Not Implemented',502=>'Bad Gateway',
 503=>'Service Unavailable', 504=>'Gateway Timeout', 505=>'HTTP Version Not Supported',400=>'Bad Request');
my @sensors = qw/sex xxx porno cewek/;
my @sensors2 = qw/norak kampung linux client server proxy basic/;
# maximum non-blocking sysread/syswrite iteration per client per request
# low for high reaction but slow passing, high for potentially low reaction but faster passing
my $max_iter = 3; 

my $aut = 0; # set 1 to enable authentication
my $aut_cre = "dody:rahasia"; #username password for proxy authentication
my $max_buffering = 1024*128; #maximum length of data read/write for each iteration
my $html_filter = 0; # enable (1) for substituting html body message text
my $non_block = 1; # just for testing, should not be changed from (1)

# declare subroutine prototype
sub debug ($$;$);
sub quickresp ($$$);
sub decode_b64 ($);
sub clientclose ($);
sub serverclose ($);
sub showcommand ($); 
sub htmlfilter ($);

# trap sigpipe (generated when reading/writing already closed socket)
$SIG{'PIPE'} = 'IGNORE';

# creating listening socket
my $mainsocket = new IO::Socket::INET (LocalHost=>$MYIP,LocalPort=>$port,Proto=>'tcp',
				       Listen=>10,Reuse=>1) or die $!;
print "Socket created at $MYIP:$port\n"; 
undef $MYIP;
$sl_read->add($mainsocket);
$sl_read->add(\*STDIN);

# main loop, other client must wait until operation has return to select
MAINLOOP: while (1) { #main loop
  # blocks here until something on the end of the connection 
  my ($aref_read, $aref_write) = IO::Select->select($sl_read,$sl_write,undef);

 READ_FHS: foreach my $sck (@$aref_read) { # serve readable handles

    if ($sck == $mainsocket) { # request to connect from client
      my $sock = $sck->accept();
      fcntl $sock, F_SETFL(), O_NONBLOCK() if $non_block; # make it non-blocking
      $st{$sock}{peerhost} = join "", $sock->peerhost(), ":", $sock->peerport();
      debug localtime(time)." - Session debugging for Client ($st{$sock}{peerhost})",$sock;
      debug "#select# => main socket readable",$sock,1;
      debug "Accepting connection from Client $st{$sock}{peerhost}...", $sock;
      $sl_read->add($sock);
      # set default var
      $st{$sock}{tipe} = 1; # 1 is Client connection
      $st{$sock}{mark} = 1; # socket has not been read/write
      $st{$sock}{persist} = 1; # connection persistance default to on
    }
    
    elsif($sck == \*STDIN) {
      showcommand $sck;
    }
    elsif ($st{$sck}{tipe} == 1) { # Client bisa dibaca
      debug "#select# => Client readable",$sck,1;
      my $buffer;
      while (1) {
	my $byte_read = sysread $sck, $buffer, $max_buffering;