*** empty log message ***

6 files changed, 180 insertions, 33 deletions

diff --git a/perl-install/c/stuff.xs.pm b/perl-install/c/stuff.xs.pm
index 831b0c1c1..092b136d3 100644
--- a/perl-install/c/stuff.xs.pm
+++ b/perl-install/c/stuff.xs.pm
@@ -345,6 +345,31 @@ rpmtransAddPackage(rpmdep, header, key, update)
   RETVAL
 
 int
+rpmtransRemovePackages(db, rpmdep, p)
+  void *db
+  void *rpmdep
+  char *p
+  CODE:
+  rpmdb d = db;
+  rpmTransactionSet r = rpmdep;
+  dbiIndexSet matches;
+  int i;
+  int count = 0;
+  if (!rpmdbFindByLabel(d, p, &matches)) {
+    for (i = 0; i < dbiIndexSetCount(matches); ++i) {
+      unsigned int recOffset = dbiIndexRecordOffset(matches, i);
+      if (recOffset) {
+        rpmtransRemovePackage(rpmdep, recOffset);
+        ++count;
+      }
+    }
+    RETVAL=count;
+  } else
+    RETVAL=0;
+  OUTPUT:
+  RETVAL
+
+int
 rpmdepOrder(order)
   void *order
   CODE:
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 652cadfd9..3b9330cb5 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -139,6 +139,7 @@ $o = $::o = {
     authentication => { md5 => 1, shadow => 1 },
     lang         => 'en',
     isUpgrade    => 0,
+    toRemove     => [],
 #-    simple_themes => 1,
 #-    installClass => "normal",
 
@@ -350,6 +351,7 @@ sub doInstallStep {
     $o->afterInstallPackages;
 
     #- make icons for KDE.
+    log::l("updating kde icons according to available devices");
     install_any::kdeicons_postinstall($o->{prefix});
 }
 #------------------------------------------------------------------------------
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index f8d07560e..ef15b58e3 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -153,7 +153,7 @@ sub selectPackagesToUpgrade($) {
     my ($o) = @_;
 
     require pkgs;
-    pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base});
+    pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove});
 }
 
 sub addToBeDone(&$) {
@@ -507,16 +507,24 @@ sub install_urpmi {
     }
 }
 
