summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--docs/diskdrake.TODO3
-rw-r--r--perl-install/Xconfigurator.pm91
-rw-r--r--perl-install/fsedit.pm21
-rw-r--r--perl-install/log.pm2
-rw-r--r--perl-install/my_gtk.pm11
-rw-r--r--perl-install/partition_table.pm38
-rw-r--r--perl-install/run_program.pm2
7 files changed, 127 insertions, 41 deletions
diff --git a/docs/diskdrake.TODO b/docs/diskdrake.TODO
index bd138e8de..db8e32ae6 100644
--- a/docs/diskdrake.TODO
+++ b/docs/diskdrake.TODO
@@ -1,9 +1,10 @@
+- the information put in save/restore partitions must be cleaned
+(remove mounted/formatted/..., also remove the Data::Dumper dependency)
- 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''
diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm
index 17c553a0c..e8782fc2c 100644
--- a/perl-install/Xconfigurator.pm
+++ b/perl-install/Xconfigurator.pm
@@ -13,6 +13,8 @@ use my_gtk qw(:wrappers);
my $tmpconfig = "/tmp/Xconfig";
+my (%cards, %monitors);
+
1;
sub setVirtual($) {
@@ -27,7 +29,9 @@ sub setVirtual($) {
sub readCardsDB {
my ($file) = @_;
- my ($card, %cards);
+ my ($card);
+
+ %cards and return;
local *F;
open F, $file or die "file $file not found";
@@ -71,13 +75,12 @@ sub readCardsDB {
# this entry is broken in X11R6 cards db
$cards{I128}->{flags}->{noclockprobe} = 1;
-
- %cards;
}
sub readMonitorsDB {
my ($file) = @_;
- my %monitors;
+
+ %monitors and return;
local *F;
open F, $file or die "can't open monitors database ($file): ?!";
@@ -99,7 +102,6 @@ sub readMonitorsDB {
$monitors{$v->[0]} =
{ hsyncrange => $v->[1], vsyncrange => $v->[2] };
}
- %monitors;
}
sub rewriteInittab {
@@ -141,12 +143,14 @@ sub cardConfigurationAuto() {
$card;
}
-sub cardConfiguration(;$) {
- my $card = shift || {};
+sub cardConfiguration(;$$) {
+ my ($card, $noauto) = @_;
+ $card ||= {};
+ $noauto = $::expert unless $noauto;
- my %cards = readCardsDB("/usr/X11R6/lib/X11/Cards");
+ readCardsDB("/usr/X11R6/lib/X11/Cards");
- add2hash($card, cardConfigurationAuto()) unless $card->{type} || $card->{server} || $::expert;
+ add2hash($card, cardConfigurationAuto()) unless $card->{type} || $card->{server} || $noauto;
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" });
@@ -177,7 +181,7 @@ sub cardConfiguration(;$) {
sub monitorConfiguration(;$) {
my $monitor = shift || {};
- my %monitors = readMonitorsDB("MonitorsDB");
+ readMonitorsDB("MonitorsDB");
add2hash($monitor, { type => $in->ask_from_list('', _("Choose a monitor"), [keys %monitors]) }) unless $monitor->{type};
add2hash($monitor, $monitors{$monitor->{type}});
@@ -209,6 +213,16 @@ sub testConfig($) {
sub testFinalConfig($) {
my ($o) = @_;
+ $o->{monitor}->{hsyncrange} && $o->{monitor}->{vsyncrange} or
+ $in->ask_warn('', _("Monitor not configured yet")), return;
+
+ $o->{card}->{server} or
+ $in->ask_warn('', _("Graphic card not configured yet")), return;
+
+ $o->{card}->{depth} or
+ $in->ask_warn('', _("Resolutions not chosen yet")), return;
+
+
write_XF86Config($o, $::testing ? $tmpconfig : "/etc/X11/XF86Config");
my $pid; unless ($pid = fork) {
@@ -250,8 +264,13 @@ sub autoResolutions($) {
my ($o) = @_;
my $card = $o->{card};
- # For the mono and vga16 server, no further configuration is required.
- return if member($card->{server}, "Mono", "VGA16");
+ $in->ask_okcancel(_("Automatic resolutions"),
+_("To find the available resolutions i will try different ones.
+Your screen will blink...
+You can switch if off if you want, you'll hear a beep when it's over")) or return;
+
+ # swith to virtual console 1 (hopefully not X :)
+ my $vt = setVirtual(1);
# Configure the modes order.
my ($ok, $best);
@@ -266,6 +285,10 @@ sub autoResolutions($) {
$card->{depth}->{$_} = [ sort { $b->[0] <=> $a->[0] } @$resolutions ];
}
}
+
+ # restore the virtual console
+ setVirtual($vt);
+ print "\a"; # beeeep!
}
sub autoDefaultDepth($$) {
@@ -287,9 +310,14 @@ sub autoDefaultDepth($$) {
}
-sub resolutionsConfiguration {
- my ($o, $manual) = @_;
+sub resolutionsConfiguration($;$) {
+ my ($o, $option) = @_;
my $card = $o->{card};
+ my $auto = $option eq 'auto';
+ my $noauto = $option || $::expert;
+
+ # For the mono and vga16 server, no further configuration is required.
+ return if member($card->{server}, "Mono", "VGA16");
# some of these guys hate to be poked
# if we dont know then its at the user's discretion
@@ -318,15 +346,11 @@ sub resolutionsConfiguration {
findLegalModes($card);
- unless ($manual || $::expert || !$in->ask_okcancel(_("Automatic resolutions"),
+ if ($auto || (!$noauto && $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);
+Do you want to try?")))) {
autoResolutions($o);
- # restore the virtual console
- setVirtual($vt);
}
autoDefaultDepth($card, $o->{resolution_wanted} || $resolution_wanted);
@@ -457,7 +481,7 @@ sub write_XF86Config {
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 map { " $_\n" } @{$O->{lines} || []};
print F qq( Ramdac "$O->{ramdac}"\n) if $O->{ramdac};
print F qq( Dacspeed "$O->{dacspeed}"\n) if $O->{dacspeed};
@@ -548,16 +572,17 @@ sub main {
$o->{monitor} = monitorConfiguration($o->{monitor});
my $ok = resolutionsConfiguration($o);
-
- $ok &&= testFinalConfig($o);
+
+ $ok = testFinalConfig($o) if $ok && $in->ask_yesorno(_("Test configuration"), _("Do you want to test configuration?"));
my $quit;
until ($ok || $quit) {
my %c = my @c = (
__("Change Monitor") => sub { $o->{monitor} = monitorConfiguration() },
- __("Change Graphic card") => sub { $o->{card} = cardConfiguration() },
- __("Change Resolution") => sub { resolutionsConfiguration($o, 1) },
+ __("Change Graphic card") => sub { $o->{card} = cardConfiguration(0, 1) },
+ __("Change Resolution") => sub { resolutionsConfiguration($o, 'noauto') },
+ __("Automaticall resolutions search") => sub { resolutionsConfiguration($o, 'auto') },
__("Test again") => sub { $ok = testFinalConfig($o) },
__("Quit") => sub { $quit = 1 },
);
@@ -565,7 +590,17 @@ sub main {
_("What do you want to do?"),
[ grep { !ref } @c ])}};
}
-
- # Success
-# rewriteInittab($rc ? 3 : 5) unless $::testing;
+
+ if ($ok && !$::expert) {
+ my $run5 = $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?"));
+ rewriteInittab($run5 ? 5 : 3) unless $::testing;
+
+ $in->ask_warn(_("X successfully configured"),
+_("Configuration file has been written. Take a look at it before running 'startx'.
+Within the server press ctrl, alt and '+' simultaneously to cycle video resolutions.
+Pressing ctrl, alt and backspace simultaneously immediately exits the server
+For further configuration, refer to /usr/X11R6/lib/X11/doc/README.Config."));
+ }
}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index ad73e45c8..df2ae8e7d 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -109,8 +109,10 @@ sub has_mntpoint($$) {
scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
}
-sub check_mntpoint($$) {
- my ($mntpoint, $hds) = @_;
+# do this before modifying $part->{mntpoint}
+# $part->{mntpoint} should not be used here, use $mntpoint instead
+sub check_mntpoint {
+ my ($mntpoint, $hd, $part, $hds) = @_;
$mntpoint eq '' and return;
@@ -119,18 +121,19 @@ sub check_mntpoint($$) {
# m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /";
has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
+
+ if ($part->{start} + $part->{size} > 124 * partition_table::cylinder_size($hd)) {
+ die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
+ die "/ ending on cylinder > 1024" if $mntpoint eq "/" && !has_mntpoint("/boot", $hds);
+ }
}
-sub add($$$) {
- my ($hd, $part, $hds) = @_;
+sub add($$$;$) {
+ my ($hd, $part, $hds, $force) = @_;
isSwap($part) ?
($part->{mntpoint} = 'swap') :
- check_mntpoint($part->{mntpoint}, $hds);
-
- $part->{mntpoint} eq '/boot' &&
- $part->{start} + $part->{size} >= 1024 * partition_table::cylinder_size($hd) and
- die "/boot on cylinder > 1024";
+ $force || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
partition_table::add($hd, $part);
}
diff --git a/perl-install/log.pm b/perl-install/log.pm
index 640349b70..1ccbbf315 100644
--- a/perl-install/log.pm
+++ b/perl-install/log.pm
@@ -20,7 +20,7 @@ sub w { &l }
sub openLog(;$) {
if ($_[0]) { # useLocal
- open LOG, "> $_[0]" or die "no log possible :(";
+ open LOG, "> $_[0]";# or die "no log possible :(";
} else {
open LOG, "> /dev/tty3" or open LOG, ">> /tmp/install.log";# or die "no log possible :(";
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index ebce6f49d..e78cd2fda 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -8,7 +8,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
%EXPORT_TAGS = (
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 ) ],
+ ask => [ qw(ask_warn ask_okcancel ask_yesorno ask_from_entry ask_from_list ask_file) ],
);
$EXPORT_TAGS{all} = [ map { @$_ } values %EXPORT_TAGS ];
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -262,6 +262,7 @@ sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes
sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Is it ok?"), _("Ok"), _("Cancel")); main($w); }
sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); }
sub ask_from_list { my $w = my_gtk->new(shift @_); $w->_ask_from_list(@_); main($w); }
+sub ask_file { my $w = my_gtk->new(''); $w->_ask_file(@_); main($w); }
sub _ask_from_entry($$@) {
my ($o, @msgs) = @_;
@@ -351,6 +352,14 @@ sub _ask_okcancel($@) {
}
+sub _ask_file($$) {
+ my ($o, $title) = @_;
+ my $f = $o->{window} = new Gtk::FileSelection $title;
+ $f->ok_button->signal_connect(clicked => sub { $o->{retval} = $f->get_filename ; Gtk->main_quit });
+ $f->cancel_button->signal_connect(clicked => sub { Gtk->main_quit });
+ $f->hide_fileop_buttons;
+}
+
################################################################################
# rubbish
################################################################################
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
index 8ea4744bc..49058e9ed 100644
--- a/perl-install/partition_table.pm
+++ b/perl-install/partition_table.pm
@@ -13,6 +13,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types);
use common qw(:common :system);
use partition_table_raw;
+use Data::Dumper;
@important_types = ("Linux native", "Linux swap", "DOS FAT16", "Win98 FAT32");
@@ -75,6 +76,8 @@ my %type2fs = (
my %types_rev = reverse %types;
my %fs2type = reverse %type2fs;
+my @fields2save = qw(primary extended totalsectors);
+
1;
@@ -355,3 +358,38 @@ sub raw_add($$) {
die "raw_add: partition table already full";
}
+sub load($$;$) {
+ my ($hd, $file, $force) = @_;
+
+ local *F;
+ open F, $file or die _("Error reading file $file");
+
+ my $h;
+ {
+ no strict 'vars';
+ $h = eval join '', <F>;
+ }
+ $@ and die _("Restoring from file $file failed: $@");
+
+ ref $h eq 'HASH' or die _("Bad backup file");
+
+ $h->{totalsectors} == $hd->{totalsectors} or $force
+ or die "Bad totalsectors";
+
+ # unsure we don't modify totalsectors
+ $h->{totalsectors} = $hd->{totalsectors} if $force;
+
+ @{$hd}{@fields2save} = @{$h}{@fields2save};
+
+ $hd->{isDirty} = $hd->{needKernelReread} = 1;
+}
+
+
+sub save($$) {
+ my ($hd, $file) = @_;
+ my %h; @h{@fields2save} = @{$hd}{@fields2save};
+ local *F;
+ open F, ">$file"
+ and print F Dumper(\%h)
+ or die _("Error writing to file $file");
+}
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
index db191691a..0341fe06d 100644
--- a/perl-install/run_program.pm
+++ b/perl-install/run_program.pm
@@ -25,6 +25,6 @@ sub rooted($$@) {
$root and chroot $root;
chdir "/";
- exec $name, @args or log::l("exec of $name failed: $!"), exit(-1);
+ exec $name, @args or log::l("exec of $name failed: $!"), exec 'false';
}
}
generated by cgit v1.2.1 (git 2.21.0) at 2024-05-29 07:14:10 +0000