[Perl] : le web server en quelques lignes

Print Friendly, PDF & Email

Après AWK et python, il fallait bien compléter notre petit tour de mise en place d’une socket d’écoute web (web serveur). C’est au tour de Perl de  nous permettre de réaliser cette petite opération.

Ce n’est pas moi qui suit à l’origine de ce code en Perl vous pouvez trouver la source ici.  En tout cas une fois de plus ce n’est pas très long et ça fait le taff en affichant un résultat sur le localhost port 8000.

#!/usr/bin/perl -w
# vim: set sw=4 ts=4 si et:
# Simple single threaded web server, written by Guido Socher
# copyright: freeware, do with it whatever you want. No warranty of any kind.
#
# Usage: perlweb.pl [portnumber] [ip-to-bind-to]
# Example: ./perlweb.pl
# The above example will answer http requests at port 8000 
# on any interface that this machine has.
# Try:
# curl -v http://localhost:8000
#
use strict;
use Socket;
#
my $listenport = $ARGV[0] || 8000;
socket (Server, PF_INET, SOCK_STREAM, 6) || die ("Error socket: $!"); # protocol 6 is tcp
setsockopt(Server, SOL_SOCKET,SO_REUSEADDR,1) || die ("Error setsockopt: $!");
my $sockaddr = sockaddr_in($listenport, $ARGV[1] ? inet_aton($ARGV[1]) : INADDR_ANY) || die ("Error sockaddr_in: $!");
bind(Server,$sockaddr) || die ("Error bind: $!");
listen(Server,SOMAXCONN) || die ("Error listen: $!");

my $caddr;
my $buffer;
while ($caddr = accept(Client, Server)) {
    recv(Client,$buffer,1000,0);
    if ($buffer && $buffer=~/^GET /){
        print Client "HTTP/1.1 200 OK\r\n";
        print Client "Content-Type: text/html\r\n";
        print Client "Server: perlweb/1.0\r\n";
        print Client "Connection: close\r\n";
        print Client "\r\n";
        # debug a bit:
        #print "client:\n$buffer\n";
        print Client "This web server works!\n";
}
close Client; }
# __END__


En plus court pour faire en une ligne mais moins complet :

$ cpan HTTP::Server::Brick   # install dependency
$ perl -MHTTP::Server::Brick -e '$s=HTTP::Server::Brick->new(port=>8000); $s->mount("/"=>{path=>"."}); $s->start'

Découvrez  [Perl] : récupérer un pattern présent une ou plusieurs fois par ligne