Write out in 32KiB chunks since FastCGI protocol support
[catagits/fcgi2.git] / perl / FCGI.PL
CommitLineData
1b64d24d 1use Config;
fa01dc1c 2use ExtUtils::MakeMaker;
1b64d24d 3
0833402a 4do 'FCGI.cfg' or die "no FCGI.cfg";
1b64d24d 5
0833402a 6open OUT, ">FCGI.pm";
7
8print "Generating FCGI.pm\n";
9print OUT <<'EOP';
4f396a01 10# $Id: FCGI.PL,v 1.36 2002/12/15 20:01:46 skimo Exp $
0833402a 11
12package FCGI;
13
14require Exporter;
15require DynaLoader;
16
17@ISA = qw(Exporter DynaLoader);
18# Items to export into callers namespace by default. Note: do not export
19# names by default without a very good reason. Use EXPORT_OK instead.
20# Do not simply export all your public functions/methods/constants.
21@EXPORT = qw(
22
23);
24
0833402a 25EOP
26
fa01dc1c 27print OUT '$VERSION = '.MM->parse_version('version.pm').";\n\n";
4945bfbe 28
0833402a 29print OUT "bootstrap FCGI;\n" unless ($pure);
30
31print OUT <<'EOP' if ($pure);
32use Symbol;
33use POSIX 'ENOTCONN';
34
35use constant VERSION_1 => 1;
36
37use constant BEGIN_REQUEST => 1;
38use constant PARAMS => 4;
39use constant FCGI_STDIN => 5;
40use constant FCGI_STDOUT => 6;
41use constant FCGI_STDERR => 7;
42
43use constant RESPONDER => 1;
44use constant AUTHORIZER => 2;
45use constant FILTER => 3;
46
47%FCGI::rolenames = (RESPONDER, "RESPONDER",
48 AUTHORIZER, "AUTHORIZER",
49 FILTER, "FILTER",
50 );
ef8432ef 51
52# This only works on Unix; anyone familiar with Windows is welcome
53# to give a hand here
0833402a 54sub IsFastCGI {
55 my ($req) = @_;
56 $req->{isfastcgi} =
57 (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
58 unless exists $req->{isfastcgi};
59 return $req->{isfastcgi};
60}
61
ef8432ef 62sub GetEnvironment {
63 return shift->{'env'};
64}
65
0833402a 66sub read_nv_len {
67 my ($stream) = @_;
68 my $buf;
69 return undef unless read $stream, $buf, 1, 0;
70 my ($len) = unpack("C", $buf);
71 if ($len & 0x80) {
152da6b7 72 $buf = pack("C", $len & 0x7F);
0833402a 73 return undef unless read $stream, $buf, 3, 1;
74 $len = unpack("N", $buf);
1b64d24d 75 }
0833402a 76 $len;
1b64d24d 77}
0833402a 78
79sub RequestX {
80 my $self = {
81 in => shift,
82 out => shift,
83 err => shift,
84 env => shift,
85 socket => shift,
86 flags => shift,
7fa2de73 87 last => 0,
0833402a 88 };
89 open $self->{listen_sock}, "<&=0";
90 bless $self, "FCGI";
91}
92
93my $run_once = 0;
94
95sub Accept {
96 my ($req) = @_;
97
98 unless ($req->IsFastCGI()) {
99 return -1 if $run_once;
100
101 $run_once = 1;
102 return 0;
103 }
104 $req->Finish();
105 $req->{socket} = gensym();
7fa2de73 106 if ($req->{last} || !accept($req->{socket}, $req->{listen_sock})) {
0833402a 107 $req->{error} = "accept";
108 return -1;
109 }
110 my ($type, $id, $body) = $req->read_record();
111 if ($type != BEGIN_REQUEST) {
112 $req->{error} = "begin request";
113 return -1;
114 }
115 my ($role, $flags) = unpack("nC", $body);
116 $req->{role} = $role;
117 $req->{flags} = $flags;
118 $req->{id} = $id;
119
120 %{$req->{env}} = ();
121 $req->{env}{FCGI_ROLE} = $FCGI::rolenames{$req->{role}};
122 my $param = FCGI::Stream->new($req, PARAMS);
123 my ($nlen, $vlen);
124 while (defined($nlen = read_nv_len($param)) &&
125 defined($vlen = read_nv_len($param))) {
126 my ($name, $val);
127 read $param, $name, $nlen;
128 read $param, $val, $vlen;
129 $req->{env}{$name} = $val;
130 }
131 $req->Bind;
132 $req->{accepted} = 1;
133
1b64d24d 134 return 0;
135}
0833402a 136
137sub UndoBindings {
138 my ($req) = @_;
139 untie ${$req->{in}};
140 untie ${$req->{out}};
141 untie ${$req->{err}};
142 $req->{bound} = 0;
143}
144
145sub Bind {
146 my ($req) = @_;
147 tie ${$req->{in}}, 'FCGI::Stream', $req, FCGI_STDIN;
148 tie ${$req->{out}}, 'FCGI::Stream', $req, FCGI_STDOUT;
149 tie ${$req->{err}}, 'FCGI::Stream', $req, FCGI_STDERR;
150 $req->{bound} = 1;
151}
152
153sub Attach {
154 my ($req) = @_;
155 $req->Bind() if ($req->{accepted} && !$req->{bound});
156}
157
158sub Detach {
159 my ($req) = @_;
160 $req->UndoBindings() if ($req->{accepted} && $req->{bound});
161}
162
163sub Finish {
164 my ($req) = @_;
165 return unless $req->{accepted};
166 if ($req->{bound}) {
167 $req->UndoBindings();
168 close ${$req->{out}};
169 close ${$req->{err}};
1b64d24d 170 }
0833402a 171 $req->{accepted} = 0;
172}
173
7fa2de73 174sub LastCall {
175 shift->{last} = 1;
176}
177
0833402a 178sub DESTROY {
179 shift->Finish();
180}
181
182sub read_record {
183 my ($self) = @_;
184 my ($header, $body);
185
186 read($self->{socket}, $header, 8);
187 my ($version, $type, $id, $clen, $plen) = unpack("CCnnC", $header);
188 read($self->{socket}, $body, $clen+$plen);
189 $body = undef if $clen == 0;
190 ($type, $id, $body);
191}
192
193sub read {
194 my ($self, $rtype, $len) = @_;
195 while (length $self->{buf} < $len) {
196 my ($type, $id, $buf) = $self->read_record();
197 return undef unless defined $buf;
198 if ($type != $rtype) {
199 $self->{error} = "unexpected stream type";
200 return 0;
b716743a 201 }
0833402a 202 $self->{buf} .= $buf;
b716743a 203 }
0833402a 204 my ($newbuf, $result) = (substr($self->{buf}, $len),
205 substr($self->{buf}, 0, $len));
206 $self->{buf} = $newbuf;
207 $result;
208}
209
210sub Flush {
211 my ($req) = @_;
212}
213
214sub write {
215 my ($self, $type, $content, $len) = @_;
216 return unless $len > 0;
217 $self->write_record($type, $content, $len);
34bfd355 218}
219
0833402a 220sub write_record {
4f396a01 221 my ($self, $type, $content, $length) = @_;
222 my $offset = 0;
223 while ($length > 0) {
224 my $len = $length > 32*1024 ? 32*1024 : $length;
225 my $padlen = (8 - ($len % 8)) % 8;
226 my $templ = "CCnnCxa${len}x$padlen";
227 my $data = pack($templ,
228 VERSION_1, $type, $self->{id}, $len, $padlen,
229 substr($content, $offset, $len));
230 syswrite $self->{socket}, $data;
231 $length -= $len;
232 $offset += $len;
233 }
0833402a 234}
235
236{ package FCGI::Stream;
237
238sub new {
239 my ($class, $src, $type) = @_;
240 my $handle = do { \local *FH };
241 tie($$handle, $class, $src, $type);
242 $handle;
243}
244
245sub TIEHANDLE {
246 my ($class, $src, $type) = @_;
247 bless { src => $src, type => $type }, $class;
248}
5baeeca7 249
0833402a 250sub READ {
251 my ($stream, undef, $len, $offset) = @_;
252 my ($ref) = \$_[1];
253 my $buf = $stream->{src}->read($stream->{type}, $len);
254 return undef unless defined $buf;
255 substr($$ref, $offset, 0, $buf);
256 length $buf;
257}
258
259sub PRINT {
260 my ($stream) = shift;
261 for (@_) {
262 $stream->{src}->write($stream->{type}, $_, length($_));
1d209997 263 }
0833402a 264}
1d209997 265
0833402a 266sub CLOSE {
267 my ($stream) = @_;
268 $stream->{src}->write_record($stream->{type}, undef, 0);
1d209997 269}
5baeeca7 270
0833402a 271}
272
273EOP
274print OUT while <DATA>;
275close OUT;
276__END__
277
278# Preloaded methods go here.
794c66be 279
0833402a 280# Autoload methods go after __END__, and are processed by the autosplit program.
1d209997 281
0833402a 282*FAIL_ACCEPT_ON_INTR = sub() { 1 };
283
ef8432ef 284sub Request(;***$*$) {
0833402a 285 my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, 0);
e09efffb 286 $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
0833402a 287 splice @defaults,0,@_,@_;
288 RequestX(@defaults);
289}
1d209997 290
0833402a 291sub accept() {
292 warn "accept called as a method; you probably wanted to call Accept" if @_;
293 if (defined %FCGI::ENV) {
294 %ENV = %FCGI::ENV;
1d209997 295 } else {
0833402a 296 %FCGI::ENV = %ENV;
1b64d24d 297 }
0833402a 298 my $rc = Accept($global_request);
299 for (keys %FCGI::ENV) {
300 $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
301 }
302
303 # not SFIO
304 $SIG{__WARN__} = $warn_handler if (tied (*STDIN));
305 $SIG{__DIE__} = $die_handler if (tied (*STDIN));
306
307 return $rc;
1b64d24d 308}
309
0833402a 310sub finish() {
311 warn "finish called as a method; you probably wanted to call Finish" if @_;
312 %ENV = %FCGI::ENV if (defined %FCGI::ENV);
b716743a 313
0833402a 314 # not SFIO
315 if (tied (*STDIN)) {
316 delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
317 delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
1b64d24d 318 }
5baeeca7 319
0833402a 320 Finish ($global_request);
321}
90a18d65 322
0833402a 323sub flush() {
324 warn "flush called as a method; you probably wanted to call Flush" if @_;
325 Flush($global_request);
326}
327
328sub detach() {
329 warn "detach called as a method; you probably wanted to call Detach" if @_;
330 Detach($global_request);
331}
90a18d65 332
0833402a 333sub attach() {
334 warn "attach called as a method; you probably wanted to call Attach" if @_;
335 Attach($global_request);
1b64d24d 336}
337
0833402a 338# deprecated
339sub set_exit_status {
1b64d24d 340}
341
0833402a 342sub start_filter_data() {
343 StartFilterData($global_request);
344}
345
346$global_request = Request();
347$warn_handler = sub { print STDERR @_ };
348$die_handler = sub { print STDERR @_ unless $^S };
34bfd355 349
0833402a 350package FCGI::Stream;
e40fb02c 351
0833402a 352sub PRINTF {
353 shift->PRINT(sprintf(shift, @_));
34bfd355 354}
355
420df423 356sub BINMODE {
357}
358
0833402a 359sub READLINE {
360 my $stream = shift;
361 my ($s, $c);
362 my $rs = $/ eq '' ? "\n\n" : $/;
363 my $l = substr $rs, -1;
364 my $len = length $rs;
365
366 $c = $stream->GETC();
367 if ($/ eq '') {
368 while ($c eq "\n") {
369 $c = $stream->GETC();
370 }
371 }
372 while (defined $c) {
373 $s .= $c;
374 last if $c eq $l and substr($s, -$len) eq $rs;
375 $c = $stream->GETC();
376 }
377 $s;
378}
1b64d24d 379
0833402a 380sub OPEN {
381 $_[0]->CLOSE;
382 if (@_ == 2) {
383 return open($_[0], $_[1]);
384 } else {
385 my $rc;
386 eval("$rc = open($_[0], $_[1], $_[2])");
387 die $@ if $@;
388 return $rc;
389 }
390}
1b64d24d 391
497802b1 392# Apparently some use fileno to determine if a filehandle is open,
393# so we might want to return a defined, but meaningless value.
394# An alternative would be to return the fcgi stream fd.
395# sub FILENO { -2 }
396
0833402a 3971;
eede4b76 398
0833402a 399=pod
eede4b76 400
0833402a 401=head1 NAME
eede4b76 402
0833402a 403FCGI - Fast CGI module
eede4b76 404
0833402a 405=head1 SYNOPSIS
6b312a77 406
0833402a 407 use FCGI;
6b312a77 408
0833402a 409 my $count = 0;
410 my $request = FCGI::Request();
6b312a77 411
0833402a 412 while($request->Accept() >= 0) {
413 print("Content-type: text/html\r\n\r\n", ++$count);
414 }
eede4b76 415
0833402a 416=head1 DESCRIPTION
eede4b76 417
0833402a 418Functions:
eede4b76 419
0833402a 420=over 4
eede4b76 421
0833402a 422=item FCGI::Request
eede4b76 423
0833402a 424Creates a request handle. It has the following optional parameters:
eede4b76 425
0833402a 426=over 8
eede4b76 427
0833402a 428=item input perl file handle (default: \*STDIN)
eede4b76 429
0833402a 430=item output perl file handle (default: \*STDOUT)
9915cd6d 431
0833402a 432=item error perl file handle (default: \*STDERR)
9915cd6d 433
0833402a 434These filehandles will be setup to act as input/output/error
435on succesful Accept.
9915cd6d 436
0833402a 437=item environment hash reference (default: \%ENV)
9915cd6d 438
0833402a 439The hash will be populated with the environment.
9915cd6d 440
0833402a 441=item socket (default: 0)
9915cd6d 442
0833402a 443Socket to communicate with the server.
444Can be the result of the OpenSocket function.
445For the moment, it's the file descriptor of the socket
446that should be passed. This may change in the future.
9915cd6d 447
dcdf34f5 448You should only use your own socket if your program
449is not started by a process manager such as mod_fastcgi
450(except for the FastCgiExternalServer case) or cgi-fcgi.
451If you use the option, you have to let your FastCGI
452server know which port (and possibly server) your program
453is listening on.
454See remote.pl for an example.
455
0833402a 456=item flags (default: 0)
1d209997 457
0833402a 458Possible values:
1d209997 459
0833402a 460=over 12
9915cd6d 461
0833402a 462=item FCGI::FAIL_ACCEPT_ON_INTR
5baeeca7 463
0833402a 464If set, Accept will fail if interrupted.
465It not set, it will just keep on waiting.
5baeeca7 466
0833402a 467=back
5baeeca7 468
0833402a 469=back
5baeeca7 470
0833402a 471Example usage:
472 my $req = FCGI::Request;
5baeeca7 473
0833402a 474or:
475 my %env;
476 my $in = new IO::Handle;
477 my $out = new IO::Handle;
478 my $err = new IO::Handle;
479 my $req = FCGI::Request($in, $out, $err, \%env);
5baeeca7 480
0833402a 481=item FCGI::OpenSocket(path, backlog)
5baeeca7 482
0833402a 483Creates a socket suitable to use as an argument to Request.
5baeeca7 484
0833402a 485=over 8
eede4b76 486
0833402a 487=item path
eede4b76 488
0833402a 489Pathname of socket or colon followed by local tcp port.
420df423 490Note that some systems take file permissions into account
491on Unix domain sockets, so you'll have to make sure that
492the server can write to the created file, by changing
493the umask before the call and/or changing permissions and/or
494group of the file afterwards.
eede4b76 495
0833402a 496=item backlog
eede4b76 497
0833402a 498Maximum length of the queue of pending connections.
499If a connection
500request arrives with the queue full the client may receive
501an error with an indication of ECONNREFUSED.
eede4b76 502
0833402a 503=back
eede4b76 504
0833402a 505=item FCGI::CloseSocket(socket)
eede4b76 506
0833402a 507Close a socket opened with OpenSocket.
eede4b76 508
0833402a 509=item $req->Accept()
90a18d65 510
0833402a 511Accepts a connection on $req, attaching the filehandles and
512populating the environment hash.
513Returns 0 on success.
514If a connection has been accepted before, the old
515one will be finished first.
1b64d24d 516
0833402a 517Note that unlike with the old interface, no die and warn
518handlers are installed by default. This means that if
519you are not running an sfio enabled perl, any warn or
520die message will not end up in the server's log by default.
521It is advised you set up die and warn handlers yourself.
522FCGI.pm contains an example of die and warn handlers.
1b64d24d 523
0833402a 524=item $req->Finish()
1b64d24d 525
0833402a 526Finishes accepted connection.
527Also detaches filehandles.
528
529=item $req->Flush()
530
531Flushes accepted connection.
532
533=item $req->Detach()
534
535Temporarily detaches filehandles on an accepted connection.
1b64d24d 536
0833402a 537=item $req->Attach()
538
539Re-attaches filehandles on an accepted connection.
540
7fa2de73 541=item $req->LastCall()
542
543Tells the library not to accept any more requests on this handle.
544It should be safe to call this method from signal handlers.
545
546Note that this method is still experimental and everything
547about it, including its name, is subject to change.
548
0833402a 549=item $env = $req->GetEnvironment()
550
551Returns the environment parameter passed to FCGI::Request.
552
553=item ($in, $out, $err) = $req->GetHandles()
554
555Returns the file handle parameters passed to FCGI::Request.
556
557=item $isfcgi = $req->IsFastCGI()
558
559Returns whether or not the program was run as a FastCGI.
560
561=back
562
563=head1 AUTHOR
564
565Sven Verdoolaege <skimo@kotnet.org>
566
567=cut
568
569__END__