package Xconfigurator; # $Id$ use diagnostics; use strict; use vars qw($in $install @window_managers @depths @monitorSize2resolution @hsyncranges %min_hsync4wres @vsyncranges %depths @resolutions @resolutions_laptop %serversdriver @svgaservers @accelservers @allbutfbservers @allservers %vgamodes %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate %standard_monitors $XF86firstchunk_text $keyboardsection_start $keyboardsection_start_v4 $keyboardsection_part2 $keyboardsection_part3 $keyboardsection_part3_v4 $keyboardsection_end $pointersection_text $monitorsection_text1 $monitorsection_text2 $monitorsection_text3 $monitorsection_text4 $modelines_text_Trident_TG_96xx $modelines_text_ext $modelines_text $devicesection_text $devicesection_text_v4 $screensection_text1 %lines @options %xkb_options $good_default_monitor $low_default_monitor $layoutsection_v4 $modelines_text_apple); use common; use log; use detect_devices; use run_program; use Xconfigurator_consts; use any; use modules; use my_gtk qw(:helpers :wrappers); my $tmpconfig = "/tmp/Xconfig"; my ($prefix, %monitors, %standard_monitors_); sub xtest { my ($display) = @_; $::isStandalone ? system("DISPLAY=$display /usr/X11R6/bin/xtest") == 0 : c::Xtest($display); } sub getVGAMode($) { $_[0]->{card}{vga_mode} || $vgamodes{"640x480x16"}; } sub readCardsDB { my ($file) = @_; my ($card, %cards); my $F = common::openFileMaybeCompressed($file); my ($lineno, $cmd, $val) = 0; my $fs = { LINE => sub { push @{$card->{lines}}, $val unless $val eq "VideoRam" }, NAME => sub { $cards{$card->{type}} = $card if $card; $card = { type => $val }; }, SEE => sub { my $c = $cards{$val} or die "Error in database, invalid reference $val at line $lineno"; push @{$card->{lines}}, @{$c->{lines} || []}; add2hash($card->{flags}, $c->{flags}); add2hash($card, $c); }, CHIPSET => sub { $card->{chipset} = $val; $card->{flags}{needChipset} = 1 if $val eq 'GeForce DDR'; $card->{flags}{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128 SiS6326)); }, SERVER => sub { $card->{server} = $val; }, DRIVER => sub { $card->{driver} = $val; }, RAMDAC => sub { $card->{ramdac} = $val; }, DACSPEED => sub { $card->{dacspeed} = $val; }, CLOCKCHIP => sub { $card->{clockchip} = $val; $card->{flags}{noclockprobe} = 1; }, NOCLOCKPROBE => sub { $card->{flags}{noclockprobe} = 1 }, UNSUPPORTED => sub { $card->{flags}{unsupported} = 1 }, COMMENT => sub {}, }; local $_; while (<$F>) { $lineno++; s/\s+$//; /^#/ and next; /^$/ and next; /^END/ and do { $cards{$card->{type}} = $card if $card; last }; ($cmd, $val) = /(\S+)\s*(.*)/ or next; #log::l("bad line $lineno ($_)"), next; my $f = $fs->{$cmd}; $f ? $f->() : log::l("unknown line $lineno ($_)"); } \%cards; } sub readCardsNames { my $file = "$ENV{SHARE_PATH}/ldetect-lst/CardsNames"; map { (split '=>')[0] } grep { !/^#/ } catMaybeCompressed($file); } sub cardName2RealName { my ($name) = @_; my $file = "$ENV{SHARE_PATH}/ldetect-lst/CardsNames"; foreach (catMaybeCompressed($file)) { chop; next if /^#/; my ($name_, $real) = split '=>'; return $real if $name eq $name_; } $name; } sub updateCardAccordingName { my ($card, $name) = @_; my $cards = readCardsDB("$ENV{SHARE_PATH}/ldetect-lst/Cards+"); add2hash($card->{flags}, $cards->{$name}{flags}); add2hash($card, $cards->{$name}); $card; } sub readMonitorsDB { my ($file) = @_; %monitors and return; my $F = common::openFileMaybeCompressed($file); local $_; my $lineno = 0; while (<$F>) { $lineno++; s/\s+$//; /^#/ and next; /^$/ and next; my @fields = qw(vendor type eisa hsyncrange vsyncrange); my @l = split /\s*;\s*/; @l == @fields or log::l("bad line $lineno ($_)"), next; my %l; @l{@fields} = @l; if ($monitors{$l{type}}) { my $i; for ($i = 0; $monitors{"$l{type} ($i)"}; $i++) {} $l{type} = "$l{type} ($i)"; } $monitors{"$l{vendor}|$l{type}"} = \%l; } while (my ($k, $v) = each %standard_monitors) { $monitors{'Generic|' . translate($k)} = $standard_monitors_{$k} = { hsyncrange => $v->[1], vsyncrange => $v->[2] }; } } sub keepOnlyLegalModes { my ($card, $monitor) = @_; my $mem = 1024 * ($card->{memory} || ($card->{server} eq 'FBDev' ? 2048 : 32768)); #- limit to 2048x1536x64 my $hsync = max(split(/[,-]/, $monitor->{hsyncrange})); while (my ($depth, $res) = each %{$card->{depth}}) { @$res = grep { $mem >= product(@$_, $depth / 8) && $hsync >= ($min_hsync4wres{$_->[0]} || 0) && ($card->{server} ne 'FBDev' || $vgamodes{"$_->[0]x$_->[1]x$depth"}) } @$res; delete $card->{depth}{$depth} if @$res == 0; } } sub cardConfigurationAuto() { my @cards; if (my @c = grep { $_->{driver} =~ /(Card|Server):/ } detect_devices::probeall()) { foreach my $i (0..$#c) { local $_ = $c[$i]->{driver}; my $card = { identifier => ($c[$i]{description} . (@c > 1 && " $i")) }; $card->{type} = $1 if /Card:(.*)/; $card->{server} = $1 if /Server:(.*)/; $card->{flags}{needVideoRam} = /86c368|S3 Inc/; $card->{busid} = "PCI:$c[$i]{pci_bus}:$c[$i]{pci_device}:$c[$i]{pci_function}"; push @{$card->{lines}}, @{$lines{$card->{identifier}} || []}; push @cards, $card; } } #- take a default on sparc if nothing has been found. if (arch() =~ /^sparc/ && !@cards) { log::l("Using probe with /proc/fb as nothing has been found!"); local $_ = cat_("/proc/fb"); if (/Mach64/) { push @cards, { server => "Mach64" } } elsif (/Permedia2/) { push @cards, { server => "3DLabs" } } else { push @cards, { server => "Sun24" } } } #- special case for dual head card using only one busid. @cards = map { my $dup = $_->{identifier} =~ /MGA G450/ ? 2 : 1; if ($dup > 1) { my @result; my $orig = $_; foreach (1..$dup) { my $card = {}; add2hash($card, $orig); push @result, $card; } @result; } else { ($_); } } @cards; #- make sure no type are already used, duplicate both screen #- and rename type (because used as id). if (@cards > 1) { my $card = 1; foreach (@cards) { updateCardAccordingName($_, $_->{type}) if $_->{type}; $_->{type} = "$_->{type} $card"; $card++; } } #- in case of only one cards, remove all busid reference, this will avoid #- need of change of it if the card is moved. #- on many PPC machines, card is on-board, busid is important, leave? @cards == 1 and delete $cards[0]{busid} if arch() !~ /ppc/; @cards; } sub cardConfiguration(;$$$) { my ($card, $noauto, $cardOptions) = @_; $card ||= {}; updateCardAccordingName($card, $card->{type}) if $card->{type}; #- try to get info from given type undef $card->{type} unless $card->{server}; #- bad type as we can't find the server my @cards = cardConfigurationAuto(); if (@cards > 1 && ($noauto || !$card->{server})) {#} && !$::isEmbedded) { my (%single_heads, @choices, $tc); my $configure_multi_head = sub { add2hash($card, $cards[0]); #- assume good default. delete $card->{cards} if $noauto; $card->{cards} or $card->{cards} = \@cards; $card->{force_xf4} = 1; #- force XF4 in such case. $card->{Xinerama} = $_[0]; }; foreach (@cards) { unless ($_->{driver} && !$_->{flags}{unsupported}) { log::l("found card \"$_->{identifier}\" not supported by XF4, disabling mutli-head support"); $configure_multi_head = undef; } #- if more than one card use the same BusID, we have to use screen. if ($single_heads{$_->{busid}}) { $single_heads{$_->{busid}}{screen} ||= 0; $_->{screen} = $single_heads{$_->{busid}}{screen} + 1; } $single_heads{$_->{busid}} = $_; } if ($configure_multi_head) { push @choices, { text => _("Configure all heads independantly"), code => sub { $configure_multi_head->('') } }; push @choices, { text => _("Use Xinerama extension"), code => sub { $configure_multi_head->(1) } }; } foreach (values %single_heads) { push @choices, { text => _("Configure only card \"%s\" (%s)", $_->{identifier}, $_->{busid}), code => sub { add2hash($card, $_); delete $card->{cards}; delete $card->{Xinerama} } }; } $tc = $in->ask_from_listf(_("Multi-head configuration"), _("Your system support multiple head configuration. What do you want to do?"), sub { translate($_[0]{text}) }, \@choices) or return; #- no more die, CHECK with auto that return ''! $tc->{code} and $tc->{code}(); } else { #- only one head found, configure it as before. add2hash($card, $cards[0]) unless $card->{server} || $noauto; delete $card->{cards}; delete $card->{Xinerama}; } $card->{server} = 'FBDev' unless !$cardOptions->{allowFB} || $card->{server} || $card->{type} || $noauto; $card->{type} = cardName2RealName($in->ask_from_treelist(_("Graphic card"), _("Select a graphic card"), '|', ['Other|Unlisted', readCardsNames()])) unless $card->{type} || $card->{server}; undef $card->{type}, $card->{server} = $in->ask_from_list(_("X server"), _("Choose a X server"), $cardOptions->{allowFB} ? \@allservers : \@allbutfbservers ) or return if $card->{type} eq 'Other|Unlisted'; updateCardAccordingName($card, $card->{type}) if $card->{type}; add2hash($card, { vendor => "Unknown", board => "Unknown" }); foreach ($card, @{$card->{cards} || []}) { $_->{memory} = 4096, delete $_->{depth} if $_->{driver} eq 'i810'; $_->{memory} = 16384, delete $_->{depth} if $_->{chipset} =~ /PERMEDIA/ && $_->{memory} <= 1024; } #- 3D acceleration configuration for XFree 3.3 using Utah-GLX. $card->{Utah_glx} = ($card->{identifier} =~ /Matrox.* G[24][05]0/ || #- 8bpp does not work. $card->{identifier} =~ /Riva.*128/ || $card->{identifier} =~ /Rage X[CL]/ || $card->{identifier} =~ /3D Rage (?:LT|Pro)/); #- NOT WORKING $card->{type} =~ /Intel 810/); $card->{Utah_glx} = '' if arch() =~ /ppc/; #- No 3D XFree 3.3 for PPC #- 3D acceleration configuration for XFree 3.3 using Utah-GLX but EXPERIMENTAL that may freeze the machine (FOR INFO NOT USED). $card->{Utah_glx_EXPERIMENTAL} = ($card->{type} =~ /RIVA TNT/ || #- all RIVA/GeForce comes from NVIDIA and may freeze (gltron). #$card->{type} =~ /RIVA128/ || $card->{type} =~ /GeForce 256/ || $card->{type} =~ /S3 Savage3D/ || #- only this one is evoluting (expect a stable release ?) #- $card->{type} =~ /S3 ViRGE/ || #- 15bits only $card->{identifier} =~ /Rage Mobility (?:P\/M|L) / || $card->{type} =~ /SiS/); #- 3D acceleration configuration for XFree 4 using DRI. $card->{DRI_glx} = ($card->{identifier} =~ /Voodoo [35]/ || $card->{identifier} =~ /Voodoo Banshee/ || #- 16bit only $card->{identifier} =~ /Matrox.* G[24][05]0.*AGP/ || #- prefer 16bit with AGP only $card->{identifier} =~ /8281[05].* CGC/ || #- 16bits (Intel 810 & 815). #$card->{identifier} =~ /Radeon / || #- 16bits preferable ? $card->{identifier} =~ /Rage 128/); #- 16 and 32 bits, prefer 16bit as no DMA. #- 3D acceleration configuration for XFree 4 using DRI but EXPERIMENTAL that may freeze the machine (FOR INFO NOT USED). $card->{DRI_glx_EXPERIMENTAL} = ($card->{identifier} =~ /SiS.*6C?326/ || #- prefer 16bit, other ? $card->{identifier} =~ /SiS.*6C?236/ || $card->{identifier} =~ /SiS.*630/ || $card->{identifier} =~ /Radeon /); #- 16bits preferable ? #- 3D acceleration configuration for XFree 4 using NVIDIA driver (TNT, TN2 and GeForce cards only). $card->{NVIDIA_glx} = $cardOptions->{allowNVIDIA_rpms} && ($card->{identifier} =~ /[nN]Vidia.*T[nN]T2/ || #- TNT2 cards $card->{identifier} =~ /[nN]Vidia.*NV[56]/ || $card->{identifier} =~ /[nN]Vidia.*Vanta/ || $card->{identifier} =~ /[nN]Vidia.*GeForce/ || #- GeForce cards $card->{identifier} =~ /[nN]Vidia.*NV1[15]/ || $card->{identifier} =~ /[nN]Vidia.*Quadro/); #- check to use XFree 4 or XFree 3.3. $card->{use_xf4} = $card->{driver} && !$card->{flags}{unsupported}; $card->{force_xf4} = arch() =~ /ppc/; #- try to figure out ugly hack for PPC (recommend XF4 always so...) $card->{prefer_xf3} = !$card->{force_xf4} && ($card->{type} =~ /RIVA TNT/ || $card->{type} =~ /RIVA128/ || $card->{type} =~ /GeForce/ || $card->{type} =~ /SiS / && $card->{type} !~ /SiS 6326/ || $card->{type} =~ /NeoMagic /); #- take into account current environment in standalone to keep #- the XFree86 version. if ($::isStandalone) { readlink("$prefix/etc/X11/X") =~ /XFree86/ and $card->{prefer_xf3} = 0; readlink("$prefix/etc/X11/X") =~ /XF86_/ and $card->{prefer_xf3} = !$card->{force_xf4}; } #- basic installation, use of XFree 4.1 or XFree 3.3. my ($xf4_ver, $xf3_ver) = ("4.1.0", "3.3.6"); my $xf3_tc = { text => _("XFree %s", $xf3_ver), code => sub { $card->{Utah_glx} = $card->{DRI_glx} = $card->{NVIDIA_glx} = ''; $card->{use_xf4} = ''; log::l("Using XFree $xf3_ver") } }; my $msg = _("Which configuration of XFree do you want to have?"); my @choices = $card->{use_xf4} ? (if_($card->{prefer_xf3}, $xf3_tc), #- hack for Matrox driver where there are undefined reference if no DRI! if_($card->{identifier} !~ /Matrox.* G[24][05]0/ && (!$card->{prefer_xf3} || $::expert), { text => _("XFree %s", $xf4_ver), code => sub { $card->{Utah_glx} = $card->{DRI_glx} = $card->{NVIDIA_glx} = ''; log::l("Using XFree $xf4_ver") } }), if_(!$card->{prefer_xf3} && $::expert, $xf3_tc)) : $xf3_tc; #- try to figure if 3D acceleration is supported #- by XFree 3.3 but not XFree 4 then ask user to keep XFree 3.3 ? if ($card->{Utah_glx}) { $msg = ($card->{use_xf4} && !($card->{DRI_glx} || $card->{NVIDIA_glx}) && !$card->{prefer_xf3} ? _("Your card can have 3D hardware acceleration support but only with XFree %s. Your card is supported by XFree %s which may have a better support in 2D.", $xf3_ver, $xf4_ver) : _("Your card can have 3D hardware acceleration support with XFree %s.", $xf3_ver)) . "\n\n\n" . $msg; $::expert or @choices = (); #- keep it by default here as it is the only choice available. unshift @choices, { text => _("XFree %s with 3D hardware acceleration", $xf3_ver), code => sub { $card->{use_xf4} = ''; log::l("Using XFree $xf3_ver with 3D hardware acceleration") } }; } #- an expert user may want to try to use an EXPERIMENTAL 3D acceleration. if ($::expert && $card->{use_xf4} && $card->{DRI_glx_EXPERIMENTAL}) { $msg = _("Your card can have 3D hardware acceleration support with XFree %s, NOTE THIS IS EXPERIMENTAL SUPPORT AND MAY FREEZE YOUR COMPUTER.", $xf4_ver) . "\n\n\n" . $msg; push @choices, { text => _("XFree %s with EXPERIMENTAL 3D hardware acceleration", $xf4_ver), code => sub { $card->{DRI_glx} = 'EXPERIMENTAL'; log::l("Using XFree $xf4_ver with EXPERIMENTAL 3D hardware acceleration") } }; } #- an expert user may want to try to use an EXPERIMENTAL 3D acceleration, currenlty #- this is with Utah GLX and so, it can provide a way of testing. if ($::expert && $card->{Utah_glx_EXPERIMENTAL}) { $msg = ($card->{use_xf4} && !($card->{DRI_glx} || $card->{NVIDIA_glx}) && !$card->{prefer_xf3} ? _("Your card can have 3D hardware acceleration support but only with XFree %s, NOTE THIS IS EXPERIMENTAL SUPPORT AND MAY FREEZE YOUR COMPUTER. Your card is supported by XFree %s which may have a better support in 2D.", $xf3_ver, $xf4_ver) : _("Your card can have 3D hardware acceleration support with XFree %s, NOTE THIS IS EXPERIMENTAL SUPPORT AND MAY FREEZE YOUR COMPUTER.", $xf3_ver)) . "\n\n\n" . $msg; push @choices, { text => _("XFree %s with EXPERIMENTAL 3D hardware acceleration", $xf3_ver), code => sub { $card->{use_xf4} = ''; $card->{Utah_glx} = 'EXPERIMENTAL'; log::l("Using XFree $xf3_ver with EXPERIMENTAL 3D hardware acceleration") } }; } #- ask the expert user to enable or not hardware acceleration support. if ($card->{use_xf4} && ($card->{DRI_glx} || $card->{NVIDIA_glx})) { $msg = _("Your card can have 3D hardware acceleration support with XFree %s.", $xf4_ver) . "\n\n\n" . $msg; $::expert or @choices = (); #- keep all user by default with XFree 4 including 3D acceleration. unshift @choices, { text => _("XFree %s with 3D hardware acceleration", $xf4_ver), code => sub { log::l("Using XFree $xf4_ver with 3D hardware acceleration") } }; } if (arch() =~ /ppc/) { #- not much choice for PPC - we only have XF4 @choices = { text => _("XFree %s", $xf4_ver), code => '' }; log::l("Using XFree $xf4_ver"); } #- examine choice of user, beware the list MUST NOT BE REORDERED AS the first item should be the #- proposed one by DrakX. my $tc = $in->ask_from_listf(_("XFree configuration"), formatAlaTeX($msg), sub { translate($_[0]{text}) }, \@choices) or return; #- in case of class discarding, this can help ... $tc or $tc = $choices[0]; $tc->{code} and $tc->{code}(); $card->{prog} = "/usr/X11R6/bin/" . ($card->{use_xf4} ? 'XFree86' : $card->{server} =~ /Sun(.*)/ ? "Xsun$1" : "XF86_$card->{server}"); #- additional packages to install according available card. #- add XFree86-libs-DRI here if using DRI (future split of XFree86 TODO) my @l = (); if ($card->{DRI_glx}) { push @l, 'Glide_V5' if $card->{identifier} =~ /Voodoo 5/; push @l, 'Glide_V3-DRI' if $card->{identifier} =~ /Voodoo (3|Banshee)/; push @l, 'XFree86-glide-module' if $card->{identifier} =~ /Voodoo/; } elsif ($card->{NVIDIA_glx}) { push @l, @{$cardOptions->{allowNVIDIA_rpms}}; } if ($card->{Utah_glx}) { push @l, 'Mesa' if !$card->{use_xf4}; } -x "$prefix$card->{prog}" or $install && $install->($card->{use_xf4} ? 'XFree86-server' : "XFree86-$card->{server}", @l); -x "$prefix$card->{prog}" or die "server $card->{server} is not available (should be in $prefix$card->{prog})"; #- check for Matrox G200 PCI cards, disable AGP in such cases, causes black screen else. if ($card->{identifier} =~ /Matrox.* G[24][05]0/ && $card->{identifier} !~ /AGP/) { log::l("disabling AGP mode for Matrox card, as it seems to be a PCI card"); log::l("this is only used for XFree 3.3.6, see /etc/X11/glx.conf"); substInFile { s/^\s*#*\s*mga_dma\s*=\s*\d+\s*$/mga_dma = 0\n/ } "$prefix/etc/X11/glx.conf"; } #- make sure everything is correct at this point, packages have really been installed #- and driver and GLX extension is present. if ($card->{NVIDIA_glx} && !$card->{DRI_glx} && (-e "$prefix/usr/X11R6/lib/modules/drivers/nvidia_drv.o" && -e "$prefix/usr/X11R6/lib/modules/extensions/libglx.so")) { log::l("Using specific NVIDIA driver and GLX extensions"); $card->{driver} = 'nvidia'; } else { $card->{NVIDIA_glx} = ''; } delete $card->{depth}{32} if $card->{type} =~ /S3 Trio3D|SiS/; $card->{options}{sw_cursor} = 1 if $card->{type} =~ /S3 Trio3D|SiS 6326/; unless ($card->{type}) { $card->{flags}{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64)); } $card->{options_xf3}{power_saver} = 1; $card->{options_xf4}{DPMS} = 1; $card->{flags}{needVideoRam} and $card->{memory} ||= $videomemory{$in->ask_from_list_('', _("Select the memory size of your graphic card"), [ sort { $videomemory{$a} <=> $videomemory{$b} } keys %videomemory]) || return}; #- hack for ATI Mach64 cards where two options should be used if using Utah-GLX. if ($card->{identifier} =~ /Rage X[CL]/ || $card->{identifier} =~ /Rage Mobility (?:P\/M|L) / || $card->{identifier} =~ /3D Rage (?:LT|Pro)/) { $card->{options_xf3}{no_font_cache} = $card->{Utah_glx}; $card->{options_xf3}{no_pixmap_cache} = $card->{Utah_glx}; } #- hack for SiS cards where an option should be used if using Utah-GLX. if ($card->{type} =~ /SiS /) { $card->{options_xf3}{no_pixmap_cache} = $card->{Utah_glx}; } #- 3D acceleration configuration for XFree 4 using DRI, this is enabled by default #- but for some there is a need to specify VideoRam (else it won't run). if ($card->{DRI_glx}) { $card->{identifier} =~ /Matrox.* G[24]00/ and $card->{flags}{needVideoRam} = 'fakeVideoRam'; $card->{identifier} =~ /8281[05].* CGC/ and ($card->{flags}{needVideoRam}, $card->{memory}) = ('fakeVideoRam', 16384); } if (!$::isStandalone && $card->{driver} eq 'i810') { require modules; eval { modules::load("agpgart"); }; } $card; } sub optionsConfiguration($) { my ($o) = @_; my @l; my %l; foreach (@options) { if ($o->{card}{server} eq $_->[1] && $o->{card}{identifier} =~ /$_->[2]/) { my $options = 'options_' . ($o->{card}{server} eq 'XFree86' ? 'xf4' : 'xf3'); $o->{card}{$options}{$_->[0]} ||= 0; unless ($l{$_->[0]}) { push @l, { label => $_->[0], val => \$o->{card}{$options}{$_->[0]}, type => 'bool' }; $l{$_->[0]} = 1; } } } @l = @l[0..9] if @l > 9; #- reduce list size to 10 for display $in->ask_from_entries_refH('', _("Choose options for server"), \@l); } sub monitorConfiguration(;$$) { my $monitor = shift || {}; my $useFB = shift || 0; if ($monitor->{hsyncrange} && $monitor->{vsyncrange}) { add2hash($monitor, { type => "monitor1", vendor => "Unknown", model => "Unknown" }); return $monitor; } readMonitorsDB("$ENV{SHARE_PATH}/ldetect-lst/MonitorsDB"); my $good_default = (arch() =~ /ppc/ ? 'Apple|' : 'Generic|') . translate($good_default_monitor); $monitor->{type} ||= ($::auto_install ? $low_default_monitor : $in->ask_from_treelist(_("Monitor"), _("Choose a monitor"), '|', ['Custom', keys %monitors], $good_default)); if ($monitor->{type} eq 'Custom') { $in->ask_from_entries_refH('', _("The two critical parameters are the vertical refresh rate, which is the rate at which the whole screen is refreshed, and most importantly the horizontal sync rate, which is the rate at which scanlines are displayed. It is VERY IMPORTANT that you do not specify a monitor type with a sync range that is beyond the capabilities of your monitor: you may damage your monitor. If in doubt, choose a conservative setting."), [ { val => \$monitor->{hsyncrange}, list => \@hsyncranges, label => _("Horizontal refresh rate") }, { val => \$monitor->{vsyncrange}, list => \@vsyncranges, label => _("Vertical refresh rate") }]); } else { add2hash($monitor, $monitors{$monitor->{type}} || $standard_monitors_{$monitor->{type}}); } add2hash($monitor, { type => "Unknown", vendor => "Unknown", model => "Unknown", manual => 1 }); } sub testConfig($) { my ($o) = @_; my ($resolutions, $clocklines); write_XF86Config($o, $tmpconfig); unlink "/tmp/.X9-lock"; #- restart_xfs; my $f = $tmpconfig . ($o->{card}{use_xf4} && "-4"); local *F; open F, "$prefix$o->{card}{prog} :9 -probeonly -pn -xf86config $f 2>&1 |"; local $_; while () { $o->{card}{memory} ||= $2 if /(videoram|Video RAM):\s*(\d*)/; # look for clocks push @$clocklines, $1 if /clocks: (.*)/ && !/(pixel |num)clocks:/; push @$resolutions, [ $1, $2 ] if /: Mode "(\d+)x(\d+)": mode clock/; print; } close F or die "X probeonly failed"; ($resolutions, $clocklines); } sub testFinalConfig { my ($o, $auto, $skiptest, $skip_badcard) = @_; $o->{monitor}{hsyncrange} && $o->{monitor}{vsyncrange} or $in->ask_warn('', _("Monitor not configured")), return; $o->{card}{server} || $o->{card}{driver} or $in->ask_warn('', _("Graphic card not configured yet")), return; $o->{card}{depth} or $in->ask_warn('', _("Resolutions not chosen yet")), return; my $f = "/etc/X11/XF86Config.test"; write_XF86Config($o, $::testing ? $tmpconfig : "$prefix/$f"); $skiptest || $o->{card}{server} =~ 'FBDev|Sun' and return 1; #- avoid testing with these. #- needed for bad cards not restoring cleanly framebuffer my $bad_card = $o->{card}{identifier} =~ /i740|ViRGE|S3 Inc|Rage Mobility (?:P\/M|L) |3D Rage LT/; $bad_card ||= $o->{card}{use_xf4}; #- TODO obsoleted to check, when using fbdev of XFree 4! log::l("the graphic card does not like X in framebuffer") if $bad_card; my $verybad_card = $o->{card}{driver} eq 'i810'; $verybad_card ||= $o->{card}{driver} eq 'nvidia' && !$::isStandalone; #- avoid testing during install at any price. $verybad_card and return 1; my $mesg = _("Do you want to test the configuration?"); my $def = 1; if ($bad_card && !$::isStandalone) { $skip_badcard and return 1; $mesg = $mesg . "\n" . _("Warning: testing this graphic card may freeze your computer"); $def = 0; } $auto && $def or $in->ask_yesorno(_("Test of the configuration"), $mesg, $def) or return 1; unlink "$prefix/tmp/.X9-lock"; #- create a link from the non-prefixed /tmp/.X11-unix/X9 to the prefixed one #- that way, you can talk to :9 without doing a chroot #- but take care of non X11 install :-) if (-d "/tmp/.X11-unix") { symlinkf "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix; } else { symlinkf "$prefix/tmp/.X11-unix", "/tmp/.X11-unix" if $prefix; } #- restart_xfs; my $f_err = "$prefix/tmp/Xoutput"; my $pid; unless ($pid = fork) { open STDERR, ">$f_err"; chroot $prefix if $prefix; exec $o->{card}{prog}, if_($o->{card}{prog} !~ /Xsun/, "-xf86config", ($::testing ? $tmpconfig : $f) . ($o->{card}{use_xf4} && "-4")), ":9" or c::_exit(0); } do { sleep 1 } until xtest(":9") || waitpid($pid, c::WNOHANG()); my $b = before_leaving { unlink $f_err }; unless (xtest(":9")) { local $_; local *F; open F, $f_err; i: while () { if (/\b(error|not supported)\b/i) { my @msg = !/error/ && $_ ; while () { /not fatal/ and last i; /^$/ and last; push @msg, $_; } $in->ask_warn('', [ _("An error has occurred:"), " ", @msg, _("\ntry to change some parameters") ]); return 0; } } } local *F; open F, "|perl 2>/dev/null" or die ''; print F "use lib qw(", join(' ', @INC), ");\n"; print F q{ use interactive_gtk; use my_gtk qw(:wrappers); $ENV{DISPLAY} = ":9"; gtkset_background(200 * 257, 210 * 257, 210 * 257); my ($h, $w) = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW)->get_size; $my_gtk::force_position = [ $w / 3, $h / 2.4 ]; $my_gtk::force_focus = 1; my $text = Gtk::Label->new; my $time = 8; Gtk->timeout_add(1000, sub { $text->set(_("Leaving in %d seconds", $time)); $time-- or Gtk->main_quit; 1; }); my $background = "/usr/share/pixmaps/backgrounds/mandrakelinux/XFdrake-image-test.jpg"; my $qiv = "/usr/bin/qiv"; -r "} . $prefix . q{/$background" && -x "} . $prefix . q{/$qiv" and system(($::testing ? "} . $prefix . q{" : "chroot } . $prefix . q{/ ") . "$qiv -y $background"); my $in = interactive_gtk->new; $in->exit($in->ask_yesorno('', [ _("Is this the correct setting?"), $text ], 0) ? 0 : 222); }; my $rc = close F; my $err = $?; unlink "/tmp/.X11-unix/X9" if $prefix; kill 2, $pid; $rc || $err == 222 << 8 or $in->ask_warn('', _("An error has occurred, try to change some parameters")); $rc; } sub autoDefaultDepth($$) { my ($card, $wres_wanted) = @_; my ($best, $depth); return 16 if $card->{Utah_glx} || $card->{DRI_glx}; #- assume 16bit as most of them need 16. for ($card->{server}) { /FBDev/ and return 16; #- this should work by default, FBDev is allowed only if install currently uses it at 16bpp. /Sun24/ and return 24; /SunMono/ and return 2; /Sun/ and return 8; } while (my ($d, $r) = each %{$card->{depth}}) { $depth = max($depth || 0, $d); #- try to have resolution_wanted $best = max($best || 0, $d) if $r->[0][0] >= $wres_wanted; $best = $card->{suggest_depth}, last if ($card->{suggest_depth} && $card->{suggest_wres} && $r->[0][0] >= $card->{suggest_wres}); } $best || $depth or die "no valid modes"; } sub autoDefaultResolution { # return "1024x768" if detect_devices::hasPCMCIA; if (arch() =~ /ppc/) { return "1024x768" if detect_devices::get_mac_model =~ /^PowerBook|^iMac/; } my ($size) = @_; $monitorSize2resolution[round($size || 14)] || #- assume a small monitor (size is in inch) $monitorSize2resolution[-1]; #- no corresponding resolution for this size. It means a big monitor, take biggest we have } sub chooseResolutionsGtk($$;$) { my ($card, $chosen_depth, $chosen_w) = @_; require my_gtk; my_gtk->import(qw(:wrappers)); my $W = my_gtk->new(_("Resolution")); my %txt2depth = reverse %depths; my ($r, $depth_combo, %w2depth, %w2h, %w2widget, $pix_monitor, $pix_colors, $w2_combo); $w2_combo = new Gtk::Combo; my $best_w; while (my ($depth, $res) = each %{$card->{depth}}) { foreach (@$res) { $w2h{$_->[0]} = $_->[1]; push @{$w2depth{$_->[0]}}, $depth; $best_w = max($_->[0], $best_w) if $_->[0] <= $chosen_w; } } $chosen_w = $best_w; my $set_depth = sub { $depth_combo->entry->set_text(translate($depths{$chosen_depth})) }; #- the set function is usefull to toggle the CheckButton with the callback being ignored my $ignore; my $no_human; # is the w2_combo->entry changed by a human? my $set = sub { $ignore = 1; $_[0]->set_active(1); $ignore = 0; }; my %monitor; $monitor{$_} = [ gtkcreate_png("monitor-" . $_ . ".png") ] foreach (640, 800, 1024, 1280); $monitor{1152} = [ gtkcreate_png("monitor-" . 1024 . ".png") ]; $monitor{1600} = [ gtkcreate_png("monitor-" . 1280 . ".png") ]; my $pixmap_m = new Gtk::Pixmap( $monitor{$chosen_w}[0] , $monitor{$chosen_w}[1] ); while (my ($w, $h) = each %w2h) { my $V = $w . "x" . $h; $w2widget{$w} = $r = new Gtk::RadioButton($r ? ($V, $r) : $V); if ($chosen_w == $w) { &$set($r); } $r->signal_connect("clicked" => sub { $ignore and return; $chosen_w = $w; $no_human=1; $w2_combo->entry->set_text($w . "x" . $w2h{$w}); unless (member($chosen_depth, @{$w2depth{$w}})) { $chosen_depth = max(@{$w2depth{$w}}); &$set_depth(); } }); } gtkadd($W->{window}, gtkpack_($W->create_box_with_title(_("Choose the resolution and the color depth"), "(" . ($card->{type} ? _("Graphic card: %s", $card->{type}) : _("XFree86 server: %s", $card->{server})) . ")" ), 1, gtkpack2(new Gtk::VBox(0,0), gtkpack2__(new Gtk::VBox(0, $::isEmbedded ? 15 : 0), if_($::isEmbedded, $pixmap_m), if_(!$::isEmbedded, map {$w2widget{$_} } ikeys(%w2widget)), gtkpack2(new Gtk::HBox(0,0), create_packtable({ col_spacings => 5, row_spacings => 5}, [ if_($::isEmbedded,$w2_combo) , new Gtk::Label("")], [ $depth_combo = new Gtk::Combo, gtkadd(gtkset_shadow_type(new Gtk::Frame, 'etched_out'), $pix_colors = gtkpng ("colors")) ], ), ), ), ), 0, gtkadd($W->create_okcancel, $::isEmbedded ? gtksignal_connect(new Gtk::Button(_("Expert Mode")), clicked => sub { system ("XFdrake --expert"); }) : gtksignal_connect(new Gtk::Button(_("Show all")), clicked => sub { $W->{retval} = 1; $chosen_w = 0; Gtk->main_quit })), )); $depth_combo->disable_activate; $depth_combo->set_use_arrows_always(1); $depth_combo->entry->set_editable(0); $depth_combo->set_popdown_strings(map { translate($depths{$_}) } ikeys(%{$card->{depth}})); $depth_combo->entry->signal_connect(changed => sub { $chosen_depth = $txt2depth{untranslate($depth_combo->entry->get_text, keys %txt2depth)}; my $w = $card->{depth}{$chosen_depth}[0][0]; $chosen_w > $w and &$set($w2widget{$chosen_w = $w}); $pix_colors->set(gtkcreate_png( $chosen_depth >= 24 ? "colors.png" : $chosen_depth >= 15 ? "colors16.png" : "colors8.png")); }); if ($::isEmbedded) { $w2_combo->disable_activate; $w2_combo->set_use_arrows_always(1); $w2_combo->entry->set_editable(0); $w2_combo->set_popdown_strings(map { $_ . "x" . $w2h{$_} } keys %w2h); $w2_combo->entry->signal_connect(changed => sub { ($chosen_w) = $w2_combo->entry->get_text =~ /([^x]*)x.*/; $no_human ? $no_human=0 : $w2widget{$chosen_w}->set_active(1); $pixmap_m->set($monitor{$chosen_w}[0], $monitor{$chosen_w}[1]); }); } &$set_depth(); $W->{ok}->grab_focus; if ($::isEmbedded) { $no_human=1; $w2_combo->entry->set_text($chosen_w . "x" . $w2h{$chosen_w}); } $W->main or return; ($chosen_depth, $chosen_w); } sub chooseResolutions($$;$) { goto &chooseResolutionsGtk if ref($in) =~ /gtk/; my ($card, $chosen_depth, $chosen_w) = @_; my $best_w; local $_ = $in->ask_from_list(_("Resolutions"), "", [ map_each { map { "$_->[0]x$_->[1] ${main::a}bpp" } @$::b } %{$card->{depth}} ]) or return; reverse /(\d+)x\S+ (\d+)/; } sub resolutionsConfiguration { my ($o, $auto) = @_; my $card = $o->{card}; #- For the mono and vga16 server, no further configuration is required. if (member($card->{server}, "Mono", "VGA16")) { $card->{depth}{8} = [[ 640, 480 ]]; return; } elsif ($card->{server} =~ /Sun/) { $card->{depth}{2} = [[ 1152, 864 ]] if $card->{server} =~ /^(SunMono)$/; $card->{depth}{8} = [[ 1152, 864 ]] if $card->{server} =~ /^(SunMono|Sun)$/; $card->{depth}{24} = [[ 1152, 864 ]] if $card->{server} =~ /^(SunMono|Sun|Sun24)$/; $card->{default_wres} = 1152; $o->{default_depth} = max(keys %{$card->{depth}}); return 1; #- aka we cannot test, assumed as good (should be). } if (is_empty_hash_ref($card->{depth})) { $card->{depth}{$_} = [ map { [ split "x" ] } (detect_devices::isLaptop() ? @resolutions_laptop : @resolutions) ] foreach @depths; } #- sort resolutions in each depth foreach (values %{$card->{depth}}) { my $i = 0; @$_ = grep { first($i != $_->[0], $i = $_->[0]) } sort { $b->[0] <=> $a->[0] } @$_; } #- remove unusable resolutions (based on the video memory size and the monitor hsync rate) keepOnlyLegalModes($card, $o->{monitor}); my $res = $o->{resolution_wanted} || $card->{suggest_wres} || autoDefaultResolution($o->{monitor}{size}); my $wres = first(split 'x', $res); #- take the first available resolution <= the wanted resolution $wres = max map { first(grep { $_->[0] <= $wres } @$_)->[0] } values %{$card->{depth}}; my $depth = eval { $o->{default_depth} || autoDefaultDepth($card, $wres) }; $auto or ($depth, $wres) = chooseResolutions($card, $depth, $wres) or return; #- if nothing has been found for wres, #- try to find if memory used by mode found match the memory available #- card, if this is the case for a relatively low resolution ( < 1024 ), #- there could be a problem. #- memory in KB is approximated by $wres*$dpeth/14 which is little less #- than memory really used, (correct factor is 13.65333 for w/h ratio of 1.33333). if (!$wres || $auto && ($wres < 1024 && ($card->{memory} / ($wres * $depth / 14)) > 2)) { delete $card->{depth}; return resolutionsConfiguration($o); } #- needed in auto mode when all has been provided by the user $card->{depth}{$depth} or die "you selected an unusable depth"; #- remove all biggest resolution (keep the small ones for ctl-alt-+) #- otherwise there'll be a virtual screen :( $_ = [ grep { $_->[0] <= $wres } @$_ ] foreach values %{$card->{depth}}; $card->{default_wres} = $wres; $card->{vga_mode} = $vgamodes{"${wres}xx$depth"} || $vgamodes{"${res}x$depth"}; #- for use with frame buffer. $o->{default_depth} = $depth; 1; } #- Create the XF86Config file. sub write_XF86Config { my ($o, $file) = @_; my $O; local (*F, *G); open F, ">$file" or die "can't write XF86Config in $file: $!"; open G, ">$file-4" or die "can't write XF86Config in $file-4: $!"; print F $XF86firstchunk_text; print G $XF86firstchunk_text; #- Write keyboard section. $O = $o->{keyboard}; print F $keyboardsection_start; print G $keyboardsection_start_v4; print F qq( XkbDisable\n) unless $O->{xkb_keymap}; print G qq( Option "XkbDisable"\n) unless $O->{xkb_keymap}; print F $keyboardsection_part3; print G $keyboardsection_part3_v4; $O->{xkb_model} ||= arch() =~ /ppc/ ? 'macintosh' : arch() =~ /sparc/ ? 'sun' : $O->{xkb_keymap} eq 'br' ? 'abnt2' : 'pc105'; print F qq( XkbModel "$O->{xkb_model}"\n); print G qq( Option "XkbModel" "$O->{xkb_model}"\n); print F qq( XkbLayout "$O->{xkb_keymap}"\n); print G qq( Option "XkbLayout" "$O->{xkb_keymap}"\n); print F join '', map { " $_\n" } @{$xkb_options{$O->{xkb_keymap}} || []}; print G join '', map { /(\S+)(.*)/; qq( Option "$1" $2\n) } @{$xkb_options{$O->{xkb_keymap}} || []}; print F $keyboardsection_end; print G $keyboardsection_end; #- Write pointer section. my $pointer = sub { my ($O, $id) = @_; print F $id > 1 ? qq(Section "XInput"\n) : qq(Section "Pointer"\n); $id > 1 and print F qq( SubSection "Mouse"\n); print G qq(Section "InputDevice"\n\n); $id > 1 and print F qq( DeviceName "Mouse$id"\n); print G qq( Identifier "Mouse$id"\n); print G qq( Driver "mouse"\n); print F ($id > 1 && " ") . qq( Protocol "$O->{XMOUSETYPE}"\n); print G qq( Option "Protocol" "$O->{XMOUSETYPE}"\n); print F ($id > 1 && " ") . qq( Device "/dev/$O->{device}"\n); print G qq( Option "Device" "/dev/$O->{device}"\n); #- this will enable the "wheel" or "knob" functionality if the mouse supports it print F ($id > 1 && " ") . " ZAxisMapping 4 5\n" if $O->{nbuttons} > 3; print F ($id > 1 && " ") . " ZAxisMapping 6 7\n" if $O->{nbuttons} > 5; print G qq( Option "ZAxisMapping" "4 5"\n) if $O->{nbuttons} > 3; print G qq( Option "ZAxisMapping" "6 7"\n) if $O->{nbuttons} > 5; print F "#" unless $O->{nbuttons} < 3; print G "#" unless $O->{nbuttons} < 3; print F ($id > 1 && " ") . qq( Emulate3Buttons\n); print G qq( Option "Emulate3Buttons"\n); print F "#" unless $O->{nbuttons} < 3; print G "#" unless $O->{nbuttons} < 3; print F ($id > 1 && " ") . qq( Emulate3Timeout 50\n\n); print G qq( Option "Emulate3Timeout" "50"\n\n); print F "# ChordMiddle is an option for some 3-button Logitech mice\n\n"; print G "# ChordMiddle is an option for some 3-button Logitech mice\n\n"; print F "#" unless $O->{chordmiddle}; print G "#" unless $O->{chordmiddle}; print F ($id > 1 && " ") . qq( ChordMiddle\n\n); print G qq( Option "ChordMiddle"\n\n); print F ($id > 1 && " ") . " ClearDTR\n" if $O->{cleardtrrts}; print F ($id > 1 && " ") . " ClearRTS\n\n" if $O->{cleardtrrts}; $id > 1 and print F qq( EndSubSection\n); print F "EndSection\n\n\n"; print G "EndSection\n\n\n"; }; print F $pointersection_text; print G $pointersection_text; $pointer->($o->{mouse}, 1); $o->{mouse}{auxmouse} and $pointer->($o->{mouse}{auxmouse}, 2); #- write module section for version 3. if (@{$o->{wacom}} || $o->{card}{Utah_glx}) { print F qq(Section "Module" ); print F qq( Load "xf86Wacom.so"\n) if @{$o->{wacom}}; print F qq( Load "glx-3.so"\n) if $o->{card}{Utah_glx}; #- glx.so may clash with server version 4. print F qq(EndSection ); } #- write wacom device support. foreach (1 .. @{$o->{wacom}}) { my $dev = "/dev/" . $o->{wacom}[$_-1]; print F $dev =~ /input\/event/ ? qq( Section "XInput" SubSection "WacomStylus" DeviceName "Stylus$_" Port "$dev" USB AlwaysCore Mode Absolute EndSubSection SubSection "WacomCursor" DeviceName "Cursor$_" Port "$dev" USB AlwaysCore Mode Relative EndSubSection SubSection "WacomEraser" DeviceName "Eraser$_" Port "$dev" USB AlwaysCore Mode Absolute EndSubSection EndSection ) : qq( Section "XInput" SubSection "WacomStylus" DeviceName "Stylus$_" Port "$dev" AlwaysCore Mode Absolute EndSubSection SubSection "WacomCursor" DeviceName "Sursor$_" Port "$dev" AlwaysCore Mode Relative EndSubSection SubSection "WacomEraser" DeviceName "Eraser$_" Port "$dev" AlwaysCore Mode Absolute EndSubSection EndSection ); } foreach (1..@{$o->{wacom}}) { my $dev = "/dev/" . $o->{wacom}[$_-1]; print G $dev =~ /input\/event/ ? qq( Section "InputDevice" Identifier "Stylus$_" Driver "wacom" Option "Type" "stylus" Option "Device" "$dev" Option "Mode" "Absolute" Option "USB" "on" EndSection Section "InputDevice" Identifier "Eraser$_" Driver "wacom" Option "Type" "eraser" Option "Device" "$dev" Option "Mode" "Absolute" Option "USB" "on" EndSection Section "InputDevice" Identifier "Cursor$_" Driver "wacom" Option "Type" "cursor" Option "Device" "$dev" Option "Mode" "Relative" Option "USB" "on" EndSection ) : qq( Section "InputDevice" Identifier "Stylus$_" Driver "wacom" Option "Type" "stylus" Option "Device" "$dev" Option "Mode" "Absolute" EndSection Section "InputDevice" Identifier "Eraser$_" Driver "wacom" Option "Type" "eraser" Option "Device" "$dev" Option "Mode" "Absolute" EndSection Section "InputDevice" Identifier "Cursor$_" Driver "wacom" Option "Type" "cursor" Option "Device" "$dev" Option "Mode" "Relative" EndSection ); } #- write modules section for version 4. print G qq( Section "Module" # This loads the DBE extension module. Load "dbe" ); if ($o->{card}{DRI_glx}) { print G qq( Load "glx" Load "dri" ); } elsif ($o->{card}{NVIDIA_glx}) { print G qq( # This loads the NVIDIA GLX extension module. # IT IS IMPORTANT TO KEEP NAME AS FULL PATH TO libglx.so ELSE # IT WILL LOAD XFree86 glx module and the server will crash. Load "/usr/X11R6/lib/modules/extensions/libglx.so" ); } print G qq( # This loads the miscellaneous extensions module, and disables # initialisation of the XFree86-DGA extension within that module. SubSection "extmod" #Option "omit xfree86-dga" EndSubSection # This loads the Type1 and FreeType font modules Load "type1" Load "freetype" EndSection ); print G qq( Section "DRI" Mode 0666 EndSection ) if $o->{card}{DRI_glx}; #- Write monitor section. $O = $o->{monitor}; print F $monitorsection_text1; print G $monitorsection_text1; print F qq( Identifier "$O->{type}"\n); print G qq( Identifier "$O->{type}"\n); print G qq( UseModes "Mac Modes"\n) if arch() =~ /ppc/; print F qq( VendorName "$O->{vendor}"\n); print G qq( VendorName "$O->{vendor}"\n); print F qq( ModelName "$O->{model}"\n\n); print G qq( ModelName "$O->{model}"\n\n); print F $monitorsection_text2; print G $monitorsection_text2; print F qq( HorizSync $O->{hsyncrange}\n\n); print G qq( HorizSync $O->{hsyncrange}\n\n); print F $monitorsection_text3; print G $monitorsection_text3; print F qq( VertRefresh $O->{vsyncrange}\n\n); print G qq( VertRefresh $O->{vsyncrange}\n\n); print F $monitorsection_text4; print F ($O->{modelines} || '') . ($o->{card}{type} eq "TG 96" ? $modelines_text_Trident_TG_96xx : "$modelines_text$modelines_text_ext"); print G $modelines_text_ext; print F "\nEndSection\n\n\n"; print G "\nEndSection\n\n\n"; print G $modelines_text_apple if arch() =~ /ppc/; foreach (2..@{$o->{card}{cards} || []}) { print G qq(Section "Monitor"\n); print G qq( Identifier "monitor$_"\n); print G qq( VendorName "$O->{vendor}"\n); print G qq( ModelName "$O->{model}"\n\n); print G qq( HorizSync $O->{hsyncrange}\n); print G qq( VertRefresh $O->{vsyncrange}\n); print G qq(EndSection\n\n\n); } #- Write Device section. $O = $o->{card}; print F $devicesection_text; print G $devicesection_text_v4; print F qq(Section "Device"\n); print F qq( Identifier "$O->{type}"\n); print F qq( VendorName "$O->{vendor}"\n); print F qq( BoardName "$O->{board}"\n); print F "#" if $O->{chipset} && !$O->{flags}{needChipset}; print F qq( Chipset "$O->{chipset}"\n) if $O->{chipset}; print F "#" if $O->{memory} && !$O->{flags}{needVideoRam}; print F " VideoRam $O->{memory}\n" if $O->{memory}; print F map { " $_\n" } @{$O->{lines} || []}; print F qq( Ramdac "$O->{ramdac}"\n) if $O->{ramdac}; print F qq( Dacspeed "$O->{dacspeed}"\n) if $O->{dacspeed}; if ($O->{clockchip}) { print F qq( Clockchip "$O->{clockchip}"\n); } else { print F " # Clock lines\n"; print F " Clocks $_\n" foreach (@{$O->{clocklines}}); } print F qq( # Uncomment following option if you see a big white block # instead of the cursor! # Option "sw_cursor" ); my $p = sub { my $l = $O->{$_[0]}; map { (!$l->{$_} && '#') . qq( Option "$_"\n) } keys %{$l || {}}; }; print F $p->('options'); print F $p->('options_xf3'); print F "EndSection\n\n\n"; #- configure all drivers here! foreach (@{$O->{cards} || [ $O ]}) { print G qq(Section "Device"\n); print G qq( Identifier "$_->{type}"\n); print G qq( VendorName "$_->{vendor}"\n); print G qq( BoardName "$_->{board}"\n); print G qq( Driver "$_->{driver}"\n); print G "#" if $_->{memory} && !$_->{flags}{needVideoRam}; print G " VideoRam $_->{memory}\n" if $_->{memory}; print G map { " $_\n" } @{$_->{lines} || []}; print G qq( Ramdac "$_->{ramdac}"\n) if $_->{ramdac}; print G qq( Dacspeed "$_->{dacspeed}"\n) if $_->{dacspeed}; if ($_->{clockchip}) { print G qq( Clockchip "$_->{clockchip}"\n); } else { print G " # Clock lines\n"; print G " Clocks $_\n" foreach (@{$_->{clocklines}}); } print G qq( # Uncomment following option if you see a big white block # instead of the cursor! # Option "sw_cursor" ); print G $p->('options'); #- keep $O for these! print G $p->('options_xf4'); #- keep $O for these! print G qq( Screen $_->{screen}\n) if defined $_->{screen}; print G qq( BusID "$_->{busid}"\n) if $_->{busid}; print G "EndSection\n\n\n"; } #- Write Screen sections. print F $screensection_text1, "\n"; print G $screensection_text1, "\n"; my $subscreen = sub { my ($f, $server, $defdepth, $depths) = @_; print $f " DefaultColorDepth $defdepth\n" if $defdepth; foreach (ikeys(%$depths)) { my $m = $server ne "fbdev" ? join(" ", map { qq("$_->[0]x$_->[1]") } @{$depths->{$_}}) : qq("default"); #-" print $f qq( Subsection "Display"\n); print $f qq( Depth $_\n) if $_; print $f qq( Modes $m\n); print $f qq( ViewPort 0 0\n); print $f qq( EndSubsection\n); } print $f "EndSection\n"; }; my $screen = sub { my ($server, $defdepth, $device, $depths) = @_; print F qq( Section "Screen" Driver "$server" Device "$device" Monitor "$o->{monitor}{type}" ); #-" $subscreen->(*F, $server, $defdepth, $depths); }; #- SVGA screen section. print F qq( # The Colour SVGA server ); if (member($O->{server}, @svgaservers)) { &$screen("svga", $o->{default_depth}, $O->{type}, $O->{depth}); } else { &$screen("svga", '', "Generic VGA", { 8 => [[ 320, 200 ]] }); } &$screen("vga16", '', (member($O->{server}, "Mono", "VGA16") ? $O->{type} : "Generic VGA"), { '' => [[ 640, 480 ], [ 800, 600 ]]}); &$screen("vga2", '', (member($O->{server}, "Mono", "VGA16") ? $O->{type} : "Generic VGA"), { '' => [[ 640, 480 ], [ 800, 600 ]]}); &$screen("accel", $o->{default_depth}, $O->{type}, $O->{depth}); &$screen("fbdev", $o->{default_depth}, $O->{type}, $O->{depth}); print G qq( Section "Screen" Identifier "screen1" Device "$O->{type}" Monitor "$o->{monitor}{type}" ); #- bpp 32 not handled by XF4 $subscreen->(*G, "svga", min($o->{default_depth}, 24), $O->{depth}); foreach (2..@{$O->{cards} || []}) { my $device = $O->{cards}[$_ - 1]{type}; print G qq( Section "Screen" Identifier "screen$_" Device "$device" Monitor "monitor$_" ); #- bpp 32 not handled by XF4 $subscreen->(*G, "svga", min($o->{default_depth}, 24), $O->{depth}); } print G qq( Section "ServerLayout" Identifier "layout1" Screen "screen1" ); foreach (2..@{$O->{cards} || []}) { my ($curr, $prev) = ($_, $_ - 1); print G qq( Screen "screen$curr" RightOf "screen$prev"\n); } print G '#' if defined $O->{Xinerama} && !$O->{Xinerama}; print G qq( Option "Xinerama" "on"\n) if defined $O->{Xinerama}; print G ' InputDevice "Mouse1" "CorePointer" '; $o->{mouse}{auxmouse} and print G ' InputDevice "Mouse2" "SendCoreEvents" '; foreach (1..@{$o->{wacom}}) { print G qq( InputDevice "Stylus$_" "AlwaysCore" InputDevice "Eraser$_" "AlwaysCore" InputDevice "Cursor$_" "AlwaysCore" ); } print G ' InputDevice "Keyboard1" "CoreKeyboard" EndSection '; #-" close F; close G; } sub XF86check_link { my ($ext) = @_; my $f = "$prefix/etc/X11/XF86Config$ext"; touch($f); my $l = "$prefix/usr/X11R6/lib/X11/XF86Config$ext"; if (-e $l && (stat($f))[1] != (stat($l))[1]) { #- compare the inode, must be the sames -e $l and unlink($l) || die "can't remove bad $l"; symlinkf "../../../../etc/X11/XF86Config$ext", $l; } } sub info { my ($o) = @_; my $info; $info .= _("Keyboard layout: %s\n", $o->{keyboard}{xkb_keymap}); $info .= _("Mouse type: %s\n", $o->{mouse}{XMOUSETYPE}); $info .= _("Mouse device: %s\n", $o->{mouse}{device}) if $::expert; $info .= _("Monitor: %s\n", $o->{monitor}{type}); $info .= _("Monitor HorizSync: %s\n", $o->{monitor}{hsyncrange}) if $::expert; $info .= _("Monitor VertRefresh: %s\n", $o->{monitor}{vsyncrange}) if $::expert; $info .= _("Graphic card: %s\n", $o->{card}{type}); $info .= _("Graphic memory: %s kB\n", $o->{card}{memory}) if $o->{card}{memory}; if ($o->{default_depth} and my $depth = $o->{card}{depth}{$o->{default_depth}}) { $info .= _("Color depth: %s\n", translate($depths{$o->{default_depth}})); $info .= _("Resolution: %s\n", join "x", @{$depth->[0]}) if $depth && !is_empty_array_ref($depth->[0]); } $info .= _("XFree86 server: %s\n", $o->{card}{server}) if $o->{card}{server}; $info .= _("XFree86 driver: %s\n", $o->{card}{driver}) if $o->{card}{driver}; $info; } sub show_info { my ($o) = @_; $in->ask_warn('', info($o)); } #- Program entry point. sub main { ($prefix, my $o, $in, my $cardOptions, $install) = @_; $o ||= {}; XF86check_link(''); XF86check_link('-4'); { my $w = $in->wait_message('', _("Preparing X-Window configuration"), 1); $o->{card} = cardConfiguration($o->{card}, $::noauto, $cardOptions); $o->{monitor} = monitorConfiguration($o->{monitor}, $o->{card}{server} eq 'FBDev'); } my $ok = resolutionsConfiguration($o, $::auto); $ok &&= testFinalConfig($o, $::auto, $o->{skiptest}, $::auto); my $quit; until ($ok || $quit) { ref($in) =~ /discard/ and die "automatic X configuration failed, ensure you give hsyncrange and vsyncrange with non-DDC aware videocards/monitors"; $in->set_help('configureXmain') unless $::isStandalone; my $f; $in->ask_from_entries_refH_powered( { title => 'XFdrake', messages => _("What do you want to do?"), cancel => '', }, [ { format => sub { $_[0][0] }, val => \$f, list => [ [ _("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() } ], [ _("Change Graphic card") => sub { $o->{card} = cardConfiguration('', 'noauto', $cardOptions) } ], if_($::expert, [ _("Change Server options") => sub { optionsConfiguration($o) } ]), [ _("Change Resolution") => sub { resolutionsConfiguration($o) } ], [ _("Show information") => sub { show_info($o) } ], [ _("Test again") => sub { $ok = testFinalConfig($o, 1) } ], [ _("Quit") => sub { $quit = 1 } ], ], } ]); $f->[1]->(); $in->kill; } if (!$ok) { $ok = $in->ask_yesorno('', _("Keep the changes? Current configuration is: %s", info($o))); } if ($ok) { unless ($::testing) { my $f = "$prefix/etc/X11/XF86Config"; if (-e "$f.test") { rename $f, "$f.old" or die "unable to make a backup of XF86Config"; rename "$f-4", "$f-4.old"; rename "$f.test", $f; rename "$f.test-4", "$f-4"; symlinkf "../..$o->{card}{prog}", "$prefix/etc/X11/X"; } } if ($::isStandalone && $0 =~ /Xdrakres/) { my $found; foreach (@window_managers) { if (`pidof "$_"` > 0) { if ($in->ask_okcancel('', _("Please relog into %s to activate the changes", ucfirst $_), 1)) { fork and $in->exit; system("kwmcom logout") if /kwm/; system("dcop kdesktop default logout") if /kwin/; system("save-session --kill") if /gnome-session/; system("killall -QUIT icewm") if /icewm/; open STDIN, "/dev/null"; open STDERR, ">&STDERR"; c::setsid(); exec qw(perl -e), q{ my $wm = shift; for (my $nb = 30; $nb && `pidof "$wm"` > 0; $nb--) { sleep 1 } system("killall X ; killall -15 xdm gdm kdm prefdm") unless `pidof "$wm"` > 0; }, $_; } $found = 1; last; } } $in->ask_warn('', _("Please log out and then use Ctrl-Alt-BackSpace")) unless $found; } else { $in->set_help('configureXxdm') unless $::isStandalone; my $run = exists $o->{xdm} ? $o->{xdm} : $::auto || $in->ask_yesorno(_("X at startup"), _("I can set up your computer to automatically start X upon booting. Would you like X to start when you reboot?"), 1); any::runlevel($prefix, $run ? 5 : 3) unless $::testing; } run_program::rooted($prefix, "chkconfig", "--del", "gpm") if $o->{mouse}{device} =~ /ttyS/ && !$::isStandalone; } } 1; id='n1412' href='#n1412'>1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441 1442 1443 1444 1445 1446 1447 1448 1449 1450 1451 1452 1453 1454 1455 1456 1457 1458 
package pkgs; # $Id$

