Expose a Qubes AppVM port to the public networks.

qvm-expose-port

#!/usr/bin/env perl
use strict;
use warnings;
use Pod::Usage;
use IPC::Open3;
use Getopt::Long;
use File::Basename;
use constant { True => 1, False => 0 };
use Symbol 'gensym';
$|=1;                           #unbuffered

#
#: Globals
#

our $SCRIPT_NAME = basename($0,'.pl');

#
#: ARGV
#

my $USAGE = False;
my $HELP = False;
my $MAN = False;
my $DEBUG = False;
my $DUMPIT = False;
my $SIMULATE = False;
GetOptions
  ( 'h|?' => \$USAGE,
    'help' => \$HELP,
    'man' => \$MAN,
    'v|verbose' => \$DEBUG,
    'd|dumpit' => \$DUMPIT,
    's|simulate' => \$SIMULATE,
  ) or pod2usage(-verbose=>0);
pod2usage(-verbose=>0) if $USAGE;
pod2usage(-verbose=>1) if $HELP;
pod2usage(-verbose=>2) if $MAN;
pod2usage(-verbose=>0) if @ARGV != 2;

#
#: Initializatons
#

our ($SRC_DOMAIN,$SRC_PORT) = @ARGV;
our (%QUBES_INFO) = get_qubes_vm_info();
our (@QUBES_DOMS) = sort keys %QUBES_INFO;
stdout("Gathering ifconfig for: ".$SRC_DOMAIN);
our (%SRC_IFINFO) = get_ifconfig($SRC_DOMAIN);
stdout("\n");

if ($DUMPIT) {
  Dumper(\%QUBES_INFO);
  exit 0;
}

#
#: Main logic
#

if (defined $QUBES_INFO{$SRC_DOMAIN}) {
  my $dom = $QUBES_INFO{$SRC_DOMAIN};
  $dom->{ifinfo} = \%SRC_IFINFO;
  stdout("Exposing port ".$SRC_PORT." on ".$SRC_DOMAIN." to the external network.\n");
  my $netvm = $dom->{netvm};
  if ($netvm && $netvm ne "None") {
    my @vmchains = ($dom);
    while ($netvm && $netvm ne "n/a") {
      $dom = $QUBES_INFO{$netvm};
      my %ii = get_ifconfig($netvm);
      $dom->{ifinfo} = \%ii;
      $netvm = $dom->{netvm};
      push(@vmchains,$dom);
    }
    # we have a list of the vm chain, in reverse order
    my @vmchains_r = reverse @vmchains;
    my $first = 0;
    my $last = @vmchains_r - 1;
    for (my $i=0;$i<@vmchains_r;$i++) {
      my $v = $vmchains_r[$i];
      my $p = ($i>0) ? $vmchains_r[$i-1] || undef : undef;
      my $n = $vmchains_r[$i+1] || undef;
      stdout("processing[".$i."]: ".$v->{name}." (p=".($p?$p->{name}:'none').",n=".($n?$n->{name}:'none').")"."\n");
      if ($i == $first) {
        # sys-net
        my $gwif = defined $n ?find_gw_iface($n->{ip},$v->{ifinfo}):undef;
        do_iptables_first_node($v,$n,$SRC_PORT,$gwif);
      } elsif ($i == $last) {
        # appvm - open the port, allow the traffic
        do_iptables_last_node($v,$p,$SRC_PORT);
      } else {
        # middles, these should all be of ProxyVM type
        my $gwif = defined $n ?find_gw_iface($n->{ip},$v->{ifinfo}):undef;
        do_iptables_middle_node($v,$n,$SRC_PORT,$gwif);
      }
    }
  } else {
    die "Not sure what to do here captin.\n";
  }
} else {
  stderr("Given domain not found: ".$SRC_DOMAIN."\n");
}
stdout("processing complete.\n");
exit(0);

#
#: Qubes-Specifc Functions
#

sub do_enable_ip_forward {
  my $appvm = shift;
  my $rv = qvm_run($appvm,"(echo 1 > /proc/sys/net/ipv4/ip_forward) 2>/dev/null");
  debug("\tip_forward enabled for: ".$appvm."\n");
}

sub do_enable_rp_filter {
  my ($appvm, $iface) = @_;
  my $rv = qvm_run($appvm,"(echo 2 > /proc/sys/net/ipv4/conf/".$iface."/rp_filter) 2>/dev/null");
  debug("\trp_filter enabled for: ".$appvm." on ".$iface."\n");
}

