".html_quote($error_text). "
".$ENV{SERVER_SOFTWARE}."
"; return $status_code; } # Abort request with error sub throw { my $self = shift; die bless { error => [ @_ ] }, 'Bugzilla::HTTPServerSimple::FakeExit'; } # Print a "Not found" error sub not_found { my $self = shift; my ($script) = @_; $self->throw(404, 'Not Found', "The requested URL $script was not found on this server."); } # Print an "Internal Server Error" sub internal_error { my $self = shift; my ($text) = @_; $self->throw(500, 'Internal Server Error', $text); } # Load CGI script from file sub get_script { my $self = shift; my ($script, $for_require) = @_; my $fd; if (!open $fd, "<$script") { $self->not_found($script); } # Reload Bugzilla.pm for old versions on each request my $preload = Bugzilla->can('request_cache') ? '' : "delete \$INC{'Bugzilla.pm'}; require 'Bugzilla.pm';"; my $content; local $/ = undef; $content = <$fd>; close $fd; # untaint ($content) = $content =~ /^(.*)$/s; $content =~ s/\n__END__.*/\n/s; $content = "\n#line 1 \"$script\"\n$content"; my $package = lc $script; $package =~ s/^(\W)/'x'.unpack('H*', $1)/es; $package =~ s/(\W)/unpack('H*', $1)/ges; $content = $for_require ? "$preload package Bugzilla::$package; $content" : "package Bugzilla::$package; sub { $preload$content }"; return $content; } # Load script sub load_script { my $self = shift; my ($script) = @_; my $m; if (!$subs{$script} || ($self->{_config_hash}->{reload} && ($m = [stat $script]->[9] || 0) > $mtime{$script})) { my $content = $self->get_script($script); $subs{$script} = eval $content; $mtime{$script} = $m; if ($@) { $self->internal_error("Error while loading $script:\n$@"); } } } # Simple "FastCGI" implementation - cache *.cgi in subs sub run_script { my $self = shift; my ($script) = @_; $self->load_script($script); my $start = [gettimeofday]; $in_eval = 1; eval { &{$subs{$script}}(); }; $self->check_errors($script); my $elapsed = tv_interval($start) * 1000; print STDERR strftime("[%Y-%m-%d %H:%M:%S]", localtime)." Served $script in $elapsed ms\n"; } # Use require() instead of sub caching under NYTProf profiler for more correct reports sub run_script_require { my $self = shift; my ($script) = @_; my $content = $self->get_script($script, 1); my $start = [gettimeofday]; $in_eval = 1; eval $content; $self->check_errors($script); my $elapsed = tv_interval($start) * 1000; print STDERR strftime("[%Y-%m-%d %H:%M:%S]", localtime)." Served $script via require() in $elapsed ms\n"; } # Finish script run and check for errors sub check_errors { my $self = shift; my ($script) = @_; my $err; if ($@ && (!ref($@) || ref($@) ne 'Bugzilla::HTTPServerSimple::FakeExit')) { $err = "Error while running $script:\n$@"; } eval { Bugzilla::_cleanup(); }; if ($@ && (!ref($@) || ref($@) ne 'Bugzilla::HTTPServerSimple::FakeExit')) { print STDERR "Error in _cleanup():\n$@"; } $in_eval = 0; if ($err) { $self->internal_error($err); } } sub handler { my $self = shift; $self->handle_request; } sub handle_request { my $self = shift; # Set SCRIPT_NAME to REQUEST_URI and clear PATH_INFO $ENV{SCRIPT_NAME} = $ENV{REQUEST_URI}; $ENV{PATH_INFO} = ''; # Set non-parsed-headers CGI mode CGI::nph(1); # Determine SCRIPT_FILENAME my $script = $ENV{SCRIPT_FILENAME}; $ENV{REQUEST_URI} =~ s!^/*!/!iso; unless ($script) { ($script) = $ENV{REQUEST_URI} =~ m!/+([^\?\#]*)!so; } if ($self->{_config_hash}->{path_parent_regexp}) { $script =~ s!^($self->{_config_hash}->{path_parent_regexp})($|/+)!!s; } $script ||= 'index.cgi'; $ENV{SCRIPT_FILENAME} = $Bugzilla::HTTPServerSimple::DOCROOT.'/'.$script; # Check access if ($self->{_config_hash}->{deny_regexp} && $script =~ /$self->{_config_hash}->{deny_regexp}/s) { return $self->print_error('403', 'Access Denied', "You are not allowed to access URL $script on this server."); } # Serve static files (should be done by nginx, but we support it for completeness) my $fd; $script =~ s!^/*!!so; if ($script !~ /\.cgi$/iso || $script =~ /\//so) { if (open $fd, '<', $script) { print $ENV{SERVER_PROTOCOL}." 200 OK\r\n". "Content-Type: ".guess_media_type($script)."\r\n". "Content-Length: ".(-s $script)."\r\n\r\n"; sendfile(fileno(STDOUT), fileno($fd), 0, -s $script); close $fd; print STDERR strftime("[%Y-%m-%d %H:%M:%S]", localtime)." Served $script via sendfile()\n"; return 200; } else { # Failed to open file return $self->print_error('403', 'Access Denied', "You are not allowed to access URL $script on this server."); } } if ($self->{_config_hash}->{http_env}) { # Allow to set environment variables from additional HTTP headers foreach (split /[\s,]*,[\s,]*/, $self->{_config_hash}->{http_env}) { $ENV{$_} = $ENV{'HTTP_X_'.uc $_}; } } if ($self->{_config_hash}->{reload}) { reload(); } # Bugzilla-specific tweaks binmode STDOUT, ':utf8' if Bugzilla->can('params') && Bugzilla->params->{utf8}; # Clear request cache for new versions $Bugzilla::_request_cache = {}; eval { if ($ENV{NYTPROF} && $INC{'Devel/NYTProf.pm'}) { $self->run_script_require($script); } else { $self->run_script($script); } }; if ($@ && ref($@) eq 'Bugzilla::HTTPServerSimple::FakeExit') { return $self->print_error(@{$@->{error}}); } return 200; } my $STATS; # Used to reload Perl modules on-the-fly (debug purposes) sub reload { my ($file, $mtime); for my $key (keys %INC) { $file = $INC{$key} or next; $file =~ /\.p[ml]$/i or next; # do not reload *.cgi $mtime = (stat $file)[9]; # Startup time as default $STATS->{$file} = $^T unless defined $STATS->{$file}; # Modified if ($mtime > $STATS->{$file}) { print STDERR __PACKAGE__ . ": $key -> $file modified, reloading\n"; unload($key) or next; eval { require $key }; if ($@) { warn $@; } $STATS->{$file} = $mtime; } } } sub unload { my ($key) = @_; my $file = $INC{$key} or return; my @subs = grep { index($DB::sub{$_}, "$file:") == 0 } keys %DB::sub; for my $sub (@subs) { eval { undef &$sub }; if ($@) { warn "Can't unload sub '$sub' in '$file': $@"; return undef; } delete $DB::sub{$sub}; } delete $INC{$key}; return 1; } # This implementation is nearly the same as the original, but also uses buffered input sub parse_request { my $self = shift; my $chunk =