Feature/server tokens

doc/service-parameters.txt

@@ -91,6 +91,11 @@ For all services:
 |                           |    |                     |where trusted means their  |
 |                           |    |                     |X-Forwarded-For/etc headers|
 |                           |    |                     |are not munged.            |
+|---------------------------+----+---------------------+---------------------------|
+|                           |    |                     |Whether to provide a       |
+|server_tokens              |bool|true                 |'Server' header in the     |
+|                           |    |                     |headers that are sent back |
+|                           |    |                     |to the user                |
 +----------------------------------------------------------------------------------+
 
 Only for 'reverse_proxy' services:

lib/Perlbal/ClientHTTPBase.pm

@@ -541,7 +541,7 @@ sub _serve_request {
 
         # now set whether this is keep-alive or not
         $res->header("Date", HTTP::Date::time2str());
-        $res->header("Server", "Perlbal");
+        $res->header("Server", "Perlbal") if $self->{service}{server_tokens};
         $res->header("Last-Modified", $lastmod);
 
         if (-f _) {
@@ -708,7 +708,7 @@ sub _serve_request_multiple_poststat {
     }
 
     $res->header("Date", HTTP::Date::time2str());
-    $res->header("Server", "Perlbal");
+    $res->header("Server", "Perlbal") if $self->{service}{server_tokens};
     $res->header("Last-Modified", $lastmod);
     $res->header("Content-Type",   $mime);
     # has to happen after content-length is set to work:
@@ -852,7 +852,7 @@ sub _simple_response {
         $res->header('Content-Length', length($body));
     }
 
-    $res->header('Server', 'Perlbal');
+    $res->header('Server', 'Perlbal') if $self->{service}{server_tokens};
 
     $self->setup_keepalive($res);
 
@@ -899,7 +899,7 @@ sub send_full_response {
         $res->header('Content-Length', length($$bref));
     }
 
-    $res->header('Server', 'Perlbal'); # Tunable?
+    $res->header('Server', 'Perlbal') if $self->{service}{server_tokens};
     # $res->header('Date', # We should do this
 
     $self->setup_keepalive($res, $options->{persist_client});

lib/Perlbal/Manual/Internals.pod

@@ -1009,6 +1009,11 @@ Comma-separated seconds (full or partial) to delay between retries.
 Milliseconds of latency to add to request.
 
 
+=item server_tokens
+
+Boolean; whether to provide a "Server" header.
+
+
 =item _stat_requests
 
 Total requests to this service.

lib/Perlbal/Manual/ReverseProxy.pod

@@ -310,6 +310,14 @@ What path the OPTIONS request sent by C<verify_backend> should use.
 
 Default is C<*>.
 
+=item B<server_tokens> = bool
+
+Whether to provide a "Server" header.
+
+Perlbal by default adds a header to all replies (such as the web_server role). By setting this default to "off", you can prevent Perlbal from identifying itself.
+
+Default is C<on>.
+
 =back
 
 

lib/Perlbal/Manual/WebServer.pod

@@ -107,6 +107,14 @@ If PUT requests are enabled, require this many levels of directories to already
 
 Default is 0.
 
+=item B<server_tokens> = bool
+
+Whether to provide a "Server" header.
+
+Perlbal by default adds a header to all replies (such as the web_server role). By setting this default to "off", you can prevent Perlbal from identifying itself.
+
+Default is C<on>.
+
 
 =back
 

lib/Perlbal/Service.pm

@@ -101,6 +101,7 @@ use fields (
             'enable_error_retries',  # bool: whether we should retry requests after errors
             'error_retry_schedule',  # string of comma-separated seconds (full or partial) to delay between retries
             'latency',               # int: milliseconds of latency to add to request
+            'server_tokens',         # bool: whether to provide a "Server" header
 
             # stats:
             '_stat_requests',       # total requests to this service
@@ -611,6 +612,12 @@ our $tunables = {
         check_role => '*',
     },
 
+    'server_tokens' => {
+        des        => 'Whether to provide a "Server" header.',
+        check_role => '*',
+        check_type => 'bool',
+        default    => 1,
+    },
 
 };
 sub autodoc_get_tunables { return $tunables; }

t/13-server-tokens.t

@@ -0,0 +1,56 @@
+#!/usr/bin/perl
+
+use strict;
+use Perlbal::Test;
+
+use Test::More tests => 13;
+require HTTP::Request;
+
+# Build conf files
+my $dir   = tempdir();
+my @confs = (
+    [ new_port() => sub { my $port = shift; qq{
+        CREATE SERVICE test
+        SET role           = web_server
+        SET listen         = 127.0.0.1:$port
+        SET docroot        = $dir
+        SET server_tokens  = on
+        ENABLE test
+    } } ],
+
+    [ new_port() => sub { my $port = shift; qq{
+        CREATE SERVICE test
+        SET role           = web_server
+        SET listen         = 127.0.0.1:$port
+        SET docroot        = $dir
+        SET server_tokens  = off
+        ENABLE test
+    } } ],
+);
+
+my $count = 0;
+foreach my $pair (@confs) {
+    my $port  = $pair->[0];
+    my $conf  = $pair->[1]->($port);
+    my $msock = start_server($conf);
+    ok($msock, "manage sock");
+    my $ua = ua();
+    ok($ua, "ua");
+
+    my $req = HTTP::Request->new( GET => "http://127.0.0.1:$port/" );
+    my $res = $ua->request($req);
+
+    ok( $res, 'Got result' );
+    isa_ok( $res, 'HTTP::Response' );
+    ok( $res->is_success, 'Result is successful' );
+
+    if ( $count++ == 0 ) {
+        # check it's on
+        ok( $res->header('Server'), 'Server header exists' );
+        is( $res->header('Server'), 'Perlbal'              );
+    } else {
+        # check it's off
+        ok( ! $res->header('Server'), 'Server header missing' );
+    }
+}
+