#!/usr/bin/perl

# $Id$
#*********************************************************************
#
# install_packages -- read package config and install packages via apt-get
#
# This script is part of FAI (Fully Automatic Installation)
# (c) 2000-2004, Thomas Lange, lange@informatik.uni-koeln.de
#
#*********************************************************************
# 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.
#*********************************************************************

my $version = "Version 2.5.1, 9-november-2004";
$0=~ s#.+/##; # remove path from program name

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

use strict;
use Getopt::Std;
use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Cache;
# global variables
our ($opt_l,$opt_L,$opt_v,$opt_h,$opt_t,$opt_m);
my $listonly; # flag, that indicates that only a list of packages will be printed
my @commands;
my %command;
our $atype;    # type of action (for apt-get, aptitude,..) that will be performed
my $test;
my $verbose;
my $FAI_ROOT;
my @classes;
my $classpath;
my $rootcmd;
my @preloadlist;
my @preloadrmlist;
my %list;
my %classisdef;
my $maxpl;  # maximum length of package list
my $cache;  # instance of AptPkg::Cache
my @unknown; # unknown packages
my @known;   # list of all known packages

# PRELOAD feature from Thomas Gebhardt  <gebhardt@hrz.uni-marburg.de>

$| = 1;
# order of commands to execute
@commands = qw/hold taskrm taskinst clean aptitude install remove dselect-upgrade/;
%command = (
	    install => 'apt-get -y --force-yes --fix-missing install',
	   ninstall => 'apt-get -y --force-yes --fix-missing -s install',
	    remove  => 'apt-get -y --purge remove',
  "dselect-upgrade" => 'apt-get -y dselect-upgrade',
         "taskinst" => 'tasksel -n install',
           "taskrm" => 'tasksel -n remove',
             "hold" => 'dpkg --set-selections',
            "clean" => 'apt-get clean',
         "aptitude" => 'aptitude -y install',
);

$test = 0;
getopts('thvlLm:');

$listonly = $opt_l || $opt_L;
$opt_h && usage();
$opt_t and $test = 1;
$verbose=$ENV{verbose} || $opt_v;
$maxpl=$ENV{MAXPACKAGES} || $opt_m ;
$maxpl && warn "Maxmimum number of packages installed at a time set to $maxpl\n";
$maxpl or $maxpl = 99 ; # set default value

$FAI_ROOT = $ENV{FAI_ROOT};
$classpath = "$ENV{FAI}/package_config";
$rootcmd = ($FAI_ROOT eq "/" ) ? '' : "chroot $FAI_ROOT";
@classes = grep { !/^#|^\s*$/ } split(/[\s\n]+/,$ENV{classes});
foreach (@classes) { $classisdef{$_}=1;}


$_config->init;                 # initialize AptPkg
$_config->set("Dir",$FAI_ROOT); # simulate "chroot"
$_config->{quiet}=2;            # don't show cache initialization messages
$_system = $_config->system;
$cache = new AptPkg::Cache;

# read all package config files
foreach (@classes) {
  my $filename = "$classpath/$_";
  &readconfig($filename) if -f $filename;
}

# 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("wget -nv -P$FAI_ROOT/$directory $url") unless $listonly;
  }
}

# call apt-get or tasksel for each type of command whith the list of packages
foreach $atype (@commands) {
  if ($atype eq "clean") {
    execute("$rootcmd apt-get clean") unless $listonly;
    next;
  }

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

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

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

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

  if ($atype eq "install" || $atype eq "aptitude" || $opt_l || $opt_L) {

    mkpackagelist(@{$list{$atype}}); # create lists of known and unknown packages
    if ($opt_l) {
      # only print the package list
      print join ' ',@known,"\n";
      exit 0;
    }
    if ($opt_L) {
      # only print the package list
      execute("$rootcmd $command{ninstall} @known | egrep ^Inst");
      exit 0;
    }
    # pass only maxpl packages to apt-get
    while (@known) {
      my $shortlist = join(' ', splice @known,0,$maxpl);
      # print "SL $shortlist\n";
      execute("$rootcmd $command{$atype} $shortlist") if $shortlist;
      execute("$rootcmd apt-get clean");
    }
    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;
}

# remove prelaoded 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";
}

# in case of unconfigured packages because of apt errors
# retry configuration
execute("$rootcmd dpkg --configure --pending");
# check if all went right
execute("$rootcmd dpkg -C");
# clean apt cache
execute("$rootcmd apt-get clean");
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub readconfig {

  my $filename = shift;
  my ($package,$type,$cllist,@oclasses,$doit);

  open (FILE,"$filename") || warn "ERROR $0: Can't read config file: $filename\n";
  warn "$0: read config file $filename\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*/) {
      ($type,$cllist) = ($1,$');
      # by default no classes are listed after this command so doit
      $doit = 1;
      if ($cllist) {
	# no classes specified after PACKAGES command
      # so add all packages listed
	# use packages on for a list of 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;
    }

    warn "PACKAGES .. line missing in $filename\n",next unless $type;
    push @{$list{$type}}, split if $doit;
  }
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
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);
  my $error;

  $test and $verbose = 1;
  $verbose and warn "$0: executing $command\n";
  $test and return;

  # @cmds should me more efficient
  $error = system @cmds;
  warn "ERROR: $error $?\n" if $error;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub dselectupgrade {

  my $type = shift;
  my ($package,$action,$list);
  my $tempfile = "$FAI_ROOT/tmp/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 {

  my @orig = @_; # copy original list
  @unknown = @known = ();

  # create two list of packages
  # @unknown contains the unkown packages
  # @known contains the kown packages
  foreach my $pack (@orig) {

    if ($pack =~ /[$\`]/) {
      # add to known if backtick or $ is found
      push @known, $pack;
      next;
    }

    if ($atype eq "aptitude" && $pack =~ /^~/) {
      # add to known if is it an aptitude search pattern
      push @known, $pack;
      next;
    }
# TODO: aptitude also can install tasks. How do we check them? Currently they will push to @unknown

    if ($cache->exists($pack)) { # simple package name
      # check for packages with no installation candidates
      # explicitely don't check if the name is provided by some other package:
      # apt-get install <virtual> fails with newer apt

      if (defined ($cache->{$pack}{VersionList})) {
	push @known, $pack;
      } else {
	push @unknown, $pack;
      }

    }

    # simulate APTs and aptitudes understanding of "special" package names
    # suffixed by -, +
    elsif ( $pack =~ /^(.*)[_=+-]$/ and $cache->exists($1)) {

      if (defined ($cache->{$1}{VersionList})) {
	push @known, $pack;
      } else {
	push @unknown, $pack;
      }

    } else {
      push @unknown, $pack;
    }
  }
  warn "WARNING: These unknown packages are removed from the installation list: " . join(' ',sort @unknown) . "\n" if @unknown;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub usage {

  print << "EOF";
install_packages $version

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