rhel-install-fixes_3.1.8/bin/install_packages

#!/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-2006, 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 3.4.1, 10-oct-2006";
$0=~ s#.+/##; # remove path from program name

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

use strict;
use Getopt::Std;
use vars qw/$aptpkg_avail/;

my @classes;
@classes = grep { !/^#|^\s*$/ } split(/[\s\n]+/,$ENV{classes});

#$aptpkg_avail=-1;

#if (eval       "require AptPkg::Config") {
#       $aptpkg_avail=1;
#}

# TODO: even if apt is available, turn it off if target is not a debian
# system!
#if ( grep $_ eq 'DIST-DEBIAN', @classes) {
#    $aptpkg_avail=-1;
#} elsif ( eval         "require AptPkg::Config" &&  grep $_ eq 'DIST-DEBIAN', @classes ) {
if ( eval       "require AptPkg::Config" &&  grep $_ eq 'DIST-DEBIAN', @classes ) {
        $aptpkg_avail=1;
} else {
    $aptpkg_avail=-1;
}


my $_config;
my $_system;

if ($aptpkg_avail==1) { 
    print "this is a debian system\n";
    eval        "require AptPkg::System";
    eval        "require AptPkg::Cache";

    $_config = $AptPkg::Config::_config;
    $_system = $AptPkg::System::_system;
    eval        'import AptPkg::Config $_config';
    eval        'import AptPkg::System $_system';
    eval        'import AptPkg::Cache';
}

# global variables
our ($opt_d,$opt_l,$opt_L,$opt_v,$opt_h,$opt_t,$opt_m,$opt_p);
my $listonly; # flag, that indicates that only a list of packages will be printed
our @commands;
our %command;
our $atype;    # type of action (for apt-get, aptitude,..) that will be performed
my $test;
my $verbose;
my $FAI_ROOT;
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
my $downloaddir="/var/cache/apt/archives/partial/"; # where to download packages that gets only unpacked

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

$| = 1;
# order of commands to execute

my $aptopt='-y -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold"';

@commands = qw/y2i y2r yast rpmr urpmi urpme yumgroup yumi yumr hold taskrm taskinst clean aptitude aptitude-r install unpack remove dselect-upgrade/;
%command = (
            install => "apt-get $aptopt --fix-missing install",
           ninstall => "apt-get $aptopt --fix-missing -s install",
            remove  => "apt-get $aptopt --purge remove",
  "dselect-upgrade" => "apt-get $aptopt dselect-upgrade",
         "taskinst" => "tasksel -n install",
           "taskrm" => "tasksel -n remove",
             "hold" => "dpkg --set-selections",
            "clean" => "apt-get clean",
         "aptitude" => "aptitude -R $aptopt install",
       "aptitude-r" => "aptitude -r $aptopt install",
           "unpack" => "cd $downloaddir; aptitude download",
  "unpack-internal" => "dpkg --unpack --recursive $downloaddir; rm $downloaddir/*.deb",
          "pending" => "dpkg --configure --pending",
            "dpkgc" => "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",
              y2i   => "y2pmsh isc",
              y2r   => "y2pmsh remove",
              yast  => "yast -i",
               rpmr => "rpm -e",
);

$test = 0;
getopts('dthvlLm:p:');

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

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 "/" ) ? '' : "chroot $FAI_ROOT";
# HENNING: moved up, needed to check if we are installing debian and running
# on debian
#@classes = grep { !/^#|^\s*$/ } split(/[\s\n]+/,$ENV{classes});
foreach (@classes) { $classisdef{$_}=1;}

if ($aptpkg_avail==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 $command{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 =~ /rpm|yum|y2/) {
    $command{clean} = "true"; # do not cal apt-get lcean for rpm and yum packages
    execute("$rootcmd $command{$atype} $packlist") if $packlist;
    next;
  }

  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" || $atype eq "unpack" || $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 $command{'clean'}"); # XXX do not execute always
      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;
}

