diff options
| -rw-r--r-- | perl-install/Xconfig.pm | 55 | ||||
| -rw-r--r-- | perl-install/Xconfigurator.pm | 2 | ||||
| -rw-r--r-- | perl-install/Xconfigurator_consts.pm | 24 | ||||
| -rw-r--r-- | perl-install/install2.pm | 10 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 16 | ||||
| -rw-r--r-- | perl-install/install_steps.pm | 5 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 7 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 78 |
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) = @_; |