-sub list_home($) {
-    my ($prefix) = @_;
-    local *F; open F, "$prefix/etc/passwd";
-    map { $_->[5] } grep { $_->[2] > 501 } map { [ split ':' ] } <F>;
+sub list_passwd() {
+    my ($e, @l);
+
+    setpwent();
+    while (@{$e = [ getpwent() ]}) { push @l, $e }
+    endpwent();
+
+    @l;
+}
+
+sub list_home() {
+    map { $_->[7] } grep { $_->[2] >= 501 } list_passwd();
 }
 
 sub template2userfile($$$$%) {
     my ($prefix, $inputfile, $outputrelfile, $force, %toreplace) = @_;
 
-    foreach ("/etc/skel", "/root", list_home($prefix)) {
+    foreach ("/etc/skel", "/root", list_home()) {
 	my $outputfile = "$prefix/$_/$outputrelfile";
 	if (-d dirname($outputfile) && ($force || ! -e $outputfile)) {
 	    log::l("generating $outputfile from template $inputfile");
@@ -528,7 +536,7 @@ sub template2userfile($$$$%) {
 sub kderc_largedisplay($) {
     my ($prefix) = @_;
 
-    foreach ("/etc/skel", "/root", list_home($prefix)) {
+    foreach ("/etc/skel", "/root", list_home()) {
 	my ($inputfile, $outputfile) = ("$prefix$_/.kderc", "$prefix$_/.kderc.new");
 	my %subst = ( contrast => "Contrast=7\n",
 		      kfmiconstyle => "kfmIconStyle=Large\n",
@@ -561,20 +569,19 @@ sub kdeicons_postinstall($) {
     my ($prefix) = @_;
 
     #- parse etc/fstab file to search for dos/win, zip, cdroms icons.
-    #- avoid rewriting existing file.
     local *F;
     open F, "$prefix/etc/fstab" or log::l("failed to read $prefix/etc/fstab"), return;
 
     foreach (<F>) {
 	if (/^\/dev\/(\S+)\s+\/mnt\/cdrom (\d*)\s+/x) {
 	    my %toreplace = ( device => $1, id => $2 );
-	    template2userfile($prefix, "/usr/share/cdrom.kdelnk.in", "Desktop/cdrom$2.kdelnk", 0, %toreplace);
+	    template2userfile($prefix, "/usr/share/cdrom.kdelnk.in", "Desktop/cdrom$2.kdelnk", 1, %toreplace);
 	} elsif (/^\/dev\/(\S+)\s+\/mnt\/zip (\d*)\s+/x) {
 	    my %toreplace = ( device => $1, id => $2 );
-	    template2userfile($prefix, "/usr/share/zip.kdelnk.in", "Desktop/zip$2.kdelnk", 0, %toreplace);
+	    template2userfile($prefix, "/usr/share/zip.kdelnk.in", "Desktop/zip$2.kdelnk", 1, %toreplace);
 	} elsif (/^\/dev\/(\S+)\s+\/mnt\/DOS_ (\S*)\s+/x) {
 	    my %toreplace = ( device => $1, id => $2 );
-	    template2userfile($prefix, "/usr/share/Dos_.kdelnk.in", "Desktop/Dos_$2.kdelnk", 0, %toreplace);
+	    template2userfile($prefix, "/usr/share/Dos_.kdelnk.in", "Desktop/Dos_$2.kdelnk", 1, %toreplace);
 	}
     }
 }
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index f3d5787e7..c1e1784e9 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -189,9 +189,39 @@ sub beforeInstallPackages {
     pkgs::init_db($o->{prefix}, $o->{isUpgrade});
 }
 
+sub beforeRemoveOtherPackages($) {
+    my ($prefix) = @_;
+
+    #- hack to save some files that may be removed during installation of other packages.
+    do {
+	unlink "$prefix/$_.mdkgisave"; rename "$prefix/$_", "$prefix/$_.mdkgisave";
+    } foreach qw(/etc/passwd);
+}
+
+sub afterRemoveOtherPackages($) {
+    my ($prefix) = @_;
+
+    #- hack to restore what have been saved before removing other packages.
+    do {
+	unlink "$prefix/$_"; rename "$prefix/$_.mdkgisave", "$prefix/$_";
+    } foreach qw(/etc/passwd);
+}
+
 sub installPackages($$) {
     my ($o, $packages) = @_;
 
+    if (@{$o->{toRemove} || []}) {
+	my @mdkgisave = qw( /etc/passwd );
+
+	#- hack to ensure proper upgrade of packages from other distribution,
+	#- as release number are not mandrake based. this causes save of very
+	#- important files (not all) and restore them after.
+	#- it is not enough to dop only that.
+	do { unlink "$o->{prefix}/$_.mdkgisave"; rename "$o->{prefix}/$_", "$o->{prefix}/$_.mdkgisave"; } foreach @mdkgisave;
+	pkgs::remove($o->{prefix}, $o->{toRemove});
+	do { unlink "$o->{prefix}/$_"; rename "$o->{prefix}/$_.mdkgisave", "$o->{prefix}/$_"; } foreach @mdkgisave;
+    }
+
     #- hack to ensure proper ordering for installation of packages.
     my @firstToInstall = qw(setup basesystem sed);
     my %firstInstalled;
@@ -204,7 +234,7 @@ sub installPackages($$) {
     }
     push @toInstall, grep { $_->{base} && $_->{selected} && !$_->{installed} && !$firstInstalled{$_->{name}} } values %$packages;
     push @toInstall, grep { !$_->{base} && $_->{selected} && !$_->{installed} && !$firstInstalled{$_->{name}} } values %$packages;
-    pkgs::install($o->{prefix}, \@toInstall);
+    pkgs::install($o->{prefix}, $o->{isUpgrade}, \@toInstall);
 }
 
 sub afterInstallPackages($) {
@@ -330,9 +360,7 @@ sub installCrypto {
 	    }
 	}
     }
-    foreach (values %$packages) {
-    }
-    pkgs::install($o->{prefix}, [ values %$packages ]);
+    pkgs::install($o->{prefix}, $o->{isUpgrade}, [ values %$packages ]);
 }
 
 #------------------------------------------------------------------------------
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
index 864cf5392..743d6389a 100644
--- a/perl-install/keyboard.pm
+++ b/perl-install/keyboard.pm
@@ -148,7 +148,7 @@ sub read($) {
     my ($prefix) = @_;
 
     my %keyf = getVarsFromSh("$prefix/etc/sysconfig/keyboard");
-    map { keyboard2kmap($_) eq $keyf{KEYTABLE} ? $_ : (); } keys %keyboards;
+    map { keyboard2kmap($_) eq $keyf{KEYTABLE} || $_ eq $keyf{KEYTABLE} ? $_ : (); } keys %keyboards;
 }
 
 #-######################################################################################
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 020ccf7c2..a9eef2b89 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -352,28 +352,57 @@ sub getHeader($) {
     $p->{header};
 }
 
-sub selectPackagesToUpgrade($$$) {
-    my ($packages, $prefix, $base) = @_;
+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) = @_;
 
     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')));
 			 if ($p) {
-			     eval { getHeader($p) }; $@ && log::l("cannot get the header for package $p->{name}"); #- not having a header will cause using a bad test for version, should change but a header should always be available.
-			     $p->{installed} = 1 if $p->{header} ? c::rpmVersionCompare($header, $p->{header}) >= 0 : c::headerGetEntry($header, 'version') ge $p->{version};
+			     if ($otherPackage && versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) <= 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 :
+				       (versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) > 0 ||
+					versionCompare(c::headerGetEntry($header, 'version'), $p->{version}) == 0 &&
+					versionCompare(c::headerGetEntry($header, 'release'), $p->{release} >= 0));
+			     }
 			 } else {
-			     my @installedFiles = c::headerGetEntry($header, 'filenames');
-			     @installedFilesForUpgrade{grep { $_ !~ m@^/etc/rc.d/@ } @installedFiles} = ();
+			     my @files = c::headerGetEntry($header, 'filenames');
+			     map { $installedFilesForUpgrade{$_} = $otherPackage } grep { $_ !~ m@^/etc/rc.d/@ } @files;
 			 }
 		     });
 
@@ -400,13 +429,18 @@ sub selectPackagesToUpgrade($$$) {
 	    #- 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')));
 				     $cumulSize += c::headerGetEntry($header, 'size'); #- all these will be deleted on upgrade.
-				     my @installedFiles = c::headerGetEntry($header, 'filenames');
-				     @installedFilesForUpgrade{ grep { $_ !~ m@^/etc/rc.d/@ } @installedFiles} = ();
+				     $toRemove{$otherPackage} = 1;
+				     my @files = c::headerGetEntry($header, 'filenames');
+				     map { $installedFilesForUpgrade{$_} = $otherPackage } grep { $_ !~ m@^/etc/rc.d/@ } @files;
 				 });
 	    eval { getHeader($p) };
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-	    map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 
 	    #- keep in mind the cumul size of installed package since they will be deleted
 	    #- on upgrade.
@@ -422,7 +456,7 @@ sub selectPackagesToUpgrade($$$) {
 	if ($p->{selected}) {
 	    eval { getHeader($p) };
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
-	    map { delete $installedFilesForUpgrade{$_} } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+	    map { $toRemove{delete $installedFilesForUpgrade{$_}} = 1 } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 	}
     }
 
@@ -435,7 +469,8 @@ sub selectPackagesToUpgrade($$$) {
 	    my @availFiles = $p->{header} ? c::headerGetEntry($p->{header}, 'filenames') : ();
 	    my $toSelect = 0;
 	    map { if (exists $installedFilesForUpgrade{$_}) {
-		$toSelect = 1; delete $installedFilesForUpgrade{$_} } } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
+		$toSelect = $toRemove{delete $installedFilesForUpgrade{$_}} = 1; }
+	      } grep { $_ !~ m@^/etc/rc.d/@ } @availFiles;
 	    pkgs::select($packages, $p) if ($toSelect);
 	}
     }
