perl-install/steps.pm


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

package steps;

use strict;
use vars qw(%installSteps @orderedInstallSteps);
use common;

#-######################################################################################
#- Steps table
#-######################################################################################
{
    my @installStepsFields = qw(text redoable onError hidden needs); 
    #entered reachable toBeDone next done;
    my @installSteps = (
  selectLanguage     => [ N_("Language"), 1, 1, '', '' ],
  acceptLicense      => [ N_("License"), 1, -1, '', '' ],
  selectMouse        => [ N_("Configure mouse"), 1, 1, '1', '' ],
  setupSCSI          => [ N_("Hard drive detection"), 1, 0, '1', '' ],
  selectInstallClass => [ N_("Select installation class"), 1, 1, '1', '' ],
  selectKeyboard     => [ N_("Choose your keyboard"), 1, 1, '1' ],
  miscellaneous      => [ N_("Security"), 1, 1, '', '' ],
  doPartitionDisks   => [ N_("Partitioning"), 1, 0, '', "selectInstallClass" ],
  formatPartitions   => [ N_("Format partitions"), 1, -1, '1', "doPartitionDisks" ],
  choosePackages     => [ N_("Choose packages to install"), 1, -2, '1', "formatPartitions" ],
  installPackages    => [ N_("Install system"), 1, -1, '', ["formatPartitions", "selectInstallClass"] ],
  setRootPassword    => [ N_("Root password"), 1, 1, '', "installPackages" ],
  addUser            => [ N_("Add a user"), 1, 1, '', "installPackages" ],
  configureNetwork   => [ N_("Configure networking"), 1, 1, '1', "formatPartitions" ],
  setupBootloader    => [ N_("Install bootloader"), 1, 0, '', "installPackages" ],
  configureX         => [ N_("Configure X"), 1, 1, '1', ["formatPartitions", "setupBootloader"] ],
  summary            => [ N_("Summary"), 1, 0, '', "installPackages" ],
  configureServices  => [ N_("Configure services"), 1, 1, '1', "installPackages" ],
  installUpdates     => [ N_("Install updates"), 1, 1, '',  ["installPackages", "configureNetwork", "summary"] ],
  exitInstall        => [ N_("Exit install"), 0, 0, '', '' ],
);
    for (my $i = 0; $i < @installSteps; $i += 2) {
	my %h; @h{@installStepsFields} = @{ $installSteps[$i + 1] };
	$h{next}    = $installSteps[$i + 2];
	$h{entered} = 0;
	$h{onError} = $installSteps[$i + 2 * $h{onError}];
	$h{reachable} = !$h{needs};
	$installSteps{$installSteps[$i]} = \%h;
	push @orderedInstallSteps, $installSteps[$i];
    }
    $installSteps{first} = $installSteps[0];
}


1;
package pkgs;

use diagnostics;
use strict;
use vars qw(*LOG);

use common qw(:common :file :functional);
use install_any;
use log;
use pkgs;
use fs;
use lang;
use c;

my @skip_list = qw(
XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs kernel-BOOT
MySQL MySQL_GPL mod_php3 midgard postfix metroess metrotmpl
hackkernel hackkernel-BOOT hackkernel-fb hackkernel-headers
hackkernel-pcmcia-cs hackkernel-smp hackkernel-smp-fb 
autoirpm autoirpm-icons numlock
);

my %by_lang = (
  ar    => [ 'acon' ],
  ja    => [ 'rxvt-CLE', 'fonts-ttf-japanese' ],
  ko    => [ 'rxvt-CLE', 'fonts-ttf-korean' ],
  zh_CN => [ 'rxvt-CLE', 'fonts-ttf-gb2312' ],
  'zh_TW.Big5' => [ 'rxvt-CLE', 'fonts-ttf-big5' ],
);

my @prefered = qw(perl-GTK);

my $A = 20471;
my $B = 16258;
sub correctSize { ($A - $_[0]) * $_[0] / $B } #- size correction in MB.
sub invCorrectSize { $A / 2 - sqrt(max(0, sqr($A) - 4 * $B * $_[0])) / 2 }

sub Package {
    my ($packages, $name) = @_;
    $packages->{$name} or log::l("unknown package `$name'") && undef;
}

