summaryrefslogtreecommitdiffstats
path: root/Bugzilla/Quantum/CGI.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Bugzilla/Quantum/CGI.pm')
-rw-r--r--Bugzilla/Quantum/CGI.pm246
1 files changed, 131 insertions, 115 deletions
diff --git a/Bugzilla/Quantum/CGI.pm b/Bugzilla/Quantum/CGI.pm
index 7548c0809..79fbcfde6 100644
--- a/Bugzilla/Quantum/CGI.pm
+++ b/Bugzilla/Quantum/CGI.pm
@@ -19,143 +19,159 @@ use File::Spec::Functions qw(catfile);
use File::Slurper qw(read_text);
use English qw(-no_match_vars);
use Bugzilla::Quantum::Stdout;
-use Bugzilla::Constants qw(bz_locations);
+use Bugzilla::Constants qw(bz_locations USAGE_MODE_BROWSER);
our $C;
my %SEEN;
sub load_all {
- my ( $class, $r ) = @_;
+ my ($class, $r) = @_;
- foreach my $file ( glob '*.cgi' ) {
- my $name = _file_to_method($file);
- $class->load_one( $name, $file );
- $r->any("/$file")->to("CGI#$name");
- }
+ foreach my $file (glob '*.cgi') {
+ my $name = _file_to_method($file);
+ $class->load_one($name, $file);
+ $r->any("/$file")->to("CGI#$name");
+ }
}
sub load_one {
- my ( $class, $name, $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;
- local $C = $c;
- local %ENV = $c->_ENV($file);
- local $CGI::Compile::USE_REAL_EXIT = 0;
- local $PROGRAM_NAME = $file;
- local *STDIN; ## no critic (local)
- 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";
- }
- finally {
- my $error = shift;
- untie *STDOUT;
- $c->finish unless $error;
- Bugzilla->cleanup;
- CGI::initialize_globals();
- };
+ my ($class, $name, $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;
+ local $C = $c;
+ local %ENV = $c->_ENV($file);
+ local $CGI::Compile::USE_REAL_EXIT = 0;
+ local $PROGRAM_NAME = $file;
+ local *STDIN; ## no critic (local)
+ open STDIN, '<', $stdin->path
+ or die "STDIN @{[$stdin->path]}: $!"
+ if -s $stdin->path;
+ tie *STDOUT, 'Bugzilla::Quantum::Stdout',
+ controller => $c; ## no critic (tie)
+
+ # the finally block calls cleanup.
+ $c->stash->{cleanup_guard}->dismiss;
+ Bugzilla->usage_mode(USAGE_MODE_BROWSER);
+ try {
+ Bugzilla->init_page();
+ $inner->();
+ }
+ catch {
+ die $_ unless _is_exit($_);
+ }
+ finally {
+ my $error = shift;
+ untie *STDOUT;
+ $c->finish if !$error || _is_exit($error);
+ Bugzilla->cleanup;
+ CGI::initialize_globals();
};
+ };
- no strict 'refs'; ## no critic (strict)
- *{$name} = subname( $name, $wrapper );
- return 1;
+ no strict 'refs'; ## no critic (strict)
+ *{$name} = subname($name, $wrapper);
+ return 1;
}
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 = $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->{'mojo.captures'}{'PATH_INFO'};
- my %captures = %{ $c->stash->{'mojo.captures'} // {} };
- foreach my $key ( keys %captures ) {
- if ( $key eq 'controller' || $key eq 'action' || $key eq 'PATH_INFO' || $key =~ /^REWRITE_/ ) {
- delete $captures{$key};
- }
+ 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 => '');
+
+ $headers->content_type('application/x-www-form-urlencoded; charset=utf-8')
+ unless $headers->content_type;
+ 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 = $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->{'mojo.captures'}{'PATH_INFO'};
+ my %captures = %{$c->stash->{'mojo.captures'} // {}};
+ foreach my $key (keys %captures) {
+ if ( $key eq 'controller'
+ || $key eq 'action'
+ || $key eq 'PATH_INFO'
+ || $key =~ /^REWRITE_/)
+ {
+ delete $captures{$key};
}
- my $cgi_query = Mojo::Parameters->new(%captures);
- $cgi_query->append( $req->url->query );
- my $prefix = $c->stash->{bmo_prefix} ? '/bmo/' : '/';
-
- return (
- %ENV,
- CONTENT_LENGTH => $content_length || 0,
- CONTENT_TYPE => $headers->content_type || '',
- GATEWAY_INTERFACE => 'CGI/1.1',
- HTTPS => $req->is_secure ? 'on' : 'off',
- %env_headers,
- QUERY_STRING => $cgi_query->to_string,
- PATH_INFO => $path_info ? "/$path_info" : '',
- REMOTE_ADDR => $tx->original_remote_address,
- REMOTE_HOST => $tx->original_remote_address,
- REMOTE_PORT => $tx->remote_port,
- REMOTE_USER => $remote_user || '',
- REQUEST_METHOD => $req->method,
- SCRIPT_NAME => "$prefix$script_name",
- SERVER_NAME => hostname,
- SERVER_PORT => $tx->local_port,
- SERVER_PROTOCOL => $req->is_secure ? 'HTTPS' : 'HTTP', # TODO: Version is missing
- SERVER_SOFTWARE => __PACKAGE__,
- );
+ }
+ my $cgi_query = Mojo::Parameters->new(%captures);
+ $cgi_query->append($req->url->query);
+ my $prefix = $c->stash->{bmo_prefix} ? '/bmo/' : '/';
+
+ return (
+ %ENV,
+ CONTENT_LENGTH => $content_length || 0,
+ CONTENT_TYPE => $headers->content_type || '',
+ GATEWAY_INTERFACE => 'CGI/1.1',
+ HTTPS => $req->is_secure ? 'on' : 'off',
+ %env_headers,
+ QUERY_STRING => $cgi_query->to_string,
+ PATH_INFO => $path_info ? "/$path_info" : '',
+ REMOTE_ADDR => $tx->original_remote_address,
+ REMOTE_HOST => $tx->original_remote_address,
+ REMOTE_PORT => $tx->remote_port,
+ REMOTE_USER => $remote_user || '',
+ REQUEST_METHOD => $req->method,
+ SCRIPT_NAME => "$prefix$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 );
+ 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);
}
sub _file_to_method {
- my ($name) = @_;
- $name =~ s/\./_/s;
- $name =~ s/\W+/_/gs;
- return $name;
+ my ($name) = @_;
+ $name =~ s/\./_/s;
+ $name =~ s/\W+/_/gs;
+ return $name;
+}
+
+sub _is_exit {
+ my ($error) = @_;
+ return ref $error eq 'ARRAY' && $error->[0] eq "EXIT\n";
}
1;