#!/usr/bin/perl -W
# TP protocole HTTP
#
# Question 4
#
# on se limite ici au domaine .ens.fr et à une profondeur de récursion de $max
#
# TODO: on ne gère pas
# - la balise
# - le fichier robots.txt et la balise
#
# Antoine Miné
# 20/04/2007
use Socket; # pour avoir l'équivalent Perl de socket.h
use IO::Handle; # pour avoir autoflush
# url_cat(base,lien) concatène lien à base
# cette fonction reprend exactement celle de urlcat.pl
sub url_cat
{
my $base = shift;
my $lien = shift;
# découpe $base
my ($protocole, $serveur, $page) =
$base =~ /^([a-z]+):\/\/([a-z0-9.:-]+)(\/.*)$/;
# supprime ce qui suit le dernier / dans $page
($page) = $page =~ /^(.*\/)[^\/]*$/;
# supprime le suffixe en # de $lien
($lien) = $lien =~ /^([^#]*)/;
# cas où $lien est une URL complète
return $lien if $lien =~ /^[a-zA-Z]+:/;
# cas où $lien précise le serveur et le chemin absolu
return "$protocole:$lien" if $lien =~ /^\/\//;
# cas où $lien précise juste le chemin absolu
return "$protocole://$serveur$lien" if $lien =~ /^\//;
# cas où $lien est un chemin relatif
$lien = "$page/$lien";
# remplace tous les // par /
while ($lien =~ s/\/\//\//g) {}
# remplace les /xxxx/.. par rien (de gauche à droite)
while ($lien =~ s/\/[^\/]*\/\.\.//) {}
# remplace tous les /. par rien
while ($lien =~ s/\/\.//g) {}
return "$protocole://$serveur$lien";
}
# scan_url(URL) renvoie la liste des liens trouvés dans la page URL
# cette fonction reprend en grande partie httpget.pl
# en cas d'erreur (serveur ou page non trouvée, etc.) on affiche un message
# la table globale %parent permet d'afficher un parent d'une URL
sub scan_url
{
my $url = shift;
my ($protocole, $serveur, undef, $port, $page) =
$url =~ /^([a-z]+):\/\/([a-z0-9.-]+)(:(\d*))?(\/.*)$/;
$port = 80 if ! defined $port;
$page = "/" if ! defined $page;
return () if ! defined($protocole);
return () unless $protocole eq "http";
$ip_serveur = gethostbyname($serveur);
if (!defined($ip_serveur)) {
print "page non trouvée: $url\n(liée depuis: $parent{$url}\n";
return ();
}
my $addr_sin = sockaddr_in($port, $ip_serveur);
socket(SOCKET, PF_INET, SOCK_STREAM, 0) || die "échec de socket: $!";
autoflush SOCKET 1;
if (!connect(SOCKET, $addr_sin)) {
print "page non trouvée: $url\n(liée depuis: $parent{$url}\n";
return ();
}
print SOCKET "GET $page HTTP/1.1\r\n";
print SOCKET "Host: $serveur:$port\r\n";
print SOCKET "User-Agent: httpget\r\n";
print SOCKET "Connection: close\r\n";
print SOCKET "\r\n";
# ligne de statu
my $statu = ;
($code) = $statu =~ /^HTTP\/[0-9.]+ (\d+) [^\n\r]*/;
print "page non trouvée: $url\n(liée depuis: $parent{$url})\n" if $code>=400;
# liste des URLs rencontrées dans les en-têtes ou dans la page
my @liens = ();
# lecture de l'en-tête
while () {
# fin
last if $_ eq "\r\n";
# en-tête de redirection
push @liens,$1 if /^Location: (\S+)/;
# si non HTML, on abandonne
if (/^Content-Type:/ && !/text\/html/) {
close SOCKET;
return ();
}
}
# lecture de la page
while () {
push @liens, (/href=\"([^\"]*)\"/g);
push @liens, (/src=\"([^\"]*)\"/g);
}
close SOCKET;
return @liens;
}
$url = $ARGV[0] or die "utilisation: $0 URL";
# pages à examiner
@todo = ($url); # pages à examiner
%done = (); # pages déjà rencontrées
$max = 5; # profondeur maximale de récursion
# parcours en largeur
for ($i=0; $i<$max; $i++) {
@todo2 = ();
foreach $x (@todo) {
$done{$x} = 1;
# pour chaque lien pointé par $x
foreach $y (scan_url($x)) {
# liens particulier mailto: et javascript: à ignorer
#next if $y =~ /^mailto:/;
#next if $y =~ /^javascript:/;
$z = url_cat($x,$y); # calcule l'URL absolue du liens
$parent{$z} = $x; # met à jour la table des parents
next if $done{$z}; # évite d'examiner deux fois la même page
next unless $z =~ /\.ens\.fr/; # évite de sortir de .ens.fr
push @todo2, $z;
$done{$z} = 1;
}
}
@todo = @todo2;
}