Script for producing a pf.conf for jail traffic NAT/redirection

jailnet.pl

#!/usr/bin/env perl

# blog: http://localhost:8000/blog/2014/blog/2014-12-31-using-warden-to-setup-jails-in-freebsd.html

use strict;
use warnings;
use v5.10; # because we use some new stuff
use feature qw(say);

my $card = 're0';
my $opt_file = "/etc/pf/jails.options.conf";
my $nat_file = "/etc/pf/jails.translation.conf";

my %ips = ();
my %ports = ();

# Parses an input string containing the port list the format of the
# list is:
# 'proto':port[-portend][/jail_port[-jail_port_end]]
#
# If portend is given, function will return all ports in range port to
# portend If jail_port is given, function will return values that
# notify the caller that translation should map host ports port to
# portend (on host) to jail_port to jail_port_end (on jail)
#
# jail_port_end might be omitted, in which case all input ports will
# map to a single port. If jail_port_end is '*', there will be a
# one-to-one mapping from the range of ports on host to the range of
# ports on jail, starting with 'port' and 'jail_port'.
#
# This function returns a reference to a hash whose key '$proto'
# contains a hash whose keys are the ports that translate to the same
# ports on the host. The returned hash reference might also contain
# another key, '${proto}_special' that describes port mapping through
# a hash whose keys represent host ports, while values represent host
# ports.
sub get_ports($$) {
  my ($proto, $ports) = @_;
  my @ports = map { s/$proto://; $_ }
              grep { /$proto:/ }
              split /,\s*/, $ports;

  my %out = ();
  foreach my $port (@ports) {
    my ($rangeh, $rangej) = split /\//, $port;
    $rangej = $rangej // $rangeh;
    $rangeh =~ tr/-/:/;
    $rangej =~ tr/-/:/;

    say STDERR "comparing '$rangeh' to '$rangej'";
    $out{$proto . ($rangeh eq $rangej?'':'_special')}->{$rangeh} = $rangej;
  }
  return \%out;
}

# Prints the option part of pf.conf
# This function creates variables 'jail_proto_ports' containing the
# list of ports that will be used verbatim on host, and a list of pairs of
# variables named 'jail_proto_ports_JX'/'jail_proto_ports_HX', where X
# is a number, which represents pairings of ports used on the jail and
# on the host, respectively.
sub print_opt($$$$) {
  my ($fout, $JN, $proto, $ports) = @_;
  my @normal = keys %{$ports->{$proto}};
  my $special = $ports->{$proto . '_special'} // {};
  say $fout qq(${JN}_\U$proto\E_PORTS="{) . (join ',', @normal) . qq(}") if 0+@normal;
  my $cnt = 0;
  foreach my $port (keys %$special) {
    $cnt++;
    say $fout qq(${JN}_\U$proto\E_PORTS_H${cnt}="$port");
    say $fout qq(${JN}_\U$proto\E_PORTS_J${cnt}=") . $special->{$port} . qq(");
  }
  return (0+@normal, $cnt);
}

while (<>) {
  # skip comments
  next if /^#/;
  chomp;
  my ($jail, $ports) = split /;\s*/;
  $ips{$jail} = `warden get ipv4 $jail`;
  chomp($ips{$jail});
  print STDERR "JAIL: $jail -> $ips{$jail}\n";
  my $udp_ports = get_ports('udp', $ports);
  my $tcp_ports = get_ports('tcp', $ports);
  $ports{$jail} = { %$udp_ports, %$tcp_ports };
}

print STDERR "Writing data to output files\n";
open my $fopt, '>', $opt_file or die "Can't write to $opt_file: $!";
open my $fnat, '>', $nat_file or die "Can't write to $nat_file: $!";

foreach my $jail (keys %ips) {
  my $JN = uc($jail);
  say $fopt qq(${JN}_IP="$ips{$jail}");

  my (%ok, %cnt);
  ($ok{udp}, $cnt{udp}) = print_opt($fopt, $JN, 'udp', $ports{$jail});
  ($ok{tcp}, $cnt{tcp}) = print_opt($fopt, $JN, 'tcp', $ports{$jail});

  say $fnat qq,nat on $card from \$${JN}_IP to any -> ($card),;
  foreach my $proto (qw(udp tcp)) {
    say $fnat qq,rdr on $card inet proto $proto from any to port \$${JN}_\U$proto\E_PORTS -> \$${JN}_IP, if $ok{$proto};
    foreach my $c (1..$cnt{$proto}) {
      say $fnat qq,rdr on $card inet proto $proto from any to port \$${JN}_\U$proto\E_PORTS_H$c -> \$${JN}_IP port \$${JN}_\U$proto\E_PORTS_J$c,;
    }
  }
}

close $fopt or die "Can't close $fopt: $!\n";
close $fnat or die "Can't close $fnat: $!\n";