test + changes for CGI detection under mod_cgid
Christian Walde [Thu, 5 Jul 2012 19:27:36 +0000 (21:27 +0200)]
Changes
t/request_mode_heuristics.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index dcb1874..8524920 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+  - Don't falsely recognize mod_cgid as FCGI
+
 0.016 - 2012-05-11
   - Actually import weaken so the 0.015 fix doesn't implode
 
diff --git a/t/request_mode_heuristics.t b/t/request_mode_heuristics.t
new file mode 100644 (file)
index 0000000..848a22e
--- /dev/null
@@ -0,0 +1,52 @@
+use strictures;
+
+use Test::More;
+use Web::Simple::Application;
+use Socket;
+
+run();
+done_testing;
+
+sub run {
+
+    my $a = Web::Simple::Application->new;
+
+    my ( $cli, $cgi, $fcgi, $test ) = qw( cli cgi fcgi test );
+
+    my $res;
+    no warnings 'redefine';
+    local *Web::Simple::Application::_run_fcgi             = sub { $res = "fcgi" };
+    local *Web::Simple::Application::_run_cgi              = sub { $res = "cgi" };
+    local *Web::Simple::Application::_run_cli              = sub { $res = "cli" };
+    local *Web::Simple::Application::_run_cli_test_request = sub { $res = "test" };
+    use strictures;
+
+    {
+        $a->run;
+        is $res, "cli", "empty invocation goes to CLI mode";
+    }
+
+  SKIP: {
+        skip "windows does not support the needed socket manipulation", 2 if $^O eq 'MSWin32' or $^O eq 'cygwin';
+        {
+            socket my $socket, AF_INET, SOCK_STREAM, 0 or die "socket: $!";
+            open my $old_in, '<&STDIN' or die "open: $!";
+            open STDIN, '<&', $socket or die "open: $!";
+            $a->run;
+            is $res, "fcgi", "STDIN being a socket means FCGI";
+            open STDIN, '<&', $old_in or die "open: $!";
+        }
+
+        {
+            local $ENV{GATEWAY_INTERFACE} = "CGI 1.1";
+            socket my $socket, AF_INET, SOCK_STREAM, 0 or die "socket: $!";
+            open my $old_in, '<&STDIN' or die "open: $!";
+            open STDIN, '<&', $socket or die "open: $!";
+            $a->run;
+            isnt $res, "fcgi", "STDIN being a socket doesn't mean FCGI if GATEWAY_INTERFACE is set";
+            open STDIN, '<&', $old_in or die "open: $!";
+        }
+    }
+
+    return;
+}