use threads; use Socket; use strict; use warnings; my $banned_type = { "cab" => 1, "class" => 1, "dat" => 1, "exe" => 1, "gif" => 1, "ico" => 1, "jpg" => 1, "js" => 1, "jsp" => 1, "png" => 1, "swf" => 1 }; my $banned_site = { "ad.doubleclick.net" => 1, "lz.mainentrypoint.com" => 1, "s.abetterinternet.com" => 1, "search-itnow.com" => 1, "www.ftstock.com" => 1, "www.mainentrypoint.com" => 1, "www.newshub.com" => 1 }; my $trusted_site = { "a248.e.akamai.net" => 1, "www.hsbc.ca" => 1 }; use constant RES_400 => "HTTP/1.1 400 Bad Request\r\n\r\n"; my $proto = getprotobyname('tcp'); socket(BROWSER_LISTENER, PF_INET, SOCK_STREAM, $proto) || die "Failed to create socket: $!"; setsockopt(BROWSER_LISTENER, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) || die "Failed to setsockopt: $!"; bind(BROWSER_LISTENER, sockaddr_in(8080, INADDR_ANY)) || die "Failed to bind: $!"; listen(BROWSER_LISTENER, SOMAXCONN) || die "Failed to listen: $!"; print "Internet filter started\n"; while (1) { my $browser; accept($browser, BROWSER_LISTENER); my $req; my $chunk; do { } until (!sysread($browser, $chunk, 10000) || ($req .= $chunk) =~ m/\r\n\r\n/); my $host = ($req =~ m/Host:\s*(.*?)\r/)[0]; my ($method, $page) = ($req =~ m/^(.*?)\s+(.*?)\s/); if ($host && $page) { if (is_trusted_site($host)) { threads->create(\&process_one_req, $browser, $req, $method, $host)->detach(); print "requested [$page] from a trusted site\n"; } else { if (is_banned_site($host) || is_banned_type($page)) { print "[$host, $page] is banned\n"; print $browser RES_400; close($browser); } else { print "[$host, $page] is not banned\n"; threads->create(\&process_one_req, $browser, $req, $method, $host)->detach(); } } } else { close($browser); } } sub process_one_req { my ($browser, $req, $method, $host) = @_; my $iaddr = inet_aton($host) || die "no host: $host"; my $paddr = sockaddr_in(80, $iaddr); $proto = getprotobyname('tcp'); my $remote; socket($remote, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; connect($remote, $paddr) || die "connect: $!"; print $remote $req, "\r\n"; my $chunk; while (sysread($remote, $chunk, 10000)) { print $browser $chunk; open(LOG, ">>log.txt"); print LOG $chunk; close LOG; } close($remote); undef($remote); close($browser); undef($browser); undef($req); undef($host); } 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; } if ($site =~ m/hitbox.com$/) { return 1; } return 0; } sub is_trusted_site { my $site = shift; return 1 if (exists($trusted_site->{$site})); } sub is_banned_type { my $tmp = lc(shift); =document $tmp =~ m/(.*?)\:\/\/((?:(?:.*)\/)*)(.*)/; my $proto = $1; my $path = $2; my $file = $3; my $query; my $type; if ($file) { ($file, $query) = split(/\?/, $file); ($file, $type) = split(/\./, $file); } =cut $tmp = (split /\//, $tmp)[-1]; my $type = (split /\./, $tmp)[-1]; print "type = $type\n" if ($type); if ($type && exists($banned_type->{$type})) { return 1; } else { return 0; } }