Mojolicious-Plugin-CGI-0.40/000755 000765 000024 00000000000 13405123151 016727 5ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/cpanfile000644 000765 000024 00000000374 13117562661 020454 0ustar00jhthorsenstaff000000 000000 # You can install this projct with curl -L http://cpanmin.us | perl - https://github.com/jhthorsen/mojolicious-plugin-cgi/archive/master.tar.gz requires "IO::Pipely" => "0.005"; requires "Mojolicious" => "7.28"; test_requires "Test::More" => "0.88"; Mojolicious-Plugin-CGI-0.40/Changes000644 000765 000024 00000010470 13405123151 020224 0ustar00jhthorsenstaff000000 000000 Revision history for perl distribution Mojolicious-Plugin-CGI 0.40 2018-12-15T15:59:53+0900 - Compatible with Mojolicious 8.06 #30 0.39 2018-09-02T22:33:56+0200 - Compatible with Mojolocious 7.90 #29 0.38 2017-06-12T21:05:08+0200 - Bumped Mojolicious version to 7.28 #27 0.37 2017-05-15T22:01:59+0200 - Stop using deprecated "spurt" #26 0.36 2016-10-27T11:55:46+0200 - Fix setting $ENV{PATH_INFO} with UTF-8 characters Contributor: kensanata 0.35 2016-10-13T10:04:50+0200 - Skipping tests on Windows 0.34 2016-06-10T19:41:37-0700 - zombies.t cannot run without File::Which 0.33 2016-06-07T15:46:09-0500 - Fix zombies left behind #20 #21 #22 0.32 2016-04-17T14:34:17+0200 - Fix passing on %ENV to cgi script #19 0.31 2016-04-11T18:17:20+0200 - Avoid making CPAN dist with files from t/cgi-bin 0.30 2016-04-11T18:06:04+0200 - Will generate all the cgi-scripts with $^X 0.29 2016-04-09T10:54:27+0200 - Replace "/usr/bin/perl" with "/usr/bin/env perl" in tests 0.28 2016-04-06T16:22:50+0200 - Try to fix "Could not run CGI script" test failures 0.27 2016-04-01T14:09:59+0200 - Refactored the module - Add $c->cgi->run(...) helper - Fix bug when exec() fail in child - Remove "ioloop" attribute - Remove "emulate_environment" method 0.26 2016-03-10T22:15:51+0100 - Expose all headers as environment variables #18 0.25 2015-11-27T11:49:54+0100 - Made post.t optional 0.24 2015-11-11T22:16:33+0100 - Add "run" option for running CGI code from a callback instead of script #17 - Add HTTP_IF_NONE_MATCH to environement #17 - Add support for reading the "Status" header - Improved NPH script support #17 0.23 2015-07-16T07:43:59+0200 - Try to fix waiting for finished CGI scripts, without checking return value from waitpid() 0.22 2015-07-14T17:32:59+0200 - Fix "Bareword found where operator expected at t/gh-16-loop_reset.t line 35" - Try to fix waiting for finished CGI scripts 0.21 2015-07-12T15:26:05+0200 - Fix "Can't call method "write" on an undefined value" #16 - Disabled "no leaky leaks" test 0.20 2015-03-13T08:27:48Z - t/post.t leaky pipes test works on osx (timgimyee) 0.19 2015-02-08T14:24:43Z - Will not test SERVER_ADMIN variable 0.18 2015-01-30T09:57:46Z - Fix SCRIPT_NAME environment variable - Fix minimum Mojolicious version in cpanfile #13 0.17 2015-01-15T17:19:57Z - Add support for QUERY_STRING with ";" instead of "&" 0.16 2015-01-02T13:24:59Z - Require Mojolicious 5.08 0.15 2014-12-14T15:24:14Z - Fix CPAN testers and HTTP_HOST regexp 0.14 2014-12-12T13:27:17Z - Fix multipart test content length value Contributor: leejo 0.13 2014-11-17T15:13:31Z - Reset IOLoop in fork to prevent fork from receiving connections 0.12 2014-10-05T18:44:58Z - Change default CGI logging prefix to "CGI:$name:$pid" - Fix _waitpids() actually checks hanging processes 0.11 2014-10-05T10:58:12Z - Default STDERR logging goes to app log - Refactored the code using IO::Pipely - env() is an attribute - Tried to fix REMOTE_HOST from Authorization header, closes #10 0.10 2014-10-02T21:31:18Z - Fix Can't use string ("") as a HASH ref while "strict refs" in use at Mojolicious::Routes::Pattern line 63. 0.09 2014-06-13T11:56:31Z - Add README.pod to MANIFEST.SKIP https://github.com/jhthorsen/mojolicious-plugin-cgi/issues/9 0.08 2014-05-14T10:29:24Z - Flushing STDERR as well - Fix REMOTE_HOST test on windows http://www.cpantesters.org/cpan/report/99cac79a-725d-1014-82ca-1dcb5cf4d ae8 REMOTE_HOST=599DSOLIMANO01.cowen.corp != localhost 0.07 2013-11-17T14:11:59Z - Reads userinfo from request path - Add support for errlog - Fix PATH_INFO and SCRIPT_NAME 0.0601 2013-10-01T12:36:25Z - Add repository to Makefile.PL 0.06 2013-09-24T09:43:37Z - Add support multipart requests lee@givengain.ch 0.0501 2013-08-26T18:35:24Z - Fix waitpid before kill, because of defunc children 0.05 2013-08-23T16:31:13Z - Fix pipe leak - Support 302 redirects - Add better error handling - Will check if child is running 0.0401 2013-08-16T23:24:58Z - Fix NAME in Makefile.PL 0.04 2013-08-16T09:15:16Z - Add before hook which can modify query string 0.0301 2013-08-08T12:31:28Z - Need to waitpid to avoid defunct processes 0.03 2013-08-08T12:23:36Z - CGI script is now non-blocking 0.02 2013-08-05T12:45:43Z - Fix compat with older perls. 0.01 2013-07-11T11:40:26Z - Add basic support for calling CGI scripts Mojolicious-Plugin-CGI-0.40/MANIFEST000644 000765 000024 00000001166 13405123151 020064 0ustar00jhthorsenstaff000000 000000 .perltidyrc .travis.yml Changes cpanfile lib/Mojolicious/Plugin/CGI.pm Makefile.PL MANIFEST This list of files MANIFEST.SKIP pm_to_blib README t/00-basic.t t/bar.txt t/basic.t t/before.t t/encoding.t t/errlog.t t/foo.txt t/gh-16-loop_reset.t t/Helper.pm t/helper.t t/multipart.t t/not-found.t t/not-modified.t t/nph-borked.t t/nph.t t/post.t t/query-string-with-semicolon.t t/redirect.t t/remote-user.t t/run.t t/test_file_with_a_long_filename.txt t/zombies.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Mojolicious-Plugin-CGI-0.40/t/000755 000765 000024 00000000000 13405123151 017172 5ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/README000644 000765 000024 00000010443 13117562744 017630 0ustar00jhthorsenstaff000000 000000 NAME Mojolicious::Plugin::CGI - Run CGI script from Mojolicious VERSION 0.38 DESCRIPTION This plugin enable Mojolicious to run Perl CGI scripts. It does so by forking a new process with a modified environment and reads the STDOUT in a non-blocking manner. SYNOPSIS Standard usage use Mojolicious::Lite; plugin CGI => [ "/cgi-bin/script" => "/path/to/cgi/script.pl" ]; Using the code above is enough to run "script.pl" when accessing . Complex usage plugin CGI => { # Specify the script and mount point script => "/path/to/cgi/script.pl", route => "/some/route", # %ENV variables visible from inside the CGI script env => {}, # default is \%ENV # Path to where STDERR from cgi script goes errlog => "/path/to/file.log", # The "before" hook is called before script start # It receives a Mojolicious::Controller which can be modified before => sub { my $c = shift; $c->req->url->query->param(a => 123); }, }; The above contains all the options you can pass on to the plugin. Helper plugin "CGI"; # GET /cgi-bin/some-script.cgi/path/info?x=123 get "/cgi-bin/#script_name/*path_info" => {path_info => ''}, sub { my $c = shift; my $name = $c->stash("script_name"); $c->cgi->run(script => File::Spec->rel2abs("/path/to/cgi/$name")); }; The helper can take most the arguments that "register" takes, with the exception of "support_semicolon_in_query_string". It is critical that "script_name" and "path_info" is present in stash. If the values are extracted directly from the path or set manually does not matter. Note that the helper is registered in all of the examples. Running code refs plugin CGI => { route => "/some/path", run => sub { my $cgi = CGI->new; # ... } }; Instead of calling a script, you can run a code block when accessing the route. This is (pretty much) safe, even if the code block modifies global state, since it runs in a separate fork/process. Support for semicolon in query string plugin CGI => { support_semicolon_in_query_string => 1, ... }; The code above need to be added before other plugins or handler which use "url" in Mojo::Message::Request. It will inject a "before_dispatch" hook which saves the original QUERY_STRING, before it is split on "&" in Mojo::Parameters. ATTRIBUTES env Holds a hash ref containing the environment variables that should be used when starting the CGI script. Defaults to %ENV when this module was loaded. This plugin will create a set of environment variables depenendent on the request passed in which is according to the CGI spec. In addition to "env", these dynamic variables are set: CONTENT_LENGTH, CONTENT_TYPE, HTTPS, PATH, PATH_INFO, QUERY_STRING, REMOTE_ADDR, REMOTE_HOST, REMOTE_PORT, REMOTE_USER, REQUEST_METHOD, SCRIPT_NAME, SERVER_PORT, SERVER_PROTOCOL. Additional static variables: GATEWAY_INTERFACE = "CGI/1.1" SERVER_ADMIN = $ENV{USER} SCRIPT_FILENAME = Script name given as argument to register. SERVER_NAME = Sys::Hostname::hostname() SERVER_SOFTWARE = "Mojolicious::Plugin::CGI" Plus all headers are exposed. Examples: .----------------------------------------. | Header | Variable | |-----------------|----------------------| | Referer | HTTP_REFERER | | User-Agent | HTTP_USER_AGENT | | X-Forwarded-For | HTTP_X_FORWARDED_FOR | '----------------------------------------' register $self->register($app, [ $route => $script ]); $self->register($app, %args); $self->register($app, \%args); "route" and path need to exist as keys in %args unless given as plain arguments. $route can be either a plain path or a route object. COPYRIGHT AND LICENSE Copyright (C) 2014, Jan Henning Thorsen This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. AUTHOR Jan Henning Thorsen - "jhthorsen@cpan.org" Mojolicious-Plugin-CGI-0.40/pm_to_blib000644 000765 000024 00000000000 13106404611 020747 0ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/MANIFEST.SKIP000644 000765 000024 00000000145 13106404414 020627 0ustar00jhthorsenstaff000000 000000 ^mypp.yml .git \.old \.swp ~$ ^blib/ ^Makefile$ ^MYMETA* ^README.pod ^Mojolicious-Plugin-CGI cgi-bin Mojolicious-Plugin-CGI-0.40/META.yml000664 000765 000024 00000001465 13405123151 020210 0ustar00jhthorsenstaff000000 000000 --- abstract: 'Run CGI script from Mojolicious' author: - 'Jan Henning Thorsen ' build_requires: Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Mojolicious-Plugin-CGI no_index: directory: - t - inc requires: IO::Pipely: '0.005' Mojolicious: '7.28' resources: bugtracker: https://github.com/jhthorsen/mojolicious-plugin-cgi/issues homepage: https://github.com/jhthorsen/mojolicious-plugin-cgi repository: https://github.com/jhthorsen/mojolicious-plugin-cgi.git version: '0.40' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Mojolicious-Plugin-CGI-0.40/lib/000755 000765 000024 00000000000 13405123151 017475 5ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/Makefile.PL000644 000765 000024 00000002561 13405123151 020705 0ustar00jhthorsenstaff000000 000000 # Generated by git-ship. See 'git-ship --man' for help or https://github.com/jhthorsen/app-git-ship use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( NAME => 'Mojolicious::Plugin::CGI', AUTHOR => 'Jan Henning Thorsen ', LICENSE => 'artistic_2', ABSTRACT_FROM => 'lib/Mojolicious/Plugin/CGI.pm', VERSION_FROM => 'lib/Mojolicious/Plugin/CGI.pm', EXE_FILES => [qw()], BUILD_REQUIRES => {} , TEST_REQUIRES => { 'Test::More' => '0.88' } , PREREQ_PM => { 'IO::Pipely' => '0.005', 'Mojolicious' => '7.28' } , META_MERGE => { 'dynamic_config' => 0, 'meta-spec' => {version => 2}, 'resources' => { bugtracker => {web => 'https://github.com/jhthorsen/mojolicious-plugin-cgi/issues'}, homepage => 'https://github.com/jhthorsen/mojolicious-plugin-cgi', repository => { type => 'git', url => 'https://github.com/jhthorsen/mojolicious-plugin-cgi.git', web => 'https://github.com/jhthorsen/mojolicious-plugin-cgi', }, }, }, test => {TESTS => (-e 'META.yml' ? 't/*.t' : 't/*.t xt/*.t')}, ); unless (eval { ExtUtils::MakeMaker->VERSION('6.63_03') }) { my $test_requires = delete $WriteMakefileArgs{TEST_REQUIRES}; @{$WriteMakefileArgs{PREREQ_PM}}{keys %$test_requires} = values %$test_requires; } WriteMakefile(%WriteMakefileArgs); Mojolicious-Plugin-CGI-0.40/.perltidyrc000644 000765 000024 00000000714 13106404365 021122 0ustar00jhthorsenstaff000000 000000 -pbp # Start with Perl Best Practices -w # Show all warnings -iob # Ignore old breakpoints -l=100 # Characters per line -mbl=2 # No more than 2 blank lines -i=2 # Indentation is 2 columns -ci=2 # Continuation indentation is 2 columns -vt=0 # Less vertical tightness -pt=2 # High parenthesis tightness -bt=2 # High brace tightness -sbt=2 # High square bracket tightness -isbc # Don't indent comments without leading space Mojolicious-Plugin-CGI-0.40/.travis.yml000644 000765 000024 00000000410 13106404365 021042 0ustar00jhthorsenstaff000000 000000 language: perl perl: - "5.20" - "5.14" - "5.10" env: - "HARNESS_OPTIONS=j1 TEST_POD=1 TEST_MORBO=1" install: - "cpanm -n Test::Pod Test::Pod::Coverage Parallel::ForkManager Proc::ProcessTable" - "cpanm -n --installdeps ." notifications: email: false Mojolicious-Plugin-CGI-0.40/META.json000664 000765 000024 00000002657 13405123151 020364 0ustar00jhthorsenstaff000000 000000 { "abstract" : "Run CGI script from Mojolicious", "author" : [ "Jan Henning Thorsen " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.150010", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Mojolicious-Plugin-CGI", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "IO::Pipely" : "0.005", "Mojolicious" : "7.28" } }, "test" : { "requires" : { "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/jhthorsen/mojolicious-plugin-cgi/issues" }, "homepage" : "https://github.com/jhthorsen/mojolicious-plugin-cgi", "repository" : { "type" : "git", "url" : "https://github.com/jhthorsen/mojolicious-plugin-cgi.git", "web" : "https://github.com/jhthorsen/mojolicious-plugin-cgi" } }, "version" : "0.40", "x_serialization_backend" : "JSON::PP version 2.97001" } Mojolicious-Plugin-CGI-0.40/lib/Mojolicious/000755 000765 000024 00000000000 13405123151 021771 5ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/lib/Mojolicious/Plugin/000755 000765 000024 00000000000 13405123151 023227 5ustar00jhthorsenstaff000000 000000 Mojolicious-Plugin-CGI-0.40/lib/Mojolicious/Plugin/CGI.pm000644 000765 000024 00000030424 13405123151 024172 0ustar00jhthorsenstaff000000 000000 package Mojolicious::Plugin::CGI; use Mojo::Base 'Mojolicious::Plugin'; use File::Basename; use File::Spec; use IO::Pipely 'pipely'; use Mojo::Util qw(b64_decode encode); use POSIX 'WNOHANG'; use Perl::OSType 'is_os_type'; use Socket qw(AF_INET inet_aton); use Sys::Hostname; use constant CHECK_CHILD_INTERVAL => $ENV{CHECK_CHILD_INTERVAL} || 0.01; use constant DEBUG => $ENV{MOJO_PLUGIN_CGI_DEBUG}; use constant IS_WINDOWS => is_os_type('Windows'); use constant READ => 0; use constant WRITE => 1; our $VERSION = '0.40'; our %ORIGINAL_ENV = %ENV; has env => sub { +{%ORIGINAL_ENV} }; sub register { my ($self, $app, $args) = @_; my $pids = $app->{'mojolicious_plugin_cgi.pids'} ||= {}; $args = {route => shift @$args, script => shift @$args} if ref $args eq 'ARRAY'; $args->{env} ||= $self->env; $args->{run} = delete $args->{script} if ref $args->{script} eq 'CODE'; $args->{pids} = $pids; $app->helper('cgi.run' => sub { _run($args, @_) }) unless $app->renderer->helpers->{'cgi.run'}; $app->{'mojolicious_plugin_cgi.tid'} ||= Mojo::IOLoop->recurring(CHECK_CHILD_INTERVAL, sub { local ($?, $!); _waitpids($pids); }); if ($args->{support_semicolon_in_query_string} and !$app->{'mojolicious_plugin_cgi.before_dispatch'}++) { $app->hook( before_dispatch => sub { $_[0]->stash('cgi.query_string' => $_[0]->req->url->query->to_string); } ); } return unless $args->{route}; # just register the helper die "Neither 'run', nor 'script' is specified." unless $args->{run} or $args->{script}; $args->{route} = $app->routes->any("$args->{route}/*path_info", {path_info => ''}) unless ref $args->{route}; $args->{script} = File::Spec->rel2abs($args->{script}) || $args->{script} if $args->{script}; $args->{route}->to(cb => sub { _run($args, @_) }); } sub _child { my ($c, $args, $stdin, $stdout, $stderr) = @_; my @STDERR = @$stderr ? ('>&', fileno $stderr->[WRITE]) : ('>>', $args->{errlog}); Mojo::IOLoop->reset; warn "[CGI:$args->{name}:$$] <<< (@{[$stdin->slurp]})\n" if DEBUG; open STDIN, '<', $stdin->path or die "STDIN @{[$stdin->path]}: $!" if -s $stdin->path; open STDERR, $STDERR[0], $STDERR[1] or die "STDERR: @$stderr: $!"; open STDOUT, '>&', fileno $stdout->[WRITE] or die "STDOUT: $!"; select STDERR; $| = 1; select STDOUT; $| = 1; %ENV = _emulate_environment($c, $args); $args->{run} ? $args->{run}->($c) : exec $args->{script} || die "Could not execute $args->{script}: $!"; eval { POSIX::_exit($!) } unless IS_WINDOWS; eval { CORE::kill KILL => $$ }; exit $!; } sub _emulate_environment { my ($c, $args) = @_; 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 => ''); my ($remote_user, $script_name); for my $name (@{$headers->names}) { my $key = uc "http_$name"; $key =~ s!\W!_!g; $env_headers{$key} = $headers->header($name); } 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 : ''; } if ($args->{route}) { $script_name = $c->url_for($args->{route}->name, {path_info => ''})->path->to_string; } elsif (my $name = $c->stash('script_name')) { my $name = quotemeta $name; $script_name = $c->req->url->path =~ m!^(.*?/$name)! ? $1 : $c->stash('script_name'); } return ( %{$args->{env}}, CONTENT_LENGTH => $content_length || 0, CONTENT_TYPE => $headers->content_type || '', GATEWAY_INTERFACE => 'CGI/1.1', HTTPS => $req->is_secure ? 'YES' : 'NO', %env_headers, PATH_INFO => '/' . encode('UTF-8', $c->stash('path_info') // ''), 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_FILENAME => $args->{script} || '', SCRIPT_NAME => $script_name || $args->{name}, SERVER_ADMIN => $ENV{USER} || '', SERVER_NAME => hostname, SERVER_PORT => $tx->local_port, SERVER_PROTOCOL => $req->is_secure ? 'HTTPS' : 'HTTP', # TODO: Version is missing SERVER_SOFTWARE => __PACKAGE__, ); } sub _run { my ($defaults, $c) = (shift, shift); my $args = @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}; my $before = $args->{before} || $defaults->{before}; my $stdin = _stdin($c); my @stdout = pipely; my ($pid, $log_key, @stderr); $args->{$_} ||= $defaults->{$_} for qw(env errlog route run script); $args->{name} = $args->{run} ? "$args->{run}" : basename $args->{script}; $c->$before($args) if $before; @stderr = (pipely) unless $args->{errlog}; defined($pid = fork) or die "[CGI:$args->{name}] fork failed: $!"; _child($c, $args, $stdin, \@stdout, \@stderr) unless $pid; $args->{pids}{$pid} = $args->{name}; $log_key = "CGI:$args->{name}:$pid"; $c->app->log->debug("[$log_key] START @{[$args->{script} || $args->{run}]}"); for my $p (\@stdout, \@stderr) { next unless $p->[READ]; close $p->[WRITE]; $p->[READ] = Mojo::IOLoop::Stream->new($p->[READ])->timeout(0); Mojo::IOLoop->stream($p->[READ]); } $c->stash('cgi.pid' => $pid, 'cgi.stdin' => $stdin); $c->render_later; $stderr[READ]->on(read => _stderr_cb($c, $log_key)) if $stderr[READ]; $stdout[READ]->on(read => _stdout_cb($c, $log_key)); $stdout[READ]->on(close => sub { my $GUARD = 50; warn "[CGI:$args->{name}:$pid] Child closed STDOUT\n" if DEBUG; unlink $stdin->path or die "Could not remove STDIN @{[$stdin->path]}" if -e $stdin->path; local ($?, $!); _waitpids({$pid => $args->{pids}{$pid}}) while $args->{pids}{$pid} and kill 0, $pid and $GUARD--; $defaults->{pids}{$pid} = $args->{pids}{$pid} if kill 0, $pid; return $c->finish if $c->res->code; return $c->render(text => "Could not run CGI script ($?, $!).\n", status => 500); } ); } sub _stderr_cb { my ($c, $log_key) = @_; my $log = $c->app->log; my $buf = ''; return sub { my ($stream, $chunk) = @_; warn "[$log_key] !!! ($chunk)\n" if DEBUG; $buf .= $chunk; $log->warn("[$log_key] $1") while $buf =~ s!^(.+)[\r\n]+$!!m; }; } sub _stdout_cb { my ($c, $log_key) = @_; my $buf = ''; my $headers; return sub { my ($stream, $chunk) = @_; warn "[$log_key] >>> ($chunk)\n" if DEBUG; # true if HTTP header has been written to client return $c->write($chunk) if $headers; $buf .= $chunk; # false until all headers has been read from the CGI script $buf =~ s/^(.*?\x0a\x0d?\x0a\x0d?)//s or return; $headers = $1; if ($headers =~ /^HTTP/) { $c->res->code($headers =~ m!^HTTP (\d\d\d)! ? $1 : 200); $c->res->parse($headers); } else { $c->res->code($1) if $headers =~ /^Status: (\d\d\d)/m; $c->res->code($headers =~ /Location:/ ? 302 : 200) unless $c->res->code; $c->res->parse($c->res->get_start_line_chunk(0) . $headers); } $c->write($buf) if length $buf; }; } 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); } sub _waitpids { my $pids = shift; for my $pid (keys %$pids) { # no idea why i need to do this, but it seems like waitpid() below return -1 if not local $SIG{CHLD} = 'DEFAULT'; next unless waitpid $pid, WNOHANG; my $name = delete $pids->{$pid} || 'unknown'; my ($exit_value, $signal) = ($? >> 8, $? & 127); warn "[CGI:$name:$pid] Child exit_value=$exit_value ($signal)\n" if DEBUG; } } 1; =encoding utf8 =head1 NAME Mojolicious::Plugin::CGI - Run CGI script from Mojolicious =head1 VERSION 0.40 =head1 DESCRIPTION This plugin enables L to run Perl CGI scripts. It does so by forking a new process with a modified environment and reads the STDOUT in a non-blocking manner. =head1 SYNOPSIS =head2 Standard usage use Mojolicious::Lite; plugin CGI => [ "/cgi-bin/script" => "/path/to/cgi/script.pl" ]; Using the code above is enough to run C when accessing L. =head2 Complex usage plugin CGI => { # Specify the script and mount point script => "/path/to/cgi/script.pl", route => "/some/route", # %ENV variables visible from inside the CGI script env => {}, # default is \%ENV # Path to where STDERR from cgi script goes errlog => "/path/to/file.log", # The "before" hook is called before script start # It receives a Mojolicious::Controller which can be modified before => sub { my $c = shift; $c->req->url->query->param(a => 123); }, }; The above contains all the options you can pass on to the plugin. =head2 Helper plugin "CGI"; # GET /cgi-bin/some-script.cgi/path/info?x=123 get "/cgi-bin/#script_name/*path_info" => {path_info => ''}, sub { my $c = shift; my $name = $c->stash("script_name"); $c->cgi->run(script => File::Spec->rel2abs("/path/to/cgi/$name")); }; The helper can take most of the arguments that L takes, with the exception of C. It is critical that "script_name" and "path_info" is present in L. Whether the values are extracted directly from the path or set manually does not matter. Note that the helper is registered in all of the examples. =head2 Running code refs plugin CGI => { route => "/some/path", run => sub { my $cgi = CGI->new; # ... } }; Instead of calling a script, you can run a code block when accessing the route. This is (pretty much) safe, even if the code block modifies global state, since it runs in a separate fork/process. =head2 Support for semicolon in query string plugin CGI => { support_semicolon_in_query_string => 1, ... }; The code above needs to be added before other plugins or handlers which use L. It will inject a C hook which saves the original QUERY_STRING, before it is split on "&" in L. =head1 ATTRIBUTES =head2 env Holds a hash ref containing the environment variables that should be used when starting the CGI script. Defaults to C<%ENV> when this module was loaded. This plugin will create a set of environment variables depenendent on the request passed in which is according to the CGI spec. In addition to L, these dynamic variables are set: CONTENT_LENGTH, CONTENT_TYPE, HTTPS, PATH, PATH_INFO, QUERY_STRING, REMOTE_ADDR, REMOTE_HOST, REMOTE_PORT, REMOTE_USER, REQUEST_METHOD, SCRIPT_NAME, SERVER_PORT, SERVER_PROTOCOL. Additional static variables: GATEWAY_INTERFACE = "CGI/1.1" SERVER_ADMIN = $ENV{USER} SCRIPT_FILENAME = Script name given as argument to register. SERVER_NAME = Sys::Hostname::hostname() SERVER_SOFTWARE = "Mojolicious::Plugin::CGI" Plus all headers are exposed. Examples: .----------------------------------------. | Header | Variable | |-----------------|----------------------| | Referer | HTTP_REFERER | | User-Agent | HTTP_USER_AGENT | | X-Forwarded-For | HTTP_X_FORWARDED_FOR | '----------------------------------------' =head2 register $self->register($app, [ $route => $script ]); $self->register($app, %args); $self->register($app, \%args); C and L need to exist as keys in C<%args> unless given as plain arguments. C<$route> can be either a plain path or a route object. =head1 COPYRIGHT AND LICENSE Copyright (C) 2014, Jan Henning Thorsen This program is free software, you can redistribute it and/or modify it under the terms of the Artistic License version 2.0. =head1 AUTHOR Jan Henning Thorsen - C =cut Mojolicious-Plugin-CGI-0.40/t/query-string-with-semicolon.t000644 000765 000024 00000001155 13106404365 025000 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; my $this_will_mess_up; use Mojolicious::Lite; plugin CGI => {support_semicolon_in_query_string => 1}; app->hook( before_dispatch => sub { my $c = shift; $this_will_mess_up = $c->req->url->query->param('a'); } ); plugin CGI => {route => '/env/basic', script => cgi_script('env.cgi'), env => {}}; my $t = Test::Mojo->new; $t->get_ok('/env/basic/foo?a=1;b=2')->status_is(200) ->content_like(qr{^QUERY_STRING=a=1;b=2}m, 'QUERY_STRING with semicolon'); local $TODO = 'mojolicious cannot parse query with semicolon'; is $this_will_mess_up, '1', 'not messed up'; done_testing; Mojolicious-Plugin-CGI-0.40/t/post.t000644 000765 000024 00000003612 13106404365 020355 0ustar00jhthorsenstaff000000 000000 use warnings; use strict; use Test::More; use Test::Mojo; # http://cpantesters.org/cpan/report/dc79de2e-c956-11e4-9245-4861e0bfc7aa # http://cpantesters.org/cpan/report/676eae4c-24f6-11e5-ad16-fd611bfff594 # http://cpantesters.org/cpan/report/908763b4-24f6-11e5-8c9c-b46a1bfff594 # http://cpantesters.org/cpan/report/1c1f3f16-8a17-11e5-b552-e159351a082c plan skip_all => 'TEST_PIPES=1; No idea how to test this consistently' unless $ENV{TEST_PIPES}; my @pipes = get_pipes(); my %LSOF_PIPE; # Map lsof DEVICE and NAME to same pipe. use Mojolicious::Lite; plugin CGI => ['/postman' => 't/cgi-bin/postman']; my $t = Test::Mojo->new; $t->post_ok('/postman', {}, "some\ndata\n")->status_is(200)->content_like(qr{^\d+\n--- some\n--- data\n$}); my $pid = $t->tx->res->body =~ /(\d+)/ ? $1 : 0; ok !(kill 0, $pid), "child $pid is taken care of ($$, @{[time]})" or is waitpid($pid, 0), $pid, "waitpid $pid, 0 ($$, @{[time]})"; is_deeply \@pipes, [get_pipes()], 'no leaky leaks'; sub get_pipes { return diag "test for leaky pipes under Debian build", 1 if $ENV{DEBIAN_BUILD}; my @pipes; if (-d "/proc/$$/fd") { for my $fd (glob "/proc/$$/fd/*") { my $pts = readlink sprintf '/proc/%s/fd/%s', $$, +(split '/', $fd)[-1] or next; push @pipes, $pts if $pts =~ /pipe:/; } } elsif (`which lsof` =~ /\blsof$/) { # Output of `lsof` for pipe looks like this: # COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME # perl5.18 57806 moejoe 3 PIPE 0xd52803906b02a64f 16384 ->0xd52803907288254f for (`lsof -p $$`) { / PIPE / or next; my ($device, $name) = /\b(0x[[:xdigit:]]+)/g; my $pipe = $LSOF_PIPE{$device} || $LSOF_PIPE{$name} || $device; $LSOF_PIPE{$device} = $LSOF_PIPE{$name} = $pipe; push @pipes, $pipe; } } else { diag "unable to test leaky pipes"; } return sort @pipes; } done_testing; Mojolicious-Plugin-CGI-0.40/t/helper.t000644 000765 000024 00000002377 13106404365 020656 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin "CGI"; get "/cgi-bin/#script_name/*path_info" => {path_info => ''}, sub { my $c = shift; my $script_name = $c->stash('script_name'); $script_name = "$script_name.cgi" unless $script_name =~ /\.cgi$/; $c->cgi->run(script => File::Spec->rel2abs(cgi_script($script_name))); }; my $t = Test::Mojo->new; $t->get_ok('/cgi-bin/nope.cgi/foo')->status_is(500)->content_like(qr{Could not run CGI script}); $t->get_ok('/cgi-bin/env.cgi/some/path/info?query=123')->status_is(200) ->content_like(qr{^PATH_INFO=/some/path/info}m, 'PATH_INFO') ->content_like(qr{^QUERY_STRING=query=123}m, 'QUERY_STRING') ->content_like(qr{^SCRIPT_FILENAME=\S+/t/cgi-bin/env\.cgi$}m, 'SCRIPT_FILENAME') ->content_like(qr{^SCRIPT_NAME=/cgi-bin/env\.cgi$}m, 'SCRIPT_NAME'); $t->get_ok('/cgi-bin/env/some/path/info?query=123')->status_is(200) ->content_like(qr{^PATH_INFO=/some/path/info}m, 'PATH_INFO') ->content_like(qr{^QUERY_STRING=query=123}m, 'QUERY_STRING') ->content_like(qr{^SCRIPT_FILENAME=\S+/t/cgi-bin/env\.cgi$}m, 'SCRIPT_FILENAME') ->content_like(qr{^SCRIPT_NAME=/cgi-bin/env$}m, 'SCRIPT_NAME'); done_testing; Mojolicious-Plugin-CGI-0.40/t/redirect.t000644 000765 000024 00000000400 13106404365 021161 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/redirect' => cgi_script('redirect.pl')]; Test::Mojo->new->get_ok('/redirect', {})->status_is(302) ->header_is('Location' => 'http://somewhereelse.com')->content_is(''); done_testing; Mojolicious-Plugin-CGI-0.40/t/before.t000644 000765 000024 00000001035 13106404365 020627 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => { route => '/user/:id', script => cgi_script('env.cgi'), before => sub { my $c = shift; my $query = $c->req->url->query; $query->param(id => $c->stash('id')); $query->param(other_value => 123); }, }; Test::Mojo->new->get_ok('/user/42')->status_is(200) ->content_like(qr{^QUERY_STRING=id=42}m, 'QUERY_STRING=id=42') ->content_like(qr{^QUERY_STRING=.*other_value=123}m, 'QUERY_STRING=...other_value=123'); done_testing; Mojolicious-Plugin-CGI-0.40/t/encoding.t000644 000765 000024 00000001320 13106404365 021150 0ustar00jhthorsenstaff000000 000000 use utf8; use lib '.'; use t::Helper; use Mojo::UserAgent; use Mojo::Util 'decode'; { use Mojolicious::Lite; use Mojo::Util 'decode'; plugin CGI => { route => '/', run => sub { diag "PATH_INFO=$ENV{PATH_INFO}"; print "HTTP/1.1 200 OK\r\n"; print "Content-Type: text/plain; charset=UTF-8\r\n"; print "\r\n"; print "p=$ENV{PATH_INFO}\n"; }, }; } # Application is alive my $t = Test::Mojo->new; my @w; $t->get_ok("/foo")->status_is(200)->content_is("p=/foo\n", 'ascii'); $t->get_ok("/föö")->status_is(200)->content_is("p=/föö\n", 'umlauts'); $t->get_ok("/fö’")->status_is(200)->content_is("p=/fö’\n", 'quote'); is "@w", "", "no warnings"; done_testing(); Mojolicious-Plugin-CGI-0.40/t/zombies.t000644 000765 000024 00000004643 13106404365 021045 0ustar00jhthorsenstaff000000 000000 use Mojo::Base -strict; use Test::More; use File::Spec::Functions 'catfile'; use File::Temp 'tempdir'; use FindBin; use IO::Socket::INET; use Mojo::File 'path'; use Mojo::IOLoop::Server; use Mojo::UserAgent; plan skip_all => $@ unless -e '.git' and eval 'require Proc::ProcessTable && require File::Which && 1'; # Prepare script my $dir = tempdir CLEANUP => 1; my $script = catfile $dir, 'myapp.pl'; my $port = Mojo::IOLoop::Server->generate_port; path($script)->spurt(< { default => { hypnotoad => { inactivity_timeout => 3, listen => ['http://127.0.0.1:$port'], workers => 2 } } }; plugin CGI => { route => '/', script => "$script", # this is required to run the test for 0.26 run => sub { print "HTTP/1.1 200 OK\r\n"; print "Content-Type: text/text; charset=ISO-8859-1\r\n"; print "\r\n"; print "Hello CGI!\n"; }, }; app->start; EOF # Start server my $hypnotoad = File::Which::which('hypnotoad'); open my $start, '-|', $^X, $hypnotoad, $script; sleep 1 while !_port($port); # Remember PID open my $file, '<', catfile($dir, 'hypnotoad.pid'); my $pid = <$file>; chomp $pid; ok $pid, "PID $pid found"; # Application is alive my $ua = Mojo::UserAgent->new; my $tx = $ua->get("http://127.0.0.1:$port/"); is $tx->res->code, 200, 'right status'; is $tx->res->body, "Hello CGI!\n", 'right content'; # Hammer the server my $requests = 20; diag("Hammering the server with $requests requests"); for my $i (1 .. $requests) { $ua->get("http://127.0.0.1:$port/"); sleep 1; } # See whether zombies are reaped my $seconds = 20; my $ts = time; diag("Waiting for the reaper"); for my $i (1 .. $seconds) { sleep 1; last if _zombies() == 0; } my $delta = time - $ts; is _zombies(), 0, "No zombies left after $delta seconds"; # Stop the server open my $stop, '-|', $^X, $hypnotoad, $script, '-s'; sleep 1 while _port($port); # Checking Processes my $alive = kill 0 => $pid; is $alive, 0, "$pid is terminated"; sub _port { IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => shift) } sub _zombies { my $processes = Proc::ProcessTable->new(enable_ttys => 0); # say join(', ', $processes->fields); my $grp = getpgrp $pid; my $zombies = 0; foreach my $proc (@{$processes->table}) { $zombies++ if $proc->pgrp == $grp and $proc->state eq 'defunct'; } return $zombies; } done_testing(); Mojolicious-Plugin-CGI-0.40/t/00-basic.t000644 000765 000024 00000002142 13106404365 020663 0ustar00jhthorsenstaff000000 000000 use Test::More; use File::Find; if (($ENV{HARNESS_PERL_SWITCHES} || '') =~ /Devel::Cover/) { plan skip_all => 'HARNESS_PERL_SWITCHES =~ /Devel::Cover/'; } if (!eval 'use Test::Pod; 1') { *Test::Pod::pod_file_ok = sub { SKIP: { skip "pod_file_ok(@_) (Test::Pod is required)", 1 } }; } if (!eval 'use Test::Pod::Coverage; 1') { *Test::Pod::Coverage::pod_coverage_ok = sub { SKIP: { skip "pod_coverage_ok(@_) (Test::Pod::Coverage is required)", 1 } }; } if (!eval 'use Test::CPAN::Changes; 1') { *Test::CPAN::Changes::changes_file_ok = sub { SKIP: { skip "changes_ok(@_) (Test::CPAN::Changes is required)", 4 } }; } find({wanted => sub { /\.pm$/ and push @files, $File::Find::name }, no_chdir => 1}, -e 'blib' ? 'blib' : 'lib',); plan tests => @files * 3 + 4; for my $file (@files) { my $module = $file; $module =~ s,\.pm$,,; $module =~ s,.*/?lib/,,; $module =~ s,/,::,g; ok eval "use $module; 1", "use $module" or diag $@; Test::Pod::pod_file_ok($file); Test::Pod::Coverage::pod_coverage_ok($module, {also_private => [qr/^[A-Z_]+$/],}); } Test::CPAN::Changes::changes_file_ok(); Mojolicious-Plugin-CGI-0.40/t/gh-16-loop_reset.t000644 000765 000024 00000003601 13106404365 022361 0ustar00jhthorsenstaff000000 000000 BEGIN { $ENV{MOJO_REACTOR} = 'Mojo::Reactor::Poll' } use Mojo::Base -strict; use Test::More; plan skip_all => 'set TEST_MORBO to enable this test (developer only!)' unless $ENV{TEST_MORBO}; plan skip_all => 'Parallel::ForkManager is not available' unless eval 'require Parallel::ForkManager;1'; plan skip_all => 't/cgi-bin/slow.pl' unless -x 't/cgi-bin/slow.pl'; use File::Spec::Functions 'catdir'; use File::Temp 'tempdir'; use IO::Socket::INET; use Mojo::File 'path'; use Mojo::IOLoop::Server; use Mojo::Server::Daemon; use Mojo::Server::Morbo; use Mojo::UserAgent; # Prepare script my $n = 5; my $dir = tempdir CLEANUP => 1; my $script = catdir $dir, 'myapp.pl'; my $morbo = Mojo::Server::Morbo->new(watch => [$script]); path($script)->spurt(<<'EOF'); use Mojolicious::Lite; app->log->level('fatal'); plugin CGI => ['/slow' => 't/cgi-bin/slow.pl']; app->start; EOF # Start my $port = Mojo::IOLoop::Server->generate_port; # assume morbo is in the same dir as the perl runing this test # this is not WIN32 compatible, and 5.14+, but since dev test only... (my $prefix = $^X) =~ s!/perl[^/]*$!!; my $pid = open my $server, '-|', $^X, "$prefix/morbo", '-l', "http://127.0.0.1:$port", $script; sleep 1 until _server_running($port); my $ua = Mojo::UserAgent->new; my $pm = Parallel::ForkManager->new($n); $pm->run_on_finish( sub { my ($pid, $exit_code, $ident, $exit_signal, $core_dump, $data) = @_; my ($is_finished, $code, $body) = @$data; ok $is_finished, 'transaction is finished'; is $code, 200, 'right status'; } ); foreach my $req (1 .. $n) { $pm->start and next; my $tx = $ua->get("http://127.0.0.1:$port/slow"); $pm->finish(0, [$tx->is_finished, $tx->res->code, $tx->res->body]); } $pm->wait_all_children; kill 'INT', $pid; sleep 1 while _server_running($port); done_testing(); sub _server_running { IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => shift) } Mojolicious-Plugin-CGI-0.40/t/basic.t000644 000765 000024 00000004651 13106404365 020455 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; $ENV{THE_ANSWER} = 42; use Mojolicious::Lite; plugin CGI => ['/working' => cgi_script('basic.pl')]; plugin CGI => {route => '/env/basic', script => cgi_script('env.cgi')}; my $t = Test::Mojo->new; $t->get_ok('/working')->status_is(200)->header_is('Content-Type' => 'text/custom') ->content_is("basic stuff\n"); $t->get_ok($t->tx->req->url->clone->path('/env/basic/foo')->query(query => 123))->status_is(200) ->content_like(qr{^ENVIRONMENT}m, 'ENVIRONMENT') ->content_like(qr{^CONTENT_LENGTH=0}m, 'CONTENT_LENGTH=0') ->content_like(qr{^CONTENT_TYPE=}m, 'CONTENT_TYPE=') ->content_like(qr{^GATEWAY_INTERFACE=CGI/1\.1}m, 'GATEWAY_INTERFACE=CGI/1\.1') ->content_like(qr{^HTTPS=NO}m, 'HTTPS=NO')->content_like(qr{^HTTP_COOKIE=}m, 'HTTP_COOKIE=') ->content_like(qr{^HTTP_HOST=(localhost|127\.0\.0\.1):\d+}m, 'HTTP_HOST=localhost:\d+') ->content_like(qr{^HTTP_REFERER=}m, 'HTTP_REFERER=') ->content_like(qr{^HTTP_USER_AGENT=Mojolicious \(Perl\)}m, 'HTTP_USER_AGENT=Mojolicious \(Perl\)') ->content_like(qr{^PATH_INFO=/foo}m, 'PATH_INFO=/foo') ->content_like(qr{^QUERY_STRING=query=123}m, 'QUERY_STRING=query=123') ->content_like(qr{^REMOTE_ADDR=\d+\S+}m, 'REMOTE_ADDR=\d+\S+') ->content_like(qr{^REMOTE_HOST=[\w\.]+}m, 'REMOTE_HOST=[\w\.]+') ->content_like(qr{^REMOTE_PORT=\w+}m, 'REMOTE_PORT=\w+') ->content_like(qr{^REMOTE_USER=}m, 'REMOTE_USER=') ->content_like(qr{^REQUEST_METHOD=GET}m, 'REQUEST_METHOD=GET') ->content_like(qr{^SCRIPT_FILENAME=\S+/t/cgi-bin/env\.cgi}m, 'SCRIPT_FILENAME=\S+/t/cgi-bin/env\.cgi') ->content_like(qr{^SCRIPT_NAME=/env/basic\W*$}m, 'SCRIPT_NAME=env/basic') ->content_like(qr{^SERVER_PORT=\d+}m, 'SERVER_PORT=\d+') ->content_like(qr{^SERVER_PROTOCOL=HTTP}m, 'SERVER_PROTOCOL=HTTP') ->content_like(qr{^SERVER_SOFTWARE=Mojolicious::Plugin::CGI}m, 'SERVER_SOFTWARE=Mojolicious::Plugin::CGI')->content_like(qr{^THE_ANSWER=42}m, 'THE_ANSWER=42'); $t->get_ok('/env/basic/foo' => {'Referer' => 'http://thorsen.pm', 'X-Forwarded-For' => '1.2.3.4'}) ->status_is(200) ->content_like(qr{^HTTP_REFERER=http://thorsen\.pm}m, 'HTTP_REFERER=http://thorsen.pm') ->content_like(qr{^HTTP_X_FORWARDED_FOR=1\.2\.3\.4}m, 'HTTP_X_FORWARDED_FOR=1.2.3.4'); done_testing; Mojolicious-Plugin-CGI-0.40/t/foo.txt000644 000765 000024 00000000017 13106404365 020523 0ustar00jhthorsenstaff000000 000000 some more data Mojolicious-Plugin-CGI-0.40/t/nph-borked.t000644 000765 000024 00000000357 13106404365 021424 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/nph-borked' => cgi_script('nph-borked.pl')]; Test::Mojo->new->get_ok('/nph-borked', {})->status_is(403) ->content_like(qr'This is the borked paywall'); done_testing; Mojolicious-Plugin-CGI-0.40/t/not-modified.t000644 000765 000024 00000000423 13106404365 021743 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/not-modified' => cgi_script('not-modified.pl')]; Test::Mojo->new->get_ok('/not-modified' => {'If-None-Match' => 'ABC'})->status_is(304) ->header_is('X-Test' => 'if-none-match seen: ABC'); done_testing; Mojolicious-Plugin-CGI-0.40/t/not-found.t000644 000765 000024 00000000343 13106404365 021277 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/not-found' => cgi_script('not-found.pl')]; Test::Mojo->new->get_ok('/not-found', {})->status_is(404)->content_like(qr'This page is missing'); done_testing; Mojolicious-Plugin-CGI-0.40/t/nph.t000644 000765 000024 00000000320 13106404365 020146 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/nph' => cgi_script('nph.pl')]; Test::Mojo->new->get_ok('/nph', {})->status_is(403)->content_like(qr'This is the paywall'); done_testing; Mojolicious-Plugin-CGI-0.40/t/bar.txt000644 000765 000024 00000000024 13106404365 020502 0ustar00jhthorsenstaff000000 000000 even more data here Mojolicious-Plugin-CGI-0.40/t/Helper.pm000644 000765 000024 00000004645 13106404365 020767 0ustar00jhthorsenstaff000000 000000 package t::Helper; use Mojo::Base -strict; use File::Basename; use File::Spec::Functions qw(catdir catfile); use Mojolicious; use Mojo::Loader; use Test::Mojo; use Test::More; sub cgi_script { my $template = shift; my $script = catfile 't', 'cgi-bin', $template; mkdir catdir qw(t cgi-bin); open my $CGI_BIN, '>', $script or Test::More::plan(skip_all => "write $script: $!"); print $CGI_BIN "#!$^X\n"; print $CGI_BIN "use strict;\nuse warnings;\n"; print $CGI_BIN Mojo::Loader::data_section(__PACKAGE__, $template); close $CGI_BIN; eval { chmod 0755, $script }; return $script; } sub import { my $class = shift; my $caller = caller; Test::More::plan(skip_all => 'Skipping tests on Windows.') if $^O eq 'Win32'; eval <<"HERE"; package $caller; use Mojo::Base -strict; use Test::Mojo; use Test::More; HERE Mojo::Util::monkey_patch($caller => cgi_script => \&cgi_script); } 1; __DATA__ @@ basic.pl print "Content-Type: text/custom\n\r\n\rbasic stuff\n"; @@ env print "Content-Type: text/plain\n\r"; print "\n\rENVIRON"; print "MENT\n"; print "$_=$ENV{$_}\n" for sort keys %ENV; @@ env.cgi print "Content-Type: text/plain\n\r"; print "\n\rENVIRON"; print "MENT\n"; print "$_=$ENV{$_}\n" for sort keys %ENV; @@ errlog warn "yikes!"; print "Content-Type: text/plain\n\r\n\r"; print "yayayyaya\n"; @@ file_upload print "Content-Type: text/custom\n\r\n\r"; print "$$\n"; print "=== $ENV{$_}\n" for qw/CONTENT_TYPE CONTENT_LENGTH/; print "--- $_" while ; @@ not-found.pl print "Status: 404 Not Found\r\n"; print "Content-Type: text/html; charset=ISO-8859-1\r\n"; print "\r\n"; print "