use strict;

use MDK::Common::System;
use URPM;
use URPM::Resolve;
use URPM::Signature;
use common;
use install_any;
use run_program;
use detect_devices;
use log;
use fs;
use loopback;
use c;


our %preferred = map { $_ => undef } qw(lilo perl-base gstreamer-oss openjade ctags glibc curl sane-backends postfix mdkkdm gcc gcc-cpp gcc-c++ proftpd ghostscript-X vim-minimal kernel db1 db2 libxpm4 zlib1 libncurses5 harddrake cups apache);

#- lower bound on the left ( aka 90 means [90-100[ )
our %compssListDesc = (
   5 => N_("must have"),
   4 => N_("important"),
   3 => N_("very nice"),
   2 => N_("nice"),
   1 => N_("maybe"),
);

#- constant for small transaction.
our $limitMinTrans = 13;


#- package to ignore, typically in Application CD. OBSOLETED ?
my %ignoreBadPkg = (
		    'civctp-demo'   => 1,
		    'eus-demo'      => 1,
		    'myth2-demo'    => 1,
		    'heretic2-demo' => 1,
		    'heroes3-demo'  => 1,
		    'rt2-demo'      => 1,
		   );

sub packageMedium {
   my ($packages, $p) = @_; $p or die "invalid package from\n" . backtrace();
   foreach (values %{$packages->{mediums}}) {
       defined $_->{start} && defined $_->{end} or next;
       $p->id >= $_->{start} && $p->id <= $_->{end} and return $_;
   }
   return {};
}