sub do_iptables_last_node {
  my ($v,$p,$port) = @_;
  foreach my $proto ("tcp","udp") {
    do_iptables
      ( $v->{name},
        "-I","INPUT","5",
        "-d",$v->{ip}.'/32',
        "-p",$proto,
        "-m",$proto,
        "--dport",$port,
        "-m","conntrack",
        "--ctstate","NEW",
        "-j","ACCEPT"
      );
  }
}

sub do_iptables_middle_node {
  my ($v,$n,$port,$gwif) = @_;
  do_enable_ip_forward($v->{name});
  my $iface = $v->{iface};
  if (ref($v->{iface}) eq "ARRAY") {
    my (@ifs) = grep { !m!^vif! } @{$v->{iface}};
    if (@ifs == 1) {
      $iface = $ifs[0];
    } else {
      stderr("ERR: Too many interfaces for middle hop? ".join(",",$v->{iface})."\n");
      return;
    }
  }
  foreach my $proto ("tcp","udp") {
    do_iptables
      ( $v->{name},
        "-t","nat",
        "-A","PREROUTING",
        "-d",$v->{ip}.'/32',
        "-i",$iface,
        "-p",$proto,
        "-m",$proto,
        "--dport",$port,
        "-j","DNAT",
        "--to-destination",$n->{ip}.':'.$port
      );
    do_iptables
      ( $v->{name},
        "-I","FORWARD","2",
        "-d",$n->{ip}.'/32',
        "-i",$iface,
        "-p",$proto,
        "-m",$proto,
        "--dport",$port,
        "-m","conntrack",
        "--ctstate","NEW",
        "-j","ACCEPT"
      );
  }
}
sub cmp_ip_in_range {
  my ($l,$r) = @_;
  my $left = '';
  $left = $1 if $l =~ m!^(\d+\.\d+\.\d+)\.\d+$!;
  my $right = '';
  $right = $1 if $r =~ m!^(\d+\.\d+\.\d+)\.\d+$!;
  return $left eq $right;
}
sub find_gw_iface {
  my ($addr,$ifaces) = @_;
  my (@ifkeys) = sort keys %{$ifaces};
  foreach my $ifkey (@ifkeys) {
    my $if = $ifaces->{$ifkey};
    if (cmp_ip_in_range($addr,$if->{address})) {
      return $ifkey, $if if wantarray;
      return $if;
    }
  }
  return undef;
}
sub do_iptables_first_node {
  my ($v,$n,$port,$gwif) = @_;
  my $hex = sprintf("0x%x",$port);
  do_enable_ip_forward($v->{name});
  do_enable_rp_filter($v->{name},"all");
  my $ip_rule_list = qvm_run_always( $v->{name},'ip rule list | grep "fwmark '.$hex.' lookup '.$port.'" 2>&1');
  if ($ip_rule_list eq "") {
    qvm_run
      ( $v->{name},
        "ip","rule","add",
        "priority","10",
        "fwmark",$hex,
        "table",$port
      );
    qvm_run
      ( $v->{name},
        "ip","route","add",
        "default","via",$gwif->{address},
        "table",$port
      );
  } else {
    debug("Found existing ip rule with fwmark ${hex} table ${port}\n");
  }
  foreach my $ifkey (keys %{$v->{ifinfo}}) {
    my $if = $v->{ifinfo}->{$ifkey};
    next unless $ifkey =~ m!^(?:wlp|enp|wlan|eth)!;
    unless (exists $if->{address} && $if->{address} && $if->{address} ne "None") {
      stdout("Ignoring ".$ifkey.": no address assigned.\n");
      next;
    }
    foreach my $proto ("tcp","udp") {
      my $rv = do_iptables
        ( $v->{name},
          "-t","nat",
          "-A","PREROUTING",
          "-d",$if->{address}.'/32',
          "-i",$ifkey,
          "-p",$proto,
          "-m",$proto,
          "--dport",$port,
          "-j","DNAT",
          "--to-destination",$n->{ip}.':'.$port
        );
      do_iptables
        ( $v->{name},
          "-I","FORWARD","2",
          "-d",$n->{ip}.'/32',
          "-i",$ifkey,
          "-p",$proto,
          "-m",$proto,
          "--dport",$port,
          "-m","conntrack",
          "--ctstate","NEW",
          "-j","ACCEPT"
        );
      do_iptables
        ( $v->{name},
          "-t","mangle",
          "-A","OUTPUT",
          "-p",$proto,
          "-m",$proto,
          "--sport",$port,
          "-m","conntrack",
          "--ctstate","DNAT",
          "--ctorigdst",$gwif->{address},
          "-j","MARK",
          "--set-xmark", $hex."/0xffffffff"
        );
    }
  }
}

