forked from h2o/h2o
-
Notifications
You must be signed in to change notification settings - Fork 0
/
fastcgi-cgi
executable file
·317 lines (283 loc) · 29.1 KB
/
fastcgi-cgi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
#! /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
}