#!/usr/bin/perl -w
# SubWeb v1.0
# Copyright (C) 2001 Stephane Aubert aka Kotao
#
# Stephane Aubert <Stephane.Aubert@hsc-labs.com>
# HSC security research labs
# Herv Schauer Consultants
#
# kotao <kotao@kotao.org>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# SubWeb should not be used as a lucrative tools without author
# autorization.
#
# $Id: subweb,v 1.0 2001/07/27 15:40:37 aubert Exp $
use strict;
BEGIN { $ENV{PATH} = '/usr/bin:/bin' }
use IO::Socket;
use Carp;
#### VARS ################################################
my $EOL = "\015\012";
my $VERSION = '1.0';
my $dynamic_filters;    #don't touch this, just add subweb=on in the URL

#### USER PARAMS ########################################
my $server_name          = "SubWeb $VERSION";
#my $server_name          = "Apache/1.3.19";

my $color                = 1;  #turn it to 0 for logging
my $debug                = 1;  
my $signature            = 1;  #turn it to 0 to desactivate subweb sig
my $convert_get_to_post  = 0;  #turn it to 1 to transform GET request to POST
my $force_auth           = 0;  # add or change auth by base64($http_auth)
my $http_auth            = "aubert:kotao";
my $anti_ids_modes       = ''; #try "1523" :) don't work on google :(
my $accept_gzipped_pages = 0;
my $static_filters       = 1; # apply static filters

my $virtual_web          = 1;  # try to add "testVWEB to the URL
my %vweb_config = (
  'giveittome' => 'file:subweb',
  'testVWEB'   => "html:<html><head><title>it works</title></head><body><big>subweb r0x</big></body></html>$EOL",
  'redirect'   => 'redirect:http://www.hsc.fr/',
);

my $cypher_hidden_field  = 0;  # cypher/decypher html hidden field (EXPERIMENTAL)
my $passphrase_hidden    = ""; # you can specifie your own passphrase (default is "random")
#my $passphrase_hidden    = "0123456789ABCDEF0123456789ABCDEF";

my $show_only_url        = 0; # show only url in request
my $dump_text_body       = 1; # dump text/* pages
my $dump_binary_body     = 0; # dump responses even binary 
my $showIN               = 1; # show client requests
my $showOUT              = 1; # show server responses
my $showUNFILTERED       = 0; # show req and resp before filters 
my $showFILTERED         = 1; # show req and resp after filters 

#### Static Filters #####################################