sub allpackages {
    my ($packages) = @_;
    my %skip_list; @skip_list{@skip_list} = ();
    grep { !exists $skip_list{$_->{name}} } values %$packages;
}

sub select($$;$) {
    my ($packages, $p, $base) = @_;
    my %prefered; @prefered{@prefered} = ();
    my ($n, $v);
    unless ($p->{installed}) { #- if the same or better version is installed, do not select.
	$p->{base} ||= $base;
	$p->{selected} = -1; #- selected by user
	my %l; @l{@{$p->{deps} || die "missing deps file"}} = ();
	while (do { my %l = %l; while (($n, $v) = each %l) { last if $v != 1; } $n }) {
	    $l{$n} = 1;
	    my $i = $packages->{$n};
	    if (!$i && $n =~ /\|/) {
		foreach (split '\|', $n) {
		    my $p = Package($packages, $_);
		    $i ||= $p;
		    $p && $p->{selected} and $i = $p, last;
		    $p && exists $prefered{$_} and $i = $p;
		}
	    }
	    $i->{base} ||= $base;
	    $i->{deps} or log::l("missing deps for $n");
	    unless ($i->{installed}) {
		unless ($i->{selected}) {
		    $l{$_} ||= 0 foreach @{$i->{deps} || []};
		}
		$i->{selected}++ unless $i->{selected} == -1;
	    }
	}
    }
    1;
}
sub unselect($$) {
    my ($packages, $p) = @_;
    $p->{base} and return;
    my $set = set_new($p->{name});
    my $l = $set->{list};

    #- get the list of provided packages
    foreach my $q (@$l) {
	my $i = Package($packages, $q);
	$i->{selected} && !$i->{base} or next;
	$i->{selected} = 1; #- that way, its counter will be zero the first time
	set_add($set, @{$i->{provides} || []});
    }
    while (@$l) {
	my $n = shift @$l;
	my $i = Package($packages, $n);

	$i->{selected} <= 0 || $i->{base} and next;
	if (--$i->{selected} == 0) {
	    push @$l, @{$i->{deps} || []};
	}
    }
    1;
}
sub toggle($$) {
    my ($packages, $p) = @_;
    $p->{selected} ? unselect($packages, $p) : &select($packages, $p);
}
sub set($$$) {
    my ($packages, $p, $val) = @_;
    $val ? &select($packages, $p) : unselect($packages, $p);
}

sub unselect_all($) {
    my ($packages) = @_;
    $_->{selected} = $_->{base} foreach values %$packages;
}