sub do_iptables {
  my $appvm = shift;
  my $v = $QUBES_INFO{$appvm};
  my $r = $v->{rules};
  my ($c,$args);
  $c = $args = join(" ",@_);
  $c =~ s!^\-t (?:nat|mangle) !!;
  $c =~ s!^\-I ([a-zA-Z0-9]+) (?:\d+?\s+)??!\-A $1 !;
  $c =~ s!(INPUT|FORWARD) \d+ !$1 !;
  if ($r =~ m!\Q${c}\E!msg) {
    stdout("\tRule exists[${appvm}]: \"${args}\"\n");
    return;
  } else {
    stdout("\tAdding rule[${appvm}]: \"${args}\"\n");
  }
  return qvm_run($appvm,'iptables',@_);
}

sub get_qubes_vm_info {
  stdout("Gathering qubes info...");
  my %info = ();
  my $raw_list = `qvm-ls --raw-data name type netvm ip 2>/dev/null`;
  my (@lines) = split(m/\n/,$raw_list);
  foreach my $line (@lines) {
    stdout(".");                # progress
    my ($raw_name,$raw_type,$raw_netvm,$ip) = split(m/\|/,$line);
    my $name = $raw_name;
    $name =~ s/[^-_a-zA-Z0-9]//g;
    my $netvm = $raw_netvm;
    $netvm =~ s/^\*//;
    next if $name =~ m!^(?:dom0)$!;
    my %ii = get_ifconfig($name);
    my @ifs = keys %ii;
    $info{$name} =
      { 'raw_name' => $raw_name,
        'name' => $name,
        'type' => $raw_type,
        'netvm' => $netvm,
        'ip' => $ip,
        'ifinfo' => \%ii,
        'iface' => @ifs == 1 ? $ifs[0] : \@ifs,
        'rules' => get_iptables($name),
      };
  }
  stdout("\n");
  return %info;
}

sub get_iptables {
  my ($appvm) = @_;
  my $raw = `qvm-run --pass-io -u root ${appvm} iptables-save 2>&1`;
  return $raw;
}

sub get_ifconfig {
  my ($appvm) = @_;
  my $raw_ifconfig = `qvm-run --pass-io -u root ${appvm} ifconfig 2>&1`;
  my (%iface_blocks) = $raw_ifconfig =~ m!^([a-z][.a-z0-9]+?)\:??(\s*(?:Link|flags).+?\n\n)!msg;
  my %ifconfig = ();
  foreach my $iface (keys %iface_blocks) {
    next if $iface =~ m!^(docker\d+|lo)$!;
    my $v = $iface_blocks{$iface};
    my ($encap) = $v =~ m!(?:Link encap\:|flags=)(.+?)\s!ms;
    my ($mac) = $v =~ m!(?:HWaddr|ether) (\d.+?)\s!ms;
    my ($addr) = $v =~ m!(?:inet addr\:|inet )(\d.+?)\s!ms;
    my ($bcast) = $v =~ m!(?:Bcast\:|broadcast )(\d.+?)\s!ms;
    my ($mask) = $v =~ m!(?:Mask\:|netmask )(\d.+?)\s!ms;
    $ifconfig{$iface} =
      { 'address' => $addr || '',
        'broadcast' => $bcast || '',
        'netmask' => $mask || '',
        'mac' => $mac,
        'flags' => $encap,
        'iface' => $iface
      };
  }
  return %ifconfig;
}

#
#: Core Qubes Management Functions
#

sub qvm_run_always {
  return always_execute_command("qvm-run","--pass-io","-u","root",shift,"'".join(" ",@_)."'");
}

sub qvm_run {
  return execute_command("qvm-run","--pass-io","-u","root",shift,"'".join(" ",@_)."'");
}

sub execute_command {
  if ($SIMULATE) {
    debug("[SIM]: ".join(" ",@_)."\n");
    return '';
  }
  return always_execute_command(@_);
}

