diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/c/stuff.xs.pm | 25 | ||||
| -rw-r--r-- | perl-install/install2.pm | 2 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 29 | ||||
| -rw-r--r-- | perl-install/install_steps.pm | 36 | ||||
| -rw-r--r-- | perl-install/keyboard.pm | 2 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 119 |
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; |