sub cleanHeaders() {
    rm_rf("$::prefix/tmp/headers") if -e "$::prefix/tmp/headers";
}

#- get all headers from an hdlist file.
sub extractHeaders {
    my ($pkgs, $media) = @_;
    my %medium2pkgs;

    cleanHeaders();

    foreach (@$pkgs) {
	foreach my $medium (values %$media) {
	    $_->id >= $medium->{start} && $_->id <= $medium->{end} or next;
	    push @{$medium2pkgs{$medium->{medium}} ||= []}, $_;
	}
    }

    foreach (keys %medium2pkgs) {
	my $medium = $media->{$_};

	eval {
	    require packdrake;
	    my $packer = new packdrake("/tmp/$medium->{hdlist}", quiet => 1);
	    $packer->extract_archive("$::prefix/tmp/headers", map { $_->header_filename } @{$medium2pkgs{$_}});
	};
    }

    foreach (@$pkgs) {
	my $f = "$::prefix/tmp/headers/" . $_->header_filename;
	$_->update_header($f) or log::l("unable to open header file $f"), next;
	log::l("read header file $f");
    }
}

sub isSupplCDMedium($) {
    my ($medium) = @_;
    $medium->{method} eq 'cdrom' && $medium->{medium} =~ /^\d+s$/;
}

