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" }; }
quarta-feira, 10 de novembro de 2010
Mini web server in perl (really small han?)
Assinar:
Postar comentários (Atom)
Nenhum comentário:
Postar um comentário