#!/usr/bin/env perl

use strict;
use warnings;

use Data::Dumper;

print "Sanitize script for node removal from container.\n";

system("pwd");
{
  my @l = (".","..");
  for(1..8) {
    push @l, (("../" x $_)."..")
  }
  for(@l) {
    my $cmd = "ls -ld $_";
    print "running: $cmd\n";
    system $cmd;
  }
}

my $tmpdir = "tmp-sanitize";

die "Has already run, abort" if -e $tmpdir;

mkdir $tmpdir;

chmodWrap(0755, $tmpdir);
chdir($tmpdir);
system("ln -s ../uniworx.tar.gz .");
system("tar xzvf uniworx.tar.gz");
chmodWrap(0755, '.'); # tar can change the rights of '.' if it contains an entry for '.' with other rights

my %truerights = ();
storeRightsMake7(".");

#print "=== Extended rights:\n";
#system("ls -l *");
#resetRights(".");
#print "=== Reset rights:\n";
#system("ls -l *");

sub chmodWrap {
  my ($mode, $fn) = @_;
  my $tries = 0;
  die "file '$fn' does not exist; cannot change its permissions to $mode" unless -e $fn;
  RIGHTS: {
    chmod($mode, $fn);
    my $ismode = (stat($fn))[2];
    my $fm = $ismode % 512;
    if($fm != $mode) {
      if($tries++ > 20) {
        die "Problem with file permissions, abort"
      }
      warn sprintf "File rights were meant to be set, but were not updated properly for file '%s', is %03o but was set to %03o; try again in 1 second";
      sleep 1;
      redo RIGHTS;
    }
  }
}

# 
sub storeRightsMake7 {
  my ($pwd) = @_;
  my $dh = undef;
  opendir($dh, $pwd) or die "Could not read dir '$pwd', because: $!";
  while(my $fn = readdir($dh)) {
    next if $fn=~m#^\.\.?$#;
    #perl -le 'my $dh = undef;opendir($dh, ".");while(my $fn = readdir($dh)) { my $mode = (stat($fn))[2];my $fm = $mode % 512;my $fmo=sprintf("%03o",$fm);print "$fn -> $fmo" }'
    my $fullname = "$pwd/$fn";
    my $mode = (stat($fullname))[2];
    my $fm = $mode % 512;
    #my $fmo = sprintf("%03o",$fm);
    $truerights{$fullname} = $fm;
    chmodWrap(($fm | 0700), $fullname);
    storeRightsMake7($fullname) if -d $fullname;
  }
}

sub resetRights {
  my ($pwd) = @_;
  print "Resetting rights to:\n" if '.' eq $pwd;
  print Data::Dumper::Dumper(\%truerights);
  my $dh = undef;
  opendir($dh, $pwd) or die "Could not read dir '$pwd', because: $!";
  while(my $fn = readdir($dh)) {
    next if $fn=~m#^\.\.?$#;
    #perl -le 'my $dh = undef;opendir($dh, ".");while(my $fn = readdir($dh)) { my $mode = (stat($fn))[2];my $fm = $mode % 512;my $fmo=sprintf("%03o",$fm);print "$fn -> $fmo" }'
    my $fullname = "$pwd/$fn";
    printf("  set rights of '$fullname' back to %03o\n", $truerights{$fullname});
    chmodWrap($truerights{$fullname}, $fullname);
    resetRights($fullname) if -d $fullname;
  }
}

sub renameWithRights {
  my ($from, $to) = @_;
  print "  rename file '$from' to '$to'\n";
  my %oldrights = %truerights;
  %truerights = ();
  while(my ($k,$v) = each %oldrights) {
    $k =~ s#^\./\Q$from\E#./$to#;
    $truerights{$k} = $v;
  }
  #my $rights = $truerights{$from};
  #delete $truerights{$from};
  rename($from, $to) or die "Could not rename '$from' to '$to', because $!";
  my $waittimer = 20;
  while(-e $from || not(-e $to) and $waittimer-- > 0) {
    sleep 1
  }
  die "rename file from '$from' to '$to', but it is still there" if -e $from;
  die "rename file from '$from' to '$to', but there is no file under the new name" unless -e $to;
  #$truerights{$to} = $rights
}

print Data::Dumper::Dumper(\%truerights);
#exit 0;

