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))) {
129 read $param, $name, $nlen;
130 read $param, $val, $vlen;
131 $req->{env}{$name} = $val;
134 $req->{accepted} = 1;
142 untie ${$req->{out}};
143 untie ${$req->{err}};
149 tie ${$req->{in}}, 'FCGI::Stream', $req, FCGI_STDIN;
150 tie ${$req->{out}}, 'FCGI::Stream', $req, FCGI_STDOUT;
151 tie ${$req->{err}}, 'FCGI::Stream', $req, FCGI_STDERR;
157 $req->Bind() if ($req->{accepted} && !$req->{bound});
162 $req->UndoBindings() if ($req->{accepted} && $req->{bound});
167 return unless $req->{accepted};
169 $req->UndoBindings();
170 # apparently these are harmful
171 # close ${$req->{out}};
172 # close ${$req->{err}};
174 $req->{accepted} = 0;
189 read($self->{socket}, $header, 8);
190 my ($version, $type, $id, $clen, $plen) = unpack("CCnnC", $header);
191 read($self->{socket}, $body, $clen+$plen);
192 $body = undef if $clen == 0;
197 my ($self, $rtype, $len) = @_;
198 while (length $self->{buf} < $len) {
199 my ($type, $id, $buf) = $self->read_record();
200 return undef unless defined $buf;
201 if ($type != $rtype) {
202 $self->{error} = "unexpected stream type";
205 $self->{buf} .= $buf;
207 my ($newbuf, $result) = (substr($self->{buf}, $len),
208 substr($self->{buf}, 0, $len));
209 $self->{buf} = $newbuf;
218 my ($self, $type, $content, $len) = @_;
219 return unless $len > 0;
220 $self->write_record($type, $content, $len);
224 my ($self, $type, $content, $length) = @_;
226 while ($length > 0) {
227 my $len = $length > 32*1024 ? 32*1024 : $length;
228 my $padlen = (8 - ($len % 8)) % 8;
229 my $templ = "CCnnCxa${len}x$padlen";
230 my $data = pack($templ,
231 VERSION_1, $type, $self->{id}, $len, $padlen,
232 substr($content, $offset, $len));
233 syswrite $self->{socket}, $data;
239 { package FCGI::Stream;
242 my ($class, $src, $type) = @_;
243 my $handle = do { \local *FH };
244 tie($$handle, $class, $src, $type);
249 my ($class, $src, $type) = @_;
250 bless { src => $src, type => $type }, $class;
254 my ($stream, undef, $len, $offset) = @_;
256 my $buf = $stream->{src}->read($stream->{type}, $len);
257 return undef unless defined $buf;
258 substr($$ref, $offset, 0, $buf);
263 my ($stream) = shift;
265 $stream->{src}->write($stream->{type}, $_, length($_));
272 $stream->{src}->write_record($stream->{type}, undef, 0);
278 print OUT while <DATA>;
282 # Preloaded methods go here.
284 # Autoload methods go after __END__, and are processed by the autosplit program.
286 *FAIL_ACCEPT_ON_INTR = sub() { 1 };
288 sub Request(;***$*$) {
289 my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR());
290 $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
291 splice @defaults,0,@_,@_;
296 warn "accept called as a method; you probably wanted to call Accept" if @_;
302 my $rc = Accept($global_request);
303 for (keys %FCGI::ENV) {
304 $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
308 $SIG{__WARN__} = $warn_handler if (tied (*STDIN));
309 $SIG{__DIE__} = $die_handler if (tied (*STDIN));
315 warn "finish called as a method; you probably wanted to call Finish" if @_;
316 %ENV = %FCGI::ENV if %FCGI::ENV;
320 delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
321 delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
324 Finish ($global_request);
328 warn "flush called as a method; you probably wanted to call Flush" if @_;
329 Flush($global_request);
333 warn "detach called as a method; you probably wanted to call Detach" if @_;
334 Detach($global_request);
338 warn "attach called as a method; you probably wanted to call Attach" if @_;
339 Attach($global_request);
343 sub set_exit_status {
346 sub start_filter_data() {
347 StartFilterData($global_request);
350 $global_request = Request();
351 $warn_handler = sub { print STDERR @_ };
352 $die_handler = sub { print STDERR @_ unless $^S };
354 package FCGI::Stream;
357 shift->PRINT(sprintf(shift, @_));
366 my $rs = $/ eq '' ? "\n\n" : $/;
367 my $l = substr $rs, -1;
368 my $len = length $rs;
370 $c = $stream->GETC();
373 $c = $stream->GETC();
378 last if $c eq $l and substr($s, -$len) eq $rs;
379 $c = $stream->GETC();
387 return open($_[0], $_[1]);
390 eval("$rc = open($_[0], $_[1], $_[2])");
396 # Some things (e.g. IPC::Run) use fileno to determine if a filehandle is open,
397 # so we return a defined, but meaningless value. (-1 being the error return
398 # value from the syscall in c, meaning it can never be a valid fd no)
399 # Probably a better alternative would be to return the fcgi stream fd.
408 FCGI - Fast CGI module
415 my $request = FCGI::Request();
417 while($request->Accept() >= 0) {
418 print("Content-type: text/html\r\n\r\n", ++$count);
429 Creates a request handle. It has the following optional parameters:
433 =item input perl file handle (default: \*STDIN)
435 =item output perl file handle (default: \*STDOUT)
437 =item error perl file handle (default: \*STDERR)
439 These filehandles will be setup to act as input/output/error
440 on successful Accept.
442 =item environment hash reference (default: \%ENV)
444 The hash will be populated with the environment.
446 =item socket (default: 0)
448 Socket to communicate with the server.
449 Can be the result of the OpenSocket function.
450 For the moment, it's the file descriptor of the socket
451 that should be passed. This may change in the future.
453 You should only use your own socket if your program
454 is not started by a process manager such as mod_fastcgi
455 (except for the FastCgiExternalServer case) or cgi-fcgi.
456 If you use the option, you have to let your FastCGI
457 server know which port (and possibly server) your program
459 See remote.pl for an example.
461 =item flags (default: 0)
467 =item FCGI::FAIL_ACCEPT_ON_INTR
469 If set, Accept will fail if interrupted.
470 It not set, it will just keep on waiting.
477 my $req = FCGI::Request;
481 my $in = new IO::Handle;
482 my $out = new IO::Handle;
483 my $err = new IO::Handle;
484 my $req = FCGI::Request($in, $out, $err, \%env);
486 =item FCGI::OpenSocket(path, backlog)
488 Creates a socket suitable to use as an argument to Request.
494 Pathname of socket or colon followed by local tcp port.
495 Note that some systems take file permissions into account
496 on Unix domain sockets, so you'll have to make sure that
497 the server can write to the created file, by changing
498 the umask before the call and/or changing permissions and/or
499 group of the file afterwards.
503 Maximum length of the queue of pending connections.
505 request arrives with the queue full the client may receive
506 an error with an indication of ECONNREFUSED.
510 =item FCGI::CloseSocket(socket)
512 Close a socket opened with OpenSocket.
516 Accepts a connection on $req, attaching the filehandles and
517 populating the environment hash.
518 Returns 0 on success.
519 If a connection has been accepted before, the old
520 one will be finished first.
522 Note that unlike with the old interface, no die and warn
523 handlers are installed by default. This means that if
524 you are not running an sfio enabled perl, any warn or
525 die message will not end up in the server's log by default.
526 It is advised you set up die and warn handlers yourself.
527 FCGI.pm contains an example of die and warn handlers.
531 Finishes accepted connection.
532 Also detaches filehandles.
536 Flushes accepted connection.
540 Temporarily detaches filehandles on an accepted connection.
544 Re-attaches filehandles on an accepted connection.
546 =item $req->LastCall()
548 Tells the library not to accept any more requests on this handle.
549 It should be safe to call this method from signal handlers.
551 Note that this method is still experimental and everything
552 about it, including its name, is subject to change.
554 =item $env = $req->GetEnvironment()
556 Returns the environment parameter passed to FCGI::Request.
558 =item ($in, $out, $err) = $req->GetHandles()
560 Returns the file handle parameters passed to FCGI::Request.
562 =item $isfcgi = $req->IsFastCGI()
564 Returns whether or not the program was run as a FastCGI.
570 FCGI.pm isn't Unicode aware, only characters within the range 0x00-0xFF are
571 supported. Attempts to output strings containing characters above 0xFF results
572 in a exception: (F) C<Wide character in %s>.
574 Users who wants the previous (FCGI.pm <= 0.68) incorrect behavior can disable the
575 exception by using the C<bytes> pragma.
585 Sven Verdoolaege <skimo@kotnet.org>