path: root/web/server/h2o/libh2o/share/h2o/fastcgi-cgi

#! /bin/sh
exec ${H2O_PERL:-perl} -x $0 "$@"
#! perl
# This chunk of stuff was generated by App::FatPacker. To find the original
# file's code, look for the end of this BEGIN block or the string 'FATPACK'
BEGIN {
my %fatpacked;

$fatpacked{"Net/FastCGI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI';
  package Net::FastCGI;use strict;use warnings;our$VERSION='0.14';use Net::FastCGI::Constant;use Net::FastCGI::Protocol;1;
NET_FASTCGI

$fatpacked{"Net/FastCGI/Constant.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_CONSTANT';
  package Net::FastCGI::Constant;use strict;use warnings;BEGIN {our$VERSION='0.14';my@common=qw[FCGI_MAX_CONTENT_LEN FCGI_MAX_LEN FCGI_HEADER_LEN FCGI_VERSION_1 FCGI_NULL_REQUEST_ID];my@type=qw[FCGI_BEGIN_REQUEST FCGI_ABORT_REQUEST FCGI_END_REQUEST FCGI_PARAMS FCGI_STDIN FCGI_STDOUT FCGI_STDERR FCGI_DATA FCGI_GET_VALUES FCGI_GET_VALUES_RESULT FCGI_UNKNOWN_TYPE FCGI_MAXTYPE];my@role=qw[FCGI_RESPONDER FCGI_AUTHORIZER FCGI_FILTER];my@flag=qw[FCGI_KEEP_CONN];my@protocol_status=qw[FCGI_REQUEST_COMPLETE FCGI_CANT_MPX_CONN FCGI_OVERLOADED FCGI_UNKNOWN_ROLE];my@value=qw[FCGI_MAX_CONNS FCGI_MAX_REQS FCGI_MPXS_CONNS];my@pack=qw[FCGI_Header FCGI_BeginRequestBody FCGI_EndRequestBody FCGI_UnknownTypeBody];my@name=qw[@FCGI_TYPE_NAME @FCGI_RECORD_NAME @FCGI_ROLE_NAME @FCGI_PROTOCOL_STATUS_NAME];our@EXPORT_OK=(@common,@type,@role,@flag,@protocol_status,@value,@pack,@name);our%EXPORT_TAGS=(all=>\@EXPORT_OK,common=>\@common,type=>\@type,role=>\@role,flag=>\@flag,protocol_status=>\@protocol_status,value=>\@value,pack=>\@pack);our@FCGI_TYPE_NAME=(undef,'FCGI_BEGIN_REQUEST','FCGI_ABORT_REQUEST','FCGI_END_REQUEST','FCGI_PARAMS','FCGI_STDIN','FCGI_STDOUT','FCGI_STDERR','FCGI_DATA','FCGI_GET_VALUES','FCGI_GET_VALUES_RESULT','FCGI_UNKNOWN_TYPE');our@FCGI_RECORD_NAME=(undef,'FCGI_BeginRequestRecord','FCGI_AbortRequestRecord','FCGI_EndRequestRecord','FCGI_ParamsRecord','FCGI_StdinRecord','FCGI_StdoutRecord','FCGI_StderrRecord','FCGI_DataRecord','FCGI_GetValuesRecord','FCGI_GetValuesResultRecord','FCGI_UnknownTypeRecord',);our@FCGI_ROLE_NAME=(undef,'FCGI_RESPONDER','FCGI_AUTHORIZER','FCGI_FILTER',);our@FCGI_PROTOCOL_STATUS_NAME=('FCGI_REQUEST_COMPLETE','FCGI_CANT_MPX_CONN','FCGI_OVERLOADED','FCGI_UNKNOWN_ROLE',);if (Internals->can('SvREADONLY')){Internals::SvREADONLY(@FCGI_TYPE_NAME,1);Internals::SvREADONLY(@FCGI_RECORD_NAME,1);Internals::SvREADONLY(@FCGI_ROLE_NAME,1);Internals::SvREADONLY(@FCGI_PROTOCOL_STATUS_NAME,1);Internals::SvREADONLY($_,1)for@FCGI_TYPE_NAME,@FCGI_RECORD_NAME,@FCGI_ROLE_NAME,@FCGI_PROTOCOL_STATUS_NAME}require Exporter;*import=\&Exporter::import}sub FCGI_LISTENSOCK_FILENO () {0}sub FCGI_MAX_CONTENT_LEN () {0xFFFF}sub FCGI_MAX_LEN () {0xFFFF}sub FCGI_HEADER_LEN () {8}sub FCGI_VERSION_1 () {1}sub FCGI_NULL_REQUEST_ID () {0}sub FCGI_BEGIN_REQUEST () {1}sub FCGI_ABORT_REQUEST () {2}sub FCGI_END_REQUEST () {3}sub FCGI_PARAMS () {4}sub FCGI_STDIN () {5}sub FCGI_STDOUT () {6}sub FCGI_STDERR () {7}sub FCGI_DATA () {8}sub FCGI_GET_VALUES () {9}sub FCGI_GET_VALUES_RESULT () {10}sub FCGI_UNKNOWN_TYPE () {11}sub FCGI_MAXTYPE () {FCGI_UNKNOWN_TYPE}sub FCGI_RESPONDER () {1}sub FCGI_AUTHORIZER () {2}sub FCGI_FILTER () {3}sub FCGI_KEEP_CONN () {1}sub FCGI_REQUEST_COMPLETE () {0}sub FCGI_CANT_MPX_CONN () {1}sub FCGI_OVERLOADED () {2}sub FCGI_UNKNOWN_ROLE () {3}sub FCGI_MAX_CONNS () {'FCGI_MAX_CONNS'}sub FCGI_MAX_REQS () {'FCGI_MAX_REQS'}sub FCGI_MPXS_CONNS () {'FCGI_MPXS_CONNS'}sub FCGI_Header () {'CCnnCx'}sub FCGI_BeginRequestBody () {'nCx5'}sub FCGI_EndRequestBody () {'NCx3'}sub FCGI_UnknownTypeBody () {'Cx7'}1;
NET_FASTCGI_CONSTANT

$fatpacked{"Net/FastCGI/IO.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_IO';
  package Net::FastCGI::IO;use strict;use warnings;use warnings::register;use Carp qw[];use Errno qw[EBADF EINTR EPIPE];use Net::FastCGI::Constant qw[FCGI_HEADER_LEN];use Net::FastCGI::Protocol qw[build_header build_record build_stream parse_header parse_record];BEGIN {our$VERSION='0.14';our@EXPORT_OK=qw[can_read can_write read_header read_record write_header write_record write_stream];our%EXPORT_TAGS=(all=>\@EXPORT_OK);require Exporter;*import=\&Exporter::import;eval q<use Time::HiRes 'time'>}*throw=\&Carp::croak;sub read_header {@_==1 || throw(q/Usage: read_header(fh)/);my ($fh)=@_;my$len=FCGI_HEADER_LEN;my$off=0;my$buf;while ($len){my$r=sysread($fh,$buf,$len,$off);if (defined$r){last unless$r;$len -= $r;$off += $r}elsif ($!!=EINTR){warnings::warn(qq<FastCGI: Could not read FCGI_Header: '$!'>)if warnings::enabled;return}}if ($len){$!=$off ? EPIPE : 0;warnings::warn(q<FastCGI: Could not read FCGI_Header: Unexpected end of stream>)if$off && warnings::enabled;return}return parse_header($buf)}sub write_header {@_==5 || throw(q/Usage: write_header(fh, type, request_id, content_length, padding_length)/);my$fh=shift;my$buf=&build_header;my$len=FCGI_HEADER_LEN;my$off=0;while (){my$r=syswrite($fh,$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len}elsif ($!!=EINTR){warnings::warn(qq<FastCGI: Could not write FCGI_Header: '$!'>)if warnings::enabled;return undef}}return$off}sub read_record {@_==1 || throw(q/Usage: read_record(fh)/);my ($fh)=@_;my$len=FCGI_HEADER_LEN;my$off=0;my$buf;while ($len){my$r=sysread($fh,$buf,$len,$off);if (defined$r){last unless$r;$len -= $r;$off += $r;if (!$len && $off==FCGI_HEADER_LEN){$len=vec($buf,2,16)+ vec($buf,6,8)}}elsif ($!!=EINTR){warnings::warn(qq<FastCGI: Could not read FCGI_Record: '$!'>)if warnings::enabled;return}}if ($len){$!=$off ? EPIPE : 0;warnings::warn(q<FastCGI: Could not read FCGI_Record: Unexpected end of stream>)if$off && warnings::enabled;return}return parse_record($buf)}sub write_record {@_==4 || @_==5 || throw(q/Usage: write_record(fh, type, request_id [, content])/);my$fh=shift;my$buf=&build_record;my$len=length$buf;my$off=0;while (){my$r=syswrite($fh,$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len}elsif ($!!=EINTR){warnings::warn(qq<FastCGI: Could not write FCGI_Record: '$!'>)if warnings::enabled;return undef}}return$off}sub write_stream {@_==4 || @_==5 || throw(q/Usage: write_stream(fh, type, request_id, content [, terminate])/);my$fh=shift;my$buf=&build_stream;my$len=length$buf;my$off=0;while (){my$r=syswrite($fh,$buf,$len,$off);if (defined$r){$len -= $r;$off += $r;last unless$len}elsif ($!!=EINTR){warnings::warn(qq<FastCGI: Could not write FCGI_Record stream: '$!'>)if warnings::enabled;return undef}}return$off}sub can_read (*$) {@_==2 || throw(q/Usage: can_read(fh, timeout)/);my ($fh,$timeout)=@_;my$fd=fileno($fh);unless (defined$fd && $fd >= 0){$!=EBADF;return undef}my$initial=time;my$pending=$timeout;my$nfound;vec(my$fdset='',$fd,1)=1;while (){$nfound=select($fdset,undef,undef,$pending);if ($nfound==-1){return undef unless $!==EINTR;redo if!$timeout || ($pending=$timeout - (time - $initial))> 0;$nfound=0}last}$!=0;return$nfound}sub can_write (*$) {@_==2 || throw(q/Usage: can_write(fh, timeout)/);my ($fh,$timeout)=@_;my$fd=fileno($fh);unless (defined$fd && $fd >= 0){$!=EBADF;return undef}my$initial=time;my$pending=$timeout;my$nfound;vec(my$fdset='',$fd,1)=1;while (){$nfound=select(undef,$fdset,undef,$pending);if ($nfound==-1){return undef unless $!==EINTR;redo if!$timeout || ($pending=$timeout - (time - $initial))> 0;$nfound=0}last}$!=0;return$nfound}1;
NET_FASTCGI_IO

$fatpacked{"Net/FastCGI/Protocol.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_PROTOCOL';
  package Net::FastCGI::Protocol;use strict;use warnings;use Carp qw[croak];use Net::FastCGI qw[];use Net::FastCGI::Constant qw[:type :common FCGI_KEEP_CONN];BEGIN {our$VERSION='0.14';our@EXPORT_OK=qw[build_begin_request build_begin_request_body build_begin_request_record build_end_request build_end_request_body build_end_request_record build_header build_params build_record build_stream build_unknown_type_body build_unknown_type_record check_params parse_begin_request_body parse_end_request_body parse_header parse_params parse_record parse_record_body parse_unknown_type_body get_record_length get_type_name get_role_name get_protocol_status_name is_known_type is_management_type is_discrete_type is_stream_type];our%EXPORT_TAGS=(all=>\@EXPORT_OK);my$use_pp=$ENV{NET_FASTCGI_PP}|| $ENV{NET_FASTCGI_PROTOCOL_PP};if (!$use_pp){eval {require Net::FastCGI::Protocol::XS};$use_pp=!!$@}if ($use_pp){require Net::FastCGI::Protocol::PP;Net::FastCGI::Protocol::PP->import(@EXPORT_OK)}else {Net::FastCGI::Protocol::XS->import(@EXPORT_OK)}push@EXPORT_OK,'dump_record','dump_record_body';require Exporter;*import=\&Exporter::import}our$DUMP_RECORD_MAX=78;our$DUMP_RECORD_ALIGN=!!0;my%ESCAPES=("\a"=>"\\a","\b"=>"\\b","\t"=>"\\t","\n"=>"\\n","\f"=>"\\f","\r"=>"\\r",);sub dump_record {goto \&dump_record_body if (@_==2 || @_==3);@_==1 || croak(q/Usage: dump_record(octets)/);my$len=&get_record_length;($len && $len <= length $_[0]&& vec($_[0],0,8)==FCGI_VERSION_1)|| return '{Malformed FCGI_Record}';return dump_record_body(&parse_record)}sub dump_record_body {@_==2 || @_==3 || croak(q/Usage: dump_record_body(type, request_id [, content])/);my ($type,$request_id)=@_;my$content_length=defined $_[2]? length $_[2]: 0;my$max=$DUMP_RECORD_MAX > 0 ? $DUMP_RECORD_MAX : FCGI_MAX_CONTENT_LEN;my$out='';if ($type==FCGI_PARAMS || $type==FCGI_GET_VALUES || $type==FCGI_GET_VALUES_RESULT){if ($content_length==0){$out=q[""]}elsif (check_params($_[2])){my ($off,$klen,$vlen)=(0);while ($off < $content_length){my$pos=$off;for ($klen,$vlen){$_=vec($_[2],$off,8);$_=vec(substr($_[2],$off,4),0,32)& 0x7FFF_FFFF if $_ > 0x7F;$off += $_ > 0x7F ? 4 : 1}my$head=substr($_[2],$pos,$off - $pos);$head =~ s/(.)/sprintf('\\%.3o',ord($1))/egs;$out .= $head;my$body=substr($_[2],$off,$klen + $vlen);for ($body){s/([\\\"])/\\$1/g;s/([\a\b\t\n\f\r])/$ESCAPES{$1}/g;s/([^\x20-\x7E])/sprintf('\\x%.2X',ord($1))/eg}$out .= $body;$off += $klen + $vlen;last if$off > $max}substr($out,$max - 5)=' ... ' if length$out > $max;$out=qq["$out"]}else {$out='Malformed FCGI_NameValuePair(s)'}}elsif ($type==FCGI_BEGIN_REQUEST || $type==FCGI_END_REQUEST || $type==FCGI_UNKNOWN_TYPE){if ($content_length!=8){my$name=$type==FCGI_BEGIN_REQUEST ? 'FCGI_BeginRequestBody' : $type==FCGI_END_REQUEST ? 'FCGI_EndRequestBody' : 'FCGI_UnknownTypeBody';$out=sprintf '{Malformed %s (expected 8 octets got %d)}',$name,$content_length}elsif ($type==FCGI_BEGIN_REQUEST){my ($role,$flags)=parse_begin_request_body($_[2]);if ($flags!=0){my@set;if ($flags & FCGI_KEEP_CONN){$flags &=~FCGI_KEEP_CONN;push@set,'FCGI_KEEP_CONN'}if ($flags){push@set,sprintf '0x%.2X',$flags}$flags=join '|',@set}$out=sprintf '{%s, %s}',get_role_name($role),$flags}elsif($type==FCGI_END_REQUEST){my ($astatus,$pstatus)=parse_end_request_body($_[2]);$out=sprintf '{%d, %s}',$astatus,get_protocol_status_name($pstatus)}else {my$unknown_type=parse_unknown_type_body($_[2]);$out=sprintf '{%s}',get_type_name($unknown_type)}}elsif ($content_length){my$looks_like_binary=do {my$count=()=$_[2]=~ /[\r\n\t\x20-\x7E]/g;($count / $content_length)< 0.7};$out=substr($_[2],0,$max + 1);for ($out){if ($looks_like_binary){s/(.)/sprintf('\\x%.2X',ord($1))/egs}else {s/([\\\"])/\\$1/g;s/([\a\b\t\n\f\r])/$ESCAPES{$1}/g;s/([^\x20-\x7E])/sprintf('\\x%.2X',ord($1))/eg}}substr($out,$max - 5)=' ... ' if length$out > $max;$out=qq["$out"]}else {$out=q[""]}my$name=get_type_name($type);my$width=0;$width=27 - length$name if$DUMP_RECORD_ALIGN;return sprintf '{%s, %*d, %s}',$name,$width,$request_id,$out}1;
NET_FASTCGI_PROTOCOL

$fatpacked{"Net/FastCGI/Protocol/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_PROTOCOL_PP';
  package Net::FastCGI::Protocol::PP;use strict;use warnings;use Carp qw[];use Net::FastCGI::Constant qw[:all];BEGIN {our$VERSION='0.14';our@EXPORT_OK=qw[build_begin_request build_begin_request_body build_begin_request_record build_end_request build_end_request_body build_end_request_record build_header build_params build_record build_stream build_unknown_type_body build_unknown_type_record check_params parse_begin_request_body parse_end_request_body parse_header parse_params parse_record parse_record_body parse_unknown_type_body is_known_type is_management_type is_discrete_type is_stream_type get_record_length get_role_name get_type_name get_protocol_status_name];our%EXPORT_TAGS=(all=>\@EXPORT_OK);require Exporter;*import=\&Exporter::import}sub TRUE () {!!1}sub FALSE () {!!0}sub ERRMSG_OCTETS () {q/FastCGI: Insufficient number of octets to parse %s/}sub ERRMSG_MALFORMED () {q/FastCGI: Malformed record %s/}sub ERRMSG_VERSION () {q/FastCGI: Protocol version mismatch (0x%.2X)/}sub ERRMSG_OCTETS_LE () {q/Invalid Argument: '%s' cannot exceed %u octets in length/}sub throw {@_=(sprintf($_[0],@_[1..$#_]))if @_ > 1;goto \&Carp::croak}sub build_header {@_==4 || throw(q/Usage: build_header(type, request_id, content_length, padding_length)/);return pack(FCGI_Header,FCGI_VERSION_1,@_)}sub parse_header {@_==1 || throw(q/Usage: parse_header(octets)/);(defined $_[0]&& length $_[0]>= 8)|| throw(ERRMSG_OCTETS,q/FCGI_Header/);(vec($_[0],0,8)==FCGI_VERSION_1)|| throw(ERRMSG_VERSION,unpack('C',$_[0]));return unpack('xCnnCx',$_[0])if wantarray;my%header;@header{qw(type request_id content_length padding_length)}=unpack('xCnnCx',$_[0]);return \%header}sub build_begin_request_body {@_==2 || throw(q/Usage: build_begin_request_body(role, flags)/);return pack(FCGI_BeginRequestBody,@_)}sub parse_begin_request_body {@_==1 || throw(q/Usage: parse_begin_request_body(octets)/);(defined $_[0]&& length $_[0]>= 8)|| throw(ERRMSG_OCTETS,q/FCGI_BeginRequestBody/);return unpack(FCGI_BeginRequestBody,$_[0])}sub build_end_request_body {@_==2 || throw(q/Usage: build_end_request_body(app_status, protocol_status)/);return pack(FCGI_EndRequestBody,@_)}sub parse_end_request_body {@_==1 || throw(q/Usage: parse_end_request_body(octets)/);(defined $_[0]&& length $_[0]>= 8)|| throw(ERRMSG_OCTETS,q/FCGI_EndRequestBody/);return unpack(FCGI_EndRequestBody,$_[0])}sub build_unknown_type_body {@_==1 || throw(q/Usage: build_unknown_type_body(type)/);return pack(FCGI_UnknownTypeBody,@_)}sub parse_unknown_type_body {@_==1 || throw(q/Usage: parse_unknown_type_body(octets)/);(defined $_[0]&& length $_[0]>= 8)|| throw(ERRMSG_OCTETS,q/FCGI_UnknownTypeBody/);return unpack(FCGI_UnknownTypeBody,$_[0])}sub build_begin_request_record {@_==3 || throw(q/Usage: build_begin_request_record(request_id, role, flags)/);my ($request_id,$role,$flags)=@_;return build_record(FCGI_BEGIN_REQUEST,$request_id,build_begin_request_body($role,$flags))}sub build_end_request_record {@_==3 || throw(q/Usage: build_end_request_record(request_id, app_status, protocol_status)/);my ($request_id,$app_status,$protocol_status)=@_;return build_record(FCGI_END_REQUEST,$request_id,build_end_request_body($app_status,$protocol_status))}sub build_unknown_type_record {@_==1 || throw(q/Usage: build_unknown_type_record(type)/);my ($type)=@_;return build_record(FCGI_UNKNOWN_TYPE,FCGI_NULL_REQUEST_ID,build_unknown_type_body($type))}sub build_record {@_==2 || @_==3 || throw(q/Usage: build_record(type, request_id [, content])/);my ($type,$request_id)=@_;my$content_length=defined $_[2]? length $_[2]: 0;my$padding_length=(8 - ($content_length % 8))% 8;($content_length <= FCGI_MAX_CONTENT_LEN)|| throw(ERRMSG_OCTETS_LE,q/content/,FCGI_MAX_CONTENT_LEN);my$res=build_header($type,$request_id,$content_length,$padding_length);if ($content_length){$res .= $_[2]}if ($padding_length){$res .= "\x00" x $padding_length}return$res}sub parse_record {@_==1 || throw(q/Usage: parse_record(octets)/);my ($type,$request_id,$content_length)=&parse_header;(length $_[0]>= FCGI_HEADER_LEN + $content_length)|| throw(ERRMSG_OCTETS,q/FCGI_Record/);return wantarray ? ($type,$request_id,substr($_[0],FCGI_HEADER_LEN,$content_length)): parse_record_body($type,$request_id,substr($_[0],FCGI_HEADER_LEN,$content_length))}sub parse_record_body {@_==3 || throw(q/Usage: parse_record_body(type, request_id, content)/);my ($type,$request_id)=@_;my$content_length=defined $_[2]? length $_[2]: 0;($content_length <= FCGI_MAX_CONTENT_LEN)|| throw(ERRMSG_OCTETS_LE,q/content/,FCGI_MAX_CONTENT_LEN);my%record=(type=>$type,request_id=>$request_id);if ($type==FCGI_BEGIN_REQUEST){($request_id!=FCGI_NULL_REQUEST_ID && $content_length==8)|| throw(ERRMSG_MALFORMED,q/FCGI_BeginRequestRecord/);@record{qw(role flags) }=parse_begin_request_body($_[2])}elsif ($type==FCGI_ABORT_REQUEST){($request_id!=FCGI_NULL_REQUEST_ID && $content_length==0)|| throw(ERRMSG_MALFORMED,q/FCGI_AbortRequestRecord/)}elsif ($type==FCGI_END_REQUEST){($request_id!=FCGI_NULL_REQUEST_ID && $content_length==8)|| throw(ERRMSG_MALFORMED,q/FCGI_EndRequestRecord/);@record{qw(app_status protocol_status) }=parse_end_request_body($_[2])}elsif ($type==FCGI_PARAMS || $type==FCGI_STDIN || $type==FCGI_STDOUT || $type==FCGI_STDERR || $type==FCGI_DATA){($request_id!=FCGI_NULL_REQUEST_ID)|| throw(ERRMSG_MALFORMED,$FCGI_RECORD_NAME[$type]);$record{content}=$content_length ? $_[2]: ''}elsif ($type==FCGI_GET_VALUES || $type==FCGI_GET_VALUES_RESULT){($request_id==FCGI_NULL_REQUEST_ID)|| throw(ERRMSG_MALFORMED,$FCGI_RECORD_NAME[$type]);$record{values}=parse_params($_[2])}elsif ($type==FCGI_UNKNOWN_TYPE){($request_id==FCGI_NULL_REQUEST_ID && $content_length==8)|| throw(ERRMSG_MALFORMED,q/FCGI_UnknownTypeRecord/);$record{unknown_type}=parse_unknown_type_body($_[2])}else {$record{content}=$_[2]if$content_length}return \%record}sub FCGI_SEGMENT_LEN () {32768 - FCGI_HEADER_LEN}sub build_stream {@_==3 || @_==4 || throw(q/Usage: build_stream(type, request_id, content [, terminate])/);my ($type,$request_id,undef,$terminate)=@_;my$len=defined $_[2]? length $_[2]: 0;my$res='';if ($len){if ($len < FCGI_SEGMENT_LEN){$res=build_record($type,$request_id,$_[2])}else {my$header=build_header($type,$request_id,FCGI_SEGMENT_LEN,0);my$off=0;while ($len >= FCGI_SEGMENT_LEN){$res .= $header;$res .= substr($_[2],$off,FCGI_SEGMENT_LEN);$len -= FCGI_SEGMENT_LEN;$off += FCGI_SEGMENT_LEN}if ($len){$res .= build_record($type,$request_id,substr($_[2],$off,$len))}}}if ($terminate){$res .= build_header($type,$request_id,0,0)}return$res}sub build_params {@_==1 || throw(q/Usage: build_params(params)/);my ($params)=@_;my$res='';while (my ($key,$val)=each(%$params)){for ($key,$val){my$len=defined $_ ? length : 0;$res .= $len < 0x80 ? pack('C',$len): pack('N',$len | 0x8000_0000)}$res .= $key;$res .= $val if defined$val}return$res}sub parse_params {@_==1 || throw(q/Usage: parse_params(octets)/);my ($octets)=@_;(defined$octets)|| return +{};my ($params,$klen,$vlen)=({},0,0);while (length$octets){for ($klen,$vlen){(1 <= length$octets)|| throw(ERRMSG_OCTETS,q/FCGI_NameValuePair/);$_=vec(substr($octets,0,1,''),0,8);next if $_ < 0x80;(3 <= length$octets)|| throw(ERRMSG_OCTETS,q/FCGI_NameValuePair/);$_=vec(pack('C',$_ & 0x7F).substr($octets,0,3,''),0,32)}($klen + $vlen <= length$octets)|| throw(ERRMSG_OCTETS,q/FCGI_NameValuePair/);my$key=substr($octets,0,$klen,'');$params->{$key}=substr($octets,0,$vlen,'')}return$params}sub check_params {@_==1 || throw(q/Usage: check_params(octets)/);(defined $_[0])|| return FALSE;my ($len,$off,$klen,$vlen)=(length $_[0],0,0,0);while ($off < $len){for ($klen,$vlen){(($off += 1)<= $len)|| return FALSE;$_=vec($_[0],$off - 1,8);next if $_ < 0x80;(($off += 3)<= $len)|| return FALSE;$_=vec(substr($_[0],$off - 4,4),0,32)& 0x7FFF_FFFF}(($off += $klen + $vlen)<= $len)|| return FALSE}return TRUE}sub build_begin_request {(@_ >= 4 && @_ <= 6)|| throw(q/Usage: build_begin_request(request_id, role, flags, params [, stdin [, data]])/);my ($request_id,$role,$flags,$params)=@_;my$r=build_begin_request_record($request_id,$role,$flags).build_stream(FCGI_PARAMS,$request_id,build_params($params),TRUE);if (@_ > 4){$r .= build_stream(FCGI_STDIN,$request_id,$_[4],TRUE);if (@_ > 5){$r .= build_stream(FCGI_DATA,$request_id,$_[5],TRUE)}}return$r}sub build_end_request {(@_ >= 3 && @_ <= 5)|| throw(q/Usage: build_end_request(request_id, app_status, protocol_status [, stdout [, stderr]])/);my ($request_id,$app_status,$protocol_status)=@_;my$r;if (@_ > 3){$r .= build_stream(FCGI_STDOUT,$request_id,$_[3],TRUE);if (@_ > 4){$r .= build_stream(FCGI_STDERR,$request_id,$_[4],TRUE)}}$r .= build_end_request_record($request_id,$app_status,$protocol_status);return$r}sub get_record_length {@_==1 || throw(q/Usage: get_record_length(octets)/);(defined $_[0]&& length $_[0]>= FCGI_HEADER_LEN)|| return 0;return FCGI_HEADER_LEN + vec($_[0],2,16)+ vec($_[0],6,8)}sub is_known_type {@_==1 || throw(q/Usage: is_known_type(type)/);my ($type)=@_;return ($type > 0 && $type <= FCGI_MAXTYPE)}sub is_discrete_type {@_==1 || throw(q/Usage: is_discrete_type(type)/);my ($type)=@_;return ($type==FCGI_BEGIN_REQUEST || $type==FCGI_ABORT_REQUEST || $type==FCGI_END_REQUEST || $type==FCGI_GET_VALUES || $type==FCGI_GET_VALUES_RESULT || $type==FCGI_UNKNOWN_TYPE)}sub is_management_type {@_==1 || throw(q/Usage: is_management_type(type)/);my ($type)=@_;return ($type==FCGI_GET_VALUES || $type==FCGI_GET_VALUES_RESULT || $type==FCGI_UNKNOWN_TYPE)}sub is_stream_type {@_==1 || throw(q/Usage: is_stream_type(type)/);my ($type)=@_;return ($type==FCGI_PARAMS || $type==FCGI_STDIN || $type==FCGI_STDOUT || $type==FCGI_STDERR || $type==FCGI_DATA)}sub get_type_name {@_==1 || throw(q/Usage: get_type_name(type)/);my ($type)=@_;return$FCGI_TYPE_NAME[$type]|| sprintf('0x%.2X',$type)}sub get_role_name {@_==1 || throw(q/Usage: get_role_name(role)/);my ($role)=@_;return$FCGI_ROLE_NAME[$role]|| sprintf('0x%.4X',$role)}sub get_protocol_status_name {@_==1 || throw(q/Usage: get_protocol_status_name(protocol_status)/);my ($status)=@_;return$FCGI_PROTOCOL_STATUS_NAME[$status]|| sprintf('0x%.2X',$status)}1;
NET_FASTCGI_PROTOCOL_PP

s/^  //mg for values %fatpacked;

my $class = 'FatPacked::'.(0+\%fatpacked);
no strict 'refs';
*{"${class}::files"} = sub { keys %{$_[0]} };

if ($] < 5.008) {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      my $pos = 0;
      my $last = length $fat;
      return (sub {
        return 0 if $pos == $last;
        my $next = (1 + index $fat, "\n", $pos) || $last;
        $_ .= substr $fat, $pos, $next - $pos;
        $pos = $next;
        return 1;
      });
    }
  };
}

else {
  *{"${class}::INC"} = sub {
    if (my $fat = $_[0]{$_[1]}) {
      open my $fh, '<', \$fat
        or die "FatPacker error loading $_[1] (could be a perl installation issue?)";
      return $fh;
    }
    return;
  };
}

unshift @INC, bless \%fatpacked, $class;
  } # END OF FATPACK CODE


use strict;
use warnings;
use File::Basename qw(dirname);
use File::Temp qw(tempfile);
use Getopt::Long;
use IO::Socket::UNIX;
use Net::FastCGI;
use Net::FastCGI::Constant qw(:common :type :flag :role :protocol_status);
use Net::FastCGI::IO qw(:all);
use Net::FastCGI::Protocol qw(:all);
use POSIX qw(:sys_wait_h getcwd);
use Socket qw(SOMAXCONN SOCK_STREAM);

my $master_pid = $$;
my %child_procs;

$SIG{CHLD} = sub {};
$SIG{HUP} = sub {};
$SIG{TERM} = sub {
    if ($$ == $master_pid) {
        kill "TERM", $_
            for sort keys %child_procs;
    }
    exit 0;
};

my $base_dir = getcwd;
chdir "/"
    or die "failed to chdir to /:$!";
main();
my $pass_authz;

sub main {
    my $sockfn;
    my $max_workers = "inf" + 1;

    GetOptions(
        "listen=s"      => \$sockfn,
        "max-workers=i" => \$max_workers,
        "pass-authz"    => \$pass_authz,
        "help"          => sub {
            print_help();
            exit 0;
        },
    ) or exit 1;

    my $listen_sock;
    if (defined $sockfn) {
        unlink $sockfn;
        $listen_sock = IO::Socket::UNIX->new(
            Listen => SOMAXCONN,
            Local  => $sockfn,
            Type   => SOCK_STREAM,
        ) or die "failed to create unix socket at $sockfn:$!";
    } else {
        die "stdin is no a socket"
            unless -S STDIN;
        $listen_sock = IO::Socket::UNIX->new;
        $listen_sock->fdopen(fileno(STDIN), "w")
            or die "failed to open unix socket:$!";
    }

    while (1) {
        my $wait_opt = 0;
        if (keys %child_procs < $max_workers) {
            if (my $sock = $listen_sock->accept) {
                my $pid = fork;
                die "fork failed:$!"
                    unless defined $pid;
                if ($pid == 0) {
                    close $listen_sock;
                    handle_connection($sock);
                    exit 0;
                }
                $sock->close;
                $child_procs{$pid} = 1;
            }
            $wait_opt = WNOHANG;
        } else {
            $wait_opt = 0;
        }
        my $kid = waitpid(-1, $wait_opt);
        if ($kid > 0) {
            delete $child_procs{$kid};
        }
    }
}

sub handle_connection {
    my $sock = shift;
    my ($type, $req_id, $content);
    my $cur_req_id;
    my $params = "";
    my $input_fh;

    # wait for FCGI_BEGIN_REQUEST
    ($type, $req_id, $content) = fetch_record($sock);
    die "expected FCGI_BEGIN_REQUEST, but got $type"
        unless $type == FCGI_BEGIN_REQUEST;
    my ($role, $flags) = parse_begin_request_body($content);
    die "unexpected role:$role"
        unless $role == FCGI_RESPONDER;
    $cur_req_id = $req_id;

    # accumulate FCGI_PARAMS
    while (1) {
        ($type, $req_id, $content) = fetch_record($sock);
        last if $type != FCGI_PARAMS;
        die "unexpected request id"
            if $cur_req_id != $req_id;
        $params .= $content;
    }
    my $env = parse_params($params);
    die "SCRIPT_FILENAME not defined"
        unless $env->{SCRIPT_FILENAME};
    $env->{SCRIPT_FILENAME} = "$base_dir/$env->{SCRIPT_FILENAME}"
        if $env->{SCRIPT_FILENAME} !~ m{^/};
    delete $env->{HTTP_AUTHORIZATION}
        unless $pass_authz;

    # accumulate FCGI_STDIN
    while (1) {
        die "received unexpected record: $type"
            if $type != FCGI_STDIN;
        die "unexpected request id"
            if $cur_req_id != $req_id;
        last if length $content == 0;
        if (!$input_fh) {
            $input_fh = tempfile()
                or die "failed to create temporary file:$!";
        }
        print $input_fh $content;
        ($type, $req_id, $content) = fetch_record($sock);
    }
    if ($input_fh) {
        flush $input_fh;
        seek $input_fh, 0, 0
            or die "seek failed:$!";
    } else {
        open $input_fh, "<", "/dev/null"
            or die "failed to open /dev/null:$!";
    }

    # create pipes for stdout and stderr
    pipe(my $stdout_rfh, my $stdout_wfh)
        or die "pipe failed:$!";
    pipe(my $stderr_rfh, my $stderr_wfh)
        or die "pipe failed:$!";

    # fork the CGI application
    my $pid = fork;
    die "fork failed:$!"
        unless defined $pid;
    if ($pid == 0) {
        close $sock;
        close $stdout_rfh;
        close $stderr_rfh;
        open STDERR, ">&", $stderr_wfh
            or die "failed to dup STDERR";
        open STDIN, "<&", $input_fh
            or die "failed to dup STDIN";
        open STDOUT, ">&", $stdout_wfh
            or die "failed to dup STDOUT";
        close $stderr_wfh;
        close $input_fh;
        close $stdout_wfh;
        $ENV{$_} = $env->{$_}
            for sort keys %$env;
        chdir dirname($env->{SCRIPT_FILENAME});
        exec $env->{SCRIPT_FILENAME};
        exit 111;
    }
    close $stdout_wfh;
    close $stderr_wfh;

    # send response
    while ($stdout_rfh || $stderr_rfh) {
        my $rin = '';
        vec($rin, fileno $stdout_rfh, 1) = 1
            if $stdout_rfh;
        vec($rin, fileno $stderr_rfh, 1) = 1
            if $stderr_rfh;
        vec($rin, fileno $sock, 1) = 1;
        if (select($rin, undef, undef, undef) <= 0) {
            next;
        }
        if ($stdout_rfh && vec($rin, fileno $stdout_rfh, 1)) {
            transfer($sock, FCGI_STDOUT, $cur_req_id, $stdout_rfh)
                or undef $stdout_rfh;
        }
        if ($stderr_rfh && vec($rin, fileno $stderr_rfh, 1)) {
            transfer($sock, FCGI_STDERR, $cur_req_id, $stderr_rfh)
                or undef $stderr_rfh;
        }
        if (vec($rin, fileno $sock, 1)) {
            # atually means that the client has closed the connection, terminate the CGI process the same way apache does
            kill 'TERM', $pid;
            $SIG{ALRM} = sub {
                kill 'KILL', $pid;
            };
            alarm 3;
            last;
        }
    }

    # close (closing without sending FCGI_END_REQUEST indicates to the client that the connection is not persistent)
    close $sock;

    # wait for child process to die
    while (waitpid($pid, 0) != $pid) {
    }
}

sub fetch_record {
    my $sock = shift;
    my ($type, $req_id, $content) = read_record($sock)
      or die "failed to read FCGI record:$!";
    die "unexpected request id:null"
        if $req_id == FCGI_NULL_REQUEST_ID;
    ($type, $req_id, $content);
}

sub transfer {
    my ($sock, $type, $req_id, $fh) = @_;
    my $buf;

    while (1) {
        my $ret = sysread $fh, $buf, 61440;
        next if (!defined $ret) && $! == Errno::EINTR;
        $buf = "" unless $ret; # send zero-length record to indicate EOS
        last;
    }
    write_record($sock, $type, $req_id, $buf)
        or die "failed to write FCGI response:$!";
    return length $buf;
}

sub print_help {
    # do not use Pod::Usage, since we are fatpacking this script
    print << "EOT";
Usage:
    $0 [options]

Options:
  --listen=sockfn    path to the UNIX socket.  If specified, the program will
                     create a UNIX socket at given path replacing the existing
                     file (should it exist).  If not, file descriptor zero (0)
                     will be used as the UNIX socket for accepting new
                     connections.
  --max-workers=nnn  maximum number of CGI processes (default: unlimited)
  --pass-authz       if set, preserves HTTP_AUTHORIZATION parameter

EOT
}