#!/usr/bin/env perl
# =============================================================================
# t/submit_script.t -- Black-box tests for submit_abuse_report
#
# Tests the --interactive flag and unresolved domain listing by running the
# script as a subprocess.  The --dry-run flag is used throughout so no SMTP
# connection is attempted.
# =============================================================================

use strict;
use warnings;
use Test::More;
use File::Temp  qw(tempfile);
use IPC::Open3  qw(open3);
use File::Spec;
use FindBin     qw($Bin);

# Path to the script under test
my $SCRIPT = File::Spec->catfile($Bin, '..', 'bin', 'submit_abuse_report');
# Fall back to the script living at the distribution root (development layout)
$SCRIPT = File::Spec->catfile($Bin, '..', 'submit_abuse_report')
    unless -f $SCRIPT;
my $PERL   = $^X;
my $LIB    = File::Spec->catfile($Bin, '..', 'lib');

plan skip_all => "submit_abuse_report not found at $SCRIPT"
    unless -f $SCRIPT;

# ---------------------------------------------------------------------------
# Helper: write a minimal spam .eml to a temp file and return the path
# ---------------------------------------------------------------------------
sub make_eml {
	my (%h) = @_;
	my ($fh, $path) = tempfile(SUFFIX => '.eml', UNLINK => 1);
	my $from    = $h{from}    // 'spam@gmail.com';
	my $body    = $h{body}    // 'Buy now at https://spamsite.example/';
	print $fh join("\r\n",
		'Received: from ext (ext [198.51.100.1]) by mx.example with ESMTP',
		"From: Spammer <$from>",
		'To: <victim@example.com>',
		'Subject: Test spam',
		'Date: Mon, 30 Mar 2026 12:00:00 +0000',
		'Message-ID: <test@example>',
		'Content-Type: text/plain',
		'',
		$body,
		'',
	);
	close $fh;
	return $path;
}

# ---------------------------------------------------------------------------
# Helper: run the script, return (stdout, stderr, exit_code)
# ---------------------------------------------------------------------------
sub run_script {
	my (@args) = @_;
	# Route child stderr to a temp file so the only IPC pipe is stdout.
	# Reading stdout then stderr sequentially from two pipes causes a
	# classic deadlock on Windows (small ~4 KB pipe buffer): the child
	# fills the stderr pipe while the parent blocks on stdout, and both
	# sides stall.  A file has no buffer limit so it never blocks.
	my ($err_fh, $err_path) = tempfile(SUFFIX => '.err', UNLINK => 1);
	my ($in, $out);
	# Include the distribution lib/ in @INC for the subprocess
	my $pid = open3($in, $out, $err_fh,
		$PERL, "-I$LIB", $SCRIPT, @args);
	close $in;
	my $stdout = do { local $/; <$out> } // '';
	close $out;
	waitpid $pid, 0;
	my $exit = $? >> 8;
	seek $err_fh, 0, 0;
	my $stderr = do { local $/; <$err_fh> } // '';
	close $err_fh;
	return ($stdout, $stderr, $exit);
}

# Verify the script compiles before running any tests
{
	my ($out, $err, $exit) = run_script('--help');
	if ($exit != 0) {
		plan skip_all =>
			"submit_abuse_report did not run successfully (exit $exit); "
			. "dependencies may be missing";
	}
}

# ---------------------------------------------------------------------------
# 1. Basic --dry-run works and shows recipient
# ---------------------------------------------------------------------------
subtest '--dry-run shows recipient without sending' => sub {
	my $eml = make_eml(from => 'spam@gmail.com');
	my ($out, $err, $exit) = run_script('--dry-run', $eml);

	like $out, qr/DRY RUN/,
		'dry-run header present';
	like $out, qr/abuse\@google\.com/i,
		'google abuse contact shown';
	is $exit, 0, 'exit status 0';
};

# ---------------------------------------------------------------------------
# 2. --interactive with --dry-run: --dry-run takes precedence, no prompt
# ---------------------------------------------------------------------------
subtest '--interactive has no effect with --dry-run' => sub {
	my $eml = make_eml(from => 'spam@gmail.com');
	my ($out, $err, $exit) = run_script('--dry-run', '--interactive', $eml);

	like $out, qr/DRY RUN/,
		'dry-run output produced';
	unlike $out . $err, qr/Send\? \[y\/N\]/,
		'no interactive prompt shown in dry-run mode';
	is $exit, 0, 'exit status 0';
};