sub psUsingDirectory(;$) {
    my $dirname = $_[0] || "/tmp/rhimage/Mandrake/RPMS";
    my %packages;

    log::l("scanning $dirname for packages");
    foreach (all("$dirname")) {
	my ($name, $version, $release) = /(.*)-([^-]+)-([^-]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next;

	$packages{$name} = {
            name => $name, version => $version, release => $release,
	    file => $_, selected => 0, deps => [],
        };
    }
    \%packages;
}

sub psUsingHdlist() {
    my $f = install_any::getFile('hdlist') or die "no hdlist found";
    my %packages;

#-    my ($noSeek, $end) = 0;
#-    $end = sysseek F, 0, 2 or die "seek failed";
#-    sysseek F, 0, 0 or die "seek failed";

    while (my $header = c::headerRead(fileno $f, 1)) {
#-	 or die "error reading header at offset ", sysseek(F, 0, 1);
	my $name = c::headerGetEntry($header, 'name');

	$packages{$name} = {
             name => $name, header => $header, selected => 0, deps => [],
	     version   => c::headerGetEntry($header, 'version'),
	     release   => c::headerGetEntry($header, 'release'),
	     size      => c::headerGetEntry($header, 'size'),
        };
    }
    log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");

    \%packages;
}

sub chop_version($) {
    first($_[0] =~ /(.*)-[^-]+-[^-]+/) || $_[0];
}

sub getDeps($) {
    my ($packages) = @_;

    my $f = install_any::getFile("depslist") or die "can't find dependencies list";
    foreach (<$f>) {
	my ($name, $size, @deps) = split;
	($name, @deps) = map { join '|', map { chop_version($_) } split '\|' } ($name, @deps);
	$packages->{$name} or next;
	$packages->{$name}{size} = $size;
	$packages->{$name}{deps} = \@deps;
	map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
    }
}

sub category2packages($) {
    my ($p) = @_;
    $p->{packages} || [ map { @{ category2packages($_) } } values %{$p->{childs}} ];
}

sub readCompss($) {
    my ($packages) = @_;
    my ($compss, $compss_, $ps) = { childs => {} };

    my $f = install_any::getFile("compss") or die "can't find compss";
    foreach (<$f>) {
	/^\s*$/ || /^#/ and next;
	s/#.*//;

	if (/^(\S+)/) {
	    my $p = $compss;
	    my @l = split ':', $1;
	    pop @l if $l[-1] =~ /^(x11|console)$/;
	    foreach (@l) {
		$p->{childs}{$_} ||= { childs => {} };
		$p = $p->{childs}{$_};
	    }
	    $ps = $p->{packages} ||= [];
	    $compss_->{$1} = $p;
	} else {
	    /(\S+)/ or log::l("bad line in compss: $_"), next;
	    push @$ps, $packages->{$1} || do { log::l("unknown package $1 (in compss)"); next };
	}
    }
    ($compss, $compss_);
}

sub readCompssList($$$) {
    my ($packages, $compss_) = @_;
    my $f = install_any::getFile("compssList") or die "can't find compssList";
    local $_ = <$f>;
    my $level = [ split ];

    my $e;
    foreach (<$f>) {
	/^\s*$/ || /^#/ and next;

	/^packages\s*$/ and do { $e = $packages; next };
	/^categories\s*$/ and do { $e = $compss_; next };

	my ($name, @values) = split;

	$e or log::l("neither packages nor categories");
	my $p = $e->{$name} or log::l("unknown entry $name (in compssList)"), next;
	$p->{values} = \@values;
    }
    foreach (split ':', $ENV{LANGUAGE}) {
	my $locales = "locales-" . substr($_, 0, 2);
	my $p = $packages->{$locales} or next;
	foreach ($locales, @{$p->{provides} || []}, @{$by_lang{$_} || []}) {
	    my $p = $packages->{$_} or next;
	    $p->{values} = [ map { $_ + 70 } @{$p->{values}} ];
	}
    }
    $level;
}

sub readCompssUsers {
    my ($packages, $compss) = @_;
    my (%compssUsers, @sorted, $l);

    my $f = install_any::getFile("compssUsers") or die "can't find compssUsers";
    foreach (<$f>) {
	/^\s*$/ || /^#/ and next;
	s/#.*//;

	if (/^(\S.*)/) {
	    push @sorted, $1;
	    $compssUsers{$1} = $l = [];
	} elsif (/\s+\+(.*)/) {
	    push @$l, $packages->{$1} || do { log::l("unknown package $1 (in compssUsers)"); next };
	} elsif (/\s+(.*)/) {
	    my $p = $compss;
	    $p &&= $p->{childs}{$_} foreach split ':', $1;
	    $p or log::l("unknown category $1 (in compssUsers)"), next;
	    push @$l, @{ category2packages($p) };
	}
    }
    \%compssUsers, \@sorted;
}

#- sub isLangSensitive($$) {
#-     my ($name, $lang) = @_;
#-     local $SIG{__DIE__} = 'none';
#-     $name =~ /-([^-]*)$/ or return;
#-     $1 eq $lang || eval { lang::text2lang($1) eq $lang } && !$@;
#- }

sub setSelectedFromCompssList {
    my ($compssListLevels, $packages, $min_level, $max_size, $install_class, $isUpgrade) = @_;
    my ($ind);

    my @packages = allpackages($packages);
    my @places = do {
	map_index { $ind = $::i if $_ eq $install_class } @$compssListLevels;
	defined $ind or log::l("unknown install class $install_class in compssList"), return;

	my @values = map { $_->{values}[$ind] } @packages;
	sort { $values[$b] <=> $values[$a] } 0 .. $#packages;
    };
    foreach (@places) {
	my $p = $packages[$_];
	last if $p->{values}[$ind] < $min_level;

	&select($packages, $p) unless $isUpgrade;

	my $nb = 0; foreach (@packages) {
	    $nb += $_->{size} if $_->{selected};
	}
	if ($nb > $max_size) {
	    unselect($packages, $p) unless $isUpgrade;
	    $min_level = $p->{values}[$ind];
	    last;
	}
    }
    $ind, $min_level;
}

sub init_db {
    my ($prefix, $isUpgrade) = @_;

    my $f = "$prefix/root/install.log";
    open(LOG, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept.");
    *LOG or *LOG = log::F() or *LOG = *STDERR;
    CORE::select((CORE::select(LOG), $| = 1)[0]);
    c::rpmErrorSetCallback(fileno LOG);
#-    c::rpmSetVeryVerbose();

    log::l("reading /usr/lib/rpm/rpmrc");
    c::rpmReadConfigFiles() or die "can't read rpm config files";
    log::l("\tdone");

    if ($isUpgrade) {
	c::rpmdbRebuild($prefix) or die "rebuilding of rpm database failed: ", c::rpmErrorString();
    }

    c::rpmdbInit($prefix, 0644) or die "creation of rpm database failed: ", c::rpmErrorString();
#-    $isUpgrade ? c::rpmdbRebuild($prefix) : c::rpmdbInit($prefix, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString();
}

sub done_db {
    log::l("closing install.log file");
    close LOG;
}

sub getHeader($) {
    my ($p) = @_;

    unless ($p->{header}) {
	my $f = install_any::getFile($p->{file}) or die "error opening package $p->{name} (file $p->{file})";
	$p->{header} = c::rpmReadPackageHeader(fileno $f) or die "bad package $p->{name}";
    }
    $p->{header};
}

sub versionCompare($$) {
    my ($a, $b) = @_;
    local $_;

    while ($a && $b) {
	my ($sb, $sa) =  map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a);
	$_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_;
    }
}

sub selectPackagesToUpgrade($$$;$$) {
    my ($packages, $prefix, $base, $toRemove, $toSave) = @_;

    log::l("reading /usr/lib/rpm/rpmrc");
    c::rpmReadConfigFiles() or die "can't read rpm config files";
    log::l("\tdone");

    my $db = c::rpmdbOpenForTraversal($prefix) or die "unable to open $prefix/var/lib/rpm/packages.rpm";
    log::l("opened rpm database for examining existing packages");

    local $_; #- else perl complains on the map { ... } grep { ... } @...;
    my %installedFilesForUpgrade; #- help searching package to upgrade in regard to already installed files.

    #- help removing package which may have different release numbering
    my %toRemove; map { $toRemove{$_} = 1 } @{$toRemove || []};

    #- mark all files which are not in /etc/rc.d/ for packages which are already installed but which
    #- are not in the packages list to upgrade.
    #- the 'installed' property will make a package unable to be selected, look at select.
    c::rpmdbTraverse($db, sub {
			 my ($header) = @_;
			 my $p = $packages->{c::headerGetEntry($header, 'name')};
#			 my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
#					     (c::headerGetEntry($header, 'name'). '-' .
#					      c::headerGetEntry($header, 'version'). '-' .
#					      c::headerGetEntry($header, 'release')));
			 my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
					     c::headerGetEntry($header, 'version'). '-' .
					     c::headerGetEntry($header, 'release'));
			 if ($p) {
			     my $version_cmp = versionCompare(c::headerGetEntry($header, 'version'), $p->{version});
			     if ($otherPackage !~ /mdk\w*$/ && $version_cmp <= 0) {
				 $toRemove{$otherPackage} = 1;
			     } else {
				 eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}");
				 $p->{installed} = 1 if $p->{header} ?
				   c::rpmVersionCompare($header, $p->{header}) >= 0 :
				       ($version_cmp > 0 ||
					$version_cmp == 0 &&
					versionCompare(c::headerGetEntry($header, 'release'), $p->{release} >= 0));
			     }
			 } else {
			     my @files = c::headerGetEntry($header, 'filenames');
			     map { $installedFilesForUpgrade{$_} = $otherPackage }
			       grep { $_ !~ m@^/etc/rc.d/@ && ! -d "$prefix/$_" } @files;
			 }
		     });

    #- find new packages to upgrade.
    foreach (values %$packages) {
	my $p = $_;
	my $skipThis = 0;
	my $count = c::rpmdbNameTraverse($db, $p->{name}, sub {
					     my ($header) = @_;
					     $skipThis ||= $p->{installed};
					 });

	#- skip if not installed (package not found in current install).
	$skipThis ||= ($count == 0);

	#- select the package if it is already installed with a lower version or simply not installed.
	unless ($skipThis) {
	    my $cumulSize;

	    pkgs::select($packages, $p) unless $p->{selected};

	    #- keep in mind installed files which are not being updated. doing this costs in
	    #- execution time but use less memory, else hash all installed files and unhash
	    #- all file for package marked for upgrade.
	    c::rpmdbNameTraverse($db, $p->{name}, sub {
				     my ($header) = @_;
#				     my $otherPackage = (c::headerGetEntry($header, 'release') !~ /mdk\w*$/ &&
#							 (c::headerGetEntry($header, 'name'). '-' .
#							  c::headerGetEntry($header, 'version'). '-' .
#							  c::headerGetEntry($header, 'release')));
				     my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
							 c::headerGetEntry($header, 'version'). '-' .
							 c::headerGetEntry($header, 'release'));
				     $cumulSize += c::headerGetEntry($header, 'size'); #- all these will be deleted on upgrade.
				     $toRemove{$otherPackage} = 1;
				     my @files = c::headerGetEntry($header, 'filenames');
				     map { $installedFilesForUpgrade{$_} = $otherPackage }
				       grep { $_ !~ m@^/etc/rc.d/@ && ! -d "$prefix/$_" } @files;
				 });
	    eval { getHeader($p) };
	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 }
	      grep { $_ !~ m@^/etc/rc.d/@ && ! -d "$prefix/$_" } @availFiles;

	    #- keep in mind the cumul size of installed package since they will be deleted
	    #- on upgrade.
	    $p->{installedCumulSize} = $cumulSize;
	}
    }

    #- unmark all files for all packages marked for upgrade. it may not have been done above
    #- since some packages may have been selected by depsList.
    foreach (values %$packages) {
	my $p = $_;

	if ($p->{selected}) {
	    eval { getHeader($p) };
	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 }
	      grep { $_ !~ m@^/etc/rc.d/@ && ! -d "$prefix/$_" } @availFiles;
	}
    }

    #- select packages which contains marked files, then unmark on selection.
    foreach (values %$packages) {
	my $p = $_;

	unless ($p->{selected}) {
	    eval { getHeader($p) };
	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
	    my $toSelect = 0;
	    map { if (exists $installedFilesForUpgrade{$_}) {
		$toSelect = $toRemove{delete $installedFilesForUpgrade{$_}} = 1; }
	      } grep { $_ !~ m@^/etc/rc.d/@ && ! -d "$prefix/$_" } @availFiles;
	    pkgs::select($packages, $p) if ($toSelect);
	}
    }

    #- select packages which obseletes other package, obselete package are not removed,
    #- should we remove them ? this could be dangerous !
    foreach (values %$packages) {
	my $p = $_;

	eval { getHeader($p) };
	my @obsoletes = $p->{header} ? c::headerGetEntry(getHeader($p), 'obsoletes'): ();
	map { pkgs::select($packages, $p) if c::rpmdbNameTraverse($db, $_) > 0 } @obsoletes;
    }

    #- select all base packages which are not installed and not selected.
    foreach (@$base) {
	my $p = $packages->{$_} or log::l("missing base package $_"), next;
	log::l("base package $_ is not installed") unless $p->{installed} || $p->{selected}; #- installed not set on upgrade.
	pkgs::select($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
    }

    #- clean false value on toRemove.
    delete $toRemove{''};

    #- get filenames that should be saved for packages to remove.
    #- typically config files, but it may broke for packages that
    #- are very old when compabilty has been broken.
    #- but new version may saved to .rpmnew so it not so hard !
    if ($toSave && keys %toRemove) {
	c::rpmdbTraverse($db, sub {
			     my ($header) = @_;
			     my $otherPackage = (c::headerGetEntry($header, 'name'). '-' .
						 c::headerGetEntry($header, 'version'). '-' .
						 c::headerGetEntry($header, 'release'));
			     if ($toRemove{$otherPackage}) {
				 my @files = c::headerGetEntry($header, 'filenames');
				 my @flags = c::headerGetEntry($header, 'fileflags');
				 for my $i (0..$#flags) {
				     if ($flags[$i] & c::RPMFILE_CONFIG()) {
					 push @$toSave, $files[$i];
				     }
				 }
			     }
			 });
    }

    log::l("before closing db");
    #- close db, job finished !
    c::rpmdbClose($db);
    log::l("done selecting packages to upgrade");

    #- update external copy with local one.
    @{$toRemove || []} = keys %toRemove;
}

