summaryrefslogtreecommitdiffstats
path: root/perl-install/pkgs.pm
diff options
context:
space:
mode:
authorChmouel Boudjnah <chmouel@mandriva.org>1999-07-01 12:29:54 +0000
committerChmouel Boudjnah <chmouel@mandriva.org>1999-07-01 12:29:54 +0000
commite1729dfdb9c341fe0b9fed7d7b0a80691a547d82 (patch)
treeb72fd8f59af166fe944ebcf114d648ed5644f752 /perl-install/pkgs.pm
parentb50e655e352e2524fb3fb84b2bb4bc96e6a04cf0 (diff)
downloaddrakx-e1729dfdb9c341fe0b9fed7d7b0a80691a547d82.tar
drakx-e1729dfdb9c341fe0b9fed7d7b0a80691a547d82.tar.gz
drakx-e1729dfdb9c341fe0b9fed7d7b0a80691a547d82.tar.bz2
drakx-e1729dfdb9c341fe0b9fed7d7b0a80691a547d82.tar.xz
drakx-e1729dfdb9c341fe0b9fed7d7b0a80691a547d82.zip
"See_The_Changelog"
Diffstat (limited to 'perl-install/pkgs.pm')
-rw-r--r--perl-install/pkgs.pm211
1 files changed, 211 insertions, 0 deletions
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
new file mode 100644
index 000000000..1f4764d22
--- /dev/null
+++ b/perl-install/pkgs.pm
@@ -0,0 +1,211 @@
+package pkgs;
+
+use diagnostics;
+use strict;
+
+use common qw(:common :file);
+use log;
+use smp;
+use fs;
+
+my @skipList = 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
+ metroess metrotmpl);
+
+1;
+
+
+sub psUsingDirectory {
+ my ($dirname) = @_;
+ my %packages;
+
+ log::l("scanning $dirname for packages");
+ foreach (glob_("$dirname/*.rpm")) {
+ my $basename = basename($_);
+ local *F;
+ open F, $_ or log::l("failed to open package $_: $!");
+ my $header = c::rpmReadPackageHeader($_) or log::l("failed to rpmReadPackageHeader $basename: $!");
+ my $name = c::headerGetEntry($header, 'name');
+
+ $packages{lc $name} = {
+ header => $header, selected => 0, manuallySelected => 0, name => $name,
+ size => c::headerGetEntry($header, 'size'),
+ group => c::headerGetEntry($header, 'group') || "(unknown group)",
+ inmenu => skipPackage($name),
+ };
+ }
+ \%packages;
+}
+
+sub psReadComponentsFile {
+ my ($compsfile, $packages) = @_;
+ my (%comps, %current);
+
+ local *F;
+ open F, $compsfile or die "Cannot open components file: $!";
+
+ <F> =~ /^0(\.1)?$/ or die "Comps file is not version 0.1 as expected";
+
+ my $inComp = 0;
+ my $n = 0;
+ foreach (<F>) { $n++;
+ chomp;
+ s/^ +//;
+ /^#/ and next;
+ /^$/ and next;
+
+ if ($inComp) { if (/^end$/) {
+ $inComp = 0;
+ $comps{lc $current{name}} = { %current };
+ } else {
+ push @{$current{packages}}, $packages->{lc $_} || log::w "package $_ does not exist (line $n of comps file)";
+ }
+ } else {
+ my ($selected, $hidden, $name) = /^([01])\s*(--hide)?\s*(.*)/ or die "bad comps file at line $n";
+ %current = (selected => $selected, inmenu => !$hidden, name => $name);
+ $inComp = 1;
+ }
+ }
+ log::l("read " . (scalar keys %comps) . " comps");
+ \%comps;
+}
+
+
+
+sub psVerifyDependencies {
+# my ($packages, $fixup) = @_;
+#
+# -r "/mnt/var/lib/rpm/packages.rpm" or die "can't find packages.rpm";
+#
+# my $db = rpmdbOpenRWCreate("/mnt");
+# my $rpmdeps = rpmtransCreateSet($db, undef);
+#
+# foreach (values %$packages) {
+# $_->{selected} ?
+# c::rpmtransAddPackage($rpmdeps, $_->{header}, undef, $_, 0, undef) :
+# c::rpmtransAvailablePackage($rpmdeps, $_->{header}, $_);
+# }
+# my @conflicts = c::rpmdepCheck($rpmdeps);
+#
+# rpmtransFree($rpmdeps);
+# rpmdbClose($db);
+#
+# if ($fixup) {
+# foreach (@conflicts) {
+# $_->{suggestedPackage}->{selected} = 1;
+# }
+# rpmdepFreeConflicts(@conflicts);
+# }
+#
+# 1;
+}
+
+sub selectComponents {
+ my ($csp, $psp, $doIndividual) = @_;
+
+ return 0;
+}
+
+sub psFromHeaderListDesc {
+ my ($fd, $noSeek) = @_;
+ my %packages;
+ my $end;
+
+ unless ($noSeek) {
+ my $current = sysseek $fd, 0, 1 or die "seek failed";
+ $end = sysseek $fd, 0, 2 or die "seek failed";
+ sysseek $fd, $current, 0 or die "seek failed";
+ }
+
+ while (1) {
+ my $header = c::headerRead(fileno($fd), 1);
+ unless ($header) {
+ $noSeek and last;
+ die "error reading header at offset ", sysseek($fd, 0, 1);
+ }
+
+ my $name = c::headerGetEntry($header, 'name');
+
+ $packages{lc $name} = {
+ header => $header, size => c::headerGetEntry($header, 'size'),
+ inmenu => skipPackage($name), name => $name,
+ group => c::headerGetEntry($header, 'group') || "(unknown group)",
+ };
+
+ $noSeek or $end <= sysseek($fd, 0, 1) and last;
+ }
+
+ log::l("psFromHeaderListDesc read " . scalar keys(%packages) . " headers");
+
+ \%packages;
+}
+
+sub psFromHeaderListFile {
+ my ($file) = @_;
+ local *F;
+ sysopen F, $file, 0 or die "error opening header file: $!";
+ psFromHeaderListDesc(\*F, 0);
+}
+
+sub skipPackage { member($_[0], @skipList) }
+
+sub printSize { }
+sub printGroup { }
+sub printPkg { }
+sub selectPackagesByGroup { }
+sub showPackageInfo { }
+sub queryIndividual { }
+
+
+sub install {
+ my ($rootPath, $method, $packages, $isUpgrade, $force) = @_;
+
+ my $f = "$rootPath/tmp/" . ($isUpgrade ? "upgrade" : "install") . ".log";
+ local *F;
+ open(F, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No upgrade log will be kept.");
+ my $fd = fileno(F) || log::fd() || 2;
+ c::rpmErrorSetCallback($fd);
+# c::rpmSetVeryVerbose();
+
+ # FIXME: we ought to read /mnt/us/lib/rpmrc if we're in the midst of an upgrade, but it's not obvious how to get RPM to do that.
+ # if we set netshared path to "" then we get no files installed
+ # addMacro(&globalMacroContext, "_netsharedpath", NULL, netSharedPath ? netSharedPath : "" , RMIL_RPMRC);
+
+ $isUpgrade ? c::rpmdbRebuild($rootPath) : c::rpmdbInit($rootPath, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString();
+
+ my $db = c::rpmdbOpen($rootPath) or die "error opening RPM database: ", c::rpmErrorString();
+ log::l("opened rpm database");
+
+ my $trans = c::rpmtransCreateSet($db, $rootPath);
+
+ my ($total, $nb);
+
+ foreach my $p ($packages->{basesystem},
+ grep { $_->{selected} && $_->{name} ne "basesystem" } values %$packages) {
+ my $fullname = sprintf "%s-%s-%s.%s.rpm",
+ $p->{name},
+ map { c::headerGetEntry($p->{header}, $_) } qw(version release arch);
+ c::rpmtransAddPackage($trans, $p->{header}, $method->getFile($fullname) , $isUpgrade);
+ $nb++;
+ $total += $p->{size};
+ }
+
+ c::rpmdepOrder($trans) or c::rpmdbClose($db), c::rpmtransFree($trans), die "error ordering package list: ", c::rpmErrorString();
+ c::rpmtransSetScriptFd($trans, $fd);
+
+ eval { fs::mount("/proc", "$rootPath/proc", "proc", 0) };
+
+ log::ld("starting installation: ", $nb, " packages, ", $total, " bytes");
+
+ # !! do not translate these messages, they are used when catched (cf install_steps_graphical)
+ my $callbackStart = sub { log::ld("starting installing package ", $_[0]) };
+ my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) };
+
+ if (my @probs = c::rpmRunTransactions($trans, $callbackStart, $callbackProgress, $force)) {
+ die "installation of rpms failed:\n ", join("\n ", @probs);
+ }
+ c::rpmtransFree($trans);
+ c::rpmdbClose($db);
+ log::l("rpm database closed");
+}