#- TODO BEFORE TODO
#- size and correction size functions for packages.
my $B = 1.20873;
my $C = 4.98663; #- does not take hdlist's into account as getAvailableSpace will do it.
sub correctSize { $B * $_[0] + $C }
sub invCorrectSize { ($_[0] - $C) / $B }

sub selectedSize {
    my ($packages) = @_;
    my $size = 0;
    my %skip;
    #- take care of packages selected...
    foreach (@{$packages->{depslist}}) {
	if ($_->flag_selected) {
	    $size += $_->size;
	    #- if a package is obsoleted with the same name it should
	    #- have been selected, so a selected new package obsoletes
	    #- all the old package.
	    exists $skip{$_->name} and next; $skip{$_->name} = undef;
	    $size -= $packages->{sizes}{$_->name};
	}
    }
    #- but remove size of package being obsoleted or removed.
    foreach (keys %{$packages->{state}{rejected}}) {
	my ($name) = /(.*)-[^\-]*-[^\-]*$/ or next;
	exists $skip{$name} and next; $skip{$name} = undef;
	$size -= $packages->{sizes}{$name};
    }
    $size;
}
sub correctedSelectedSize { correctSize(selectedSize($_[0]) / sqr(1024)) }

sub size2time {
    my ($x, $max) = @_;
    my $A = 7e-07;
    my $limit = min($max * 3 / 4, 9e8);
    if ($x < $limit) {
	$A * $x;
    } else { 
	$x -= $limit;
	my $B = 6e-16;
	my $C = 15e-07;
	$B * $x ** 2 + $C * $x + $A * $limit;
    }
}


