summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--perl-install/Xconfig.pm55
-rw-r--r--perl-install/Xconfigurator.pm2
-rw-r--r--perl-install/Xconfigurator_consts.pm24
-rw-r--r--perl-install/install2.pm10
-rw-r--r--perl-install/install_any.pm16
-rw-r--r--perl-install/install_steps.pm5
-rw-r--r--perl-install/install_steps_interactive.pm7
-rw-r--r--perl-install/pkgs.pm78
8 files changed, 162 insertions, 35 deletions
diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm
index 9d01673b9..6158873df 100644
--- a/perl-install/Xconfig.pm
+++ b/perl-install/Xconfig.pm
@@ -1,7 +1,11 @@
package Xconfig;
+use diagnostics;
+use strict;
+
use common qw(:common :file :system);
use mouse;
+use Xconfigurator;
# otherwise uses the rule substr($keymap, 0, 2)
my %keymap_translate = (
@@ -31,44 +35,56 @@ sub getinfo {
sub getinfoFromXF86Config {
my $o = shift || {};
- my (%c, $depth);
+ my $prefix = shift || "";
+ my (%c, $depth, $driver);
- $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; #- /x for perl2fcalls
+ $o->{card}{server} ||= $1 if readlink("$prefix/etc/X11/X") =~ /XF86_ (\w+)$/x; #- /x for perl2fcalls
local *F;
- open F, "/etc/X11/XF86Config" or return {};
+ open F, "$prefix/etc/X11/XF86Config" or return {};
foreach (<F>) {
if (/^Section "Keyboard"/ .. /^EndSection/) {
+ $o->{keyboard}{altmeta} ||= ($1 eq "ModeShift" ? 1 : 0) if /^\s*RightAlt\s+"(.*?)"/;
$o->{keyboard}{xkb_keymap} ||= $1 if /^\s*XkbLayout\s+"(.*?)"/;
} elsif (/^Section "Pointer"/ .. /^EndSection/) {
$o->{mouse}{XMOUSETYPE} ||= $1 if /^\s*Protocol\s+"(.*?)"/;
$o->{mouse}{device} ||= $1 if m|^\s*Device\s+"/dev/(.*?)"|;
+ $o->{mouse}{XEMU3} ||= 1 if m/^\s*Emulate3Buttons\s+/;
+ $o->{mouse}{cleardtrrts} ||= 1 if m/^\s*ClearDTR\s+/;
+ $o->{mouse}{cleardtrrts} ||= 1 if m/^\s*ClearRTS\s+/;
} elsif (my $i = /^Section "Device"/ .. /^EndSection/) {
- if ($i = 1 && $c{type} && $c{type} ne "Generic VGA") {
- add2hash($o->{card} ||= {}, \%c);
- %c = ();
- }
+ %c = () if $i == 1;
+
$c{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
- $c{memory} ||= $1 if /^\s*VideoRam\s+(\d+)/;
+ $c{memory} ||= $1 if /VideoRam\s+(\d+)/;
+ $c{flags}{needVideoRam} ||= 1 if /^\s*VideoRam\s+/;
$c{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
$c{board} ||= $1 if /^\s*BoardName\s+"(.*?)"/;
+ #- clockchip, ramdac, dacspeed read with following line.
push @{$c{lines}}, $_ unless /(Section|Identifier|VideoRam|VendorName|BoardName)/;
+
+ add2hash($o->{card} ||= {}, \%c) if ($i =~ /E0/ && $c{type} && $c{type} ne "Generic VGA");
} elsif (/^Section "Monitor"/ .. /^EndSection/) {
$o->{monitor}{type} ||= $1 if /^\s*Identifier\s+"(.*?)"/;
$o->{monitor}{hsyncrange} ||= $1 if /^\s*HorizSync\s+(.*)/;
$o->{monitor}{vsyncrange} ||= $1 if /^\s*VertRefresh\s+(.*)/;
$o->{monitor}{vendor} ||= $1 if /^\s*VendorName\s+"(.*?)"/;
$o->{monitor}{model} ||= $1 if /^\s*ModelName\s+"(.*?)"/;
- } elsif (/^Section "Screen"/ .. /^EndSection/) {
- $o->{card}{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
- if (my $i = /^\s*Subsection\s+"Display"/ .. /^\s*EndSubsection/) {
- $depth = undef if $i == 1;
- $depth = $1 if /^\s*Depth\s+(\d*)/;
- if (/^\s*Modes\s+(.*)/) {
- my $a = 0;
- push @{$o->{card}{depth}{$depth || 8}},
- grep { $_->[0] >= 640 } map { [ /"(\d+)x(\d+)"/ ] } split ' ', $1;
+ } elsif (my $s = /^Section "Screen"/ .. /^EndSection/) {
+ $driver = undef if $s == 1;
+ $driver = $1 if /^\s*Driver\s+"(.*?)"/;
+ print "($driver eq $Xconfigurator::serversdriver{$o->{card}{server}})";
+ if ($driver eq $Xconfigurator::serversdriver{$o->{card}{server}}) { #- take into account the right screen section for the server.
+ $o->{card}{default_depth} ||= $1 if /^\s*DefaultColorDepth\s+(\d+)/;
+ if (my $i = /^\s*Subsection\s+"Display"/ .. /^\s*EndSubsection/) {
+ $depth = undef if $i == 1;
+ $depth = $1 if /^\s*Depth\s+(\d*)/;
+ if (/^\s*Modes\s+(.*)/) {
+ my $a = 0;
+ push @{$o->{card}{depth}{$depth || 8}},
+ grep { $_->[0] >= 640 } map { [ /"(\d+)x(\d+)"/ ] } split ' ', $1;
+ }
}
}
}
@@ -78,10 +94,11 @@ sub getinfoFromXF86Config {
sub getinfoFromSysconfig {
my $o = shift || {};
+ my $prefix = shift || "";
- add2hash($o->{mouse} ||= {}, { getVarsFromSh("/etc/sysconfig/mouse") });
+ add2hash($o->{mouse} ||= {}, { getVarsFromSh("$prefix/etc/sysconfig/mouse") });
- if (my %keyboard = getVarsFromSh "/etc/sysconfig/keyboard") {
+ if (my %keyboard = getVarsFromSh "$prefix/etc/sysconfig/keyboard") {
$keyboard{KEYTABLE} or last;
$o->{keyboard}{xkb_keymap} ||= keymap_translate($keyboard{KEYTABLE});
}
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 6068706d6..0627717ad 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -2,7 +2,7 @@ package Xconfigurator;
use diagnostics;
use strict;
-use vars qw($in $install $resolution_wanted @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions @svgaservers @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $intro_text $finalcomment_text $s3_comment $cirrus_comment $probeonlywarning_text $monitorintro_text $hsyncintro_text $vsyncintro_text $XF86firstchunk_text $keyboardsection_start $keyboardsection_part2 $keyboardsection_end $pointersection_text1 $pointersection_text2 $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text $devicesection_text $screensection_text1 %lines %xkb_options);
+use vars qw($in $install $resolution_wanted @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions %serversdriver @svgaservers @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $intro_text $finalcomment_text $s3_comment $cirrus_comment $probeonlywarning_text $monitorintro_text $hsyncintro_text $vsyncintro_text $XF86firstchunk_text $keyboardsection_start $keyboardsection_part2 $keyboardsection_end $pointersection_text1 $pointersection_text2 $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text $devicesection_text $screensection_text1 %lines %xkb_options);
use pci_probing::main;
use common qw(:common :file :functional);
diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm
index e4dcaac61..193eb84e6 100644
--- a/perl-install/Xconfigurator_consts.pm
+++ b/perl-install/Xconfigurator_consts.pm
@@ -12,9 +12,27 @@ use common qw(:common);
$resolution_wanted = "1024x768";
@resolutions = qw(640x480 800x600 1024x768 1152x864 1280x1024 1600x1200);
-@svgaservers = qw(SVGA Rage128);
-@accelservers = qw(S3 Mach32 Mach8 8514 P9000 AGX W32 Mach64 I128 S3V 3DLabs);
-@allservers = (qw(Mono VGA16), @svgaservers, @accelservers);
+%serversdriver = (
+ 'SVGA' => "svga",
+ 'Rage128' => "svga",
+ 'S3' => "accel",
+ 'Mach32' => "accel",
+ 'Mach8' => "accel",
+ '8514' => "accel",
+ 'P9000' => "accel",
+ 'AGX' => "accel",
+ 'W32' => "accel",
+ 'Mach64' => "accel",
+ 'I128' => "accel",
+ 'S3V' => "accel",
+ '3DLabs' => "accel",
+ 'Mono' => "vga2",
+ 'VGA16' => "vga16",
+ 'FBDev' => "fbdev",
+);
+@svgaservers = grep { $serversdriver{$_} eq "svga" } keys(%serversdriver);#-qw(SVGA Rage128);
+@accelservers = grep { $serversdriver{$_} eq "accel" } keys(%serversdriver);#-qw(S3 Mach32 Mach8 8514 P9000 AGX W32 Mach64 I128 S3V 3DLabs);
+@allservers = keys(%serversdrivers);#-(qw(Mono VGA16), @svgaservers, @accelservers);
{ #- @monitorSize2resolution
my %l = my @l = ( #- size in inch
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index 2cf475a53..fbf52a641 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -212,7 +212,7 @@ sub selectLanguage {
sub selectMouse {
my ($clicked) = $_[0];
- $o->{mouse} or $o->{mouse} = {};
+ $o->{mouse} ||= {};
add2hash($o->{mouse}, { mouse::read($o->{prefix}) }) if $o->{isUpgrade} && !$clicked;
$o->selectMouse($clicked);
@@ -327,9 +327,10 @@ sub selectInstallClass {
$o->{partitions} ||= $suggestedPartitions{$o->{installClass}};
$o->{partitioning}{auto_allocate} ||= -1 if $::beginner;
- $o->setPackages(\@install_classes)
- if $o->{steps}{choosePackages}{entered} >= 1 &&
- !$o->{steps}{doInstallStep}{done};
+ if ($o->{steps}{choosePackages}{entered} >= 1 && !$o->{steps}{doInstallStep}{done}) {
+ $o->setPackages(\@install_classes);
+ $o->findPackagesToUpgrade() if $o->{isUpgrade};
+ }
}
#------------------------------------------------------------------------------
@@ -403,6 +404,7 @@ sub formatPartitions {
#-PADTODO
sub choosePackages {
$o->setPackages($o, \@install_classes) if $_[1] == 1;
+ $o->findPackagesToUpgrade($o) if $o->{isUpgrade} && $_[1] == 1;
$o->choosePackages($o->{packages}, $o->{compss});
$o->{packages}{$_}{selected} = 1 foreach @{$o->{base}};
}
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index 834c58a73..4bb4e9bc4 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -124,15 +124,23 @@ sub setPackages($$) {
push @{$o->{base}}, "kernel-pcmcia-cs" if $o->{pcmcia};
}
- do {
- my $p = $o->{packages}{$_} or log::l("missing base package $_"), next;
- pkgs::select($o->{packages}, $p, 1);
- } foreach @{$o->{base}};
+ unless ($o->{isUpgrade}) {
+ do {
+ my $p = $o->{packages}{$_} or log::l("missing base package $_"), next;
+ pkgs::select($o->{packages}, $p, 1);
+ } foreach @{$o->{base}};
+ }
pkgs::setShowFromCompss($o->{compss}, $o->{installClass}, $o->{lang});
($o->{packages_}{ind}, $o->{packages_}{select_level}) = pkgs::setSelectedFromCompssList($o->{compssListLevels}, $o->{packages}, getAvailableSpace($o) * 0.7, $o->{installClass}, $o->{lang});
}
+sub findPackagesToUpgrade($) {
+ my ($o) = @_;
+
+ pkgs::findPackagesToUpgrade($o->{packages}, $o->{prefix});
+}
+
sub addToBeDone(&$) {
my ($f, $step) = @_;
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 42dd72d17..6c144e873 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -131,6 +131,11 @@ sub setPackages {
my ($o, $install_classes) = @_;
install_any::setPackages($o, $install_classes);
}
+sub findPackagesToUpgrade {
+ my ($o) = @_;
+ install_any::findPackagesToUpgrade($o);
+}
+
sub choosePackages($$$) {
my ($o, $packages, $compss) = @_;
}
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index 5b616bd2c..7136726e9 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -154,7 +154,12 @@ sub setPackages {
my $w = $o->wait_message('', _("Searching for available packages"));
$o->SUPER::setPackages($install_classes);
}
-
+#------------------------------------------------------------------------------
+sub findPackagesToUpgrade {
+ my ($o) = @_;
+ my $w = $o->wait_message('', _("Finding package to upgrade"));
+ $o->SUPER::findPackagesToUpgrade();
+}
#------------------------------------------------------------------------------
sub configureNetwork($) {
my ($o, $first_time) = @_;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 75a2434f5..489c2dc83 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -136,9 +136,9 @@ sub psUsingHdlist() {
$packages{$name} = {
name => $name, header => $header, selected => 0, deps => [],
- version => c::headerGetEntry($header, 'version'),
- release => c::headerGetEntry($header, 'release'),
- size => c::headerGetEntry($header, 'size'),
+ version => c::headerGetEntry($header, 'version'),
+ release => c::headerGetEntry($header, 'release'),
+ size => c::headerGetEntry($header, 'size'),
};
}
log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");
@@ -288,6 +288,78 @@ sub getHeader($) {
$p->{header};
}
+sub findPackagesToUpgrade($$) {
+ my ($packages, $prefix) = @_;
+
+ 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";
+ my %installedFilesToRemove; #- files installed but not present in the package to upgrade -> to remove.
+
+ #- mark all files which are not in /etc/rc.d/ for packages which are already installed.
+ c::rpmdbTraverse($db, sub {
+ my ($header) = @_;
+ my @filenames = c::headerGetEntry($header, 'filenames');
+ @installedFilesToRemove{grep { $_ !~ m@/etc/rc.d/@ } @filenames} = ();
+ });
+
+ #- find new packages to upgrade.
+ foreach (values %$packages) {
+ my $p = $_;
+ my $skipThis = 0;
+ $skipThis ||= 1 if c::rpmdbNameTraverse($db, $p->{name}, sub {
+ my ($header) = @_;
+ $skipThis ||= (c::headerGetEntry($header, 'version') ge $p->{version});
+ }) == 0; #- skip if not installed (package not found in current install).
+ #- select the package if it is already installed with a lower version or simply not installed.
+ pkgs::select($packages, $p) unless ($skipThis || $p->{selected});
+ }
+
+ #- unmark all files for all packages marked for upgrade.
+ foreach (values %$packages) {
+ my $p = $_;
+
+ if ($p->{selected}) {
+ my @availFiles = $p->{filename} ? c::headerGetEntry($p->{header}, 'filename') : ();
+ map { delete $installedFilesToRemove{$_} } grep { $_ !~ m@/etc/rc.d/@ } @availFiles;
+ }
+ }
+
+ #- select packages which contains marked files, then unmark on selection.
+ foreach (values %$packages) {
+ my $p = $_;
+
+ unless ($p->{selected}) {
+ my @availFiles = $p->{filename} ? c::headerGetEntry($p->{header}, 'filename') : ();
+ my $toSelect = 0;
+ map { if (exists $installedFilesToRemove{$_}) {
+ $toSelect = 1; delete $installedFilesToRemove{$_} } } grep { $_ !~ m@/etc/rc.d/@ } @availFiles;
+ pkgs::select($packages, $p) if ($toSelect);
+ }
+ }
+
+ #- select packages which obseletes other package, TODO.
+
+ #- consistency check: deselect all packages with a version lower to already existing.
+ foreach (values %$packages) {
+ my $p = $_;
+ my $skipThis = 0;
+ if ($p->{selected}) {
+ c::rpmdbNameTraverse($db, $p->{name}, sub {
+ my ($header) = @_;
+ $skipThis ||= (c::headerGetEntry($header, 'version') ge $p->{version});
+ });
+ #- unselect the package if it is already installed with a greater or equal version.
+ pkgs::unselect($packages, $p) if ($skipThis);
+ }
+ }
+
+ #- close db, job finished !
+ c::rpmdbClose($db);
+}
+
sub install($$) {
my ($prefix, $toInstall) = @_;