&cgiend;
}elsif($duplex?$ppid>=0&&!($wr=fork):!$pid){
my $pid1;
$F=openpipe('<',"$fi");
defined($pid1=rdx($F))||&cgidie;
close($F);
$F=openpipe('<',"$fi.$pid1.r");
my ($l,$l1);
while((my $s1=<$F>) ne "\n"){$s.=$s1;$s1=~s/^CONTENT_LENGTH: (\d*)/$l1=$1/se}
$s=wrx($pid1)."$s\n";
$l=$l1+length($s);
print(($nph?$ENV{SERVER_PROTOCOL}:'Status:')." 200 OK\nContent-Length: $l\nContent-Type: $dtype\n\n$s")||&cgiend;
$wr=0;
undef $s;
fcopy($l,$F,*STDOUT)||&cgidie;
close($F);
&cgiend if($duplex||!$pid);
}

cgiend("$fi.$pid.r","$fi.$pid.c") if(!(defined($wr)||print(($nph?$ENV{SERVER_PROTOCOL}:'Status:')." 200 OK\nContent-Length: 0\nContent-Type: $dtype\n\n"))||($pid && $pgrp && getpgrp($pid)==-1));
unlink("$fi.$pid.r") if($ppid>0);
&cgiend if(!-e "$fi.$pid.c");
$F=openpipe('>',"$fi.$pid.c");
if(exists($ENV{CONTENT_LENGTH})){
 fcopy($ENV{CONTENT_LENGTH},*STDIN,$F)||&cgidie;
}else{
 fcopy1(*STDIN,$F)||&cgidie;
}
close($F);
&cgiend;

sub cgiend{
unlink(@ff,@_);
$wr&&waitpid($wr,0);
exit;
}

sub cgidie{
my $e=shift;
print ($nph?$ENV{SERVER_PROTOCOL}:'Status:')." 500 Internal Server Error\n\n500 Error $e";
cgiend(@_);
}

sub openpipe{
use POSIX qw/mkfifo/;
my $f;
my $n=$_[1];
-e $n||POSIX::mkfifo($n,0700)||-e $n||err("mkfifo $n");
open($f,"$_[0]$n")||err("open $n");
select($f);$|=1;select(STDOUT);
$f
}

sub err{
wlog("Error:",$!,@_);
&cgidie;
}


### daemon

sub fcopy{
my $sz=$_[0];
my ($buf,$n);
for(1..$#_){binmode($_[$_])}
while($sz&&!eof($_[1])){
 $sz-=($n=$sz>$bufsize?$bufsize:$sz);
 defined(my $n=read($_[1],$buf='',$n))||return;
 for(2..$#_){defined(syswrite($_[$_],$buf,$n))||return}
}
1
}

sub fcopy1{
my $buf;
for(@_){binmode($_)}
while(!eof($_[0])){
 defined(my $n=read($_[0],$buf,$bufsize))||return;
 for(1..$#_){defined(syswrite($_[$_],$buf,$n))||return}
 undef $buf;
}
1
}

sub ffread{
my $s;
binmode($_[0]);
while(!eof($_[0])){
 defined(read($_[0],my $s1,$bufsize))||return;
 $s.=$s1
}
$s
}

sub wrx{sprintf("%032d",$_[0])}
sub rdx{defined(read($_[0],my $x,32))||return;$x eq ''?undef:$x+0}

sub wlog{
$log||return;
my $L;