){$s=~s/(.*?)\: (.*?)[\r\n]/my $x=$1;$x=~tr\/-a-z\/_A-Z\/;$ENV{substr($x,0,7) eq 'CONTENT'?$x:"HTTP_$x"}=$2/ge}
if($_=$domain{"$ENV{'HTTP_HOST'}"}){
@err=&$_;
$content=$err[1];
goto STD if($err[0]);
print $content
}
$RANGE[3]=~s/bytes\=([0-9]*)-([0-9]*)/@RANGE[0,1]=($1,$2);1/gse if($RANGE[3]=$ENV{'HTTP_RANGE'});
$file="/$file" if(substr($file,0,1) ne '/');
$file.="\n";
$file=~s/(\/.*?)\/\.\.([\/\n])/$1$2/g;
chomp($file);
$ENV{'REDIRECT_URI'}=$ENV{'SCRIPT_NAME'}=$file||='/';
goto (MAP_OK,EXEC_CGI)[(($content,@stat)=@{$contents{$file=$content}})!=0] if(($content,@guid)=@{$URIs{$file}});
@guid=(-1,-1);
for(sort keys %map){
my @mask=split(/ /,$_,2);
$content=$file;
$content=~s/$mask[1]//;
if($content eq ''){
$options{$_}='' for(split(/\|/,$mask[0]));
$file=~s/$mask[1]/&{$map{$_}}/e;
$file=~s/\[(.*?)\:(.*?)\]/my $g=($2+0 eq $2||$2 eq ''?$2:getgrnam($2));my $u=($1+0 eq $1||$1 eq ''?$1:getpwnam($1)); die "Invalid uid or gid\n" if(!(defined($u)&&defined($g)));@guid=($u,$g);''/e if(substr($file,0,1) eq '[');
goto MAP_OK
}
}
goto E404;
MAP_OK:
if($guid[1]!=-1){
$)="$guid[1] $guid[1]";
if($) ne "$guid[1] $guid[1]"){
ESEC:
$RANGE[2]=0;
@err=(500,'Security error');
goto ERR
}
}
if($guid[0]!=-1){
$>=$guid[0];
goto ESEC if($> ne $guid[0]);
}
if(-d $file){
goto DAEMON if($$==$mainpid && fork);
my $s=$ENV{'REQUEST_URI'};
if(substr($s,-1) ne '/'){
print "Status: 301\nLocation: $s/\n\n";
exit
}
opendir FH,$file or goto ERR;
@stat=stat(FH);
$s="Index of $s";
$s="Last-Modified: ".gmtime($stat[9])."\nContent-type: text/html\n\n$s$s
";
for(readdir(FH)){
my @st=stat("$file$_");
$_=~s/([\x00-\x1f,:\"\'\\])/sprintf('%%%02X',ord($1))/eg;
$_.='/' if(-d "$file$_");
$s.="$_ ".localtime($st[9])." $st[7]\n";
if(length($s)>1024){print $s;$s=''}
}
print "$s
$ENV{'SERVER_SIGNATURE'}";
close FH;
}elsif(-x $file){
if(($content,my @s)=@{$contents{$file}}){
@stat=stat($file);
goto EXEC_CGI if($stat[9]==$s[9]);
delete($contents{$file})
}
open FH,"<$file" or goto ERR;
@stat=stat(FH) if(!@stat);
read(FH,$content,$stat[7]) or goto ERR;
close FH;
$content=~s/#\![ ]*(.*?)\n/my $x;for(split(\/[ ]\/,$1)){if(substr($_,0,1) eq '-' && defined(my $o=$opt{substr($_,1,1)})){$x.=&$o(quotemeta(substr($_,2))).';'}};"$x\n"/gse if(substr($content,0,2) eq '#!');
if($$==$mainpid&&!exists($options{'n'})){
$content=eval "sub \{ $content \};";
$URIs{$ENV{'SCRIPT_NAME'}}=[$file,@guid] if(exists($options{'X'}));
$contents{$file}=[$content,@stat] if(exists($options{'x'}));
EXEC_CGI:
$mode=1
}
goto DAEMON if($$==$mainpid && fork);
$RANGE[5]=(exists($options{'H'}));
$RANGE[2]=0 if($RANGE[2]<3);
$ENV{'SCRIPT_FILENAME'}=$file;
$guid[1]=$stat[5] if($stat[2]&02000);
$guid[0]=$stat[4] if($stat[2]&04000);
$)="$guid[1] ".($(=$guid[1]) if($guid[1]!=-1);
$<=$>=$guid[0] if($guid[0]!=-1);
return $mode,$content if($RANGE[2]<4);
$mode?&$content:eval $content
}elsif(-e $file){
goto DAEMON if($$==$mainpid && fork);
open FH,"<$file" or goto ERR;
$RANGE[2]=3 if($RANGE[2]>3);
@stat=stat(FH);
my $l=$stat[7];
my $h="Last-Modified: ".gmtime($stat[9])."\nContent-Length: $l\n";
my @x=(split(/\./,$file))[-1,-2];
my ($t,$enc,$n);
read(FH,$content,$n=$l<1024?$l:1024) or goto ERR;
if(substr($content,0,14) eq '=0 && ($t=$mime{$x[1]})){
$h.="Content-encoding: $enc\n"
}
if($RANGE[3]){
$content=$n>($l=$RANGE[1]+1)?substr($content,0,$n=$l):($n='') if($RANGE[1] ne '');
if($RANGE[0]){
$content='';
seek(FH,$pos=$n=$RANGE[0],0) or goto ERR;
}
}
$t||=$mime{$x[0]}||(-B $file?'binary/unknown':'text/plain');
print $h,"Content-type: $t\n\n",$content;
untie *STDOUT;
while($l-=$n){
read(FH,$content,$n=$l<1024?$l:1024) or goto ERR;
print $content
}
close FH
}else{
E404:
@err=(404,$file);
ERR:
if(!$err[1]){
goto DAEMON if($$==$mainpid && fork);
die " \n"
}
$content="Status: $err[0]\n\n$err[0] $rfc2068_status{$err[0]}: '$err[1]'";
STD:
goto DAEMON if($$==$mainpid && fork);
$RANGE[6]=1;
print $content
}
if($RANGE[2]==5){
$RANGE[6]=1;
print ''
}
exit if(!$RANGE[2]);
$OPTIONS{'t'}=abs($RANGE[7]) if($OPTIONS{'t'}>abs($RANGE[7]));
($>,$))=@saveguid;
goto (ALIVE,ESEC)[$> ne $saveguid[0] && $) ne $saveguid[1]];
}
sub TIEHANDLE{bless({})}
sub SEEK{
$pos=0 if(!$_[2]);
$buf='' if(!($pos+=$_[1]))
}
sub PRINT{
shift;
my $out=*STDOUT;
my ($b,$l);
if($RANGE[2]==5&&!$RANGE[6]){$buf.=join('',@_);return 1}
if($RANGE[4]){$b=join('',@_);untie $out}
else{
($buf,$b)=split(/[\r]*\n[\r]*\n[\r]*/,join('',$buf,@_),2);
if(defined($b)){
if($RANGE[2]){
$l=lc($ENV{'HTTP_CONNECTION'}||'');
$RANGE[2]=0 if($l eq 'close'||($l ne 'keep-alive'&&$ENV{'SERVER_PROTOCOL'} lt 'HTTP/1.1'));
}
my %hh=('Content-type'=>'text/html','Status'=>200,'Server'=>$ENV{'SERVER_SOFTWARE'},'Date'=>''.gmtime(time));
$_=~s/(.*?)\:[ ]+(.*)[\r]*/$hh{ucfirst(lc($1))}=$2/e for(split(/\n/,$buf));
if(exists($hh{'Content-length'})){
$l=$hh{'Content-length'}
}elsif($RANGE[6]){
$hh{'Content-length'}=$l=length($b)
}elsif($RANGE[2]==4){
$buf.="\n\n$b";
$RANGE[2]=5;
return 1
}else{
$RANGE[2]=0;
$l='*'
}
if(lc($hh{'Connection'}||=$RANGE[2]?'keep-alive':'close') eq 'close'){
$RANGE[2]=0
}elsif($RANGE[7] && (my $x=$ENV{'HTTP_KEEP_ALIVE'})){
if($RANGE[7]>$x){$RANGE[7]=$x}
elsif($RANGE[7]!=$x){$hh{'Keep-alive'}||="timeout=$RANGE[7]"}
}
if($RANGE[3] && !exists($hh{'Content-range'})){
$RANGE[4]=$RANGE[5]+1;
$hh{'Content-length'}=(($l<=$RANGE[1]||$RANGE[1] eq '')?$RANGE[1]=$l-1:$RANGE[1])+1-$RANGE[0] if($l ne '*');
$hh{'Content-range'}="bytes $RANGE[0]-$RANGE[1]/$l";
$hh{'Status'}=206
}
$buf=delete($hh{'Status'});
$buf="$ENV{'SERVER_PROTOCOL'} $buf $rfc2068_status{$buf}\n";
while(my ($x,$y)=each %hh){$buf.="$x: $y\n"}
$buf.="\n";
untie $out;
if($ENV{'REQUEST_METHOD'} eq 'HEAD'){
print $out $buf;
exit if($RANGE[5]);
$RANGE[4]=$RANGE[0]=$RANGE[1]=-1
}elsif(!$RANGE[4]){return print $out $buf.$b}else{print $out $buf};
}else{return 1}
}
$l=length($b);
if($RANGE[1] ne ''){
if($pos>$RANGE[1]){
exit if($RANGE[4]==2);
goto RET
}elsif((my $n=$pos+$l-1-$RANGE[1])>0){
substr($b,-$n)='';
$pos+=$n;
$l-=$n
}
}
if((my $n=$RANGE[0]-$pos)>0){
if($n>$l){$n=$l;$b=''}
else{substr($b,0,$n,'')}
$pos+=$n;
$l-=$n
}
if($l>0){
print $out $b;
$pos+=$l
}
RET:
tie($out,'phttpd') if($RANGE[4] && !tied($out));
1
}
sub OPEN{my $f=shift;open(tied($f),@_)}
sub WRITE{PRINT($_[0],substr($_[1],0,$_[2]))}
sub PRINTF{PRINT(shift,sprintf(shift,@_))}
sub CLOSE{untie *STDOUT;close(STDOUT)}
$SIG{__DIE__}=sub{push @errors,@_};
END{
print "Status: 500\n\nError(s): ".join("
",$!,$@,@errors[1,])."
While loading: $ENV{'SCRIPT_NAME'}
$ENV{'SERVER_SIGNATURE'}" if(tied(*STDOUT)&&$$!=$mainpid)&&!$RANGE[4];
if($mainpid){
close(STDOUT);
close(STDIN);
shutdown(SERVER,2) if($$==$mainpid)
}
}
}
my ($mode,$content)=phttpd::httpd();
$mode?&$content:eval $content