#! /usr/bin/perl -w
#
# Copyright (c) 2014-2025 Tore Anderson <tore@fud.no>
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to deal
# in the Software without restriction, including without limitation the rights
# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.
#
# See the file 'README.pod' in the source distribution or the manual page
# clatd(8) for more information.
#
use strict;
use IPC::Cmd qw(can_run);
use Net::IP;

my $VERSION = "2.1.0";

#
# Populate the global config hash with the default values
#
my %CFG;
$CFG{"quiet"} = 0;			# suppress normal output
$CFG{"debug"} = 0;			# debugging output level
$CFG{"script-up"} = undef;		# sh script to run when starting up
$CFG{"script-down"} = undef;		# sh script to run when shutting down
$CFG{"clat-dev"} = "clat";		# TUN interface name to use
$CFG{"clat-v4-addr"} = "192.0.0.1";	# from RFC 7335
$CFG{"clat-v6-addr"} = "shared";	# re-use primary address from host OS
$CFG{"dns64-servers"} = undef;		# use system resolver by default
$CFG{"cmd-ip"} = "ip";			# assume in $PATH
$CFG{"cmd-networkctl"} = "networkctl";	# assume in $PATH
$CFG{"cmd-nft"} = "nft";		# assume in $PATH
$CFG{"cmd-tayga"} = "tayga";		# assume in $PATH
$CFG{"cmd-ufw"} = "ufw";		# assume in $PATH
$CFG{"ctmark"} = undef;			# match ctmark for routing pkts to CLAT
$CFG{"forwarding-enable"} = 1;		# enable ipv6 forwarding?
$CFG{"plat-dev"} = undef;		# PLAT-facing device, default detect
$CFG{"plat-prefix"} = undef;		# detect using DNS64 by default
$CFG{"plat-fallback-prefix"} = undef;	# fallback prefix if no prefix is found
$CFG{"proxynd-enable"} = undef;		# add proxy-nd entry for clat?
$CFG{"route-table"} = 0xc1a7;		# add route to CLAT in this table
$CFG{"tayga-conffile"} = undef;		# make a temporary one by default
$CFG{"tayga-v4-addr"} = "192.0.0.2";	# from RFC 7335
$CFG{"v4-conncheck-enable"} = 1;	# exit if there's already a defroute
$CFG{"v4-conncheck-delay"} = 10;	# seconds before checking for v4 conn.
$CFG{"v4-defaultroute-enable"} = 1;	# add a v4 defaultroute via the CLAT?
$CFG{"v4-defaultroute-replace"} = 0;	# replace existing v4 defaultroute?
$CFG{"v4-defaultroute-metric"} = 2048;	# metric for the IPv4 defaultroute
$CFG{"v4-defaultroute-mtu"} = 1260;	# MTU for the IPv4 defaultroute
$CFG{"v4-defaultroute-advmss"} = 0;	# TCP MSS for the IPv4 defaultroute


#
# helper functions for various modes of output and error handling
#
sub p {
  print join("", @_), "\n" unless($CFG{"quiet"} >= 1);
}
sub d {
  print join("", @_), "\n" if($CFG{"debug"} >= 1);
}
sub d2 {
  print join("", @_), "\n" if($CFG{"debug"} >= 2);
}
sub w {
  print "<warn> ", join("", @_), "\n" unless($CFG{"quiet"} >= 2);
}
sub err {
  print "<error> ", join("", @_), "\n" unless($CFG{"quiet"} >= 2);
  cleanup_and_exit(1);
}


#
# Runs a command. First argument is what subroutine to call to a message if
# the command doesn't exit successfully, second is the command itself, and
# any more are the command line arguments.
#
sub cmd {
  my $msgsub = shift;
  my @cmd = @_;

  d("cmd(@cmd)");

  if(system(@cmd)) {
    if($? == -1) {
      &{$msgsub}("cmd(@cmd) failed to execute");
    } elsif($? & 127) {
      &{$msgsub}("cmd(@cmd) died with signal ", ($? & 127));
    } else {
      &{$msgsub}("cmd(@cmd) returned ", ($? >> 8));
    }
  }
  return $?;
}


