diff options
Diffstat (limited to 'Bugzilla/Quantum/CGI.pm')
-rw-r--r-- | Bugzilla/Quantum/CGI.pm | 136 |
1 files changed, 114 insertions, 22 deletions
diff --git a/Bugzilla/Quantum/CGI.pm b/Bugzilla/Quantum/CGI.pm index fab2b145d..9b9af51de 100644 --- a/Bugzilla/Quantum/CGI.pm +++ b/Bugzilla/Quantum/CGI.pm @@ -12,44 +12,136 @@ use CGI::Compile; use Bugzilla::Constants qw(bz_locations); use File::Slurper qw(read_text); use File::Spec::Functions qw(catfile); +use Sub::Name; use Sub::Quote 2.005000; +use Try::Tiny; use Taint::Util qw(untaint); +use Socket qw(AF_INET inet_aton); +use Capture::Tiny qw(capture_stdout); +use Sys::Hostname; -my %CGIS; - -_load_all(); - -sub expose_routes { +sub load_all { my ($class, $r) = @_; - foreach my $cgi (keys %CGIS) { - $r->any("/$cgi")->to("CGI#$CGIS{$cgi}"); - } -} + my $stash = Package::Stash->new(__PACKAGE__); -sub _load_all { foreach my $script (glob '*.cgi') { - my $name = _load_cgi($script); - $CGIS{ $script } = $name; + my ($name, $method) = $class->_load_cgi($script); + $stash->add_symbol("&$name" => $method); + $r->any("/$script")->to("CGI#$name"); } } -sub _load_cgi { - my ($file) = @_; - my $name = $file; - $name =~ s/\.cgi$//s; +sub _file_to_method { + my ($name) = @_; + $name =~ s/\./_/s; $name =~ s/\W+/_/gs; - my $subname = "handle_$name"; - my $content = read_text(catfile(bz_locations->{cgi_path}, $file)); + return $name; +} + +my %SEEN; + +sub _load_cgi { + my ($class, $file) = @_; + my $name = _file_to_method($file); + my $package = __PACKAGE__ . "::$name", + my $inner_name = "_$name"; + my $content = read_text( catfile( bz_locations->{cgi_path}, $file ) ); + $content = "package $package; $content"; untaint($content); - $content = 'my ($self) = @_; ' . $content; my %options = ( - package => __PACKAGE__ . "::$name", + package => $package, file => $file, line => 1, no_defer => 1, ); - quote_sub $subname, $content, {}, \%options; - return $subname; + die "Tried to load $file more than once" if $SEEN{$file}++; + my $inner = quote_sub $inner_name, $content, {}, \%options; + my $wrapper = sub { + my ($c) = @_; + my $stdin = $c->_STDIN; + my $stdout = ''; + local %ENV = $c->_ENV; + local *STDIN; ## no critic (local) + local $CGI::Compile::USE_REAL_EXIT = 0; + open STDIN, '<', $stdin->path or die "STDIN @{[$stdin->path]}: $!" if -s $stdin->path; + try { + Bugzilla->init_page(); + Bugzilla->request_cache->{mojo_controller} = $c; + $stdout = capture_stdout \&$inner; + } + catch { + die $_ unless ref $_ eq 'ARRAY' && $_->[0] eq "EXIT\n" || /\bModPerl::Util::exit\b/; + } + finally { + if ( length $stdout ) { + warn "setting body\n"; + $c->res->body($stdout); + $c->rendered; + } + Bugzilla->_cleanup; ## no critic (private) + CGI::initialize_globals(); + }; + }; + return ($name, subname($name, $wrapper)); +} + +sub _ENV { + my ($c) = @_; + my $tx = $c->tx; + my $req = $tx->req; + my $headers = $req->headers; + my $content_length = $req->content->is_multipart ? $req->body_size : $headers->content_length; + my %env_headers = ( HTTP_COOKIE => '', HTTP_REFERER => '' ); + + for my $name ( @{ $headers->names } ) { + my $key = uc "http_$name"; + $key =~ s!\W!_!g; + $env_headers{$key} = $headers->header($name); + } + + my $remote_user; + if ( my $userinfo = $c->req->url->to_abs->userinfo ) { + $remote_user = $userinfo =~ /([^:]+)/ ? $1 : ''; + } + elsif ( my $authenticate = $headers->authorization ) { + $remote_user = $authenticate =~ /Basic\s+(.*)/ ? b64_decode $1 : ''; + $remote_user = $remote_user =~ /([^:]+)/ ? $1 : ''; + } + + return ( + CONTENT_LENGTH => $content_length || 0, + CONTENT_TYPE => $headers->content_type || '', + GATEWAY_INTERFACE => 'CGI/1.1', + HTTPS => $req->is_secure ? 'YES' : 'NO', + %env_headers, + QUERY_STRING => $c->stash('cgi.query_string') || $req->url->query->to_string, + REMOTE_ADDR => $tx->remote_address, + REMOTE_HOST => gethostbyaddr( inet_aton( $tx->remote_address || '127.0.0.1' ), AF_INET ) || '', + REMOTE_PORT => $tx->remote_port, + REMOTE_USER => $remote_user || '', + REQUEST_METHOD => $req->method, + SCRIPT_NAME => $req->env->{SCRIPT_NAME}, + SERVER_NAME => hostname, + SERVER_PORT => $tx->local_port, + SERVER_PROTOCOL => $req->is_secure ? 'HTTPS' : 'HTTP', # TODO: Version is missing + SERVER_SOFTWARE => __PACKAGE__, + ); +} + +sub _STDIN { + my $c = shift; + my $stdin; + + if ( $c->req->content->is_multipart ) { + $stdin = Mojo::Asset::File->new; + $stdin->add_chunk( $c->req->build_body ); + } + else { + $stdin = $c->req->content->asset; + } + + return $stdin if $stdin->isa('Mojo::Asset::File'); + return Mojo::Asset::File->new->add_chunk( $stdin->slurp ); } 1;
\ No newline at end of file |