Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

RE: Benevolent Ad Filter

by httptech (Chaplain)
on Jun 08, 2000 at 01:30 UTC ( [id://16967]=note: print w/replies, xml ) Need Help??


in reply to Benevolent Ad Filter

#!/usr/bin/perl use CGI::Carp qw(fatalsToBrowser); use Net::DNS; use Socket; my $url = my $path = $ENV{'REQUEST_URI'}; my $host = $ENV{'HTTP_HOST'}; my $referrer = $ENV{'HTTP_REFERER'}; my $useragent = $ENV{'USER_AGENT'}; my $content_type; $path =~ s#/([^/])*$##; GETCONTENT: $content_type = &get_content_type; &print_gif if $content_type =~ /image/; &print_text; exit; sub print_text { print "Content-type: $content_type\n\n<!-- -->\n"; ex +it } sub print_gif { # Prints a transparent GIF. Adapted from code created by Turnstep: # http://www.perlmonks.org/index.pl?node_id=7974 print "Content-Length: 43\nContent-type: image/gif\n\n"; printf "GIF89a\1\0\1\0%c\0\0%c%c%c\0\0\0%s,\0\0\0\0\1\0\1\0\0%c%c% +c\1\0;", 144,0,0,0,1?pack("c8",33,249,4,5,16,0,0,0):"",2,2,4; exit; } sub nslookup { my $host = shift; my $dns = new Net::DNS::Resolver; my $query = $dns->search($host); if ($query) { for $rr ($query->answer) { next unless $rr->type eq "A"; return $rr->address; } } else { die "lookup of $host failed: ", $dns->errorstring, "\n"; } } sub get_content_type { my ($type, $location); my $addr = &nslookup($host); my $proto = getprotobyname('tcp'); my $inet = inet_aton($addr); socket(S,PF_INET,SOCK_STREAM,$proto) || die "Couldn't open socket: + $!"; if (connect(S,pack "SnA4x8",2,80,$inet)) { select (S); $| = 1; print "GET $url HTTP/1.0\r\n"; print "Referer: $referrer\r\n"; print "User-Agent: $useragent\r\n\r\n"; while (<S>) { if (/^Content-type:\s*(.*)(?:\;|\n)/i) { $type = $1 } if (/^Location:\s*(.*)$/i) { $location = $1 } last if /^\s*$/; # Close the connection after getting the +headers } select (STDOUT); close S; } else { die "Couldn't connect to $host : $!" } if ($location) { # We've been redirected if ($location =~ m#^http://([^/]*)/(.*)$#) { $host = $1; $url = "/$2"; } else { $url = ($location =~ /^$path/o) ? $location : "$path/$loca +tion"; } goto GETCONTENT; } return $type; }

Replies are listed 'Best First'.
FilterProxy
by floopy (Sexton) on Jun 09, 2000 at 02:04 UTC
    This is somewhat related: I recently installed FilterProxy, a Proxy http server written in Perl of course. What's quite nice about it is that one can point one's web browser at the proxy port and configure all the regexes used, etc. *excellent* program if you don't want to install apache to use this one. The only real advantage to punk music is that nobody can whistle it.
      Actually you really don't need to install Apache to use this. You could use Miniweb, the standalone single-CGI script http server that runs from inetd.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://16967]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others sharing their wisdom with the Monastery: (4)
As of 2024-06-20 05:13 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.