Script para mandar noticias irrelevantes a meneame.net
Supongo que muchos de los que me leen saben el barullo que se ha montado en meneame.net.
Si no lo sabeis, no voy a ser yo el que lo explique :P
El caso es que acabo de encontrarme con un código muy curioso por internet:
#!/usr/bin/perl -w
# Irrelebot v1.0
use LWP::UserAgent;
# Configuration
my $user = 'PON AQUI TU NOMBRE DE USUARIO';
my $password = 'PON AQUI TU CONTRASEÑA';
my $query = 'prensa+rosa';
# Code
my $userAgent = LWP::UserAgent->new(
'agent' => 'Mozilla/5.0 (X11; U; Linux i686; es-ES; rv:1.9.0.7) Gecko/2009021906 Firefox/3.0.7',
'timeout' => 10
);
$userAgent->cookie_jar({});
# Logging to meneame.net
print "Loggeandose...\n";
$userAgent->get('http://meneame.net/login.php?return=%2F');
sleep(10);
my $meneameResponse = $userAgent->post('http://meneame.net/login.php', {
'username' => $user,
'password' => $password,
'persistent' => 'on',
'processlogin' => '1',
'return' => '/'
});
sleep(10);
my $meneameContent = $meneameResponse->content;
if ($meneameContent =~ m/error/) {
die "Error al loggearse\n";
}
print "Loggeado.\n";
while (1) {
my $googleResponse = $userAgent->get('http://www.google.com/search?q=' . $query . '&hl=es&lr=&safe=off&start=' . (int(rand(65)) * 10) . '&sa=N');
if (!$googleResponse->is_success) {
die "Error al conectar a www.google.com\n";
}
my $googleContent = $googleResponse->decoded_content;
# Parte cutre-salchichera hecha rapidamente
while ($googleContent =~ /<h3 class=r><a href="([^"]*)" class=l onmousedown=/) {
my $irrelevanteURL = $1;
my $irrelevanteResponse = $userAgent->get($irrelevanteURL);
if ($irrelevanteResponse->is_success) {
my $irrelevanteContent = $irrelevanteResponse->content;
if ($irrelevanteContent =~ m/<title>(.*?)<\/title>/) {
my $description = $1;
$description =~ s/&([^;]*?);//g;
my $title = $description;
if (length($title) > 120) {
$title = substr($title, 120);
}
print 'Enviando ' . $title . "...\n";
$meneameResponse = $userAgent->get('http://meneame.net/submit.php');
sleep(10);
$meneameContent = $meneameResponse->content;
$meneameContent =~ /<input type="hidden" name="key" value="([^"]*)" \/>/;
my $key = $1;
$meneameContent =~ /<input type="hidden" name="randkey" value="([^"]*)" \/>/;
my $randkey = $1;
$meneameResponse = $userAgent->post('http://meneame.net/submit.php', {
'url' => $irrelevanteURL,
'phase' => '1',
'key' => $key,
'randkey' => $randkey,
'id' => 'c_1'
});
sleep(10);
$meneameContent = $meneameResponse->content;
if (!($meneameContent =~ m/error/)) {
$meneameContent =~ /<input type="hidden" name="randkey" value="([^"]*)" \/>/;
$randkey = $1;
$meneameContent =~ /<input type="hidden" name="id" value="([^"]*)" \/>/;
my $id = $1;
$meneameResponse = $userAgent->post('http://meneame.net/submit.php', {
'url' => $irrelevanteURL,
'phase' => '2',
'key' => $key,
'randkey' => $randkey,
'type' => 'image',
'id' => $id,
'title' => $title,
'tags' => 'meneame, prensa, rosa, porcina',
'bodycounter' => 550 - length($title),
'bodytext' => $description,
'category' => 29
});
sleep(10);
$meneameContent = $meneameResponse->content;
if (!($meneameContent =~ m/error/)) {
$meneameContent =~ /<input type="hidden" name="randkey" value="([^"]*)" \/>/;
$randkey = $1;
$meneameContent =~ /<input type="hidden" name="id" value="([^"]*)" \/>/;
$id = $1;
$meneameResponse = $userAgent->post('http://meneame.net/submit.php', {
'phase' => '3',
'key' => $key,
'randkey' => $randkey,
'id' => $id,
'trackback' => ''
});
sleep(10);
$meneameContent = $meneameResponse->content;
if (!($meneameContent =~ m/error/)) {
print "Enviada...\n";
}
else {
print "Error al confirmar el envio\n";
}
}
else {
print "Error al escribir titulo/entradilla\n";
}
}
else {
print "Error de verificación\n";
}
}
}
$googleContent =~ s/<h3 class=r><a href="[^"]*" class=l onmousedown=//;
}
sleep(30);
}
Se supone que este código salchichero busca en google noticias irrelevantes sobre la prensa rosa y las publica en meneame.net cada pocos segundos.
No he visto código más feo y más inútil en toda mi vida ;)
Está hecho en PERL (que ironía) y para ejecutarlo es bastante simple: desde una consola unix sólo hay que lanzar "perl nombre_del_archivo_que_contenga_el_codigo.pl"
Yo no lo he usado, pero si alguien lo usa puede contarme en los comentarios qué tal le ha ido :P
1 opiniones irrelevantes más:
Un regalo para Perl en Perl jajajajajaja.
Publicar un comentario en la entrada