# 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 ($aptpkg_avail==1) {
        # in case of unconfigured packages because of apt errors
        # retry configuration
        execute("$rootcmd $command{pending}");
        # check if all went right
        execute("$rootcmd $command{dpkgc}");
        # clean apt cache
        execute("$rootcmd $command{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,$');
      warn "WARNING: Unknow action $type after PACKAGES\n." unless defined $command{$type};
      # 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;
    }

    # warning if uppercase letters are found (package are always lowercase)
    warn "WARNING: Uppercase character found in package name in line $_\n" if $_ =~ /[A-Z]/;
    warn "ERROR: 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 installable {
  # ckeck, wether package can be installed.
  # return false for packages which only exist in 
  # dpkg status files

  my $package  = shift;
  # print "Checking wether $package is installable...\n";

  # version list of package
  my $vlist = $cache->{$package}{VersionList};

  # for each version
  foreach my $version (@$vlist) {
    # list of package files
    my $flist = $version->{FileList};
    foreach my $fitem (@$flist) {
      # if the file is a package index (not a dpkg status file)
      # the package is installable 
      return 1 if ($fitem->{File}{IndexType} eq "Debian Package Index");
    }
  }

  # no package index file found for the current package
  return 0;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub mkpackagelist {

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

  # create two list of packages
  # @unknown contains the unknown packages
  # @known contains the known packages

  # ignore packages ending with - when using -d
  @complete = grep {!/-$/} @complete if $opt_d; 

  foreach (reverse @complete) {
    my $pack = $_;
    if ($aptpkg_avail==1) {
        if ( /^(.+)[_=+-]$/ and $1 and $cache->exists($1)) {
            $pack = $1;
        }
    }
    if (! defined ($complete{$pack})) {
      $complete{$pack} = 1;
      unshift @orig, $_;
    }
  }

  # currently we disable the complete checking of package names if aptitude
  # is used. This is because we can't check task names, which are supported by aptitude
  if ($atype eq "aptitude") {
    @known=@orig;
    return;
  }

  foreach my $pack (@orig) {

#     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 (installable($pack)) {
        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;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
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 aptitude aptitude-r install unpack/;
%command = (
            install => "apt-get $qopt -d $ENV{aptoptions} -y --fix-missing install",
         "taskinst" => "aptitude -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",
           "unpack" => "cd $downloaddir; aptitude download",
            "clean" => 'true',
          "pending" => 'true',
            "dpkgc" => 'true',
);

}
# - - - - - - - - - - - - - - - - - - - - - - - - - - -
1	lange	2	#!/usr/bin/perl
2
3			# $Id$
4			#*********************************************************************
5			#
6	lange	534	# install_packages -- read package config and install packages via apt-get
7	lange	2	#
8			# This script is part of FAI (Fully Automatic Installation)
9	lange	3321	# (c) 2000-2006, Thomas Lange, lange@informatik.uni-koeln.de
10	lange	2	#
11			#*********************************************************************
12			# This program is free software; you can redistribute it and/or modify
13			# it under the terms of the GNU General Public License as published by
14			# the Free Software Foundation; either version 2 of the License, or
15			# (at your option) any later version.
16			#
17			# This program is distributed in the hope that it will be useful, but
18			# WITHOUT ANY WARRANTY; without even the implied warranty of
19			# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20			# General Public License for more details.
21	lange	1139	#
22	lange	2	# You should have received a copy of the GNU General Public License
23			# along with this program; see the file COPYING. If not, write to the
24			# Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
25			# MA 02111-1307, USA.
26			#*********************************************************************
27
28	lange	4073	my $version = "Version 3.4.1, 10-oct-2006";
29	lange	2367	$0=~ s#.+/##; # remove path from program name
30	lange	1402
31	lange	2353	# import variables: $verbose, $MAXPACKAGES, $classes, $FAI, $FAI_ROOT
32
33	lange	1139	use strict;
34	lange	1333	use Getopt::Std;
35	lazyboy-guest	4402	use vars qw/$aptpkg_avail/;
36	lange	2493
37	lazyboy-guest	4402	my @classes;
38			@classes = grep { !/^#\|^\s*$/ } split(/[\s\n]+/,$ENV{classes});
39
40			#$aptpkg_avail=-1;
41
42			#if (eval "require AptPkg::Config") {
43			# $aptpkg_avail=1;
44			#}
45
46			# TODO: even if apt is available, turn it off if target is not a debian
47			# system!
48			#if ( grep $_ eq 'DIST-DEBIAN', @classes) {
49			# $aptpkg_avail=-1;
50			#} elsif ( eval "require AptPkg::Config" && grep $_ eq 'DIST-DEBIAN', @classes ) {
51			if ( eval "require AptPkg::Config" && grep $_ eq 'DIST-DEBIAN', @classes ) {
52			$aptpkg_avail=1;
53			} else {
54			$aptpkg_avail=-1;
55			}
56
57
58			my $_config;
59			my $_system;
60
61			if ($aptpkg_avail==1) {
62			print "this is a debian system\n";
63			eval "require AptPkg::System";
64			eval "require AptPkg::Cache";
65
66			$_config = $AptPkg::Config::_config;
67			$_system = $AptPkg::System::_system;
68			eval 'import AptPkg::Config $_config';
69			eval 'import AptPkg::System $_system';
70			eval 'import AptPkg::Cache';
71			}
72
73	lange	1139	# global variables
74	lange	3833	our ($opt_d,$opt_l,$opt_L,$opt_v,$opt_h,$opt_t,$opt_m,$opt_p);
75	lange	2483	my $listonly; # flag, that indicates that only a list of packages will be printed
76	lange	2499	our @commands;
77			our %command;
78	lange	2491	our $atype; # type of action (for apt-get, aptitude,..) that will be performed
79	lange	1139	my $test;
80			my $verbose;
81			my $FAI_ROOT;
82			my $classpath;
83			my $rootcmd;
84			my @preloadlist;
85			my @preloadrmlist;
86			my %list;
87	lange	1402	my %classisdef;
88	lange	2010	my $maxpl; # maximum length of package list
89	lange	2348	my $cache; # instance of AptPkg::Cache
90			my @unknown; # unknown packages
91			my @known; # list of all known packages
92	lange	3283	my $downloaddir="/var/cache/apt/archives/partial/"; # where to download packages that gets only unpacked
93	lange	1139
94	lange	2	# PRELOAD feature from Thomas Gebhardt <gebhardt@hrz.uni-marburg.de>
95
96			$\| = 1;
97	lange	753	# order of commands to execute
98	lange	2677
99			my $aptopt='-y -o Dpkg::Options::="--force-confdef" -o Dpkg::Options::="--force-confold"';
100
101	lange	3383	@commands = qw/y2i y2r yast rpmr urpmi urpme yumgroup yumi yumr hold taskrm taskinst clean aptitude aptitude-r install unpack remove dselect-upgrade/;
102	lange	753	%command = (
103	lange	3163	install => "apt-get $aptopt --fix-missing install",
104			ninstall => "apt-get $aptopt --fix-missing -s install",
105	lange	2677	remove => "apt-get $aptopt --purge remove",
106			"dselect-upgrade" => "apt-get $aptopt dselect-upgrade",
107			"taskinst" => "tasksel -n install",
108			"taskrm" => "tasksel -n remove",
109			"hold" => "dpkg --set-selections",
110			"clean" => "apt-get clean",
111	lange	3121	"aptitude" => "aptitude -R $aptopt install",
112	lange	2793	"aptitude-r" => "aptitude -r $aptopt install",
113	lange	3283	"unpack" => "cd $downloaddir; aptitude download",
114			"unpack-internal" => "dpkg --unpack --recursive $downloaddir; rm $downloaddir/*.deb",
115	lange	2677	"pending" => "dpkg --configure --pending",
116			"dpkgc" => "dpkg -C",
117	lange	3321	urpmi => "urpmi --auto --foce --allow-force --keep",
118	lange	3347	urpme => "urpme --auto --foce --allow-force --keep",
119			yumi => "yum -y install",
120			yumr => "yum -y remove",
121	lange	3383	yumgroup => "yum -y groupinstall",
122			y2i => "y2pmsh isc",
123			y2r => "y2pmsh remove",
124			yast => "yast -i",
125			rpmr => "rpm -e",
126	lange	2	);
127
128	lange	534	$test = 0;
129	lange	3833	getopts('dthvlLm:p:');
130	lange	534
131	lange	2483	$listonly = $opt_l \|\| $opt_L;
132	lange	1402	$opt_h && usage();
133			$opt_t and $test = 1;
134	lange	1333	$verbose=$ENV{verbose} \|\| $opt_v;
135	lange	2628	$opt_d && setdownloadonly();
136	lange	2010	$maxpl=$ENV{MAXPACKAGES} \|\| $opt_m ;
137	lange	2522	$maxpl && $verbose && warn "Maxmimum number of packages installed at a time set to $maxpl\n";
138	lange	2416	$maxpl or $maxpl = 99 ; # set default value
139	lange	2010
140	lange	2860	my $qopt="-qq" unless $verbose;
141	lange	2867	my $devnull=">/dev/null" unless $verbose;
142	lange	2860
143	lange	2	$FAI_ROOT = $ENV{FAI_ROOT};
144	lange	3833	$classpath = $opt_p \|\| "$ENV{FAI}/package_config";
145	lange	753	$rootcmd = ($FAI_ROOT eq "/" ) ? '' : "chroot $FAI_ROOT";
146	lazyboy-guest	4402	# HENNING: moved up, needed to check if we are installing debian and running
147			# on debian
148			#@classes = grep { !/^#\|^\s*$/ } split(/[\s\n]+/,$ENV{classes});
149	lange	1402	foreach (@classes) { $classisdef{$_}=1;}
150	lange	2
151	lazyboy-guest	4402	if ($aptpkg_avail==1) {
152			$_config->init; # initialize AptPkg
153			$_config->set("Dir",$FAI_ROOT); # simulate "chroot"
154			$_config->{quiet}=2; # don't show cache initialization messages
155			$_system = $_config->system;
156			$cache = new AptPkg::Cache;
157			}
158	lange	2348
159	lange	311	# read all package config files
160	lange	335	foreach (@classes) {
161	lange	106	my $filename = "$classpath/$_";
162	lange	2	&readconfig($filename) if -f $filename;
163			}
164
165	lange	1278	# get files which must exist before installing packages
166	lange	1139	foreach my $entry (@preloadlist,@preloadrmlist) {
167	lange	2	my ($url, $directory) = @$entry;
168	lange	918	if ($url =~ m!^file:/(.+)!) {
169			my $file = $1;
170	lange	2483	execute("cp $FAI_ROOT/$file $FAI_ROOT/$directory") unless $listonly;
171	lange	918	} else {
172	lange	2483	execute("wget -nv -P$FAI_ROOT/$directory $url") unless $listonly;
173	lange	919	}
174	lange	2	}
175
176	lange	753	# call apt-get or tasksel for each type of command whith the list of packages
177	lange	2491	foreach $atype (@commands) {
178	lange	3321
179	lange	2491	if ($atype eq "clean") {
180	lange	2499	execute("$rootcmd $command{clean}") unless $listonly;
181	lange	1744	next;
182			}
183
184	lange	1145	# skip if empty list
185	lange	2491	next unless defined $list{$atype};
186	lange	1145
187	lange	2491	if ($atype eq "dselect-upgrade") {
188			dselectupgrade($atype);
189	lange	513	next;
190			}
191
192	lange	2491	my $packlist = join(' ',@{$list{$atype}});
193	lange	920
194	lange	4073	if ($atype =~ /rpm\|yum\|y2/) {
195	lange	3347	$command{clean} = "true"; # do not cal apt-get lcean for rpm and yum packages
196	lange	4073	execute("$rootcmd $command{$atype} $packlist") if $packlist;
197	lange	3338	next;
198			}
199
200	lange	2491	if ($atype eq "hold") {
201	lange	1139	my $hold = join " hold\n", @{$list{hold}};
202	lange	913	$hold .= " hold\n";
203			execute("echo \"$hold\" \| $rootcmd $command{hold}");
204			next;
205			}
206	lange	902
207	lange	3283	if ($atype eq "install" \|\| $atype eq "aptitude" \|\| $atype eq "unpack" \|\| $opt_l \|\| $opt_L) {
208	lange	2348
209	lange	2491	mkpackagelist(@{$list{$atype}}); # create lists of known and unknown packages
210	lange	1333	if ($opt_l) {
211			# only print the package list
212	lange	2348	print join ' ',@known,"\n";
213	lange	1333	exit 0;
214			}
215	lange	2351	if ($opt_L) {
216			# only print the package list
217	lange	2362	execute("$rootcmd $command{ninstall} @known \| egrep ^Inst");
218	lange	2351	exit 0;
219			}
220	lange	2010	# pass only maxpl packages to apt-get
221	lange	2348	while (@known) {
222			my $shortlist = join(' ', splice @known,0,$maxpl);
223	lange	2010	# print "SL $shortlist\n";
224	lange	2491	execute("$rootcmd $command{$atype} $shortlist") if $shortlist;
225	lange	3283	execute("$rootcmd $command{'clean'}"); # XXX do not execute always
226			execute("$rootcmd $command{'unpack-internal'}") if ($atype eq "unpack"); # unpack and rm deb files
227	lange	2010	}
228			next;
229	lange	2	}
230	lange	2444
231	lange	2491	if ($atype eq "taskinst" \|\| $atype eq "taskrm") {
232			foreach my $tsk (@{$list{$atype}}) {
233			execute("$rootcmd $command{$atype} $tsk");
234	lange	2444	}
235			next;
236			}
237
238			# other types
239	lange	2491	execute("$rootcmd $command{$atype} $packlist") if $packlist;
240	lange	2	}
241
242	lange	2666	# remove preloaded files
243	lange	1139	foreach my $entry (@preloadrmlist) {
244	lange	595	my ($url, $directory) = @$entry;
245			$url =~ m#/([^/]+$)#;
246			my $file = "$directory/$1";
247			print "rm $file\n" if $verbose;
248			unlink $file \|\| warn "Can't remove $file\n";
249			}
250
251	lazyboy-guest	4402	if ($aptpkg_avail==1) {
252			# in case of unconfigured packages because of apt errors
253			# retry configuration
254			execute("$rootcmd $command{pending}");
255			# check if all went right
256			execute("$rootcmd $command{dpkgc}");
257			# clean apt cache
258			execute("$rootcmd $command{clean}");
259			}
260	lange	2	# - - - - - - - - - - - - - - - - - - - - - - - - - - -
261			sub readconfig {
262
263			my $filename = shift;
264	lange	1402	my ($package,$type,$cllist,@oclasses,$doit);
265	lange	2
266			open (FILE,"$filename") \|\| warn "ERROR $0: Can't read config file: $filename\n";
267	lange	1333	warn "$0: read config file $filename\n" if $verbose;
268	lange	2
269			while (<FILE>) {
270	lange	311	next if /^#/; # skip comments
271	lange	414	s/#.*$//; # delete comments
272	lange	311	next if /^\s*$/; # skip empty lines
273	lange	2	chomp;
274	lange	1402	/^PRELOAD\s+(\S+)\s+(\S+)/ and push(@preloadlist, [$1,$2]),next;
275			/^PRELOADRM\s+(\S+)\s+(\S+)/ and push(@preloadrmlist, [$1,$2]),next;
276
277			if (/^PACKAGES\s+(\S+)\s*/) {
278			($type,$cllist) = ($1,$');
279	lange	3155	warn "WARNING: Unknow action $type after PACKAGES\n." unless defined $command{$type};
280	lange	1402	# by default no classes are listed after this command so doit
281			$doit = 1;
282	lange	2598	if ($cllist) {
283	lange	1402	# no classes specified after PACKAGES command
284	lange	3155	# so add all packages listed
285	lange	1402	# use packages on for a list of classes
286			$doit = 0; # assume no class is defined
287			@oclasses = split(/\s+/,$cllist);
288			# if a listed class is defined, add the packaes, otherwise skip these packages
289			foreach (@oclasses) { exists $classisdef{$_} and $doit = 1;}
290			}
291			next;
292			}
293
294	lange	3155	# warning if uppercase letters are found (package are always lowercase)
295			warn "WARNING: Uppercase character found in package name in line $_\n" if $_ =~ /[A-Z]/;
296			warn "ERROR: PACKAGES .. line missing in $filename\n",next unless $type;
297	lange	1402	push @{$list{$type}}, split if $doit;
298	lange	2	}
299			}
300	lange	106	# - - - - - - - - - - - - - - - - - - - - - - - - - - -
301			sub execute {
302
303	lange	311	# execute a command or only print it
304	lange	2232	my @cmds = @_;
305	lange	2351
306			# TODO: split cmds into array except when a pipe is found
307
308	lange	2232	my $command = join (' ',@cmds);
309	lange	106	my $error;
310
311	lange	1402	$test and $verbose = 1;
312	lange	2482	$verbose and warn "$0: executing $command\n";
313	lange	1402	$test and return;
314	lange	513
315	lange	2232	# @cmds should me more efficient
316			$error = system @cmds;
317	lange	534	warn "ERROR: $error $?\n" if $error;
318	lange	513	}
319			# - - - - - - - - - - - - - - - - - - - - - - - - - - -
320			sub dselectupgrade {
321	lange	1402
322	lange	1139	my $type = shift;
323	lange	513	my ($package,$action,$list);
324	lange	1402	my $tempfile = "$FAI_ROOT/tmp/dpkg-selections.tmp"; # TODO: use better uniq filename
325	lange	513	while (@{$list{$type}}) {
326			$package = shift @{$list{$type}};
327	lange	1402	$action = shift @{$list{$type}};
328	lange	513	$list .= "$package $action\n";
329	lange	106	}
330	lange	513
331	lange	1281	open TMP,"> $tempfile" \|\| die " Can't write to $tempfile";
332	lange	513	print TMP $list;
333			close TMP;
334
335	lange	614	execute("$rootcmd dpkg --set-selections < $tempfile");
336	lange	753	execute("$rootcmd $command{$type}");
337	lange	534	unlink $tempfile;
338	lange	106	}
339	lange	1402	# - - - - - - - - - - - - - - - - - - - - - - - - - - -
340	lange	2666	sub installable {
341			# ckeck, wether package can be installed.
342			# return false for packages which only exist in
343			# dpkg status files
344
345			my $package = shift;
346			# print "Checking wether $package is installable...\n";
347
348			# version list of package
349			my $vlist = $cache->{$package}{VersionList};
350
351			# for each version
352			foreach my $version (@$vlist) {
353			# list of package files
354			my $flist = $version->{FileList};
355			foreach my $fitem (@$flist) {
356			# if the file is a package index (not a dpkg status file)
357			# the package is installable
358			return 1 if ($fitem->{File}{IndexType} eq "Debian Package Index");
359			}
360			}
361
362			# no package index file found for the current package
363			return 0;
364			}
365			# - - - - - - - - - - - - - - - - - - - - - - - - - - -
366	lange	2348	sub mkpackagelist {
367
368	lange	2666	my @complete = @_; # copy original list
369			my @orig = ();
370	lange	2491	@unknown = @known = ();
371	lange	2666	my %complete = ();
372	lange	2491
373	lange	2348	# create two list of packages
374	lange	2666	# @unknown contains the unknown packages
375			# @known contains the known packages
376	lange	2493
377	lange	3034	# ignore packages ending with - when using -d
378			@complete = grep {!/-$/} @complete if $opt_d;
379
380	lange	3170	foreach (reverse @complete) {
381			my $pack = $_;
382	lazyboy-guest	4402	if ($aptpkg_avail==1) {
383			if ( /^(.+)[_=+-]$/ and $1 and $cache->exists($1)) {
384			$pack = $1;
385			}
386	lange	2666	}
387			if (! defined ($complete{$pack})) {
388			$complete{$pack} = 1;
389			unshift @orig, $_;
390			}
391			}
392
393	lange	2493	# currently we disable the complete checking of package names if aptitude
394			# is used. This is because we can't check task names, which are supported by aptitude
395			if ($atype eq "aptitude") {
396			@known=@orig;
397			return;
398			}
399
400	lange	2491	foreach my $pack (@orig) {
401	lange	2348
402	lange	2493	# if ($atype eq "aptitude" && $pack =~ /^~/) {
403			# # add to known if is it an aptitude search pattern
404			# push @known, $pack;
405			# next;
406			# }
407	lange	2491	# TODO: aptitude also can install tasks. How do we check them? Currently they will push to @unknown
408
409	lange	2348	if ($cache->exists($pack)) { # simple package name
410			# check for packages with no installation candidates
411			# explicitely don't check if the name is provided by some other package:
412			# apt-get install <virtual> fails with newer apt
413
414	lange	2666	if (installable($pack)) {
415	lange	2348	push @known, $pack;
416			} else {
417			push @unknown, $pack;
418			}
419
420			}
421
422	lange	2491	# simulate APTs and aptitudes understanding of "special" package names
423	lange	2348	# suffixed by -, +
424	lange	3170	elsif ( $pack =~ /^(.+)[_=+-]$/ and $cache->exists($1)) {
425	lange	2348
426			if (defined ($cache->{$1}{VersionList})) {
427	lange	2360	push @known, $pack;
428	lange	2348	} else {
429	lange	2360	push @unknown, $pack;
430	lange	2348	}
431
432			} else {
433			push @unknown, $pack;
434			}
435			}
436			warn "WARNING: These unknown packages are removed from the installation list: " . join(' ',sort @unknown) . "\n" if @unknown;
437			}
438			# - - - - - - - - - - - - - - - - - - - - - - - - - - -
439	lange	1402	sub usage {
440
441			print << "EOF";
442			install_packages $version
443
444	lange	2310	Please read the manual pages install_packages(8).
445	lange	1402	EOF
446			exit 0;
447			}
448			# - - - - - - - - - - - - - - - - - - - - - - - - - - -
449	lange	2628	sub setdownloadonly {
450
451			# Definitions for install_packages(8) for download only mode
452			# Used by fai-mirror(1)
453
454			# we are using a variable from %ENV
455			# for debugging remove >/dev/null and -q
456
457			undef @commands;
458			undef %command;
459
460			$maxpl=9999;
461	lange	3283	@commands = qw/taskinst aptitude aptitude-r install unpack/;
462	lange	2628	%command = (
463	lange	3163	install => "apt-get $qopt -d $ENV{aptoptions} -y --fix-missing install",
464	lange	2860	"taskinst" => "aptitude -d $ENV{aptoptions} -y install $devnull",
465	lange	3121	"aptitude" => "aptitude -R -d $ENV{aptoptions} -y install $devnull",
466			"aptitude-r" => "aptitude -r -d $ENV{aptoptions} -y install $devnull",
467	lange	3283	"unpack" => "cd $downloaddir; aptitude download",
468	lange	2628	"clean" => 'true',
469			"pending" => 'true',
470			"dpkgc" => 'true',
471			);
472
473			}
474			# - - - - - - - - - - - - - - - - - - - - - - - - - - -
Name	Value
svn:eol-style	native
svn:executable	*
svn:keywords	Author Date Id Revision