sub FilterIN {
  my $r = shift;
  ## Put your filters here from client to server #######

    $r =~ s/Host:\s+\S+$/Host: SubWeb/gm;
    if( $r=~ m-GET\shttp://www.kotao.org-i) {$r=~s/kotao\.org/perdu.com/mi;}
    $r =~ s/^.*Connection: Keep-Alive$EOL//gm;
    if( $r=~m-GET\s+http://www.google.fr-i) {$r=~s/q=denis/q=frenchlover/gm;} #:)

    # trivial anti-ads
    $r =~ s/\.valueclick\.com/xxx/g;
    $r =~ s/\.doubleclick\.net/xxx/g;

    # Cookie stuff
    # $r =~ s/Cookie:\s+.*$EOL//gm;  # Don't send coockies
    $r =~ s/Cookie:\s+.*$EOL/sprintf("Coockie: %s$EOL", "NO-COOKIE-PLEASE:"x5)/egm;  # activism ;)

  return $r;
}

sub FilterOUT {
  my $r = shift;
  ## Put your filters here from server to client #######

    #$r =~ s/./A/gm;
    $r =~ s/[Vv][Aa][Ll][Uu][Ee]="frenchlover"/value="denis"/gm;

  return $r;
}

#### Dynamic Filters ####################################

sub DynamicFilterIN {
  my $r = shift;
  # filters activated by subweb=on in the URL

    $r =~ s/FreeBSD/MacOS/m;
    $r =~ s/Linux/Atari/m;

  return $r;
}

sub DynamicFilterOUT {
  my $r = shift;
  ## filters activated by subweb=on in the URL 

    $r =~ s/<img/[image]<NO-IMG/gim;

  return $r;
}

#### COLORS #############################################
my $BOLDRED=     ($color ? "\033[1;31m" : '');
my $BOLDGREEN=   ($color ? "\033[1;32m" : '');
my $BOLDYELLOW=  ($color ? "\033[1;33m" : '');
my $BOLDBLUE=    ($color ? "\033[1;34m" : '');
my $BOLDMAGENTA= ($color ? "\033[1;35m" : '');
my $BOLDCYAN=    ($color ? "\033[1;36m" : '');
my $WHITE=       ($color ? "\033[0;29m" : '');
my $RED=         ($color ? "\033[31m" : '');
my $GREEN=       ($color ? "\033[32m" : '');
my $YELLOW=      ($color ? "\033[33m" : '');
my $BLUE=        ($color ? "\033[34m" : '');
my $MAGENTA=     ($color ? "\033[35m" : '');
my $CYAN=        ($color ? "\033[36m" : '');
my $CLEAR=       ($color ? "\033[2J\033[1;1H" : '');
my $CL=          ($color ? "\033[0m" : ''); 

### Usage ###############################################
sub Banner {
  print "$CLEAR$YELLOW -=- SubWeb - <Stephane.Aubert\@hsc-labs.com> - $VERSION -=- $CL\n";
}
sub Usage {
  &Banner;
  print "\n$YELLOW Usage : ./subweb [local_port] [proxy|midproxy|rproxy] [remote_host] [remote_port]$CL\n\n";
}

### MAIN ################################################
sub spawn;  # forward declaration
sub handle_request;
sub logmsg { print "$RED\[", scalar localtime, ": @_\]$CL\n"; }

my $port = shift || 8080;
my $mode = shift || 'midproxy';                 # midproxy | proxy | rproxy 
my $remote_ip = shift || 'localhost'; 
my $remote_port = shift || 3128; 

&Usage;
srand;

# Verify params

if( $cypher_hidden_field ) {
  $passphrase_hidden=random_passphrase(),warn "Use random passphrase !\n"  
    if($passphrase_hidden!~/\S/ or length($passphrase_hidden)!=32);
  eval "require Crypt::Blowfish"; 
  die "You must install Crypt::Blowfish to cypher hidden fields\n" if($@);
  die "Passphrase must have 32 char.\n" if(length($passphrase_hidden)!=32);
}

# base64 encoder from whisker
eval "require MIME::Base64"; # MIME::Base64 is faster
if($@) { *b64enc = \&perl_encode_base64; } 
else   { *b64enc = \&MIME::Base64::encode_base64;}

($port) = $port =~ /^(\d+)$/                               or die "invalid port";
my $proto = getprotobyname('tcp');
socket(Server, PF_INET, SOCK_STREAM, $proto)               || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY))               || die "bind: $!";
listen(Server,SOMAXCONN)                                   || die "listen: $!";

logmsg "server started on port $port";

my $waitedpid = 0;
my $paddr;

sub REAPER {
    $waitedpid = wait;
    $SIG{CHLD} = \&REAPER;
    logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '') if($debug>10);
}
$SIG{CHLD} = \&REAPER;

for ( $waitedpid = 0;
      ($paddr = accept(Client,Server)) || $waitedpid;
      $waitedpid = 0, close Client) {
    next if $waitedpid and not $paddr;
    my($port,$iaddr) = sockaddr_in($paddr);
    my $name = gethostbyaddr($iaddr,AF_INET);
    logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";
    spawn sub { $|=1; &handle_request; };
}

sub spawn {
    my $coderef = shift;
    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') { confess "usage: spawn CODEREF"; }
    my $pid;
    if (!defined($pid = fork)) { logmsg "cannot fork: $!"; return; } 
    elsif( $pid ) { logmsg "begat $pid" if($debug>10); return; } # I'm the parent 
    # else I'm the child -- go spawn
    open(STDIN,  "<&Client")   || die "can't dup client to stdin";
    open(STDOUT, ">&Client")   || die "can't dup client to stdout";
    ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
    exit &$coderef();
}

