diff options
Diffstat (limited to 'perl-install')
-rw-r--r-- | perl-install/Xconfigurator.pm | 91 | ||||
-rw-r--r-- | perl-install/fsedit.pm | 21 | ||||
-rw-r--r-- | perl-install/log.pm | 2 | ||||
-rw-r--r-- | perl-install/my_gtk.pm | 11 | ||||
-rw-r--r-- | perl-install/partition_table.pm | 38 | ||||
-rw-r--r-- | perl-install/run_program.pm | 2 |
6 files changed, 125 insertions, 40 deletions
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'; } } |