RE: Benevolent Ad Filter

[httptech]

#!/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;
}

[floopy]

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.

[httptech]

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.