#---------------------------------------------------------------------#
# blowfish stuff
sub cypherBlowfish {
  my $text = shift;
  my $m=""; my $i=0; my @t=(); my $c;
  foreach $c (split //,$text) {
    $m.=$c;
    if($i++>6) { push @t,$m;$i=0;$m="";}
  }
  if($m=~/\S/) { if(length($m)<8) {$m.=' 'x(8-length($m))} push @t,$m;}
  my @C=();
  my $key = pack("H*", $passphrase_hidden);
  my $cipher = new Crypt::Blowfish $key;
  foreach (@t) {push @C,unpack("H16",$cipher->encrypt($_));}
  my $data=join(':',@C);
  return $data;
}

sub decypherBlowfish {
  my $data = shift;
  $data =~ s/\%3A/:/gi;
  my @C=split(/:/,$data);
  my $key = pack("H*", $passphrase_hidden);
  my $cipher = new Crypt::Blowfish $key;
  my $msg = "";
  foreach (@C) { $msg .= $cipher->decrypt(pack("H16",$_));}
  $msg =~ s/\s+$//;
  return $msg;
}

#---------------------------------------------------------------------#

sub http_error {
  my $err = shift || "unknown";
  print "HTTP/1.0 200 OK$EOL".
        "Date: " . scalar localtime . "$EOL".
        "Server: " . $server_name . $EOL.
        "Content-Type: text/html$EOL".
        #"Proxy-Connection: close$EOL".
        "$EOL".
        "<html><head><title>error</title></head><body><big>$err</big></body></html>$EOL";
}

sub give_http_page {
  my $page = shift || "<html><head><title>page</title></head><body><big>page web</big></body></html>$EOL";
  print "HTTP/1.0 200 OK$EOL".
        "Date: " . scalar localtime . $EOL.
        "Server: ". $server_name . $EOL.
        "Content-Type: text/html$EOL".
        $EOL.
        $page . $EOL;
}

sub give_http_redirect {
  my $location = shift || "localhost";
  print "HTTP/1.0 302 Found$EOL".
        "Date: " . scalar localtime . $EOL.
        "Server: ". $server_name . $EOL.
        "Location: ".$location . $EOL.
        "Connection: close$EOL".
        "Content-Type: text/html; charset=iso-8859-1$EOL$EOL";
}

#---------------------------------------------------------------------#