This page is missing\n"; @@ not-modified.pl print "Status: 304 Not Modified\r\n"; print "X-Test: if-none-match seen: $ENV{HTTP_IF_NONE_MATCH}\r\n"; print "\r\n"; @@ nph-borked.pl # When SERVER_PROTOCOL is set to "HTTP", the CGI module will just print HTTP and # no version! print "HTTP 403 Payment Required\r\n"; print "Content-Type: text/html; charset=ISO-8859-1\r\n"; print "\r\n"; print "

This is the borked paywall.\n"; @@ nph.pl print "HTTP/1.1 403 Payment Required\r\n"; print "Content-Type: text/html; charset=ISO-8859-1\r\n"; print "\r\n"; print "

This is the paywall.\n"; @@ postman print "Content-Type: text/custom\n\r\n\r"; print "$$\n"; print "--- $_" while ; @@ redirect.pl print "Location: http://somewhereelse.com\n\r\n\r"; @@ slow.pl sleep 1; print "Content-Type: text/custom\n\r\n\rHello Morbo!\n"; Mojolicious-Plugin-CGI-0.40/t/run.t000644 000765 000024 00000000534 13106404365 020174 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => { route => '/', run => sub { print "HTTP/1.1 200 OK\r\n"; print "Content-Type: text/html; charset=ISO-8859-1\r\n"; print "\r\n"; print "

