diff options
Diffstat (limited to 'MyProxy.pl')
| -rwxr-xr-x | MyProxy.pl | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/MyProxy.pl b/MyProxy.pl new file mode 100755 index 0000000..34ffe9c --- /dev/null +++ b/MyProxy.pl @@ -0,0 +1,223 @@ +#!/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(); +} |