#!/usr/bin/perl
use strict;
use warnings;
use HTTP::Proxy;
use HTTP::Proxy::HeaderFilter::simple;
use HTTP::Response;
use Log::Log4perl;
use FindBin;
use YAML;
use Getopt::Long;
use LWP::UserAgent;

my $LOGCONF="$FindBin::Bin/log.conf";
my $PORT=3128;
my @PATFILES=map {"$FindBin::Bin/adzap/scripts/$_"} qw(prematch.list squid_redirect postmatch.list);
my $ZAPSDIR="$FindBin::Bin/adzap/zaps";

my @PATTERNS;

{

sub subptn2re {
  my ($pat)=@_;
  return "[^/]*" if $pat eq '*'; # * -> [^/]*
  return ".*" if $pat=~/^\*+$/;  # ** -> .*
  return $pat;                   # leave everything else alone
}

sub ptn2re {
  my ($pat)=@_;
  $pat=~s|([.\@\%\$+])|\\$1|g;               # quote specials
  $pat=~s|([^(])(\?)|$1\\$2|g;                    # quote some question marks
  $pat=~s|/+|/+|g;                           # turn slashes into "/+"
  $pat=~s:(\\.|[^*\\]|\*+):subptn2re($1):ge; # expand wildcards
  my $ret=eval{qr{^$pat$}};
  return if $@;
  return $ret;
}

my %ACTIONS=(
             PASS => [\&pass],
             NOZAP => [\&redirect],
             AD => [\&constant,'ad.gif', 'image/gif'],
             ADBG => [\&constant,'adbg.gif', 'image/gif'],
             ADPOPUP => [\&constant,'closepopup.html', 'text/html'],
             ADJS => [\&constant,'no-op.js', 'text/javascript'],
             ADJSTEXT => [\&constant,'no-op.js', 'text/javascript'],
             ADHTML => [\&constant,'no-op.html', 'text/html'],
             ADHTMLTEXT => [\&constant,'no-op.html', 'text/html'],
             COUNTER => [\&constant,'counter.gif', 'image/gif'],
             COUNTERJS => [\&constant,'no-op-counter.js', 'text/javascript'],
             COUNTERHTML => [\&constant,'no-op-counter.html', 'text/html'],
             WEBBUG => [\&constant,'webbug.gif', 'image/gif'],
             WEBBUGJS => [\&constant,'webbug.js', 'text/javascript'],
             WEBBUGHTML => [\&constant,'webbug.html', 'text/html'],
             ADMP3 => [\&constant,'ad.mp3', 'audio/mpeg'],
             ADSWF => [\&constant,'ad.swf', 'application/x-shockwave-flash'],
             PRINT => [\&redirect],
             REWRITE => [\&redirect],
             ANTICRACK => [\&constant,'ad.gif', 'image/gif'],
             HR => [\&constat,'ad-clear.gif','image/gif'],
             URCHIN => [\&constant,'urchin.js','text/javascript'],
            );

my $addPatternLogger=Log::Log4perl->get_logger('MyProxy.load.addPattern');
sub addPattern {
  my ($action,$match,@parms)=@_;

  $addPatternLogger->debug("adding: $action ($match) -> [@parms]");

  unless (exists $ACTIONS{$action}) {
    $addPatternLogger->error("Unknown action $action, skipping");
    return;
  }
  my $re=ptn2re($match);
  push @PATTERNS,[$re,@{$ACTIONS{$action}},@parms] if $re;
}

my $loadPatternsLogger=Log::Log4perl->get_logger('MyProxy.load.loadPatterns');
sub loadPatterns {
  my ($file)=@_;

  my $fh;
  open $fh,'<',$file or do {
    $loadPatternsLogger->warn("Can't open $file");
    return;
  };
  $loadPatternsLogger->info("Opening $file");
  my $state=0;
  my @line;
  while (<$fh>) {
    chomp;
    next unless $_!~/^\s*$/;
    next if /^#/;
    $loadPatternsLogger->debug("Got line: $_");
    @line=split /\s+/,$_;
    if ($state==0) { # non sappiamo ancora se è una lista o un sorgente Perl
      if (uc($line[0]) eq $line[0]) {
        $loadPatternsLogger->debug("detected pattern");
        $state=1;
        addPattern(@line);
      } else {
        $loadPatternsLogger->debug("detected Perl header, skipping");
        $state=2;
      }
    } elsif ($state==2) { # è un sorgente Perl, skip fino a __DATA__
      /^__DATA__\b/ and $state=1;
    } else { # abbiamo un pattern
      addPattern(@line);
    }
  }
}
}

{
my $passLogger=Log::Log4perl->get_logger('MyProxy.filter.pass');
sub pass {
  my ($proxy,$request,@parms)=@_;
  my $uri=$request->uri;
  if ($passLogger->is_debug()) {$passLogger->debug("passing $uri [@parms]")}
  return;
}

my $constantLogger=Log::Log4perl->get_logger('MyProxy.filter.constant');
sub constant {
  my ($proxy,$request,$theFile,$type)=@_;
  my $uri=$request->uri;
  if ($constantLogger->is_debug()) {
    $constantLogger->debug("passing $theFile($type) for $uri");
  }
  my $res=HTTP::Response->new(200);
  $res->content_type($type);
  {local $/;
   open my $fh,'<',"$ZAPSDIR/$theFile" or do {
     $constantLogger->error("Can't open $ZAPSDIR/$theFile");
   };
   my $data=<$fh>;
   $res->content($data);}
  $proxy->response($res);
}

my $redirectLogger=Log::Log4perl->get_logger('MyProxy.filter.redirect');
sub redirect {
  my ($proxy,$request,$newUrl)=@_;
  my $uri=$request->uri;
  if ($redirectLogger->is_debug()) {
    $redirectLogger->debug("redirecting from $uri to $newUrl");
  }
  my $matches=$proxy->stash('url_matches');
  $newUrl=~s{^\d+:}{}; # kill the redirect value: we always send 302
  $newUrl=~s{\$(\d)}{$matches->[-1+$1]}ge; # expand match vars
  $newUrl=~s{\$\{?\&\}?}{$proxy->stash('full_match')}ge; # full match expand
  $newUrl=~s{\$\{?`\}?}{$proxy->stash('pre_match')}ge;
  $newUrl=~s{\$\{?'\}?}{$proxy->stash('post_match')}ge;

  if ($redirectLogger->is_debug()) {
    $redirectLogger->debug("new url = $newUrl");
  }
  my $res=HTTP::Response->new(302);
  $res->header(Location => $newUrl);
  $proxy->response($res);
}

my $doFilterLogger=Log::Log4perl->get_logger('MyProxy.filter.doFilter');
sub doFilter {
  my ($self,$headers,$request)=@_;
  my $uri=$request->uri;$uri="$uri";
  if ($doFilterLogger->is_debug()) {
    $doFilterLogger->debug("Looking at $uri");
  }
  for (@PATTERNS) {
    my ($pat,$sub,@rest)=@$_;
    if ($uri=~/$pat/) {
      if ($doFilterLogger->is_debug()) {
          $doFilterLogger->debug("$uri matched $pat");
      }
      $self->proxy->stash('url_matches',[$1,$2,$3,$4,$5,$6,$7,$8,$9]);
      $self->proxy->stash('pre_match',substr($uri,0,$-[0]));
      $self->proxy->stash('full_match',substr($uri,$-[0],$+[0]-$-[0]));
      $self->proxy->stash('post_match',substr($uri,$+[0]));
      $sub->($self->proxy(),$request,@rest);
      last;
    }
  }
}
}

{ # jumpurl
  my $jumpFilterLogger=Log::Log4perl->get_logger('MyProxy.filter.jumpFilter');
sub jumpFilter {
  return unless -f '/tmp/jumpurl';
  my ($self,$headers,$request)=@_;
  my $uri=$request->uri;
  $jumpFilterLogger->debug("Should $uri jump?");
  return if $uri =~ m|^http://(.*?)stumbleupon.com/|;
  my $stuff;
  my $u=URI->new($uri);
  my %p=$u->query_form();
  $jumpFilterLogger->debug("Params:".Dump(\%p));
  if (exists $p{u} && $u->path =~ /((outp?|c|process)\.(php|cgi))|(\/[lc]$)/) {$stuff=$p{u}}
  elsif (exists $p{url}) {$stuff=$p{url}}
  elsif (exists $p{URL}) {$stuff=$p{URL}}
  elsif (exists $p{gal}) {$stuff=$p{gal}}
  elsif (exists $p{link}) {$stuff=$p{link}}
  else {return}
  if (
      $stuff !~ m{://}
          and
              $stuff =~ m{^\w+\.\w+}
          ) {
      $stuff='http://'.$stuff
  }
  return unless $stuff =~ m{^http://};
  $jumpFilterLogger->debug("Jumping from $uri to $stuff");
  my $res=HTTP::Response->new(302);
  $res->header(Location => $stuff);
  $self->proxy->response($res);
}
}

{
  my $viaLogger=Log::Log4perl->get_logger('MyProxy.filter.viaProxy');
  my $ua=LWP::UserAgent->new(
  	keep_alive=>2,
	parse_head=>0,
	);
  $ua->proxy('http','http://dechirico:3128/');
  $ua->requests_redirectable([]);
sub viaProxy {
  my ($self,$headers,$request)=@_;
  my $uri=$request->uri;
  $viaLogger->debug("Forwarding $uri");
  return if $uri !~ m|^http://(.*?)teoma.com/|;
  my $response=$ua->request($request);
  $self->proxy->response($response);
}
}

{
  my $socks=0;
  GetOptions('socks|s!' => \$socks,
             'port|p=i' => \$PORT,
             'log|l=s' => \$LOGCONF,
         );
  Log::Log4perl::init($LOGCONF);
  my $logger=Log::Log4perl->get_logger('MyProxy.main');
  $logger->info("Loading...");
  for (@PATFILES) {loadPatterns($_)};
  if ($socks) {
      $logger->info("Using SOCKS");
      require LWP::Protocol::http::SocksChain;
      LWP::Protocol::implementor( http => 'LWP::Protocol::http::SocksChain' );
      @LWP::Protocol::http::SocksChain::EXTRA_SOCK_OPTS=( Chain_Len    => 1,
                                                          Debug        => 0,
                                                          Random_Chain => 0,
                                                          Auto_Save    => 1,
                                                          Restore_Type => 1,
                                                      );
  }
  my $proxy=HTTP::Proxy->new(port=>$PORT,engine=>'ScoreBoard');
  $proxy->push_filter(request => HTTP::Proxy::HeaderFilter::simple->new(\&doFilter));
  $proxy->push_filter(request => HTTP::Proxy::HeaderFilter::simple->new(\&jumpFilter));
  $proxy->push_filter(request => HTTP::Proxy::HeaderFilter::simple->new(\&viaProxy));
  $logger->info("Running on port ".$proxy->port());
  $proxy->start();
}
