Re: This site is

#!/usr/bin/perl
use POSIX ;
use strict ;
use LWP::UserAgent ;
my @table_agents ;
my @table_url ;
my %urls ;
my %urls_erreur ;
my %agents ;
my $compteur=0 ;
my $compteurOK=0 ;
my $compteurErreur=0 ;

if(init_table_agents()) {
if(init_table_url())
{ print 'Nombre d\'agents utilisateurs : '.($#table_agents+1)."\n" ;
print 'Nombre d\'URLs : '.($#table_url+1)."\n" ;
traitement() ;
}
}
exit ;
# Traitement
sub traitement
{ for(;;)
{ $compteur++ ;
print $compteur.') ' ;
my $agent=retourne_table_agents() ;
my $agent_utilisateur=new LWP::UserAgent($agent) ;
$agent_utilisateur->agent($agent) ;
my $url=retourne_url() ;
$agents{$agent}++ ;
print $url.' / '.substr($agent, 0, 30). ' ' ;
my $req=new HTTP::Request 'GET' => $url ;
$req->header('Accept' => 'text/html') ;
my $res = $agent_utilisateur->request($req) ;
if($res->is_success)
{ print ' !' ;
$urls{$url}++ ;
$compteurOK++ ;
}
else
{ print ' '.$res->code.' '.$res->message ;
$compteurErreur++ ;
$urls_erreur{$url}++ ;
}
undef($agent_utilisateur) ;
print "\n" ;
statistiques() ;
}
}

# affiche statistiques
sub statistiques
{ my $fichier='rapport.txt' ;
if(open(LOG, ">$fichier"))
{ print LOG "\n\n\n" ;
print LOG '------------------------------------------------------------------------'."\n" ;
for my $url(sort { $urls{$b} <=> $urls{$a} } keys %urls)
{ my $j=0 ;
my $i=$urls{$url} ;
if($compteur>0) { $j=ceil($i*(100/$compteur)) ; }
print LOG cc($i, 10) ;
print LOG cc($j.'%', 4) ;
print LOG $url."\n" ;
}
print LOG '------------------------------------------------------------------------'."\n" ;
for my $url(sort { $urls_erreur{$b} <=> $urls_erreur{$a} } keys %urls_erreur)
{ my $j=0 ;
my $i=$urls_erreur{$url} ;
if($compteurErreur>0) { $j=ceil($i*(100/$compteurErreur)) ; }
print LOG cc($i, 10) ;
print LOG cc($j.'%', 4) ;
print LOG $url."\n" ;
}
print LOG '------------------------------------------------------------------------'."\n" ;
for my $agent(sort { $agents{$b} <=> $agents{$a} } keys %agents)
{ my $j=0 ;
my $i=$agents{$agent} ;
if($compteurOK>0) { $j=ceil($i*(100/$compteurOK)) ; }
print LOG cc($i, 10) ;
print LOG cc($j.'%', 4) ;
print LOG $agent."\n" ;
}
print LOG '------------------------------------------------------------------------'."\n" ;
my ($i,$j)=(0,0) ;
if($compteur>0)
{ $i=ceil($compteurOK*(100/$compteur)) ;
$j=ceil($compteurErreur*(100/$compteur)) ;
}
print LOG "compteur:$compteur / compteurOK:$compteurOK ($i%) / compteurErreur:$compteurErreur ($j%)\n" ;
close LOG ;
}
}

# complete une chaine avec des espaces
sub cc
{ my $chaine=shift ;
my $max=shift ;
while(length($chaine)<$max)
{ $chaine.=' ' ;
}
return $chaine ;
}

# Retourne une URL
sub retourne_url
{ my $a=int(rand($#table_url)) ;
return $table_url[$a] ;
}

# Retourne un agent utilisateur
sub retourne_table_agents
{ my $a=int(rand($#table_agents)) ;
return $table_agents[$a] ;
}

# Initialise une table avec des URLs
sub init_table_url
{
# ne fonctionne pas avec Mozilla 1.2.1 sous Linux
push @table_url, 'http://www.onobox.com'(...) ; #new IE only web site
push @table_url, 'http://partners.adobe.com';(...) #warns NN4/IE4 only support
push @table_url, 'http://www.scour.com'(...) ; #allows only IE & windows
push @table_url, 'http://www.virgin.fr'(...) ; #only IE
push @table_url, 'http://www.pien.nl'(...) ; #only supports IE4 or higher
push @table_url, 'http://www.cinemanow.com'(...) ; #only available for MS IE on Windows
push @table_url, 'http://www.within-temptation.com/';(...) #
push @table_url, 'http://www.virginmega.fr'(...) ; #site is IE only
push @table_url, 'http://www.cartenomad.bouygtel.com'(...) ; # site optimisé pour les navigateurs Internet Explorer à partir de la version 4.0 et Netscape à partir de la version 4.1 (sauf 6 et suivantes) sur PC et Mac.
push @table_url, 'http://www.argos.co.uk';(...) # cannot currently be viewed using Netscape 6
push @table_url, 'http://www.marksandspencer.com';(...) # website has been optimised for use with the most popular browsers
push @table_url, 'http://www.audiax.net/';(...) # Sorry, don't like Netscape, please download IE 6
push @table_url, 'http://www.agoraplus.com/';(...) # devez utiliser Microsoft Internet Explorer version 5.0 ou superieure sur plate-forme Windows-Intel.
push @table_url, 'http://www.chappee.com/';(...) # vous devez utiliser Microsoft Internet Explorer version 4.0 ou supérieure sur plate-forme Windows-Intel.
push @table_url, 'http://www.ideal-standard.fr/';(...) # vous devez utiliser Microsoft Internet Explorer version 4 ou supérieure
push @table_url, 'http://www.zone.com';(...) # Browser not fully supported (with Mozilla 1.2.1)
push @table_url, 'http://www.excelsior.fr';(...) # site optimisé pour Microsoft Internet Explorer version 4 et + et Netscape Navigator version 4 et +
push @table_url, 'http://www.magic-kinder.com';(...) # on peut allez au dela de la page d'inscription !
push @table_url, 'http://www.parislogement.com';(...) # ce site n'est pas compatible avec votre Navigateur. Merci d'utiliser Internet Explorer
push @table_url, 'http://www.activebaseconcept.com';(...) # utiliser Microsoft Internet Explorer

# fonctionne mais soit disant "optimise"
push @table_url, 'http://www.guidedenuit.com';(...) # Site optimisé pour I.E. 5 et plus.
push @table_url, 'http://www.avatarsystems.net'(...) ; # This site optimized for Internet Explorer
push @table_url, 'http://www.mvps.org'(...) ;
push @table_url, 'http://www.markjeffords.com'(...) ;
push @table_url, 'http://www.saliu.com'(...) ; #get Miscrosoftt Internet Explorer
push @table_url, 'http://www.accp.asso.fr'(...) ; # optimisé pour IE 5
push @table_url, 'http://syncrasy.com'(...) ; #message en bas : This page is best viewed with the latest Microsoft Internet Explorer browser. Netscape not supported.
push @table_url, 'http://www.just-the-right-sale.net'(...) ; #message en haut : These pages are best viewed in IE5 - Netscape not supported - click on logo to enter site.
push @table_url, 'http://www.nav2000.com'(...) ; #Votre Navigateur Mozilla 1.3 n'est pas 100% compatible avec NAV2000 :-/

return test_doubles(\@table_url) ;
}

# Initialise une table avec des agents utilisateurs differents
sub init_table_agents
{ push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020826" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686) Gecko/20030401 Galeon/1.3.3" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; Debian/1.3.3.20030322-2) Gecko/20030319 Galeon/1.3.3" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; fr-FR; rv:1.0.0) Gecko/20020623 Debian/1.0.0-0.woody.1";
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20021023";
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.0) Gecko/20020605";
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.2b) Gecko/20021016";
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.1) Gecko/20020828";
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.0) Gecko/20020623 Debian/1.0.0-0.woody.1";
push @table_agents, "Mozilla/5.0 (X11; U; FreeBSD i386; en-US; rv:1.0.0) Gecko/20020709";
push @table_agents, "Mozilla/5.0 (X11; U; Linux ppc; en-US; rv:1.3b) Gecko/20021213" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:1.0rc2) Gecko/20020516 " ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i586; en-US; rv:1.4a) Gecko/2003040" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.2) Gecko/20030208 Netscape/7.02" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; fr-FR; rv:1.0.2) Gecko/20030208 Netscape/7.02" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.3) Gecko/20030312" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.4a) Gecko/20030403 Phoenix/0.5" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; fr-FR; rv:0.9.9) Gecko/20020313 " ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; fr-FR; rv:1.2.1) Gecko/20030225" ;
push @table_agents, "Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.2) Gecko/20021216" ;
push @table_agents, "Mozilla/5.0 (Macintosh; U; PPC; en-US; rv:1.0.2) Gecko/20021216 " ;
push @table_agents, "Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en-US; rv:1.3) Gecko/2003031" ;
push @table_agents, "Mozilla/5.0 (Macintosh; U; PPC Mac OS X Mach-O; en-US; rv:1.0.1) Gecko/20030306 Camino/0.7" ;
push @table_agents, "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; fr-FR; rv:1.0.2) Gecko/20030208 Netscape/7.02" ;
push @table_agents, "Mozilla/5.0 (Macintosh; U; PPC Mac OS X; en-US; rv:1.0.2) Gecko/20030106" ;
push @table_agents, "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.3) Gecko/20030312" ;
push @table_agents, "Mozilla/5.0 (Windows; U; Win98; fr-FR; rv:1.2.1) Gecko/20021130" ;
push @table_agents, "Mozilla/5.0 (Windows; U; Windows NT 5.0; fr-FR; rv:1.3) Gecko/20030312 " ;
push @table_agents, "Mozilla/5.0 (Windows; U; Win 9x 4.90; en-US; rv:1.0.2) Gecko/20030208 Netscape/7.02" ;
push @table_agents, "Mozilla/5.0 (Windows; U; Win 9x 4.90; fr-FR; rv:1.0.2) Gecko/20030208 Netscape/7.02" ;
return test_doubles(\@table_agents) ;

}

# Test si il existe des doublons...
sub test_doubles
{ my $t=shift ;
my %c ;
foreach my $e(@$t)
{ if(defined($c{$e}))
{ print "(!) $e deja declare\n" ;
return 0 ;
}
else
{ $c{$e}=1 ;
}
}
return 1 ;
}