Browse files

Merge #368 with fixes.

  • Loading branch information...
2 parents d0cc252 + 14e06a5 commit 4b2b1ba142ad087bdedd04258fc2b6b0bd8ce8d5 @miyagawa miyagawa committed Feb 4, 2013
View
4 lib/Plack/App/WrapCGI.pm
@@ -3,6 +3,7 @@ use strict;
use warnings;
use parent qw(Plack::Component);
use Plack::Util::Accessor qw(script execute _app);
+use File::Spec;
use CGI::Emulate::PSGI;
use CGI::Compile;
use Carp;
@@ -13,6 +14,8 @@ sub prepare_app {
my $script = $self->script
or croak "'script' is not set";
+ $script = File::Spec->rel2abs($script);
+
if ($self->execute) {
my $app = sub {
my $env = shift;
@@ -41,6 +44,7 @@ sub prepare_app {
open( STDIN, "<&=" . fileno($stdinr) )
or Carp::croak "Cannot dup STDIN: $!";
+ chdir(File::Basename::dirname($script));
exec($script) or Carp::croak("cannot exec: $!");
exit(2);
View
14 t/Plack-Middleware/cgi-bin/cgi_dir.cgi
@@ -0,0 +1,14 @@
+#!/usr/bin/env perl
+use CGI;
+use File::Basename qw/dirname/;
+use Cwd;
+
+my $cgi_dir = Cwd::abs_path( dirname( __FILE__ ) );
+my $exec_dir = Cwd::abs_path( Cwd::getcwd );
+my $result = $cgi_dir eq $exec_dir ? "MATCH" : "DIFFERENT";
+if ($result ne "MATCH") {
+ $result .= "\nCGI_DIR: $cgi_dir\nEXEC_DIR: $exec_dir\n";
+}
+
+my $q = CGI->new;
+print $q->header(-type => "text/plain"), $result;
View
11 t/Plack-Middleware/cgibin.t
@@ -43,4 +43,15 @@ test_psgi app => $app, client => sub {
is $res->content, "\xe1\x83\xb7\n";
};
+my $app = Plack::App::CGIBin->new(
+ root => "t/Plack-Middleware/cgi-bin",
+ exec_cb => sub { 1 } )->to_app;
+
+test_psgi app => $app, client => sub {
+ my $cb = shift;
+ my $res = $cb->(GET "http://localhost/cgi_dir.cgi");
+ is $res->code, 200;
+ is $res->content, "MATCH";
+};
+
done_testing;
View
40 t/Plack-Middleware/cgibin_exec.t
@@ -26,4 +26,44 @@ test_psgi app => $app, client => sub {
like $res->content, qr/QUERY_STRING is name=foo/;
};
+# test that current directory is same the script directory
+{
+ use File::Basename qw/basename dirname/;
+ my $tmp = File::Temp->new(CLEANUP => 1);
+ print $tmp <<"...";
+#!$^X
+use CGI;
+use File::Basename qw/dirname/;
+use Cwd;
+
+my \$cgi_dir = Cwd::abs_path( dirname( __FILE__ ) );
+my \$exec_dir = Cwd::abs_path( Cwd::getcwd );
+my \$result = \$cgi_dir eq \$exec_dir ? "MATCH" : "DIFFERENT";
+if (\$result ne "MATCH") {
+ \$result .= "\nCGI_DIR: \$cgi_dir\nEXEC_DIR: \$exec_dir\n";
+}
+
+my \$q = CGI->new;
+print \$q->header(-type => "text/plain"), \$result;
+...
+ close $tmp;
+
+ chmod(oct("0700"), $tmp->filename) or die "Cannot chmod";
+
+ my $cgi_dir = dirname( $tmp->filename );
+ my $cgi_name = basename( $tmp->filename );
+ my $app_exec = Plack::App::CGIBin->new(
+ root => $cgi_dir,
+ exec_cb => sub { 1 } )->to_app;
+ test_psgi app => $app_exec, client => sub {
+ my $cb = shift;
+
+ my $res = $cb->(GET "http://localhost/$cgi_name?");
+ is $res->code, 200;
+ is $res->content, "MATCH";
+ };
+
+ undef $tmp;
+};
+
done_testing;
View
12 t/Plack-Middleware/wrapcgi.t
@@ -21,4 +21,16 @@ test_psgi app => $app, client => sub {
is $res->content, "Hello bar counter=2";
};
+$app = Plack::App::WrapCGI->new(
+ script => "t/Plack-Middleware/cgi-bin/cgi_dir.cgi",
+ execute => 1)->to_app;
+
+test_psgi app => $app, client => sub {
+ my $cb = shift;
+
+ my $res = $cb->(GET "http://localhost/?");
+ is $res->code, 200;
+ is $res->content, "MATCH";
+};
+
done_testing;
View
35 t/Plack-Middleware/wrapcgi_exec.t
@@ -101,5 +101,40 @@ print <STDIN>;
undef $tmp;
};
+# test that current directory is same the script directory
+{
+ my $tmp = File::Temp->new(CLEANUP => 1);
+ print $tmp <<"...";
+#!$^X
+use CGI;
+use File::Basename qw/dirname/;
+use Cwd;
+
+my \$cgi_dir = Cwd::abs_path( dirname( __FILE__ ) );
+my \$exec_dir = Cwd::abs_path( Cwd::getcwd );
+my \$result = \$cgi_dir eq \$exec_dir ? "MATCH" : "DIFFERENT";
+if (\$result ne "MATCH") {
+ \$result .= "\nCGI_DIR: \$cgi_dir\nEXEC_DIR: \$exec_dir\n";
+}
+
+my \$q = CGI->new;
+print \$q->header(-type => "text/plain"), \$result;
+...
+ close $tmp;
+
+ chmod(oct("0700"), $tmp->filename) or die "Cannot chmod";
+
+ my $app_exec = Plack::App::WrapCGI->new(script => "$tmp", execute => 1)->to_app;
+ test_psgi app => $app_exec, client => sub {
+ my $cb = shift;
+
+ my $res = $cb->(GET "http://localhost/?");
+ is $res->code, 200;
+ is $res->content, "MATCH";
+ };
+
+ undef $tmp;
+};
+
done_testing;

0 comments on commit 4b2b1ba

Please sign in to comment.