use IO::Select; use IO::Socket; use Tk::DialogBox; 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 $trusted_site = { "www.perlmonks.org"=>1 }; use constant RES_400 => "404 HTTP/1.1 Banned\r\n\r\n

Banned

"; use constant FAILED_TO_CONNECT_REMOTE => "404 HTTP/1.1 Banned\r\n\r\n< +html>Failed to connect remote site %s"; my $mw = MainWindow->new(); my $browser_listener = new IO::Socket::INET(Proto => "tcp", LocalAddr => "localhost", LocalPort => 8080, Reuse => 1, Timeout => 1, Listen => 10) || die "fail +ed to create browser listener"; my $selector = new IO::Select(); my %pairs = (); while (1) { if (my $browser = $browser_listener->accept()) { my $req = recv_req($browser); my $remote = send_req($browser, $req); if ($remote) { $selector->add($remote); $pairs{$remote} = $browser; }; } foreach my $remote ($selector->can_read(1)) { my $res = read_res($remote); if ($res) { send_res($pairs{$remote}, $res); } else { $selector->remove($remote); $remote->close(); $pairs{$remote}->close(); delete $pairs{$remote}; } } } sub recv_req { my ($browser, $thread_id) = @_; my $content_length = 0; my $req = ""; while (1) { my $chunk; $browser->recv($chunk, 10000); if ($chunk =~ m/Content-Length: (\d*)/) { $content_length = $1; } $req .= $chunk; last if ($chunk =~ "\r\n\r\n"); } $req =~ /(.*?)\r\n\r\n(.*)/s; if (length($2) > 0) { $content_length -= length($2); print "after -, content_length = $content_length\n"; } while ($content_length > 0) { my $chunk; $browser->recv($chunk, $content_length); $req .= $chunk; $content_length -= length($chunk); } return $req; } sub send_req { my ($browser, $req) = @_; my $host = ($req =~ m/Host:\s*(.*?)\r/)[0]; my $remote; #some web site does not like repeat siet in get/post $req =~ s/$host//; #only once $req =~ s/http:\/\///; $req =~ m/.*?\s+(.*?)\s/; my $page = $1; if (!defined($trusted_site->{$host})) { ##

##

		my $dialog = $mw->DialogBox(-title => "Is $host trusted?", -buttons => ["Yes", "No"]);
		$dialog->geometry("600x100+0+0");
		$dialog->deiconify();
		my $answer = $dialog->Show(-global, -popover=>"cursor");
		
		if ($answer eq "Yes") {
			$trusted_site->{$host} = 1;
		} else {
			$trusted_site->{$host} = 0;
		}

##

##

}
	if (!$trusted_site->{$host} || is_banned_type($page)) {
            print "[$host, $page] is banned\n";
            print $browser RES_400;
            close($browser);
        } else {
            if ($remote = new IO::Socket::INET(Proto => "tcp", PeerAddr => $host, PeerPort => 80)) {
                $remote->send($req);
            }
        }
    return $remote;
}

sub read_res {
    my $remote = shift;
    my $res;
    $remote->recv($res, 100000);
    if (!length($res)) {
        $res = undef;
    }
    return $res;
}

sub send_res {
    my ($browser, $res) = @_;
    $browser->send($res);
}


sub is_banned_type {
    my $tmp = lc(shift);
    if ($tmp ne "/") {
        $tmp = (split /\//, $tmp)[-1];
        my $type = (split /\./, $tmp)[-1];

        if ($type && exists($banned_type->{$type})) {
            return 1;
        } else {
            return 0;
        }
    }    
}