#!/usr/bin/perl

#*********************************************************************
#
# install_packages -- read package config and install packages via apt-get
#
# This script is part of FAI (Fully Automatic Installation)
# (c) 2000-2025, Thomas Lange, lange@cs.uni-koeln.de
# (c) 2003-2004, Henning Glawe, glaweh@physik.fu-berlin.de
# (c) 2004     , Jonas Hoffmann, jhoffman@physik.fu-berlin.de
# PRELOAD feature from Thomas Gebhardt  <gebhardt@hrz.uni-marburg.de>
# (c) 2019     , TUXEDO Computers GmbH, tux@tuxedocomputers.com
#
#*********************************************************************
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING. If not, write to the
# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
# MA 02111-1307, USA.
#*********************************************************************

$0=~ s#.+/##; # remove path from program name

# import variables: $verbose, $MAXPACKAGES, $classes, $FAI, $FAI_ROOT, $aptoptions, $FAI_DEBSOURCESDIR

use strict;
use Getopt::Std;
use utf8; # needed for Eval::Logic

my $debug=0;
# global variables
our ($opt_c,$opt_d,$opt_l,$opt_L,$opt_v,$opt_h,$opt_H,$opt_m,$opt_n,$opt_N,$opt_p,$opt_s);
my $listonly; # flag, that indicates that only a list of packages will be printed
our %command;
our $atype;    # type of action (for apt-get, aptitude,..) that will be performed
our $pkgopt;   # additional option for packages
our $pkgrel;   # additional release info for packages
my $dryrun=0;
my $verbose;
my $FAI_ROOT;
my @classes;
our @clvar;
my $classpath;
my $rootcmd;
my @preloadlist;
my @preloadrmlist;
my $_config;
my $_system;
my $hasdebian=0;  # some Debian related commands/types are used in package_config
my %list;   # hash of arrays, key=type (yumi,aptitude,..), list of packages
my %types;  # hash containing the types found in all loaded package_config files
my %classisdef;
my $maxpl;  # maximum length of package list
my @known;   # list of all known packages
my $execerrors; # counts execution errors
my $aptopt='-y -o Dpkg::Options::=--force-confdef -o Dpkg::Options::=--force-confnew --allow-change-held-packages';
my $aptitudeopt='-y -o Dpkg::Options::=--force-confdef -o Dpkg::Options::=--force-confnew';
my $pacmanopts=' --noconfirm ';
my $downloaddir="/var/cache/apt/archives/partial/"; # where to download packages that gets only unpacked
my $debsourcesdir='/var/lib/fai/packages';
my @ls;
my %pname;   # hash of all available packages
my %install; # key is package names, value says if we want to install it
my %pmap;    # map package name from the list (including +-/=) to real package names
my @newlist; # list of packages, but unknown packages removed

$| = 1;


# @commands is the order of the commands that are executed
our @commands = qw/y2i y2r zypper zypper-pattern zypper-product zypper-rm yast rpmr urpmi urpme yumgroup yumi yumr dnfgroup dnfi dnfr smarti smartr hold taskrm taskinst clean-internal cupt cupt-r install install-norec aptitude aptitude-r apt unpack remove dselect-upgrade pacman-Rns pacman-S apk-add apk-del/;
%command = (
          "install" => "apt-get $aptopt --fix-missing install",
    "install-norec" => "apt-get $aptopt --fix-missing install --no-install-recommends",
           "remove" => "apt-get $aptopt --purge remove",
  "dselect-upgrade" => "apt-get $aptopt dselect-upgrade",
         "pacman-S" => "pacman $pacmanopts -S ",
       "pacman-Rns" => "pacman $pacmanopts -Rns ",
         "taskinst" => "tasksel install",
           "taskrm" => "tasksel remove",
             "hold" => "dpkg --set-selections",
   "clean-internal" => "apt-get clean",
         "aptitude" => "aptitude -R $aptitudeopt install",
       "aptitude-r" => "aptitude -r $aptitudeopt install",
              "apt" => "apt $aptopt install",
             "cupt" => "cupt -R $aptopt install",
           "cupt-r" => "cupt $aptopt install",
           "unpack" => "cd $downloaddir; apt download",
  "unpack-internal" => "dpkg --unpack --recursive $downloaddir; rm $downloaddir/*.deb",
 "pending-internal" => "dpkg --configure --pending",
   "dpkgc-internal" => "dpkg -C",
            "urpmi" => "urpmi --auto --foce --allow-force --keep",
            "urpme" => "urpme --auto --foce --allow-force --keep",
             "yumi" => "yum -y install",
             "yumr" => "yum -y remove",
        "yumgroup"  => "yum -y groupinstall",
             "dnfi" => "dnf -y install",
             "dnfr" => "dnf -y remove",
        "dnfgroup"  => "dnf -y group install",
             "y2i"  => "y2pmsh isc",
             "y2r"  => "y2pmsh remove",
             "yast" => "yast -i",
           "zypper" => "zypper -n install -l",
   "zypper-pattern" => "zypper -n install -l -t pattern",
   "zypper-product" => "zypper -n install -l -t product",
        "zypper-rm" => "zypper -n remove",
             "rpmr" => "rpm -e",
           "smarti" => "smart install -y",
           "smartr" => "smart remove -y",
  "smartc-internal" => "smart clean",
	  "apk-add" => "apk add",
	  "apk-del" => "apk del",
);

