#! /usr/bin/perl

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# some setup...

BEGIN { unshift @INC, ( $0 =~ /(.*?)((?<![^\/])bin\/)?[^\/]+$/ )[0] . "lib" }
use ReadConfig;
use MakeExt2Image;
use AddFiles;
use Conv2Image;
use CompressImage;
use Cwd "realpath";

sub check_link;
sub fix_alternatives_link;

die "usage: $Script\n" if @ARGV;

# Instead of program arguments mk_image uses environment variables. (sorry.)
# See doc/configoptions.md for a reference.

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# some config data

$imagename = $ENV{image};
die "no image name\n" if $imagename eq "";

$srcname = $ENV{src};
$srcname = $imagename if $srcname eq "";

$fl = $ENV{filelist};
$fl = $imagename if $fl eq "";

$srcdir = "${DataPath}$srcname";
$tmpdir = "${BasePath}tmp/$imagename";
$tmpdir = "${BasePath}tmp/$ENV{tmpdir}" if $ENV{tmpdir};
$image = "${ImagePath}$imagename";

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# now we really start...

$ENV{YAST_IS_RUNNING} = 1 unless exists $ENV{YAST_IS_RUNNING};

if($ENV{disjunct}) {
  $tmpdisjunct = "${BasePath}tmp/$ENV{disjunct}";
  die "$tmpdisjunct: so such directory" unless -d $tmpdisjunct;
  $tmpdir2 = "$tmpdir.not_$ENV{disjunct}";
  if(-d($tmpdir2)) {
    SUSystem "rm -rf $tmpdir2" and die "$Script: failed to remove old $tmpdir2";
  }
}

$debug = exists($ENV{'debug'}) ?  $ENV{'debug'} : "";
$imagetype = $ENV{fs};
$imagetype = "none" unless $imagetype;
$use_compress = 'gzip' if $imagetype =~ s/\.gz$//;
$use_compress = 'xz' if $imagetype =~ s/\.xz$//;
$use_compress = 'zstd' if $imagetype =~ s/\.zst$//;

# modes: keep, add, "" (default)
@mode{split ",", $ENV{mode}} = ( 1 .. 10 );

if(!$mode{keep} || $mode{add}) {
  if(!$mode{add}) {
    # clean up
    if(-d($tmpdir)) {
      SUSystem "rm -rf $tmpdir" and die "$Script: failed to remove old $tmpdir";
    }

    mkdir $tmpdir || die "$Script: failed to create $tmpdir";
  }

  $dangling_links = {};

  AddFiles $tmpdir, "${srcdir}/$fl.file_list", $srcdir, $dangling_links or
    die "$Script: failed to setup image";

  if(-s "$tmpdir.rpmlog") {
    SUSystem "chmod 777 $tmpdir";
    SUSystem "perl -pe 's/\\[(.*?)\\].*/\$1/' $tmpdir.rpmlog | sort -u >$tmpdir/.packages.$fl";
    SUSystem "cp $tmpdir.rpmlog $tmpdir/.packages.$fl";
    SUSystem "chmod 755 $tmpdir";
  }

#  print "fix locale...\n";
#  SUSystem "fix_locale $tmpdir";

  print "fix permissions of directories...\n";
  SUSystem "fix_perms $tmpdir";

  if($ENV{dostrip}) {
    print "strip everything...\n";
    SUSystem "strip_dir $tmpdir";
  }

  if($ENV{alternatives}) {
    print "handling update-alternatives links...\n";
    fix_alternatives_link $tmpdir;
  }

  if(!$ENV{nolinkcheck}) {
    print "checking for dangling symlinks...\n";
    if(check_link $tmpdir) {
      if($debug =~ /\bignore\b/) {
        warn "$Script: please fix symlinks\n";
      }
      else {
        die "$Script: please fix symlinks\n";
      }
    }
  }

  @libdeps = split ',', $ENV{libdeps};
  if(@libdeps) {
    $ldirs .= " ${BasePath}tmp/$_" for @libdeps;
    if($debug =~ /\bignore\b/ || $debug =~ /\bignorelibs\b/) {
      system "check_libs $ldirs" and
        warn "$Script: error in shared lib config, please fix\n";
    }
    else {
      system "check_libs $ldirs" and
        die "$Script: error in shared lib config, please fix\n";
    }
  }

  @perldeps = split ',', $ENV{perldeps};
  if(@perldeps) {
    $pdirs .= " ${BasePath}tmp/$_" for @perldeps;
    if($debug =~ /\bignore\b/ || $debug =~ /\bignorelibs\b/) {
      system "perl_deps --check $pdirs" and
        warn "$Script: error in perl module config, please fix\n";
    }
    else {
      system "perl_deps --check $pdirs" and
        die "$Script: error in perl module config, please fix\n";
    }
  }
}

if($tmpdir2) {
  SUSystem "common_tree --dst $tmpdir2 $tmpdir $tmpdisjunct";
  $tmpdir = "$tmpdir2/1";
}

if($imagetype eq 'dir') {
  SUSystem "rm -rf $image ; cp -a $tmpdir $image";
}
elsif($imagetype ne 'none') {
  $start_size = `du --apparent-size -k -s $tmpdir 2>/dev/null` + 0;
  $start_inodes = `find $tmpdir | wc -l 2>/dev/null` + 0;

  $start_inodes += 2000;
  $start_size = ($start_size + $start_inodes * 4096) * 1.2;

  # leave that much space
  $extra_size = 1000;		# kbyte
  $extra_inodes = 200;

  if($ENV{theme} eq 'Zen') {
    $extra_size = 20000;
    $extra_inodes = 10000;
  }

  Conv2Image $image, $tmpdir, $imagetype, $start_size, $start_inodes, $extra_size, $extra_inodes;
  $i = -s $image;
  print "$Script: created \"$image\" ($i bytes)\n";

  if($use_compress) {
    $i = CompressImage $image, $use_compress;
    print "$Script: compressed \"$image\" ($i bytes)\n";
  }
}


sub check_link
{
  my $dir = shift;
  my ($x, $err);
  local $_;

  for (`find $dir -type l`) {
    chomp;

    $x = readlink;

    my $ds = $_;
    $ds =~ s#^$dir/?##;

    next if $dangling_links->{$ds} eq $x;

    if($x =~ /^\//) {
      next if $x =~ m#^/lbin/#;
      next if $x =~ m#^/proc/#;
      next if $x =~ m#^/dev/#;

      # don't verify symlinks to symlinks
      next if -l "$dir$x" || -e _;
    }
    else {
      # don't verify symlinks to symlinks
      next if -l || -e _;
    }
    $err = 1;
    my $n = $_;
    $n =~ s#^$dir##;
    print STDERR "invalid: $n -> $x\n";
  }

  return $err;
}


sub fix_alternatives_link
{
  my $dir = shift;
  my $cnt = 0;

  die "oops, working on real root?\n" if $dir eq "" || $dir eq "/";

  for (`find $dir -type l`) {
    chomp;

    my $x = readlink;
    next if $x !~ m#/etc/alternatives/#;

    my $l = readlink "$dir$x";
    if($l) {
      unlink $_;
      if(!symlink($l, $_)) {
        print STDERR "symlink $l, $_: $!\n"
      }
      $cnt++;
    }
  }

  if($cnt) {
    unlink "$dir/usr/sbin/update-alternatives";
    unlink "$dir/usr/sbin/alternatives";
    unlink "$dir/var/log/update-alternatives.log";
    system "rm -r $dir/etc/alternatives/";
    system "rm -rf $dir/var/lib{/rpm,}/alternatives/";
  }
}

