#!/usr/bin/perl
# Copyright Carlos Francisco Ferry Sauterel a.k.a zOrK - carlos@gnu.cl
# Baalux0.1: March 29, 2007
# Baalux0.2: May 27, 2007
BEGIN {
use strict;
use warnings;
use Cwd;
use DBI;
use Net::DNS;
use Data::Dumper;
use LWP::UserAgent;
use Lingua::Identify qw/langof/;
use CGI qw(:standard);
use HTML::TokeParser;
use HTML::SimpleLinkExtor;
use HTML::LinkExtor;
use Term::ANSIColor qw(:constants);
use open ':utf8';
use Acme::Comment type => 'C++', one_line => 1, own_line => 0;
my $curdir = getcwd;
my $ifor = 10;
my $nprintmode = 'term';
my $timeout=65;
my $identifier = "NS";
my $dfolder=$curdir . '/getemp/';
my $lfolder=$curdir . '/logs/';
my $datafolder=$curdir . '/data/';
my $server = `uname -n`;;
my $range = 5000;
my $dsn = 'DBI:mysql:wildserv:localhost';
my $dusn = 'wildserv';
my $dpass = 'XXXXXXXXXXXXXXXXXXXXX';
my $dbh = DBI->connect($dsn, $dusn, $dpass);
no warnings "recursion";
$Term::ANSIColor::AUTORESET = 1;
$SIG{'INT'} = 'CLEANUP';
$SIG{'HUP'} = 'CLEANUP';
if ($ARGV[0] eq "stop") {
CLEANUP();
}
/* I make a general check */
start_check();
/* I check if mySQL works || not */
if (!$dbh) {
nprint("E","Couldn't connect!.");
die;
} else {
nprint("S","Connection to mySQL established.");
}
sub start_check {
my $lfolder_status;
nprint("N","Starting.");
/* We check directories, incorrenctly named as folder in vars */
if (!chdir($lfolder)) {
$lfolder_status = "N";
mkdir($lfolder);
} else {
nprint("N","'$lfolder' exists");
chdir($curdir);
}
nprint("N","Checking software ...");
nprint("N","Checking directories ...");
if (defined($lfolder_status)) {
if ($lfolder_status eq "N"){
nprint("E","'$lfolder' didn't exist!");
nprint("N","'$lfolder' created");
}
}
if (!chdir($dfolder)) {
nprint("E","'$dfolder' doesn't exist!");
nprint("N","Creating '$dfolder'..");
mkdir($dfolder);
} else {
nprint("N","'$dfolder' exists");
chdir($curdir);
}
if (!chdir($datafolder)) {
nprint("E","'$datafolder' doesn't exist!");
nprint("N","Creating '$datafolder'..");
mkdir($datafolder);
} else {
nprint("N","'$datafolder' exists");
chdir($curdir);
}
}
/* Colors in nprint: E = ERROR - S = SUCCESSFUL OPERATION - N = NORMAL OPERATION */
sub nprint {
my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
my $time = sprintf("%0.2d:%0.2d:%0.2d",$hour,$min,$sec);
my $date = sprintf("%0.4d/%0.2d/%0.2d",$year+1900,++$mon,$mday);
my $ldate = sprintf("%0.4d-%0.2d-%0.2d",$year+1900,++$mon,$mday);
my $timestamp = "$time - $date";
my ($flag, $lfile, $npm);
if ($_[0] eq "E") {
$lfile = $lfolder . "errors.log";
}
else {
$lfile = $lfolder . $ldate . "-logs.txt";
}
open PFILE, ">>$lfile" or die nprint("E","Unable to open $lfile $!");
if ($_[0] eq "E") {
$flag = RED;
}
elsif ($_[0] eq "S") {
$flag = GREEN;
}
elsif ($_[0] eq "N") {
$flag = YELLOW;
}
print PFILE $flag . '[' . $identifier . '][' . $timestamp . ']-> ' . $_[1] . "\n", RESET;
close PFILE;
}
sub work_words {
open( FILE, "< $_[0]" ) or die "Can't open $_[0] : $!";
close FILE;
}
sub get_ahref {
my $sth;
my $url_from = $_[1];
my ($c, $nc, $t);
my $extor = HTML::SimpleLinkExtor->new($url_from);
$extor->parse_file(shift);
my @a_hrefs = $extor->a;
$sth = $dbh->prepare(qq{ delete from `linkers` where url_from = ? });
$sth->execute("$url_from");
foreach $a (@a_hrefs) {
$sth = $dbh->prepare(qq{ select id from `linkers` where url_to = ? and url_from = ? });
$sth->execute("$a","$url_from");
my $link_id = $sth->fetchrow_array();
if (!defined($link_id) && "$a" ne "$url_from")
{
$sth = $dbh->prepare(qq{ insert into `linkers` (url_to, url_from) values (?, ?) });
$sth->execute("$a","$url_from");
}
$sth = $dbh->prepare(qq{ select id from `update` where url = ? });
$sth->execute("$a");
my $update_id = $sth->fetchrow_array();
if (!defined($update_id)) {
$sth = $dbh->prepare(qq{ insert into `update` (url, next_date) values (?, 0000-00-00) });
$sth->execute("$a");
}
undef $link_id;
undef $update_id;
}
#nprint ("S","Linkers $c added - $nc not added - $t total.");
}
sub clean_protocol {
my $url = $_[0];
$url =~ s/^(.*):\/\///m;
$url =~ s/\/(.*)$//m;
return $url;
}
sub get_description {
my $content;
my $p = HTML::TokeParser->new($_[0]);
while ( my $tag = $p->get_tag("meta") ) {
if ( defined( $tag->[1]{'name'} )) {
if($tag->[1]{'name'} eq "description") {
$content = $tag->[1]{'content'}
}
};
}
/* I'm going to try to get description by h1 ;-) */
if (!defined($content)) {
$p = HTML::TokeParser->new($_[0]);
if ($p->get_tag("h1")) {
$content = $p->get_trimmed_text;
}
}
return $content;
}
sub get_dns {
my $basedomain = $_[0];
if ($basedomain =~ /\/$/) {
$basedomain =~ s/\/$//g;
}
#print "$basedomain !\n";
my $res = Net::DNS::Resolver->new;
my $query = $res->search($basedomain);
my $dns;
my $status;
if ($query) {
foreach my $rr ($query->answer) {
next unless $rr->type eq "A";
$dns = $rr->address;
$status = "Y";
nprint("S","DNS: $basedomain -> " . $rr->address);
}
} else {
nprint ("E","DNS query failed: $res->errorstring");
$status = "N";
}
return ($status,$dns);
}
sub get_erank {
my $co;
my $erank;
my $sth;
$sth = $dbh->prepare(qq{ select url_from from `linkers` where url_to = ? });
$sth->execute("$_[0]");
while (defined(my $url_from = $sth->fetchrow_array())) {
$co++;
}
if (!defined($co)) {
$erank = 0.0000000003;
} else {
$erank = $co * 0.000000004;
}
return $erank;
}
sub get_title {
my $title;
my $p = HTML::TokeParser->new($_[0]);
if ($p->get_tag("title")) {
$title = $p->get_trimmed_text;
if (defined($title)) {
return $title;
}
}
}
sub wget {
my ($status, $rnumber, $wget_outfile, $response);
my $read_size = ":read_size_hint";
$rnumber = rand($range);
$wget_outfile = $dfolder . $rnumber . '.html';
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/5.0');
$ua->protocols_allowed( [ 'http', 'ftp', 'https'] );
$ua->from('carlos@gnu.cl');
$ua->timeout($timeout);
$ua->env_proxy;
nprint("N","Ready to download $_[0] ");
$response = $ua->get($_[0]);
if ($response->is_success) {
open OUT, "> $wget_outfile" or exit nprint("E","Can't open $wget_outfile : $!");
nprint("S",$response->status_line);
print OUT $response->content;
close OUT;
$status = "S";
return ($status,$wget_outfile);
}
else {
nprint("E","Something wrong happened while processing $_[0]");
nprint("E",$response->status_line);
$status = "N";
return $status;
}
}
sub get_lang {
my @lang;
my $langfilename = $_[0];
open( FILEL, "< $langfilename" ) or nprint ("E","Can't open $langfilename : $!");
foreach my $line (<FILEL>) {
push @lang, $line;
}
close FILEL;
my $text = join "\n", @lang;
my $language = langof($text);
return $language;
}
sub dump_html {
my @dumped = ` lynx -dump -nolist -nonumbers -dont_wrap_pre $_[0]`;
return @dumped;
}
sub fetch {
my $cleaned_url = clean_protocol($_[0]);
my $sth;
/* A function which recognizes how often does a webpage changes should be here, read carlos castillo tesis. */
$sth = $dbh->prepare(qq{ update `update` SET `ip` = 'Y', `sv` = '$server' where url = ? });
$sth->execute($_[0]);
my ($dns_status, $dns) = get_dns($cleaned_url);
if ($dns_status eq "N") {
nprint("E","Couldn't reverse $_[0], trying next page");
/* A function which sets this domain for tomorrow should be here. */
}
else
{
my ($line, @fline, @url_links, $p);
my ($downl_status, $downl_file) = wget($_[0]);
#VALUE RETURNED SHOULD INDICATE: N = NOT SUCCESSFUL OPERATION, S = SUCCESSFUL OPERATION.
if ($downl_status eq "N")
{
&nprint("E","Error!");
}
else
{
nprint("S","$_[0] downloaded successfully.");
# open( FILE , "< $downl_file" ) or die nprint("E","Can't open $downl_file : $!");
# nprint("N","Opening $downl_file ..");
# foreach $line (<FILE>)
# {
# push @fline, $line;
#}
#close FILE;
my $webtitle = get_title($downl_file);
my $webdesc = get_description($downl_file);
/* aca deberia ir una opcion porq si es .pdf lo mande a dump_pdf, quizas sera necesario q todas las funciones (dump_html, get_lang, get_erank)
sean una variable dependiendo si es .pdf o .html ($dump, $lang), etc*/
my @dumped = dump_html($downl_file);
my $lang = get_lang($downl_file);
my $erank = get_erank($_[0]);
$sth = $dbh->prepare(qq{ select id from `indexed` where url = ? });
$sth->execute("$_[0]");
my $url_id = $sth->fetchrow_array();
if (!defined($url_id)) {
$sth = $dbh->prepare(qq{ insert into `indexed` (url, webtext, webdesc, language, title, rank) values (?, ?, ?, ?, ?, ?) });
$sth->execute("$_[0]", "@dumped", "$webdesc", "$lang", "$webtitle","$erank");
nprint("S","New url $_[0] Added to the DB.");
} else {
$sth = $dbh->prepare(qq{ update `indexed` set webtext = ?, webdesc = ?, language = ?, title = ?, rank = ? where url = ? });
$sth->execute("@dumped","$webdesc","$lang","$webtitle","$erank","$_[0]");
nprint("S","url $_[0] Updated in the DB.");
}
get_ahref($downl_file,$_[0]);
unlink($downl_file);
#ACA DEBERIA IR EL UPLOADER
# Here should be a nice math function whichr recognizes where to make the next update. (consultar tesis de castillo)
$sth = $dbh->prepare(qq{ update `update` SET next_date = DATE_ADD(CURDATE(), INTERVAL +7 DAY) where url = ? });
$sth->execute($_[0]);
# We set the update to inprogress N.
#delete($downl_file);
}
}
$sth = $dbh->prepare(qq{ update `update` SET `ip` = 'N', `sv` = 'N' where url = ? and `sv` = '$server' });
$sth->execute($_[0]);
}
sub CLEANUP {
my $sth;
nprint ("N","Caught Interrupt, Aborting.");
$sth = $dbh->prepare(qq{ update `update` SET `ip` = 'N', `sv` = 'N' where `sv` = '$server' });
$sth->execute();
$sth->finish();
exit(1);
}
sub autonomous_fetch {
my $sth;
my $readytofetch;
my $instances=10;
my @urls_to_fetch;
my $wbfc;
my $seconds=10;
/* ip = inprogress */
$sth = $dbh->prepare(qq{ select distinct url from `update` where `ip` = 'N' and next_date = '0000-00-00' or next_date <= CURDATE() and `ip` = 'N' order by rand() limit $instances });
$sth->execute();
#fork and exit;
while (defined(my $willbefetched = $sth->fetchrow_array())) {
# fork and exit;
fetch($willbefetched);
}
$sth->finish();
}
sub run_nucleous {
#fork and exit;
autonomous_fetch();
/* Recursive */
run_nucleous();
}
run_nucleous();
/* BEGIN {'s end */
}