# Checksummen:
# outerjson  c27f -- toplevel $outerjson.json, by sha256sum $outerjson.json
# imageid    d940 -- toplevel verzeichnis mit der layer darin; doc says: Each image’s ID is given by the SHA256 hash of its configuration JSON.
#                    we'll try as configuration "remove nodejs $oldhash"
#                    or we just use a random number ;)
# layertar   fd3d -- doc says: Each image’s ID is given by the SHA256 hash of its configuration JSON.
#
##### FOUND
# outerjson c27f64c8de183296ef409baecc27ddac8cd4065aac760b1b512caf482ad782dd -- in manifest.json
# imageid   d940253667b5ab47060e8bf537bd5b3e66a2447978f3c784a22b115a262fccbf -- in manifest.json
# imageid   d940253667b5ab47060e8bf537bd5b3e66a2447978f3c784a22b115a262fccbf -- as toplevel dirname
# outerjson c27f64c8de183296ef409baecc27ddac8cd4065aac760b1b512caf482ad782dd -- as toplevel filename
# imageid   d940253667b5ab47060e8bf537bd5b3e66a2447978f3c784a22b115a262fccbf -- in $layerdir/json
# layertar  fd3d3cdf4ece09864ac933aa664eb5f397cf5ca28652125addd689726f8485cd -- in $outerjson.json
# 
#
##### COMPUTE
# toplevel
# outerjson  c27f64c8de183296ef409baecc27ddac8cd4065aac760b1b512caf482ad782dd  $outerjson.json
#            b21db3fcc85b23d91067a2a5834e114ca9eec0364742c8680546f040598d8cd9  manifest.json
#            238f234e3a1ddb27a034f4ee1e59735175741e5cc05673b5dd41d9a42bac2ebd  uniworx.tar.gz
# in $layerdir/
#            028c1e8d9688b420f7316bb44ce0e26f4712dc21ef93c5af8000c102b1405ad4  json
# layertar   fd3d3cdf4ece09864ac933aa664eb5f397cf5ca28652125addd689726f8485cd  layer.tar
#            d0ff5974b6aa52cf562bea5921840c032a860a91a3512f7fe8f768f6bbe005f6  VERSION
#
#
# sha256sum layer.tar fd3d3cdf4ece09864ac933aa664eb5f397cf5ca28652125addd689726f8485cd

my ($outerjson, $imageid) = ();

{
  my $dirh = undef;
  opendir($dirh, '.') or die "Could not read dir '.', because: $!";
  while(my $fn = readdir($dirh)) {
    next if $fn=~m#^\.#;
    if($fn=~m#(.{16,})\.json#) { # it shall match on hash sums but not for example on manifest.json
      $outerjson = $1;
      next
    }
    if($fn=~m#^[0-9a-f]{64}$#) {
      $imageid = $fn
    }
  }
}

die "Bad archive, could not found expected files and directories" unless defined($outerjson) and defined($imageid);

#system("pwd");
#print "will run: sha256sum $imageid/layer.tar\n";

my $oldLayerdir = qx(sha256sum $imageid/layer.tar);
#print "oldLayerdir is for now $oldLayerdir\n\n";
$oldLayerdir =~ m#^([0-9a-f]{64}).*$# or die "layer.tar not found or sha256sum not installed!";
$oldLayerdir = $1;

# tar --delete --file layer.tar nix/store/cdalbhzm3z4gz07wyg89maprdbjc4yah-nodejs-14.17.0
my $layerContent = qx(tar -tf $imageid/layer.tar);

my @rms = $layerContent=~m#^((?:\./)?nix/store/[a-z0-9]+-(?:nodejs|openjdk|ghc)-[^/]+/)$#gm;

print "rm <<$_>>\n" for @rms;

system("tar --delete --file $imageid/layer.tar '$_'") for @rms;


### Deconstruction finished, now lets put everything together again after fixing the checksums


my $newImageId = qx(echo 'remove nodejs $imageid' | sha256sum);
$newImageId =~ m#^([0-9a-f]{64}).*$# or die "sha256sum not installed!";
$newImageId = $1;

my $newLayerdir = qx(sha256sum $imageid/layer.tar);
$newLayerdir =~ m#^([0-9a-f]{64}).*$# or die "sha256sum not installed!";
$newLayerdir = $1;

# new outerjson is computed later, as we first have to change its content

sub cautionWaiter {
  # some file operations give the impression that they are not instant.
  # Hence, we wait here a bit to see if that fixes stuff
  #sleep 5; # seems not to be the reason
}

sub replaceInFile {
  my ($filename, $replacer) = @_;
  return unless -e $filename;
  my $fh = undef;
  open($fh, '<', $filename) or die "Could not read $filename, because: $!";
  my $content = join '', <$fh>;
  close $fh;
  keys %$replacer;
  while(my ($k,$v) = each %$replacer) {
    $content=~s#\Q$k\E#$v#g;
  }
  my $wh = undef;
  open($wh, '>', $filename) or die "Could not write $filename, because: $!";
  print $wh $content;
  close $wh;
}

my %replacer = (
  $oldLayerdir => $newLayerdir,
  $imageid => $newImageId,
);

replaceInFile("$imageid/json", \%replacer);
replaceInFile("$outerjson.json", \%replacer);

cautionWaiter();

my $newOuterjson = qx(sha256sum '$outerjson.json');
$newOuterjson =~ m#^([0-9a-f]{64}).*$# or die "sha256sum not installed!";
$newOuterjson = $1;

cautionWaiter();

renameWithRights("$outerjson.json", "$newOuterjson.json");
$replacer{$outerjson} = $newOuterjson;

replaceInFile("manifest.json", \%replacer);

replaceInFile("repositories", \%replacer);

cautionWaiter();
renameWithRights($imageid, $newImageId);

cautionWaiter();





resetRights(".");


system("find");

unlink("uniworx.tar.gz");

system("tar czvf uniwox-rmnodejs.tar.gz *");

cautionWaiter();
print "Debug output, content of container:\n";
system("tar tzvf uniwox-rmnodejs.tar.gz");

cautionWaiter();
#unlink("../uniworx.tar.gz");

system("cp uniwox-rmnodejs.tar.gz ../uniworx-sanitized.tar.gz");