- 论坛徽章:
- 1
|
本帖最后由 yakczh_cu 于 2016-12-13 12:52 编辑
回复 2# laputa73
- require 5.002;
- use strict;
- BEGIN { $ENV{PATH} = '/usr/ucb:/bin' }
- use Socket;
- use Carp;
- $|=1;
- sub spawn; # forward declaration
- sub logmsg {
- open LOG,'>>log.txt';
- print LOG "\n$0 $: @_ at ", scalar localtime, "\n"
- }
- my $port = shift || 80;
- my $proto = getprotobyname('tcp');
- $port = $1 if $port =~ /(\d+)/; # untaint port number
- socket(Server, PF_INET, SOCK_STREAM, $proto) || die "socket: $!";
- setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
- pack("l", 1)) || die "setsockopt: $!";
- bind(Server, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
- listen(Server,SOMAXCONN) || die "listen: $!";
- print "\n master server $§ started on port $port";
- my $waitedpid = 0;
- my $paddr;
- sub REAPER {
- $waitedpid = wait;
- $SIG{CHLD} = \&REAPER; # loathe sysV
- logmsg "reaped $waitedpid" . ($? ? " with exit $?" : '');
- }
- $SIG{CHLD} = \&REAPER;
- for ( $waitedpid = 0;
- ($paddr = accept(Client,Server)) || $waitedpid;
- $waitedpid = 0, close Client)
- {
- next if $waitedpid and not $paddr;
- my($port,$iaddr) = sockaddr_in($paddr);
- my $name = gethostbyaddr($iaddr,AF_INET);
- logmsg "connection from $name [",
- inet_ntoa($iaddr), "]
- at port $port";
- spawn sub {
- #print "Hello there, $name, it's now ", scalar localtime, "\n";
- logmsg "\n this is worker $§ ";
- print "HTTP/1.0 200 OK\r\nConnection: close\r\n\r\n<h1> this is $§" </h1>";
- or confess "can't exec fortune: $!";
- };
- }
- sub spawn {
- my $coderef = shift;
- open(STDIN, "<&Client") || die "can't dup client to stdin";
- open(STDOUT, ">&Client") || die "can't dup client to stdout";
- open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
- #print $coderef;
- unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
- confess "usage: spawn CODEREF";
- }
- my $pid;
- if (!defined($pid = fork)) {
- logmsg "cannot fork: $!";
- return;
- } elsif ($pid) {
- logmsg "FORK OK $pid";
- return; # I'm the parent
- }
- # else I'm the child -- go spawn
- # print "\nchild ->",$;
- logmsg "\n spawn wrap worker $§";
- &$coderef();
- sleep(1);
- # exit 0;
- }
复制代码
用管道确实可以 但是这样写来一个请求就会Spawn 一下新的perl进程, 如果要象nginx那样,启动固定数量的 worer 该怎么写?
|
|