sub get_cli_req {
  my $nbmax = 1024*8;
  my $nread = 0;
  my $res;
  my @result;
  my $headers = '';
  my $cont_len = 0;
  my $body = '';

  # read : command url proto
  $res = <STDIN>;
  $nread = length($res);

  my ($com,$uri,$proto) = split( /\s+/, $res );
  http_error("Invalid HTTP command"),return undef  unless( $com =~/^(head|get|post)$/i );
  http_error("Invalid URI"),return undef           unless( $uri =~m;^(http://|/)\S*$;i );
  http_error("Invalid protocol"),return undef      unless( $proto =~m:^HTTP/1\.[01]$:i );

  # read : headers
  while( $nread <= $nbmax ) {
    $res = <STDIN>;
    my $n = length($res);
    last unless($res=~/\S/);
    $nread+=$n; $headers.=$res;
    $cont_len=$1 if($res=~/^Content-length:\s(\d+)\s*$/);
  }
  http_error("Request too long"),return undef if( ($nread+$cont_len)>=$nbmax );

  # read body (data) if com==post and content-length!=0
  if( $com=~/^post$/i and $cont_len ) {
#    $body = <STDIN>;
#    my $n = length($body);
    my $n = read STDIN, $body, $cont_len;
    warn "Invalid POST data" if($n!=$cont_len);
  }

  @result = ($com,$uri,$proto,$headers,$cont_len,$body);
  return @result;
}

#---------------------------------------------------------------------#

sub color_html {
  my $colour = shift;
  my $req = shift;

  $req =~ s/\<A\s+HREF=[^>]+\>/${MAGENTA}$&$colour/gim;
  $req =~ s/\<INPUT\s+[^>]*type="?hidden"?[^>]*\>/${RED}$&$colour/gim;

  return $req;
}

#---------------------------------------------------------------------#

sub EncodeHexa {
  my $colour=shift;
  my $req = shift;
  my $res = '';
  my $text = '';
  my $c;
  my $col = 1;

  my ($r1,$r2) = split(/$EOL$EOL/, $req);
  $res = $r1;

  if( $req=~/Content-Type:\s+text/im and $req!~/Accept-Encoding:\s+gzip/im ) {
    if($dump_text_body) { return "$colour".color_html("$colour","$req")."$CL"; }
    else { return "${colour}$res$CL"; }
  }

  return "${colour}$res$CL" unless($dump_binary_body);

  foreach $c (split //,$r2) {
    $res .= sprintf "%02x ",ord($c);
    if(ord($c)>31 and ord($c)<127 ) { $text.=$c; }
    else { $text .= '.'; }
    $res.=" $text\n",$col=1,$text='' if($col++>=25)
  }
  $res .= ' ' x ((26-$col)*3+1);
  $res .= $text;
  return "${colour}$res$CL";  
}

#---------------------------------------------------------------------#

sub show_request {
  my $req = shift;

  return $req unless( $show_only_url );

  my ($res) = split( /$EOL/, $req );
  if( $req =~ /^POST\s/i ) {
    my ($buf,$data) = split( /$EOL$EOL/, $req );
    $res .= "${EOL}POST_DATA:$data";
  }

  return $res;  
}

#---------------------------------------------------------------------#

sub process_virutal_web {
  my ($action,$data) = @_;
  if(    $action=~/^redirect$/i ) { 
    give_http_redirect($data); 
    print STDERR "${RED}\[VirtualWeb: Send redirect to $data] $CL\n" if($showOUT);      
  }
  elsif( $action=~/^html$/i ) { 
    give_http_page($data); 
    print STDERR "${RED}\[VirtualWeb: Send html code] $CL\n" if($showOUT);      
  }
  elsif( $action=~/^file$/i ) {  
    if( open(IN,"< $data") ) {
      my $buf = '';
      while(<IN>) { $buf .= $_; }
      close IN;
      give_http_page($buf);
      print STDERR "${RED}\[VirtualWeb: Send file $data] $CL\n" if($showOUT);      
    } 
    else { http_error("VWEB: bad file"); }
  }
  else { http_error("VWEB: bad action"); }
}

#---------------------------------------------------------------------#

sub apply_filterIN {
  my $r = shift;
  
  $r = FilterIN($r)        if( $static_filters );
  $r = DynamicFilterIN($r) if( $dynamic_filters );

  $r =~ s/Accept-Encoding:\s+gzip$EOL//gm unless($accept_gzipped_pages);

  #decypher hidden tags
  if($cypher_hidden_field) {
    my $f;
    $r =~ s/(\w+=)SUBWEB([\w:%]+)(\W)/$1.($f=decypherBlowfish($2)).$3/mge;
    if( $r=~/^POST\s/i) {
      #we must fix the Content-length
      my($r1,$r2) = split(/$EOL$EOL/,$r);
      $r2 =~ s/($EOL)+$//g;
      my $n = length($r2);
      $r =~ s/Content-length: \d+/Content-length: $n/;
    }
  }
  return $r;
}

sub apply_filterOUT {
  my $r = shift;

  $r = FilterOUT($r)        if( $static_filters );
  $r = DynamicFilterOUT($r) if( $dynamic_filters );

  $r =~ s|</HTML>|<HR><tt>Powered by SubWeb :)</tt></HTML>$EOL|igm  if($signature);

  if($cypher_hidden_field) {
    my $f;
    $r =~ s/(<INPUT\s+TYPE=\"hidden\"\s+NAME=\"[^"]*\"\s+VALUE=)\"([^"]+)\"/"$1SUBWEB".($f=cypherBlowfish($2))/mgei;
    $r =~ s/(<INPUT\s+TYPE=\"hidden\"\s+VALUE=)\"([^"]+)\"/"$1SUBWEB".($f=cypherBlowfish($2))/mgei;
  }

  return $r;
}

