#!/usr/bin/env perl

# Builds a self-extracting sneakernet upgrade one-shot cleanup script.
#
# Checks out a revision of the zfs_utils SVN trunk, packages it, and writes a Perl script that -
# when eval'd on the target during a normal sneakernet run (see executeCleanupScript in
# sneakernet/sneakernet) - verifies, extracts, archives the current install, and swaps in the new
# code. See sneakernet/allowKeyRotation.md Part 2 for the full design.
#
# Uses 'svn checkout', NOT 'svn export'. An export has no .svn metadata, so getWorkingCopyRevision()
# would report 'unknown' on the target after the upgrade instead of the real revision - measured
# cost of keeping .svn is only ~14KB compressed, so there is no reason to export instead.
#
# Usage:
#   buildUpgradeOneShot.pl --output /path/to/oneShotCleanup/upgradeToR158
#                           [--rev HEAD] [--repo <svn URL>] [--install-dir /usr/local/opt/zfs_utils]

use strict;
use warnings;
use Getopt::Long qw(GetOptions);
use File::Temp qw(tempdir);
use MIME::Base64 qw(encode_base64);
use Digest::SHA qw(sha256_hex);
use Pod::Usage qw(pod2usage);

my %opt = (
   repo       => 'http://svn.dailydata.net/svn/zfs_utils/trunk',
   rev        => 'HEAD',
   installdir => '/usr/local/opt/zfs_utils',
);
GetOptions(
   'repo=s'        => \$opt{repo},
   'rev=s'         => \$opt{rev},
   'install-dir=s' => \$opt{installdir},
   'output=s'      => \$opt{output},
   'help'          => sub { pod2usage(1) },
) or pod2usage(2);
pod2usage("--output is required (path to write the generated one-shot script)") unless $opt{output};

my $tmp = tempdir( CLEANUP => 1 );
my $checkoutDir = "$tmp/zfs_utils";

print "Checking out r$opt{rev} from $opt{repo} ...\n";
system('svn', 'checkout', '-q', '-r', $opt{rev}, $opt{repo}, $checkoutDir) == 0
   or die "svn checkout failed (exit " . ($? >> 8) . ")\n";

# svnversion needs to run from inside the checkout; this also resolves 'HEAD' to a real number.
chomp(my $actualRev = `cd '$checkoutDir' && svnversion .`);
die "svnversion reported '$actualRev' - checkout does not look like a working copy\n"
   unless $actualRev =~ /^\d/;
print "Checked out revision: $actualRev\n";

my $tarFile = "$tmp/zfs_utils.tar.xz";
print "Packaging (tar+xz) ...\n";
system("tar cJf '$tarFile' -C '$tmp' zfs_utils") == 0
   or die "tar failed (exit " . ($? >> 8) . ")\n";

open my $tfh, '<:raw', $tarFile or die "Can't read $tarFile: $!\n";
local $/;
my $tarBytes = <$tfh>;
close $tfh;

my $sha256 = sha256_hex($tarBytes);
my $base64 = encode_base64($tarBytes, '');
printf "Payload: %d bytes raw tar.xz, %d bytes base64, sha256 %s\n",
   length($tarBytes), length($base64), $sha256;

my $script = installerTemplate();
$script =~ s/__REVISION__/$actualRev/g;
$script =~ s/__SHA256__/$sha256/g;
$script =~ s/__INSTALLDIR__/$opt{installdir}/g;
$script =~ s/__BASE64__/$base64/;

open my $ofh, '>', $opt{output} or die "Can't write $opt{output}: $!\n";
print $ofh $script;
close $ofh;

print "Wrote one-shot installer to $opt{output} (targets revision $actualRev)\n";
print "Drop it in source.oneShotCleanup (or leave it there if that's where --output pointed) -\n";
print "it ships on the next source run and is removed from the source after a successful copy.\n";

