path: root/MyProxy.pl

#!/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;
 
# qui dovrei inizializzare log4perl 
Log::Log4perl::init("$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|/+|/+|g;                           # turn slashes into "/+" 
  $pat=~s:(\\.|[^*\\]|\*+):subptn2re($1):ge; # expand wildcards 
  return qr{^$pat$};
}
 
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;
  }
  push @PATTERNS,[ptn2re($match),@{$ACTIONS{$action}},@parms];
}
 
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/) {
      $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 $logger=Log::Log4perl->get_logger('MyProxy.main');
  $logger->info("Loading...");
  for (@PATFILES) {loadPatterns($_)};
  my $proxy=HTTP::Proxy->new(port=>$PORT);
  $proxy->push_filter(request => HTTP::Proxy::HeaderFilter::simple->new(\&doFilter));
  $proxy->push_filter(request => HTTP::Proxy::HeaderFilter::simple->new(\&jumpFilter));
  $logger->info("Running on port ".$proxy->port());
  $proxy->start();
}