sub installCallback {
    my $msg = shift;

    log::l($msg .": ". join(',', @_));
}

sub install($$$) {
    my ($prefix, $isUpgrade, $toInstall) = @_;
    my %packages;

    return if $::g_auto_install;

    log::l("reading /usr/lib/rpm/rpmrc");
    c::rpmReadConfigFiles() or die "can't read rpm config files";
    log::l("\tdone");

    my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
    log::l("opened rpm database for installing new packages");

    my $trans = c::rpmtransCreateSet($db, $prefix);

    my ($total, $nb);

    foreach my $p (@$toInstall) {
	eval { getHeader($p) }; $@ and next;
	$p->{file} ||= sprintf "%s-%s-%s.%s.rpm",
	                       $p->{name}, $p->{version}, $p->{release},
			       c::headerGetEntry(getHeader($p), 'arch');
	$packages{$p->{name}} = $p;
	c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $isUpgrade && $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
	$nb++;
	$total += $p->{size};
    }

    c::rpmdepOrder($trans) or
	cdie "error ordering package list: " . c::rpmErrorString(),
	  sub {
	      c::rpmdbClose($db);
	      c::rpmtransFree($trans);
	  };
    c::rpmtransSetScriptFd($trans, fileno LOG);

    eval { fs::mount("/proc", "$prefix/proc", "proc", 0) };

    my $callbackOpen = sub {
	my $f = (my $p = $packages{$_[0]})->{file};
	print LOG "$f\n";
	my $fd = install_any::getFile($f) or log::l("ERROR: bad file $f");
	$fd ? fileno $fd : -1;
    };
    my $callbackClose = sub { $packages{$_[0]}{installed} = 1; };
    my $callbackMessage = \&pkgs::installCallback;

    #- do not modify/translate the message used with installCallback since
    #- these are keys during progressing installation, or change in other
    #- place (install_steps_gtk.pm,...).
    &$callbackMessage("Starting installation", $nb, $total);

    if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
	my %parts;
	@probs = reverse grep {
	    if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
		$parts{$3} ? 0 : ($parts{$3} = 1);
	    } else { 1; }
	} reverse @probs;
	die "installation of rpms failed:\n  ", join("\n  ", @probs);
    }
    c::rpmtransFree($trans);
    c::rpmdbClose($db);
    log::l("rpm database closed");
}

