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 | |
by httptech (Chaplain) on Jun 09, 2000 at 02:23 UTC |