summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>1999-12-07 18:14:34 +0000
committerFrancois Pons <fpons@mandriva.com>1999-12-07 18:14:34 +0000
commit8c45c7d481e611752c996d4f543cf3a9f25b165a (patch)
tree09bf1a7b75d06be04a723a419b5ce487adceef99 /perl-install
parent27e6b80900b2b3a724e95be3192faecc60954427 (diff)
downloaddrakx-8c45c7d481e611752c996d4f543cf3a9f25b165a.tar
drakx-8c45c7d481e611752c996d4f543cf3a9f25b165a.tar.gz
drakx-8c45c7d481e611752c996d4f543cf3a9f25b165a.tar.bz2
drakx-8c45c7d481e611752c996d4f543cf3a9f25b165a.tar.xz
drakx-8c45c7d481e611752c996d4f543cf3a9f25b165a.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/c/stuff.xs.pm25
-rw-r--r--perl-install/install2.pm2
-rw-r--r--perl-install/install_any.pm29
-rw-r--r--perl-install/install_steps.pm36
-rw-r--r--perl-install/keyboard.pm2
-rw-r--r--perl-install/pkgs.pm119
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;