I wrote this for myself, to stop those garbages on internet and speed up, by not forwarding certain requests.

It works and satisfied my needs, however core dumps once a while. Can anyone spot anything, or just pure guess? Your help is greatly apprecaited.

use IO::Socket::INET;
use threads;
use strict;
use warnings;

my $banned_type = {
    "cab" => 1,
    "class" => 1,
    "dat" => 1,
    "exe" => 1,
    "gif" => 1,
    "js" => 1,
    "swf" => 1
};

my $banned_site = {
    "ad.doubleclick.net" => 1,
    "search-itnow.com" => 1,
    "www.ftstock.com" => 1,
    "www.newshub.com" => 1
};

use constant RES_400 => "HTTP/1.1 400 Bad Request\r\n\r\n";
use constant LISTEN_SIZE => 20;
use constant LISTEN_PORT => 8080;
use constant MAX_REQ_SIZE => 5000;

my $browser_listener = new IO::Socket::INET(Proto => "tcp",
                                       LocalAddr => "localhost",
                                       LocalPort => LISTEN_PORT,
                                       Resue => 1,
                                       Listen => LISTEN_SIZE)
                  || die "Failed to initialize browser listener socket
+\n";
print "Internet filter started\n";
while (1) {
    my $browser = $browser_listener->accept();
    if ($browser) {
        my $req;
        sysread($browser, $req, MAX_REQ_SIZE);
        my $host = ($req =~ m/Host:\s*(.*?)\r/)[0];
        my ($method, $page) = ($req =~ m/^(.*?)\s+(.*?)\s/);
        print "Received request for [$host, $page]\n";
        if ($method eq "GET") {
            if ($host && $page) {
                if (is_banned_site($host) || is_banned_type($page)) {
                    print "[$host, $page] is banned\n";
                    print $browser RES_400;
                    close($browser);
                } else {
                    threads->create(\&process_one_req, $browser, $req,
+ $host);
                }
            } else {
                open(BUG, ">bug.txt");
                print BUG $req;
                close(BUG);
                close($browser);
            }
        } else {
            threads->create(\&process_one_req, $browser, $req, $host);
        }
    } else {
        print "Bad accept, skip\n";
    }
}

sub process_one_req {
    my ($browser, $req, $host) = @_;
    my $remote = new IO::Socket::INET(Proto => "tcp", PeerAddr => $hos
+t, PeerPort => 80);
    if ($remote) {
        print $remote $req;
        my $chunk;
        print $browser $chunk while (sysread($remote, $chunk, 10000));
        close($remote);
        undef($remote);
    } else {
        print $browser RES_400;
    }
    close($browser);
    undef($browser);
}

sub is_banned_site {
    my $site = shift;
    return 1 if (exists($banned_site->{$site}));

    if ($site =~ m/offeroptimizer/) {
        return 1;
    }
    if ($site =~ m/revenue.net$/) {
        return 1;
    }
    if ($site =~ m/popupsponsor.com$/) {
        return 1;
    }
    return 0;
}

sub is_banned_type {
    return (exists($banned_type->{(split(/\./, shift))[-1]})) ? 1 : 0;
}

[download]

In reply to another core dump by pg

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.