#!/usr/bin/perl
# =============================================================================
# Un petit serveur HTTP statique, pour voir le rendu reel.
#
#   perl outils/servir.pl            sert public/ sur http://localhost:8787
#   perl outils/servir.pl 9000       sur un autre port
#
# POURQUOI CET OUTIL EXISTE
# -------------------------
# Le volet d apercu du navigateur BLOQUE les feuilles de style et les polices
# chargees depuis un fichier ouvert en file:// : sa politique de securite les
# traite comme des ressources d une autre origine. Une page ouverte ainsi
# s affiche sans la charte, en Times New Roman, et on croit a un defaut de
# style alors que le style n a jamais ete charge.
#
# Ce serveur repond en http://, ce qui rend les .css et les .woff2 lisibles, et
# permet donc de juger le rendu. Il ne sert QUE des fichiers, il n execute
# aucun PHP : ce que l on regarde ici, c est la charte, pas l application.
#
# Le poste n a ni php ni python en ligne de commande. Perl est fourni par Git.
#
# ARRET : Ctrl+C.
# =============================================================================
use strict;
use warnings;
use IO::Socket::INET;

my $port   = shift @ARGV // 8787;
my $racine = 'public';

die "Dossier introuvable : $racine (lancer depuis site/)\n" unless -d $racine;

my $serveur = IO::Socket::INET->new(
    LocalAddr => '127.0.0.1',
    LocalPort => $port,
    Proto     => 'tcp',
    Listen    => 8,
    ReuseAddr => 1,
) or die "Port $port indisponible : $!\n";

print "Sert $racine sur http://localhost:$port\n";
print "Ctrl+C pour arreter.\n\n";

my %types = (
    'html' => 'text/html; charset=utf-8',
    'css'  => 'text/css; charset=utf-8',
    'js'   => 'text/javascript; charset=utf-8',
    'svg'  => 'image/svg+xml',
    'png'  => 'image/png',
    'jpg'  => 'image/jpeg',
    'ico'  => 'image/x-icon',
    'woff2'=> 'font/woff2',
    'json' => 'application/json; charset=utf-8',
    'txt'  => 'text/plain; charset=utf-8',
);

while (my $client = $serveur->accept()) {
    my $ligne = <$client>;
    unless (defined $ligne) { close $client; next; }

    my ($methode, $chemin) = $ligne =~ m{^(\w+)\s+(\S+)};
    # Vider le reste des en-tetes.
    while (my $e = <$client>) { last if $e =~ /^\r?\n$/; }

    $chemin //= '/';
    $chemin =~ s/\?.*$//;
    $chemin = '/index.html' if $chemin eq '/';

    # Aucune remontee hors du dossier servi.
    $chemin =~ s/\.\.//g;
    my $fichier = $racine . $chemin;

    if (-f $fichier) {
        my ($ext) = $fichier =~ /\.(\w+)$/;
        my $type = $types{ lc($ext // '') } // 'application/octet-stream';

        open(my $h, '<:raw', $fichier) or next;
        my $corps = do { local $/; <$h> };
        close $h;

        print $client "HTTP/1.1 200 OK\r\n";
        print $client "Content-Type: $type\r\n";
        print $client 'Content-Length: ' . length($corps) . "\r\n";
        print $client "Cache-Control: no-store\r\n";
        print $client "\r\n";
        print $client $corps;
        print "200 $chemin\n";
    } else {
        my $corps = "Introuvable : $chemin\n";
        print $client "HTTP/1.1 404 Not Found\r\n";
        print $client "Content-Type: text/plain; charset=utf-8\r\n";
        print $client 'Content-Length: ' . length($corps) . "\r\n";
        print $client "\r\n";
        print $client $corps;
        print "404 $chemin\n";
    }

    close $client;
}