diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/Xconfigurator.pm | 149 | ||||
| -rw-r--r-- | perl-install/Xconfigurator_consts.pm | 8 | ||||
| -rw-r--r-- | perl-install/install2.pm | 4 | ||||
| -rw-r--r-- | perl-install/install_steps_interactive.pm | 128 | ||||
| -rw-r--r-- | perl-install/interactive_gtk.pm | 2 | ||||
| -rw-r--r-- | perl-install/my_gtk.pm | 42 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 6 | ||||
| -rw-r--r-- | perl-install/resize_fat/main.pm | 4 |
8 files changed, 281 insertions, 62 deletions
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index 8b5f151b7..f9f84bdbf 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -2,15 +2,16 @@ package Xconfigurator; use diagnostics; use strict; -use vars qw($in $resolution_wanted @depths @resolutions @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate @vsync_range %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); +use vars qw($in $install $resolution_wanted @depths @resolutions @accelservers @allservers %videomemory @ramdac_name @ramdac_id @clockchip_name @clockchip_id %keymap_translate @vsync_range %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); use pci_probing::main; use common qw(:common :file); -use interactive_gtk; use log; use Xconfigurator_consts; +my $tmpconfig = "/tmp/Xconfig"; + 1; sub setVirtual($) { @@ -52,7 +53,7 @@ sub readCardsDB { add2hash($card, $c); }, CHIPSET => sub { $card->{chipset} = $val; - $card->{flags}->{needVideoRam} if member($val, qw(RIVA128)); + $card->{flags}->{needVideoRam} = 1 if member($val, qw(mgag10 mgag200 RIVA128)); }, SERVER => sub { $card->{server} = $val; }, RAMDAC => sub { $card->{ramdac} = $val; }, @@ -148,6 +149,27 @@ sub cardConfiguration(;$) { add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server}; add2hash($card, $cards{$card->{type}}) if $card->{type}; add2hash($card, { vendor => "Unknown", board => "Unknown" }); + + $card->{prog} = "/usr/X11R6/bin/XF86_$card->{server}"; + + -x $card->{prog} or !defined $install or &$install($card->{server}); + -x $card->{prog} or die "server $card->{server} is not available (should be in $card->{prog})"; + + unless ($::testing) { + unlink("/etc/X11/X"); + symlink("../../$card->{prog}", "/etc/X11/X"); + } + + unless ($card->{type}) { + $card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64)); + } + + $card->{flags}->{needVideoRam} and + $card->{memory} ||= + $videomemory{$in->ask_from_list_('', + _("Give your graphic card memory size"), + [ sort { $videomemory{$a} <=> $videomemory{$b} } + keys %videomemory])}; $card; } @@ -166,22 +188,56 @@ sub testConfig($) { my ($o) = @_; my ($resolutions, $clocklines); - write_XF86Config($o, "/tmp/Xconfig"); + write_XF86Config($o, $tmpconfig); local *F; - open F, "/etc/X11/X :9 -probeonly -pn -xf86config /tmp/Xconfig 2>&1 |"; + open F, "$o->{card}->{prog} :9 -probeonly -pn -xf86config $tmpconfig 2>&1 |"; foreach (<F>) { #$videomemory = $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) = @_; + + write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config"); + + my $pid; unless ($pid = fork) { + my @l = "X"; + @l = ($o->{card}->{prog}, "-xf86config", $tmpconfig) if $::testing; + exec @l, ":9" or exit 1; + } + do { sleep 1; } until (c::Xtest(':0')); + + local *F; + open F, "|perl" 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_mousecursor(2); + gtkset_background(200, 210, 210); + 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; + exit !interactive_gtk->new->ask_yesorno('', _("It this ok?")); + }; + my $rc = close F; + kill 2, $pid; + + $rc; +} + sub autoResolutions($) { my ($o) = @_; my $card = $o->{card}; @@ -193,11 +249,11 @@ sub autoResolutions($) { # Configure the modes order. my ($ok, $best); - foreach (@depths) { + foreach (reverse @depths) { local $card->{default_depth} = $_; my ($resolutions, $clocklines) = eval { testConfig($o) }; - if ($@) { + if ($@ || !$resolutions) { delete $card->{depth}->{$_}; } else { $card->{clocklines} ||= $clocklines unless $card->{flags}->{noclockprobe}; @@ -207,30 +263,20 @@ sub autoResolutions($) { my ($b) = sort { $b->[0] <=> $a->[0] } @$resolutions; # require $resolution_wanted, no matter what bpp this requires - $best = $_ if $b->[0] >= $hres_wanted; + $card->{default_depth} = $_, last if $b->[0] >= $hres_wanted; } } $ok or die "no valid modes"; - - $card->{default_depth} = $best; } -sub moreCardConfiguration { - my ($o) = @_; +sub resolutionsConfiguration { + my ($o, $manual) = @_; my $card = $o->{card}; - $card->{vendor} ||= "Unknown"; - $card->{model} ||= "Unknown"; - - unless ($card->{type}) { - $card->{flags}->{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64)); - } - - my $manual; # some of these guys hate to be poked # if we dont know then its at the user's discretion - #my $manual = + #my $manual ||= # $card->{server} =~ /^(TGA|Mach32)/ || # $card->{name} =~ /^Riva 128/ || # $card->{chipset} =~ /^(RIVA128|mgag)/ || @@ -253,25 +299,24 @@ sub moreCardConfiguration { #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("), # _("Do you want to try?") ]); - $card->{flags}->{needVideoRam} and - $card->{memory} ||= - $videomemory{$in->ask_from_list_('', - _("Give your graphic card memory size"), - [ sort { $videomemory{$a} <=> $videomemory{$b} } - keys %videomemory])}; + findLegalModes($card); - findLegalModes($o->{card}); - - unless ($manual || $::expert) { + unless ($manual || $::expert || !$in->ask_okcancel(_("Automatic resolutions"), +_("I can try to find the available resolutions (eg: 800x600). +Alas it can freeze sometimes +Do you want to try?"))) { # swith to virtual console 1 (hopefully not X :) my $vt = setVirtual(1); - - autoMemoryAndClocksline($o); autoResolutions($o); - # restore the virtual console setVirtual($vt); } + my %l; + foreach ($card->{depth}) + + ask_from_list(_("Resolution"), + _("Choose resolution and color depth"), + [ ]); } @@ -421,11 +466,13 @@ sub XF86check_link { } } + # * Program entry point. sub main { - my ($default, $interact) = @_; + my ($default, $interact, $install_pkg) = @_; my $o = $default; $in = $interact; + $install = $install_pkg; $o->{resolution_wanted} ||= $resolution_wanted; @@ -433,29 +480,27 @@ sub main { $o->{card} = cardConfiguration($o->{card}); - unless ($::testing) { - my $prog = "/usr/X11R6/bin/XF86_$o->{card}->{server}"; - -x $prog or die "server $o->{card}->{server} is not available (should be in $prog)"; - unlink("/etc/X11/X"); - symlink("../../$prog", "/etc/X11/X"); - } - $o->{monitor} = monitorConfiguration($o->{monitor}); - moreCardConfiguration($o); + resolutionsConfiguration($o); + + my $ok = testFinalConfig($o); + my $quit; - write_XF86Config($o, "/tmp/Xconfig"); + until ($ok || $quit) { - unless (fork) { - exec "X", ":9" or exit 1; + my %c = my @c = ( + __("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() }, + __("Change Graphic card") => sub { $o->{card} = cardConfiguration() }, + __("Change Resolution") => sub { resolutionsConfiguration($o, 1) }, + __("Test again") => sub { $ok = testFinalConfig($o) }, + __("Quit") => sub { $quit = 1 }, + ); + &{$c{$in->ask_from_list_('', + _("What do you want to do?"), + [ grep { !ref } @c ])}}; } - { - local $ENV{DISPLAY} = ":9"; - my $w = interactive_gtk->new; - $w->ask_yesorno("Do you see this message"); - } - # Success - rewriteInittab(rc & STARTX ? 5 : 3); +# rewriteInittab($rc ? 3 : 5) unless $::testing; } diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm index 976f65d9e..841704332 100644 --- a/perl-install/Xconfigurator_consts.pm +++ b/perl-install/Xconfigurator_consts.pm @@ -6,6 +6,14 @@ use common qw(:common); @depths = qw(8 15 16 24 32); +%depths_text = ( + __("256 colors") => 8, + __("32 thousand colors") => 15, + __("65 thousand colors") => 16, + __("16 millions of colors") => 24, + __("4 billions of colors") => 32, +); + $resolution_wanted = "1024x768"; @resolutions = qw(640x480 800x600 1024x768 1152x864 1280x1024 1600x1200); diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 13b587060..3c70564df 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -178,10 +178,6 @@ sub formatPartitions { } sub findInstallFiles { - log::l("reading /usr/lib/rpm/rpmrc"); - c::rpmReadConfigFiles() or die "can't read rpm config files"; - log::l("\tdone"); - $o->{packages} = pkgs::psUsingDirectory(); pkgs::getDeps($o->{packages}); diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm new file mode 100644 index 000000000..f3fabc985 --- /dev/null +++ b/perl-install/install_steps_interactive.pm @@ -0,0 +1,128 @@ +package install_steps_interactive; + +# heritate from this class and you'll get all made interactivity for same steps. +# for this you need to provide +# - ask_from_listW(o, title, messages, arrayref, default) returns one string of arrayref +# - ask_many_from_listW(o, title, messages, arrayref, arrayref2) returns one string of arrayref +# +# where +# - o is the object +# - title is a string +# - messages is an refarray of strings +# - default is an optional string (default is in arrayref) +# - arrayref is an arrayref of strings +# - arrayref2 contains booleans telling the default state, +# +# ask_from_list and ask_from_list_ are wrappers around ask_from_biglist and ask_from_smalllist +# +# ask_from_list_ just translate arrayref before calling ask_from_list and untranslate the result +# +# ask_from_listW should handle differently small lists and big ones. + + +use diagnostics; +use strict; +use vars qw(@ISA); + +@ISA = qw(install_steps); + +use common qw(:common); +use partition_table qw(:types); +use install_steps; +use lang; +use log; + +1; + +sub errorInStep($$) { + my ($o, $err) = @_; + $o->ask_warn(_("Error"), [ _("An error occured"), $err ]); +} + +=cut +sub chooseLanguage($) { + my ($o) = @_; + lang::text2lang($o->ask_from_list("Language", + __("Which language do you want?"), # the translation may be used for the help + [ lang::list() ])); +} + +sub selectInstallOrUpgrade($) { + my ($o) = @_; + $o->ask_from_list_(_("Install/Upgrade"), + _("Is it an install or an updgrade?"), + [ __("Install"), __("Upgrade") ], + "Install") eq "Upgrade"; +} + +sub selectInstallClass($@) { + my ($o, @classes) = @_; + $o->ask_from_list_(_("Install Class"), + _("What type of user will you have?"), + [ @classes ]); +} + +sub rebootNeeded($) { + my ($o) = @_; + $o->ask_warn('', _("You need to reboot for the partition table modifications to take place")); + $o->SUPER::rebootNeeded; +} + +sub choosePartitionsToFormat($$) { + my ($o, $fstab) = @_; + my @l = grep { $_->{mntpoint} && (isExt2($_) || isSwap($_)) } @$fstab; + my @r = $o->ask_many_from_list('', _("Choose the partitions you want to format"), + [ map { $_->{mntpoint} } @l ], + [ map { $_->{notFormatted} } @l ]); + for (my $i = 0; $i < @l; $i++) { + $l[$i]->{toFormat} = $r[$i]; + } +} + +sub installPackages { + my $o = shift; + + my $old = \&log::ld; + local *log::ld = sub { + my $m = shift; + if ($m =~ /^starting installing/) { + my $name = first($_[0] =~ m|([^/]*)-.+?-|); + print("installing package $name"); + } else { goto $old } + }; + $o->SUPER::installPackages(@_); +} + +sub createBootdisk($) { + my ($o) = @_; + + $o->SUPER::createBootdisk if + $o->{default}->{mkbootdisk} = $o->ask_yesorno('', + _("A custom bootdisk provides a way of booting into your Linux system without +depending on the normal bootloader. This is useful if you don't want to install +lilo on your system, or another operating system removes lilo, or lilo doesn't +work with your hardware configuration. A custom bootdisk can also be used with +the Mandrake rescue image, making it much easier to recover from severe system +failures. Would you like to create a bootdisk for your system?")); +} + +sub setupBootloader($) { + my ($o) = @_; + + my $where = $o->ask_from_list(_("Lilo Installation"), _("Where do you want to install the bootloader?"), [ _("First sector of drive"), _("First sector of boot partition") ]); + $o->{default}->{bootloader}->{onmbr} = $where eq _("First sector of drive"); + + $o->SUPER::setupBootloader; +} +=cut +sub exitInstall { + my ($o) = @_; + $o->ask_warn('', +_"Congratulations, installation is complete. +Remove the boot media and press return to reboot. +For information on fixes which are available for this release of Linux Mandrake, +consult the Errata available from http://www.linux-mandrake.com/. +Information on configuring your system is available in the post +install chapter of the Official Linux Mandrake User's Guide."); +} + diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 935766470..e83e161cb 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -20,7 +20,7 @@ sub ask_from_listW { my $f = sub { $w->{retval} = $_[1]; Gtk->main_quit }; gtkadd($w->{window}, gtkpack(create_box_with_title($o, @$messages), - gtkadd(create_hbox(), + gtkadd((@$l < 3 ? create_hbox() : create_vbox()), map { my $b = new Gtk::Button($_); $b->signal_connect(clicked => [ $f, $_ ]); diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index ff34324b0..ebce6f49d 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -6,8 +6,8 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK); @ISA = qw(Exporter); %EXPORT_TAGS = ( - helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment create_box_with_title) ], - wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy) ], + helpers => [ qw(create_okcancel createScrolledWindow create_menu create_notebook create_packtable create_hbox create_vbox create_adjustment create_box_with_title) ], + wrappers => [ qw(gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkset_active gtkshow gtkdestroy gtkset_mousecursor gtkset_background) ], ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ) ], ); $EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ]; @@ -118,6 +118,33 @@ sub gtkadd($@) { $w } +sub gtkset_mousecursor($) { + my ($type) = @_; + Gtk->init; + + my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW); + $root->set_cursor(Gtk::Gdk::Cursor->new($type)); +} + +sub gtkset_background($$$) { + my ($r, $g, $b) = @_; + + Gtk->init; + my $root = Gtk::Gdk::Window->new_foreign(Gtk::Gdk->ROOT_WINDOW); + my $gc = Gtk::Gdk::GC->new($root); + + my $color = bless {}, 'Gtk::Gdk::Color'; + $color->red ($r << 8); + $color->green($g << 8); + $color->blue ($b << 8); + $color = $root->get_colormap->color_alloc($color); + $gc->set_foreground($color); + $root->set_background($color); + + my ($h, $w) = $root->get_size; + + $root->draw_rectangle($gc, 1, 0, 0, $w, $h); +} @@ -139,7 +166,7 @@ sub create_okcancel($;$$) { sub create_box_with_title($@) { my $o = shift; $o->{box} = gtkpack_(new Gtk::VBox(0,0), - 0, map({ new Gtk::Label(" $_ ") } @_), + map({ 0, $_ } @_), 0, new Gtk::HSeparator, ) } @@ -204,6 +231,11 @@ sub create_hbox { $w->set_layout(-spread); $w; } +sub create_vbox { + my $w = new Gtk::VButtonBox; + $w->set_layout(-spread); + $w; +} sub _create_window($$) { @@ -291,7 +323,7 @@ sub _ask_from_list($$$$) { gtkadd($o->{window}, gtkpack($o->create_box_with_title(@$messages), @widgets > 15 ? - gtkset_usize(createScrolledWindow($list), 0, 300) : + gtkset_usize(createScrolledWindow($list), 200, 300) : $list)); $widgets[$def]->grab_focus; } @@ -329,3 +361,5 @@ sub _ask_okcancel($@) { # $w->set_alignment(!/W/i, !/N/i); # $w #} + + diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index f56e43cee..0ad16d1b0 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -221,6 +221,10 @@ sub init_db { c::rpmErrorSetCallback($fd); # c::rpmSetVeryVerbose(); + log::l("reading /usr/lib/rpm/rpmrc"); + c::rpmReadConfigFiles() or die "can't read rpm config files"; + log::l("\tdone"); + $isUpgrade ? c::rpmdbRebuild($prefix) : c::rpmdbInit($prefix, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString(); } @@ -238,6 +242,8 @@ sub getHeader($) { sub install { my ($prefix, $toInstall, $isUpgrade, $force) = @_; + c::rpmReadConfigFiles() or die "can't read rpm config files"; + my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString(); log::l("opened rpm database"); diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm index fe50ddd12..6239e6075 100644 --- a/perl-install/resize_fat/main.pm +++ b/perl-install/resize_fat/main.pm @@ -1,7 +1,7 @@ #!/usr/bin/perl # DiskDrake -# Copyright (C) 1999 MandrakeSoft +# Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com) # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -17,6 +17,8 @@ # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +# This is mainly a perl rewrite of the work of Andrew Clausen (libresize) + package resize_fat::main; use diagnostics; |