diff options
Diffstat (limited to '')
| -rwxr-xr-x | debian/vendor-h2o/share/h2o/fastcgi-cgi | 319 |
1 files changed, 319 insertions, 0 deletions
diff --git a/debian/vendor-h2o/share/h2o/fastcgi-cgi b/debian/vendor-h2o/share/h2o/fastcgi-cgi new file mode 100755 index 0000000..baf59d4 --- /dev/null +++ b/debian/vendor-h2o/share/h2o/fastcgi-cgi @@ -0,0 +1,319 @@ +#! /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 +} |