#!/usr/bin/perl
# Copyright Carlos Francisco Ferry Sauterel - carlos@gnu.cl
# May 27, 2007
BEGIN {
use strict;
use warnings;
use Cwd;
use DBI;
use Net::DNS;
use Data::Dumper;
use LWP::UserAgent;
use HTML::TokeParser;
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 = 'XXXXXXXXXXXXXXX';
my $dbh = DBI->connect($dsn, $dusn, $dpass);
$Term::ANSIColor::AUTORESET = 1;
$SIG{'INT'} = 'CLEANUP';
$SIG{HUP} = 'CLEANUP';
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 $start_timestamp = "Beginning at $time on $date";
my $timestamp = "$time - $date";
/* 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;
/* 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", $start_timestamp);
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 ($flag, $lfile, $npm);
$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;
}
#PFILE
print $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 $p;
my $url_from = $_[0];
my $parse = $_[1];
$p = HTML::LinkExtor->new(\&cb, $url_from);
$p->parse_file($parse);
sub cb {
my ($counter, $tcounter, $sth, $vid);
my($tag, $ref, $link) = @_;
if ($tag eq "a" && $ref eq "href") {
$sth = $dbh->prepare(qq{ select id from `linkers` where url_from = ? and url_to = ? });
$sth->execute($_[0], $link);
$vid = $sth->fetchrow_array();
/* I check if it was added, if not, I'll upload it to mySQL, otherwise it won't be added */
if (!defined($vid))
{
$sth = $dbh->prepare(qq{ insert into `linkers` (url_from, url_to) values (?, ?) });
$sth->execute($_[0], $link);
}
#print "$link\n";
print "$_[0]\n";
#print "@{[%links]}\n";
#push @links, "@{[%links]}\n";
}
}
}
sub clean_protocol {
my $url = $_[0];
my ($protocol);
my @protocols_allowed = 'http https ftp';
my @protocols_splited = map {split ' '} @protocols_allowed;
foreach $protocol (@protocols_splited)
{
if ($url =~ /$protocol:\/\//)
{
$url =~ s/^$protocol:\/\///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_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 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 @webalinks = get_alinks($downl_file,$_[0]);
#print @webalinks;
if (defined($webtitle))
{
print "$webtitle <- title\n";
}
my $webdesc = get_description($downl_file);
if (defined($webdesc))
{
print "$webdesc\n";
}
get_ahref($_[0],$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 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
fetch($willbefetched);
#exit
}
$sth->finish();
}
sub run_nucleous {
autonomous_fetch();
#run_nucleous();
}
run_nucleous();
}