From 57b83ea8af21886bcfded97d7198150e13953f32 Mon Sep 17 00:00:00 2001 From: "Kyle J. McKay" Date: Thu, 28 Jan 2021 20:14:17 -0700 Subject: [PATCH] gitweb: provide fallback pure perl FastCGI implementation When running gitweb.cgi, there's a substantial time penalty on each initial startup of the perl script -- it's a very large script and, in addition, it then performs some once-at-startup initialization. In order to deliver decent performance, it's imperative that the gitweb.cgi perl script be able to run in FastCGI mode if at all possible. To this end, include an alternative pure perl implementation of the FastCGI specification that will automatically be used if either (or both) of the CGI::Fast or FCGI modules are not present. The pure perl FastCGI implementation may not be quite as fast as the native FCGI module, but using the pure perl version delivers far better responsiveness when the native FCGI module is not available than falling back to a non-FastCGI mode does. Update the check-perl-modules.pl warning messages to indicate when this will happen. No changes are required to gitweb.cgi, the magic happens in the `gitweb_config.perl` file that it includes and Girocco provides. When gitweb.cgi attempts to use CGI::Fast/FCGI (which it only does if it's been configured to run in FastCGI mode), the extra code that's been added to `gitweb_config.perl` checks to see whether or not both the CGI::Fast and FCGI modules are present and if not automatically uses the substitute pure perl FastCGI implementation instead. With this support in place, the only factor limiting use of the FastCGI mode becomes whether or not the web server software itself supports FastCGI. Most of the web server software available does. Signed-off-by: Kyle J. McKay --- Girocco/extra/CGI/FCGI.pm | 859 ++++++++++++++++++++++++++++++++++++++++++ gitweb/gitweb_config.perl | 23 ++ toolbox/check-perl-modules.pl | 25 +- 3 files changed, 900 insertions(+), 7 deletions(-) create mode 100644 Girocco/extra/CGI/FCGI.pm diff --git a/Girocco/extra/CGI/FCGI.pm b/Girocco/extra/CGI/FCGI.pm new file mode 100644 index 0000000..89aaf27 --- /dev/null +++ b/Girocco/extra/CGI/FCGI.pm @@ -0,0 +1,859 @@ +package CGI::FCGI; + +# CGI::FCGI -- Alternative Pure Perl CGI::Fast and FCGI implementation +# Copyright (C) 2015,2016,2017,2020 Kyle J. McKay. +# All rights reserved. + +# Licensed under the same license as Perl OR GNU GPL v2 or later +# There is NO WARRANTY, to the extent permitted by law. +# See license below starting with '=head1 LICENSE' + +# See documentation below starting with '=head1' + +# MUST be used BEFORE CGI::Fast and FCGI. + +$CGI::FCGI::VERSION = '1.0'; + +use strict; +use warnings; + +use Errno; +use Socket; +use Carp 'croak'; +use CGI; +our @ISA = ('CGI'); + +BEGIN { + my $subtoname = sub { + my $name = shift; + $name =~ s,::,/,g; + "$name.pm" + }; + my $name = $subtoname->(__PACKAGE__); + $INC{$name} = __FILE__ if !$INC{$name}; + foreach my $pkg (qw(CGI::Fast FCGI)) { + my $pkgn = $subtoname->($pkg); + croak "Must `use ".__PACKAGE__.";` ". + "BEFORE `use $pkg;`!" + if $INC{$pkgn} && $INC{$pkgn} ne $INC{$name}; + $INC{$pkgn} = $INC{$name}; + } +} + +my %PARAMS; +my %ROLES; +BEGIN { + %PARAMS = ( + FCGI_MAX_CONNS => 1, # Maximum concurrent connections + FCGI_MAX_REQS => 1, # Max concurrent requests on a connection + FCGI_MPXS_CONNS => 0, # No multiplexing capabilities here + ); + %ROLES = ( + 1 => "RESPONDER", + 2 => "AUTHORIZER", + 3 => "FILTER", # Not currently supported + ); +} + +sub IsFCGI { + open my $fh, '+<&0' or return 0; + return 0 unless getsockname $fh; + defined(my $st = getsockopt($fh, SOL_SOCKET, SO_TYPE)) or return 0; + $st = unpack("i", $st); + defined($st) && $st == SOCK_STREAM or return 0; + return 0 if getpeername $fh; + return $!{ENOTCONN} ? 1 : 0; +} + +sub save_request { + # Make sure state's not saved +} + +my $is_inited; +my %fcgi; +my %active; +my $generation; + +BEGIN { + $generation = 1; +} + +sub _init { + return unless !$is_inited; + $is_inited = 1; + undef %active; + undef %fcgi; + croak 'STDIN_FILENO (0) is not an accept socket' unless IsFCGI; + local *ASOCK; + open ASOCK, '<&=0' or croak 'STDIN_FILENO (0) is not valid'; + $fcgi{'asock'} = *ASOCK; +} + +sub _write_all { + my $fh = shift; + my $data = shift; + return unless defined $data; + my $offset = 0; + my $len = length $data; + while ($len) { + my $cnt = syswrite $fh, $data, $len, $offset; + next if !defined($cnt) && $!{EINTR}; + croak "syswrite failed: $!" unless defined $cnt; + croak "syswrite of $len wrote 0" unless $cnt; + $offset += $cnt; + $len -= $cnt; + } +} + +sub _read_all { + my $fh = shift; + my $cnt = shift; + my $eofok = shift; + return undef unless defined $cnt && $cnt >= 0; + my $data = ''; + my $len = 0; + while ($len < $cnt) { + my $r = sysread $fh, $data, $cnt - $len, $len; + next if !defined($r) && $!{EINTR}; + croak "sysread failed: $!" unless defined $r; + return '' if $eofok && !$r && !$len; # EOF at beginning okay + croak "sysread of @{[$cnt - $len]} read 0" unless $r; + $len += $r; + } + return $data; +} + +sub _read_discard { + my $fh = shift; + my $cnt = shift; + return undef unless defined $cnt && $cnt >= 0; + my $len = 0; + while ($len < $cnt) { + my $data; + my $r = sysread $fh, $data, 32768; + next if !defined($r) && $!{EINTR}; + croak "sysread failed: $!" unless defined $r; + croak "sysread of 32768 read 0" unless $r; + $len += $r; + } + return $cnt; +} + +sub _read_one_var { + my $data = shift; + my $offset = shift || 0; + my $discardvalue = shift || 0; + my $len = length($data); + croak "_read_one_var invalid input" unless $offset >= 0 && $offset + 3 <= $len; + my $ptr = $offset; + my $nlen = unpack('C', substr($data, $ptr++, 1)); + if ($nlen & 0x80) { + croak "_read_one_var invalid input" unless $ptr + 5 <= $len; + my @bytes = unpack('CCC', substr($data, $ptr, 3)); + $ptr += 3; + $nlen = (($nlen & 0x7f) << 24) | ($bytes[0] << 16) | + ($bytes[1] << 8) | $bytes[2]; + } + my $vlen = unpack('C', substr($data, $ptr++, 1)); + if ($vlen & 0x80) { + croak "_read_one_var invalid input" unless $ptr + 4 <= $len; + my @bytes = unpack('CCC', substr($data, $ptr, 3)); + $ptr += 3; + $vlen = (($vlen & 0x7f) << 24) | ($bytes[0] << 16) | + ($bytes[1] << 8) | $bytes[2]; + } + croak "FCGI out of bounds var name/value length" if $ptr + $nlen + $vlen > $len; + if (!$nlen) { + _read_discard($fcgi{'csock'}, $nlen + $vlen); + return ("_ZERO_LENGTH_VAR_NAME", "", $ptr - $offset + $nlen + $vlen); + } + if ($nlen > 256) { + _read_discard($fcgi{'csock'}, $nlen + $vlen); + return ("_TOO_LONG_VAR_NAME", "", $ptr - $offset + $nlen + $vlen); + } + if ($vlen > 32768) { + _read_discard($fcgi{'csock'}, $nlen + $vlen); + return ("_TOO_LONG_VAR_VAL", "", $ptr - $offset + $nlen + $vlen); + } + return (substr($data, $ptr, $nlen), + ($discardvalue ? undef : substr($data, $ptr+$nlen, $vlen)), + $ptr - $offset + $nlen + $vlen); +} + +sub _encode_length { + my $l = shift; + return pack('C', ($l & 0x7f)) if $l < 128; + my $b3 = $l & 0xff; + $l >>= 8; + my $b2 = $l & 0xff; + $l >>= 8; + my $b1 = $l & 0xff; + $l >>= 8; + my $b0 = $l | 0x80; + return pack('CCCC', $b3, $b2, $b1, $b0); +} + +sub _encode_one_var { + my ($n, $v) = @_; + return _encode_length(length($n)). + _encode_length(length($v)). + $n.$v; +} + +sub _get_padding { + my $len = shift; + my $rem = $len & 0x7; + return '' unless $rem; + return pack('C', 0) x (8 - $rem); +} + +sub _write_stream { + my $fh = shift; + my $type = shift; + my $rid = shift; + my $data = shift; + my $force = shift; + return unless ($type == 6 || $type == 7) && length($data) || $force; + my $padding = _get_padding(length($data)); + _write_all($fh, pack('CCnnCC', 1, $type, $rid, length($data), length($padding), 0).$data.$padding); +} + +sub _write_end_stream { + my $fh = shift; + my $type = shift; + my $rid = shift; + return _write_stream($fh, $type, $rid, '', 1); +} + +sub _write_end_request { + my $fh = shift; + my $rid = shift; + my $pstat = shift || 0; + my $astat = shift || 0; + _write_all($fh, pack('CCnnCCNCCCC', + 1, 3, $rid, 8, 0, 0, $astat, $pstat, 0, 0, 0)); +} + +sub _handle_unknown_packet { + my ($fh, $rid, $clen, $plen) = @_; + croak "FCGI invalid unkown packet content length $clen (must be >= 1)" + unless $clen >= 1; + my $t = _read_all($fh, 1); + _read_discard($fh, $clen + $plen - 1); + _write_all($fh, pack('CCnnCCCCCCCCCC', + 1, 11, $rid, 8, 0, 0, unpack('C', $t), 0, 0, 0, 0, 0, 0, 0)); +} + +sub _handle_get_params { + my ($fh, $rid, $clen, $plen) = @_; + my $varnames = _read_all($fh, $clen); + _read_discard($fh, $plen); + my @v = (); + my $offset = 0; + my $len = length($varnames); + while ($offset < $len) { + my ($n, undef, $b) = _read_one_var($varnames, $offset, 1); + push(@v, $n); + $offset += $b; + } + my $vars = ''; + $vars = join('', + map({exists($PARAMS{$_}) ? _encode_one_var($_, $PARAMS{$_}) : ()} @v)) + unless $rid; + _write_stream($fh, 10, $rid, $vars, 1); +} + +# Can only return types 1, 2, 4, 5, or 8 +# And for types 1 and 2 the packet is fully read along with its padding +sub _read_packet { + my $fh = shift; + my $eofok = shift; + my $done; + my ($type, $rid, $clen, $plen); + { + my $request = _read_all($fh, 8, $eofok); + return undef if !defined($request) && $eofok; + my $vers; + ($vers, $type, $rid, $clen, $plen) = unpack('CCnnC', $request); + croak "FCGI bad packet header version $vers (should be 1)" + unless $vers == 1; + croak "FCGI invalid packet type $type (should be 1..11)" + unless $type >= 1 && $type <= 11; + croak "FCGI unexpected packet type $type (should be 1, 2, 4, 5, 8, 9 or 11)" + if $type == 3 || $type == 6 || $type == 7 || $type == 10; + _handle_get_params($fh, $rid, $clen, $plen), redo if $type == 9; + _handle_unknown_packet($fh, $rid, $clen, $plen), redo if $type == 11; + croak "FCGI invalid BEGIN content length $clen (should be 8)" + if $type == 1 && $clen != 8; + croak "FCGI invalid ABORT content length $clen (should be 0)" + if $type == 2 && $clen != 0; + croak "FCGI invalid requestId == 0 for BEGIN/ABORT/PARAMS/STDIN/DATA" + if ($type <= 2 || $type == 4 || $type == 5 || $type == 8) && !$rid; + } + my ($role, $flags); + if ($type == 1) { + my $begin = _read_all($fh, $clen); + _read_discard($fh, $plen); + ($role, $flags) = unpack('nC', $begin); + } + if ($type == 2) { + _read_discard($fh, $plen); + } + return ($type, $rid, $clen, $plen, $role, $flags); +} + +sub _close_active { + return unless $active{'active'}; + my $pstat = shift || 0; + my $astat = shift || 0; + my $done = shift || 0; + _write_end_stream($fcgi{'csock'}, 6, $active{'active'}) if $done; + _write_end_request($fcgi{'csock'}, $active{'active'}, $pstat, $astat); + *STDIN = $active{'STDIN'}; + *STDOUT = $active{'STDOUT'}; + *STDERR = $active{'STDERR'}; + %ENV = %{$active{'ENV'}}; + $/ = $active{'RS'}; + unless ($active{'keep'}) { + close($fcgi{'csock'}); + undef $fcgi{'csock'}; + } + undef %active; + ++$generation; +} + +sub _next_request { + _init unless $is_inited; + _close_active(0, 0, 1) if $active{'active'}; + + RETRY: + while (!$active{'active'}) { + while (!$fcgi{'csock'}) { + local *CSOCK; + unless (accept(CSOCK, $fcgi{'asock'})) { + next if $!{EINTR} || $!{ECONNABORTED}; + croak "accept failed: $!"; + } + $fcgi{'csock'} = *CSOCK; + } + my ($type, $rid, $clen, $plen, $role, $flags) = _read_packet($fcgi{'csock'}, 1); + if (!$type) { + close($fcgi{'csock'}); + undef $fcgi{'csock'}; + next; + } + _read_discard($fcgi{'csock'}, $clen+$plen), redo if $type == 5 || $type == 8; + croak "FCGI unexpected packet type $type (expecting 1 -- BEGIN)" + unless $type == 1; + if ($role != 1 && $role != 2) { + _write_end_request($fcgi{'csock'}, $rid, 3); + unless($flags & 0x01) { + close($fcgi{'csock'}); + undef $fcgi{'csock'}; + } + next; + } + $active{'active'} = $rid; + $active{'role'} = $role; + $active{'keep'} = 1 if $flags & 0x01; + $active{'STDIN'} = *STDIN; + $active{'STDOUT'} = *STDOUT; + $active{'STDERR'} = *STDERR; + my %saveenv = %ENV; + $active{'ENV'} = \%saveenv; + $active{'RS'} = $/; + } + my %vars = (); + { + my ($type, $rid, $clen, $plen) = _read_packet($fcgi{'csock'}); + if ($type == 1) { + _write_end_request($fcgi{'sock'}, $rid, 1) + unless $rid == $active{'active'}; + redo; + } + redo unless $rid == $active{'active'}; + if ($type == 2) { + _close_active; + goto RETRY; + } + croak "FCGI unexpected packet type $type (expecting 4 -- PARAMS)" + unless $type == 4; + if ($clen) { + my $vars = _read_all($fcgi{'csock'}, $clen); + _read_discard($plen); + my $offset = 0; + my $len = length($vars); + while ($offset < $len) { + my ($n, $v, $b) = _read_one_var($vars, $offset); + $vars{$n} = $v; + $offset += $b; + } + redo; + } else { + _read_discard($plen); + } + $vars{'FCGI_ROLE'} = $ROLES{$active{'role'}}; # We must add this + } + # Tie the streams, set %ENV and off we go! + local *TI; + tie *TI, 'CGI::FCGI::IStream' or croak "CGI::FCGI::IStream tie STDIN failed"; + local *TO; + tie *TO, 'CGI::FCGI::OStream', 6 or croak "CGI::FCGI::IStream tie STDOUT failed"; + local *TE; + tie *TE, 'CGI::FCGI::OStream', 7 or croak "CGI::FCGI::IStream tie STDERR failed"; + *STDIN = *TI; + *STDOUT = *TO; + *STDERR = *TE; + my ($n, $v); + $ENV{$n} = $v while ($n,$v) = each %vars; +} + +sub _read_more { + my $min = shift || 1; + return '' unless $active{'active'}; + my $ans = ''; + while (!$active{'eof'} && $min > 0) { + my ($type, $rid, $clen, $plen) = _read_packet($fcgi{'csock'}); + if ($type == 1) { + _write_end_request($fcgi{'sock'}, $rid, 1) + unless $rid == $active{'active'}; + redo; + } + redo unless $rid == $active{'active'}; + if ($type == 2) { + _close_active(0, 1); + exit(1); + } + croak "FCGI unexpected packet type $type (expecting 5 -- STDIN)" + unless $type == 5; + my $input = _read_all($fcgi{'csock'}, $clen); + _read_discard($fcgi{'sock'}, $plen); + $min -= length($input); + $active{'eof'} = 1 unless length($input); + $ans .= $input; + } + return $ans; +} + +sub _write_more { + my $type = shift; + my $data = shift; + return unless $active{'active'}; + _write_stream($fcgi{'csock'}, $type, $active{'active'}, $data) + if defined($data) && length($data); +} + +sub _get_new_class { + use Carp 'croak'; + my ($class, $package) = @_; + $package or $package = __PACKAGE__; + my $try = ref $class || $class || $package; + UNIVERSAL::isa($try, $package) + or croak "Cannot call ${package}::new with a class ($try)". + " that does not inherit from $package"; + return $try; +} + +sub new { + my $class = _get_new_class(shift); + $CGI::Q = undef; + CGI->_reset_globals(); + $class->_setup_symbols(@CGI::SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS; + _next_request; + my $self = $CGI::Q = $class->SUPER::new(@_); + $self->{'.fcgi_generation'} = $generation if $self; + return $self; +} + +sub DESTROY { + my $self = shift; + $self->SUPER::DESTROY if $self->can('SUPER::DESTROY'); + _close_active(0, 0, 1) + if $active{'active'} && $self->{'.fcgi_generation'} == $generation; +} + +sub CGI::FCGI::Raw::new { + my $class = _get_new_class(shift, 'CGI::FCGI::Raw'); + _next_request; + my $self = {}; + bless $self, $class; + $self->{'.fcgi_generation'} = $generation if $self; + return $self; +} + +sub CGI::FCGI::Raw::DESTROY { + my $self = shift; + _close_active(0, 0, 1) + if $active{'active'} && $self->{'.fcgi_generation'} == $generation; +} + +sub CGI::FCGI::Raw::ResetCGI { + $CGI::Q = undef; + CGI->_reset_globals(); + CGI->_setup_symbols(@CGI::SAVED_SYMBOLS) if @CGI::SAVED_SYMBOLS; + 1; +} + +package CGI::FCGI::IStream; + +use Carp 'croak'; + +sub TIEHANDLE { + my $class = shift; + my $self = {}; + $self->{'buffer'} = ''; + return bless $self, $class; +} + +sub BINMODE { + return 1; +} + +sub FILENO { + return undef; +} + +sub _read_more { + my $self = shift; + my $min = shift; + if (!$self->{'eof'}) { + my $more = CGI::FCGI::_read_more($min); + $self->{'eof'} = 1 if !length($more); + $self->{'buffer'} .= $more; + } +} + +sub EOF { + my $self = shift; + $self->_read_more + if !$self->{'eof'} && !length($self->{'buffer'}); + return $self->{'eof'} ? 1 : 0; +} + +sub GETC { + my $self = shift; + $self->_read_more + if !$self->{'eof'} && !length($self->{'buffer'}); + return undef unless length($self->{'buffer'}); + my $c = substr($self->{'buffer'}, 0, 1); + substr($self->{'buffer'}, 0, 1) = ''; + return $c; +} + +sub READ { + my ($self, undef, $length, $offset) = @_; + my $bufref = \$_[1]; + $offset = 0 unless defined($offset); + $$bufref = '' unless defined($$bufref); + croak "CGI::FCGI::IStream::READ invalid length $length" + if $length < 0; + $offset += length($$bufref) if $offset < 0; + croak "CGI::FCGI::IStream::READ invalid read offset" + if $offset > length($$bufref); + $self->_read_more(length($self->{'buffer'} - $length)) + if length($self->{'buffer'}) < $length; + $length = length($self->{'buffer'}) if $length > length($self->{'buffer'}); + substr($$bufref, $offset) = substr($self->{'buffer'}, 0, $length); + substr($self->{'buffer'}, 0, $length) = ''; + return $length; +} + +sub _read_line { + my $self = shift; + if (ref($/) eq 'SCALAR') { + $self->_read_more(${$/} - length($self->{'buffer'})) + if !$self->{'eof'} && length($self->{'buffer'}) < ${$/}; + my $ans = substr($self->{'buffer'}, 0, ${$/}); + substr($self->{'buffer'}, 0, ${$/}) = ''; + return $ans; + } elsif (defined($/)) { + my $pos = -1; + my $offset = 0; + my $d = $/ eq '' ? "\n\n" : $/; + while (($pos = index($self->{'buffer'}, $d, $offset)) < 0 && !$self->{'eof'}) { + $offset += length($self->{'buffer'}) - (length($d) - 1); + $self->_read_more; + } + if ($pos >= 0) { + $pos += length($d); + my $cpos = $pos; + if ($/ eq '') {{ + $self->_read_more + if !$self->{'eeof'} && length($self->{'buffer'}) <= $pos; + ++$pos, redo + if substr($self->{'buffer'}, $pos, 1) eq "\n"; + }} + my $ans = substr($self->{'buffer'}, 0, $cpos); + substr($self->{'buffer'}, 0, $pos) = ''; + return $ans; + } + } else { + $self->_read_more(32768) while !$self->{'eof'}; + } + return undef unless length($self->{'buffer'}); + my $ans = $self->{'buffer'}; + $self->{'buffer'} = ''; + return $ans; +} + +sub READLINE { + my $self = shift; + if (wantarray) { + my @a = (); + my $l; + push(@a, $l) while defined($l = $self->_read_line); + return @a; + } else { + return $self->_read_line; + } +} + +sub CLOSE { + return 1; +} + +sub DESTROY { +} + +package CGI::FCGI::OStream; + +use Carp 'croak'; + +sub TIEHANDLE { + my $class = shift; + my $type = shift; + my $self = {}; + $self->{'type'} = $type; + return bless $self, $class; +} + +sub BINMODE { + return 1; +} + +sub FILENO { + return undef; +} + +sub EOF { + return 0; +} + +sub CLOSE { + return 1; +} + +sub DESTROY { +} + +sub PRINTF { + my $self = shift; + my $template = shift; + return $self->PRINT(sprintf $template, @_); +} + +sub PRINT {goto &FCGI::Stream::PRINT} + +sub FCGI::Stream::PRINT { + my $self = shift; + CGI::FCGI::_write_more($self->{'type'}, join('', @_)); + return 1; +} + +sub WRITE { + my $self = shift; + my ($scalar, $length, $offset) = @_; + $scalar = '' if !defined($scalar); + $length = length($scalar) if !defined($length); + croak "CGI::FCGI::OStream::WRITE invalid length $length" + if $length < 0; + $offset = 0 if !defined($offset); + $offset += length($scalar) if $offset < 0; + croak "CGI::FCGI::OStream::WRITE invalid write offset" + if $offset < 0 || $offset > $length; + my $max = length($scalar) - $offset; + $length = $max if $length > $max; + $self->PRINT(substr($scalar, $offset, $length)); + return $length; +} + +package FCGI; + +use Carp 'croak'; + +sub new {croak 'FCGI->new is not permitted when `use CGI::FCGI;` is in effect'} + +package CGI::Fast; + +our @ISA = ('CGI::FCGI'); + +sub new {goto &CGI::FCGI::new} + +1; + +=head1 NAME + +CGI::FCGI - Alternative CGI::Fast and FCGI Interface + +=head1 SYNOPSIS + + use CGI::FCGI; + use CGI qw/ :standard /; + + my $maxrequests = 1; + my $CGI = 'CGI'; + if (CGI::FCGI::IsFCGI) { + $CGI = 'CGI::Fast'; + $maxrequests = 100; + } + + while (my $q = $CGI->new) { + ProcessRequest($q); + last unless --$maxrequests; + } + + sub ProcessRequest { + my $r = shift; + + # Perform standard CGI processing for one request + } + + 1; + +=head1 DESCRIPTION + +CGI::FCGI is intended as a bare bones Pure Perl replacement for +both CGI::Fast and FCGI. It's lightweight and supports the most +common use case of wanting to support FastCGI but missing one +or both of the CGI::Fast and FCGI modules. + +It only supports 'RESPONDER' and 'AUTHORIZER' roles (the +'RESPONDER' role corresponding to standard CGI applications) and it +only handles one request at a time on one socket at a time. For +compatibility with FCGI.pm, the FCGI_ROLE environment variable is always +set to either "RESPONDER" or "AUTHORIZER". + +Nevertheless, this is quite sufficient to reap a huge performance +gain as Perl need not be restarted once for every CGI request. + +Note that just like FCGI, input/output is always byte oriented so +the caller is responsible for decoding/encoding as needed. To +facilitate compatibility with the standard FCGI, the tied output +streams call a FCGI::Stream::PRINT function which contains the +actual PRINT implementation and may be head-patched in exactly +the same manner as the standard FCGI::Stream::PRINT implemention +to provide UTF-8 encoding on output. + +Other than CGI::Fast::new and FCGI::Stream::PRINT, B of the +other standard CGI::Fast or FCGI functions are provided! + +Remember, if using CGI::FCGI::Raw to allow custom handling of any +'POST' data, the data B be read from and B +the file handle which is also known as <>. + +=head1 FUNCTIONS + +=over 4 + +=item CGI::FCGI::IsFCGI + +Returns true if STDIN_FILENO appears to be a FastCGI socket. + +As there's not a direct equivalent in CGI::Fast or FCGI, don't +call this if code is to be interchangeable between CGI::FCGI and +CGI::Fast. + +=item CGI::FCGI::new + +Returns a new CGI instance for the next request. Returns undef +if the listen socket has been closed. All arguments are passed +on up to CGI::new. + +=item CGI::Fast::new + +Convenient alias for CGI::FCGI::new, all arguments are passed +on up to CGI::new. + +=item CGI::FCGI::Raw::new + +Returns a new instance for the next request that is B a CGI instance. +This is similar to FCGI::Request()->Accept() but can be used in a loop just the +same way CGI::FCGI::new (or the equivalent CGI::Fast::new) can. While the +returned instance is alive, STDIN, STDOUT, STDERR and %ENV are directed to the +request being serviced (in just the same way as for CGI::FCGI::new), but +B of the CGI processing happens (e.g. slurping up 'POST' data, parsing +QUERY_STRING, etc.) as the instance is B a CGI instance and for the same +reason B of the standard CGI methods are available on the instance. +No arguments are passed up to CGI since the new instance is B a CGI. +Returns undef if the listen socket has been closed. However, it is possible +to explicitly create a new CGI instance (CGI->new) after calling this function +provided the CGI global state has first been reset to its normal "empty" state. +See the CGI::FCGI::Raw::ResetCGI function for help with this. + +=item CGI::FCGI::Raw::ResetCGI + +Resets the global CGI state so that a call to CGI->new will create a new +CGI instance from the current environment in %ENV without being influenced by a +previously handled request. + +Do B call this unless the "Raw" interface is being used! The regular +interface (CGI::FCGI::new or CGI::Fast::new) takes care of this automatically. + +When using the "Raw" interface (i.e. CGI::FCGI::Raw::new) B then calling +CGI->new directly, this function should be called B CGI::FCGI::Raw::new +but B CGI->new to make sure that CGI->new doesn't return an instance +with leftover configuration and/or data from a previously handled request. + +=item FCGI::Stream::PRINT + +All stream output passes through this function which may be head-patched +to perform custom processing such as UTF-8 encoding. This is the same +name used by the standard FCGI module for compatibility. + +=back + +=head1 LIMITATIONS + +Although the implementation is Pure Perl, it I make heavy use of +the socket functions so may not function properly on platforms where the +socket functions are not available or only partially supported. + +This module must be use'd B CGI::Fast and FCGI otherwise it +will die with a fatal error. + +While a request is active, STDIN, STDOUT, STDERR and %ENV are temporarily +altered and there's no option to do otherwise. + +When a new request is started, the current values of the STDIN, STDOUT, +STDERR, %ENV and $/ variables are preserved before tying STDIN, STDOUT, +STDERR and adding received variables to %ENV. + +When the request ends (i.e. it's DESTROY'd) those variables are restored +to the values they had just prior to the start of the request therefore +changes to any of those variables during the processing of a request are, +deliberately, nonpersistent. + +=head1 LICENSE + +CGI::FCGI Copyright (C) 2015,2016,2017,2020 Kyle J. McKay. All rights reserved. + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself or under the terms of the +GNU General Public License version 2 (or, at your option, any later +version). + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +Address feedback to mackyle gmail.com. + +=head1 BUGS + +Hopefully squashed. + +=head1 SEE ALSO + +CGI, CGI::Fast, FCGI + +=cut diff --git a/gitweb/gitweb_config.perl b/gitweb/gitweb_config.perl index 1154550..494bf82 100644 --- a/gitweb/gitweb_config.perl +++ b/gitweb/gitweb_config.perl @@ -10,6 +10,29 @@ BEGIN { $INC{'HTML/Email/Obfuscate.pm'} = $INC{'Girocco/Email/Obfuscate.pm'}; # mwahaha } } +BEGIN { + # Redirect use of the FCGI/CGI::Fast module to the pure Perl substitute + # unless both the FCGI and CGI::Fast modules are actually present. + # However, if one or both of FCGI/CGI::Fast has already been use'd don't + # bother doing anything since it's too late to redirect at that point. + my $hasinc = sub { + do {my $f = $_."/".$_[0]; return $f if -f $f} + foreach grep(!ref($_),@INC); + return undef; + }; + my $gd = sub {my $l=1; return sub {$_=$l?"1;":"";$l--}}; + my $pre = sub { + if ($_[1] eq 'CGI/Fast.pm' && !$INC{'FCGI.pm'} or + $_[1] eq 'FCGI.pm' && !$INC{'CGI/Fast.pm'}) { + if (!&$hasinc('CGI/Fast.pm') || !&$hasinc('FCGI.pm')) { + require 'Girocco/extra/CGI/FCGI.pm'; + return &$gd; + } + } + return (); + }; + unshift(@INC, $pre); +} ## For the complete overview of available configuration options, ## see git.git/gitweb/gitweb.perl file beginning (git.git/gitweb/README diff --git a/toolbox/check-perl-modules.pl b/toolbox/check-perl-modules.pl index 07a65d3..f4bbbc3 100755 --- a/toolbox/check-perl-modules.pl +++ b/toolbox/check-perl-modules.pl @@ -1,7 +1,7 @@ #!/usr/bin/env perl # check-perl-modules.pl -- check for modules used by Girocco -# Copyright (c) 2013,2019,2020 Kyle J. McKay. All rights reserved. +# Copyright (c) 2013,2019,2020,2021 Kyle J. McKay. All rights reserved. # License GPLv2+: GNU GPL version 2 or later. # www.gnu.org/licenses/gpl-2.0.html # This is free software: you are free to change and redistribute it. @@ -103,12 +103,23 @@ print STDERR "Note: Perl modules JSON, LWP::UserAgent, RPC::XML and RPC::". my $fcgi_ok = 1; eval {require FCGI; 1} or $fcgi_ok = 0, -print STDERR "Note: running gitweb.cgi in FastCGI mode requires ". - "the missing Perl module FCGI\n"; -eval {require CGI::Fast; 1} or $fcgi_ok = 0, -print STDERR "Note: running gitweb.cgi in FastCGI mode requires ". - "the missing Perl module CGI::Fast\n"; -!$fcgi_ok || eval {require FCGI::ProcManager; 1} or +print STDERR "Note: missing Perl module FCGI used for efficient ". + "gitweb.cgi FastCGI implementation\n"; +my $cgifast_ok = 1; +eval {require CGI::Fast; 1} or $cgifast_ok = 0, +print STDERR "Note: missing Perl module CGI::Fast used for efficient ". + "gitweb.cgi FastCGI implementation\n"; +my $mods = ""; +$mods .= "FCGI" unless $fcgi_ok; +$mods .= ($mods?" and ":"")."CGI::Fast" unless $cgifast_ok; +my $pl = ""; +$pl = "s" unless $fcgi_ok || $cgifast_ok; +$mods eq "" or +print STDERR "Warning: gitweb.cgi running in FastCGI mode will use a pure Perl ". + "implementation of FastCGI\n". + "Warning: install Perl module$pl $mods for a more efficient gitweb.cgi ". + "FastCGI implementation\n"; +eval {require FCGI::ProcManager; 1} or print STDERR "Note: gitweb.cgi running in FastCGI mode requires ". "missing FCGI::ProcManager to support the --nproc option\n"; -- 2.11.4.GIT