#!/usr/bin/perl -I/usr/local/realadm/lib
use Const::Fast;
use Cwd 'abs_path';
use Fcntl ':flock';
use File::Basename;
use File::Slurp;
use JSON::PP;
use RealEd;
use Aia::Cmd qw(capture sudo sys);
use Aia::Getopt;

sub apache_sites_enabled();
sub confirm($@);
sub default_iface();
sub detect_host_type();
sub disable_boot_unit();
sub enable_boot_unit();
sub host_features();
sub host_has_feature($);
sub host_type();
sub host_type_active($);
sub is_active();
sub require_active();
sub isadmin();
sub isserver();
sub isvpn();
sub isweb();
sub key_match($$);
sub lock_state();
sub nft(@);
sub nft_add(@);
sub nft_delete(@);
sub nft_ensure_set($);
sub nft_load_sets($);
sub cidr_covers($$);
sub cidr_range($);
sub compact_cidrs(@);
sub normalize_cidr($);
sub normalize_key($);
sub explain_rule($);
sub entry_ports($);
sub fwrule_match_lines($);
sub normalize_fwrule_key($);
sub normalize_ports($);
sub normalize_user_ports($);
sub order($);
sub parse_fwrule_key($);
sub policy_steps($$$$);
sub ports_to_nft($);
sub read_values(@);
sub render($$);
sub rules();
sub setname(@);
sub scope_match_lines($$$);
sub scope_ports_label($);
sub scope_verdict($);sub shape_ensure();
sub shape_status();
sub show_live(;$);
sub state_load();
sub state_save($);
sub target_active($);
sub usage(;$);
sub vardir($);
sub volatile_set_members($);

$ENV{PATH} = join ':', qw(/usr/sbin /sbin /usr/bin /bin);

const my $bindir   => dirname(abs_path($0));
# Source checkout: rules live next to the script. Installed package: fixed paths.
const my $fromsrc  => -e "$bindir/rules";
const my $vardir   => $fromsrc ? $bindir : '/var/lib/refw';
const my $etcdir   => $fromsrc ? $bindir : '/etc/refw';
# isrealed / isdev come from RealEd when present; see detect_host_type().

const my @table => qw(inet refw);       # nft table family + name (argv + docs)
const my $chain => 'screen';            # main hook chain, per rules file
const my $shape_chain => 'shape';       # output hook: mark ratelimited flows for tc
const my $shape_mark  => 1;             # fwmark → tc HTB slow class (matches old action)
const my $shape_rate  => '1mbit';       # crawl punishment for @f2b_ratelimit

# scope properties:
#   keyed    - entries may carry --key paths (prefix-matched)
#   volatile - membership lives in the kernel only, never in the declaration
#                keyed guard volatile
# ported: membership is keyed by proto/ports/act signature (legacy fwrule scope).
# portopt: optional --ports (TCP); omit/all/* = any port; key stays a name/role.
const my %scopes => (
    user     => {keyed => 1, guard => 0, volatile => 0, ported => 0, portopt => 1},
    system   => {keyed => 1, guard => 1, volatile => 0, ported => 0, portopt => 1},
    feed     => {keyed => 1, guard => 0, volatile => 0, ported => 0, portopt => 0},
    fwrule   => {keyed => 1, guard => 0, volatile => 0, ported => 1, portopt => 0}, # legacy
    fail2ban => {keyed => 0, guard => 0, volatile => 1, ported => 0, portopt => 0},
);
# NB: every scope lists all flags. Const::Fast locks the keys of each nested
# hash, so reading an absent key dies ("disallowed key") rather than undef.
const my %actions => map { $_ => 1 } qw(allow drop reject);
# act sort for generated fwrule match lines (first match wins among overlaps)
const my %act_order => (allow => 0, drop => 1, reject => 2);

# Host types (system roles). A trailing "?" on a rules-file target is
# conditional: either on host type (name ends in -<type>) or on a feature
# (bare name, or set-<feature>-{allow,drop}). See host_type / host_features.
# Keep the list as an array + alternation regex only - a Const::Fast hash
# would die on exists/fetch of non-type tokens like "allow" from set names.
const my @host_types => qw(realed web server admin dev vpn);
const my $host_type_re => join '|', @host_types;
const my $vpn_bin => '/usr/local/realadm/bin/vpn';

# Getopt
our ($all, $comment, $dryrun, $input, $key, $live, $nokey, $ports, $quiet, $raw,
     $rekey, $summary, $timeout, $type, $yes);

my $cmd = shift or usage 'need a command';

no strict 'refs';
defined &{"x_$cmd"} or usage "unknown command - $cmd";
&{"x_$cmd"}(@ARGV);
exit 0;

# commands - membership (hot path: set edits, no structural reload)

# True when refw is enforcing: nft table inet refw exists (not merely installed).
# nft needs netlink, so unprivileged there is no answer - and no answer must
# not read as "inactive": that lie sends every isactive consumer (genfw's
# backend pick, sutilw, reuser, a human checking) down the legacy path.
sub is_active() {
    $> == 0 or die "refw: must run as root to query nft (try sudo)\n";
    my $out = capture {errok => 1, quiet => 1, quieterr => 1},
        qw(nft list table), @table;
    return !!(defined $out && $out =~ /\S/);
}

sub require_active() {
    is_active()
        or die "refw is not active; run: refw activate\n";
}