## The generated one-shot's source, as a template with __PLACEHOLDER__ tokens filled in above.
## Kept as a heredoc rather than a separate file so the builder produces one self-contained script
## with no companion files to lose track of.
sub installerTemplate {
   return <<'ONESHOT';
# sneakernet upgrade one-shot - auto-generated by utilities/buildUpgradeOneShot.pl
# Target revision: __REVISION__     Expected sha256 of payload: __SHA256__
#
# Executed inside sneakernet's own process via string eval (see executeCleanupScript in
# sneakernet/sneakernet) - $config, $programDefinition and every ZFS_Utils export are already in
# scope with no 'use' needed. Deliberately does NOT declare a lexical named $config - that would
# shadow sneakernet's own and could corrupt the rest of the run. Also deliberately does NOT read
# $config for the install path (baked in as $installDir below instead): trusting a config file
# that might itself be mid-upgrade is the wrong thing to depend on for a script whose whole job is
# replacing the code that reads that config.
#
# There is no __DATA__ filehandle available under a string eval, so the payload is a plain string
# literal below.

use MIME::Base64 qw(decode_base64);
use Digest::SHA qw(sha256_hex);
use File::Temp qw(tempdir);
use File::Path qw(make_path);
use File::Copy qw(copy);
use File::Basename qw(dirname basename);
use POSIX qw(strftime);

my @upgradeResults;
my @upgradeErrors;

my $installDir      = '__INSTALLDIR__';
my $expectedSha256   = '__SHA256__';
my $targetRevision  = '__REVISION__';
my $payloadBase64    = '__BASE64__';

# Runtime state that must never be overwritten by the upgrade, checked by RELATIVE PATH PREFIX
# against $installDir (e.g. 'sneakernet/states' excludes everything under that directory). This is
# an explicit list, not a heuristic, so it is obvious at a glance what survives an upgrade.
my @preserve = (
   'sneakernet/sneakernet.conf.yaml',
   'sneakernet/sneakernet_target.status',   # also covers the timestamped *.status.<timestamp> backups
   'sneakernet/sneakernet.log',
   'sneakernet/history.tsv',
   'sneakernet/states',
);

eval {
   my $tarBytes = decode_base64($payloadBase64);
   my $gotSha256 = sha256_hex($tarBytes);
   die "checksum mismatch: expected $expectedSha256, got $gotSha256 - refusing to install\n"
      unless $gotSha256 eq $expectedSha256;
   push @upgradeResults, "Payload checksum verified ($expectedSha256)";

   my $tmp = tempdir( CLEANUP => 1 );
   my $tarFile = "$tmp/payload.tar.xz";
   open my $fh, '>:raw', $tarFile or die "Can't write $tarFile: $!\n";
   print $fh $tarBytes;
   close $fh;

   system('tar', 'xJf', $tarFile, '-C', $tmp) == 0
      or die "tar extraction failed (exit " . ($? >> 8) . ")\n";

   my $extracted = "$tmp/zfs_utils";
   die "Extracted payload is missing expected files (ZFS_Utils.pm / sneakernet/sneakernet) -"
      . " refusing to install what may be a corrupt or unexpected archive\n"
      unless -f "$extracted/ZFS_Utils.pm" && -f "$extracted/sneakernet/sneakernet";
   push @upgradeResults, "Extracted and verified payload contents";

   # Archive the CURRENT install before touching anything, so a bad upgrade can be undone by hand.
   my $timestamp = strftime("%Y-%m-%d_%H.%M.%S", localtime);
   my $archiveFile = "$installDir.pre-upgrade.$timestamp.tar.xz";
   system('tar', 'cJf', $archiveFile, '-C', dirname($installDir), basename($installDir)) == 0
      or die "Failed to archive current install to $archiveFile (exit " . ($? >> 8) . ") -"
            . " aborting before any files are touched\n";
   push @upgradeResults, "Archived current install to $archiveFile";

   my $copied = copyTree($extracted, $installDir, \@preserve);
   push @upgradeResults, "Installed revision $targetRevision to $installDir ($copied file(s) written)";

   # The main entry point must stay executable; File::Copy::copy does not preserve permissions.
   chmod 0755, "$installDir/sneakernet/sneakernet" if -f "$installDir/sneakernet/sneakernet";

   1;
} or do {
   push @upgradeErrors, "Upgrade to revision $targetRevision failed: $@";
};

## Copy every file under $src into $dst, except any relative path that starts with one of the
## @$preserve prefixes (checked as a plain string prefix - sufficient here since the preserve list
## is short and specific; not a general glob engine). Iterative (a stack, not recursion) since the
## tree is shallow and this avoids any question of Perl's default recursion depth.
## Returns the number of files copied.
sub copyTree {
   my ($srcRoot, $dstRoot, $preserve) = @_;
   my $count = 0;
   my @stack = ('');
   while (@stack) {
      my $rel = pop @stack;
      my $srcDir = $rel eq '' ? $srcRoot : "$srcRoot/$rel";
      opendir(my $dh, $srcDir) or die "Can't read $srcDir: $!\n";
      for my $entry (readdir $dh) {
         next if $entry eq '.' || $entry eq '..';
         my $entryRel = $rel eq '' ? $entry : "$rel/$entry";
         next if grep { index($entryRel, $_) == 0 } @$preserve;
         my $srcPath = "$srcDir/$entry";
         my $dstPath = "$dstRoot/$entryRel";
         if (-d $srcPath) {
            make_path($dstPath) unless -d $dstPath;
            push @stack, $entryRel;
         } else {
            my $dstDir = dirname($dstPath);
            make_path($dstDir) unless -d $dstDir;
            copy($srcPath, $dstPath) or die "Copy failed: $srcPath -> $dstPath: $!\n";
            $count++;
         }
      }
      closedir $dh;
   }
   return $count;
}

if (caller()) {
   return (
      join("\n", @upgradeResults) . "\n",
      @upgradeErrors ? join("\n", @upgradeErrors) : ""
   );
} else {
   print "Results:\n" . join("\n", @upgradeResults) . "\n";
   if (@upgradeErrors) {
      print "\n=== ERRORS ===\n" . join("\n", @upgradeErrors) . "\n";
      exit 1;
   }
   exit 0;
}
ONESHOT
}