Leser: 24
1 2 3 4 5 6 7 8 9 10 11
while ( 1 ) {# prevents from exiting when client connects without SSL while (my $c = $d->accept()) { my $pid = fork(); die "Cannot fork: $!" unless defined($pid); if ($pid == 0) { # &handle($c); sleep(10); exit(0); } } }
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35
#!/usr/bin/perl use warnings; use strict; use HTTP::Daemon; use POSIX qw(setsid); use Digest::SHA qw(sha256_hex); require 'functions.pl' or die $!; my $d = HTTP::Daemon->new(LocalAddr => "localhost", LocalPort => 8080, ReuseAddr => 1) || die "Couldn't start server! Reason: $!"; print "Serving as (".$$.") on ".$d->sockhost.":".$d->sockport."\n"; # # catching the exit- or termination status of the child process to avoid zombies # $SIG{CHLD} = sub {wait ()}; # # daemonizing, In- and Output to /dev/null and forking the server => giving control back to the shell # #&daemonize; # # looping and forking a child to process the incoming request that was accepted by the main program # while ( 1 ) {# prevents from exiting when client connects without SSL while (my $c = $d->accept()) { my $pid = fork(); die "Cannot fork: $!" unless defined($pid); if ($pid == 0) { #&handle($c); sleep(10); exit(0); } } } close($d);
1
2
drux@debiserv:~/xenter$ perl -v
This is perl, v5.10.1 (*) built for x86_64-linux-gnu-thread-multi
1
2
Linux debiserv 2.6.32-22-generic
#36-Ubuntu SMP Thu Jun 3 19:31:57 UTC 2010 x86_64 GNU/Linux
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
while (my $c = $d->accept) { while (my $r = $c->get_request) { my $pid = fork; next unless defined $pid; if ($pid) { print "forked child $pid\n"; } else { print "child $$, handling request\n"; sleep 5; print $c "Status 200 OK\n"; exit; } } }
1 2 3 4 5 6 7 8 9 10 11 12 13 14
sub handle { my $c = shift; my $r = $c->get_request; my %_GET=(); my %_POST=(); if ($r) { %_GET = &parseQueryString($r->url()); if (defined($r->content_length)) { %_POST = &parsePostFields($r); } $c->send_status_line(); #... code ... } }