# Command: add addresses to a scope set (or volatile fail2ban set).
sub x_add {
    require_active();
    my ($scope, @rest) = @_;
    exists $scopes{$scope} or usage "unknown scope - $scope";
    my \%props = $scopes{$scope};

    if ($props{volatile}) {                     # refw add fail2ban ratelimit 6.6.6.6 [--timeout N]
        my $set = shift @rest // usage 'need a set name (jail)';
        my $ip = normalize_cidr(shift @rest // usage 'need an address');
        nft_add setname($scope, $set), $ip, $timeout;
        return;
    }

    my $action = shift @rest // usage 'need an action';
    exists $actions{$action} or usage "unknown action - $action";
    $props{keyed} and !defined $key and !$nokey
        and die "$scope requires --key (or --nokey to add without one)\n";
    if ($props{ported}) {
        defined $key or die "fwrule requires --key=proto/ports/act "
            . "(e.g. tcp/22/allow or tcp/59822+59823/allow)\n";
        $key = normalize_fwrule_key($key);
        my $ka = (parse_fwrule_key($key))[2];
        $ka eq $action or die "fwrule key act '$ka' does not match action '$action'\n";
        defined $ports and die "--ports is for user/system; put ports in --key for fwrule\n";
    } else {
        !$props{portopt} && $action eq 'reject'
            and usage "reject is only valid for user, system, or fwrule";
        $key = normalize_key($key) if defined $key;
        !$props{portopt} && defined $ports
            and die "--ports is only valid for user or system scope\n";
    }
    my $eports = $props{portopt} ? normalize_user_ports($ports) : undef;

    my $lock = lock_state;
    my \%state = state_load;
    my \@entries = ($state{sets}{"$scope/$action"} //= []);

    my @values = compact_cidrs(read_values(@rest));

    !$props{guard} or $yes or confirm "modify $scope (infrastructure) list?"
        or die "aborted\n";

    my $newkey = 0;
    for my $value (@values) {
        # fwrule: unique per (value, signature); portopt: per (value, ports);
        # others: unique per value
        my ($e) = $props{ported}
            ? grep { $_->{value} eq $value && ($_->{key} // '') eq ($key // '') } @entries
            : $props{portopt}
            ? grep {
                $_->{value} eq $value
                && (entry_ports($_) // '') eq ($eports // '')
              } @entries
            : grep { $_->{value} eq $value } @entries;
        if ($e) {
            my $had = $e->{key} // '(unkeyed)';
            my $want = $key // '(unkeyed)';
            if ($had eq $want) {
                next;
            }
            $props{ported} and die "$value already under '$had' for this signature\n";
            $rekey or die "$value already present under key '$had' - "
                        . "use --rekey to move it to '$want', or replace\n";
            defined $key ? ($e->{key} = $key) : delete $e->{key};
            if ($props{portopt}) {
                defined $eports ? ($e->{ports} = $eports) : delete $e->{ports};
            }
            say "re-keyed $value: $had -> $want" unless $quiet;
            next;
        }
        # Drop existing members of this set that the new prefix fully covers
        # (interval sets reject overlapping elements). Same ports bucket only.
        my @covered = grep {
            my $ev = $entries[$_]{value};
            my $ek = $entries[$_]{key} // '';
            my $ep = entry_ports($entries[$_]);
            ($props{ported} ? $ek eq ($key // '') : 1)
                && (!$props{portopt} || ($ep // '') eq ($eports // ''))
                && cidr_covers($value, $ev) && $ev ne $value
        } 0 .. $#entries;
        for (reverse @covered) {
            my $ev = $entries[$_]{value};
            my $ee = $entries[$_];
            nft_delete setname($scope, $action, $ee->{key}, entry_ports($ee)), $ev;
            splice @entries, $_, 1;
            say "dropped $ev (covered by $value)" unless $quiet;
        }
        if (my ($broader) = map { $entries[$_]{value} } grep {
                my $ev = $entries[$_]{value};
                my $ek = $entries[$_]{key} // '';
                my $ep = entry_ports($entries[$_]);
                ($props{ported} ? $ek eq ($key // '') : 1)
                    && (!$props{portopt} || ($ep // '') eq ($eports // ''))
                    && cidr_covers($ev, $value)
            } 0 .. $#entries) {
            say "skip $value (covered by $broader)" unless $quiet;
            next;
        }
        my $ne = {value => $value,
                  defined $key     ? (key     => $key)     : (),
                  defined $comment ? (comment => $comment) : (),
                  defined $eports  ? (ports   => $eports)  : ()};
        push @entries, $ne;
        $newkey ||= defined $key
            && !grep { key_match($_->{key} // '', $key) } @entries[0 .. $#entries - 1];
        nft_add setname($scope, $action, $key, $eports), $value;
    }
    say "created new key '$key'" if $newkey and !$quiet;
    state_save \%state;
}

# Command: delete matching declaration/kernel entries.
sub x_delete {
    require_active();
    my ($scope, @rest) = @_;
    exists $scopes{$scope} or usage "unknown scope - $scope";
    my \%props = $scopes{$scope};

    if ($props{volatile}) {
        my $set = shift @rest // usage 'need a set name (jail)';
        my $ip = normalize_cidr(shift @rest // usage 'need an address');
        nft_delete setname($scope, $set), $ip;
        return;
    }

    # action may be omitted: 'refw delete user --key=fred' offboards across allow+drop
    my @pairs = ($rest[0] && exists $actions{$rest[0]})
        ? do { my $a = shift @rest; ["$scope/$a"] }
        : [map "$scope/$_", sort keys %actions];
    my @spec = map normalize_cidr($_), @rest;
    if (defined $key) {
        $key = $props{ported} ? normalize_fwrule_key($key) : normalize_key($key);
    }
    @spec or defined $key or usage 'need an address or --key';

    my $lock = lock_state;
    my \%state = state_load;

    my @doomed;                                 # [setpath, index, entry]
    for my $setpath (map @$_, @pairs) {
        my \@entries = ($state{sets}{$setpath} //= []);
        for my $i (0 .. $#entries) {
            my \%e = $entries[$i];
            next if @spec && !grep { $_ eq $e{value} } @spec;
            if (defined $key) {
                my $ek = $e{key} // '';
                next if $props{ported} ? $ek ne $key : !key_match($ek, $key);
            }
            push @doomed, [$setpath, $i, \%e];
        }
    }
    @doomed or die "no matching entries\n";

    if (@doomed > 1 and !$all) {
        say "matches @{[scalar @doomed]} entries:";
        printf "  %-20s %-24s %s\n", $_->[0], $_->[2]{key} // '(unkeyed)', $_->[2]{value}
            for @doomed;
        $yes or confirm 'delete all?' or die "aborted\n";
    }

    !$scopes{$scope}{guard} or $yes or confirm "modify $scope (infrastructure) list?"
        or die "aborted\n";

    for my $d (reverse @doomed) {               # reverse: splice indexes stay valid
        my ($setpath, $i, $e) = @$d;
        splice @{$state{sets}{$setpath}}, $i, 1;
        my ($s, $a) = split '/', $setpath, 2;
        nft_delete setname($s, $a, $e->{key}, entry_ports($e)), $e->{value};
    }
    state_save \%state;
}

# Command: make a key partition hold exactly the given addresses.
sub x_replace {
    require_active();
    my ($scope, $action, @rest) = @_;
    exists $scopes{$scope} or usage "unknown scope - $scope";
    my \%props = $scopes{$scope};
    $props{volatile} and usage "$scope is volatile - use add/delete";
    defined $action and exists $actions{$action} or usage 'need an action';
    defined $key or usage 'replace requires --key';
    if ($props{ported}) {
        $key = normalize_fwrule_key($key);
        my $ka = (parse_fwrule_key($key))[2];
        $ka eq $action or die "fwrule key act '$ka' does not match action '$action'\n";
        defined $ports and die "--ports is for user/system; put ports in --key for fwrule\n";
    } else {
        !$props{portopt} && $action eq 'reject'
            and usage "reject is only valid for user, system, or fwrule";
        $key = normalize_key($key);
        !$props{portopt} && defined $ports
            and die "--ports is only valid for user or system scope\n";
    }
    my $eports = $props{portopt} ? normalize_user_ports($ports) : undef;

    my $lock = lock_state;
    my \%state = state_load;
    my \@entries = ($state{sets}{"$scope/$action"} //= []);

    # Interval sets reject overlapping elements (e.g. 0.0.0.0/0 and a host).
    my @values = compact_cidrs(read_values(@rest));

    # entries under the key (ported: exact signature; else prefix match) ...
    my @old = grep {
        my $ek = $entries[$_]{key} // '';
        $props{ported} ? $ek eq $key : key_match($ek, $key);
    } 0 .. $#entries;
    my %subkeys = map { ($entries[$_]{key} // '') => 1 } @old;
    if (keys %subkeys > 1 and !$all) {          # prefix spans multiple sub-paths
        say "key '$key' matches @{[scalar @old]} entries under: ",
            join ', ', sort keys %subkeys;
        $yes or confirm 'replace all of them?' or die "aborted\n";
    }
    # non-ported: value unique per ports bucket — move collisions into this key
    my %inkey = map { $_ => 1 } @old;
    my %want  = map { $_ => 1 } @values;
    my @moved = $props{ported} ? ()
        : grep {
            !$inkey{$_} and $want{$entries[$_]{value}}
            and (!$props{portopt}
                 || (entry_ports($entries[$_]) // '') eq ($eports // ''))
          } 0 .. $#entries;
    for (@moved) {
        say "moved $entries[$_]{value}: @{[$entries[$_]{key} // '(unkeyed)']} -> $key"
            unless $quiet;
    }

    !$props{guard} or $yes or confirm "modify $scope (infrastructure) list?"
        or die "aborted\n";

    my %gone = map { $_ => 1 } @old, @moved;
    # Kernel sets this replace touches: every bucket a removed entry lived
    # in, plus the target bucket.
    my %rebuild = map { $_ => [] }
        setname($scope, $action, $key, $eports),
        map { setname($scope, $action, $entries[$_]{key}, entry_ports($entries[$_])) }
            keys %gone;
    @entries = @entries[grep { !$gone{$_} } 0 .. $#entries];
    push @entries, map { +{value => $_, key => $key,
                           defined $comment ? (comment => $comment) : (),
                           defined $eports  ? (ports   => $eports)  : ()} }
        @values;
    # One atomic nft transaction reloads each touched set from the
    # declaration: no per-element execs (a 76K-entry feed paid three forks
    # per element), no empty-set window, and kernel drift self-heals.
    for my $e (@entries) {
        my $set = setname($scope, $action, $e->{key}, entry_ports($e));
        push @{$rebuild{$set}}, $e->{value} if $rebuild{$set};
    }
    nft_load_sets(\%rebuild);
    state_save \%state;
}

# Command: remove all declaration membership for a scope (and kernel elements).
# Used by sutilw for a full fwrule resync before re-adding signatures.
sub x_flush {
    require_active();
    my ($scope) = @_;
    exists $scopes{$scope} or usage "unknown scope - $scope";
    my \%props = $scopes{$scope};
    $props{volatile} and usage "cannot flush volatile scope - $scope";

    my $lock = lock_state;
    my \%state = state_load;
    # Prefer flush set (idempotent) over per-element delete: state can list
    # hosts that never made it into the kernel (e.g. after a prior overlap).
    my %sets;
    for my $action (sort keys %actions) {
        my $path = "$scope/$action";
        my \@entries = ($state{sets}{$path} //= []);
        for my $e (@entries) {
            $sets{setname($scope, $action, $e->{key}, entry_ports($e))} = 1;
        }
        @{$state{sets}{$path}} = ();
    }
    nft_flush_set($_) for sort keys %sets;    state_save \%state;
    say "flushed scope $scope" unless $quiet;
}

# Command: list set membership (declaration and/or volatile kernel sets).
sub x_list {
    my ($scope, @rest) = @_;
    # No scope → every scope (declared + any volatile sets present in the kernel).
    my $all = !defined $scope;
    my @scopes = $all
        ? sort keys %scopes
        : do { exists $scopes{$scope} or usage "unknown scope - $scope"; $scope };

    $key = normalize_key($key) if defined $key;
    my \%state = state_load;

    if ($all && $summary) {
        list_summary(\%state);
        return;
    }

    for my $sc (@scopes) {
        my \%props = $scopes{$sc};

        if ($props{volatile}) {                 # kernel-only; declaration has no contents
            my @sets;
            if (@rest) {
                @sets = shift @rest;
            } elsif ($all) {
                # Discover f2b_* sets from the live table (none is fine).
                @sets = map { s/^f2b_//r }
                    grep { /^f2b_/ }
                    map { /set (\w+)/ ? $1 : () }
                    nft {quieterr => 1}, qw(list table), @table;
            } else {
                usage 'need a set name (jail)';
            }
            for my $set (@sets) {
                my @lines = nft {quieterr => 1}, qw(list set), @table,
                    setname($sc, $set);
                if (!@lines) {
                    printf "%-6s %-6s %s\n", $sc, $set,
                        '(not in kernel — refw apply?)';
                    next;
                }
                if ($summary) {
                    # Volatile membership lives in the kernel; count the
                    # address tokens in the listing.
                    my $n = () = "@lines" =~ /\d+\.\d+\.\d+\.\d+/g;
                    printf "%-8s %-9s %-24s %-14s %6d\n", $sc, $set, '', '', $n;
                    next;
                }
                for (@lines) {
                    printf "%-6s %-6s %s\n", $sc, $set, $_;
                }
            }
            next;
        }

        # Action only applies when a single scope was named; all-scopes dump
        # always shows allow+drop.
        my @pairs = (!$all && @rest && exists $actions{$rest[0]})
            ? (shift @rest) : (sort keys %actions);
        for my $action (@pairs) {
            if ($summary) {
                summary_pair(\%state, $sc, $action);
                next;
            }
            for my \%e (@{$state{sets}{"$sc/$action"} // []}) {
                next if defined $key && !key_match($e{key} // '', $key);
                printf "%-6s %-6s %-24s %-18s %-12s %s\n", $sc, $action,
                    $e{key} // '(unkeyed)', $e{value},
                    scope_ports_label(\%e), $e{comment} // '';
            }
        }
    }
}

# One summary line per key (and ports bucket) for a scope/action pair:
# the categories, not the members.
sub summary_pair($$$) {
    my (\%state, $sc, $action) = @_;
    my %n;
    for my \%e (@{$state{sets}{"$sc/$action"} // []}) {
        next if defined $key && !key_match($e{key} // '', $key);
        $n{($e{key} // '(unkeyed)') . "\0" . scope_ports_label(\%e)}++;
    }
    for my $k (sort keys %n) {
        my ($kk, $pl) = split /\0/, $k, 2;
        printf "%-8s %-9s %-24s %-14s %6d\n", $sc, $action, $kk, $pl, $n{$k};
    }
}

# Kernel element count for one volatile fail2ban set; silent when absent.
sub summary_volatile($) {
    my $set = shift;
    my @lines = nft {quieterr => 1}, qw(list set), @table,
        setname('fail2ban', $set);
    @lines or return;
    my $n = () = "@lines" =~ /\d+\.\d+\.\d+\.\d+/g;
    printf "%-8s %-9s %-24s %-14s %6d\n", 'fail2ban', $set, '', '', $n;
}

# All-scope summary in match order: the summary reads like policy, so it
# follows the chain's precedence - allows, ban, drops, rejects, ratelimit -
# with the legacy fwrule scope and any custom volatile sets trailing.
sub list_summary($) {
    my \%state = shift;
    summary_pair(\%state, $_, 'allow') for qw(user system feed);
    summary_volatile('ban');
    summary_pair(\%state, $_, 'drop') for qw(user system feed);
    summary_pair(\%state, $_, 'reject') for qw(user system);
    summary_volatile('ratelimit');
    summary_pair(\%state, 'fwrule', $_) for sort keys %actions;
    for my $set (map { s/^f2b_//r } grep { /^f2b_/ }
                 map { /set (\w+)/ ? $1 : () }
                 nft {quieterr => 1}, qw(list table), @table) {
        next if $set eq 'ban' || $set eq 'ratelimit';
        summary_volatile($set);
    }
}

# commands - structural (cold path: declaration edit + atomic render/apply)

# Command: structural rule edit (not yet implemented).
sub x_rule {
    my $verb = shift // usage 'need add|delete|replace|list';
    # TODO: mutate declaration's literal-rule categories (stable ids = hash of
    # normalized spec); never touches the kernel - that is x_apply's job
    die "rule $verb: not yet implemented\n";
}

# Command: render rules file to nft and load it; install tc shape if needed.
sub x_apply {
    my $lock = lock_state;
    my \%rules = rules;
    my @order = order \%rules;
    my $ruleset = render \%rules, \@order;       # full nft -f text: per-chain flush,
                                                # set declarations, verbatim + generated
    if ($dryrun) {
        print $ruleset;
        if (host_has_feature('ratelimit')) {
            my $dev = default_iface() // '(no default route)';
            print "\n# shape (tc): ensure HTB ${shape_rate} crawl on dev $dev ",
                  "fwmark $shape_mark for \@f2b_ratelimit\n";
        }
        return;
    }
    my $gen = vardir 'generation.nft';
    write_file "$gen.new", $ruleset;
    sys {errok => 1}, qw(nft -f), "$gen.new" or do {
        unlink "$gen.new";
        die "apply: nft -f failed\n";
    };
    rename "$gen.new", $gen or die "can't install $gen: $!\n";
    # Remember the default-route device: boot-time renders have no route
    # to detect it from (see the <default-iface> handling in render).
    if (defined(my $dev = default_iface())) {
        my \%state = state_load;
        if (($state{iface} // '') ne $dev) {
            $state{iface} = $dev;
            state_save \%state;
        }
    }
    # tc shape needs a default route; on early boot that may be absent — nft
    # policy already loaded, so treat shape failure as a warning
    # (refw-shape.service reruns it after network-online).
    if (host_has_feature('ratelimit')) {
        eval { shape_ensure() };
        if (my $err = $@) {
            $err =~ s/\s+\z//;
            warn "apply: shape_ensure failed (nft ok): $err\n";
        }
    }
    # Boot unit is ConditionPathExists=generation.nft; enable on successful apply
    # so reboot reapplies (activate also enables; safe if already enabled).
    enable_boot_unit();
    say "applied generation file $gen" unless $quiet;
}

# Idempotently enable the systemd units: apply on boot (pre-network) and
# the tc shaper once the network is online.
sub enable_boot_unit() {
    capture {errok => 1, quiet => 1, quieterr => 1},
        qw(systemctl enable refw.service refw-shape.service);
}

sub disable_boot_unit() {
    capture {errok => 1, quiet => 1, quieterr => 1},
        qw(systemctl disable --now refw.service refw-shape.service);
}

# Command: install the tc crawl shaper (feature ratelimit). Split out of
# apply's soft-fail: refw.service applies nft before the network is up,
# where no default route exists, so refw-shape.service runs this after
# network-online. No-op when refw is inactive or the feature is off;
# dies (unit failure) if a default route is still absent.
sub x_shape {
    if (!is_active()) {
        say 'refw is not active - no shape' unless $quiet;
        return;
    }
    if (!host_has_feature('ratelimit')) {
        say 'feature ratelimit is off - no shape' unless $quiet;
        return;
    }
    shape_ensure();
}

# Command: classify live iptables/ipset content against the known legacy
# patterns and report what is left. Residue is somebody's hand-added policy
# (an allow-<user> ipset, a one-off rule) that must be migrated to refw
# membership or deliberately discarded before clean-legacy-iptables.sh may
# run; refw-cutover.sh --go --clean refuses while lint reports any.
# Read-only. Exit 0 clean, 1 residue. The pattern tables are grown
# empirically per audited host (champ-devr2, realed-web, cefree-web so far);
# only the filter and mangle tables are examined - refw does not manage nat.
sub x_lint {
    my $save = capture({errok => 1, quiet => 1, quieterr => 1},
                       qw(iptables-save)) // '';
    my $terse = capture({errok => 1, quiet => 1, quieterr => 1},
                        qw(ipset list -terse)) // '';

    # Chains owned wholesale by legacy machinery or foreign tools: their
    # creation and every rule on them is recognized.
    my $ownchain = qr/^(?:screen|rechain|logdrop|logrej|hashlim|whitelist
                       |RATELIMITED|f2b-[\w-]+|fail2ban-[\w-]+|DOCKER[\w-]*)$/x;
    # Known legacy/volatile ipset names.
    my $ownset = qr/^(?:realed-[\w.-]+|whitelist|ratelimited|f2b-[\w-]+)$/;
    # Recognized rule shapes on the shared chains (INPUT/FORWARD/OUTPUT).
    my @known = (
        qr/-j (?:screen|rechain|RATELIMITED|f2b-[\w-]+|fail2ban-[\w-]+|DOCKER[\w-]*)$/,
        qr/--match-set (?:whitelist|ratelimited|realed-[\w.-]+) /,
        qr/-i lo -j ACCEPT$/,
        qr/--ctstate (?:RELATED,ESTABLISHED|ESTABLISHED,RELATED) -j ACCEPT$/,
        qr/-m state --state (?:RELATED,ESTABLISHED|ESTABLISHED,RELATED) -j ACCEPT$/,
        qr/-p icmp\b/,
        qr/-s 146\.148\.47\.157(?:\/32)? /,         # a1 pinholes
        qr/! -s 146\.148\.47\.157(?:\/32)? -p tcp .*--dport 22 -j DROP$/,
        qr/-s 10\.\d+\.\d+\.\d+(?:\/\d+)? .*-j ACCEPT$/,   # internal net
        qr/--dports? (?:443|80,443) -j (?:ACCEPT|f2b-[\w-]+)$/,
        qr/-m multiport --dports 139,445[\d,]* -j ACCEPT$/,
        qr/-m multiport --dports 137,138 -j ACCEPT$/,
        qr/-[io] (?:docker\d*|br-\w+) /,
    );

    my $table = '';
    my (@residue, %setrules);
    for my $line (split /\n/, $save) {
        if ($line =~ /^\*(\w+)/) { $table = $1; next; }
        next if $line =~ /^(?:#|COMMIT)/;
        next unless $table eq 'filter' || $table eq 'mangle';
        if (my ($c) = $line =~ /^:(\S+) /) {
            next if $c =~ /^(?:PREROUTING|INPUT|FORWARD|OUTPUT|POSTROUTING)$/
                 || $c =~ $ownchain;
            push @residue, "[$table] chain $c";
            next;
        }
        if (my ($c) = $line =~ /^-A (\S+)/) {
            # Verdict source for set suggestions whatever chain the rule
            # lives on: a residue set is usually referenced from a
            # recognized legacy chain (rechain's allow-<user> ACCEPT).
            $line =~ /--match-set (\S+) \S+ -j (ACCEPT|DROP)\b/
                and push @{$setrules{$1}}, $2;
            next if $c =~ $ownchain;
            next if grep { $line =~ $_ } @known;
            push @residue, "[$table] $line";
        }
    }
    my @ressets;
    for my $n ($terse =~ /^Name: (\S+)$/mg) {
        next if $n =~ $ownset;
        push @ressets, $n;
        push @residue, "ipset $n"
            . ($setrules{$n} ? '' : ' (orphan - no rule references it)');
    }

    if (!@residue) {
        say 'lint: clean - no unrecognized legacy iptables/ipset content'
            unless $quiet;
        return;
    }
    say 'lint: ' . @residue . ' unrecognized item(s) - migrate to refw'
        . ' membership or remove before clean-legacy:';
    say "  $_" for @residue;
    my %done;
    for my $set (@ressets) {
        for my $verdict (@{$setrules{$set} // []}) {
            next if $done{"$set/$verdict"}++;
            say "  suggest: $_" for lint_suggest($set, $verdict);
        }
    }
    exit 1;
}

# Suggested refw membership commands for a residue ipset behind an
# ACCEPT/DROP rule: plain members in one command, ported members grouped
# by identical port signature (hash:net,port / hash:ip,port).
sub lint_suggest($$) {
    my ($set, $verdict) = @_;
    my $ls = capture({errok => 1, quiet => 1, quieterr => 1},
                     qw(ipset list), $set) // '';
    my ($mem) = $ls =~ /^Members:\n(.*)\z/ms;
    my (@plain, %ports);
    for my $m (split /\n/, $mem // '') {
        my ($addr, $rest) = split /,/, $m, 2;
        defined $addr && length $addr or next;
        if (defined $rest && $rest =~ /^(?:tcp|udp):(\d+)/) {
            $ports{$addr}{$1} = 1;
        } else {
            push @plain, $addr;
        }
    }
    my $scopeact = $verdict eq 'ACCEPT' ? 'user allow' : 'system drop';
    (my $keyname = $set) =~ s/^(?:allow|drop)-//;
    $keyname =~ s/[^\w.-]/_/g;
    my @out;
    @plain and push @out, "refw add $scopeact @plain --key=$keyname";
    my %bysig;
    for my $addr (sort keys %ports) {
        push @{$bysig{join '+', sort { $a <=> $b } keys %{$ports{$addr}}}}, $addr;
    }
    for my $sig (sort keys %bysig) {
        push @out, "refw add $scopeact @{$bysig{$sig}} --key=$keyname --ports=$sig";
    }
    @out or push @out, "(set $set is empty - refw delete nothing; just remove it)";
    return @out;
}

# Command: exit 0 if nft table present, 1 if not. Prints active/inactive unless -q.
# Self-elevates: nft is netlink, so unprivileged there is no honest answer -
# re-exec ourselves through Aia::Cmd's sudo (exec replaces this process, so
# the re-run's answer and exit status are the caller's).
sub x_isactive {
    if ($> != 0) {
        sudo {exec => 1, quiet => 1},
            abs_path($0), 'isactive', ($quiet ? '-q' : ());
    }
    my $on = is_active() ? 1 : 0;
    say $on ? 'active' : 'inactive' unless $quiet;
    exit($on ? 0 : 1);
}

# Command: load rules (even with empty sets) and enable boot apply.
# Run once after install before genfw / sutilw fwrule membership updates.
sub x_activate {
    if (is_active() && !$yes) {
        say "refw is already active" unless $quiet;
        return;
    }
    x_apply();    # creates nft table + generation.nft; enables boot unit
    say "refw activated" unless $quiet;
}

# Command: stop owning the host firewall. Keeps state.json for a later activate.
# Does not restore legacy iptables (use refw-cutover revert for that).
sub x_deactivate {
    is_active() || $yes or die "refw is not active\n";
    !$yes and !confirm('deactivate refw (delete nft table, disable boot apply)?')
        and die "aborted\n";
    unlink vardir('generation.nft');
    disable_boot_unit();
    nft {quieterr => 1}, qw(delete table), @table;
    say "refw deactivated" unless $quiet;
}

# Command: diff expected vs kernel state (not yet implemented).
sub x_verify {
    # TODO: render expected state, diff against 'nft list table', scope-aware
    # (skip volatile membership, foreign chains); exit 0 clean, else 1 line per
    # divergence + nonzero, for the 15-minute health monitor
    die "verify: not yet implemented\n";
}

# Command: print paths, host-type, features, generation, shape status.
sub x_status {
    my \%state = state_load;
    my %feat = host_features;
    say "vardir:      $vardir";
    say "etcdir:      $etcdir";
    say "table:       @table";
    say "active:      ", is_active() ? 'yes' : 'no';
    say "host-type:   ", host_type;
    for my $t (@host_types) {
        my $fn = "is$t";
        printf "is%-10s %s\n", "$t:", main->can($fn) && $fn->() ? 'yes' : 'no';
    }
    say "features:    ", join(' ', sort keys %feat) || '(none)';
    say "generation:  ", $state{generation} // 0;
    say "declared:    ", join ' ', map { "$_=" . scalar @{$state{sets}{$_}} }
        sort keys %{$state{sets} // {}};
    if (host_has_feature('ratelimit')) {
        say "shape:       ", shape_status();
    }
}

# Human-oriented view of the firewall shape (what list/status omit).
#   refw show           - at-a-glance flow (no nft jargon)
#   refw show --raw     - only the rendered nft document (what apply would load)
#   refw show --live    - only what is in the kernel right now (nft table + tc)
# Command: human policy flow, or --raw/--live machine dumps.
sub x_show {
    my \%rules = rules;
    my @order = order \%rules;
    my $dev = default_iface();

    # Machine-oriented modes: no human tree.
    if ($raw || $dryrun) {
        print render(\%rules, \@order);
        if (host_has_feature('ratelimit')) {
            print "\n# tc on apply: HTB ${shape_rate} on ",
                  ($dev // '(no default route)'),
                  " fwmark $shape_mark for \@f2b_ratelimit\n";
        }
        show_live($dev) if $live || $all;
        return;
    }
    if ($live || $all) {
        show_live($dev);
        return;
    }

    my %feat = host_features;
    my \%state = state_load;
    # Only probe sets that apply on this host (ratelimit is optional).
    my @f2b_sets = ('ban');
    push @f2b_sets, 'ratelimit' if $feat{ratelimit} || $feat{fail2ban};
    my %f2b = map { $_ => [volatile_set_members($_)] } @f2b_sets;
    my @steps = policy_steps(\%rules, \@order, $state{sets} // {}, \%f2b);

    my $feat = join(', ', sort keys %feat) || 'none';
    say "Firewall shape";
    say "  host-type  ", host_type;
    say "  features   $feat";
    say "  table      @table";
    say "";

    # ---- inbound flow (set membership listed under each set rule) ----
    say "INBOUND  ($chain)  — first match wins; default ──→  DROP";
    say "│";
    if (!@steps) {
        say "│  (no active rules)";
        say "│";
    } else {
        for my $s (@steps) {
            say "├─ $s->{title}";
            my @lines = @{$s->{lines}};
            for my $j (0 .. $#lines) {
                my $leaf = ($j == $#lines) ? '└─' : '├─';
                say "│     $leaf $lines[$j]";
            }
            say "│";
        }
    }
    say "└─ anything else  ──────────────────────────────→  DROP";
    say "";

    # ---- outbound / crawl ----
    if (host_has_feature('ratelimit')) {
        my $iface = $dev // '(no default route)';
        my @ips = @{$f2b{ratelimit} // []};
        say "OUTBOUND  ($shape_chain)  — default ──→  accept (no filter)";
        say "│";
        say "└─ HTTP/HTTPS reply to address in set \"ratelimit\"";
        say "      ──→  mark ──→  crawl ${shape_rate} on $iface";
        if (@ips) {
            say "│     └─ currently:";
            printf "│           %s\n", $_ for @ips;
        } else {
            say "│     └─ (none listed)";
        }
        say "";
    }

    say "Skipped targets (inactive for this host):";
    my $skip = 0;
    for my $target (@order) {
        next if target_active($target);
        say "  · $target";
        $skip = 1;
    }
    say "  (none)" unless $skip;
    say "";
    say "# refw show --raw    nft rules apply would load";
    say "# refw show --live   what the kernel has loaded right now";
}

# Print live nft table (and tc) for the refw firewall.
sub show_live(;$) {
    my ($dev) = @_;
    $dev //= default_iface();
    my $nft_out = capture {errok => 1, quiet => 1, quieterr => 1},
        qw(nft list table), @table;
    if ($nft_out && $nft_out =~ /\S/) {
        print $nft_out;
        print "\n" unless $nft_out =~ /\n\z/;
    } else {
        say "# (table @table missing or unreadable — apply not run yet?)";
    }
    if (host_has_feature('ratelimit') && $dev) {
        say "# tc on $dev:";
        for my $sub (qw(qdisc class filter)) {
            my $o = capture {errok => 1, quiet => 1, quieterr => 1},
                qw(tc), $sub, qw(show dev), $dev;
            print $o if $o && $o =~ /\S/;
            print "\n" if $o && $o !~ /\n\z/;
        }
    }
    my $gen = vardir 'generation.nft';
    say "# last apply file: ", (-e $gen ? $gen : "(none)");
}

# Build ordered human-readable steps for show (with set membership).
sub policy_steps($$$$) {
    my (\%rules, \@order, \%declared, \%f2b) = @_;
    my @steps;
    for my $target (@order) {
        target_active($target) or next;
        (my $bare = $target) =~ s/\?$//;
        my (@lines, $title);

        if ($bare eq 'fwrule-matches') {
            $title = 'fwrule  (DB / staff UI — port signatures)';
            my @ml = fwrule_match_lines({sets => \%declared});
            if (@ml) {
                for my $act (sort { $act_order{$a} <=> $act_order{$b} } keys %act_order) {
                    my %bykey;
                    for my $e (@{$declared{"fwrule/$act"} // []}) {
                        push @{$bykey{$e->{key} // next}}, $e;
                    }
                    for my $sig (sort keys %bykey) {
                        my $verdict = $act eq 'allow' ? 'ACCEPT' : uc $act;
                        push @lines, "if source in $sig  ──→  $verdict";
                        for my $e (@{$bykey{$sig}}) {
                            push @lines, sprintf '    %-18s  %s',
                                ($e->{comment} // ''), $e->{value};
                        }
                    }
                }
            } else {
                push @lines, '(none listed)';
            }
        } elsif (my ($scope, $action) = $bare =~ /^set-(\w+)-(allow|drop|reject)$/) {
            my $verb = uc scope_verdict($action);
            $verb = 'ACCEPT' if $verb eq 'ACCEPT';  # already
            $title = $scopes{$scope}{portopt}
                ? "$scope $action  (key = name/role; optional ports)"
                : "if source in $scope/$action  ──→  $verb";
            my @entries = @{$declared{"$scope/$action"} // []};
            if (@entries) {
                for my $e (@entries) {
                    my $k = $e->{key} // '(unkeyed)';
                    my $pl = scope_ports_label($e);
                    my $cmt = defined $e->{comment} && length $e->{comment}
                        ? "  # $e->{comment}" : '';
                    if ($scopes{$scope}{portopt}) {
                        push @lines, sprintf '%-20s  %-18s  %s%s',
                            $k, $e->{value}, $pl, $cmt;
                    } else {
                        push @lines, sprintf '%-20s  %s%s', $k, $e->{value}, $cmt;
                    }
                }
            } else {
                push @lines, '(none listed)';
            }
        } else {
            my @frags = @{$rules{$target}{actions} // []};
            @frags or next;                     # pure ordering nodes
            ($title = $bare) =~ s/-/ /g;
            $title = "rule  $title";
            $title .= "  [optional]" if $target =~ /\?$/;
            push @lines, explain_rule($_) for @frags;
            # Attach live fail2ban members under the rule that references them.
            if ("@frags" =~ /\@f2b_ban\b/) {
                my @ips = @{$f2b{ban} // []};
                push @lines, @ips
                    ? map { "listed: $_" } @ips
                    : '(none listed in f2b_ban)';
            }
            if ("@frags" =~ /\@f2b_ratelimit\b/) {
                my @ips = @{$f2b{ratelimit} // []};
                push @lines, @ips
                    ? map { "listed: $_" } @ips
                    : '(none listed in f2b_ratelimit)';
            }
        }
        push @steps, {title => $title, lines => \@lines} if @lines;
    }
    return @steps;
}

# Return live IP/CIDR elements of a fail2ban volatile set.
# Missing table/set is normal before apply (or after a ruleset wipe) — quieterr
# so show does not dump nft "No such file or directory" noise.
sub volatile_set_members($) {
    my $js = shift;
    my $sn = setname('fail2ban', $js);
    my $out = capture {errok => 1, quiet => 1, quieterr => 1},
        qw(nft list set), @table, $sn;
    return () unless $out && $out =~ /elements\s*=\s*\{([^}]*)\}/s;
    # timeout / expires tokens may appear after each address; take only IPs.
    return $1 =~ /(\d+\.\d+\.\d+\.\d+(?:\/\d+)?)/g;
}

# Turn one nft rule fragment into a short plain-language line.
sub explain_rule($) {
    local $_ = shift;
    s/^\s+|\s+$//g;

    return 'loopback  ──────────────────────────────→  ACCEPT' if /^iif lo\b.*accept/;
    return "on $1 from $2  ───────────────────────→  ACCEPT"
        if /^iifname "([^"]+)" ip saddr (\S+) accept/;
    return 'established / related connection  ────→  ACCEPT'
        if /^ct state related,established accept/
        || /^ct state established,related accept/;
    return 'ICMP "fragmentation needed"  ─────────→  ACCEPT'
        if /icmp type destination-unreachable.*(?:frag-needed|icmp code 4).*accept/;
    return "new ICMP (rate ≤ $1)  ────────────────→  ACCEPT"
        if /ip protocol icmp ct state new limit rate (\S+) accept/;
    return "from $1 · TCP port $2  ───────────────→  ACCEPT"
        if /^ip saddr (\S+) tcp dport (\d+) accept/;
    return "from $1 · TCP ports $2  ──────────────→  ACCEPT"
        if /^ip saddr (\S+) tcp dport \{ ([^}]+) \} accept/;
    return "from \{$1\} · TCP port $2  ───────────→  ACCEPT"
        if /^ip saddr \{ ([^}]+) \} tcp dport (\d+) accept/;
    return "from \{$1\} · TCP ports $2  ──────────→  ACCEPT"
        if /^ip saddr \{ ([^}]+) \} tcp dport \{ ([^}]+) \} accept/;
    return "from $1 · TCP port $2  ───────────────→  REJECT"
        if /^ip saddr (\S+) tcp dport (\d+) reject/;
    return "from $1 · TCP port $2  ─────────────────→  DROP"
        if /^ip saddr (\S+) tcp dport (\d+) drop/;
    return "from $1 · UDP port $2  ───────────────→  ACCEPT"
        if /^ip saddr (\S+) udp dport (\d+) accept/;

    if (/^ip saddr \@(\w+) accept/) {
        return sprintf 'source in set "%s"  ──────────────→  ACCEPT', $1;
    }
    if (/^ip saddr \@(\w+) drop/) {
        return sprintf 'source in set "%s"  ────────────────→  DROP', $1;
    }
    if (/^ip saddr \@(\w+) tcp dport \{ ([^}]+) \} ct state new limit rate over (\S+) burst (\d+) packets drop/) {
        return "from set \"$1\" · new TCP [$2] over $3 (burst $4)  ──→  DROP";
    }
    if (/^ip daddr \@(\w+) tcp sport \{ ([^}]+) \} meta mark set/) {
        return "HTTP(S) reply to set \"$1\"  ──→  mark ──→  ${shape_rate} crawl";
    }
    if (/^ip saddr (\S+) drop/) {
        return "from $1  ────────────────────────────→  DROP";
    }
    if (/^ip saddr (\S+) accept/) {
        return "from $1  ────────────────────────────→  ACCEPT";
    }

    # fallback: keep raw but still with an arrow so the tree stays consistent
    return "$_  ──→  (see raw nft)";
}

# functions

# Interactive y/N prompt; false if stdin is not a tty.
sub confirm($@) {
    my $prompt = shift;
    -t STDIN or return 0;                       # non-interactive: require --yes
    print "$prompt [y/N] ";
    return <STDIN> =~ /^y/i;
}

# True if entry key equals want or is under want/ (prefix match).
sub key_match($$) {
    my ($have, $want) = @_;
    return $have eq $want || index($have, "$want/") == 0;
}

# Take an exclusive flock on the vardir lock file; hold via returned handle.
sub lock_state() {
    open my $fh, '>>', vardir 'lock' or die "can't open lock: $!\n";
    flock $fh, LOCK_EX or die "can't lock: $!\n";
    return $fh;                                 # released when handle goes away
}

# Run nft as root (quiet, non-fatal); return captured output.
# $opt may set quieterr (hide expected failures: missing set/element).
# Caller (sutilw / operator) must already be root — no sudo.
# Pass verbs and table as separate words: nft qw(list set), @table, $set.
sub nft(@) {
    my %opt = (chomp => 1, errok => 1, quiet => 1);
    if (ref $_[0] eq 'HASH') {
        %opt = (%opt, %{shift @_});
    }
    return capture \%opt, 'nft', @_;
}

# Ensure set exists, then add an element (optional timeout).
sub nft_add(@) {
    my ($set, $value, $timeout) = @_;
    nft_ensure_set $set;                         # spring table+set into place
    nft qw(add element), @table, $set,
        '{', $value, ($timeout ? (qw(timeout), "${timeout}s") : ()), '}';
}

# Idempotently create table + named set (inert until apply).
sub nft_ensure_set($) {
    my $set = shift;
    my $flags = $set =~ /^f2b_/ ? 'interval, timeout' : 'interval';
    nft qw(add table), @table;
    nft qw(add set), @table, $set, "{ type ipv4_addr; flags $flags; }";
}

# Delete one element from a kernel set (ok if set/element already gone).
sub nft_delete(@) {
    my ($set, $value) = @_;
    nft {quieterr => 1}, qw(delete element), @table, $set, '{', $value, '}';
}

# Flush all elements from a kernel set (ok if set missing).
sub nft_flush_set($) {
    nft {quieterr => 1}, qw(flush set), @table, $_[0];
}

# Atomically (re)load kernel sets from declared membership: one nft -f
# transaction creates/flushes each set and loads its elements, so there is
# never an empty-set window and kernel drift self-heals. Values are
# compacted per set: an interval set rejects overlapping members, and
# members from different keys may nest (the declaration keeps both; the
# kernel carries the covering range).
sub nft_load_sets($) {
    my \%bysets = shift;                        # set name => [values]
    my $doc = "add table @table\n";
    for my $set (sort keys %bysets) {
        my $flags = $set =~ /^f2b_/ ? 'interval, timeout' : 'interval';
        $doc .= "add set @table $set { type ipv4_addr; flags $flags; }\n";
        $doc .= "flush set @table $set\n";
        my @v = compact_cidrs(@{$bysets{$set}});
        while (my @chunk = splice @v, 0, 1000) {
            $doc .= "add element @table $set { " . join(', ', @chunk) . " }\n";
        }
    }
    my $tmp = vardir 'setload.nft.new';
    write_file $tmp, $doc;
    my $ok = sys {errok => 1, quiet => 1}, qw(nft -f), $tmp;
    unlink $tmp;
    $ok or die "nft -f set load failed\n";
}

# Collect addresses from argv, or from stdin when a lone "-" is given.
# "-" may not be mixed with other address operands.
sub read_values(@) {
    my @rest = @_;
    @rest or usage 'need at least one address (or - to read stdin)';
    if (grep { $_ eq '-' } @rest) {
        @rest == 1 or usage 'cannot mix - with address arguments';
        my @values = map normalize_cidr($_), grep length, read_file(\*STDIN, chomp => 1);
        @values or usage 'need at least one address on stdin';
        return @values;
    }
    return map normalize_cidr($_), @rest;
}

# Validate and normalize an IPv4 address or CIDR string.
sub normalize_cidr($) {
    my $in = my $cidr = shift;
    my ($ip, $len) = split '/', $cidr;
    my @o = split /\./, $ip;
    @o >= 1 && @o <= 4 && !grep { !/^\d+$/ || $_ > 255 } @o
        or die "bad address - $in\n";
    push @o, 0 while @o < 4;                    # 10.0.0/8 -> 10.0.0.0/8
    defined $len and ($len =~ /^\d+$/ && $len <= 32 or die "bad prefix - $in\n");
    return join('.', @o) . (defined $len && $len < 32 ? "/$len" : '');
}

# Inclusive IPv4 range and prefix length for a normalized CIDR (host => /32).
sub cidr_range($) {
    my $cidr = shift;
    my ($ip, $len) = $cidr =~ m{^([\d.]+)(?:/(\d+))?$} or return;
    $len = 32 unless defined $len;
    my $n = unpack 'N', pack 'C4', split /\./, $ip;
    my $mask = $len == 0 ? 0 : (0xffffffff << (32 - $len)) & 0xffffffff;
    my $start = $n & $mask;
    my $end   = $start | (~$mask & 0xffffffff);
    return ($start, $end, $len);
}

# True if CIDR $a fully covers CIDR $b (equal ranges count as cover).
sub cidr_covers($$) {
    my ($a, $b) = @_;
    my ($as, $ae) = cidr_range($a) or return 0;
    my ($bs, $be) = cidr_range($b) or return 0;
    return $bs >= $as && $be <= $ae;
}

# Drop addresses fully covered by a broader (or equal) peer in the same list.
# nft interval sets reject overlapping elements (0.0.0.0/0 vs a host).
# Sorted sweep, O(n log n): ordered by start (broadest first on ties), an
# entry is covered iff it ends at or before the furthest end already kept -
# CIDRs never partially overlap, so containment is the only overlap.
sub compact_cidrs(@) {
    my @parsed;
    for my $c (@_) {
        my ($s, $e) = cidr_range($c) or next;
        push @parsed, [$s, $e, $c];
    }
    @parsed = sort { $a->[0] <=> $b->[0] || $b->[1] <=> $a->[1] } @parsed;
    my $maxend = -1;
    my @keep;
    for my $c (@parsed) {
        next if $c->[1] <= $maxend;
        $maxend = $c->[1];
        push @keep, $c->[2];
    }
    return @keep;
}

# Validate and normalize a hierarchical entry key path.
sub normalize_key($) {
    my $key = shift;
    $key =~ s/^\s+|\s+$//g;
    $key =~ s,/+,/,g;
    $key =~ s,^/|/$,,g;
    $key =~ m{^[\w.-]+(?:/[\w.-]+)*$} or die "bad key - $key\n";
    return $key;
}

# True if /etc/apache2/sites-enabled has at least one entry.
sub apache_sites_enabled() {
    my $dir = '/etc/apache2/sites-enabled';
    return 0 unless -d $dir;
    opendir my $dh, $dir or return 0;
    return scalar(grep { !/^\.\.?$/ } readdir $dh) ? 1 : 0;
}

# is* predicates — one per host type (realed web server admin dev vpn).
# isrealed / isdev come from RealEd. The rest are local. Several can be true
# at once (e.g. isrealed+isdev on a realed dev box); detect_host_type picks
# one exclusive host_type string for classification.

# True if the RealEd vpn binary is installed.
sub isvpn() {
    return -e $vpn_bin;
}

# True for non-realed/non-dev/non-vpn hosts with apache sites enabled.
sub isweb() {
    return 0 if isrealed() || isdev() || isvpn();
    return apache_sites_enabled();
}

# True for residual hosts that are not realed/dev/vpn/web.
sub isserver() {
    return 0 if isrealed() || isdev() || isvpn() || isweb();
    return 1;
}

# True when effective host_type is admin (--type or type file).
sub isadmin() {
    return host_type() eq 'admin';
}

# Auto-detect exclusive host_type string from flags and layout.
sub detect_host_type() {
    return 'realed' if isrealed();
    return 'dev'    if isdev();
    return 'vpn'    if isvpn();
    return 'web'    if isweb();
    return 'server';
}

# Effective host type: --type, type file, or detect_host_type().
sub host_type() {
    state $cached;
    return $cached if defined $cached;

    my $pick;
    if (defined $type) {
        $pick = $type;
    } else {
        for my $file ("$etcdir/type", vardir 'type') {
            -e $file or next;
            my $raw = read_file($file);
            $raw =~ s/#.*//mg;
            ($pick) = $raw =~ /(\S+)/;
            defined $pick or die "empty host type in $file\n";
            last;
        }
    }
    $pick //= detect_host_type;
    $pick =~ /^(?:$host_type_re)$/ or die "unknown host type '$pick' "
        . "(want @{[join '|', @host_types]})\n";
    return $cached = $pick;
}

# Whether a -TYPE? rules suffix should fire (via isTYPE).
sub host_type_active($) {
    my $want = shift;
    my $fn = "is$want";
    die "unknown host type for conditional - $want\n" unless main->can($fn);
    return $fn->();
}

# Feature set for ?-conditionals (file or defaults).
sub host_features() {
    state $cached;
    return %$cached if $cached;

    my %feat;
    my $from_file;
    for my $file ("$etcdir/features", vardir 'features') {
        -e $file or next;
        $from_file = 1;
        for (read_file($file, chomp => 1)) {
            s/#.*//;
            next unless /\S/;
            $feat{$_} = 1 for grep length, split /[\s,]+/;
        }
        last;
    }
    if (!$from_file) {
        my $ht = host_type;
        $feat{feed} = 1 if $ht eq 'web';
        if (-d '/etc/fail2ban') {
            $feat{fail2ban} = 1;
            # Soft crawl for ambiguous DoS (ratelimiter-realed → f2b_ratelimit).
            $feat{ratelimit} = 1;
        }
    }
    $cached = \%feat;
    return %feat;
}

# True if the named feature is enabled for this host.
sub host_has_feature($) {
    my %feat = host_features;
    return !!$feat{$_[0]};
}

# True if a rules-file target should be emitted by render.
sub target_active($) {
    my $target = shift;
    return 1 unless $target =~ s/\?$//;          # strip marker; bare name remains

    if ($target =~ /-($host_type_re)$/) {
        return host_type_active($1);
    }
    if (my ($feat) = $target =~ /^set-(\w+)-(?:allow|drop)$/) {
        return host_has_feature($feat);
    }
    return host_has_feature($target);
}

# Build full nft -f text from ordered rules (and optional shape chain).
sub render($$) {
    my (\%rules, \@order) = @_;

    # Chain body: walk the dependency order, emit each target's contribution.
    #   set-<scope>-<action>  -> generated "ip saddr @<scope>_<action> verdict"
    #   anything else         -> its verbatim nft fragments (may be none)
    # A trailing '?' marks a host-type or feature conditional: skipped when
    # target_active() is false (see host_type / host_features).
    my \%state = state_load;
    my @body;
    for my $target (@order) {
        target_active($target) or next;
        (my $name = $target) =~ s/\?$//;
        if ($name eq 'fwrule-matches') {
            # Dynamic matches from fwrule scope membership (ported signatures).
            push @body, fwrule_match_lines(\%state);
            next;
        }
        if (my ($scope, $action) = $name =~ /^set-(\w+)-(allow|drop|reject)$/) {
            if ($scopes{$scope}{portopt}) {
                push @body, scope_match_lines(\%state, $scope, $action);
            } else {
                push @body, "ip saddr \@${scope}_${action} "
                          . scope_verdict($action);
            }
        } else {
            push @body, @{$rules{$target}{actions} // []};
        }
    }

    # Bind <default-iface> fragments to the default-route device. Boot
    # applies run pre-network (no route yet), so fall back to the device
    # the last routed apply recorded; a vanished or unknown device drops
    # the qualifier - an unqualified match beats one that never fires.
    my $iface = default_iface() // $state{iface};
    defined $iface && !-e "/sys/class/net/$iface" and undef $iface;
    for (@body) {
        /<default-iface>/ or next;
        if (defined $iface) {
            s/<default-iface>/$iface/g;
        } else {
            s/iifname "<default-iface>" //;
        }
    }

    # Declare exactly the sets the body references (@name). f2b_* are the
    # volatile fail2ban sets (need timeout); the rest hold CIDRs (interval).
    my %used;
    my $refs = "@body";
    $used{$1} = 1 while $refs =~ /\@(\w+)/g;
    my $shape = host_has_feature('ratelimit');
    $used{f2b_ratelimit} = 1 if $shape;
    my %elements;
    for my $sc (keys %scopes) {
        next if $scopes{$sc}{volatile};
        for my $act (keys %actions) {
            for my $e (@{$state{sets}{"$sc/$act"} // []}) {
                my $name = setname($sc, $act, $e->{key}, entry_ports($e));
                $used{$name} = 1;
                push @{$elements{$name}}, $e->{value};
            }
        }
    }

    # Declared membership goes into the generation file, so the boot-time
    # apply restores members rather than empty sets. nft merges elements
    # into an existing set, so live membership still survives a re-apply;
    # f2b_* sets stay volatile (fail2ban repopulates them itself).
    my $sets = join "\n", map {
        my $flags = /^f2b_/ ? 'interval, timeout' : 'interval';
        my $el = $elements{$_}
            ? "\n\t\telements = { " . join(",\n\t\t\t", @{$elements{$_}}) . " }\n\t"
            : ' ';
        "\tset $_ { type ipv4_addr; flags $flags;$el}"
    } sort keys %used;

    my $body = join "\n", map "\t\t$_", @body;
    my $hook_in  = 'type filter hook input priority 0; policy drop;';
    my $hook_out = 'type filter hook output priority 0; policy accept;';

    # Output "shape" chain: mark HTTP(S) replies to @f2b_ratelimit so tc can
    # crawl them at $shape_rate (see shape_ensure). Only when feature on.
    my ($shape_boot, $shape_body) = ('', '');
    if ($shape) {
        $shape_boot = <<EOT;
add chain @table $shape_chain { $hook_out }
flush chain @table $shape_chain
EOT
        $shape_body = <<EOT;

\tchain $shape_chain {
\t\t$hook_out
\t\tip daddr \@f2b_ratelimit tcp sport { 80, 443 } meta mark set $shape_mark
\t}
EOT
    }

    # Bootstrap (create table+base chain if absent), flush only chains so
    # set membership survives, then load sets and rules in one transaction.
    return <<EOT;
#!/usr/sbin/nft -f
# generated by refw - do not edit; source is the rules file + state.json.
# per-chain flush (never flush table/set) preserves set membership on apply;
# declared elements below restore membership when loaded on a fresh boot.

add table @table
add chain @table $chain { $hook_in }
flush chain @table $chain
$shape_boot
table @table {
$sets

\tchain $chain {
\t\t$hook_in
$body
\t}
$shape_body}
EOT
}

# Default-route IPv4 interface name (for tc shape). Undef if none / ip failed.
sub default_iface() {
    my $out = capture {chomp => 1, errok => 1, quiet => 1, quieterr => 1},
        qw(ip -4 route show default);
    for (split /\n/, $out // '') {
        return $1 if /\bdev\s+(\S+)/;
    }
    return;
}

# Install HTB 1mbit crawl qdisc/filter on the default interface.
sub shape_ensure() {
    my $dev = default_iface()
        // die "no default IPv4 route; cannot install tc shape\n";
    # No root qdisc yet → "handle of zero"; ignore. quieterr hides the noise.
    capture {errok => 1, quiet => 1, quieterr => 1},
        qw(tc qdisc del dev), $dev, 'root';
    # quiet only: die on hard tc failures (sys prints the failing command line).
    my %q = (quiet => 1);
    sys \%q, qw(tc qdisc add dev), $dev, qw(root handle 1: htb default 10);
    sys \%q, qw(tc class add dev), $dev, qw(parent 1: classid 1:1 htb rate 100mbit);
    sys \%q, qw(tc class add dev), $dev, qw(parent 1:1 classid 1:10 htb rate 100mbit);
    sys \%q, qw(tc class add dev), $dev, qw(parent 1:1 classid 1:2 htb rate),
        $shape_rate, 'ceil', $shape_rate;
    sys \%q, qw(tc qdisc add dev), $dev, qw(parent 1:2 sfq perturb 10);
    sys \%q, qw(tc filter add dev), $dev, qw(protocol ip parent 1: prio 1 handle),
        $shape_mark, qw(fw flowid 1:2);
    say "shape: $dev HTB crawl $shape_rate mark $shape_mark" unless $quiet;
}

# One-line summary of tc shape state on the default interface.
sub shape_status() {
    my $dev = default_iface();
    return 'no default route' unless defined $dev;
    my $q = capture {chomp => 1, errok => 1, quiet => 1, quieterr => 1},
        qw(tc qdisc show dev), $dev;
    return "$dev (no root qdisc)" unless $q && $q =~ /\S/;
    my $ok = ($q =~ /qdisc htb 1:/) ? 'htb 1: ok' : 'foreign/missing htb 1:';
    return "$dev $ok";
}

# Map scope+action (or jail name) to kernel set name.
# ported fwrule: key signature → fw_tcp_22_allow
# portopt user/system: optional ports → user_allow_p22_80_443; omit = user_allow
sub setname(@) {
    my ($scope, $x, $key, $ports) = @_;
    if ($scopes{$scope}{volatile}) {
        $x =~ /^\w+$/ or die "bad set name - $x\n";
        return "f2b_$x";
    }
    if ($scopes{$scope}{ported} && defined $key && length $key) {
        my $s = $key;
        $s =~ s#[+/]#_#g;
        $s =~ s#-#r#g;                          # keep ranges distinct: 1-2 vs 12
        $s =~ s#[^A-Za-z0-9_]##g;
        $s =~ s#_+#_#g;
        return "fw_$s";
    }
    if ($scopes{$scope}{portopt}) {
        my $base = "${scope}_$x";
        return $base unless defined $ports && length $ports;
        (my $s = $ports) =~ s/\+/_/g;
        $s =~ s/-/r/g;                          # keep ranges distinct: 80-88 vs 8088
        $s =~ s#[^A-Za-z0-9_]##g;
        return "${base}_p$s";
    }
    return "${scope}_${x}";
}

# Optional ports field on a declaration entry (undef/'' => all ports).
sub entry_ports($) {
    my $e = shift;
    return undef unless ref $e eq 'HASH';
    my $p = $e->{ports};
    return undef unless defined $p && length $p;
    return $p;
}

# Normalize --ports for portopt scopes: undef/empty/all/* => all ports.
sub normalize_user_ports($) {
    my $raw = shift;
    return undef unless defined $raw;
    $raw =~ s/^\s+|\s+$//g;
    return undef unless length $raw;
    return undef if $raw =~ /^(?:all|\*)\z/i;
    return normalize_ports($raw);
}

sub scope_ports_label($) {
    my $e = shift;
    my $p = entry_ports($e);
    return defined $p ? "tcp/$p" : 'all-ports';
}

sub scope_verdict($) {
    my $action = shift;
    return 'accept' if $action eq 'allow';
    return $action;                             # drop | reject
}

# Match lines for portopt scopes: one line per distinct ports bucket.
sub scope_match_lines($$$) {
    my (\%state, $scope, $action) = @_;
    my $verdict = scope_verdict($action);
    my %buckets;
    for my $e (@{$state{sets}{"$scope/$action"} // []}) {
        $buckets{entry_ports($e) // ''} = 1;
    }
    $buckets{''} = 1 unless keys %buckets;
    my @lines;
    for my $pk (sort { length($a) <=> length($b) || $a cmp $b } keys %buckets) {
        my $ports = length $pk ? $pk : undef;
        my $set = setname($scope, $action, undef, $ports);
        if (defined $ports) {
            push @lines, "ip saddr \@$set tcp " . ports_to_nft($ports) . " $verdict";
        } else {
            push @lines, "ip saddr \@$set $verdict";
        }
    }
    return @lines;
}

# Normalize fwrule signature key: proto/ports/act (accept -> allow).
# Ports may be comma- or plus-separated; result uses +.
sub normalize_fwrule_key($) {
    my $raw = shift;
    $raw =~ s/^\s+|\s+$//g;
    my ($proto, $ports, $act) = $raw =~ m{\A([a-zA-Z]+)/([^/]+)/([a-zA-Z]+)\z}
        or die "bad fwrule key - $raw (want proto/ports/act)\n";
    $proto = lc $proto;
    $proto =~ /\A(?:tcp|udp)\z/ or die "bad fwrule proto - $proto\n";
    $act = lc $act;
    $act = 'allow' if $act eq 'accept';
    exists $actions{$act} or die "bad fwrule act - $act\n";
    return "$proto/" . normalize_ports($ports) . "/$act";
}

# Sort/unique port tokens; join with + for keys.
sub normalize_ports($) {
    my $ports = shift;
    $ports =~ s/,/+/g;
    my @p = split /\+/, $ports;
    my $rng = qr/\A\d+(?:-\d+)?\z/;
    for (@p) {
        s/^\s+|\s+$//g;
        /$rng/ or die "bad port or range - $_\n";
    }
    my %seen;
    @p = sort {
        my ($a1) = $a =~ /^(\d+)/;
        my ($b1) = $b =~ /^(\d+)/;
        $a1 <=> $b1 || $a cmp $b;
    } grep { !$seen{$_}++ } @p;
    @p or die "empty port list\n";
    return join '+', @p;
}

# Parse normalized fwrule key into (proto, ports_plus_sep, act).
sub parse_fwrule_key($) {
    my $key = shift;
    my ($proto, $ports, $act) = $key =~ m{\A([a-z]+)/([^/]+)/([a-z]+)\z}
        or die "bad fwrule key - $key\n";
    return ($proto, $ports, $act);
}

# nft dport clause from plus-separated port list.
sub ports_to_nft($) {
    my $ports = shift;
    my @p = split /\+/, $ports;
    return @p == 1 ? "dport $p[0]" : 'dport { ' . join(', ', @p) . ' }';
}

# Ordered fwrule match lines from declaration (allow, then drop, then reject).
sub fwrule_match_lines($) {
    my \%state = shift;
    my @lines;
    for my $act (sort { $act_order{$a} <=> $act_order{$b} } keys %act_order) {
        my %bykey;
        for my $e (@{$state{sets}{"fwrule/$act"} // []}) {
            my $k = $e->{key} // next;
            $bykey{$k} = 1;
        }
        for my $sig (sort keys %bykey) {
            my ($proto, $ports, $a) = parse_fwrule_key($sig);
            my $set = setname('fwrule', $act, $sig);
            my $verdict = $act eq 'allow' ? 'accept' : $act;
            push @lines, "ip saddr \@$set $proto " . ports_to_nft($ports) . " $verdict";
        }
    }
    return @lines;
}

# Load declaration state.json (or empty structure).
sub state_load() {
    my $file = vardir 'state.json';
    -e $file or return {generation => 0, sets => {}};
    return decode_json scalar read_file $file;
}

# Atomically write state.json and bump generation.
sub state_save($) {
    my \%state = shift;
    $state{generation}++;
    my $file = vardir 'state.json';
    write_file "$file.new", JSON::PP->new->canonical->pretty->encode(\%state);
    rename "$file.new", $file or die "can't install $file: $!\n";
}

# Print usage to stderr and exit 2 (optional error message).
sub usage(;$) {
    my $msg = shift;
    print STDERR "refw: $msg\n" if $msg;
    print STDERR <<'EOT';
usage: refw <command> ...
  refw add     <scope> <action> <cidr>...|- [--key=path] [--comment=text]
  refw add     user|system <action> <cidr>...|- --key=name [--ports=list]
  refw add     fail2ban <set> <ip> [--timeout=secs]
  refw delete  <scope> [<action>] [<cidr>...] [--key=path] [--all]
  refw replace <scope> <action> <cidr>...|- --key=path [--ports=list] [--all]
  refw list    [<scope> [<action>]] [--key=path] [-s|--summary]
  refw show    [--raw] [--live]   # human policy flow (or raw nft / live kernel)
  refw flush   <scope>            # clear all membership for a scope
  refw rule    add|delete|replace|list ...
  refw apply   [--dry-run]  refw verify [--quiet]  refw status
  refw shape                # (re)install tc crawl shaper (refw-shape.service)
  refw lint                 # exit 1 + report unmigrated legacy iptables/ipset
  refw isactive             # exit 0 if nft table present (self-elevates via sudo)
  refw activate             # apply + enable boot unit
  refw deactivate [--yes]   # drop nft table + generation.nft, disable boot unit
scopes: user system feed fwrule(fail2ban legacy ported) fail2ban
actions: allow drop reject (reject: user/system/fwrule)
--ports (user|system): omit or all|* = any port; else TCP (22,80,443 or 22+80+443)
EOT
    exit 2;
}

# Path under the refw variable directory for a basename.
sub vardir($) {
    return "$vardir/$_[0]";
}

# rules-file parsing and ordering, carried over from the previous refw

# Parse the makefile-style rules file into a dependency graph.
# Prefer $etcdir/rules (packaged/admin config), else $vardir/rules.
sub rules() {
    my $path = -e "$etcdir/rules" ? "$etcdir/rules" : vardir 'rules';
    -e $path or die "refw: rules file not found ($etcdir/rules or "
        . vardir('rules') . ")\n";
    $. = 0;
    my $err;
    my ($rule, %rules, %sets);
    for (read_file($path, chomp => 1)) {
        $.++;
        s/\s*#.*$//;
        length or next;
        if (/^\t(.*)/) {
            $rule or $err = print STDERR "$path: line $., indented line before a target - $_\n";
            push @{$rules{$rule}{actions}}, $1;
        } else {
            ($rule, my $deps) = /^(\S+):\s*(.*)\s*$/
                or $err = print STDERR "$path: line $., couldn't parse - $_\n";
            my @deps;
            if ($deps eq '<previous-rules>') {
                @deps = grep($_ ne $rule, sort keys %rules);
            } else {
                @deps = split ' ', $deps;
                for my $dep (@deps) {
                    $dep =~ /^set-/ and $sets{$dep} = 1;
                }
            }
            $rules{$rule}{deps} = \@deps;
            $rules{$rule}{line} = $.;
        }
    }
    $err and exit 1;
    $rules{$_} //= {deps => [], actions => []} for keys %sets;
    return \%rules;
}

# Topological sort of rules targets (detects cycles).
sub order($) {
    my \%rules = shift;
    my (@order, %state, @stack);

    my $visit;
    $visit = sub {
        my $name = shift;
        if (($state{$name} // '') eq 'visiting') {
            my ($i) = grep { $stack[$_] eq $name } 0 .. $#stack;
            die "dependency cycle: ", join(' -> ', @stack[$i .. $#stack], $name), "\n";
        }
        return if ($state{$name} // '') eq 'done';
        die "unknown dependency: $name\n" unless exists $rules{$name};
        $state{$name} = 'visiting';
        push @stack, $name;
        $visit->($_) for @{$rules{$name}{deps} // []};
        pop @stack;
        $state{$name} = 'done';
        push @order, $name;
    };
    $visit->($_) for sort keys %rules;
    return @order;
}

# POD lives above __DATA__ so nothing reading the DATA filehandle ever sees it.

=pod

=encoding UTF-8

=head1 NAME

refw - single point of control for the host firewall

=head1 SYNOPSIS

    refw add     <scope> <action> <cidr>...|- [--key=path] [--comment=text]
    refw add     fail2ban <set> <ip> [--timeout=secs]
    refw delete  <scope> [<action>] [<cidr>...] [--key=path] [--all]
    refw replace <scope> <action> <cidr>...|- --key=path [--all]
    refw list    [<scope> [<action>]] [--key=path] [-s|--summary]
    refw show    [--raw] [--live]
    refw flush   <scope>

    refw rule    add|delete|replace|list ...        (not yet implemented)
    refw apply   [--dry-run]
    refw shape
    refw verify  [--quiet]                          (not yet implemented)
    refw status

=head1 DESCRIPTION

refw owns the firewall on this host. It replaces the previous mechanisms
(the Aia::Channel firewall call, the daily geofence upload, and the
firewall shell script under /home/aia/local) - all of which become clients
that issue refw commands rather than touching iptables/ipset/nft directly.
The only other legitimate writers are Docker (its own chains, on
admin/dev hosts) and fail2ban (fenced chains or volatile sets).

Operations split into two paths:

=over 4

=item B<hot path> - set membership

add/delete/replace/list against the user, system, feed, fwrule, and
fail2ban scopes. These edit nft set elements live, require no ruleset
reload, and are the common case (customer IP churn, threat feeds,
staff UI fwrule rows, bans). Mutations serialize on a lock and update
the declaration atomically.

=item B<cold path> - ruleset structure

rule add/delete/replace edit literal rules in the declaration; apply
renders the full ruleset through the dependency graph in the rules file
and loads it as one atomic nft transaction with per-chain flushes (set
membership survives). When the B<ratelimit> feature is on, apply also
installs the 1 mbit tc crawl on the default-route interface.

=back

The declaration (state.json) is the source of truth; the kernel is a
rendering of it. verify diffs the two and is intended to run from the
15-minute health monitor.

=head1 COMMANDS

=over 4

=item B<add> <scope> <action> <cidr>... {--key=path | --nokey} [--comment=text]

Add one or more addresses to a set. Use B<-> alone in place of addresses
to read them from stdin (one per line). Values are normalized on ingest
(10.0.0/8 becomes 10.0.0.0/8). Adding under a --key that doesn't exist
yet creates it, with a notice.

Keyed scopes (user, system, feed) B<require> a key: an add without --key
is refused unless you pass --nokey to add an entry deliberately unkeyed.

A value is unique within a set (an nft set cannot hold it twice). Adding
a value that already exists under the same key is an idempotent no-op;
adding it under a I<different> key is an error unless --rekey is given,
which moves the existing value to the new key. To change what a whole
key holds, use B<replace>.

=item B<add fail2ban> <set> <ip> [--timeout=secs]

Volatile-set add: written to the kernel only, never to the declaration.
The set names the jail's set. Convention:

=over 4

=item C<ban> → C<f2b_ban> — hard drop (clear abuse; apache-https)

=item C<ratelimit> → C<f2b_ratelimit> — soft crawl (ambiguous DoS;
ratelimiter-realed). New 80/443 connections are rate-limited; HTTP(S)
I<replies> to that IP are marked and shaped to 1 mbit by tc (after
B<apply>).

=back

This is the entry point for fail2ban actionban/actionunban scripts.

=item B<delete> <scope> [<action>] [<cidr>...] [--key=path] [--all]

Delete matching entries. Address and --key constraints combine (both
must match). The action may be omitted to sweep allow and drop together
- the offboarding case: C<refw delete user --key=fred>. A delete that
matches more than one entry echoes the matches and requires confirmation
(or --all; --yes for non-interactive use).

=item B<replace> <scope> <action> <cidr>...|- --key=path [--all]

Make the entries under a key path become exactly the given list: "this
location moved" is C<refw replace user allow 5.6.7.8 --key=fred/work>; a
feed update is C<refw replace feed drop --key=ipsum -> with the list on
stdin (B<-> required to read stdin; atomic swap of that key's partition).
Every kernel set the replace touches is reloaded from the declaration in
one nft transaction, so there is no empty-set window and kernel drift
self-heals. A replace whose prefix spans multiple sub-keys requires
confirmation or --all.

Because a value is unique per set, replace also serves to re-key: an
incoming value that currently lives under another key (or unkeyed) is
moved to this key, with a notice - so C<refw replace user drop 1.2.3.4
--key=localnet> relabels an existing 1.2.3.4 rather than duplicating it.

=item B<list> [<scope> [<action>]] [--key=path] [-s|--summary]

Show B<set membership> only (declaration rows, plus volatile fail2ban
sets from the kernel). This does B<not> show preamble ports, chain
policy, or other structural rules — use B<show> for that. Omitting the
scope lists every non-volatile scope; C<refw list fail2ban ban> names a
volatile set explicitly.

B<--summary> collapses the members: one line per key (the category —
C<cloudflare>, C<ryan>, C<ipsum>, …) and ports bucket, with an entry
count. Volatile sets show a kernel element count. The all-scope dump
prints in B<match order> — allows, ban, drops, rejects, ratelimit — so
the summary reads like the policy it renders to.

=item B<show> [--raw] [--live]

Default: at-a-glance B<shape> in plain language (inbound flow, set
membership under each rule, optional crawl path). No nft syntax.

B<--raw> — only the rendered nft document that B<apply> would load
(same as C<apply --dry-run>). No human formatting.

B<--live> — only what is loaded in the kernel right now:
C<nft list table inet refw> plus tc on the default interface when
ratelimit is enabled. Use this to check apply actually took effect.
(Differs from B<--raw>, which is the intended policy file, not the live
state.)

=item B<flush> <scope>

Remove all declaration membership for a non-volatile scope and delete
the corresponding kernel set elements. Used by B<sutilw fwrule> before a
full resync of staff-UI rules.

=item B<rule> add|delete|replace|list - I<not yet implemented>

Literal-rule management in the declaration's categories. Rules get
stable short ids (hash of the normalized spec) for delete/replace.
Mutations touch only the declaration; apply touches the kernel.

=item B<apply> [--dry-run]

Render the rules file (dependency-ordered verbatim and generated blocks)
into a single nft -f document, write it under the vardir as
C<generation.nft>, and load it with C<nft -f>. B<--dry-run> prints the
document (and a note about tc shape) without changing the system.

The rendered document bootstraps the table and base chain, then flushes
only the chain(s) (never the table or a set) so set membership survives
the reload, then reloads the set declarations and chain bodies in one
transaction. Declared membership is rendered into the set declarations
as C<elements>, so the boot-time apply restores members on a fresh
kernel (nft merges elements into an existing set; volatile C<f2b_*>
sets carry no elements — fail2ban repopulates those itself). Host-type /
feature conditionals (C<?> targets) are resolved by B<host_type> and
B<host_features> (see FILES and NOTES).

With feature B<ratelimit>, an output chain C<shape> marks TCP sports
80/443 to destinations in C<@f2b_ratelimit> (fwmark 1), and apply runs
B<shape_ensure>: HTB root on the default-route interface with a 1 mbit
crawl class for that mark (same numbers as the old ratelimiter-realed
action). B<root qdisc on that iface is replaced> — refw owns it when
ratelimit is enabled.

Dead-man's-switch confirm for apply is not yet implemented.

=item B<shape>

(Re)install the tc crawl shaper. Split out of apply's soft-fail:
C<refw.service> applies nft before the network is up, where no default
route exists yet, so C<refw-shape.service> runs this once
C<network-online.target> is reached. No-op when refw is not active or
feature B<ratelimit> is off; fails when a default route is still absent.

=item B<lint>

Classify the live iptables/ipset content (filter and mangle tables)
against the known legacy patterns - screen/rechain and their feeds,
fail2ban chains, RATELIMITED/ratelimited, whitelist, Docker's chains
wholesale, the standard preamble shapes - and report what is left.
Residue is hand-added policy (an C<allow-E<lt>userE<gt>> ipset, a
one-off rule) that must become refw membership or be deliberately
discarded before the legacy cleaner may run: B<refw-cutover.sh --go
--clean> refuses while lint reports any (override with
B<--clean-anyway>). For a residue set behind an ACCEPT/DROP rule, lint
prints ready-to-paste C<refw add> commands (ports preserved for
C<hash:*,port> sets). Read-only; exit 0 clean, 1 residue. The pattern
tables grow empirically - extend them when a host presents a new benign
shape.

=item B<verify> [--quiet] - I<not yet implemented>

Compare rendered expectation against kernel state, scope-aware: volatile
set membership and foreign chains (Docker, fenced fail2ban) are asserted
present but not inspected. Exit 0 when clean, otherwise nonzero with one
line per divergence. Health-monitor hook.

=item B<status>

Show vardir, table, host-type, is* flags, features, declaration
generation, per-set entry counts, and (if ratelimit is on) tc shape
status on the default interface.

=back

=head1 SCOPES

=over 4

=item B<user> - named people/logins (key = C<user.usr>). Optional
B<--ports> (TCP); omit/all/* = any port. Filled by B<sutilw fwrule>
from C<userip> (reuser no longer owns host firewall when refw is present).

=item B<system> - site/staff policy (was fwrule/fwnet + local firewall
generation). Same optional B<--ports> and allow/drop/reject as user.
Keys are stable rule ids (e.g. C<fwrule/123>). Guarded (confirm / C<--yes>).

=item B<feed> - threat-feed entries (geo lists, IP-blocking services);
keys are source tags (ipsum, arbitrary/...), so a feed update replaces
only its own partition and hand-curated entries survive.

=item B<fwrule> - B<legacy> ported scope (signature keys). New rebuilds
use B<system> instead; left for compatibility with old state.

=item B<fail2ban> - volatile category of per-jail sets. The set name
identifies the jail's set (kernel name C<f2b_E<lt>setE<gt>>). RealEd
packages: C<ratelimit> for ratelimiter-realed (1 mbit crawl), C<ban>
for apache-https (hard drop). Membership lives in the kernel only.

=back

Actions are B<allow> and B<drop>. Within the rendered ruleset, allows
precede drops (an allow wins); ordering between categories is fixed by
the dependency graph, never by callers.

=head1 KEYS

Keys are hierarchical paths (C<fred/work>), normalized on ingest, matched
by prefix: --key=fred addresses everything under fred/. A key owns a
list of values (fred at home, work, and the VPN). Operations where a
prefix expands to multiple entries are guarded (--all / confirmation).

=head1 FILES

=over 4

=item F</var/lib/refw/> - runtime state (next to the script in a package
source checkout):

=over 4

=item C<state.json> - declaration; written atomically, generation-counted

=item C<lock> - mutation serialization (flock)

=item C<generation.nft> - last document loaded by B<apply>; also the
boot gate for C<refw.service> (C<ConditionPathExists>)

=back

=item F</lib/systemd/system/refw.service> - oneshot B<apply> on boot
(enabled by package postinst; skipped until C<generation.nft> exists).
Ordered after C<local-fs.target> — refw resolves site perl trees under
F</home>, and running before all local mounts can expose a stale
underlay — and before C<network-pre.target>, so the firewall is up
before interfaces are.
B<refw isactive> is true when nft table C<inet refw> exists (after
B<activate> / B<apply>). nft is netlink, so an unprivileged query has
no answer: B<isactive> re-execs itself through C<sudo -n> rather than
report a false C<inactive> — the lie would route every consumer to the
legacy path. Other kernel-querying commands still require root
outright.

=item F</lib/systemd/system/refw-shape.service> - oneshot B<shape> after
C<network-online.target> (same C<generation.nft> boot gate): installs
the tc crawl shaper that the pre-network B<apply> could not.

=item F</etc/refw/> - admin config (same directory as runtime state in a
source checkout):

=over 4

=item C<rules> - dependency/ordering file (makefile syntax). If missing,
F</var/lib/refw/rules> is used instead.

=item C<type> - declared host type (C<realed web server admin dev vpn>).
Overridden by B<--type>. If unset, auto-detect:

=over 4

=item * RealEd C<isrealed> → C<realed>

=item * RealEd C<isdev> → C<dev>

=item * F</usr/local/realadm/bin/vpn> exists → C<vpn>

=item * F</etc/apache2/sites-enabled> non-empty → C<web>

=item * else → C<server>

=back

C<admin> is not auto-detected; set it with B<--type> or this file.

=item C<features> - optional whitespace- or comma-separated feature names
(C<fail2ban>, C<feed>, C<ratelimit>, …). When absent, defaults are: C<feed>
on type C<web>; C<fail2ban> and C<ratelimit> when F</etc/fail2ban> exists.

=back

=back

=head1 EXIT STATUS

0 on success. 2 on usage errors. Nonzero (with diagnostics) on
failed/aborted operations; verify reserves nonzero for drift.

=head1 NOTES

Non-interactive callers (Aia::Channel over the tunnel) must pass --yes
on operations that may prompt. IPv6 set pairing is not yet implemented.
The nft table is C<inet refw>; per-chain flushes on apply are what keep
set membership alive across structural reloads - never flush the table.

A trailing C<?> on a rules-file target is a conditional. Resolution:

=over 4

=item * name ends in C<-E<lt>typeE<gt>> (e.g. C<preamble-realed?>) —
emitted when the matching C<isE<lt>typeE<gt>> predicate is true.
Predicates: C<isrealed> / C<isdev> (RealEd), C<isvpn> (F</usr/local/realadm/bin/vpn>
exists), C<isweb> / C<isserver> (layout heuristics; mutually exclusive with
the above), C<isadmin> (only when C<host_type> is C<admin> via B<--type> or
the type file). More than one C<is*> can be true at once (e.g. realed+dev);
the exclusive C<host_type> string is still chosen by detect order.

=item * C<set-E<lt>featureE<gt>-{allow,drop}?> (e.g. C<set-feed-allow?>) —
emitted only when that feature is enabled

=item * bare name (e.g. C<fail2ban?>, C<ratelimit?>) — emitted only when
that feature is enabled

=back

Inactive conditionals still participate in the dependency graph (so
ordering stays stable) but contribute no chain body.

Verbatim fragments may reference C<E<lt>default-ifaceE<gt>>: render
substitutes the default-route device, falling back to the device the
last routed B<apply> recorded in state.json (boot applies run before
the network is up), and drops the C<iifname> qualifier entirely when no
usable device is known.

=head2 Fail2ban client model and the 1 mbit crawl

fail2ban only classifies IPs. refw enforces:

=over 4

=item * C<f2b_ban> — C<ip saddr @f2b_ban drop> in the input chain

=item * C<f2b_ratelimit> — new connections to ports 80/443 from set
members are limited (10/minute burst 20); HTTP(S) replies B<to> those
IPs get fwmark 1; B<tc> HTB on the default-route NIC puts mark 1 in a
1 mbit class (crawl punishment for ambiguous DoS vs misconfigured
customer)

=back

Run C<refw apply> after enabling the features so chains and tc exist.
Hot-path C<refw add fail2ban …> only updates set membership.

=cut

__DATA__
getopt
all             delete/replace may span multiple entries without prompting | \$all
comment=s       <text> free-text annotation stored with the entry | \$comment
k|key=s         <path> hierarchical entry key, e.g. fred/work (prefix-matched) | \$key
live            show: dump live kernel nft/tc only (what is loaded now) | \$live
nokey           add to a keyed scope without a key (must be explicit) | \$nokey
n|dry-run       print what apply would load, change nothing | \$dryrun
ports=s         <list> user/system: TCP dports (22,80,443); omit/all/* = any port | \$ports
q|quiet         suppress informational output (verify: exit status only) | \$quiet
s|summary       list: one line per key (category) with a count, no members | \$summary
raw             show: print rendered nft only (what apply would load) | \$raw
rekey           on add, move an existing value to the new key instead of erroring | \$rekey
timeout=i       <secs> per-element timeout for volatile sets | \$timeout
type=s          <systype> host type for apply/render (realed web server admin dev vpn); overrides etc/type | \$type
y|yes           assume yes to confirmations (for use over the tunnel) | \$yes
