#! /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]}) {

return sub {

return 0 unless length $fat;

$fat =~ s/^([^\n]*\n?)//;

$_ = $1;

return 1;

};

}

return;

};

}

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

}