#---------------------------------------------------------------------#

sub process_request {
  my ($soc,$req) = @_;
  my $resp = '';

  if( $virtual_web ) {
    my $trig;
    foreach $trig (keys %vweb_config) {
      process_virutal_web(split(/:/,$vweb_config{$trig},2)),return if( $req=~/$trig/);
    }
  }
  $dynamic_filters=0;
  if( $req =~ /^\S+\s+\S+\?\S*subweb=on/ ) {
    $dynamic_filters=1; 
    print STDERR "${RED}\[Active dynamic filters] $CL\n";      
  }

  print $soc apply_filterIN($req);
  print STDERR "$BLUE",show_request($req),"$CL\n--\n" if($showIN and $showUNFILTERED);      
  print STDERR "$CYAN",show_request(apply_filterIN($req)),"$CL\n--\n" if($showIN and $showFILTERED);      

  while(<$soc>) { $resp.=$_; } 

  print apply_filterOUT($resp); 
  print STDERR EncodeHexa("$GREEN","$resp"),"\n--\n" if($showOUT and $showUNFILTERED);      
  print STDERR EncodeHexa("$YELLOW",apply_filterOUT("$resp")),"\n--\n" if($showOUT and $showFILTERED);      
}

#---------------------------------------------------------------------#

sub random_string { # taken from whisker
  my ($str,$c);
  my $drift=(rand() * 10) % 10;
  for($c=0;$c<60+$drift;$c++){ 
    $str .= chr(((rand() * 26) % 26) + 97);}
  return $str;
}

sub random_passphrase {
  my $pass='';
  for(0..31) {
    $pass.=(0..9,'A'..'F')[rand 16];
  }
  $pass;
}

#---------------------------------------------------------------------#

