2 use ExtUtils::MakeMaker;
4 do 'FCGI.cfg' or die "no FCGI.cfg";
8 print "Generating FCGI.pm\n";
10 # $Id: FCGI.PL,v 1.37 2002/12/15 20:02:48 skimo Exp $
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.
27 print OUT '$VERSION = q{'.MM->parse_version('version.pm')."};\n\n";
29 print OUT "bootstrap FCGI;\n" unless ($pure);
31 print OUT '$VERSION = eval $VERSION;';
33 print OUT <<'EOP' if ($pure);
37 use constant VERSION_1 => 1;
39 use constant BEGIN_REQUEST => 1;
40 use constant PARAMS => 4;
41 use constant FCGI_STDIN => 5;
42 use constant FCGI_STDOUT => 6;
43 use constant FCGI_STDERR => 7;
45 use constant RESPONDER => 1;
46 use constant AUTHORIZER => 2;
47 use constant FILTER => 3;
49 %FCGI::rolenames = (RESPONDER, "RESPONDER",
50 AUTHORIZER, "AUTHORIZER",
54 # This only works on Unix; anyone familiar with Windows is welcome
59 (!defined getpeername shift->{listen_sock}) && $! == ENOTCONN
60 unless exists $req->{isfastcgi};
61 return $req->{isfastcgi};
65 return shift->{'env'};
71 return undef unless read $stream, $buf, 1, 0;
72 my ($len) = unpack("C", $buf);
74 $buf = pack("C", $len & 0x7F);
75 return undef unless read $stream, $buf, 3, 1;
76 $len = unpack("N", $buf);
91 open $self->{listen_sock}, "<&=0";
100 unless ($req->IsFastCGI()) {
101 return -1 if $run_once;
107 $req->{socket} = gensym();
108 if ($req->{last} || !accept($req->{socket}, $req->{listen_sock})) {
109 $req->{error} = "accept";
112 my ($type, $id, $body) = $req->read_record();
113 if ($type != BEGIN_REQUEST) {
114 $req->{error} = "begin request";
117 my ($role, $flags) = unpack("nC", $body);
118 $req->{role} = $role;
119 $req->{flags} = $flags;
123 $req->{env}{FCGI_ROLE} = $FCGI::rolenames{$req->{role}};
124 my $param = FCGI::Stream->new($req, PARAMS);
126 while (defined($nlen = read_nv_len($param)) &&
127 defined($vlen = read_nv_len($param)))
130 read $param, $name, $nlen;
131 read $param, $val, $vlen;
132 $req->{env}{$name} = $val;
135 $req->{accepted} = 1;
143 untie ${$req->{out}};
144 untie ${$req->{err}};
150 tie ${$req->{in}}, 'FCGI::Stream', $req, FCGI_STDIN;
151 tie ${$req->{out}}, 'FCGI::Stream', $req, FCGI_STDOUT;
152 tie ${$req->{err}}, 'FCGI::Stream', $req, FCGI_STDERR;
158 $req->Bind() if ($req->{accepted} && !$req->{bound});
163 $req->UndoBindings() if ($req->{accepted} && $req->{bound});
168 return unless $req->{accepted};
170 $req->UndoBindings();
171 # apparently these are harmful
172 # close ${$req->{out}};
173 # close ${$req->{err}};
175 $req->{accepted} = 0;
190 read($self->{socket}, $header, 8);
191 my ($version, $type, $id, $clen, $plen) = unpack("CCnnC", $header);
192 read($self->{socket}, $body, $clen+$plen);
193 $body = undef if $clen == 0;
198 my ($self, $rtype, $len) = @_;
199 while (length $self->{buf} < $len) {
200 my ($type, $id, $buf) = $self->read_record();
201 return undef unless defined $buf;
202 if ($type != $rtype) {
203 $self->{error} = "unexpected stream type";
206 $self->{buf} .= $buf;
208 my ($newbuf, $result) = (substr($self->{buf}, $len),
209 substr($self->{buf}, 0, $len));
210 $self->{buf} = $newbuf;
219 my ($self, $type, $content, $len) = @_;
220 return unless $len > 0;
221 $self->write_record($type, $content, $len);
225 my ($self, $type, $content, $length) = @_;
227 while ($length > 0) {
228 my $len = $length > 32*1024 ? 32*1024 : $length;
229 my $padlen = (8 - ($len % 8)) % 8;
230 my $templ = "CCnnCxa${len}x$padlen";
231 my $data = pack($templ,
232 VERSION_1, $type, $self->{id}, $len, $padlen,
233 substr($content, $offset, $len));
234 syswrite $self->{socket}, $data;
240 { package FCGI::Stream;
243 my ($class, $src, $type) = @_;
244 my $handle = do { \local *FH };
245 tie($$handle, $class, $src, $type);
250 my ($class, $src, $type) = @_;
251 bless { src => $src, type => $type }, $class;
255 my ($stream, undef, $len, $offset) = @_;
257 my $buf = $stream->{src}->read($stream->{type}, $len);
258 return undef unless defined $buf;
259 substr($$ref, $offset, 0, $buf);
264 my ($stream) = shift;
266 $stream->{src}->write($stream->{type}, $_, length($_));
273 $stream->{src}->write_record($stream->{type}, undef, 0);
279 print OUT while <DATA>;
283 # Preloaded methods go here.
285 # Autoload methods go after __END__, and are processed by the autosplit program.
287 *FAIL_ACCEPT_ON_INTR = sub() { 1 };
289 sub Request(;***$*$) {
290 my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR());
291 $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
292 splice @defaults,0,@_,@_;
297 warn "accept called as a method; you probably wanted to call Accept" if @_;
298 if ( defined($FCGI::ENV) ) {
303 my $rc = Accept($global_request);
304 for (keys %$FCGI::ENV) {
305 $ENV{$_} = $FCGI::ENV->{$_} unless exists $ENV{$_};
309 $SIG{__WARN__} = $warn_handler if (tied (*STDIN));
310 $SIG{__DIE__} = $die_handler if (tied (*STDIN));
316 warn "finish called as a method; you probably wanted to call Finish" if @_;
317 %ENV = %$FCGI::ENV if defined($FCGI::ENV);
321 delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
322 delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
325 Finish ($global_request);
329 warn "flush called as a method; you probably wanted to call Flush" if @_;
330 Flush($global_request);
334 warn "detach called as a method; you probably wanted to call Detach" if @_;
335 Detach($global_request);
339 warn "attach called as a method; you probably wanted to call Attach" if @_;
340 Attach($global_request);
344 sub set_exit_status {
347 sub start_filter_data() {
348 StartFilterData($global_request);
351 $global_request = Request();
352 $warn_handler = sub { print STDERR @_ };
353 $die_handler = sub { print STDERR @_ unless $^S };
355 package FCGI::Stream;
358 shift->PRINT(sprintf(shift, @_));
367 my $rs = $/ eq '' ? "\n\n" : $/;
368 my $l = substr $rs, -1;
369 my $len = length $rs;
371 $c = $stream->GETC();
374 $c = $stream->GETC();
379 last if $c eq $l and substr($s, -$len) eq $rs;
380 $c = $stream->GETC();
388 return open($_[0], $_[1]);
391 eval("$rc = open($_[0], $_[1], $_[2])");
397 # Some things (e.g. IPC::Run) use fileno to determine if a filehandle is open,
398 # so we return a defined, but meaningless value. (-1 being the error return
399 # value from the syscall in c, meaning it can never be a valid fd no)
400 # Probably a better alternative would be to return the fcgi stream fd.
409 FCGI - Fast CGI module
416 my $request = FCGI::Request();
418 while($request->Accept() >= 0) {
419 print("Content-type: text/html\r\n\r\n", ++$count);
430 Creates a request handle. It has the following optional parameters:
434 =item input perl file handle (default: \*STDIN)
436 =item output perl file handle (default: \*STDOUT)
438 =item error perl file handle (default: \*STDERR)
440 These filehandles will be setup to act as input/output/error
441 on successful Accept.
443 =item environment hash reference (default: \%ENV)
445 The hash will be populated with the environment.
447 =item socket (default: 0)
449 Socket to communicate with the server.
450 Can be the result of the OpenSocket function.
451 For the moment, it's the file descriptor of the socket
452 that should be passed. This may change in the future.
454 You should only use your own socket if your program
455 is not started by a process manager such as mod_fastcgi
456 (except for the FastCgiExternalServer case) or cgi-fcgi.
457 If you use the option, you have to let your FastCGI
458 server know which port (and possibly server) your program
460 See remote.pl for an example.
462 =item flags (default: 0)
468 =item FCGI::FAIL_ACCEPT_ON_INTR
470 If set, Accept will fail if interrupted.
471 It not set, it will just keep on waiting.
478 my $req = FCGI::Request;
482 my $in = new IO::Handle;
483 my $out = new IO::Handle;
484 my $err = new IO::Handle;
485 my $req = FCGI::Request($in, $out, $err, \%env);
487 =item FCGI::OpenSocket(path, backlog)
489 Creates a socket suitable to use as an argument to Request.
495 Pathname of socket or colon followed by local tcp port.
496 Note that some systems take file permissions into account
497 on Unix domain sockets, so you'll have to make sure that
498 the server can write to the created file, by changing
499 the umask before the call and/or changing permissions and/or
500 group of the file afterwards.
504 Maximum length of the queue of pending connections.
506 request arrives with the queue full the client may receive
507 an error with an indication of ECONNREFUSED.
511 =item FCGI::CloseSocket(socket)
513 Close a socket opened with OpenSocket.
517 Accepts a connection on $req, attaching the filehandles and
518 populating the environment hash.
519 Returns 0 on success.
520 If a connection has been accepted before, the old
521 one will be finished first.
523 Note that unlike with the old interface, no die and warn
524 handlers are installed by default. This means that if
525 you are not running an sfio enabled perl, any warn or
526 die message will not end up in the server's log by default.
527 It is advised you set up die and warn handlers yourself.
528 FCGI.pm contains an example of die and warn handlers.
532 Finishes accepted connection.
533 Also detaches filehandles.
537 Flushes accepted connection.
541 Temporarily detaches filehandles on an accepted connection.
545 Re-attaches filehandles on an accepted connection.
547 =item $req->LastCall()
549 Tells the library not to accept any more requests on this handle.
550 It should be safe to call this method from signal handlers.
552 Note that this method is still experimental and everything
553 about it, including its name, is subject to change.
555 =item $env = $req->GetEnvironment()
557 Returns the environment parameter passed to FCGI::Request.
559 =item ($in, $out, $err) = $req->GetHandles()
561 Returns the file handle parameters passed to FCGI::Request.
563 =item $isfcgi = $req->IsFastCGI()
565 Returns whether or not the program was run as a FastCGI.
571 FCGI.pm isn't Unicode aware, only characters within the range 0x00-0xFF are
572 supported. Attempts to output strings containing characters above 0xFF results
573 in a exception: (F) C<Wide character in %s>.
575 Users who wants the previous (FCGI.pm <= 0.68) incorrect behavior can disable the
576 exception by using the C<bytes> pragma.
586 Sven Verdoolaege <skimo@kotnet.org>