sub packagesProviding {
    my ($packages, $name) = @_;
    map { $packages->{depslist}[$_] } keys %{$packages->{provides}{$name} || {}};
}

#- searching and grouping methods.
#- package is a reference to list that contains
#- a hash to search by name and
#- a list to search by id.
sub packageByName {
    my ($packages, $name) = @_;
    #- search package with given name and compatible with current architecture.
    #- take the best one found (most up-to-date).
    my @packages;
    foreach my $pkg (packagesProviding($packages, $name)) {
	$pkg->is_arch_compat or next;
	$pkg->name eq $name or next;
	push @packages, $pkg;
    }
    my $best;
    foreach (@packages) {
	if ($best && $best != $_) {
	    $_->compare_pkg($best) > 0 and $best = $_;
	} else {
	    $best = $_;
	}
    }
    $best or log::l("unknown package `$name'");
    $best;
}
sub packageById {
    my ($packages, $id) = @_;
    my $pkg = $packages->{depslist}[$id]; #- do not log as id unsupported are still in depslist.
    $pkg->is_arch_compat && $pkg;
}

sub analyse_kernel_name {
    my $kernels = join('|', map { "-$_" }
	'(p3|i586|i686)-(up|smp)-(1GB|4GB|64GB)', 
	qw(enterprise secure smp multimedia multimedia-smp xbox),
    );
    my @l = $_[0] =~ /kernel[^\-]*($kernels)?(-([^\-]+))?$/ or return;
    $l[0], $l[-1];
}