# ---------------------------------------------------------------------------
# 3. No contacts: unresolved domain listing shown
# ---------------------------------------------------------------------------
subtest 'no contacts -- unresolved domains listed' => sub {
	# Use a domain not in any provider table so no contact is found,
	# but include it as a URL so it appears in embedded_urls()
	my $eml = make_eml(
		from => 'spoofed@innocent.example',
		body => 'Visit http://www.spamsiteunknown.example/offer now',
	);
	my ($out, $err, $exit) = run_script('--dry-run', $eml);

	# With --dry-run and no contacts, the script exits before dry_run_report
	# and prints the no-contacts message to stderr
	# 'No abuse contacts' is printed to STDERR
	like $err, qr/No abuse contacts could be determined/,
		'no-contacts message shown';
	is $exit, 0, 'exit status 0';
};

# ---------------------------------------------------------------------------
# 4. No contacts: spoofed From: domain excluded from unresolved list
# ---------------------------------------------------------------------------
subtest 'no contacts -- spoofed From: domain not listed' => sub {
	my $eml = make_eml(
		from => 'spoofed@innocent-victim.example',
		body => 'Contact scammer@unknownprovider.example for details',
	);
	my ($out, $err, $exit) = run_script('--dry-run', $eml);

	unlike $err, qr/innocent-victim\.example/,
		'spoofed From: domain absent from unresolved listing';
	is $exit, 0, 'exit status 0';
};

# ---------------------------------------------------------------------------
# 5. --interactive flag appears in --help output
# ---------------------------------------------------------------------------
subtest '--interactive documented in --help' => sub {
	my ($out, $err, $exit) = run_script('--help');

	# pod2text may emit overstrike-bold sequences (char + backspace + char)
	# on environments with no real terminal; strip them before matching so
	# "interactive" is not seen as "iinntteerraaccttiivvee".
	(my $clean = $out . $err) =~ s/.\x08//g;
	like $clean, qr/interactive/i,
		'--interactive mentioned in help output';
};

# ---------------------------------------------------------------------------
# 6. Path traversal rejected
# ---------------------------------------------------------------------------
subtest 'path traversal in filename is rejected' => sub {
	# Strategy: pass a path containing ../ as the email file argument.
	# The script must exit non-zero and print an error mentioning traversal.
	my ($out, $err, $exit) = run_script('--dry-run', '--from=x@x.example',
		'../../../etc/passwd');
	my $combined = $out . $err;
	ok $exit != 0, 'exit status non-zero for traversal path';
	like $combined, qr/traversal/i,
		'error message mentions traversal';
};

# NUL bytes in argv cannot be tested via subprocess: POSIX execve(2) uses
# NUL-terminated strings, so the OS truncates any argv element at the first
# NUL before the child process sees it.  The in-script guard against NUL is
# still valuable when the script is called from Perl (e.g. system() or
# IPC::Open3 with a tainted string), but it cannot be exercised this way.

# ---------------------------------------------------------------------------
# 7. Regression: overstrike-bold sequences must be stripped before matching
#    --help output.  On CPAN tester machines that route pod2usage through
#    groff/nroff, bold text is rendered as (char + \x08 + char) overstrike,
#    turning "--interactive" into "--iinntteerraaccttiivvee".  Without stripping,
#    /interactive/i never matches.
# ---------------------------------------------------------------------------
subtest 'overstrike-bold stripping regression (CPAN tester groff rendering)' => sub {
	# Build the overstrike form that groff -man -Tascii produces for bold text:
	# each character c becomes "c\x08c".
	my $plain     = '--interactive';
	my $overstruck = join '', map { "$_\x08$_" } split //, $plain;

	# Confirm the raw overstruck string does NOT satisfy a naive regex match --
	# this is exactly the failure seen on CPAN tester 5be8844e.
	unlike $overstruck, qr/interactive/i,
		'overstrike-encoded text fails naive /interactive/i match';

	# Apply the same strip used in subtest 5.
	(my $clean = $overstruck) =~ s/.\x08//g;

	like $clean, qr/interactive/i,
		'stripped text matches /interactive/i';
	is $clean, $plain,
		'stripped text is byte-identical to the original plain string';
};

done_testing();
