X-Git-Url: http://sjero.net/git/?p=wget;a=blobdiff_plain;f=tests%2FHTTPServer.pm;h=58b1a363b4fc0570ad45858f5fde20c80cb6d747;hp=57b0499faa47df2c109210f6c9fb59769a457c65;hb=d763f8bf6d6e13ce006ffab616cc8a77e747a633;hpb=c60c7b9941da3756a0b46130dfa15ad31132dbfa

diff --git a/tests/HTTPServer.pm b/tests/HTTPServer.pm
index 57b0499f..58b1a363 100644
--- a/tests/HTTPServer.pm
+++ b/tests/HTTPServer.pm
@@ -1,8 +1,7 @@
-#!/usr/bin/perl -w
-
 package HTTPServer;
 
 use strict;
+use warnings;
 
 use HTTP::Daemon;
 use HTTP::Status;
@@ -23,11 +22,12 @@ sub run {
         if (!$initialized) {
             $synch_callback->();
             $initialized = 1;
-        }        
+        }
         my $con = $self->accept();
         print STDERR "Accepted a new connection\n" if $log;
         while (my $req = $con->get_request) {
-            my $url_path = $req->url->path;
+            #my $url_path = $req->url->path;
+            my $url_path = $req->url->as_string;
             if ($url_path =~ m{/$}) { # append 'index.html'
                 $url_path .= 'index.html';
             }
@@ -45,14 +45,14 @@ sub run {
             if (exists($urls->{$url_path})) {
                 print STDERR "Serving requested URL: ", $url_path, "\n" if $log;
                 next unless ($req->method eq "HEAD" || $req->method eq "GET");
-                
+
                 my $url_rec = $urls->{$url_path};
                 $self->send_response($req, $url_rec, $con);
             } else {
                 print STDERR "Requested wrong URL: ", $url_path, "\n" if $log;
                 $con->send_error($HTTP::Status::RC_FORBIDDEN);
                 last;
-            }            
+            }
         }
         print STDERR "Closing connection\n" if $log;
         $con->close;
@@ -68,6 +68,9 @@ sub send_response {
     if (exists $url_rec->{'auth_method'}) {
         ($send_content, $code, $msg, $headers) =
             $self->handle_auth($req, $url_rec);
+    } elsif (!$self->verify_request_headers ($req, $url_rec)) {
+        ($send_content, $code, $msg, $headers) =
+            ('', 400, 'Mismatch on expected headers', {});
     } else {
         ($code, $msg) = @{$url_rec}{'code', 'msg'};
         $headers = $url_rec->{headers};
@@ -210,6 +213,22 @@ sub verify_auth_basic {
     }
 }
 
+sub verify_request_headers {
+    my ($self, $req, $url_rec) = @_;
+
+    return 1 unless exists $url_rec->{'request_headers'};
+    for my $hdrname (keys %{$url_rec->{'request_headers'}}) {
+        my $rhdr = $req->header ($hdrname);
+        my $ehdr = $url_rec->{'request_headers'}{$hdrname};
+        unless (defined $rhdr && $rhdr =~ $ehdr) {
+            print STDERR "\n*** Mismatch on $hdrname: $rhdr =~ $ehdr\n";
+            return undef;
+        }
+    }
+
+    return 1;
+}
+
 sub _substitute_port {
     my $self = shift;
     my $ret = shift;