sub anti_ids {
  my $uri = shift;
  my $delim = ' ';
  my $m;
  my $buf = '';

  if(    $uri =~ m-^(http://[^\/]+)(\/.*)$-i ) { $buf=$1;$uri=$2; } 
  elsif( $uri =~ m-^(http://[^\/]+)$-i ) { $buf=$1;$uri='/'; } 

  foreach $m (split //, $anti_ids_modes ) {
    if(    $m eq '1' ) {     #always generate an alert in RealSecure ;) 
      $delim = "  "; }     
    elsif( $m eq '2' ) {     #replace / with /./ (taken from whisker) 
      $uri=~s/\//\/.\//g; } 
    elsif( $m eq '3' ) {     #encode URL (taken from whisker) 
      $uri=~s/([-a-zA-Z0-9.])/sprintf("%%%x",ord($1))/ge;} 
    elsif( $m eq '4' ) {     #encode URL in unicode
      $uri=~s/([-a-zA-Z0-9.\/])/( ord($1) > 0x40 ? sprintf("%%c1%%%x",ord($1)-0x40): sprintf("%%c0%%%x",ord($1)) )/ge;
      $uri="/$uri";}
    elsif( $m eq '5' ) {     # long random URL (taken from whisker)
      $uri="/".&random_string."/..$uri";}
    elsif( $m eq '6' ) {     # Windows \ delimiter (taken from whisker)
      $uri=~s/\//\\/g;         # convert / to \
      $uri=~s/^\\/\//;         # first one needs to be /
      $uri=~s/\\$/\//;}        # last one needs to be /
    elsif( $m eq '7' ) {     # taken from whisker
      $delim = '\t'; }
  }
  return $delim.$buf.$uri;
}

#---------------------------------------------------------------------#

sub create_request {
  my ($com,$uri,$proto,$headers,$cont_len,$body) = @_;
  my $req = '';

  if( $convert_get_to_post and $com=~/^GET$/i ) {
    my ($file,$body) = split( /\?/, $uri );
    $body='' unless(defined $body);
    $cont_len = length($body);
    $headers .= "Content-length: $cont_len$EOL";
    $req = "POST".anti_ids($file)." $proto$EOL$headers$EOL$EOL$body$EOL";
  } else {
    $req = "$com".anti_ids($uri)." $proto$EOL$headers$EOL";
    $req.="$body" if($com=~/^POST$/i);
    $req.="$EOL";
  }
  return $req;
}

sub create_socket {
  my ($ip,$p) = @_;
  my $soc = IO::Socket::INET->new(Proto=>"tcp",PeerAddr=>$ip,PeerPort=>$p);
  $soc->autoflush(1) if($soc);
  return $soc;
}

#---------------------------------------------------------------------#

sub handle_request {
  my ($com,$uri,$proto,$headers,$cont_len,$body) = get_cli_req();
  return unless(defined $com);

  ### MODE MID PROXY ########
  if( $mode eq 'midproxy' ) {
    my $soc = create_socket($remote_ip,$remote_port);
    http_error("Cannot connect to $port/tcp on $remote_ip"),return unless($soc);
    if($force_auth) {
      my $auth_str = "Proxy-authorization: Basic ".b64enc($http_auth);
      if( $headers =~ /Proxy-authorization: Basic/ ) {
            $headers =~ s/Authorization:\s+Basic\s+\S+/$auth_str/ge; }
      else {$headers = $auth_str.$EOL.$headers;}
    }
    process_request($soc,create_request($com,$uri,$proto,$headers,$cont_len,$body));
    close $soc;
  } 
  ### MODE REVERSE PROXY #####
  elsif( $mode eq 'rproxy' ) {
    http_error("This is not a proxy"),return unless($uri=~m:^/:);
    my $soc = create_socket($remote_ip,$remote_port);
    http_error("Internal server error"),return unless($soc);
    if($force_auth) {
      my $auth_str = "Authorization: Basic ".b64enc($http_auth);
      if( $headers =~ /Authorization: Basic/ ) {
            $headers =~ s/Authorization:\s+Basic\s+\S+/$auth_str/ge; }
      else {$headers = $auth_str.$EOL.$headers;}
    }
    process_request($soc,create_request($com,$uri,$proto,$headers,$cont_len,$body));
    close $soc;
  }
  ### MODE PROXY #############
  elsif( $mode eq 'proxy' ) {
    my $file='/';

    if(    $uri =~ m;^http://([^:/]+)$;i )             { $remote_ip=$1; $remote_port=80; }
    elsif( $uri =~ m;^http://([^:/]+):(\d+)$;i )       { $remote_ip=$1; $remote_port=$2; }
    elsif( $uri =~ m;^http://([^:/]+)(\/.*)$;i )       { $remote_ip=$1; $remote_port=80; $file=$2; }
    elsif( $uri =~ m;^http://([^:/]+):(\d+)(\/.*)$;i ) { $remote_ip=$1; $remote_port=$2; $file=$3; }
    else { http_error("Invalid URI in proxy"); return; }

    my $soc = create_socket($remote_ip,$remote_port);
    http_error("Cannot connect to $port/tcp on $remote_ip"),return unless($soc);
    if($force_auth) {
      my $auth_str = "Proxy-authorization: Basic ".b64enc($http_auth);
      if( $headers =~ /Proxy-authorization: Basic/ ) {
            $headers =~ s/Authorization:\s+Basic\s+\S+/$auth_str/ge; }
      else {$headers = $auth_str.$EOL.$headers;}
    }
    process_request($soc,create_request($com,$file,$proto,$headers,$cont_len,$body));
    close $soc;
  }
  ### INVALID MODE #############
  else {
    http_error("Invalid mode");
    return;
  }

}

#---------------------------------------------------------------------#

sub perl_encode_base64 ($:$) { # ripped from MIME::Base64 from whisker :)
    my $res = "";
    pos($_[0]) = 0;
    while ($_[0] =~ /(.{1,45})/gs) {
        $res .= substr(pack('u', $1), 1);
        chop($res);}
    $res =~ tr|` -_|AA-Za-z0-9+/|;
    my $padding = (3 - length($_[0]) % 3) % 3;
    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
    $res; 
}

#EOF#

