NEWS: cite --start-pos

[wget] / tests / HTTPServer.pm

diff --git a/tests/HTTPServer.pm b/tests/HTTPServer.pm
index e3c38e6f5f02c31a580813591b6e21a2726a6dc2..065ea1ed87250c0c6769132ad53f721c4f58ddca 100644 (file)
--- a/tests/HTTPServer.pm
+++ b/tests/HTTPServer.pm
@@ -26,7 +26,8 @@ sub run {
         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';
             }
@@ -67,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};
@@ -119,7 +123,7 @@ sub send_response {
             next;
         }
         # fill in content
-        $content = $self->_substitute_port($content);
+        $content = $self->_substitute_port($content) if defined $content;
         $resp->content($content);
         print STDERR "HTTP::Response with content: \n", $resp->as_string if $log;
     }
@@ -209,6 +213,35 @@ 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 $must_not_match;
+        my $ehdr = $url_rec->{'request_headers'}{$hdrname};
+        if ($must_not_match = ($hdrname =~ /^!(\w+)/)) {
+            $hdrname = $1;
+        }
+        my $rhdr = $req->header ($hdrname);
+        if ($must_not_match) {
+            if (defined $rhdr && $rhdr =~ $ehdr) {
+                $rhdr = '' unless defined $rhdr;
+                print STDERR "\n*** Match forbidden $hdrname: $rhdr =~ $ehdr\n";
+                return undef;
+            }
+        } else {
+            unless (defined $rhdr && $rhdr =~ $ehdr) {
+                $rhdr = '' unless defined $rhdr;
+                print STDERR "\n*** Mismatch on $hdrname: $rhdr =~ $ehdr\n";
+                return undef;
+            }
+        }
+    }
+
+    return 1;
+}
+
 sub _substitute_port {
     my $self = shift;
     my $ret = shift;