sub packages2kernels {
    my ($packages) = @_;

    map { 
	if (my ($ext, $version) = analyse_kernel_name($_->name)) {
	    { pkg => $_, ext => $ext, version => $version };
	} else {
	    log::l("ERROR: unknown package " . $_->name . " providing kernel");
	    ();
	}
    } packagesProviding($packages, 'kernel');
}

sub bestKernelPackage {
    my ($packages) = @_;

    my @kernels = packages2kernels($packages) or internal_error('no kernel available');
    my ($version_BOOT) = c::kernel_version() =~ /^(\d+\.\d+)/;
    if (my @l = grep { $_->{version} =~ /\Q$version_BOOT/ } @kernels) {
	#- favour versions corresponding to current BOOT version
	@kernels = @l;
    }
    my @prefered_exts = 
      is_xbox() ? '-xbox' :
      detect_devices::is_i586() ? '-i586-up-1GB' :
      !detect_devices::has_cpu_flag('pae') ? ('-i686-up-4GB', '-i586-up-1GB') :
      detect_devices::hasSMP() ? '-smp' : 
      '';
    foreach my $prefered_ext (@prefered_exts, '') {
	if (my @l = grep { $_->{ext} eq $prefered_ext } @kernels) {
	    @kernels = @l;
	}
    }
    
    log::l("bestKernelPackage (" . join(':', @prefered_exts) . "): " . join(' ', map { $_->{pkg}->name } @kernels) . (@kernels > 1 ? ' (choosing the first)' : ''));
    $preferred{'kernel-source-' . $kernels[0]{version}} = undef;
    $kernels[0]{pkg};
}

sub packagesOfMedium {
    my ($packages, $medium) = @_;
    defined $medium->{start} && defined $medium->{end} ? @{$packages->{depslist}}[$medium->{start} .. $medium->{end}] : ();
}
sub packagesToInstall {
    my ($packages) = @_;
    my @packages;
    foreach (values %{$packages->{mediums}}) {
	$_->{selected} or next;
	log::l("examining packagesToInstall of medium $_->{descr}");
	push @packages, grep { $_->flag_selected } packagesOfMedium($packages, $_);
    }
    log::l("found " . scalar(@packages) . " packages to install");
    @packages;
}

sub allMediums {
    my ($packages) = @_;
    sort {
	#- put supplementary media at the end
	my @x = ($a, $b);
	foreach (@x) { /(\d+)s/ and $_ = 100 + $1 }
	$x[0] <=> $x[1];
    } keys %{$packages->{mediums}};
}

sub mediumDescr {
    my ($packages, $medium_name) = @_;
    $packages->{mediums}{$medium_name}{descr};
}

sub packageRequest {
    my ($packages, $pkg) = @_;

    #- check if the same or better version is installed,
    #- do not select in such case.
    $pkg && ($pkg->flag_upgrade || !$pkg->flag_installed) or return;

    #- check for medium selection, if the medium has not been
    #- selected, the package cannot be selected.
    foreach (values %{$packages->{mediums}}) {
	!$_->{selected} && $pkg->id >= $_->{start} && $pkg->id <= $_->{end} and return;
    }

    return { $pkg->id => 1 };
}

sub packageCallbackChoices {
    my ($urpm, $_db, $state, $choices) = @_;
    if (my $prefer = find { $_->arch ne 'src' && exists $preferred{$_->name} } @$choices) {
	$prefer;
    } else {
	my @l = grep {
	    #- or even if a package requires a specific locales which
	    #- is already selected.
	    find {
		/locales-/ && do {
		    my $p = packageByName($urpm, $_);
		    $p && $p->flag_available;
		};
	    } $_->requires_nosense;
	} @$choices;
	if (!@l) {
	    push @l, $choices->[0];
	    log::l("packageCallbackChoices: default choice from ", join(",", map { $urpm->{depslist}[$_]->name } keys %{$state->{selected}}), " in ", join(",", map { $_->name } @$choices));
	}
	#-log::l("packageCallbackChoices: chosen " . join(" ", map { $_->name } @l));
	@l;
    }
}

