#! /usr/bin/env perl

# Simplified BSD License (FreeBSD License)
#
# Copyright (c) 2026, Daily Data Inc.
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# Harness::Containment - the config containment gate. See
# sneakernet/Documentation/TESTING_automation.md section 6.5.
#
# The harness's most dangerous operations are not the ones it issues itself - they are the
# ones sneakernet issues, driven by whatever the config on disk says: zfs receive -F, and the
# destroy-and-retry path that Part 7.2b deliberately enables via allowFullOverwrite: 1. This
# module is the check that stands between "the config got mutated ~25 times by an automated
# patcher" and "sneakernet received a stream over storage/backup".
#
# Two entry points:
#   check_object($yamlPatchObj, $rawText) - core logic, operates on an already-loaded
#       YAMLPatch object (and the raw text, for the '<'/'>' scan). This is what
#       Harness::Runner registers as a YAMLPatch save() hook (gate 6/7).
#   check_file($path) - loads $path fresh and runs the same checks. This is what
#       Harness::Safe::run_sneakernet calls immediately before every single sneakernet
#       invocation (see TESTING_automation.md 6.5: "not once per Part... re-validated
#       immediately before every single sneakernet invocation").

package Harness::Containment;

use strict;
use warnings;
use YAMLPatch;   # caller (run-tests / test scripts) is responsible for 'use lib' to find this -
                  # FindBin inside a library module resolves relative to the invoking SCRIPT,
                  # not this file, so it would silently do the wrong thing here.

our $SANDBOX_DS   = 'storage/testing';
our $SANDBOX_PATH = '/storage/testing';

sub _under_ds {
    my ($v) = @_;
    return defined($v) && length($v) && ($v eq $SANDBOX_DS || index($v, "$SANDBOX_DS/") == 0);
}

sub _under_path_or_empty {
    my ($v) = @_;
    return 1 if !defined($v) || $v eq '';
    return $v eq $SANDBOX_PATH || index($v, "$SANDBOX_PATH/") == 0;
}

sub _val {
    my ($y, $path) = @_;
    my $rec = $y->get($path);
    return defined($rec) ? $rec->{value} : undef;
}

sub check_object {
    my ($y, $rawText) = @_;
    my @problems;

    # --- dataset-namespace fields: must be under storage/testing/ ---
    for my $p (qw(source.poolname target.poolname)) {
        my $v = _val($y, $p);
        push @problems, "$p ('" . ($v // '') . "') is outside $SANDBOX_DS/" unless _under_ds($v);
    }
    for my $dsPath ($y->path_list) {
        next unless $dsPath =~ /^datasets\.([^.]+)\.(source|target)$/;
        my $v = _val($y, $dsPath);
        push @problems, "$dsPath ('" . ($v // '') . "') is outside $SANDBOX_DS/" unless _under_ds($v);
    }
    if ($y->exists_path('transport.verifyFullSendDataset')) {
        my $v = _val($y, 'transport.verifyFullSendDataset');
        push @problems, "transport.verifyFullSendDataset ('$v') is outside $SANDBOX_DS/"
            if length($v) && !_under_ds($v);
    }

    # --- filesystem-namespace fields: must be under /storage/testing/ or empty ---
    for my $p (qw(logFile statusFile source.historyFile source.cleanUpScriptsDir
                  source.oneShotCleanup source.targetSnapshotList target.stateFile
                  transport.mountPoint target.report.targetDrive.mountPoint
                  source.report.targetDrive.mountPoint)) {
        next unless $y->exists_path($p);
        my $v = _val($y, $p);
        push @problems, "$p ('" . ($v // '') . "') is outside $SANDBOX_PATH/"
            unless _under_path_or_empty($v);
    }

    # --- physical-drive triggers: must be empty ---
    for my $p (qw(transport.label target.report.targetDrive.label source.report.targetDrive.label)) {
        next unless $y->exists_path($p);
        my $v = _val($y, $p);
        push @problems, "$p is non-empty ('$v') - sneakernet would try to mount a PHYSICAL drive"
            if defined($v) && length($v);
    }

    # --- explicitly out-of-scope subsystems ---
    push @problems, "target.geli block is present - GELI is explicitly out of scope for this harness"
        if grep { /^target\.geli(\.|$|\[)/ } $y->path_list;

    if ($y->exists_path('target.shutdownAfterReplication')) {
        my $v = _val($y, 'target.shutdownAfterReplication');
        push @problems, "target.shutdownAfterReplication is set ('$v') - this would POWER OFF the host"
            if $v;
    }

    # --- the loadConfig silent-rewrite trigger (TESTING_automation.md 3.1a) ---
    if (defined $rawText && $rawText =~ /[<>]/) {
        push @problems, "config contains '<' or '>' - ZFS_Utils::loadConfig would silently rewrite the whole file";
    }

    if (@problems) {
        die "Harness::Containment: REFUSED - config fails the containment gate:\n  "
          . join("\n  ", @problems) . "\n";
    }
    return 1;
}

sub check_file {
    my ($path) = @_;
    my $y = YAMLPatch->load_file($path);
    my $rawText = $y->as_text;
    return check_object($y, $rawText);
}

# Returns a coderef suitable for YAMLPatch's save(hooks => [...]). YAMLPatch calls it as
# $hook->($yamlPatchObj, $newText) and treats a false return OR a die as a refusal.
sub as_yamlpatch_hook {
    return sub {
        my ($y, $text) = @_;
        check_object($y, $text);
        return 1;
    };
}

1;

__END__
See sneakernet/Documentation/TESTING_automation.md section 6.5. This module is harness-
internal (like Harness::Safe, not general-purpose like YAMLPatch.pm) - it encodes knowledge
specific to sneakernet's config schema and to what would constitute reaching production on
this particular host.