[Bps-public-commit] HTTP-Server-Simple branch, master, updated. 0.44-1-g140c868

[Jason May]

The branch, master has been updated
       via  140c86845915c3030259829f82399e4b4e40cdd5 (commit)
      from  9cd6f434297dc1dde6816fa86414338a94bf1e97 (commit)

Summary of changes:
 lib/HTTP/Server/Simple.pm |    3 +++
 t/04cgi.t                 |   34 ++++++++++++++++++++++++++++++++--
 2 files changed, 35 insertions(+), 2 deletions(-)

- Log -----------------------------------------------------------------
commit 140c86845915c3030259829f82399e4b4e40cdd5
Author: Jason May <jasonmay at bestpractical.com>
Date:   Thu Sep 8 17:58:07 2011 -0400

    Implement and test for awareness of absolute URIs in requests, per RFC 2616
    
    http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.1.2

diff --git a/lib/HTTP/Server/Simple.pm b/lib/HTTP/Server/Simple.pm
index 50479ae..7256835 100644
--- a/lib/HTTP/Server/Simple.pm
+++ b/lib/HTTP/Server/Simple.pm
@@ -608,6 +608,9 @@ sub parse_request {
     my $uri      = $2 || '';
     my $protocol = $3 || '';
 
+    # strip <scheme>://<host:port> out of HTTP/1.1 requests
+    $uri =~ s{^\w+://[^/]+/}{/};
+
     return ( $method, $uri, $protocol );
 }
 
diff --git a/t/04cgi.t b/t/04cgi.t
index 1b6a5e1..83a41cf 100644
--- a/t/04cgi.t
+++ b/t/04cgi.t
@@ -32,10 +32,10 @@ my %envvars=(
 if ($^O eq 'freebsd' && `sysctl -n security.jail.jailed` == 1) {
     delete @methods{qw(url server_name)};
     delete @envvars{qw(SERVER_URL SERVER_NAME REMOTE_ADDR)};
-    plan tests => 18;
+    plan tests => 50;
 }
 else {
-    plan tests => 23;
+    plan tests => 55;
 }
 
 {
@@ -69,6 +69,36 @@ else {
     select(undef,undef,undef,0.2); # wait a sec
   }
 
+# extra tests for HTTP/1.1 absolute URLs
+
+  foreach my $verb ('GET', 'HEAD') {
+    foreach my $method (keys(%methods)) {
+      next unless defined $methods{$method};
+
+      my $method_value = $methods{$method};
+      $method_value =~ s/\bGET\b/$verb/;
+
+      like(
+            fetch("$verb http://localhost/cgitest/$method HTTP/1.1",""),
+            "/$method_value/",
+            "method (absolute URL) - $method"
+          );
+      select(undef,undef,undef,0.2); # wait a sec
+    }
+
+    foreach my $envvar (keys(%envvars)) {
+      (my $envvar_value = $envvars{$envvar});
+      $envvar_value =~ s/\bGET\b/$verb/;
+
+      like(
+            fetch("$verb http://localhost/cgitest/$envvar HTTP/1.1",""),
+            "/$envvar_value/",
+            "Environment (absolute URL) - $envvar"
+          );
+      select(undef,undef,undef,0.2); # wait a sec
+    }
+  }
+
   like(
        fetch("GET /cgitest/REQUEST_URI?foo%3Fbar HTTP/1.0",""),
        qr/foo%3Fbar/,

-----------------------------------------------------------------------