%once>
use strict;
use URI;
use LWP::Simple qw(get $ua);
use HTML::TokeParser::Simple;
%once>
<%perl>
unless (length($url)) {
$m->out('Isto é um proxy da treta... dá-me um argumento url para eu ir buscar. Não, não suporta forms nem cookies(nunca dariam).');
$m->out('
Exemplo: http://dev.karlus.net/proxy/?url=http://www.sapo.pt');
$m->out('
Dominios/wildcards disponiveis: ');
$m->out(map { "$_ "} keys %allowed);
$m->out('
Bugs para proxy.da.treta@karlus.net');
return;
}
$url = 'http://'.$url unless $url =~ /^http:\/\//;
my $u = URI->new($url);
unless ($u && map { $u->host =~ m/$_$/} keys %allowed) {
$m->out('Beeeeep!
Só pode surfar pelos dominios: ');
$m->out(map { "$_ "} keys %allowed);
return;
}
if ($url) {
my $base_uri = URI->new_abs('./',$url);
my $page = get($url);
if (length($page)) {
my $p = HTML::TokeParser::Simple->new(\$page);
while ( my $token = $p->get_token ) {
if ( $token->is_start_tag('a') ) {
my $action = $token->return_attr->{href};
$action =~ s/^[\.|\.\.]//;
my $uri = URI->new_abs($action, $base_uri );
$token->set_attr('href', $proxy_url.$uri);
}
if ( $token->is_start_tag('img') ) {
my $action = $token->return_attr->{src};
$action =~ s/^[\.|\.\.]//;
my $uri = URI->new_abs($action, $base_uri );
$token->set_attr('src',$uri);
}
if ( $token->is_start_tag('form') ) {
my $action = $token->return_attr->{action};
$action =~ s/^[\.|\.\.]//;
my $uri = URI->new_abs($action, $base_uri );
$token->set_attr('action',$proxy_url.$uri);
}
$m->out($token->as_is);
}
} else {
$m->out('Não consegui ir buscar (not found?)');
}
}
%perl>
<%args>
$url => undef
%args>
<%init>
$ua->timeout(10);
my $proxy_url = 'http://dev.karlus.net/proxy/?url=';
my %allowed = ('.sapo.pt' => 1,
'.clix.pt' => 1,
'.google.pt' => 1);
%init>