Hi!\n"; }, }; my $t = Test::Mojo->new; $t->get_ok('/')->status_is(200)->content_like(qr/Hi!/); done_testing; Mojolicious-Plugin-CGI-0.40/t/multipart.t000644 000765 000024 00000001534 13106404365 021412 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => ['/file_upload' => cgi_script('file_upload')]; my $t = Test::Mojo->new; $t->post_ok( '/file_upload' => form => { mytext => [ {file => 't/foo.txt'}, {file => 't/bar.txt'}, {file => 't/test_file_with_a_long_filename.txt'}, ] } ); $t->status_is(200); $t->content_like( qr{^\d+ === multipart/form-data; boundary=(\w+) === \d+ --- --\1\r --- Content-Disposition: form-data; name="mytext"; filename="foo\.txt"\r --- \r --- some more --- data --- \r --- --\1\r --- Content-Disposition: form-data; name="mytext"; filename="bar\.txt"\r --- \r --- even more --- data here --- \r --- --\1\r --- Content-Disposition: form-data; name="mytext"; filename="test_file_with_a_long_filename\.txt"\r --- \r --- and yet more --- data in here --- \r --- --\1--}s ); done_testing; Mojolicious-Plugin-CGI-0.40/t/remote-user.t000644 000765 000024 00000001234 13106404365 021635 0ustar00jhthorsenstaff000000 000000 use lib '.'; use t::Helper; use Mojolicious::Lite; plugin CGI => {route => '/auth', script => cgi_script('env.cgi'), env => {}}; my $t = Test::Mojo->new; $t->get_ok('/auth')->status_is(200)->status_is(200) ->content_like(qr{^REMOTE_USER=}m, 'REMOTE_USER='); $t->get_ok($t->tx->req->url->clone->userinfo('Aladdin:foopass'), {'Authorization' => ''}) ->status_is(200)->content_like(qr{^REMOTE_USER=Aladdin$}m, 'REMOTE_USER=Aladdin'); $t->get_ok( $t->tx->req->url->clone->userinfo('whatever:foopass'), {'Authorization' => 'Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ=='} )->status_is(200)->content_like(qr{^REMOTE_USER=Aladdin$}m, 'REMOTE_USER=Aladdin'); done_testing; Mojolicious-Plugin-CGI-0.40/t/errlog.t000644 000765 000024 00000001440 13405122543 020654 0ustar00jhthorsenstaff000000 000000 use lib '.'; BEGIN { $ENV{MOJO_LOG_LEVEL} = 'warn' } use t::Helper; unlink 't/err.log'; my $app = Mojolicious->new; my $t = Test::Mojo->new($app); my ($s, @err); $app->plugin(CGI => {route => '/err', script => cgi_script('errlog')}); $app->log->on( message => sub { my ($log, $level, $message) = @_; push @err, $message if $level eq 'warn'; } ); $t->get_ok('/err'); like $err[0], qr{\[CGI:errlog:\d+\] yikes! at .*errlog line 4}, 'logged stderr'; $app = Mojolicious->new; $t = Test::Mojo->new($app); $app->plugin(CGI => {route => '/err', script => cgi_script('errlog'), errlog => 't/err.log'}); $t->get_ok('/err'); $s = -s 't/err.log'; ok $s, 't/err.log has data'; $t->get_ok('/err'); ok -s 't/err.log' >= $s * 2, 't/err.log has more data'; unlink 't/err.log'; done_testing; Mojolicious-Plugin-CGI-0.40/t/test_file_with_a_long_filename.txt000644 000765 000024 00000000032 13106404365 026125 0ustar00jhthorsenstaff000000 000000 and yet more data in here