#!/usr/bin/perl -W
# TP proxy HTTP
#
# Question 3
#
# Antoine Miné
# 15/05/2007
use IO::Socket::INET; # on utilise l'interface orientée-objet
# création de la socket d'écoute
$listen = new IO::Socket::INET(LocalPort => '8080',
Proto => 'tcp',
Listen => 5,
ReuseAddr => 1, )
or die "échec de création de la socket d'écoute: $!";
# boucle de traitement des connections
while ($client = $listen->accept()) {
$first = 1; # première requête
$keepalive = 1; # mode keep-alive
$host = undef;
$serv = undef;
# boucle de traitement des requêtes
while ($keepalive) {
# lit la requête du client
$req = <$client>;
last if !defined($req);
($url) = $req =~ m!GET (\S*) HTTP/1.?! or die "requête non reconnue: $_";
@headers = ();
while ($l = <$client>) {
last if $l =~ /^\r\n$/;
$host = $1 if $l =~ /^host:\s*(\S+)/i;
if ($l =~ /connection:\s*(\S+)/i) {
# transforme Proxy-connection en Connection
$l = "Connection: $1\r\n";
$keepalive = 0 if ($l =~ /close/i);
}
push @headers, $l;
}
print "requête entrante: $url\n";
# établit la connection si c'est la première requête
if ($first) {
unless (defined($host) &&
($serv = new IO::Socket::INET(PeerAddr => $host,
PeerPort => '80',
Proto => 'tcp', ))) {
# on échoue à contacter le serveur
print $client "HTTP/1.1 502 Bad Gateway\r\n";
print $client "Connection: close\r\n";
print $client "Content-type: text/html\r\n";
print $client "\r\n";
print $client "Erreur!\r\n";
print $client "Je n'ai pas trouvé $host.\r\n";
last;
}
}
# envoie la requête au serveur
print $serv "$req";
foreach $k (@headers) { print $serv "$k"; }
print $serv "\r\n";
# lit la réponse (statu + en-têtes) du serveur
$statu = <$serv>;
last if !defined($statu);
@headers = ();
$chunked = 0;
$length = undef;
while ($l = <$serv>) {
last if $l =~ /^\r\n$/;
$keepalive = 0 if $l =~ /^connection:\s*close/i;
$keepalive = 0 if $l =~ /^proxy-connection:\s*close/i;
$length = $1 if $l =~ /^content-length:\s*(\S+)/i;
$chunked = 1 if $l =~ /^transfer-encoding:\s*chunked/i;
push @headers, $l;
}
# envoie la réponse au client
print $client "$statu";
foreach $k (@headers) { print $client "$k"; }
print $client "\r\n";
# copie le corps de la réponse
if ($chunked) {
# mode par blocs
while (<$serv>) {
s/\r\n//g;
$length = hex;
printf $client "%x\r\n", $length;
$x = read $serv,$l,$length;
die "erreur de lecture" unless $x == $length;
print $client "$l";
while (<$serv>) {
print $client "$_";
last if /^\r\n$/;
}
last if $length == 0;
}
}
elsif (defined($length)) {
# content-length connu
$x = read $serv,$l,$length;
die "erreur de lecture" unless $x == $length;
print $client $l;
}
else {
# jusqu'à cloture par le serveur
while ($l = <$serv>) {
print $client $l;
}
}
$first = 0;
}
print "fin de connection\n";
close $client;
close $serv if defined($serv);
}