Mini web server in perl (really small han?)

10 Nov 2010

use strict;
use warnings;
use LWP;
use HTTP::Daemon;

# the parameters are 
# the user/group user to restrict permissions, the port (default 80)
# the local addres (default locahost)
# respectivaly
my ($userg, $port, $laddres) = @ARGV;
$userg or die 'You need to suply a nonroot user/group as first parameter'; 
my ($user, $group) = split ('/', $userg);

$port = 80 unless $port;
$laddres = 'localhost' unless $laddres;

my $server = new HTTP::Daemon (
    LocalAddr => $laddres,
    LocalPort => $port,
    Listen => 5,
    Reuse => 1,
) || die $!;

$> = getpwnam $user || die $!; 
$) = getgrnam $group || die $!; 


while (my $con = $server->accept()) {
    my $pid = fork();
    if (!$pid) { 
        my $req = $con->get_request();
        print $req->as_string();
        my $file = $req->url();
        $file =~ s/^.//g;    
        $con->send_file_response($file);
    } elsif ($pid) { next;  
    } else { print STDERR "fork: $!\n" };
}