Short Perl script to sanitize haproxy.config files

sanitize-haproxy-config.pl

#!/bin/perl

# This script expects an haproxy.config file on standard input and writes out a
# "sanitized" haproxy.config file to standard output where potentially sensitive
# information has been replaced with sanitized values.  At the end of the
# output, the script lists the substitutions that it performed.
#
# Specifically, this script sanitizes the following things:
#
# • backend names,
# • server names,
# • cookie names, and
# • cookie values.
#
# For example, consider the following backend:
#
# backend be_edge_http:myapp:mynamespace
#   cookie db40246ac77b3ee80d2a329822bb503c insert indirect nocache httponly secure attr SameSite=None
#   server pod:mypod1:myapp::10.1.2.3:8080 10.1.2.3:8080 cookie 925505b78b32b6aaa45f10a2cf138386 weight 256 check inter 5000ms
#   server pod:mypod2:myapp::10.4.5.6:8080 10.4.5.6:8080 cookie 71b8f83e20c3722b0387b8dcc39adf0f weight 256 check inter 5000ms
#
# If the script read in the above backend, it would sanitize it to look like the
# following:
#
# backend backend1
#   cookie cookie-name1 insert indirect nocache httponly secure attr SameSite=None
#   server server1 10.254.144.30:22195 cookie cookie1 weight 256 check inter 5000ms
#   server server2 10.254.180.17:22195 cookie cookie2 weight 256 check inter 5000ms
#
# Note that each potentially sensitive string is substituted by a pseudonym.
# For example, the string "pod:mypod1:myapp::10.1.2.3:8080" is replaced with the
# pseudonym "server1" so as to obscure potentially sensitive names.  If the same
# name occurs more than once in the input, this script substitutes the same
# pseudonym for each occurrence in the output.  At the end of the output, the
# script outputs a list of substitutions in the following format:
#
# backend:be_edge_http:myapp:mynamespace → backend1
# cookie-name:db40246ac77b3ee80d2a329822bb503c → cookie-name1
# cookie-value:925505b78b32b6aaa45f10a2cf138386 → cookie-value1
# cookie-value:71b8f83e20c3722b0387b8dcc39adf0f → cookie-value2
# server:pod:mypod1:myapp::10.1.2.3:8080 → server1
# server:pod:mypod2:myapp::10.4.5.6:8080 → server2


# substitutions maps thing:name to pseudonym.  There's no need to assign
# pseudonyms for the standard backends and frontends, so prefill the map with
# those.  The sanitize function fills the table out with generated pseudonyms
# as it reads the input haproxy.config.
my %substitutions = (
    "backend:be_sni"            => "be_sni",
    "backend:be_no_sni"         => "be_no_sni",
    "backend:openshift_default" => "openshift_default",
    "server:fe_no_sni"          => "fe_no_sni",
    "server:fe_sni"             => "fe_sni",
);

# things maps thing to number of instances of the thing read in so far.
my %things;

# make_pseudonym generates pseudonyms like thing1, thing2, thing3, and so on.
sub make_pseudonym {
    my ($thing) = @_;
    $thing . ++$things{$thing}
}

# sanitize returns a pseudonym (e.g., "thing1") for the thing with the given
# name.  If the name has been sanitized and assigned a pseudonym before, then
# the same pseudonym is returned again.
sub sanitize {
    my ($thing, $name) = @_;
    my $idx = $thing.":".$name;
    $substitutions{$idx} //= make_pseudonym($thing)
}

# Read in, sanitize, and write out line by line.
while (<>) {
    if ($_ =~ /^backend (.*)/) {
        my $backend = sanitize("backend", $1);
        print "backend $backend\n";
    } elsif ($_ =~ /^  cookie (.*?) (.*)/) {
        my $cookie_name = sanitize("cookie-name", $1);
        print "  cookie $cookie_name $2\n";
    } elsif ($_ =~ /^  server (.*?) (.*)/) {
        my $server_name = sanitize("server", $1);
        my $rest = $2;
        if ($rest =~ /(.*?) cookie (.*?) (.*)/) {
            my $cookie_value = sanitize("cookie-value", $2);
            print "  server $server_name $1 cookie $cookie_value $3\n";
        } else {
            print "  server $server_name $rest\n";
        }
    } else {
        print;
    }
}

print "\n\n".("="x79)."\n\nThe following substitutions were made:\n\n";

# Sort keys lexically by the prefix and then numerically by the suffix
# using a Schwartzian transform.
my @keys = map { $_->[0] }
           sort { $a->[1] cmp $b->[1] || $a->[2] <=> $b->[2] }
           map { [$_, $substitutions{$_} =~ /^(\D+)(\d*)$/] }
           keys %substitutions;
print "$_ → $substitutions{$_}\n" foreach (@keys);

0;