# This Source Code Form is subject to the terms of the Mozilla Public # License, v. 2.0. If a copy of the MPL was not distributed with this # file, You can obtain one at http://mozilla.org/MPL/2.0/. # # This Source Code Form is "Incompatible With Secondary Licenses", as # defined by the Mozilla Public License, v. 2.0. package Bugzilla::Quantum::CGI; use Mojo::Base 'Mojolicious::Controller'; use CGI::Compile; use Bugzilla::Constants qw(bz_locations); use Bugzilla::Quantum::Stdout; 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 Sys::Hostname; use English qw(-no_match_vars); our $C; sub load_all { my ($class, $r) = @_; my $stash = Package::Stash->new(__PACKAGE__); foreach my $script (glob '*.cgi') { my ($name, $method) = $class->_load_cgi($script); $stash->add_symbol("&$name" => $method); $r->any("/$script")->to("CGI#$name"); } } sub _file_to_method { my ($name) = @_; $name =~ s/\./_/s; $name =~ s/\W+/_/gs; 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); my %options = ( package => $package, file => $file, line => 1, no_defer => 1, ); 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 $C = $c; local %ENV = $c->_ENV($file); local *STDIN; ## no critic (local) local $CGI::Compile::USE_REAL_EXIT = 0; local $PROGRAM_NAME = $file; open STDIN, '<', $stdin->path or die "STDIN @{[$stdin->path]}: $!" if -s $stdin->path; tie *STDOUT, 'Bugzilla::Quantum::Stdout', controller => $c; ## no critic (tie) try { Bugzilla->init_page(); $inner->(); } catch { die $_ unless ref $_ eq 'ARRAY' && $_->[0] eq "EXIT\n" || /\bModPerl::Util::exit\b/; } finally { untie *STDOUT; $c->finish; Bugzilla->_cleanup; ## no critic (private) CGI::initialize_globals(); }; }; return ($name, subname($name, $wrapper)); } sub _ENV { my ($c, $script_name) = @_; 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 : ''; } my $path_info = $c->stash('PATH_INFO') || ''; 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, PATH_INFO => $path_info ? "/$path_info" : '', 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 => "/$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;