@@ -457,9 +492,15 @@ sub selectPackagesToUpgrade($$$) {
 	pkgs::select($packages, $p, 1) unless $p->{selected}; #- if installed it cannot be selected.
     }
 
+    #- clean false value on toRemove.
+    delete $toRemove{''};
+
     #- 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 {
@@ -468,16 +509,18 @@ sub installCallback {
     log::l($msg .": ". join(',', @_));
 }
 
-sub install($$) {
-    my ($prefix, $toInstall) = @_;
+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");
+    log::l("opened rpm database for installing new packages");
 
     my $trans = c::rpmtransCreateSet($db, $prefix);
 
@@ -489,7 +532,7 @@ sub install($$) {
 	                       $p->{name}, $p->{version}, $p->{release},
 			       c::headerGetEntry(getHeader($p), 'arch');
 	$packages{$p->{name}} = $p;
-	c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
+	c::rpmtransAddPackage($trans, getHeader($p), $p->{name}, $isUpgrade && $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
 	$nb++;
 	$total += $p->{size};
     }
@@ -512,8 +555,6 @@ sub install($$) {
     };
     my $callbackClose = sub { $packages{$_[0]}{installed} = 1; };
     my $callbackMessage = \&pkgs::installCallback;
-#-    my $callbackStart = sub { log::ld("starting installing package ", $_[0]) };
-#-    my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) };
 
     #- do not modify/translate the message used with installCallback since
     #- these are keys during progressing installation, or change in other
@@ -534,4 +575,48 @@ sub install($$) {
     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;