sub remove($$) {
    my ($prefix, $toRemove) = @_;

    return if $::g_auto_install || !@{$toRemove || []};

    log::l("reading /usr/lib/rpm/rpmrc");
    c::rpmReadConfigFiles() or die "can't read rpm config files";
    log::l("\tdone");

    my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
    log::l("opened rpm database for removing old packages");

    my $trans = c::rpmtransCreateSet($db, $prefix);

    foreach my $p (@$toRemove) {
	#- stuff remove all packages that matches $p, not a problem since $p has name-version-release format.
	c::rpmtransRemovePackages($db, $trans, $p) if $p !~ /kernel/;
    }

    eval { fs::mount("/proc", "$prefix/proc", "proc", 0) };

    my $callbackOpen = sub { log::l("trying to open file from $_[0] which should not happen"); };
    my $callbackClose = sub { log::l("trying to close file from $_[0] which should not happen"); };
    my $callbackMessage = \&pkgs::installCallback;

    #- we are not checking depends since it should come when
    #- upgrading a system. although we may remove some functionalities ?

    #- do not modify/translate the message used with installCallback since
    #- these are keys during progressing installation, or change in other
    #- place (install_steps_gtk.pm,...).
    &$callbackMessage("Starting removing other packages", scalar @$toRemove);

    if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackMessage, 0)) {
	die "removing of old rpms failed:\n  ", join("\n  ", @probs);
    }
    c::rpmtransFree($trans);
    c::rpmdbClose($db);
    log::l("rpm database closed");

    #- keep in mind removing of these packages by cleaning $toRemove.
    @{$toRemove || []} = ();
}

1;