#
# Reads in key=value pairs from a configuration file, overwriting the default
# setting in the %CFG hash. The key must exist in the built-in hash, or we
# ignore the setting in the config file.
#
sub readconf {
  d("readconf('@_')");
  open(my $fd, "@_") or err("readconf('@_') failed: $!");
  while(<$fd>) {
    chomp;
    next if m,^\s*(;|#|//|$),; # strip out comments and empty lines
    if(m|^\s*([\w-]+)\s*=\s*(.*)\s*$|) {
      if(!exists($CFG{$1})) {
        w("Unknown key '$1' defined in config file ignored");
      } else {
        $CFG{$1} = $2;
      }
    } else {
      w("Unknown line '$_' in config file ignored");
    }
  }
  close($fd) or err($!);
}


#
# gets a boolean value from the config hash - fails if unset or syntactically
# invalid
#
sub cfgbool {
  my ($key) = @_;
  d2("cfgbool($key)");
  if(!exists($CFG{$key})) {
    err("key '$key' doesn't exist in config hash");
  }
  my $val = lc($CFG{$key});
  return 1 if($val eq "1" or $val eq "true" or $val eq "on" or $val eq "yes");
  return 0 if($val eq "0" or $val eq "false" or $val eq "off" or $val eq "no");
  err("$key: boolean value (1/0/true/false/on/off/yes/no) expected");
}


#
# gets an integer value from the config hash - fails if unset or syntactically
# invalid
#
sub cfgint {
  my ($key) = @_;
  d2("cfgint($key)");
  if(!exists($CFG{$key})) {
    err("key '$key' doesn't exist in config hash");
  }
  my $val = $CFG{$key};
  $val =~ m|^\d+$| or err("$key=$val - integer expected");
  return $val;
}


#
# gets a scalar value from the config hash - fails if unset
#
sub cfg {
  my ($key) = @_;
  d2("cfg($key)");
  if(!exists($CFG{$key})) {
    err("key '$key' doesn't exist in config hash");
  }
  return $CFG{$key};
}


#
# read sysctl in the first argument, or set it to value in second argument
# if provided
#
sub sysctl {
  my ($sysctl, $new_value) = @_;

  $sysctl =~ s|^/proc/sys/||;

  if(defined($new_value)) {
    d("Setting sysctl /proc/sys/$sysctl=$new_value");
    my $fd;
    open($fd, ">/proc/sys/$sysctl");
    if(!defined($fd)) {
      w("Failed to open /proc/sys/$sysctl for writing: $!");
      return;
    }
    print $fd "$new_value\n";
    if(!close($fd)) {
      w("Failed to close /proc/sys/$sysctl after writing: $!");
      return;
    }
    return $new_value;
  } else {
    d("Reading sysctl /proc/sys/$sysctl");
    my $fd;
    open($fd, "/proc/sys/$sysctl");
    if(!defined($fd)) {
      w("Failed to open /proc/sys/$sysctl for reading: $!");
      return;
    }
    my $value = <$fd>;
    chomp($value);
    if(!close($fd)) {
      w("Failed to close /proc/sys/$sysctl after reading: $!");
    }
    d("/proc/sys/$sysctl is set to '$value'");
    return $value;
  }
}


#
# Look for either of the WKAs for ipv4only.arpa (192.0.0.170 and .171) in an
# IPv6 address at all of the locations RFC 6052 says it can occur, starting at
# the longest prefix length. If it's present at any of those locations, return
# the inferred translation prefix.
#
sub find_rfc7050_wka {
  my $AAAA = shift;
  d("check_wka(): Testing to see if $AAAA was DNS64-synthesised");
  my $ip = Net::IP->new($AAAA, 6);
  if(!$ip) {
    w("Net::IP->new($AAAA, 6) failed: ", Net::IP::Error());
    return;
  }

  my %rfc6052table;
  $rfc6052table{"32"}{"mask"} = "0:0:ffff:ffff::";
  $rfc6052table{"32"}{"wkas"} = [qw(0:0:c000:aa:: 0:0:c000:ab::)];
  $rfc6052table{"40"}{"mask"} = "0:0:ff:ffff:ff::";
  $rfc6052table{"40"}{"wkas"} = [qw(0:0:c0:0:aa:: 0:0:c0:0:ab::)];
  $rfc6052table{"48"}{"mask"} = "::ffff:ff:ff00:0:0";
  $rfc6052table{"48"}{"wkas"} = [qw(::c000:0:aa00:0:0 ::c000:0:ab00:0:0)];
  $rfc6052table{"56"}{"mask"} = "::ff:ff:ffff:0:0";
  $rfc6052table{"56"}{"wkas"} = [qw(::c0:0:aa:0:0 ::c0:0:ab:0:0)];
  $rfc6052table{"64"}{"mask"} = "::ff:ffff:ff00:0";
  $rfc6052table{"64"}{"wkas"} = [qw(::c0:0:aa00:0 ::c0:0:ab00:0)];
  $rfc6052table{"96"}{"mask"} = "::ffff:ffff";
  $rfc6052table{"96"}{"wkas"} = [qw(::c000:aa ::c000:ab)];

  my $discovered_pfx_len;

  outer: for my $len (sort {$b <=> $a} keys(%rfc6052table)) {
    d2("Looking for Well-Known Addresses at prefix length /$len");
    my $maskedip = $ip->intip();
    my $mask = Net::IP->new($rfc6052table{"$len"}{"mask"}, 6);
    if(!$mask) {
      w('Net::IP->new(', $rfc6052table{"$len"}{"mask"}, ', 6) failed: ',
        Net::IP::Error());
      return;
    }

    $maskedip &= $mask->intip();

    for my $wka (@{$rfc6052table{"$len"}{"wkas"}}) {
      d2("Looking for WKA $wka");
      my $wkaint = Net::IP->new($wka, 6);
      if(!$wkaint) {
        w("Net::IP->new($wka, 6) failed: ", Net::IP::Error());
        next;
      }

      if($maskedip == $wkaint->intip) {
        d2("Found it!");
        $discovered_pfx_len = $len;
        last outer;
      } else {
        d2("Didn't find it");
      }
    }
  }

  if(!$discovered_pfx_len) {
    d2("Did not locate any WKAs in ", $ip->short);
    return;
  }

  # Yay, we have found a prefix! Zero the host bits manually, as Net::IP-new()
  # unfortunately doesn't accept an address with a prefix length. That would
  # have made the rest of this function so much easier...
  $ip = $ip->intip;
  $ip >>= (128-$discovered_pfx_len);
  $ip <<= (128-$discovered_pfx_len);

  # Now convert that bigint back to an IPv6 address. Net::IP doesn't have
  # a function to convert directly from a bigint to an IPv6 address (or
  # to create a new instance directly from a bigint), so we'll have to take
  # a detour via a binary string...
  my $binip = Net::IP::ip_inttobin($ip, 6);
  unless($binip) {
    w("Failed to convert integer $ip to a binary string");
    return;
  }
  unless($ip = Net::IP::ip_bintoip($binip, 6)) {
    w("Failed to convert binary string $binip to an IPv6 address");
    return;
  }

  # Now make sure we have a valid prefix, and return it in pretty (compact)
  # format
  $ip = Net::IP->new("$ip/$discovered_pfx_len", 6);
  if(!$ip) {
    w("Net::IP->new($ip, 6) failed: ", Net::IP::Error());
    return;
  }

  d("Inferred PLAT prefix ", $ip->short(), "/", $ip->prefixlen(),
    " from AAAA record $AAAA");

  return $ip->short() . "/" . $ip->prefixlen();
}


#
# This function attempts to implement RFC 7050: Discovery of the IPv6 Prefix
# Used for IPv6 Address Synthesis. It tries to infer a PLAT prefix by looking
# up to see if the well-known hostname 'ipv4only.arpa' resolves to an IPv6
# address, if so there is a high chance of DNS64 being used.
#
sub get_plat_prefix_from_dns64 {
  p("Performing DNS64-based PLAT prefix discovery (cf. RFC 7050)");

  require Net::DNS;

  my @dns64_servers = split(",", cfg("dns64-servers") || "");
  my @prefixes;

  while (1) {
    my $dns64 = shift(@dns64_servers);
    my $res;
    if($dns64) {
      d("Looking up 'ipv4only.arpa' using DNS64 server $dns64");
      $res = Net::DNS::Resolver->new(nameservers => [$dns64]);
    } else {
      d("Looking up 'ipv4only.arpa' using system resolver");
      $res = Net::DNS::Resolver->new();
    }
    $res->dnssec(0); # RFC 7050 section 3

    # Force use of AF_INET6 socket with IPv4-mapped addresses when querying
    # an IPv4 name server (e.g., systemd-resolved listening on 127.0.0.53).
    # This works around https://rt.cpan.org/Public/Bug/Display.html?id=158714
    # (and/or https://rt.cpan.org/Public/Bug/Display.html?id=132760).
    $res->nameservers(map {
      Net::IP->new($_)->version() == 4 ? "::ffff:$_" : $_;
    } $res->nameservers);
    d2("Nameservers after Net::DNS bug workaround: ",
       join(" ", $res->nameservers));

    my $pkt = $res->query('ipv4only.arpa', 'AAAA');
    if(!$pkt) {
      d("No AAAA records was returned for 'ipv4only.arpa'");
      next;
    }
    for my $rr ($pkt->answer) {
     if($rr->type ne "AAAA") {
       w("Got an non-AAAA RR? That's unexpected... Type=", $rr->type);
       next;
     }
     my $prefix = find_rfc7050_wka($rr->address);
     if(grep { $_ eq "$prefix" } @prefixes) {
       # we've seen this prefix already, ignore it (in most cases this will
       # happen at least once, since ipv4only.arpa has two A records)
     } else {
       push(@prefixes, $prefix);
     }
    }
  } continue { last unless @dns64_servers };

  if(@prefixes > 1) {
    # Cool! More than one prefix! Here we might at some point implement a
    # connectivity check which tests that the prefixes actually work, and
    # skips to the next one if so...
    w("Multiple PLAT prefixes discovered (@prefixes), using the first seen");
  }
  if(@prefixes) {
    return $prefixes[0];
  } elsif($CFG{"plat-fallback-prefix"}) {
    p("No PLAT prefix could be discovered, using fallback");
    return $CFG{"plat-fallback-prefix"};
  } else {
    p("No PLAT prefix could be discovered. Your ISP probably doesn't provide",
      " NAT64/DNS64 PLAT service. Exiting.");
    cleanup_and_exit(0);
  }
}


#
# This function attempts request a PLAT prefix from systemd-networkd, which
# systemd-networkd will know about if the Router Advertisements contain the
# PREF64 option defined in RFC 8781, and systemd-networkd is configured with
# UsePREF64=true (not the default). The first prefix seen is used, subsequent
# ones are ignored.
#
sub get_plat_prefix_from_networkd {
  if(!can_run(cfg("cmd-networkctl"))) {
    d(cfg("cmd-networkctl"), " is not installed or not exectutable, skipping");
    return;
  }
  p("Attempting to query systemd-networkd for PLAT prefix (cf. RFC 8781)");
  open(my $fd, '-|', cfg("cmd-networkctl"), qw(--json=short status))
    or err(cfg("cmd-networkctl"), " failed to execute");
  my @out = <$fd>;
  if(!close($fd)) {
    p("'networkctl status' failed, trying DNS64 PLAT prefix discovery");
    return;
  }

  require JSON;
  my $status = JSON::decode_json("@out");

  return unless($status->{"Interfaces"});

  for my $interface (@{$status->{"Interfaces"}}) {
    next if(!$interface->{"NDisc"}->{"PREF64"});

    d2($interface->{"Name"}, " PREF64 bytes: ",
       join(" ", @{$interface->{"NDisc"}->{"PREF64"}->[0]->{"Prefix"}}),
       " / ", $interface->{"NDisc"}->{"PREF64"}->[0]->{"PrefixLength"});

    # PREF64 is an array of bytes, convert to IPv6 string representation
    my @bytes = @{$interface->{"NDisc"}->{"PREF64"}->[0]->{"Prefix"}};
    my $ipstr;
    for (my $i = 0; $i < @bytes;) {
      $ipstr .= sprintf("%02x%02x", $bytes[$i++], $bytes[$i++]);
      $ipstr .= ":" if($i < @bytes);
    }
    $ipstr .= "/" . $interface->{"NDisc"}->{"PREF64"}->[0]->{"PrefixLength"};

    d2("String representation: $ipstr");

    # Run the result through Net::IP to ensure we have a valid IPv6 string
    # and also to convert it to compact format.
    my $ip = Net::IP->new($ipstr, 6)
      or err("Failed to convert PREF64 bytes array to IPv6 string format");

    my $prefix = $ip->short() . "/" . $ip->prefixlen();
    d("Obtained PLAT prefix $prefix from systemd-networkd");
    return $prefix;
  }
}


#
# This function figures out which network interface on the system faces the
# PLAT/NAT64. We need this when generating an IPv6 address for the CLAT, when
# installing Proxy-ND entries, and when setting up nft rules.
#
sub get_plat_dev {
  d("get_plat_dev(): finding which network dev faces the PLAT");
  my $plat_dev;
  my $plat_dev_srcip;
  my $plat_prefix = cfg("plat-prefix");
  if(!$plat_prefix) {
    err("get_plat_dev(): No PLAT prefix to work with");
  }
  $plat_prefix =~ s|/\d+$||;
  open(my $fd, '-|', cfg("cmd-ip"), qw(-6 route get), $plat_prefix)
    or err("get_plat_dev(): 'ip -6 route get $plat_prefix' failed to execute");
  while(<$fd>) {
    if(/ dev (\S+) /) {
      d("get_plat_dev(): Found PLAT-facing device: $1");
      $plat_dev = $1;
    }
    if(/ src (\S+) /) {
      d("get_plat_dev(): Found PLAT-facing device source IP: $1");
      $plat_dev_srcip = $1;
    }
  }
  close($fd) or err("get_plat_dev(): 'ip -6 route get $plat_prefix' failed");
  return ($plat_dev, $plat_dev_srcip);
}


#
# Determines if an address is contructed using the Modified EUI-64 algorithm,
# by extension that it was configured using SLAAC (in which case we're at
# liberty to grab another address in that same /64 for the CLAT).
#
# This isn't a 100% foolproof check, as it is certainly possible to configure
# such an address statically, or to hand it out using DHCPv6 IA_NA, but as
# we can't easliy know with 100% certainty that SLAAC is being used, it'll
# have to do. The function checks three things which are known to be true for
# IPv6 addresses with Interface IDs based on Modified EUI-64:
#  1) bits 24 through 38 in the Interface ID are 1
#  2) bit 39 in the Interface ID is 0
# Return true if all of the above is the case, false otherwise.
#
sub is_modified_eui64 {
  my $ip = shift;
  $ip = Net::IP->new($ip) or return;
  $ip = $ip->intip();

  # Check 1) - return false if check fails
  my $mask = Net::IP->new("::ff:fe00:0");
  $mask = $mask->intip();
  return unless ($ip & $mask) == $mask;

  # Check 2) and return
  $mask = Net::IP->new("::100:0");
  $mask = $mask->intip();
  return ($ip & $mask) != $mask;
}

sub cleanup_handler {
  p("Cleaning up and exiting");
  if(cfg("script-down")) {
    d("Running custom shutdown script: ", cfg("script-down"));
    cmd(\&err, cfg("script-down"));
  }
  cleanup_and_exit(0);
}


#
# This function considers any globally scoped IPv6 address on the PLAT-facing
# device, and derives an CLAT IPv6 address from the best match (longest
# common prefix with PLAT prefix). Addresses based on Modified EUI-64 are
# preferred, and if found, it generates a new address for the CLAT by
# substituting the "0xfffe" bits in the middle of the Interface ID with
# 0xc1a7 ("clat"). This keeps the last 24 bits unchanged, which has the added
# bonus of not requiring the host to join another Solicited-Node multicast
# group. If no EUI-64 address is seen, it'll use a random IID instead.
#
sub get_clat_v6_addr {
  my $plat_dev = cfg("plat-dev");
  if(!$plat_dev) {
    err("get_clat_v6_addr(): No PLAT device to work with");
  }

  # In case there are more than one EUI-64-based addresses on the plat device,
  # we'll need the plat prefix as an bigint in order to find which of those
  # addresses share the longest common prefix. We'll prefer to use that one.
  my $plat_prefix_int = Net::IP->new(cfg("plat-prefix"), 6)->intip();
  if(!$plat_prefix_int) {
    err("Failed to convert plat prefix to bigint");
  }
  my $ip; # will contain the best candidate ip in bigint format
  my $ip_plen; # will contain the prefix length of the best candidate ip
  my $best_score; # will contain the score of the best candidate seen
  my $seen_eui64; # set if we've seen an eui-64 based address

  p("Attempting to derive a CLAT IPv6 address from an IPv6 address on ",
    "'$plat_dev'");
  open(my $fd, '-|', cfg("cmd-ip"), qw(-6 address list scope global dev),
       $plat_dev)
    or err("'ip -6 address list scope global dev $plat_dev' failed to execute");
  while(<$fd>) {
    if(m| inet6 (\S+)/(\d{1,3}) scope global |) {
      my $candidate = $1;
      my $plen = $2;
      d2("Saw a candidate address on '$plat_dev': $candidate/$plen");
      my $candidate_int = Net::IP->new($candidate, 6)->intip();
      if(!$candidate_int) {
        err("Failed to convert plat prefix to bigint");
      }

      if($plen > 120) {
        # We'll need a subnet with some space if we are to generate a random
        # IID and don't have too large risk of collisions... /120 seems like
        # an OK limit
        d2("Refusing to use random IIDs for prefix lengths > /120");
        next;
      }

      # True if the candidate under consideration is EUI-64 based
      my $is_eui64 = ($plen == 64) && is_modified_eui64($candidate);

      # If this is the first time we're considering an EUI-64 based address,
      # we unconditionally prefer it (even if it doesn't have the longest
      # matching prefix), because we consider deriving the CLAT IPv6
      # address from an EUI-64 based candidate to be safer than generating
      # a truly random CLAT IPv6 address.
      if($is_eui64 and !$seen_eui64++) {
        d2("Preferring $candidate/$plen; it's the first EUI-64 seen");
        $best_score = $plat_prefix_int ^ $candidate_int;
        $ip = $candidate_int;
        $ip_plen = $plen;
        next;
      }

      # If we already have found an EUI-64 based address, we can reject this
      # candidate outright, as it is *not* EUI-64 based.
      if(!$is_eui64 and $seen_eui64) {
        d2("Rejecting $candidate/$plen; we have better EUI-64 candidates");
        next;
      }

      # Otherwise, we'll be comparing EUI-64 to EUI-64, or non EUI-64 to
      # non EUI-64. If so, we prefer the current candidate if it has a better
      # score than the current best match (or if there is no current best
      # match).
      if(!$best_score or $best_score > ($plat_prefix_int ^ $candidate_int)) {
        d2("Preferring $candidate/$plen; best match so far");
        $best_score = $plat_prefix_int ^ $candidate_int;
        $ip = $candidate_int;
        $ip_plen = $plen;
        next;
      }

      d2("Rejecting $candidate/$plen; we've seen better matches");
    }
  }
  close($fd)
    or err("'ip -6 address list scope global dev $plat_dev' failed");

  if(!$ip) {
    err("Could not find a global IPv6 address on $plat_dev from which ",
        "to derive a CLAT IPv6 address (try setting 'clat-v6-addr')");
  }

  if($seen_eui64) {
    # If the chosen candidate IP is EUI-64 based, we derive a CLAT IPv6
    # address by replacing the 0xffe in the middle of the Interface ID with
    # 0xc1a7 ("CLAT").

    # First clear the middle 0xfffe bits of the interface ID
    my $mask = Net::IP->new("ffff:ffff:ffff:ffff:ffff:ff00:00ff:ffff");
    $mask = $mask->intip();
    $ip &= $mask;

    # Next set them to the value 0xc1a7
    $mask = Net::IP->new("::c1:a700:0", 6) or err(Net::IP::Error());
    $mask = $mask->intip();
    $ip |= $mask;
  } else {
    # If the chosen candidate IP is NOT EUI-64 based, we'll just make up a
    # random interface ID. There is no guarantee that this will actually
    # work, but it's the best thing we can try...

    # First zero out the entire Interface ID
    $ip >>= (128-$ip_plen);
    $ip <<= (128-$ip_plen);

    my $iid = int(rand(2**(128-$ip_plen)));
    d2(sprintf("Using random interface ID: %x", $iid));
    $ip |= $iid;
  }

  # Convert back the BigInt to a regular Net::IP object and return
  $ip = Net::IP->new(Net::IP::ip_bintoip(Net::IP::ip_inttobin($ip, 6), 6));
  return $ip->short() if $ip;

  err("Failed to generate a CLAT IPv6 address (try setting 'clat-v6-addr')");
}

#
# This subroutine is called when we are exiting, for whatever reason. It
# tries to clean up any temporary changes we've made first. The variables
# below gets set as we go along, so that the cleanup subroutine can restore
# stuff if necessary.
#
my $cleanup_remove_tayga_clat_dev;	# true if having created it
my $cleanup_remove_nat46_clat_dev;	# true if having created it
my $cleanup_delete_taygaconf;		# true if having made a temp confile
my $cleanup_zero_forwarding_sysctl;	# zero forwarding sysctl if set
my @cleanup_accept_ra_sysctls;		# accept_ra sysctls to be reset to '1'
my $cleanup_zero_proxynd_sysctl;	# zero proxy_ndp sysctl if set
my $cleanup_remove_proxynd_entry,	# true if having added proxynd entry
my $cleanup_remove_nftable;		# true if having added an nftable
my $cleanup_remove_clat_iprule;		# true if having added clat iprule
my $cleanup_remove_ufw_rules;		# true if having added ufw rules
my $cleanup_restore_local_iprule_prio;	# true if having reordered local iprule
my @cleanup_restore_v4_defaultroutes;	# temporarily replaced defaultroutes

sub cleanup_and_exit {
  my $exitcode = shift;

  if(defined($cleanup_remove_tayga_clat_dev)) {
    d("Cleanup: Removing TAYGA CLAT device");
    cmd(\&w, cfg("cmd-tayga"), "--config", cfg("tayga-conffile"), "--rmtun");
  }
  if(defined($cleanup_delete_taygaconf)) {
    d("Cleanup: Deleting TAYGA config file '", cfg("tayga-conffile"), "'");
    unlink(cfg("tayga-conffile"))
      or w("unlink('", cfg("tayga-conffile"), "') failed");
  }
  if(defined($cleanup_remove_nat46_clat_dev)) {
    d("Cleanup: Removing nat46 CLAT device");
    my $nat46_control_fh;
    open($nat46_control_fh, ">/proc/net/nat46/control") or
        err("Could not open nat46 control socket for writing");
    print $nat46_control_fh "del ", cfg("clat-dev"), "\n";
    close($nat46_control_fh) or err("close($nat46_control_fh: $!");
  }
  if(defined($cleanup_zero_forwarding_sysctl)) {
    d("Cleanup: Resetting forwarding sysctl to 0");
    sysctl("net/ipv6/conf/all/forwarding", 0);
  }
  for my $sysctl (@cleanup_accept_ra_sysctls) {
    d("Cleanup: Resetting $sysctl to 1");
    sysctl($sysctl, 1);
  }
  if(defined($cleanup_zero_proxynd_sysctl)) {
    d("Cleanup: Resetting proxy_ndp sysctl to 0");
    sysctl("net/ipv6/conf/" . cfg("plat-dev") . "/proxy_ndp", 0);
  }
  if(defined($cleanup_remove_proxynd_entry)) {
    d("Cleanup: Removing Proxy-ND entry for ", cfg("clat-v6-addr"), " on ",
      cfg("plat-dev"));
    cmd(\&w, cfg("cmd-ip"), qw(-6 neighbour delete proxy), cfg("clat-v6-addr"),
        "dev", cfg("plat-dev"));
  }
  if(defined($cleanup_remove_nftable)) {
    d("Cleanup: Removing clatd netfilter table");
    cmd(\&w, cfg("cmd-nft"), "delete table ip6 clatd");
  }
  for my $rt (@cleanup_restore_v4_defaultroutes) {
    d("Cleanup: Restoring temporarily replaced IPv4 default route");
    cmd(\&w, cfg("cmd-ip"), qw(-4 route add), @{$rt});
  }
  if(defined($cleanup_restore_local_iprule_prio)) {
    d("Cleanup: Restoring local ip rule priority to 0");
    cmd(\&w, cfg("cmd-ip"), qw(-6 rule add prio 0 table local));
    cmd(\&w, cfg("cmd-ip"), qw(-6 rule del prio 1 table local));
  }
  if(defined($cleanup_remove_clat_iprule)) {
    d("Cleanup: Removing ip rule for redirecting inbound traffic to CLAT");
    cmd(\&w, cfg("cmd-ip"), qw(-6 rule del prio 0 table), cfg("route-table"));
  }
  if(defined($cleanup_remove_ufw_rules)) {
    cmd(\&w, cfg("cmd-ufw"), qw(route delete allow in on), cfg("clat-dev"),
        "from", cfg("clat-v6-addr"), qw(out on), cfg("plat-dev"), "to",
        cfg("plat-prefix"));
    cmd(\&w, cfg("cmd-ufw"), qw(route delete allow in on), cfg("plat-dev"),
        "from", cfg("plat-prefix"), qw(out on), cfg("clat-dev"), "to",
        cfg("clat-v6-addr"));
  }

  exit($exitcode);
}


#
# Ok, we're done defining helper functions, and are ready to start doing some
# real work here. First parse option arguments from command line, config
# overrides we do in a second pass below. We do it in two passes to ensure we
# have read in any config from the config file before possibly overriding with
# config supplied on the command line
#
#
for (my $i = 0; $i < @ARGV;) {
  if($ARGV[$i] eq "-q") {
    $CFG{"quiet"}++;
    splice(@ARGV, $i, 1);
    next;
  } elsif($ARGV[$i] eq "-d") {
    $CFG{"debug"}++;
    splice(@ARGV, $i, 1);
    next;
  } elsif($ARGV[$i] eq "-c") {
    if(!defined($ARGV[$i+1])) {
      err("Command line option '-c' given without an argument");
    }
    if(!defined(&readconf)) {
      err("Command line option '-c' given more than once");
    }
    readconf($ARGV[$i+1]);
    undef(&readconf);
    splice(@ARGV, $i, 2);
    next;
  } elsif($ARGV[$i] =~ /^(-h|--help)$/) {
    print <<"EOF";
clatd v$VERSION - a 464XLAT (RFC 6877) CLAT and SIIT-DC Edge Relay
             (RFC 7756) implementation for Linux
EOF
    print "\n";
    print "  Usage:    clatd [-q] [-d [-d]] [-c config-file] ",
          "[conf-key=val ...]\n";
    print "  Author:   Tore Anderson <tore\@fud.no>\n";
    print "  Homepage: https://github.com/toreanderson/clatd\n";
    print "\n";
    print "For more documentation and information, see 'man 8 clatd'.\n";
    exit 0;
  } elsif($ARGV[$i] =~ /^-/) {
    err("Unrecognised command line option '$ARGV[$i]'");
  }
  $i++;
}


#
# Read in config from default location if we haven't already due to
# '-c "somefile"' having been supplied on command line (if so, &readconf
# will have been undefined. However if it doesn't exit, that's OK - we'll
# just proceed with defaults + any command line overrides
#
if(defined(&readconf) && -e "/etc/clatd.conf") {
  readconf("/etc/clatd.conf");
}


#
# Finally, deal with config settings from command line. This is done last so
# that the command line takes precedence over all other sources of config
#
for (@ARGV) {
  if(m|^([\w-]+)=(.*)$|) {
    if(!exists($CFG{$1})) {
      err("Unknown config key '$1' given on command line");
    }
    $CFG{$1} = $2;
  } else {
    err("Unrecognised command line argument '$_'");
  }
}
d("Configuration successfully read, dumping it:");
for my $key (sort(keys(%CFG))) {
  d("  $key=", defined($CFG{$key}) ? $CFG{$key} : "<undefined>");
}

p("Starting clatd v$VERSION by Tore Anderson <tore\@fud.no>");

#
# Step 1: Fill in any essential blanks in the configuration by auto-detecting
# any missing values.
$CFG{"plat-prefix"} ||= get_plat_prefix_from_networkd()
  unless($CFG{"dns64-servers"});
$CFG{"plat-prefix"} ||= get_plat_prefix_from_dns64();
if(!$CFG{"plat-prefix"}) {
  w("No PLAT prefix was discovered or specified; 464XLAT cannot work.");
  exit 0;
} else {
  # Do some basic sanity checking on the PLAT prefix
  my $ip = Net::IP->new($CFG{"plat-prefix"}, 6);
  if(!$ip) {
    d2("Net::IP::Error()=" . Net::IP::Error()) if(Net::IP::Error());
    err("PLAT prefix $CFG{'plat-prefix'} is not a valid IPv6 prefix");
  }
  if($ip->prefixlen() != 96 and
     $ip->prefixlen() != 64 and
     $ip->prefixlen() != 56 and
     $ip->prefixlen() != 48 and
     $ip->prefixlen() != 32) {
    err("PLAT prefix $CFG{'plat-prefix'} has an invalid prefix length ",
        "(see RFC 6052 section 2.2)");
  }
  p("Using PLAT (NAT64) prefix: $CFG{'plat-prefix'}");
}
my @plat_dev = get_plat_dev();
$CFG{"plat-dev"} ||= $plat_dev[0];
p("Device facing the PLAT: ", $CFG{"plat-dev"});

if($CFG{"clat-v6-addr"} eq "shared") {
  if(!$plat_dev[1]) {
    err("Could not determine source IP facing the PLAT, needed due to using ",
        "clat-v6-addr=shared");
  }
  $CFG{"clat-v6-addr"} = $plat_dev[1];
  if(!defined($CFG{"proxynd-enable"})) {
    $CFG{"proxynd-enable"} = 0;
  }
  if(!defined($CFG{"ctmark"})) {
    $CFG{"ctmark"} = 0xc1a7;
  }
} elsif($CFG{"clat-v6-addr"} eq "derived") {
  $CFG{"clat-v6-addr"} = get_clat_v6_addr();
}

# Fill defaults for proxynd-enable and ctmark for clat-v6-addr!=shared
if(!defined($CFG{"proxynd-enable"})) {
  $CFG{"proxynd-enable"} = 1;
}
if(!defined($CFG{"ctmark"})) {
  $CFG{"ctmark"} = 0;
}

p("Using CLAT IPv4 address: ", $CFG{"clat-v4-addr"});
p("Using CLAT IPv6 address: ", $CFG{"clat-v6-addr"});
if(!$CFG{"v4-defaultroute-advmss"} and cfgint("v4-defaultroute-mtu")) {
  $CFG{"v4-defaultroute-advmss"} = $CFG{"v4-defaultroute-mtu"} - 40;
}

#
# Step 1: Detect if there is an IPv4 default route on the system from before.
# If so we have no need for 464XLAT, and we can just exit straight away
#
if(cfgbool("v4-conncheck-enable") and !cfgbool("v4-defaultroute-replace")) {
  my $delay = cfgint("v4-conncheck-delay");
  p("Checking if this system already has IPv4 connectivity ",
    $delay ? "in $delay sec(s)" : "now");
  sleep($delay);
  open(my $fd, '-|', cfg("cmd-ip"), qw(-4 route list default))
    or err("'", cfg("cmd-ip"), " -4 route list default' failed to execute");
  while(<$fd>) {
    if(/^default /) {
      p("This system already has IPv4 connectivity; no need for a CLAT.");
      cleanup_and_exit(0);
    }
  }
  close($fd) or err("cmd(ip -4 route list default) failed");
} else {
  d("Skipping IPv4 connectivity check at user request");
}

# Let's figure out if there's nat46 kernel module loaded
my $nat46_controlfile = "/proc/net/nat46/control";
my $use_nat46 = (-e $nat46_controlfile);



#
# Write out the TAYGA config file, either to the user-specified location,
# or to a temporary file (which we'll delete later)
#
unless($use_nat46) {
  my $tayga_conffile = cfg("tayga-conffile");
  my $tayga_conffile_fh;
  if(!$tayga_conffile) {
    require File::Temp;
    ($tayga_conffile_fh, $tayga_conffile) = File::Temp::tempfile();
    d2("Using temporary conffile for TAYGA: $tayga_conffile");
    $CFG{"tayga-conffile"} = $tayga_conffile;
    $cleanup_delete_taygaconf = 1;
  } else {
    open($tayga_conffile_fh, ">$tayga_conffile") or
      err("Could not open TAYGA config file '$tayga_conffile' for writing");
  }

  print $tayga_conffile_fh "# Ephemeral TAYGA config file written by $0\n";
  print $tayga_conffile_fh "# This file may be safely deleted at any time.\n";
  print $tayga_conffile_fh "tun-device ", cfg("clat-dev"), "\n";
  print $tayga_conffile_fh "prefix ", cfg("plat-prefix"), "\n";
  print $tayga_conffile_fh "ipv4-addr ", cfg("tayga-v4-addr"), "\n";
  print $tayga_conffile_fh "map ", cfg("clat-v4-addr"), " ",
                           cfg("clat-v6-addr"),"\n";

  close($tayga_conffile_fh) or err("close($tayga_conffile_fh: $!");
}
#
# Enable IPv6 forwarding if necessary
#
if(cfgbool("forwarding-enable")) {
  if(sysctl("net/ipv6/conf/all/forwarding") == 0) {
    p("Enabling IPv6 forwarding");
    for my $ctl (glob("/proc/sys/net/ipv6/conf/*/accept_ra")) {

      # Don't touch the ctl for the "all" interface, as that will probably
      # change interfaces that have accept_ra set to 0 also.
      next if($ctl eq "/proc/sys/net/ipv6/conf/all/accept_ra");
      
      if(sysctl($ctl) == 1) {
        d("Changing $ctl from 1 to 2 to prevent connectivity loss after ",
          "enabling IPv6 forwarding");
        sysctl($ctl, 2);
        push(@cleanup_accept_ra_sysctls, $ctl);
      }
    }
    sysctl("net/ipv6/conf/all/forwarding", 1);
    $cleanup_zero_forwarding_sysctl = 0;
  }
}

#
# Add firewall rules to allow PLAT-CLAT traffic if a supported local firewall
# framework is present and active
#
if(can_run(cfg("cmd-ufw"))) {
  open(my $fd, '-|', cfg("cmd-ufw"), "status")
    or err("'ufw status' failed to execute");
  while(<$fd>) {
    if(/^Status: active$/) {
      p("UFW local firewall framework active, allowing CLAT-PLAT traffic");
      cmd(\&err, cfg("cmd-ufw"), qw(route allow in on), cfg("clat-dev"),
          "from", cfg("clat-v6-addr"), qw(out on), cfg("plat-dev"), "to",
          cfg("plat-prefix"));
      cmd(\&err, cfg("cmd-ufw"), qw(route allow in on), cfg("plat-dev"),
          "from", cfg("plat-prefix"), qw(out on), cfg("clat-dev"), "to",
          cfg("clat-v6-addr"));
      $cleanup_remove_ufw_rules = 1;
    }
  }
  close($fd) or err("'ufw status' failed");
} else {
  d("UFW command '", cfg("cmd-ufw"), "' not found, not installing UFW rules");
}

#
# Enable ND proxy for the CLAT's IPv6 address on the interface facing the PLAT
#
if(cfgbool("proxynd-enable")) {
  my $plat_dev = cfg("plat-dev");
  my $clat_v6_addr = cfg("clat-v6-addr");
  p("Enabling Proxy-ND for $clat_v6_addr on $plat_dev");
  if(sysctl("net/ipv6/conf/$plat_dev/proxy_ndp") == 0) {
    sysctl("net/ipv6/conf/$plat_dev/proxy_ndp", 1);
    $cleanup_zero_proxynd_sysctl = 1;
    d("Enabled Proxy-ND sysctl for $plat_dev");
  }
  cmd(\&w, cfg("cmd-ip"), qw(-6 neighbour add proxy), cfg("clat-v6-addr"),
      "dev", cfg("plat-dev"));

  $cleanup_remove_proxynd_entry = 1;
}

# Move the default ip rule for local traffic to a higher priority, so we can
# override it. This is necessary if re-using the primary IPv6 address on the
# PLAT-facing device for the CLAT function.
open(my $fd, '-|', cfg("cmd-ip"), qw(-6 rule show prio 0 table local))
  or err("'ip -6 rule show prio 0 table local' failed to execute");
while(<$fd>) {
  d("Increasing prio of default local ip rule to 1");
  cmd(\&err, cfg("cmd-ip"), qw(-6 rule add prio 1 table local));
  cmd(\&err, cfg("cmd-ip"), qw(-6 rule del prio 0 table local));
  $cleanup_restore_local_iprule_prio = 1;
  last;
}
close($fd) or err("'ip -6 rule show prio 0 table local' failed");


#
# Create the CLAT tun interface, add the IPv4 address to it as well as the
# route to the corresponding IPv6 address, and possibly an IPv4 default route
#
p("Creating and configuring up CLAT device '", cfg("clat-dev"), "'");
if($use_nat46) {
  my $nat46_control_fh;
  open($nat46_control_fh, ">$nat46_controlfile") or
      err("Could not open nat46 control socket for writing");
  print $nat46_control_fh "add ", cfg("clat-dev"), "\n";
  close($nat46_control_fh) or err("close($nat46_control_fh: $!");
  $cleanup_remove_nat46_clat_dev = 1;
} else {
  cmd(\&err, cfg("cmd-tayga"), "--config", cfg("tayga-conffile"), "--mktun",
      cfgint("debug") ? "-d" : "");
  $cleanup_remove_tayga_clat_dev = 1;
}
cmd(\&err, cfg("cmd-ip"), qw(link set up dev), cfg("clat-dev"));
cmd(\&err, cfg("cmd-ip"), qw(-4 address add), cfg("clat-v4-addr"),
    "dev", cfg("clat-dev"));
cmd(\&err, cfg("cmd-ip"), qw(-6 route add), cfg("clat-v6-addr"),
    "dev", cfg("clat-dev"), "table", cfgint("route-table"));
cmd(\&err, cfg("cmd-ip"), qw(-6 rule add prio 0 from),
    cfg("plat-prefix"), "to", cfg("clat-v6-addr"),
    cfgint("ctmark") ? ("fwmark", cfgint("ctmark")) : (),
    "table", cfg("route-table"));
$cleanup_remove_clat_iprule = 1;

if(cfgint("ctmark")) {
  p("Adding clatd nftable, using conntrack mark ", cfgint("ctmark"));
  open(my $fd, '|-', cfg("cmd-nft"), "-f-")
    or err("'nft -f-' failed to execute");
  print $fd "add table ip6 clatd\n";
  print $fd "add chain ip6 clatd prerouting ",
            "{ type filter hook prerouting priority mangle; }\n";
  print $fd "add rule ip6 clatd prerouting",
            " iif ", cfg("clat-dev"),
            " ip6 saddr ", cfg("clat-v6-addr"),
            " ip6 daddr ", cfg("plat-prefix"),
            " ct mark set ", cfgint("ctmark"),
            # set meta mark as well, to placate firewalld's IPv6_rpfilter and NixOS' rpfilter rules
            " meta mark set ", cfgint("ctmark"), " counter\n";
  print $fd "add rule ip6 clatd prerouting",
            " iif ", cfg("plat-dev"),
            " ip6 saddr ", cfg("plat-prefix"),
            " ip6 daddr ", cfg("clat-v6-addr"),
            " ct mark ", cfgint("ctmark"),
            " meta mark set ct mark counter\n";
  close($fd) or err("'nft -f-' failed");
  $cleanup_remove_nftable = 1;
}

if(cfgbool("v4-defaultroute-replace")) {
  open(my $fd, '-|', cfg("cmd-ip"), qw(-4 route show default))
    or err("'ip -4 route show default' failed to execute");
  while(<$fd>) {
    my @rt = split(/\s+/, $_);
    d("Replacing pre-existing IPv4 default route: @rt");
    cmd(\&err, cfg("cmd-ip"), qw(-4 route del), @rt);
    push(@cleanup_restore_v4_defaultroutes, \@rt);
  }
  close($fd) or err("'ip -4 route show default' failed");
}
if(cfgbool("v4-defaultroute-enable")) {
  my @cmdline = (qw(-4 route add default dev), cfg("clat-dev"));
  if(cfgint("v4-defaultroute-metric")) {
    push(@cmdline, ("metric", cfgint("v4-defaultroute-metric")))
  }
  if(cfgint("v4-defaultroute-mtu")) {
    push(@cmdline, ("mtu", cfgint("v4-defaultroute-mtu")));
  }
  if(cfgint("v4-defaultroute-advmss")) {
    push(@cmdline, ("advmss", cfgint("v4-defaultroute-advmss")));
  }
  p("Adding IPv4 default route via the CLAT");
  cmd(\&err, cfg("cmd-ip"), @cmdline);
}

# Inject %CFG into %ENV and then run the up script
for my $key (sort keys(%CFG)) {
  my $var = $key;
  $var =~ y/-/_/;
  d2(sprintf("Script env: %s=%s", $key, $CFG{$key} || ''));
  $ENV{$var} = $CFG{$key};
}
if(cfg("script-up")) {
  d("Running custom startup script: ", cfg("script-up"));
  cmd(\&err, cfg("script-up"));
}

#
# All preparation done! We can now start nat46 or TAYGA, which will handle the actual
# translation of IP packets.
#
if($use_nat46){
  p("Setting up nat46 kernel module");
  my $nat46_control_fh;
  open($nat46_control_fh, ">$nat46_controlfile") or
    err("Could not open nat46 control socket for writing");
  print $nat46_control_fh "config ", cfg("clat-dev"), " local.style NONE\n";
  print $nat46_control_fh "config ", cfg("clat-dev"), " local.v4 ", cfg("clat-v4-addr"), "/32\n";
  print $nat46_control_fh "config ", cfg("clat-dev"), " local.v6 ", cfg("clat-v6-addr"), "/128\n";
  print $nat46_control_fh "config ", cfg("clat-dev"), " remote.style RFC6052\n";
  print $nat46_control_fh "config ", cfg("clat-dev"), " remote.v6 ", cfg("plat-prefix"), "\n";
  close($nat46_control_fh) or err("close($nat46_control_fh: $!");

  # Nothing more to do here, we just set up a cleanup handler and sleep forever.
  $SIG{'INT'} = \&cleanup_handler;
  $SIG{'TERM'} = \&cleanup_handler;
  sleep();
} else {
  my $tayga_conffile = cfg("tayga-conffile");
  p("Starting up TAYGA, using config file '$tayga_conffile'");

  # We don't want systemd etc. to actually kill this script when stopping the
  # service, just TAYGA (so that we can get around to cleaning up after
  # ourselves)
  $SIG{'INT'} = 'IGNORE';
  $SIG{'TERM'} = 'IGNORE';

  cmd(\&err, cfg("cmd-tayga"), "--config", cfg("tayga-conffile"), "--nodetach",
      cfgint("debug") ? "-d" : "");
  p("TAYGA terminated, cleaning up and exiting");

  $SIG{'INT'} = 'DEFAULT';
  $SIG{'TERM'} = 'DEFAULT';

  #
  # TAYGA exited, probably because we're shutting down. Run the down script, then
  # cleanup and exit.
  #
  if(cfg("script-down")) {
    d("Running custom shutdown script: ", cfg("script-down"));
    cmd(\&err, cfg("script-down"));
  }
  cleanup_and_exit(0);
}