sub always_execute_command {
  my $cmd = join(" ",@_);
  debug("[CMD]: ".$cmd."\n");
  open(my $fh,$cmd.' |')
    or die "Failed to open \"${cmd}\" for reading: $!\n";
  my $out = '';
  while (<$fh>) {
    $out .= $_;
  }
  return $out;
}

#
#: Functions
#

sub Dumper {
  foreach my $in (@_) {
    stderr(DumpItem_R(0,$in));
  }
}

sub DumpItem_R {
  my ($lvl,$in) = @_;
  my $out = '';
  my $pad = "  ";
  my $margin = $pad x $lvl;
  my $rf = ref($in);
  if ($rf eq "HASH") {
    $out .= $margin."{\n";
    foreach my $k (keys %{$in}) {
      $out .= $margin.$pad."'".$k."' => ".DumpItem_R($lvl+1,$in->{$k})."\n";
    }
    $out .= $margin."},\n";
  } elsif ($rf eq "ARRAY") {
    $out .= $margin."[\n";
    foreach my $v (@{$in}) {
      $out .= $margin.$pad.DumpItem_R($lvl+1,$v)."\n";
    }
    $out .= $margin."],\n";
  } else {
    $out .= '"'.(defined $in ? $in : '').'",';
  }
  return $out;
}

sub stderr {
  print STDERR shift while @_;
}

sub debug {
  return unless $DEBUG;
  stderr(@_);
}

sub stdout {
  print STDOUT shift while @_;
}

__END__

=head1 NAME

qvm-expose-port - Expose a Qubes AppVM port to the public networks.

=head1 SYNOPSIS

qvm-expose-port [-h|--help|--man] [-v|-d|-s] <appvm> <port>

=head1 OPTIONS

   -h -?              brief usage message
   --help             help message
   --man              full manual page
   -v --verbose       more output during operation
   -d --dumpit        dump information and exit
   -s --simulate      everything non-invasive, implies -v

=head1 DESCRIPTION

Given a port and AppVM domain, setup B<iptables> rules for all NetVMs
until the public network is reached.

All public interfaces (with assigned IPv4 addresses) will have their
IP tables adjusted to allow for the port forwarding rules to function
regardless of inbound interface.

 Internet
  ^
  |
  `-> Router
       ^ ^
       | |
       | `-- lan0 --\
       |             > [QubesOS] sys-net <-> sys-firewall <-> appvm
       `---- lan1 --/

In the above diagram, regardless of the port forwarding setup on the
router (meaning regardless of lan0 or lan1 being the mapped path),
the port will be forwarded all the way into the appvm and back all
the way out through the interface it came in on.

As an added bonus, extra efforts have been taken to try and ensure that
at no point are IP tables rules being duplicated. While this logic is not
fool-proof, it does try it's best to be helpful and not clobber the tables.

=head1 OPTIONS

=over 4

=item B<-h|-?|--help|--man>

Display helpful screens of information like this one.

=item B<-v|--verbose>

More information is output, only really useful for debugging purposes.

=item B<-d|--dumpit>

More debugging information.

=item B<-s|--simulate>

Perform all the options and procedures without actually doing any of the
invasive operations (such as actually settings iptables rules and so on).

=back

=head1 INSTALLATION

This script is fully self-contained with the exception of external tools
such as B<qvm-ls>, B<qvm-run>, B<iptables> and B<ip>. Simply transfer this
script to your Qubes-OS B<dom0>, make it executable and run! There are no
dependencies not already present in a default Qubes-OS installation.

=head1 SEE ALSO

=over 4

=item https://www.qubes-os.org/doc/firewall

=item https://serverfault.com/questions/584374/reply-on-the-same-interface-as-incoming-with-dnated-ip

=item http://ipset.netfilter.org/iptables.man.html

=item http://man7.org/linux/man-pages/man8/ip-rule.8.html

=back

=head1 CHANGELOG

=head2 2017-09-08

=over 4

=item Add support for Debian based NetVM (interface naming conventions)

=back

=head1 COPYRIGHT

 qvm-expose-port - Expose a Qubes AppVM port to the public networks.
 Copyright (C) 2017  Kevin C. Krinke <kevin@krinke.ca>

 This library is free software; you can redistribute it and/or
 modify it under the terms of the GNU Library General Public
 License as published by the Free Software Foundation; specifically
 version 2.1 of the License and no other version.

 This library is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 Library General Public License for more details.

 You should have received a copy of the GNU Library General Public
 License along with this library; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

=cut

Any chance this can be updated for Qubes-os 4.0 ? NFT is used along side iptables.