getopts('cdhHvlLm:p:nNs');

$opt_d=1 if $opt_c;
$listonly = $opt_l || $opt_L;
$opt_h && usage();
$opt_H && showcommands();
$dryrun=1 if $opt_n;
$verbose=$ENV{verbose} || $opt_v;
$opt_d && setdownloadonly();
$maxpl=$ENV{MAXPACKAGES} || $opt_m ;
$maxpl && $verbose && warn "Maximum number of packages installed at a time set to $maxpl\n";
$maxpl or $maxpl = 99 ; # set default value
$opt_N=$ENV{FAI_DISABLE_PACKAGE_NAME_CHECK} || $opt_N;

my $qopt="-qq" unless $verbose;
my $devnull=">/dev/null" unless $verbose;

$FAI_ROOT = $ENV{FAI_ROOT};
$classpath = $opt_p || "$ENV{FAI}/package_config";
$rootcmd = ($FAI_ROOT eq "/" or not defined $FAI_ROOT ) ? '' : "chroot $FAI_ROOT";
@classes = grep { !/^#|^\s*$/ } split(/[\s\n]+/,$ENV{classes});
foreach (@classes) { $classisdef{$_}=1;}
# define an array of arguments for subroutine call: the class names, set to 1
@clvar =  map { $_,1 }  map { s/-/Ö/gr } @classes;

warn "$0: reading config files from directory $classpath\n" if $verbose;
foreach (@classes) {
  &readconfig($classpath,$_) if -f "$classpath/$_"; # read all package config files
}

# check if any Debian related commands/types are used in package_config
my @debiantypes= qw/taskinst cupt cupt-r apt aptitude aptitude-r install install-norec remove dselect-upgrade smarti/;
foreach my $dt (@debiantypes) {
  $types{$dt} and $hasdebian=1;
}

if ($types{'smarti'}) {  # smarti is used in a packages_config file
  $command{'clean-internal'} = $command{'smartc-internal'};
  $command{'pending-internal'} = "true";
  $command{'dpkgc-internal'} = "true";
}

# get files which must exist before installing packages
foreach my $entry (@preloadlist,@preloadrmlist) {
  my ($url, $directory) = @$entry;
  if ($url =~ m!^file:/(.+)!) {
    my $file = $1;
    execute("cp $FAI_ROOT/$file $FAI_ROOT/$directory") unless $listonly;
  } else {
    execute("cd $FAI_ROOT/$directory; curl -# -O $url") unless $listonly;
  }
}

$hasdebian && create_debian_pkg_list();

# - - - - - - - - - - - - - - - - - - - - - - - - - - -
# begin of the big foreach loop
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
# call apt-get or tasksel for each type of command whith the list of packages
foreach $atype (@commands) {

  if ($atype eq "clean-internal" && $hasdebian) {
    execute("$rootcmd $command{'clean-internal'}") unless $listonly;
    next;
  }

  # skip if empty list
  next unless defined $list{$atype};
  my $pkglist;

  foreach $pkgopt (sort keys %{$list{$atype}}) {
    $pkglist = $list{$atype}{$pkgopt}; # create an alias
    # skip if empty list
    next unless defined $pkglist;

    # map release= option to -t
    undef $pkgrel;
    if ($pkgopt =~ /release=(\S+)/) {
      $pkgrel=" -t $1";
    }

    if ($atype eq "dselect-upgrade") {
      dselectupgrade($atype);
      next;
    }

    my $packlist = join(' ',@{$pkglist});

    if ($atype eq "hold") {
      my $hold = join " hold\n", @{$list{hold}{$pkgopt}}, "";
      execute("echo \"$hold\" | $rootcmd $command{hold}");
      next;
    }

    if ($atype eq "install" || $atype eq "install-norec" || $atype eq "smarti" || $atype eq "cupt"|| $atype eq "cupt-r"|| $atype eq "apt" || $atype eq "aptitude" || $atype eq "aptitude-r" || $atype eq "unpack" || $opt_l || $opt_L) {

      mkpackagelist(@{$pkglist}); # create lists of known and unknown packages
      getsources();               # retrieve sources
      if ($opt_l) {
        next;
      }
      if ($opt_L) {
        # only print the package list, only works for install and instal-norec
        execute("$rootcmd $command{$atype} -s @known | egrep ^Inst");
        next;
      }

      # pass only maxpl packages to apt-get
      while (@known) {
        my $shortlist = join(' ', splice @known,0,$maxpl);

        # we can skip a package it's already processed,
        if ($maxpl == 1 && $shortlist) {
          @ls=<$ENV{FAI_ARCHIVE_DIR}/${shortlist}_*deb>;
          next if @ls;
        }
        execute("$rootcmd $command{$atype} $pkgrel $shortlist") if $shortlist;
        execute("$rootcmd $command{'clean-internal'}") if $hasdebian;
        execute("$rootcmd $command{'unpack-internal'}") if ($atype eq "unpack"); # unpack and rm deb files
      }
      next;
    }

    if ($atype eq "taskinst" || $atype eq "taskrm") {
      foreach my $tsk (@{$list{$atype}}) {
        execute("$rootcmd $command{$atype} $tsk");
      }
      next;
    }

    # other types
    execute("$rootcmd $command{$atype} $packlist") if $packlist;
  }                             # foreach $pkgopt
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
# end of the big foreach loop
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
if ($opt_L) {
  exit 0;
}
if ($opt_l) {
  print join ' ',@known,"\n";
  exit 0;
}

# remove preloaded files
foreach my $entry (@preloadrmlist) {
  my ($url, $directory) = @$entry;
  $url =~ m#/([^/]+$)#;
  my $file =  "$directory/$1";
  print "rm $file\n" if $verbose;
  unlink $file || warn "Can't remove $file\n";
}

if ($hasdebian) {
  # in case of unconfigured packages because of apt errors
  # retry configuration
  execute("$rootcmd $command{'pending-internal'}");
  # check if all went right
  execute("$rootcmd $command{'dpkgc-internal'}");
  # clean apt cache
  execute("$rootcmd $command{'clean-internal'}");
}

if ($execerrors) {
  warn "$execerrors errors during executing of $0\n";
  exit 3;
}

exit 0; # end of program
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub readconfig {

  my ($path,$file) = @_;
  my ($package,$type,$cllist,@oclasses,$doit);
  my $pkgoption;

  open (FILE,"$path/$file") || warn "ERROR $0: Can't read config file: $path/$file\n";
  warn "$0: read config file $file\n" if $verbose;

  while (<FILE>) {
    next if /^#/;    # skip comments
    s/#.*$//;        # delete comments
    next if /^\s*$/; # skip empty lines
    chomp;
    /^PRELOAD\s+(\S+)\s+(\S+)/   and push(@preloadlist,   [$1,$2]),next;
    /^PRELOADRM\s+(\S+)\s+(\S+)/ and push(@preloadrmlist, [$1,$2]),next;

    if (/^PACKAGES\s+(\S+)\s*(\S+=\S+)?\s*/) {
      ($type,$pkgoption,$cllist) = ($1,$2,$');

      warn "ERROR: PACKAGES option $pkgoption not allowed\n" unless ( ! defined $pkgoption or $pkgoption =~ /^release=/);

      warn "WARNING: Unknown action $type after PACKAGES\n" unless defined $command{$type};

      # by default no classes are listed after this command so doit
      $doit = 1;
      if ($cllist) {
        next if ($opt_d && $cllist =~ /!/); # if we have a negation in the regex we need to download for fai-mirror
        # check if we only have a list of classes or some logical expression
        if ($cllist =~ /[!&|()]/) { # we found a logical expression
          eval "require Eval::Logic" or
            die "Perl module Eval::Logic is not available\n";
          $cllist =~ s/-/Ö/g;
          my $expr = Eval::Logic->new ( "$cllist" );
          $expr->undef_default ( 0 ); # set default value for undefined classes
          $doit = $expr->evaluate( @clvar );
          print "REGEX: $cllist = $doit\n" if $debug;
        } else {
          # use packages only for the list of classes (like a logical or for all classes)
          $doit = 0; # assume no class is defined
          @oclasses = split(/\s+/,$cllist);
          # if a listed class is defined, add the packaes, otherwise skip these packages
          foreach (@oclasses) { exists $classisdef{$_} and $doit = 1;}
        }
      }
      next;
    }

    # warning if uppercase letters are found (package are always lowercase)
    warn "WARNING: Uppercase character found in package name in line $_\n" if $_ =~ /[A-Z]/;
    unless ($type) {
        warn "ERROR: PACKAGES .. line missing in $file\n";
        next;
    }
    push @{$list{$type}{$pkgoption}}, split if $doit;
    $types{$type}=1 if $doit;   # remember which types are used in package_config
  }
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub execute {

  # execute a command or only print it
  my @cmds = @_;

  # TODO: split cmds into array except when a pipe is found

  my $command = join (' ',@cmds);
  $command =~ s/\s+/ /g;
  my $error;

  return if ($command eq ' true');  # do not execute noop command
  $dryrun and $verbose = 1;
  $verbose and warn "$0: executing $command\n";
  $dryrun and return;

  # @cmds should me more efficient
  $error = system @cmds;
  warn "ERROR: $error $?\n" if $error;
  my $rc = $?>>8;
  warn "ERROR: $cmds[0] return code $rc\n" if $rc;
  $execerrors++ if $rc;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub dselectupgrade {

  my $type = shift;
  my ($package,$action,$list);
  my $tempfile = "$FAI_ROOT/var/lib/fai/dpkg-selections.tmp"; # TODO: use better uniq filename
  while (@{$list{$type}}) {
    $package = shift @{$list{$type}};
    $action  = shift @{$list{$type}};
    $list .= "$package $action\n";
  }

  open TMP,"> $tempfile" || die " Can't write to $tempfile";
  print TMP $list;
  close TMP;

  execute("$rootcmd dpkg --set-selections < $tempfile");
  execute("$rootcmd $command{$type}");
  unlink $tempfile;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub mkpackagelist {

  # CURRENTLY no packages are removed from the list of known packages

  my @complete = @_; # copy original list
  # @known contains the known packages

  # on Debian system, clean list of packages
  if ( ! $opt_N && $hasdebian ) {
    @known = clean_pkg_list(@complete);
  } else {
    @known = @complete;
  }

  return if $opt_c;
  writepackages();
  return;
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub writepackages {

  # write package list to log file

  return if $opt_d; # do not write the list if we only download packages
  return if $opt_l; # do not write the list to a file, just print it
  return if $dryrun;

  open(LIST,"> $FAI_ROOT/var/log/install_packages.list") || warn "ERROR $0: Can't write package list file: $!\n";
  print LIST "# List of all packages that will be installed via install_packages\n";
  for (@known) { print LIST "$_\n"; }
  close(LIST);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
# download debian source packages
sub getsources {

  return unless $opt_s;

  print "Trying to retrieve sources as specified via -s option for install_packages\n" if $verbose;

  if (!$ENV{'FAI_DEBSOURCESDIR'}) {
    die "Error: FAI_DEBSOURCESDIR is not set, can not retrieve sources.";
  }

  execute("mkdir -p $FAI_ROOT/$debsourcesdir;");
  execute("mkdir -p $ENV{'FAI_DEBSOURCESDIR'};");
  for (@known) {
    execute("$rootcmd sh -c \"cd $debsourcesdir ; apt-get --download-only source $_\"");
    execute("mv $FAI_ROOT/$debsourcesdir/* $ENV{'FAI_DEBSOURCESDIR'}");
  }
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub usage {

  print << "EOF";
install_packages

 Please read the manual pages install_packages(8).
EOF
  exit 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub setdownloadonly {

# Definitions for install_packages(8) for download only mode
# Used by fai-mirror(1)

# we are using a variable from %ENV
# for debugging remove >/dev/null and -q

undef @commands;
undef %command;

$maxpl=9999;
@commands = qw/taskinst cupt cupt-r aptitude aptitude-r install install-norec apt unpack/;
%command = (
          "install" => "apt-get $qopt -d $ENV{aptoptions} -y --fix-missing install",
    "install-norec" => "apt-get $qopt -d $ENV{aptoptions} -y --fix-missing install --no-install-recommends",
         "taskinst" => "aptitude -d $ENV{aptoptions} -y install $devnull",
              "apt" => "apt -d $ENV{aptoptions} -y install $devnull",
         "aptitude" => "aptitude -R -d $ENV{aptoptions} -y install $devnull",
       "aptitude-r" => "aptitude -r -d $ENV{aptoptions} -y install $devnull",
             "cupt" => "cupt -R --download-only $ENV{aptoptions} -y install $devnull",
           "cupt-r" => "cupt --download-only $ENV{aptoptions} -y install $devnull",
           "unpack" => "cd $downloaddir; aptitude download",
   "clean-internal" => 'true',
 "pending-internal" => 'true',
   "dpkgc-internal" => 'true',
);

}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub showcommands {

  # show all available commands
  print "List of known commands for package_config files\n";
  print "Short list:\n";
  foreach (sort keys %command) {
    next if /-internal/; # skip internal commands
    print "$_\n";
  }

  print "\nLong list:\n";
  foreach (sort keys %command) {
    next if /-internal/; # skip internal commands
    printf "%15s    $command{$_}\n",$_;
  }
  exit 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub create_debian_pkg_list {
  # build a hash of all known package names
  open(IN,"$rootcmd apt-cache $ENV{aptoptions} dumpavail |") || die;
  while (<IN>) {
    chomp;
    if (s/^Package: //) {
      $pname{$_} = 1;
    } elsif (s/^Provides: //) {
      foreach (split /\s*,\s*/) {
        $pname{$_} = 1;
      }
    }
  }
  close(IN);
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub insert_pkg {

  # if package name is known, insert package into data structure, return success
  # insert orig package name and modified name into %pmap
  # %pmap maps orig name (including +-=) to real package names
  # save status install/remove of each package in %install

  my ($orig, $pack, $install, $msg) = @_;

  if ($pname{$pack}) {
    print "$msg\n" if $debug;
    push @newlist, $orig;
    $pmap{$orig} = "$pack";
    $install{$pack} = $install;
    return 1;
  }
  return 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub clean_pkg_list {

  # clean up the list of packages, remove unknown packages,
  # "merge" things like: pkgA pkgA-

  my @inlist = @_;
  my $pack;
  my @unknown;
  my @final; # final list of packages

  # clean global hashes
  undef %pmap;
  undef %install;

  foreach my $n (@inlist) {
    $pack = $n;

    # plain package name is known, this also matches g++, memtest86+, ...
    insert_pkg($n, $pack, 1, "$n found") && next;

    # handle packagename-
    if ( $pack =~ s/-$//) {
      insert_pkg($n, $pack, 0, "$pack - removed") && next;
    }

    # handle packagename+, where packagename itself does not include a +
    if ( $pack =~ s/\+$//) {
      insert_pkg($n, $pack, 1, "$pack + added") && next;
    }

    # remove /distribution or =version from package name
    if ( $pack =~ s#[/=].+##) {
      insert_pkg($n, $pack, 1, "$n using $pack found") && next;
    }

    # remove :arch from package name
    if ( $pack =~ s/:\S+//) {
      insert_pkg($n, $pack, 1, "$n using $pack found") && next;
    }

    # handle $varname in package name
    if ( $pack =~ /\$(\w+)/) {
      $pack = $ENV{$1};
      insert_pkg($n, $pack, 1, "$n using $pack found") && next;
    }

    # handle ${varname} in package name
    if ( $pack =~ /\$\{(\w+)\}/) {
      $pack = $ENV{$1};
      insert_pkg($n, $pack, 1, "$n using $pack found") && next;
    }

    # else package is unknown
    push @unknown, $n;
  }

  warn "WARNING: These unknown packages are removed from the installation list: " . join(' ', @unknown) . "\n" if @unknown;
  $opt_c && return;

  print "-"x30,"\n" if $debug;
  print join ' ' ,"   ORIG:", @inlist, "\n" if $debug;
  print join ' ' ,"INSTALL:", @newlist, "\n" if $debug;


  # create new list of packages (incl. +-/=) that should be installed or removed
  foreach (@newlist) {

    push @final, $_ if ($install{$pmap{$_}} == 0 && $_ =~/-$/); # pkg names with - that should be not installed
    next if ($install{$pmap{$_}} == 1 && $_ =~/-$/);
    next unless $install{$pmap{$_}}; # do not include package that are marked as do not install
    push @final, $_;
  }

  print join ' ' ,"DO INST:", @final, "\n" if $debug;
  return @final;
}