summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/diskdrake.TODO31
-rw-r--r--perl-install/Xconfigurator.pm149
-rw-r--r--perl-install/Xconfigurator_consts.pm8
-rw-r--r--perl-install/install2.pm4
-rw-r--r--perl-install/install_steps_interactive.pm128
-rw-r--r--perl-install/interactive_gtk.pm2
-rw-r--r--perl-install/my_gtk.pm42
-rw-r--r--perl-install/pkgs.pm6
-rw-r--r--perl-install/resize_fat/main.pm4
9 files changed, 298 insertions, 76 deletions
diff --git a/docs/diskdrake.TODO b/docs/diskdrake.TODO
index 097789747..bd138e8de 100644
--- a/docs/diskdrake.TODO
+++ b/docs/diskdrake.TODO
@@ -1,14 +1,17 @@
-text version
-
-save/restore partitions in a file
-
-display the information about the correspondance color2type
-
-have ``undo''
-
-handle the `luke' case (main extended partition must be extended)
-
-ajouter une verif apres fdiskReadPartitionTable pour s'assurer qu'on se
-trompe pas sur la facon de calculer le start_cyl, end_cyl...
-Pas possible de le faire dans fdiskReadPartitionTable car start est relatif dans les etendues
-
+- test, test, test
+- integrate ext2resize
+- add the ability to specify primary or extended partitions (in expert mode)
+- text version
+- better error handling (what to do if we find a bad partition table?)
+- save/restore partitions in a file (mainly, just a Data::Dumper of $hds)
+- display the information about the correspondance color2type
+- handle the partition labels (missing information here)
+- have ``undo''
+- add comments in the code
+- add documentation
+- handle the `luke' case (main extended partition must be extended)
+- add a verification after fdiskReadPartitionTable that the start_cyl,
+end_cyl... do correspond to start and start+size. For the moment, this
+information is just discarded :(
+This verif can't be done in fdiskReadPartitionTable as start is relative in
+extended partitions
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;
generated by cgit v1.2.1 (git 2.21.0) at 2024-07-01 07:11:52 +0000