#- selection, unselection of package.
sub selectPackage {
    my ($packages, $pkg, $b_base, $o_otherOnly) = @_;

    #- select package and dependancies, o_otherOnly may be a reference
    #- to a hash to indicate package that will strictly be selected
    #- when value is true, may be selected when value is false (this
    #- is only used for unselection, not selection)
    my $state = $packages->{state} ||= {};

    my @l = $packages->resolve_requested($packages->{rpmdb}, $state, packageRequest($packages, $pkg) || {},
					 callback_choices => \&packageCallbackChoices);

    if ($b_base || $o_otherOnly) {
	foreach (@l) {
	    $b_base and $_->set_flag_base;
	    $o_otherOnly and $o_otherOnly->{$_->id} = $_->flag_requested;
	}
	$o_otherOnly and $packages->disable_selected($packages->{rpmdb}, $state, @l);
    }
    1;
}

sub unselectPackage($$;$) {
    my ($packages, $pkg, $o_otherOnly) = @_;

    #- base package are not unselectable,
    #- and already unselected package are no more unselectable.
    $pkg->flag_base and return;
    $pkg->flag_selected or return;

    my $state = $packages->{state} ||= {};
    log::l("removing selection on package " . $pkg->fullname);
    my @l = $packages->disable_selected($packages->{rpmdb}, $state, $pkg);
    log::l("   removed selection on package " . $pkg->fullname . "gives " . join(',', map { scalar $_->fullname } @l));
    if ($o_otherOnly) {
	foreach (@l) {
	    $o_otherOnly->{$_->id} = undef;
	}
	log::l("   reselecting removed selection...");
	$packages->resolve_requested($packages->{rpmdb}, $state, $o_otherOnly, callback_choices => \&packageCallbackChoices);
	log::l("   done");
    }
    1;
}
sub setPackageSelection($$$) {
    my ($packages, $pkg, $value) = @_;
    $value ? selectPackage($packages, $pkg) : unselectPackage($packages, $pkg);
}

sub unselectAllPackages($) {
    my ($packages) = @_;
    my %keep_selected;
    log::l("unselecting all packages...");
    foreach (@{$packages->{depslist}}) {
	if ($_->flag_base || $_->flag_installed && $_->flag_selected) {
	    #- keep track of package that should be kept selected.
	    $keep_selected{$_->id} = $_;
	    log::l("...keeping " . $_->fullname);
	} else {
	    #- deselect all packages except base or packages that need to be upgraded.
	    $_->set_flag_required(0);
	    $_->set_flag_requested(0);
	}
    }
    #- clean staten, in order to start with a brand new set...
    $packages->{state} = {};
    $packages->resolve_requested($packages->{rpmdb}, $packages->{state}, \%keep_selected,
				 callback_choices => \&packageCallbackChoices);
}

sub urpmidir() {
    my $v = "$::prefix/var/lib/urpmi";
    -l $v && !-e _ and unlink $v and mkdir $v, 0755; #- dangling symlink
    -w $v ? $v : '/tmp';
}

sub psUpdateHdlistsDeps {
    my ($packages) = @_;
    my $need_copy = 0;
    my $urpmidir = urpmidir();

    #- check if current configuration is still up-to-date and do not need to be updated.
    foreach (values %{$packages->{mediums}}) {
	$_->{selected} || $_->{ignored} or next;
	my $hdlistf = "$urpmidir/hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2");
	my $synthesisf = "$urpmidir/synthesis.hdlist.$_->{fakemedium}.cz" . ($_->{hdlist} =~ /\.cz2/ && "2");
	if (-s $hdlistf != $_->{hdlist_size}) {
	    install_any::getAndSaveFile("media/media_info/$_->{hdlist}", $hdlistf) or die "no $_->{hdlist} found";
	    symlinkf $hdlistf, "/tmp/$_->{hdlist}";
	    ++$need_copy;
	    chown 0, 0, $hdlistf;
	}
	if (-s $synthesisf != $_->{synthesis_hdlist_size}) {
	    install_any::getAndSaveFile("media/media_info/synthesis.$_->{hdlist}", $synthesisf);
	    if (-s $synthesisf > 0) { chown 0, 0, $synthesisf } else { unlink $synthesisf }
	}
    }

    if ($need_copy) {
	#- this is necessary for urpmi.
	install_any::getAndSaveFile("media/media_info/$_", "$urpmidir/$_") && chown 0, 0, "$urpmidir/$_" foreach qw(rpmsrate);
    }
}

sub psUsingHdlists {
    my ($o, $method, $o_hdlistsprefix, $o_packages, $o_initialmedium, $o_callback) = @_;
    my $is_ftp = $o_hdlistsprefix =~ /^ftp:/;
    my $listf = install_any::getFile($o_hdlistsprefix && !$is_ftp ? "$o_hdlistsprefix/media/media_info/hdlists" : 'media/media_info/hdlists')
	or die "no hdlists found";
    my ($suppl_CDs, $deselectionAllowed) = ($o->{supplmedia} || 0, $o->{askmedia} || 0);
    if (!$o_packages) {
	$o_packages = new URPM;
	#- add additional fields used by DrakX.
	@$o_packages{qw(count mediums)} = (0, {});
    }

    #- parse hdlists file.
    my $medium_name = $o_initialmedium || 1;
    my (@hdlists, %mediumsize);
    foreach (<$listf>) {
	chomp;
	s/\s*#.*$//;
	/^\s*$/ and next;
	#- we'll ask afterwards for supplementary CDs, if the hdlists file contains
	#- a line that begins with "suppl"
	if (/^suppl/) { $suppl_CDs = 1; next }
	#- if the hdlists contains a line "askmedia", deletion of media found
	#- in this hdlist is allowed
	if (/^askmedia/) { $deselectionAllowed = 1; next }
	my $cdsuppl = index($medium_name, 's') >= 0;
	my ($noauto, $hdlist, $rpmsdir, $descr, $size) = m/^\s*(noauto:)?(hdlist\S*\.cz2?)\s+(\S+)\s*([^(]*)(\(.+\))?$/
	    or die qq(invalid hdlist description "$_" in hdlists file);
	$descr =~ s/\s+$//;
	push @hdlists, [ $hdlist, $medium_name, $rpmsdir, $descr, !$noauto, 
	    #- hdlist path, suppl CDs are mounted on /mnt/cdrom :
	    $o_hdlistsprefix ? ($is_ftp ? "media/media_info/$hdlist" : "$o_hdlistsprefix/media/media_info/$hdlist") : undef,
	];
	if ($size) {
	    ($mediumsize{$hdlist}) = $size =~ /(\d+)/; #- XXX assume Mo
	} else {
	    $mediumsize{$hdlist} = 0;
	}
	$cdsuppl ? ($medium_name = ($medium_name + 1) . 's') : ++$medium_name;
    }
    my $copy_rpms_on_disk = 0;
    if ($deselectionAllowed && !defined $o_initialmedium) {
	(my $finalhdlists, $copy_rpms_on_disk) = $o->deselectFoundMedia(\@hdlists, \%mediumsize);
	@hdlists = @$finalhdlists;
    }

    foreach my $h (@hdlists) {
	#- make sure the first medium is always selected!
	#- by default select all image.
	my $supplmedium = psUsingHdlist($method, $o_packages, @$h);
	$o_callback and $o_callback->($supplmedium, $o_hdlistsprefix, $method);
    }

    log::l("psUsingHdlists read " . int(@{$o_packages->{depslist}}) .
	   " headers on " . int(keys %{$o_packages->{mediums}}) . " hdlists");

    return $o_packages, $suppl_CDs, $copy_rpms_on_disk;
}

sub psUsingHdlist {
    my ($method, $packages, $hdlist, $medium_name, $rpmsdir, $descr, $selected, $o_fhdlist, $o_pubkey, $o_nocopy) = @_;
    my $fakemedium = "$descr ($method$medium_name)";
    my $urpmidir = urpmidir();
    log::l("trying to read $hdlist for medium $medium_name");

    my $m = { hdlist     => $hdlist,
	      method     => $method,
	      medium     => $medium_name,
	      rpmsdir    => $rpmsdir, #- where is RPMS directory.
	      descr      => $descr,
	      fakemedium => $fakemedium,
	      selected   => $selected, #- default value is only CD1, it is really the minimal.
	      ignored    => !$selected, #- keep track of ignored medium by DrakX.
	      pubkey     => [], #- all pubkey block here
	    };

    #- copy hdlist file directly to urpmi directory, this will be used
    #- for getting header of package during installation or after by urpmi.
    my $newf = "$urpmidir/hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2");
    unless ($o_nocopy) {
	my $w_wait;
	$w_wait = $::o->wait_message(N("Please wait"), N("Downloading file %s...", $hdlist)) if $::o->{method} =~ /^(?:ftp|http|nfs)$/;
	-e $newf and do { unlink $newf or die "cannot remove $newf: $!" };
	install_any::getAndSaveFile($o_fhdlist || "media/media_info/$hdlist", $newf) or do { unlink $newf; die "no $hdlist found" };
	$m->{hdlist_size} = -s $newf; #- keep track of size for post-check.
	symlinkf $newf, "/tmp/$hdlist";
	undef $w_wait;
    }

    my $newsf = "$urpmidir/synthesis.hdlist.$fakemedium.cz" . ($hdlist =~ /\.cz2/ && "2");
    #- if $o_fhdlist is a filehandle, it's preferable not to try to find the associated synthesis.
    if (!$o_nocopy && !ref $o_fhdlist) {
	#- copy existing synthesis file too.
	my $synth;
	if ($o_fhdlist) {
	    $synth = $o_fhdlist;
	    $synth =~ s/hdlist/synthesis.hdlist/ or $synth = undef;
	}
	$synth ||= "media/media_info/synthesis.$hdlist";
	install_any::getAndSaveFile($synth, $newsf);
	$m->{synthesis_hdlist_size} = -s $newsf; #- keep track of size for post-check.
	-s $newsf > 0 or unlink $newsf;
    }

    chown 0, 0, $newf, $newsf;

    #- get all keys corresponding in the right pubkey file,
    #- they will be added in rpmdb later if not found.
    if (!$o_fhdlist || $o_pubkey) {
	$m->{pubkey} = $o_pubkey;
	unless ($m->{pubkey}) {
	    my $pubkey = install_any::getFile("media/media_info/pubkey" . ($hdlist =~ /hdlist(\S*)\.cz2?/ && $1));
	    $m->{pubkey} = [ $packages->parse_armored_file($pubkey) ];
	}
    }

    #- integrate medium in media list, only here to avoid download error (update) to be propagated.
    $packages->{mediums}{$medium_name} = $m;

    #- parse synthesis (if available) of directly hdlist (with packing).
    if ($m->{ignored}) {
	log::l("ignoring packages in $hdlist");
    } else {
	my $nb_suppl_pkg_skipped = 0;
	my $callback = sub {
	    my (undef, $p) = @_;
	    our %uniq_pkg_seen;
	    if ($uniq_pkg_seen{$p->fullname}++) {
		log::l("skipping " . scalar $p->fullname);
		++$nb_suppl_pkg_skipped;
		return 0;
	    } else {
		return 1;
	    }
	};
	if (-s $newsf) {
	    ($m->{start}, $m->{end}) = $packages->parse_synthesis($newsf, callback => $callback);
	} elsif (-s $newf) {
	    ($m->{start}, $m->{end}) = $packages->parse_hdlist($newf, callback => $callback);
	} else {
	    delete $packages->{mediums}{$medium_name};
	    unlink $newf;
	    $o_fhdlist or unlink $newsf;
	    die "fatal: no hdlist nor synthesis to read for $fakemedium";
	}
	$m->{start} > $m->{end} and do { delete $packages->{mediums}{$medium_name};
					 unlink $newf;
					 $o_fhdlist or unlink $newsf;
					 die "fatal: nothing read in hdlist or synthesis for $fakemedium" };
	log::l("read " . ($m->{end} - $m->{start} + 1) . " packages in $hdlist, $nb_suppl_pkg_skipped skipped");
    }
    $m;
}

