1#! /bin/sh 2exec ${H2O_PERL:-perl} -x $0 "$@" 3#! perl 4# This chunk of stuff was generated by App::FatPacker. To find the original 5# file's code, look for the end of this BEGIN block or the string 'FATPACK' 6BEGIN { 7my %fatpacked; 8 9$fatpacked{"Net/FastCGI.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI'; 10 package Net::FastCGI;use strict;use warnings;our$VERSION='0.14';use Net::FastCGI::Constant;use Net::FastCGI::Protocol;1; 11NET_FASTCGI 12 13$fatpacked{"Net/FastCGI/Constant.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_CONSTANT'; 14 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; 15NET_FASTCGI_CONSTANT 16 17$fatpacked{"Net/FastCGI/IO.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_IO'; 18 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; 19NET_FASTCGI_IO 20 21$fatpacked{"Net/FastCGI/Protocol.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_PROTOCOL'; 22 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; 23NET_FASTCGI_PROTOCOL 24 25$fatpacked{"Net/FastCGI/Protocol/PP.pm"} = '#line '.(1+__LINE__).' "'.__FILE__."\"\n".<<'NET_FASTCGI_PROTOCOL_PP'; 26 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; 27NET_FASTCGI_PROTOCOL_PP 28 29s/^ //mg for values %fatpacked; 30 31my $class = 'FatPacked::'.(0+\%fatpacked); 32no strict 'refs'; 33*{"${class}::files"} = sub { keys %{$_[0]} }; 34 35if ($] < 5.008) { 36 *{"${class}::INC"} = sub { 37 if (my $fat = $_[0]{$_[1]}) { 38 my $pos = 0; 39 my $last = length $fat; 40 return (sub { 41 return 0 if $pos == $last; 42 my $next = (1 + index $fat, "\n", $pos) || $last; 43 $_ .= substr $fat, $pos, $next - $pos; 44 $pos = $next; 45 return 1; 46 }); 47 } 48 }; 49} 50 51else { 52 *{"${class}::INC"} = sub { 53 if (my $fat = $_[0]{$_[1]}) { 54 open my $fh, '<', \$fat 55 or die "FatPacker error loading $_[1] (could be a perl installation issue?)"; 56 return $fh; 57 } 58 return; 59 }; 60} 61 62unshift @INC, bless \%fatpacked, $class; 63 } # END OF FATPACK CODE 64 65 66use strict; 67use warnings; 68use File::Basename qw(dirname); 69use File::Temp qw(tempfile); 70use Getopt::Long; 71use IO::Socket::UNIX; 72use Net::FastCGI; 73use Net::FastCGI::Constant qw(:common :type :flag :role :protocol_status); 74use Net::FastCGI::IO qw(:all); 75use Net::FastCGI::Protocol qw(:all); 76use POSIX qw(:sys_wait_h getcwd); 77use Socket qw(SOMAXCONN SOCK_STREAM); 78 79my $master_pid = $$; 80my %child_procs; 81my $base_dir = getcwd; 82my $pass_authz; 83my $verbose = 0; 84 85$SIG{CHLD} = sub {}; 86$SIG{HUP} = sub {}; 87$SIG{TERM} = sub { 88 if ($$ == $master_pid) { 89 kill "TERM", $_ 90 for sort keys %child_procs; 91 } 92 exit 0; 93}; 94 95chdir "/" 96 or die "failed to chdir to /:$!"; 97main(); 98 99sub verbose_print { 100 return unless $verbose; 101 print STDERR "fastcgi-cgi:$$:@_\n"; 102} 103 104sub main { 105 my $sockfn; 106 my $max_workers = "inf" + 1; 107 108 GetOptions( 109 "listen=s" => \$sockfn, 110 "max-workers=i" => \$max_workers, 111 "pass-authz" => \$pass_authz, 112 "verbose" => sub { ++$verbose }, 113 "help" => sub { 114 print_help(); 115 exit 0; 116 }, 117 ) or exit 1; 118 119 my $listen_sock; 120 if (defined $sockfn) { 121 unlink $sockfn; 122 $listen_sock = IO::Socket::UNIX->new( 123 Listen => SOMAXCONN, 124 Local => $sockfn, 125 Type => SOCK_STREAM, 126 ) or die "failed to create unix socket at $sockfn:$!"; 127 } else { 128 die "stdin is no a socket" 129 unless -S STDIN; 130 $listen_sock = IO::Socket::UNIX->new; 131 $listen_sock->fdopen(fileno(STDIN), "w") 132 or die "failed to open unix socket:$!"; 133 } 134 verbose_print("accepting connections"); 135 136 while (1) { 137 my $wait_opt = 0; 138 if (keys %child_procs < $max_workers) { 139 if (my $sock = $listen_sock->accept) { 140 verbose_print("accepted new connection"); 141 my $pid = fork; 142 die "fork failed:$!" 143 unless defined $pid; 144 if ($pid == 0) { 145 close $listen_sock; 146 handle_connection($sock); 147 exit 0; 148 } 149 $sock->close; 150 $child_procs{$pid} = 1; 151 } 152 $wait_opt = WNOHANG; 153 } else { 154 verbose_print("reached max-workers"); 155 $wait_opt = 0; 156 } 157 my $kid = waitpid(-1, $wait_opt); 158 if ($kid > 0) { 159 verbose_print("collected pid $kid"); 160 delete $child_procs{$kid}; 161 } 162 } 163} 164 165sub handle_connection { 166 my $sock = shift; 167 my ($type, $req_id, $content); 168 my $cur_req_id; 169 my $params = ""; 170 my $input_fh; 171 172 verbose_print("handling new request"); 173 174 # wait for FCGI_BEGIN_REQUEST 175 ($type, $req_id, $content) = fetch_record($sock); 176 die "expected FCGI_BEGIN_REQUEST, but got $type" 177 unless $type == FCGI_BEGIN_REQUEST; 178 my ($role, $flags) = parse_begin_request_body($content); 179 die "unexpected role:$role" 180 unless $role == FCGI_RESPONDER; 181 $cur_req_id = $req_id; 182 verbose_print("received FCGI_BEGIN_REQUEST"); 183 184 # accumulate FCGI_PARAMS 185 while (1) { 186 ($type, $req_id, $content) = fetch_record($sock); 187 last if $type != FCGI_PARAMS; 188 die "unexpected request id" 189 if $cur_req_id != $req_id; 190 $params .= $content; 191 } 192 my $env = parse_params($params); 193 die "SCRIPT_FILENAME not defined" 194 unless $env->{SCRIPT_FILENAME}; 195 $env->{SCRIPT_FILENAME} = "$base_dir/$env->{SCRIPT_FILENAME}" 196 if $env->{SCRIPT_FILENAME} !~ m{^/}; 197 delete $env->{HTTP_AUTHORIZATION} 198 unless $pass_authz; 199 verbose_print("received FCGI_PARAMS"); 200 201 # accumulate FCGI_STDIN 202 while (1) { 203 die "received unexpected record: $type" 204 if $type != FCGI_STDIN; 205 die "unexpected request id" 206 if $cur_req_id != $req_id; 207 last if length $content == 0; 208 if (!$input_fh) { 209 $input_fh = tempfile() 210 or die "failed to create temporary file:$!"; 211 } 212 print $input_fh $content; 213 ($type, $req_id, $content) = fetch_record($sock); 214 } 215 if ($input_fh) { 216 flush $input_fh; 217 seek $input_fh, 0, 0 218 or die "seek failed:$!"; 219 } else { 220 open $input_fh, "<", "/dev/null" 221 or die "failed to open /dev/null:$!"; 222 } 223 verbose_print("received FCGI_STDIN"); 224 225 # create pipes for stdout and stderr 226 pipe(my $stdout_rfh, my $stdout_wfh) 227 or die "pipe failed:$!"; 228 pipe(my $stderr_rfh, my $stderr_wfh) 229 or die "pipe failed:$!"; 230 231 # fork the CGI application 232 verbose_print("spawning $env->{SCRIPT_FILENAME}"); 233 my $pid = fork; 234 die "fork failed:$!" 235 unless defined $pid; 236 if ($pid == 0) { 237 close $sock; 238 close $stdout_rfh; 239 close $stderr_rfh; 240 open STDERR, ">&", $stderr_wfh 241 or die "failed to dup STDERR"; 242 open STDIN, "<&", $input_fh 243 or die "failed to dup STDIN"; 244 open STDOUT, ">&", $stdout_wfh 245 or die "failed to dup STDOUT"; 246 close $stderr_wfh; 247 close $input_fh; 248 close $stdout_wfh; 249 $ENV{$_} = $env->{$_} 250 for sort keys %$env; 251 chdir dirname($env->{SCRIPT_FILENAME}); 252 exec $env->{SCRIPT_FILENAME}; 253 die "failed to spawn $env->{SCRIPT_FILENAME}:$!"; 254 } 255 close $stdout_wfh; 256 close $stderr_wfh; 257 258 verbose_print("waiting for response"); 259 260 # send response 261 while ($stdout_rfh || $stderr_rfh) { 262 my $rin = ''; 263 vec($rin, fileno $stdout_rfh, 1) = 1 264 if $stdout_rfh; 265 vec($rin, fileno $stderr_rfh, 1) = 1 266 if $stderr_rfh; 267 vec($rin, fileno $sock, 1) = 1; 268 if (select($rin, undef, undef, undef) <= 0) { 269 next; 270 } 271 if ($stdout_rfh && vec($rin, fileno $stdout_rfh, 1)) { 272 verbose_print("forwarding STDOUT"); 273 transfer($sock, FCGI_STDOUT, $cur_req_id, $stdout_rfh) 274 or undef $stdout_rfh; 275 } 276 if ($stderr_rfh && vec($rin, fileno $stderr_rfh, 1)) { 277 verbose_print("forwarding STDERR"); 278 transfer($sock, FCGI_STDERR, $cur_req_id, $stderr_rfh) 279 or undef $stderr_rfh; 280 } 281 if (vec($rin, fileno $sock, 1)) { 282 # atually means that the client has closed the connection, terminate the CGI process the same way apache does 283 verbose_print("client has closed connection; killing myself in 3 seconds"); 284 kill 'TERM', $pid; 285 $SIG{ALRM} = sub { 286 kill 'KILL', $pid; 287 }; 288 alarm 3; 289 last; 290 } 291 } 292 293 verbose_print("response complete"); 294 295 # close (closing without sending FCGI_END_REQUEST indicates to the client that the connection is not persistent) 296 close $sock; 297 298 # wait for child process to die 299 verbose_print("waiting for CGI process to exit"); 300 while (waitpid($pid, 0) != $pid) { 301 } 302 verbose_print("exitting"); 303} 304 305sub fetch_record { 306 my $sock = shift; 307 my ($type, $req_id, $content) = read_record($sock) 308 or die "failed to read FCGI record:$!"; 309 die "unexpected request id:null" 310 if $req_id == FCGI_NULL_REQUEST_ID; 311 ($type, $req_id, $content); 312} 313 314sub transfer { 315 my ($sock, $type, $req_id, $fh) = @_; 316 my $buf; 317 318 while (1) { 319 my $ret = sysread $fh, $buf, 61440; 320 next if (!defined $ret) && $! == Errno::EINTR; 321 $buf = "" unless $ret; # send zero-length record to indicate EOS 322 last; 323 } 324 write_record($sock, $type, $req_id, $buf) 325 or die "failed to write FCGI response:$!"; 326 return length $buf; 327} 328 329sub print_help { 330 # do not use Pod::Usage, since we are fatpacking this script 331 print << "EOT"; 332Usage: 333 $0 [options] 334 335Options: 336 --listen=sockfn path to the UNIX socket. If specified, the program will 337 create a UNIX socket at given path replacing the existing 338 file (should it exist). If not, file descriptor zero (0) 339 will be used as the UNIX socket for accepting new 340 connections. 341 --max-workers=nnn maximum number of CGI processes (default: unlimited) 342 --pass-authz if set, preserves HTTP_AUTHORIZATION parameter 343 --verbose verbose mode 344 345EOT 346} 347