#!/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 <BASE>
# - le fichier robots.txt et la balise <META NAME="ROBOTS">
#
# 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 = <SOCKET>;
    ($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 (<SOCKET>) {

	# 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 (<SOCKET>) {
	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;
}