sub read_rpmsrate_raw {
    my ($f) = @_;
    my $line_nb = 0;
    my $fatal_error;
    my (%flags, %rates, @need_to_copy);
    my (@l);
    local $_;
    while (<$f>) {
	$line_nb++;
	/\t/ and die "tabulations not allowed at line $line_nb\n";
	s/#.*//; # comments

	my ($indent, $data) = /(\s*)(.*)/;
	next if !$data; # skip empty lines

	@l = grep { $_->[0] < length $indent } @l;

	my @m = @l ? @{$l[-1][1]} : ();
	my ($t, $flag, @l2);
	while ($data =~ 
	       /^((
                   [1-5]
                   |
                   (?:            (?: !\s*)? [0-9A-Z_]+(?:".*?")?)
                   (?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)*
                  )
                  (?:\s+|$)
                 )(.*)/x) { #@")) {
	    ($t, $flag, $data) = ($1,$2,$3);
	    while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
	    push @m, $flag;
	    push @l2, [ length $indent, [ @m ] ];
	    $indent .= $t;
	}
	if ($data) {
	    # has packages on same line
	    my ($rates, $flags) = partition { /^\d$/ } @m;
	    my ($rate) = @$rates or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
	    foreach my $name (split ' ', $data) {
		if (member('INSTALL', @$flags)) {
		    push @need_to_copy, $name if !member('NOCOPY', @$flags);
		    next;    #- do not need to put INSTALL flag for a package.
		}
		if (member('PRINTER', @$flags)) {
		    push @need_to_copy, $name;
		}
		my @new_flags = @$flags;
		if (my $previous = $flags{$name}) {
		    my @common = intersection($flags, $previous);
		    my @diff1 = difference2($flags, \@common);
		    my @diff2 = difference2($previous, \@common);
		    if (!@diff1 || !@diff2) {
			@new_flags = @common;
		    } elsif (@diff1 == 1 && @diff2 == 1) {
			@new_flags = (@common, join('||', $diff1[0], $diff2[0]));
		    } else {
			log::l("can not handle complicate flags for packages appearing twice ($name)");
			$fatal_error++;
		    }
		    log::l("package $name appearing twice with different rates ($rate != " . $rates{$name} . ")") if $rate != $rates{$name};
		}
		$rates{$name} = $rate;
		$flags{$name} = \@new_flags;
	    }
	    push @l, @l2;
	} else {
	    push @l, [ $l2[0][0], $l2[-1][1] ];
	}
    }
    $fatal_error and die "$fatal_error fatal errors in rpmsrate";
    \%rates, \%flags, \@need_to_copy;
}

sub read_rpmsrate {
    my ($packages, $rpmsrate_flags_chosen, $f) = @_;

    my ($rates, $flags, $need_to_copy) = read_rpmsrate_raw($f);
    
    foreach (keys %$flags) {
	my $p = packageByName($packages, $_) or next;
	my @flags = (@{$flags->{$_}}, map { if_(/locales-(.*)/, qq(LOCALES"$1")) } $p->requires_nosense);

	@flags = map {
	    my ($user_flags, $known_flags) = partition { /^!?CAT_/ } split('\|\|', $_);
	    my $ok = find {
		my $inv = s/^!//;
		$inv xor do {
		    if (my ($p) = /^HW"(.*)"/) {
			detect_devices::matching_desc__regexp($p);
		    } elsif (($p) = /^DRIVER"(.*)"/) {
			detect_devices::matching_driver__regexp($p);
		    } elsif (($p) = /^TYPE"(.*)"/) {
			detect_devices::matching_type($p);
		    } else {
			$rpmsrate_flags_chosen->{$_};
		    }
		};
	    } @$known_flags;
	    $ok ? 'TRUE' : @$user_flags ? join('||', @$user_flags) : 'FALSE';
	} @flags;

	$p->set_rate($rates->{$_});
	$p->set_rflags(member('FALSE', @flags) ? 'FALSE' : @flags);
    }
    $packages->{needToCopy} = $need_to_copy;
}

sub readCompssUsers {
    my ($file) = @_;

    my $f = -e $file ? install_any::getLocalFile($file) : install_any::getFile($file)
	or do { log::l("can not find $file: $!"); return (undef, undef) };
    my ($compssUsers, $gtk_display_compssUsers) = eval join('', <$f>);
    if ($@) {
	log::l("ERROR: bad $file: $@");
    } else {
	log::l("compssUsers.pl got: ", join(', ', map { qq("$_->{path}|$_->{label}") } @$compssUsers));
    }
    ($compssUsers, $gtk_display_compssUsers);
}

sub saveCompssUsers {
    my ($packages, $compssUsers) = @_;
    my $flat;
    foreach (@$compssUsers) {
	my %fl = map { ("CAT_$_" => 1) } @{$_->{flags}};
	$flat .= "$_->{label} [icon=xxx] [path=$_->{path}]\n";
	foreach my $p (@{$packages->{depslist}}) {
	    my @flags = $p->rflags;
	    if ($p->rate && any { any { !/^!/ && $fl{$_} } split('\|\|') } @flags) {
		$flat .= sprintf "\t%d %s\n", $p->rate, $p->name;
	    }
	}
    }
    my $urpmidir = urpmidir();
    output "$urpmidir/compssUsers.flat", $flat;
}

sub setSelectedFromCompssList {
    my ($packages, $rpmsrate_flags_chosen, $min_level, $max_size) = @_;
    $rpmsrate_flags_chosen->{TRUE} = 1; #- ensure TRUE is set
    my $nb = selectedSize($packages);
    foreach my $p (sort { $b->rate <=> $a->rate } @{$packages->{depslist}}) {
	my @flags = $p->rflags;
	next if 
	  !$p->rate || $p->rate < $min_level || 
	  any { !any { /^!(.*)/ ? !$rpmsrate_flags_chosen->{$1} : $rpmsrate_flags_chosen->{$_} } split('\|\|') } @flags;

	#- determine the packages that will be selected when
	#- selecting $p. the packages are not selected.
	my $state = $packages->{state} ||= {};

	my @l = $packages->resolve_requested($packages->{rpmdb}, $state, packageRequest($packages, $p) || {},
					     callback_choices => \&packageCallbackChoices);

	#- this enable an incremental total size.
	my $old_nb = $nb;
	foreach (@l) {
	    $nb += $_->size;
	}
	if ($max_size && $nb > $max_size) {
	    $nb = $old_nb;
	    $min_level = $p->rate;
	    $packages->disable_selected($packages->{rpmdb}, $state, @l);
	    last;
	}
    }
    my @flags = map_each { if_($::b, $::a) } %$rpmsrate_flags_chosen;
    log::l("setSelectedFromCompssList: reached size ", formatXiB($nb), ", up to indice $min_level (less than ", formatXiB($max_size), ") for flags ", join(' ', sort @flags));
    log::l("setSelectedFromCompssList: ", join(" ", sort map { $_->name } grep { $_->flag_selected } @{$packages->{depslist}}));
    $min_level;
}

#- usefull to know the size it would take for a given min_level/max_size
#- just saves the selected packages, call setSelectedFromCompssList and restores the selected packages
sub saveSelected {
    my ($packages) = @_;
    my $state = delete $packages->{state};
    my @l = @{$packages->{depslist}};
    my @flags = map { ($_->flag_requested && 1) + ($_->flag_required && 2) + ($_->flag_upgrade && 4) } @l;
    [ $packages, $state, \@l, \@flags ];
}
sub restoreSelected {
    my ($packages, $state, $l, $flags) = @{$_[0]};
    $packages->{state} = $state;
    mapn { my ($pkg, $flag) = @_;
	   $pkg->set_flag_requested($flag & 1);
	   $pkg->set_flag_required($flag & 2);
	   $pkg->set_flag_upgrade($flag & 4);
         } $l, $flags;
}

sub computeGroupSize {
    my ($packages, $min_level) = @_;

    sub inside {
	my ($l1, $l2) = @_;
	my $i = 0;
	return if @$l1 > @$l2;
	foreach (@$l1) {
	    my $c;
	    while ($c = $l2->[$i++] cmp $_) {
		return if $c == 1 || $i > @$l2;
	    }
	}
	1;
    }

    sub or_ify {
	my ($first, @other) = @_;
	my @l = split('\|\|', $first);
	foreach (@other) {
	    @l = map {
		my $n = $_;
		map { "$_&&$n" } @l;
	    } split('\|\|');
	}
	@l;
    }
    my %or_ify_cache;
    my $or_ify_cached = sub {
	$or_ify_cache{$_[0]} ||= join("\t", or_ify(split("\t", $_[0])));
    };
    sub or_clean {
	my ($flags) = @_;
	my @l = split("\t", $flags);
	@l = map { [ sort split('&&') ] } @l;
	my @r;
	B: while (@l) {
	    my $e = shift @l;
	    foreach (@r, @l) {
		inside($_, $e) and next B;
	    }
	    push @r, $e;
	}
	join("\t", map { join('&&', @$_) } @r);
    }
    my (%group, %memo, $slowpart_counter);

    log::l("pkgs::computeGroupSize");
    my $time = time();

    my %pkgs_with_same_rflags;
    foreach (@{$packages->{depslist}}) {
	next if !$_->rate || $_->rate < $min_level || $_->flag_available;
	my $flags = join("\t", $_->rflags);
	next if $flags eq 'FALSE';
	push @{$pkgs_with_same_rflags{$flags}}, $_;
    }

    foreach my $raw_flags (keys %pkgs_with_same_rflags) {
	my $flags = $or_ify_cached->($raw_flags);
	my @pkgs = @{$pkgs_with_same_rflags{$raw_flags}};
  
	#- determine the packages that will be selected when selecting $p.
	#- make a fast selection (but potentially erroneous).
	#- installed and upgrade flags must have been computed (see compute_installed_flags).
	my %newSelection;
			 
	my @l2 = map { $_->id } @pkgs;
	my $id;

	    while (defined($id = shift @l2)) {
		exists $newSelection{$id} and next;
		$newSelection{$id} = undef;

		my $pkg = $packages->{depslist}[$id];
		foreach ($pkg->requires_nosense) {
		    my @choices = keys %{$packages->{provides}{$_} || {}};
		    if (@choices <= 1) {
			push @l2, @choices;
		    } elsif (! find { exists $newSelection{$_} } @choices) {
			my ($candidate_id, $prefer_id);
			foreach (@choices) {
			    ++$slowpart_counter;
			    my $ppkg = $packages->{depslist}[$_] or next;
			    $ppkg->flag_available and $prefer_id = $candidate_id = undef, last;
			    exists $preferred{$ppkg->name} and $prefer_id = $_;
			    $ppkg->name =~ /kernel-\d/ and $prefer_id ||= $_;
			    foreach my $l ($ppkg->requires_nosense) {
				/locales-/ or next;
				my $pppkg = packageByName($packages, $l) or next;
				$pppkg->flag_available and $prefer_id ||= $_;
			    }
			    $candidate_id = $_;
			}
			if (defined $prefer_id || defined $candidate_id) {
			    push @l2, defined $prefer_id ? $prefer_id : $candidate_id;
			}
		    }
		}
	    }

	foreach (keys %newSelection) {
	    my $p = $packages->{depslist}[$_] or next;
	    next if $p->flag_selected; #- always installed (accounted in system_size)
	    my $s = $group{$p->name} || $or_ify_cached->(join("\t", $p->rflags));
	    my $m = "$flags\t$s";
	    $group{$p->name} = ($memo{$m} ||= or_clean($m));
	}
    }
    my (%sizes, %pkgs);
    while (my ($k, $v) = each %group) {
	my $pkg = packageByName($packages, $k) or next;
	push @{$pkgs{$v}}, $k;
	$sizes{$v} += $pkg->size - $packages->{sizes}{$pkg->name};
    }
    log::l("pkgs::computeGroupSize took: ", formatTimeRaw(time() - $time));
    log::l(sprintf "%s %dMB %s", $_, $sizes{$_} / sqr(1024), join(',', @{$pkgs{$_}})) foreach keys %sizes;
    \%sizes, \%pkgs;
}


sub openInstallLog() {

    my $f = "$::prefix/root/drakx/install.log";
    open(my $LOG, ">> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept."); #-#