[continued from previous message]
- read($self->{socket}, $header, 8);
- my ($version, $type, $id, $clen, $plen) = unpack("CCnnC", $header);
- read($self->{socket}, $body, $clen+$plen);
- $body = undef if $clen == 0;
- ($type, $id, $body);
-}
-
-sub read {
- my ($self, $rtype, $len) = @_;
- while (length $self->{buf} < $len) {
- my ($type, $id, $buf) = $self->read_record();
- return undef unless defined $buf;
- if ($type != $rtype) {
- $self->{error} = "unexpected stream type";
- return 0;
- }
- $self->{buf} .= $buf;
- }
- my ($newbuf, $result) = (substr($self->{buf}, $len),
- substr($self->{buf}, 0, $len));
- $self->{buf} = $newbuf;
- $result;
-}
-
-sub Flush {
- my ($req) = @_;
-}
-
-sub write {
- my ($self, $type, $content, $len) = @_;
- return unless $len > 0;
- $self->write_record($type, $content, $len);
-}
-
-sub write_record {
- my ($self, $type, $content, $length) = @_;
- my $offset = 0;
- while ($length > 0) {
- my $len = $length > 32*1024 ? 32*1024 : $length;
- my $padlen = (8 - ($len % 8)) % 8;
- my $templ = "CCnnCxa${len}x$padlen";
- my $data = pack($templ,
- VERSION_1, $type, $self->{id}, $len, $padlen,
- substr($content, $offset, $len));
- syswrite $self->{socket}, $data;
- $length -= $len;
- $offset += $len;
- }
-}
-
-{ package FCGI::Stream;
-
-sub new {
- my ($class, $src, $type) = @_;
- my $handle = do { \local *FH };
- tie($$handle, $class, $src, $type);
- $handle;
-}
-
-sub TIEHANDLE {
- my ($class, $src, $type) = @_;
- bless { src => $src, type => $type }, $class;
-}
-
-sub READ {
- my ($stream, undef, $len, $offset) = @_;
- my ($ref) = \$_[1];
- my $buf = $stream->{src}->read($stream->{type}, $len);
- return undef unless defined $buf;
- substr($$ref, $offset, 0, $buf);
- length $buf;
-}
-
-sub PRINT {
- my ($stream) = shift;
- for (@_) {
- $stream->{src}->write($stream->{type}, $_, length($_));
- }
-}
-
-sub CLOSE {
- my ($stream) = @_;
- $stream->{src}->write_record($stream->{type}, undef, 0);
-}
-
-}
-
-EOP
-print OUT while <DATA>;
-close OUT;
-__END__
-
-# Preloaded methods go here.
-
-# Autoload methods go after __END__, and are processed by the autosplit program.
-
-*FAIL_ACCEPT_ON_INTR = sub() { 1 };
-
-sub Request(;***$*$) {
- my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, 0);
- $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
- splice @defaults,0,@_,@_;
- RequestX(@defaults);
-}
-
-sub accept() {
- warn "accept called as a method; you probably wanted to call Accept" if @_;
- if (defined %FCGI::ENV) {
- %ENV = %FCGI::ENV;
- } else {
- %FCGI::ENV = %ENV;
- }
- my $rc = Accept($global_request);
- for (keys %FCGI::ENV) {
- $ENV{$_} = $FCGI::ENV{$_} unless exists $ENV{$_};
- }
-
- # not SFIO
- $SIG{__WARN__} = $warn_handler if (tied (*STDIN));
- $SIG{__DIE__} = $die_handler if (tied (*STDIN));
-
- return $rc;
-}
-
-sub finish() {
- warn "finish called as a method; you probably wanted to call Finish" if @_;
- %ENV = %FCGI::ENV if (defined %FCGI::ENV);
-
- # not SFIO
- if (tied (*STDIN)) {
- delete $SIG{__WARN__} if ($SIG{__WARN__} == $warn_handler);
- delete $SIG{__DIE__} if ($SIG{__DIE__} == $die_handler);
- }
-
- Finish ($global_request);
-}
-
-sub flush() {
- warn "flush called as a method; you probably wanted to call Flush" if @_; - Flush($global_request);
-}
-
-sub detach() {
- warn "detach called as a method; you probably wanted to call Detach" if @_;
- Detach($global_request);
-}
-
-sub attach() {
- warn "attach called as a method; you probably wanted to call Attach" if @_;
- Attach($global_request);
-}
-
-# deprecated
-sub set_exit_status {
-}
-
-sub start_filter_data() {
- StartFilterData($global_request);
-}
-
-$global_request = Request();
-$warn_handler = sub { print STDERR @_ };
-$die_handler = sub { print STDERR @_ unless $^S };
-
-package FCGI::Stream;
-
-sub PRINTF {
- shift->PRINT(sprintf(shift, @_));
-}
-
-sub BINMODE {
-}
-
-sub READLINE {
- my $stream = shift;
- my ($s, $c);
- my $rs = $/ eq '' ? "\n\n" : $/;
- my $l = substr $rs, -1;
- my $len = length $rs;
-
- $c = $stream->GETC();
- if ($/ eq '') {
- while ($c eq "\n") {
- $c = $stream->GETC();
- }
- }
- while (defined $c) {
- $s .= $c;
- last if $c eq $l and substr($s, -$len) eq $rs;
- $c = $stream->GETC();
- }
- $s;
-}
-
-sub OPEN {
- $_[0]->CLOSE;
- if (@_ == 2) {
- return open($_[0], $_[1]);
- } else {
- my $rc;
- eval("$rc = open($_[0], $_[1], $_[2])");
- die $@ if $@;
- return $rc;
- }
-}
-
-# Apparently some use fileno to determine if a filehandle is open,
-# so we might want to return a defined, but meaningless value.
-# An alternative would be to return the fcgi stream fd.
-# sub FILENO { -2 }
-
-1;
-
-=pod
-
-=head1 NAME
-
-FCGI - Fast CGI module
-
-=head1 SYNOPSIS
-
- use FCGI;
-
- my $count = 0;
- my $request = FCGI::Request();
-
- while($request->Accept() >= 0) {
- print("Content-type: text/html\r\n\r\n", ++$count);
- }
-
-=head1 DESCRIPTION
-
-Functions:
-
-=over 4
-
-=item FCGI::Request
-
-Creates a request handle. It has the following optional parameters:
-
-=over 8
-
-=item input perl file handle (default: \*STDIN)
-
-=item output perl file handle (default: \*STDOUT)
-
-=item error perl file handle (default: \*STDERR)
-
-These filehandles will be setup to act as input/output/error
-on successful Accept.
-
-=item environment hash reference (default: \%ENV)
-
-The hash will be populated with the environment.
-
-=item socket (default: 0)
-
-Socket to communicate with the server.
-Can be the result of the OpenSocket function.
-For the moment, it's the file descriptor of the socket
-that should be passed. This may change in the future.
-
-You should only use your own socket if your program
-is not started by a process manager such as mod_fastcgi
-(except for the FastCgiExternalServer case) or cgi-fcgi.
-If you use the option, you have to let your FastCGI
-server know which port (and possibly server) your program
-is listening on.
-See remote.pl for an example.
-
-=item flags (default: 0)
-
-Possible values:
-
-=over 12
-
-=item FCGI::FAIL_ACCEPT_ON_INTR
-
-If set, Accept will fail if interrupted.
-It not set, it will just keep on waiting.
-
-=back
-
-=back
-
-Example usage:
- my $req = FCGI::Request;
-
-or:
- my %env;
- my $in = new IO::Handle;
- my $out = new IO::Handle;
- my $err = new IO::Handle;
- my $req = FCGI::Request($in, $out, $err, \%env);
-
-=item FCGI::OpenSocket(path, backlog)
-
-Creates a socket suitable to use as an argument to Request.
-
-=over 8
-
-=item path
-
-Pathname of socket or colon followed by local tcp port.
-Note that some systems take file permissions into account
-on Unix domain sockets, so you'll have to make sure that
-the server can write to the created file, by changing
-the umask before the call and/or changing permissions and/or
-group of the file afterwards.
-
-=item backlog
-
-Maximum length of the queue of pending connections.
-If a connection
-request arrives with the queue full the client may receive
-an error with an indication of ECONNREFUSED.
-
-=back
-
-=item FCGI::CloseSocket(socket)
-
-Close a socket opened with OpenSocket.
-
-=item $req->Accept()
-
-Accepts a connection on $req, attaching the filehandles and
-populating the environment hash.
-Returns 0 on success.
-If a connection has been accepted before, the old
-one will be finished first.
-
-Note that unlike with the old interface, no die and warn
-handlers are installed by default. This means that if
-you are not running an sfio enabled perl, any warn or
-die message will not end up in the server's log by default.
-It is advised you set up die and warn handlers yourself.
-FCGI.pm contains an example of die and warn handlers.
-
-=item $req->Finish()
-
-Finishes accepted connection.
-Also detaches filehandles.
-
-=item $req->Flush()
-
-Flushes accepted connection.
-
-=item $req->Detach()
-
-Temporarily detaches filehandles on an accepted connection.
-
-=item $req->Attach()
-
-Re-attaches filehandles on an accepted connection.
-
-=item $req->LastCall()
-
-Tells the library not to accept any more requests on this handle.
-It should be safe to call this method from signal handlers.
-
-Note that this method is still experimental and everything
-about it, including its name, is subject to change.
-
-=item $env = $req->GetEnvironment()
-
-Returns the environment parameter passed to FCGI::Request.
-
-=item ($in, $out, $err) = $req->GetHandles()
-
-Returns the file handle parameters passed to FCGI::Request.
-
-=item $isfcgi = $req->IsFastCGI()
-
-Returns whether or not the program was run as a FastCGI.
-
-=back
-
-=head1 AUTHOR
-
-Sven Verdoolaege <
skimo@kotnet.org>
-
-=cut
-
-__END__
diff -Nru libfcgi-2.4.2/perl/FCGI.pm libfcgi-2.4.5/perl/FCGI.pm
--- libfcgi-2.4.2/perl/FCGI.pm 1970-01-01 01:00:00.000000000 +0100
+++ libfcgi-2.4.5/perl/FCGI.pm 2025-04-14 19:35:59.000000000 +0200
@@ -0,0 +1,265 @@
+package FCGI;
+use strict;
+
+BEGIN {
+ our $VERSION = '0.82';
+
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+}
+
+sub FAIL_ACCEPT_ON_INTR () { 1 };
+
+sub Request(;***$*$) {
+ my @defaults = (\*STDIN, \*STDOUT, \*STDERR, \%ENV, 0, FAIL_ACCEPT_ON_INTR);
+ $_[4] = fileno($_[4]) if defined($_[4]) && defined(fileno($_[4]));
+ splice @defaults,0,@_,@_;
+ &RequestX(@defaults);
+}
+
+package FCGI::Stream;
+use strict;
+
+sub PRINTF {
+ shift->PRINT(sprintf(shift, @_));
+}
+
+sub BINMODE {
+}
+
+sub READLINE {
+ my $stream = shift;
+ my ($s, $c);
+ my $rs = $/ eq '' ? "\n\n" : $/;
+ my $l = substr $rs, -1;
+ my $len = length $rs;
+
+ $c = $stream->GETC();
+ if ($/ eq '') {
+ while ($c eq "\n") {
+ $c = $stream->GETC();
+ }
+ }
+ whi