diff options
| author | Pascal Rigaux <pixel@mandriva.com> | 1999-09-09 09:02:47 +0000 |
|---|---|---|
| committer | Pascal Rigaux <pixel@mandriva.com> | 1999-09-09 09:02:47 +0000 |
| commit | 1d3ac921d66022bb6e19a96dce95472cc31f0987 (patch) | |
| tree | 4da18678cee71134f6cec6004f0b41afe6d25145 | |
| parent | db4013c2a40eaeb3752cc69623037e4bb274693b (diff) | |
| download | drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.gz drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.bz2 drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.tar.xz drakx-backup-do-not-use-1d3ac921d66022bb6e19a96dce95472cc31f0987.zip | |
no_comment
36 files changed, 489 insertions, 651 deletions
@@ -1,5 +1,7 @@ merge the install(1) of redhat +smp::detect + try detect_devices::floppies (and how are scsi floppies handled?) have a better time estimation of the remaining time in install packages diff --git a/perl-install/Makefile b/perl-install/Makefile index f9a160426..6b3f998c6 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -78,8 +78,9 @@ install_pms: all for i in $(PMS); do \ dest=$(DESTREP4PMS)/`dirname $$i`; \ install -d $$dest; \ - perl -ne 'print unless (/^=head/ .. /^=cut/) || /^\s*#-/ || /use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \ + perl -ne 'print unless (/^=head/ .. /^=cut/) || /#-.*/' $$i > $(DESTREP4PMS)/$$i; \ done +# || /use (diagnostics|vars|strict)/ rm $(DESTREP4PMS)/c/c.xs.pm mv -f $(DESTREP4PMS)/c/c.pm $(DESTREP4PMS) @@ -134,7 +135,9 @@ get_needed_files: $(SO_FILES) install -d $(DEST)/usr/X11R6/lib/X11/fonts/75dpi install -d $(DEST)/usr/X11R6/lib/X11/fonts/misc cd /usr/X11R6/lib/X11/fonts/75dpi ; cp -a fonts.* helvR* $(DEST)/usr/X11R6/lib/X11/fonts/75dpi - cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc + cd /usr/X11R6/lib/X11/fonts/misc ; cp -a fonts.* k14.pcf.gz cursor.pcf.gz 6x13.pcf.gz $(DEST)/usr/X11R6/lib/X11/fonts/misc + + for i in ru ja; do install -d $(DEST)/usr/share/locale/$$i ; cp -f `find /usr/share/locale/$$i/* -prune -type f` $(DEST)/usr/share/locale/$$i ; done perl -I. -Ic -Ic/blib/arch -Mkeyboard -e 'foreach (keyboard::xmodmaps()) { `cp /usr/share/xmodmap/xmodmap.$$_ $(DEST)/usr/share/xmodmap` }' diff --git a/perl-install/Xconfig.pm b/perl-install/Xconfig.pm index edbdc2c01..2e93b5679 100644 --- a/perl-install/Xconfig.pm +++ b/perl-install/Xconfig.pm @@ -35,7 +35,7 @@ sub getinfoFromXF86Config { my $o = shift || {}; my (%c, $depth); - $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; # /x for perl2fcalls + $o->{card}{server} ||= $1 if readlink("/etc/X11/X") =~ /XF86_ (\w+)$/x; #- /x for perl2fcalls local *F; open F, "/etc/X11/XF86Config" or return {}; diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index 84ff9b803..1879e45b2 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -78,7 +78,7 @@ sub readCardsDB { push @{$cards{S3}{lines}}, $s3_comment; push @{$cards{'CL-GD'}{lines}}, $cirrus_comment; - # this entry is broken in X11R6 cards db + #- this entry is broken in X11R6 cards db $cards{I128}{flags}{noclockprobe} = 1; } @@ -150,8 +150,8 @@ sub cardConfiguration(;$$) { readCardsDB("$prefix/usr/X11R6/lib/X11/Cards"); - add2hash($card, $cards{$card->{type}}) if $card->{type}; # try to get info from given type - $card->{type} = undef unless $card->{server}; # bad type as we can't find the server + add2hash($card, $cards{$card->{type}}) if $card->{type}; #- try to get info from given type + $card->{type} = undef unless $card->{server}; #- bad type as we can't find the server add2hash($card, cardConfigurationAuto()) unless $card->{server} || $noauto; add2hash($card, { type => $in->ask_from_list('', _("Choose a graphic card"), [keys %cards]) }) unless $card->{type} || $card->{server}; @@ -245,8 +245,8 @@ sub testFinalConfig($;$) { } do { sleep 1; } until (c::Xtest(':0')); - # 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 + #- 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 unlink "/tmp/.X11-unix/X9" if $prefix; symlink "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix; @@ -291,10 +291,10 @@ _("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 :) + #- swith to virtual console 1 (hopefully not X :) my $vt = setVirtual(1); - # Configure the modes order. + #- Configure the modes order. my ($ok, $best); foreach (reverse @depths) { local $card->{default_depth} = $_; @@ -308,9 +308,9 @@ You can switch if off if you want, you'll hear a beep when it's over")) or retur } } - # restore the virtual console + #- restore the virtual console setVirtual($vt); - print "\a"; # beeeep! + print "\a"; #- beeeep! } sub autoDefaultDepth($$) { @@ -332,12 +332,12 @@ sub chooseResolutions($$) { my $W = my_gtk->new(_("Resolution")); my %txt2depth = reverse %depths; - my $chosen_w = 9999999; # will be set by the combo callback + my $chosen_w = 9999999; #- will be set by the combo callback my ($r, $depth_combo, %w2depth, %w2h, %w2widget); 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 + #- the set function is usefull to toggle the CheckButton with the callback being ignored my $ignore; my $set = sub { $ignore = 1; $_[0]->set_active(1); $ignore = 0; }; @@ -394,33 +394,33 @@ sub resolutionsConfiguration($$) { my $nowarning = $auto || $option eq 'nowarning'; my $noauto = $option eq 'noauto'; - # For the mono and vga16 server, no further configuration is required. + #- 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 - #my $manual ||= - # $card->{server} =~ /^(TGA|Mach32)/ || - # $card->{name} =~ /^Riva 128/ || - # $card->{chipset} =~ /^(RIVA128|mgag)/ || - # $::expert; - # - #my $unknown = - # member($card->{server}, qw(S3 S3V I128 Mach64)) || - # member($card->{type}, - # "Matrox Millennium (MGA)", - # "Matrox Millennium II", - # "Matrox Millennium II AGP", - # "Matrox Mystique", - # "Matrox Mystique", - # "S3", - # "S3V", - # "I128", - # ) || - # $card->{type} =~ /S3 ViRGE/; - # - #$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("), - # _("Do you want to try?") ]); + #- some of these guys hate to be poked + #- if we dont know then its at the user's discretion + #-my $manual ||= + #- $card->{server} =~ /^(TGA|Mach32)/ || + #- $card->{name} =~ /^Riva 128/ || + #- $card->{chipset} =~ /^(RIVA128|mgag)/ || + #- $::expert; + #- + #-my $unknown = + #- member($card->{server}, qw(S3 S3V I128 Mach64)) || + #- member($card->{type}, + #- "Matrox Millennium (MGA)", + #- "Matrox Millennium II", + #- "Matrox Millennium II AGP", + #- "Matrox Mystique", + #- "Matrox Mystique", + #- "S3", + #- "S3V", + #- "I128", + #- ) || + #- $card->{type} =~ /S3 ViRGE/; + #- + #-$unknown and $manual ||= !$in->ask_okcancel('', [ _("I can try to autodetect information about graphic card, but it may freeze :("), + #- _("Do you want to try?") ]); unless ($card->{depth}) { $card->{depth}{$_} = [ map { [ split "x" ] } @resolutions ] @@ -434,14 +434,14 @@ Do you want to try?")))) { } } - # sort resolutions in each depth + #- sort resolutions in each depth foreach (values %{$card->{depth}}) { my $i; @$_ = grep { first($i != $_->[0], $i = $_->[0]) } sort { $b->[0] <=> $a->[0] } @$_; } - # remove unusable resolutions (based on the video memory size) + #- remove unusable resolutions (based on the video memory size) keepOnlyLegalModes($card); my $res = $o->{resolution_wanted} || $resolution_wanted; @@ -449,18 +449,18 @@ Do you want to try?")))) { $auto or ($depth, $res) = chooseResolutions($card, $depth) or return; - # needed in auto mode when all has been provided by the user + #- needed in auto mode when all has been provided by the user $card->{depth}{$depth} or die "you fixed an unusable depth"; - # remove all biggest resolution (keep the small ones for ctl-alt-+) - # otherwise there'll be a virtual screen :( + #- remove all biggest resolution (keep the small ones for ctl-alt-+) + #- otherwise there'll be a virtual screen :( $card->{depth}{$depth} = [ grep { $_->[0] <= $res } @{$card->{depth}{$depth}} ]; $card->{default_depth} = $depth; 1; } -# * Create the XF86Config file. +#- Create the XF86Config file. sub write_XF86Config { my ($o, $file) = @_; my $O; @@ -470,7 +470,7 @@ sub write_XF86Config { print F $XF86firstchunk_text; - # Write keyboard section. + #- Write keyboard section. $O = $o->{keyboard}; print F $keyboardsection_start; @@ -479,12 +479,12 @@ sub write_XF86Config { print F qq( XkbLayout "$O->{xkb_keymap}"\n); print F $keyboardsection_end; - # Write pointer section. + #- Write pointer section. $O = $o->{mouse}; print F $pointersection_text1; print F qq( Protocol "$O->{XMOUSETYPE}"\n); print F qq( Device "$O->{device}"\n); - # this will enable the "wheel" or "knob" functionality if the mouse supports it + #- this will enable the "wheel" or "knob" functionality if the mouse supports it print F " ZAxisMapping 4 5\n" if member($O->{XMOUSETYPE}, qw(IntelliMouse IMPS/2 ThinkingMousePS/2 NetScrollPS/2 NetMousePS/2 MouseManPlusPS/2)); @@ -500,7 +500,7 @@ sub write_XF86Config { print F " ClearRTS\n\n" if $O->{cleardtrrts}; print F "EndSection\n\n\n"; - # Write monitor section. + #- Write monitor section. $O = $o->{monitor}; print F $monitorsection_text1; print F qq( Identifier "$O->{type}"\n); @@ -519,7 +519,7 @@ sub write_XF86Config { $modelines_text); print F "EndSection\n\n\n"; - # Write Device section. + #- Write Device section. $O = $o->{card}; print F $devicesection_text; print F qq(Section "Device"\n); @@ -543,7 +543,7 @@ sub write_XF86Config { } print F "EndSection\n\n\n"; - # Write Screen sections. + #- Write Screen sections. print F $screensection_text1; my $screen = sub { @@ -568,7 +568,7 @@ Section "Screen" print F "EndSection\n"; }; - # SVGA screen section. + #- SVGA screen section. print F qq( # The Colour SVGA server ); @@ -598,7 +598,7 @@ sub XF86check_link { my $l = "$prefix/usr/X11R6/lib/X11/XF86Config"; - if (-e $l && (stat($f))[1] != (stat($l))[1]) { # compare the inode, must be the sames + 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"; symlink "../../../../etc/X11/XF86Config", $l; } @@ -621,7 +621,7 @@ sub show_info { $in->ask_warn('', $info); } -# * Program entry point. +#- Program entry point. sub main { my $o; ($prefix, $o, $in, $install) = @_; diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm index 258f7c882..1f7529164 100644 --- a/perl-install/Xconfigurator_consts.pm +++ b/perl-install/Xconfigurator_consts.pm @@ -2,7 +2,7 @@ use common qw(:common); %depths = ( 8 => __("256 colors"), -# 15 => __("32 thousand colors"), +#- 15 => __("32 thousand colors"), 16 => __("65 thousand colors"), 24 => __("16 million colors"), 32 => __("4 billion colors"), @@ -41,7 +41,7 @@ $resolution_wanted = "1024x768"; __("Monitor that can do 1600x1200 at 76 Hz") => [ '1600x1200@76', "31.5-94.0" , "50-160" ], ); -# * Screen/video card configuration. +#- * Screen/video card configuration. %ramdacs = ( __("No RAMDAC Setting (recommended)") => '', __("AT&T 20C490 (S3 and AGX servers, ARK driver)"), => 'att20c490', diff --git a/perl-install/common.pm b/perl-install/common.pm index 084080959..4b88b85ed 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -29,7 +29,7 @@ sub fold_left(&@) { } sub _ { my $s = shift @_; sprintf translate($s), @_ } -#delete $main::{'_'}; +#-delete $main::{'_'}; sub __ { $_[0] } sub min { fold_left { $a < $b ? $a : $b } @_ } sub max { fold_left { $a > $b ? $a : $b } @_ } @@ -85,7 +85,7 @@ sub map_index(&@) { @l; } -#pseudo-array-hash :) +#- pseudo-array-hash :) sub map_tab_hash(&$@) { my ($f, $fields, @tab_hash) = @_; my %hash; @@ -135,7 +135,7 @@ sub add_f4before_leaving { } -# ! the functions are not called in the order wanted, in case of multiple before_leaving :( +#- ! the functions are not called in the order wanted, in case of multiple before_leaving :( sub before_leaving(&) { my ($f) = @_; my $b = bless {}, 'common::before_leaving'; diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index c8c14736b..5b6f79e41 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -15,12 +15,12 @@ my $CSADeviceAvailable; 1; sub get { - # Detect the default BIOS boot harddrive is kind of tricky. We may have IDE, - # SCSI and RAID devices on the same machine. From what I see so far, the default - # BIOS boot harddrive will be - # 1. The first IDE device if IDE exists. Or - # 2. The first SCSI device if SCSI exists. Or - # 3. The first RAID device if RAID exists. + #- Detect the default BIOS boot harddrive is kind of tricky. We may have IDE, + #- SCSI and RAID devices on the same machine. From what I see so far, the default + #- BIOS boot harddrive will be + #- 1. The first IDE device if IDE exists. Or + #- 2. The first SCSI device if SCSI exists. Or + #- 3. The first RAID device if RAID exists. map { &{$_->[0]}() ? &{$_->[1]}() : () } [ \&hasIDE, \&getIDE ], @@ -89,7 +89,7 @@ sub getSCSI() { sub getIDE() { my @idi; - # Great. 2.2 kernel, things are much easier and less error prone. + #- Great. 2.2 kernel, things are much easier and less error prone. foreach my $d (glob_('/proc/ide/hd*')) { my ($t) = chop_(cat_("$d/media")); my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next; @@ -119,8 +119,8 @@ sub getCompaqSmartArray() { sub getDAC960() { my @idi; - # We are looking for lines of this format:DAC960#0: - # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012 + #- We are looking for lines of this format:DAC960#0: + #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012 foreach (syslog()) { my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next; push @idi, { info => $info, type => 'hd', devicename => $devicename }; diff --git a/perl-install/devices.pm b/perl-install/devices.pm index af5dd3ab1..f29ac194b 100644 --- a/perl-install/devices.pm +++ b/perl-install/devices.pm @@ -17,15 +17,15 @@ sub size($) { my $valid_offset = sub { sysseek(F, $_[0], 0) && sysread(F, my $a, 1) }; - # first try getting the size nicely + #- first try getting the size nicely my $size = 0; ioctl(F, c::BLKGETSIZE(), $size) and return unpack("i", $size) * $common::SECTORSIZE; - # sad it didn't work, well searching the size using the dichotomy algorithm! + #- sad it didn't work, well searching the size using the dichotomy algorithm! my $low = 0; my ($high, $mid); - # first find n where 2^n < size <= 2^n+1 + #- first find n where 2^n < size <= 2^n+1 for ($high = 1; $high > 0 && &$valid_offset($high); $high *= 2) { $low = $high; } while ($low < $high - 1) { @@ -46,7 +46,7 @@ sub make($) { $file = "$prefix/dev/$_"; -e $file or $file = "$prefix/tmp/$_"; } - -e $file and return $file; # assume nobody takes fun at creating files named as device + -e $file and return $file; #- assume nobody takes fun at creating files named as device if (/^sd(.)(\d{0,2})/) { $type = c::S_IFBLK(); @@ -100,7 +100,7 @@ sub make($) { }}{$_} or die "unknown device $_" }; } - # make a directory for this inode if needed. + #- make a directory for this inode if needed. mkdir dirname($file), 0755; syscall_('mknod', $file, $type | 0600, makedev($major, $minor)) or die "mknod failed (dev:$_): $!"; diff --git a/perl-install/fs.pm b/perl-install/fs.pm index b891f5f10..45045e508 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -63,7 +63,7 @@ sub format_ext2($;$) { my ($dev, $bad_blocks) = @_; my @options; - $dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); # For RAID only. + $dev =~ m,(rd|ida)/, and push @options, qw(-b 4096 -R stride=16); #- For RAID only. $bad_blocks and push @options, "-c"; run_program::run("mke2fs", devices::make($dev), @options) or die _("%s formatting of %s failed", "ext2", $dev); @@ -116,24 +116,24 @@ sub mount($$$;$) { if ($fs eq 'vfat') { $mount_opt = "check=relaxed"; - eval { modules::load('vfat') }; # try using vfat - eval { modules::load('msdos') } if $@; # otherwise msdos... + eval { modules::load('vfat') }; #- try using vfat + eval { modules::load('msdos') } if $@; #- otherwise msdos... } log::l("calling mount($dev, $where, $fs, $flag, $mount_opt)"); syscall_('mount', $dev, $where, $fs, $flag, $mount_opt) or die _("mount failed: ") . "$!"; } local *F; - open F, ">>/etc/mtab" or return; # fail silently, must be read-only /etc + open F, ">>/etc/mtab" or return; #- fail silently, must be read-only /etc print F "$dev $where $fs defaults 0 0\n"; } -# takes the mount point to umount (can also be the device) +#- takes the mount point to umount (can also be the device) sub umount($) { my ($mntpoint) = @_; syscall_('umount', $mntpoint) or die _("error unmounting %s: %s", $mntpoint, "$!"); - my @mtab = cat_('/etc/mtab'); # don't care about error, if we can't read, we won't manage to write... (and mess mtab) + my @mtab = cat_('/etc/mtab'); #- don't care about error, if we can't read, we won't manage to write... (and mess mtab) local *F; open F, ">/etc/mtab" or return; foreach (@mtab) { print F $_ unless /(^|\s)$mntpoint\s/; } @@ -150,7 +150,7 @@ sub mount_part($;$) { $part->{mntpoint} or die "missing mount point"; mount(devices::make($part->{device}), ($prefix || '') . $part->{mntpoint}, type2fs($part->{type}), 0); } - $part->{isMounted} = $part->{isFormatted} = 1; # assume that if mount works, partition is formatted + $part->{isMounted} = $part->{isFormatted} = 1; #- assume that if mount works, partition is formatted } sub umount_part($;$) { @@ -169,7 +169,7 @@ sub mount_all($;$) { log::l("mounting all filesystems"); - # order mount by alphabetical ordre, that way / < /home < /home/httpd... + #- order mount by alphabetical ordre, that way / < /home < /home/httpd... foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) { mount_part($_, $prefix) if ($_->{mntpoint} || isSwap($_)); } @@ -185,7 +185,7 @@ sub umount_all($;$) { } } -# do some stuff before calling write_fstab +#- do some stuff before calling write_fstab sub write($$) { my ($prefix, $fstab) = @_; my @cd_drives = detect_devices::cdroms(); @@ -194,8 +194,8 @@ sub write($$) { unshift @cd_drives, grep { $_->{type} eq 'iso9660' } read_fstab("/proc/mounts"); log::l("found cdrom drive(s) " . join(', ', map { $_->{device} } @cd_drives)); - # cd-rom rooted installs have the cdrom mounted on /dev/root which - # is not what we want to symlink to /dev/cdrom. + #- cd-rom rooted installs have the cdrom mounted on /dev/root which + #- is not what we want to symlink to /dev/cdrom. my $cddev = first(grep { $_ ne 'root' } map { $_->{device} } @cd_drives); log::l("resetting /etc/mtab"); @@ -234,7 +234,7 @@ sub write_fstab($;$$) { push @to_add, [ split ' ', 'none /dev/pts devpts mode=0620 0 0' ]; } - # get the list of devices and mntpoint + #- get the list of devices and mntpoint my @new = grep { $_ ne 'none' } map { @$_[0,1] } @to_add; my %new; @new{@new} = undef; @@ -245,7 +245,7 @@ sub write_fstab($;$$) { open F, "> $prefix/etc/fstab" or die "error writing $prefix/etc/fstab"; foreach (@current) { my ($a, $b) = split; - # if we find one line of fstab containing either the same device or mntpoint, do not write it + #- if we find one line of fstab containing either the same device or mntpoint, do not write it exists $new{$a} || exists $new{$b} and next; print F $_; } diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index fc555c056..055a1d3b8 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -76,9 +76,9 @@ sub suggest_part($$$;$) { $best = $second if $best->{mntpoint} eq '/boot' && - $part->{start} + $best->{minsize} > 1024 * partition_table::cylinder_size($hd); # if the empty slot is beyond the 1024th cylinder, no use having /boot + $part->{start} + $best->{minsize} > 1024 * partition_table::cylinder_size($hd); #- if the empty slot is beyond the 1024th cylinder, no use having /boot - defined $best or return; # sorry no suggestion :( + defined $best or return; #- sorry no suggestion :( $part->{mntpoint} = $best->{mntpoint}; $part->{type} = $best->{type}; @@ -87,24 +87,24 @@ sub suggest_part($$$;$) { } -#sub partitionDrives { -# -# my $cmd = "/sbin/fdisk"; -# -x $cmd or $cmd = "/usr/bin/fdisk"; -# -# my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller."; -# -# foreach (@$drives) { -# my $text = "/dev/" . $_->{device}; -# $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/; -# $text .= " - Model " . $_->{info}; -# $text .= " array" if $_->{device} =~ /^c.d/; -# -# # truncate at 50 columns for now -# $text = substr $text, 0, 50; -# } -# #TODO TODO -#} +#-sub partitionDrives { +#- +#- my $cmd = "/sbin/fdisk"; +#- -x $cmd or $cmd = "/usr/bin/fdisk"; +#- +#- my $drives = findDrivesPresent() or die "You don't have any hard drives available! You probably forgot to configure a SCSI controller."; +#- +#- foreach (@$drives) { +#- my $text = "/dev/" . $_->{device}; +#- $text .= " - SCSI ID " . $_->{id} if $_->{device} =~ /^sd/; +#- $text .= " - Model " . $_->{info}; +#- $text .= " array" if $_->{device} =~ /^c.d/; +#- +#- #- truncate at 50 columns for now +#- $text = substr $text, 0, 50; +#- } +#- #-TODO TODO +#-} sub has_mntpoint($$) { @@ -112,8 +112,8 @@ sub has_mntpoint($$) { scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds); } -# do this before modifying $part->{mntpoint} -# $part->{mntpoint} should not be used here, use $mntpoint instead +#- do this before modifying $part->{mntpoint} +#- $part->{mntpoint} should not be used here, use $mntpoint instead sub check_mntpoint { my ($mntpoint, $hd, $part, $hds) = @_; @@ -121,7 +121,7 @@ sub check_mntpoint { local $_ = $mntpoint; m|^/| or die _("Mount points must begin with a leading /"); -# m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /"; +#- 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); @@ -152,10 +152,10 @@ sub removeFromList($$$) { if ($start == $list->[$i]) { $end > $list->[$i + 1] and die $err; if ($end == $list->[$i + 1]) { - # the free block is just the same size, removing it + #- the free block is just the same size, removing it splice(@$list, 0, 2); } else { - # the free block now start just after this block + #- the free block now start just after this block $list->[$i] = $end; } } else { @@ -163,7 +163,7 @@ sub removeFromList($$$) { if ($end < $list->[$i + 1]) { splice(@$list, $i + 2, 0, $end, $list->[$i + 1]); } - $list->[$i + 1] = $start; # shorten the free block + $list->[$i + 1] = $start; #- shorten the free block } return; } @@ -172,7 +172,7 @@ sub removeFromList($$$) { sub allocatePartitions($$) { my ($hds, $to_add) = @_; - my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; # first sector is always occupied by the MBR + my %free_sectors = map { $_->{device} => [1, $_->{totalsectors} ] } @$hds; #- first sector is always occupied by the MBR my $remove = sub { removeFromList($_[0]{start}, $_[0]->{start} + $_[0]->{size}, $free_sectors{$_[0]->{rootDevice}}) }; my $success = 0; @@ -239,7 +239,7 @@ sub move { $part2->{size} += partition_table::cylinder_size($hd2) - 1; partition_table::remove($hd, $part); { - local ($part2->{notFormatted}, $part2->{isFormatted}); # do not allow partition::add to change this + local ($part2->{notFormatted}, $part2->{isFormatted}); #- do not allow partition::add to change this partition_table::add($hd2, $part2); } diff --git a/perl-install/install2.pm b/perl-install/install2.pm index abcae4402..f3850252b 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -183,7 +183,7 @@ my @installSteps = ( configureMouse => [ __("Configure mouse"), 1, 1, "formatPartitions" ], configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ], configureTimezone => [ __("Configure timezone"), 1, 1, "doInstallStep" ], -# configureServices => [ __("Configure services"), 0, 0 ], +#- configureServices => [ __("Configure services"), 0, 0 ], configurePrinter => [ __("Configure printer"), 1, 0, "doInstallStep" ], setRootPassword => [ __("Set root password"), 1, 1, "formatPartitions" ], addUser => [ __("Add a user"), 1, 1, "doInstallStep" ], @@ -204,18 +204,18 @@ for (my $i = 0; $i < @installSteps; $i += 2) { push @orderedInstallSteps, $installSteps[$i]; } -#TOSEE bug with -#%installSteps = -# map_tab_hash { -# my ($i, $h) = @_; -# $h->{help} = $stepsHelp{$installSteps[$i]} || __("Help"); -# $h->{next} = $installSteps[$i + 2]; -# $h->{onError} = $installSteps[$i + 2 * $h->{onError}]; -## $h->{toBeDone} = []; SEMBLE FIXE les PBS -## $h->{entered} = 0; -# push @orderedInstallSteps, $installSteps[$i]; -# } \@installStepsFields, @installSteps; -#print Dumper(\%installSteps); +#-TOSEE bug with +#-%installSteps = +#- map_tab_hash { +#- my ($i, $h) = @_; +#- $h->{help} = $stepsHelp{$installSteps[$i]} || __("Help"); +#- $h->{next} = $installSteps[$i + 2]; +#- $h->{onError} = $installSteps[$i + 2 * $h->{onError}]; +#-#- $h->{toBeDone} = []; SEMBLE FIXE les PBS +#-#- $h->{entered} = 0; +#- push @orderedInstallSteps, $installSteps[$i]; +#- } \@installStepsFields, @installSteps; +#-print Dumper(\%installSteps); $installSteps{first} = $installSteps[0]; @@ -227,7 +227,7 @@ my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert #-##################################################################################### #-Default value #-##################################################################################### -# partition layout +#- partition layout my %suggestedPartitions = ( beginner => [ { mntpoint => "/boot", size => 16 << 11, type => 0x83 }, @@ -264,28 +264,28 @@ my %suggestedPartitions = ( $o = $::o = { bootloader => { onmbr => 1, linear => 0 }, autoSCSI => 0, - mkbootdisk => 1, # no mkbootdisk if 0 or undef, find a floppy with 1 -# packages => [ qw() ], + mkbootdisk => 1, #- no mkbootdisk if 0 or undef, find a floppy with 1 +#- packages => [ qw() ], partitioning => { clearall => $::testing, eraseBadPartitions => 0, auto_allocate => 0, autoformat => 0 }, -# partitions => [ -# { mntpoint => "/boot", size => 16 << 11, type => 0x83 }, -# { mntpoint => "/", size => 256 << 11, type => 0x83 }, -# { mntpoint => "/usr", size => 512 << 11, type => 0x83, growable => 1 }, -# { mntpoint => "/var", size => 256 << 11, type => 0x83 }, -# { mntpoint => "/home", size => 512 << 11, type => 0x83, growable => 1 }, -# { mntpoint => "swap", size => 64 << 11, type => 0x82 } -# { mntpoint => "/boot", size => 16 << 11, type => 0x83 }, -# { mntpoint => "/", size => 300 << 11, type => 0x83 }, -# { mntpoint => "swap", size => 64 << 11, type => 0x82 }, -# { mntpoint => "/usr", size => 400 << 11, type => 0x83, growable => 1 }, -# ], +#- partitions => [ +#- { mntpoint => "/boot", size => 16 << 11, type => 0x83 }, +#- { mntpoint => "/", size => 256 << 11, type => 0x83 }, +#- { mntpoint => "/usr", size => 512 << 11, type => 0x83, growable => 1 }, +#- { mntpoint => "/var", size => 256 << 11, type => 0x83 }, +#- { mntpoint => "/home", size => 512 << 11, type => 0x83, growable => 1 }, +#- { mntpoint => "swap", size => 64 << 11, type => 0x82 } +#- { mntpoint => "/boot", size => 16 << 11, type => 0x83 }, +#- { mntpoint => "/", size => 300 << 11, type => 0x83 }, +#- { mntpoint => "swap", size => 64 << 11, type => 0x82 }, +#- { mntpoint => "/usr", size => 400 << 11, type => 0x83, growable => 1 }, +#- ], shells => [ map { "/bin/$_" } qw(bash tcsh zsh ash ksh) ], lang => 'en', isUpgrade => 0, installClass => "beginner", timezone => { -# timezone => "Europe/Paris", +#- timezone => "Europe/Paris", GMT => 1, }, printer => { @@ -315,27 +315,27 @@ $o = $::o = { SMBPASSWD => "passowrd", SMBWORKGROUP => "AS3", }, -# superuser => { password => 'a', shell => '/bin/bash', realname => 'God' }, -# user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' }, +#- superuser => { password => 'a', shell => '/bin/bash', realname => 'God' }, +#- user => { name => 'foo', password => 'bar', home => '/home/foo', shell => '/bin/bash', realname => 'really, it is foo' }, -# keyboard => 'de', -# display => "192.168.1.9:0", +#- keyboard => 'de', +#- display => "192.168.1.9:0", steps => \%installSteps, orderedSteps => \@orderedInstallSteps, base => [ qw(basesystem initscripts console-tools mkbootdisk anacron rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which cpio) ], -# for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm -# intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ], - -#step : the current one -#prefix -#mouse -#keyboard -#netc -#autoSCSI drives hds fstab -#methods -#packages compss -#printer haveone entry(cf printer.pm) +#- for the list of fields available for user and superuser, see @etc_pass_fields in install_steps.pm +#- intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ], + +#-step : the current one +#-prefix +#-mouse +#-keyboard +#-netc +#-autoSCSI drives hds fstab +#-methods +#-packages compss +#-printer haveone entry(cf printer.pm) }; @@ -363,7 +363,7 @@ sub selectKeyboard { return if $::beginner && !$clicked; $o->selectKeyboard; - #if we go back to the selectKeyboard, you must rewrite + #- if we go back to the selectKeyboard, you must rewrite addToBeDone { keyboard::write($o->{prefix}, $o->{keyboard}) unless $o->{isUpgrade}; } 'doInstallStep'; @@ -397,7 +397,7 @@ sub setupSCSI { } #------------------------------------------------------------------------------ -#PADTODO +#-PADTODO sub partitionDisks { $o->{drives} = [ detect_devices::hds() ]; $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) } @@ -409,9 +409,9 @@ I'll try to go on blanking bad partitions")); }; unless (@{$o->{hds}} > 0) { - $o->setupSCSI if $o->{autoSCSI}; # ask for an unautodetected scsi card + $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card } - unless (@{$o->{hds}} > 0) { # no way + unless (@{$o->{hds}} > 0) { #- no way die _("An error has occurred - no valid devices were found on which to create new filesystems. Please check your hardware for the cause of this problem"); } @@ -431,7 +431,7 @@ I'll try to go on blanking bad partitions")); } -#PADTODO +#-PADTODO sub formatPartitions { $o->choosePartitionsToFormat($o->{fstab}); @@ -444,7 +444,7 @@ sub formatPartitions { } #------------------------------------------------------------------------------ -#PADTODO +#-PADTODO sub choosePackages { install_any::setPackages($o); $o->choosePackages($o->{packages}, $o->{compss}); @@ -452,7 +452,7 @@ sub choosePackages { } #------------------------------------------------------------------------------ -#PADTODO +#-PADTODO sub doInstallStep { $o->beforeInstallPackages; $o->installPackages($o->{packages}); @@ -467,7 +467,7 @@ sub configureNetwork { $o->configureNetwork($entered == 1 && !$clicked) } #------------------------------------------------------------------------------ -#PADTODO +#-PADTODO sub configureTimezone { my ($clicked) = $_[0]; my $f = "$o->{prefix}/etc/sysconfig/clock"; @@ -486,12 +486,12 @@ sub addUser { $o->addUser; addToBeDone { - run_program::rooted($o->{prefix}, "pwconv") or log::l("pwconv failed"); # use shadow passwords + run_program::rooted($o->{prefix}, "pwconv") or log::l("pwconv failed"); #- use shadow passwords } 'doInstallStep'; } #------------------------------------------------------------------------------ -#PADTODO +#-PADTODO sub createBootdisk { fs::write($o->{prefix}, $o->{fstab}) unless $o->{isUpgrade}; modules::write_conf("$o->{prefix}/etc/conf.modules", 'append'); @@ -517,7 +517,7 @@ sub exitInstall { $o->exitInstall } sub main { $SIG{__DIE__} = sub { chomp $_[0]; log::l("ERROR: $_[0]") }; - # if this fails, it's okay -- it might help with free space though + #- if this fails, it's okay -- it might help with free space though unlink "/sbin/install" unless $::testing; unlink "/sbin/insmod" unless $::testing; @@ -529,15 +529,15 @@ sub main { $o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt"; mkdir $o->{prefix}, 0755; - # make sure we don't pick up any gunk from the outside world + #- make sure we don't pick up any gunk from the outside world $ENV{PATH} = "/usr/bin:/bin:/sbin:/usr/sbin:/usr/X11R6/bin:$o->{prefix}/sbin:$o->{prefix}/bin:$o->{prefix}/usr/sbin:$o->{prefix}/usr/bin:$o->{prefix}/usr/X11R6/bin"; $ENV{LD_LIBRARY_PATH} = ""; - #really needed ?? + #-really needed ?? spawnSync(); eval { spawnShell() }; - # needed very early for install_steps_graphical + #- needed very early for install_steps_graphical $o->{mouse} = install_any::mouse_detect() unless $::testing || $o->{mouse}; $o = install_steps_graphical->new($o); @@ -574,7 +574,7 @@ sub main { } - #the main cycle + #-the main cycle my $clicked = 0; MAIN: for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) { $o->enteringStep($o->{step}); @@ -604,10 +604,10 @@ sub main { sub killCardServices { my $pid = chop_(cat_("/tmp/cardmgr.pid")); - $pid and kill(15, $pid); # send SIGTERM + $pid and kill(15, $pid); #- send SIGTERM } #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 5cec2da8a..0b9989377 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -125,87 +125,3 @@ sub addToBeDone(&$) { push @{$::o->{steps}{$step}{toBeDone}}, $f; } - -sub upgrFindInstall { -# int rc; -# -# if (!$::o->{table}.parts) { -# rc = findAllPartitions(NULL, &$::o->{table}); -# if (rc) return rc; -# } -# -# umountFilesystems(&$::o->{fstab}); -# -# # rootpath upgrade support -# if (strcmp($::o->{rootPath} ,"/mnt")) -# return INST_OKAY; -# -# # this also turns on swap for us -# rc = readMountTable($::o->{table}, &$::o->{fstab}); -# if (rc) return rc; -# -# if (!testing) { -# mountFilesystems(&$::o->{fstab}); -# -# if ($::o->{method}->prepareMedia) { -# rc = $::o->{method}->prepareMedia($::o->{method}, &$::o->{fstab}); -# if (rc) { -# umountFilesystems(&$::o->{fstab}); -# return rc; -# } -# } -# } -# -# return 0; -} - -sub upgrChoosePackages { -# static int firstTime = 1; -# char * rpmconvertbin; -# int rc; -# char * path; -# char * argv[] = { NULL, NULL }; -# char buf[128]; -# -# if (testing) -# path = "/"; -# else -# path = $::o->{rootPath}; -# -# if (firstTime) { -# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath}, -# "/var/lib/rpm/packages.rpm"); -# if (access(buf, R_OK)) { -# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath}, -# "/var/lib/rpm/packages"); -# if (access(buf, R_OK)) { -# errorWindow("No RPM database exists!"); -# return INST_ERROR; -# } -# -# if ($::o->{method}->getFile($::o->{method}, "rpmconvert", -# &rpmconvertbin)) { -# return INST_ERROR; -# } -# -# symlink("/mnt/var", "/var"); -# winStatus(35, 3, _("Upgrade"), _("Converting RPM database...")); -# chmod(rpmconvertbin, 0755); -# argv[0] = rpmconvertbin; -# rc = runProgram(RUN_LOG, rpmconvertbin, argv); -# if ($::o->{method}->rmFiles) -# unlink(rpmconvertbin); -# -# newtPopWindow(); -# if (rc) return INST_ERROR; -# } -# winStatus(35, 3, "Upgrade", _("Finding packages to upgrade...")); -# rc = ugFindUpgradePackages(&$::o->{packages}, path); -# newtPopWindow(); -# if (rc) return rc; -# firstTime = 0; -# psVerifyDependencies(&$::o->{packages}, 1); -# } -# -# return psSelectPackages(&$::o->{packages}, &$::o->{compss}, NULL, 0, 1); -} diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 6cd107081..cf3df79dc 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -52,17 +52,14 @@ sub enteringStep($$) { my @l = ref $needs ? @$needs : $needs; $reachable = min(map { $o->{steps}{$_}{done} || 0 } @l); } - $o->{steps}{$s}{reachable} = 1, $o->step_set_reachable($s) if $reachable; + $o->{steps}{$s}{reachable} = 1 if $reachable; } } sub leavingStep($$) { my ($o, $step) = @_; log::l("step `$step' finished"); - unless ($o->{steps}{$step}{redoable}) { - $o->{steps}{$step}{reachable} = 0; - $o->step_set_unreachable($step); - } + $o->{steps}{$step}{reachable} = $o->{steps}{$step}{redoable}; while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) { eval { &$f() }; @@ -149,7 +146,7 @@ sub installPackages($$) { sub afterInstallPackages($) { my ($o) = @_; - # why not? cuz weather is nice today :-) [pixel] + #- why not? cuz weather is nice today :-) [pixel] sync(); sync(); # configPCMCIA($o->{rootPath}, $o->{pcmcia}); @@ -175,7 +172,7 @@ sub configureNetwork($) { network::add2hosts("$etc/hosts", $o->{netc}{HOSTNAME}, map { $_->{IPADDR} } @{$o->{intf}}); network::sethostname($o->{netc}) unless $::testing; network::addDefaultRoute($o->{netc}) unless $::testing; - #res_init(); # reinit the resolver so DNS changes take affect + #-res_init(); # reinit the resolver so DNS changes take affect } #------------------------------------------------------------------------------ @@ -265,7 +262,7 @@ sub createBootdisk($) { my @l = detect_devices::floppies(); $dev = shift @l || die _("no floppy available") - if $dev eq "1"; # special case meaning autochoose + if $dev eq "1"; #- special case meaning autochoose return if $::testing; @@ -291,4 +288,4 @@ sub exitInstall {} #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index b2b42036c..70090a875 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -266,7 +266,7 @@ name and directory should be used for this queue?"), } eval { modules::unload("lp") }; -# @port =("lp0", "lp1", "lp2"); +#- @port =("lp0", "lp1", "lp2"); $o->{printer}{DEVICE} = $port[0] if $port[0]; @@ -275,7 +275,7 @@ name and directory should be used for this queue?"), [_("Printer Device:")], [{val => \$o->{printer}{DEVICE}, list => \@port }], ); - #TAKE A GOODDEFAULT TODO + #-TAKE A GOODDEFAULT TODO } elsif ($o->{printer}{TYPE} eq "REMOTE") { return if !$o->ask_from_entries_ref(_("Remote lpd Printer Options"), @@ -348,7 +348,7 @@ wish to access and any applicable user name and password."), my %db_entry = %{$printer::thedb{$o->{printer}{DBENTRY}}}; - #paper size conf + #-paper size conf $o->{printer}{PAPERSIZE} = $o->ask_from_list_(_("Paper Size"), _("Paper Size"), @@ -356,7 +356,7 @@ wish to access and any applicable user name and password."), $o->{printer}{PAPERSIZE} ); - #resolution size conf + #-resolution size conf my @list_res = @{$db_entry{RESOLUTION}}; my @res = map { "${$_}{XDPI}x${$_}{YDPI}" } @list_res; if (@list_res) { @@ -375,7 +375,7 @@ wish to access and any applicable user name and password."), $o->{printer}{CRLF}); - #color_depth + #-color_depth if ($db_entry{BITSPERPIXEL}) { my @list_col = @{$db_entry{BITSPERPIXEL}}; my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col; @@ -606,4 +606,4 @@ sub setup_thiskind { #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm index 69fb31f97..9e3d8b6a3 100644 --- a/perl-install/interactive.pm +++ b/perl-install/interactive.pm @@ -8,24 +8,24 @@ use strict; #-###################################################################################### use common qw(:common :functional); -# 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 many strings 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. +#- 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 many strings 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. @@ -119,9 +119,9 @@ sub ask_from_entries($$$$;$%) { map { $$_ } @$val : undef; } -# can get a hash of callback: focus_out changed and complete -# moreove if you pass a hash with a field list -> combo -# if you pass a hash with a field hidden -> emulate stty -echo +#- can get a hash of callback: focus_out changed and complete +#- moreove if you pass a hash with a field list -> combo +#- if you pass a hash with a field hidden -> emulate stty -echo sub ask_from_entries_ref($$$$;$%) { my ($o, $title, $message, $l, $val, %callback) = @_; @@ -146,14 +146,15 @@ sub wait_message($$$) { my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]); my $b = before_leaving { $o->wait_message_endW($w) }; - # enable access through set + #- enable access through set common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set'); $b; } sub kill { my ($o) = @_; - while ($o->{before_killing} && @interactive::objects > $o->{before_killing}) { + $o->{before_killing} ||= 0; + while (@interactive::objects > $o->{before_killing}) { my $w = pop @interactive::objects; $w->destroy; } @@ -163,4 +164,4 @@ sub kill { #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index 1afb5b420..ad4aa36ba 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -12,12 +12,12 @@ use my_gtk qw(:helpers :wrappers); 1; -## redefine ask_warn -#sub ask_warn { -# my $o = shift; -# local $my_gtk::grab = 1; -# $o->SUPER::ask_warn(@_); -#} +#-#- redefine ask_warn +#-sub ask_warn { +#- my $o = shift; +#- local $my_gtk::grab = 1; +#- $o->SUPER::ask_warn(@_); +#-} sub ask_from_entryW { my ($o, $title, $messages, $def) = @_; @@ -77,10 +77,10 @@ sub ask_many_from_list_refW($$$$$) { sub ask_from_entries_refW { my ($o, $title, $messages, $l, $val, %hcallback) = @_; my $num_fields = @{$l}; - my $ignore = 0; #to handle recursivity + my $ignore = 0; #-to handle recursivity my $w = my_gtk->new($title, %$o); - #the widgets + #-the widgets my @entries = map { if ($_->{type} eq "list") { my $depth_combo = new Gtk::Combo; @@ -113,10 +113,10 @@ sub ask_from_entries_refW { for (my $i = 0; $i < $num_fields; $i++) { - my $ind = $i; #cos lexical bindings pb !! + my $ind = $i; #-cos lexical bindings pb !! my $entry = comb_entry($entries[$i], $val->[$i]); my $changed_callback = sub { - return if $ignore; #handle recursive deadlock + return if $ignore; #-handle recursive deadlock &{$updates[$ind]}; if ($hcallback{changed}) { &{$hcallback{changed}}($ind); @@ -151,8 +151,8 @@ sub ask_from_entries_refW { my $c = chr $e->{keyval}; if ($c eq "\x8d") { - #don't know why it works, i believe that - #i must say before &$go_to_next, but with it doen't work HACK! + #-don't know why it works, i believe that + #-i must say before &$go_to_next, but with it doen't work HACK! $w->signal_emit_stop("key_press_event"); } ; @@ -175,7 +175,7 @@ sub ask_from_entries_refW { if ($hcallback{complete}) { my $callback = sub { my ($error, $focus) = &{$hcallback{complete}}; - #update all the value + #-update all the value $ignore = 1; foreach (@updates_inv) { &{$_};} $ignore = 0; diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm index 8bd75bbf3..baad33b74 100644 --- a/perl-install/keyboard.pm +++ b/perl-install/keyboard.pm @@ -23,10 +23,10 @@ my %lang2keyboard = "en" => "us", ); -# [1] = name for loadkeys, [2] = extension for Xmodmap +#- [1] = name for loadkeys, [2] = extension for Xmodmap my %keyboards = ( -# armenian xmodmap have to be checked... -# "am" => [ __("Armenian"), "am-armscii8", "am" ], +#- armenian xmodmap have to be checked... +#- "am" => [ __("Armenian"), "am-armscii8", "am" ], "be" => [ __("Belgian"), "be-latin1", "be" ], "bg" => [ __("Bulgarian"), "bg", "bg" ], "cz" => [ __("Czech"), "cz-latin2", "cz" ], @@ -35,9 +35,9 @@ my %keyboards = ( "dvorak" => [ __("Dvorak"), "dvorak", "dvorak" ], "fi" => [ __("Finnish"), "fi-latin1", "fi" ], "fr" => [ __("French"), "fr-latin1", "fr" ], -# georgian keyboards have to be written... -#"ge_ru"=>[__("Georgian (\"Russian\" layout)","ge_ru-georgian_academy","ge_ru"], -#"ge_la"=>[__("Georgian ("\Latin\" layout)","ge_la-georgian_academy","ge_ru"], +#- georgian keyboards have to be written... +#-"ge_ru"=>[__("Georgian (\"Russian\" layout)","ge_ru-georgian_academy","ge_ru"], +#-"ge_la"=>[__("Georgian ("\Latin\" layout)","ge_la-georgian_academy","ge_ru"], "gr" => [ __("Greek"), "gr-8859_7", "gr" ], "hu" => [ __("Hungarian"), "hu-latin2", "hu" ], "il" => [ __("Israelian"), "il-8859_8", "il" ], @@ -55,8 +55,8 @@ my %keyboards = ( "sg" => [ __("Swiss (german layout)"), "sg-latin1", "sg" ], "si" => [ __("Slovenian"), "si-latin1", "si" ], "sk" => [ __("Slovakian"), "sk-latin2", "sk" ], -# the xmodmap.th has to be fixed to use tis620 keymaps -# "th" => [ __("Thai keyboard"), "th", "th" ], +#- the xmodmap.th has to be fixed to use tis620 keymaps +#- "th" => [ __("Thai keyboard"), "th", "th" ], "tr_f" => [ __("Turkish (traditional \"F\" model)"), "tr_f-latin5", "tr_f" ], "tr_q" => [ __("Turkish (modern \"Q\" model)"), "tr_q-latin5", "tr_q" ], "uk" => [ __("UK keyboard"), "uk-latin1", "uk" ], @@ -144,7 +144,7 @@ sub read($) { foreach (<F>) { ($_) = /^KEYTABLE=(.*)/ or log::l("unrecognized entry in keyboard configuration file ($_)"), next; s/^\s*"(.*)"\s*$/$1/; - s/\.[^.]*//; # remove extension + s/\.[^.]*//; #- remove extension return basename($_); } die "empty keyboard configuration file"; @@ -153,4 +153,4 @@ sub read($) { #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/lang.pm b/perl-install/lang.pm index b28fd081f..fa353a776 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -13,9 +13,9 @@ use log; #-###################################################################################### #- Globals #-###################################################################################### -# key (to be used in $LC_ALL), [0] = english name, [1] = charset encoding, -# [2] = value for $LANG, [3] = value for LANGUAGE (a list of possible -# languages, carefully choosen) +#- key (to be used in $LC_ALL), [0] = english name, [1] = charset encoding, +#- [2] = value for $LANG, [3] = value for LANGUAGE (a list of possible +#- languages, carefully choosen) my %languages = ( 'en' => [ 'English', undef, 'en', 'en_US' ], 'fr_FR' => [ 'French (France)', 'iso-8859-1', 'fr', 'fr_FR' ], @@ -56,16 +56,16 @@ my %charsets = ( "iso-8859-5" => [ "iso05.f16", "iso05", "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," . "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-5" ], -# arabic needs special console driver for text mode [acon] -# (and gtk support isn't done yet) +#- arabic needs special console driver for text mode [acon] +#- (and gtk support isn't done yet) "iso-8859-6" => [ "iso06.f16", "iso06", "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," . "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-6" ], "iso-8859-7" => [ "iso07.f16", "iso07", "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," . "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-7" ], -# hebrew needs special console driver for text mode (none yet) -# (and gtk support isn't done yet) +#- hebrew needs special console driver for text mode (none yet) +#- (and gtk support isn't done yet) "iso-8859-8" => [ "iso08.f16", "iso08", "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," . "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-8" ], @@ -75,7 +75,7 @@ my %charsets = ( "iso-8859-15" => [ "lat0-sun16.psf", "iso15", "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," . "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-15" ], -# japanese needs special console driver for text mode [kon2] +#- japanese needs special console driver for text mode [kon2] "jisx0208" => [ "????", "????", "-misc-fixed-medium-r-normal--14-130-75-75-c-70-jisx0201.1976-0" ], @@ -150,32 +150,32 @@ sub write { } } -#sub load_font { -# my ($charset) = @_; -# my $fontFile = "lat0-sun16"; -# -# if (my $c = $charsets{$charset}) { -# log::l("loading $charset font"); -# $fontFile = $c->[0]; -# } -# -# # text mode font -# log::l("loading font /usr/share/consolefonts/$fontFile"); -# #c::loadFont("/tmp/$fontFile") or log::l("error in loadFont: one of PIO_FONT PIO_UNIMAPCLR PIO_UNIMAP PIO_UNISCRNMAP failed: $!"); -# #print STDERR "\033(K"; -# -#} - -sub get_x_fontset { - my ($lang) = @_; - my $def = "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1"; - - my $l = $languages{$lang} or return $def; - my $c = $charsets{$l->[1]} or return $def; - $c->[2]; -} +#-sub load_font { +#- my ($charset) = @_; +#- my $fontFile = "lat0-sun16"; +#- +#- if (my $c = $charsets{$charset}) { +#- log::l("loading $charset font"); +#- $fontFile = $c->[0]; +#- } +#- +#- # text mode font +#- log::l("loading font /usr/share/consolefonts/$fontFile"); +#- #c::loadFont("/tmp/$fontFile") or log::l("error in loadFont: one of PIO_FONT PIO_UNIMAPCLR PIO_UNIMAP PIO_UNISCRNMAP failed: $!"); +#- #print STDERR "\033(K"; +#- +#-} + +#-sub get_x_fontset { +#- my ($lang) = @_; +#- my $def = "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1"; +#- +#- my $l = $languages{$lang} or return $def; +#- my $c = $charsets{$l->[1]} or return $def; +#- $c->[2]; +#-} #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/log.pm b/perl-install/log.pm index 3f119b365..b1428408d 100644 --- a/perl-install/log.pm +++ b/perl-install/log.pm @@ -27,7 +27,7 @@ sub w { &l } sub openLog(;$) { if ($::isStandalone) { open LOG, ">&STDERR"; - } elsif ($_[0]) { # useLocal + } elsif ($_[0]) { #- useLocal open LOG, "> $_[0]";# or die "no log possible :("; } else { open LOG, "> /dev/tty3" or open LOG, ">> /tmp/install.log";# or die "no log possible :("; @@ -44,4 +44,4 @@ sub closeLog() { close LOG; close LOG2; } #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/modules.pm b/perl-install/modules.pm index 46ff2b068..d0c38d49c 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -15,91 +15,30 @@ my $scsi = 0; my %deps = (); -my @neOptions = ( - [ "io=", "Base IO port:", "0x300:0x280:0x320:0x340:0x360" ], - [ "irq=", "IRQ level:", "" ], -); - -my @de4x5Options = ( - [ "io=", "Base IO port:", "0x0b" ], -); - -my @cdu31aOptions = ( - [ "cdu31a_port=", "Base IO port:", "" ], - [ "cdu31a_irq=", "IRQ level:", "" ], -); - -# -#my %knownAliases = ( -# eth => { type => 'net', minor => 'ethernet' }, -# scsi_hostadapter => { type => 'scsi' }, -#); -# -#my @neOptions = ( -# [ "io=", __("Base IO port:"), "0x300", "0x280", "0x320", "0x340", "0x360" ], -# [ "irq=", __("IRQ level:"), "" ], -#); -# -#my @de4x5Options = ( -# [ "io=", __("Base IO port:"), "0x0b" ], -#); -# -#my @cdu31aOptions = ( -# [ "cdu31a_port=", __("Base IO port:"), "" ], -# [ "cdu31a_irq=", __("IRQ level:"), "" ], -#); -# -#my @cm206Options = ( -# [ "cm206=", __("IO base, IRQ:"), "" ], -#); -# -#my @mcdOptions = ( -# [ "mcd=", __("Base IO port:"), "" ], -#); -# -#my @optcdOptions = ( -# [ "optcd=", __("Base IO port:"), "" ], -#); -# -#my @fdomainOptions = ( -# [ "setup_called=", __("Use other options"), "1" ], -# [ "port_base=", __("Base IO port:"), "0xd800" ], -# [ "interrupt_level=", __("Interrupt level (IRQ):"), "10" ], -#); -# -#my @sbpcdOptions = ( -# [ "sbpcd=", __("IO base, IRQ, label:"), "" ], -#); -# -#my @parportPcOptions = ( -# [ "io=", __("Base IO port:"), "0x378" ], -# [ "irq=", __("IRQ level:"), "7" ], -#); -# -#my @modules_fields = qw(shouldAutoprobe options flags defaultOptions); -#my %modules = ( -# "8390" => [ 1 ], -# "cdu31a" => [ 0, \@cdu31aOptions ], -# "cm206" => [ 0, \@cm206Options ], -# "de4x5" => [ 1, \@de4x5Options, 'AUTOPROBE', "io=0" ], -# "ds" => [ 1, undef, 0, '' ], -# "fdomain" => [ 1, \@fdomainOptions, 0, '' ], -# "i82365" => [ 1, undef, 0, '' ], -# "isofs" => [ 1, undef, 0, '' ], -# "loop" => [ 1, undef, 0, '' ], -# "lp" => [ 1, undef, 0, '' ], -# "parport" => [ 1, undef, 0, '' ], -# "parport_pc" => [ 1, \@parportPcOptions, 0, "irq=7" ], -# "mcd" => [ 0, \@mcdOptions, 0, '' ], -# "ne" => [ 0, \@neOptions, 'FAKEAUTOPROBE', "io=0x300" ], -# "nfs" => [ 1, undef, 0, '' ], -# "optcd" => [ 0, \@optcdOptions, 0, '' ], -# "pcmcia_core" => [ 1, undef, 0, '' ], -# "sbpcd" => [ 1, \@sbpcdOptions, 0, '' ], -# "smbfs" => [ 1, undef, 0, '' ], -# "tcic" => [ 1, undef, 0, '' ], -# "vfat" => [ 1, undef, 0, '' ], -#); +#-my @modules_fields = qw(shouldAutoprobe options flags defaultOptions); +#-my %modules = ( +#- "8390" => [ 1 ], +#- "cdu31a" => [ 0, \@cdu31aOptions ], +#- "cm206" => [ 0, \@cm206Options ], +#- "de4x5" => [ 1, \@de4x5Options, 'AUTOPROBE', "io=0" ], +#- "ds" => [ 1, undef, 0, '' ], +#- "fdomain" => [ 1, \@fdomainOptions, 0, '' ], +#- "i82365" => [ 1, undef, 0, '' ], +#- "isofs" => [ 1, undef, 0, '' ], +#- "loop" => [ 1, undef, 0, '' ], +#- "lp" => [ 1, undef, 0, '' ], +#- "parport" => [ 1, undef, 0, '' ], +#- "parport_pc" => [ 1, \@parportPcOptions, 0, "irq=7" ], +#- "mcd" => [ 0, \@mcdOptions, 0, '' ], +#- "ne" => [ 0, \@neOptions, 'FAKEAUTOPROBE', "io=0x300" ], +#- "nfs" => [ 1, undef, 0, '' ], +#- "optcd" => [ 0, \@optcdOptions, 0, '' ], +#- "pcmcia_core" => [ 1, undef, 0, '' ], +#- "sbpcd" => [ 1, \@sbpcdOptions, 0, '' ], +#- "smbfs" => [ 1, undef, 0, '' ], +#- "tcic" => [ 1, undef, 0, '' ], +#- "vfat" => [ 1, undef, 0, '' ], +#-); my @drivers_by_category = ( [ \&detect_devices::hasEthernet, 'net', 'ethernet', { "3c509" => "3com 3c509", @@ -274,7 +213,7 @@ sub load_raw($@) { run_program::run("insmod", $name, @options) or die("insmod $name failed"); - # this is a hack to make plip go + #- this is a hack to make plip go if ($name eq "parport_pc") { foreach (@options) { /^irq=(\d+)/ or next; @@ -315,7 +254,7 @@ sub read_conf($;$) { $$scsi = max($$scsi, $1 || 0) if /^\s*alias\s+scsi_hostadapter (\d*)/x && $scsi; } if /^\s*(\S+)\s+(\S+)\s+(.*?)\s*$/; } - # cheating here: not handling aliases of aliases + #- cheating here: not handling aliases of aliases while (my ($k, $v) = each %c) { $$scsi ||= $v->{scsi_hostadapter} if $scsi; if (my $a = $v->{alias}) { @@ -372,15 +311,15 @@ sub load_thiskind($;&) { } } -# This assumes only one of each driver type is loaded -sub removeDeviceDriver { -# my ($type) = @_; -# -# my @m = grep { $loaded{$_}{type} eq $type } keys %loaded; -# @m or return 0; -# @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")"); -# removeModule($m[0]); -# 1; -} +#-#- This assumes only one of each driver type is loaded +#-sub removeDeviceDriver { +#- my ($type) = @_; +#- +#- my @m = grep { $loaded{$_}{type} eq $type } keys %loaded; +#- @m or return 0; +#- @m > 1 and log::l("removeDeviceDriver assume only one of each driver type is loaded, which is not the case (" . join(' ', @m) . ")"); +#- removeModule($m[0]); +#- 1; +#-} diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index 7ebbd0fda..33f753638 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -17,14 +17,14 @@ use Gtk; use c; use common qw(:common :functional); -my $forgetTime = 1000; # in milli-seconds +my $forgetTime = 1000; #- in milli-seconds $border = 5; 1; -################################################################################ -# OO stuff -################################################################################ +#-############################################################################### +#- OO stuff +#-############################################################################### sub new { my ($type, $title, %opts) = @_; @@ -169,11 +169,11 @@ sub gtkset_default_fontset($) { } -################################################################################ -# createXXX functions +#-############################################################################### +#- createXXX functions -# these functions return a widget -################################################################################ +#- these functions return a widget +#-############################################################################### sub create_okcancel($;$$) { my ($w, $ok, $cancel) = @_; @@ -316,11 +316,11 @@ sub _create_window($$) { -################################################################################ -# ask_XXX +#-############################################################################### +#- ask_XXX -# just give a title and some args, and it will return the value given by the user -################################################################################ +#- just give a title and some args, and it will return the value given by the user +#-############################################################################### sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); } sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); } @@ -394,7 +394,7 @@ sub _ask_from_list($$$$) { gtkpack($o->create_box_with_title(@$messages), @$l > 15 ? gtkset_usize(createScrolledWindow($list), 200, 280) : $list)); - $o->sync; # otherwise the moveto is not done + $o->sync; #- otherwise the moveto is not done map_index { $list->append($_); &$select($::i) if $def && $_ eq $def; @@ -434,16 +434,16 @@ sub _ask_file($$) { $f->hide_fileop_buttons; } -################################################################################ -# rubbish -################################################################################ +#-############################################################################### +#- rubbish +#-############################################################################### -#sub label_align($$) { -# my $w = shift; -# local $_ = shift; -# $w->set_alignment(!/W/i, !/N/i); -# $w -#} +#-sub label_align($$) { +#- my $w = shift; +#- local $_ = shift; +#- $w->set_alignment(!/W/i, !/N/i); +#- $w +#-} #-sub _ask_from_list($$$$) { #- my ($o, $messages, $l, $def) = @_; diff --git a/perl-install/network.pm b/perl-install/network.pm index cc5c74fa6..7529261bd 100644 --- a/perl-install/network.pm +++ b/perl-install/network.pm @@ -48,7 +48,7 @@ sub write_conf { sub write_resolv_conf { my ($file, $netc) = @_; - # We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work. + #- We always write these, even if they were autoconfigured. Otherwise, the reverse name lookup in the install doesn't work. unless ($netc->{DOMAINNAME} || dnsServers($netc)) { unlink($file); log::l("neither domain name nor dns server are configured"); @@ -62,7 +62,7 @@ sub write_resolv_conf { print F "nameserver $_\n" foreach dnsServers($netc); print F "#$_" foreach @l; - #res_init(); # reinit the resolver so DNS changes take affect + #-res_init(); # reinit the resolver so DNS changes take affect 1; } @@ -158,13 +158,13 @@ sub netmask { return "255.255.255.0" unless is_ip($ip); $ip =~ $ip_regexp; if ($1 >= 1 && $1 < 127) { - return "255.0.0.0"; #1.0.0.0 to 127.0.0.0 + return "255.0.0.0"; #-1.0.0.0 to 127.0.0.0 } elsif ($1 >= 128 && $1 <= 191 ){ - return "255.255.0.0"; #128.0.0.0 to 191.255.0.0 + return "255.255.0.0"; #-128.0.0.0 to 191.255.0.0 } elsif ($1 >= 192 && $1 <= 223) { return "255.255.255.0"; } else { - return "255.255.255.255"; #experimental classes + return "255.255.255.255"; #-experimental classes } } @@ -198,4 +198,4 @@ sub gateway { #-###################################################################################### #- Wonderful perl :( #-###################################################################################### -1; # +1; diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 800a65c60..65b084f21 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -29,7 +29,7 @@ my %types = ( 4 => "DOS 16-bit <32M", 5 => "Extended", 6 => "DOS FAT16", - 7 => "OS/2 HPFS", # or QNX? + 7 => "OS/2 HPFS", #- or QNX? 8 => "AIX", 9 => "AIX bootable", 10 => "OS/2 Boot Manager", @@ -39,28 +39,28 @@ my %types = ( 0x12 => "Compaq setup", 0x40 => "Venix 80286", 0x51 => "Novell?", - 0x52 => "Microport", # or CPM? - 0x63 => "GNU HURD", # or System V/386? + 0x52 => "Microport", #- or CPM? + 0x63 => "GNU HURD", #- or System V/386? 0x64 => "Novell Netware 286", 0x65 => "Novell Netware 386", 0x75 => "PC/IX", - 0x80 => "Old MINIX", # Minix 1.4a and earlier + 0x80 => "Old MINIX", #- Minix 1.4a and earlier - 0x81 => "Linux/MINIX", # Minix 1.4b and later + 0x81 => "Linux/MINIX", #- Minix 1.4b and later 0x82 => "Linux swap", 0x83 => "Linux native", 0x93 => "Amoeba", - 0x94 => "Amoeba BBT", # (bad block table) + 0x94 => "Amoeba BBT", #- (bad block table) 0xa5 => "BSD/386", 0xb7 => "BSDI fs", 0xb8 => "BSDI swap", 0xc7 => "Syrinx", - 0xdb => "CP/M", # or Concurrent DOS? + 0xdb => "CP/M", #- or Concurrent DOS? 0xe1 => "DOS access", 0xe3 => "DOS R/O", 0xf2 => "DOS secondary", - 0xff => "BBT" # (bad track table) + 0xff => "BBT" #- (bad track table) ); my %type2fs = ( @@ -74,7 +74,7 @@ my %type2fs = ( 0x0e => 'vfat', 0x82 => 'swap', 0x83 => 'ext2', - nfs => 'nfs', # hack + nfs => 'nfs', #- hack ); my %types_rev = reverse %types; my %fs2type = reverse %type2fs; @@ -94,7 +94,7 @@ sub isSwap($) { $type2fs{$_[0]{type}} eq 'swap' } sub isExt2($) { $type2fs{$_[0]{type}} eq 'ext2' } sub isDos($) { $ {{ 1=>1, 4=>1, 6=>1 }}{$_[0]{type}} } sub isWin($) { $ {{ 0xb=>1, 0xc=>1, 0xe=>1 }}{$_[0]{type}} } -sub isNfs($) { $_[0]{type} eq 'nfs' } # small hack +sub isNfs($) { $_[0]{type} eq 'nfs' } #- small hack sub isPrimary($$) { my ($part, $hd) = @_; @@ -160,10 +160,10 @@ sub assign_device_numbers($) { $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}{raw}}, map { $_->{normal} } @{$hd->{extended} || []}; - # try to figure what the windobe drive letter could be! + #- try to figure what the windobe drive letter could be! # - # first verify there's at least one primary dos partition, otherwise it - # means it is a secondary disk and all will be false :( + #- first verify there's at least one primary dos partition, otherwise it + #- means it is a secondary disk and all will be false :( my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}{normal}}; $c or return; @@ -206,10 +206,10 @@ sub adjust_main_extended($) { $l->{size} = $hd->{primary}{extended}{size} = $end - $start; } unless (@{$hd->{extended} || []} || !$hd->{primary}{extended}) { - %{$hd->{primary}{extended}} = (); # modify the raw entry + %{$hd->{primary}{extended}} = (); #- modify the raw entry delete $hd->{primary}{extended}; } - verifyParts($hd); # verify everything is all right + verifyParts($hd); #- verify everything is all right } @@ -265,7 +265,7 @@ sub read_extended($$) { @{$pt->{normal}} <= 1 or die "more than one normal partition in extended partition"; @{$pt->{normal}} >= 1 or die "no normal partition in extended partition"; $pt->{normal} = $pt->{normal}[0]; - # in case of extended partitions, the start sector is local to the partition or to the first extended_part! + #- in case of extended partitions, the start sector is local to the partition or to the first extended_part! $pt->{normal}{start} += $pt->{start}; verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition"; @@ -281,7 +281,7 @@ sub read_extended($$) { sub write($) { my ($hd) = @_; - # set first primary partition active if no primary partitions are marked as active. + #- set first primary partition active if no primary partitions are marked as active. for ($hd->{primary}{raw}) { (grep { $_->{local_start} = $_->{start}; $_->{active} ||= 0 } @$_) or $_->[0]{active} = 0x80; } @@ -296,7 +296,7 @@ sub write($) { } $hd->{isDirty} = 0; - # now sync disk and re-read the partition table + #- now sync disk and re-read the partition table if ($hd->{needKernelReread}) { sync(); partition_table_raw::kernel_read($hd); @@ -317,21 +317,21 @@ sub remove($$) { my ($hd, $part) = @_; my $i; - # first search it in the primary partitions + #- first search it in the primary partitions $i = 0; foreach (@{$hd->{primary}{normal}}) { if ($_ eq $part) { splice(@{$hd->{primary}{normal}}, $i, 1); - %$_ = (); # blank it + %$_ = (); #- blank it return $hd->{isDirty} = $hd->{needKernelReread} = 1; } $i++; } - # otherwise search it in extended partitions + #- otherwise search it in extended partitions foreach (@{$hd->{extended}}) { $_->{normal} eq $part or next; - delete $_->{normal}; # remove it + delete $_->{normal}; #- remove it remove_empty_extended($hd); return $hd->{isDirty} = $hd->{needKernelReread} = 1; @@ -344,12 +344,12 @@ sub add_primary($$) { my ($hd, $part) = @_; { - local $hd->{primary}{normal}; # save it to fake an addition of $part, that way add_primary do not modify $hd if it fails + local $hd->{primary}{normal}; #- save it to fake an addition of $part, that way add_primary do not modify $hd if it fails push @{$hd->{primary}{normal}}, $part; - adjust_main_extended($hd); # verify + adjust_main_extended($hd); #- verify raw_add($hd->{primary}{raw}, $part); } - push @{$hd->{primary}{normal}}, $part; # really do it + push @{$hd->{primary}{normal}}, $part; #- really do it } sub add_extended($$) { @@ -363,7 +363,7 @@ sub add_extended($$) { my $start = min($e->{start}, $part->{start}); $end = max($end, $part->{start} + $part->{size}) - $start; - { # faking a resizing of the main extended partition to test for problems + { #- faking a resizing of the main extended partition to test for problems local $e->{start} = $start; local $e->{size} = $end - $start; eval { verifyPrimary($hd->{primary}) }; @@ -386,7 +386,7 @@ The only solution is to move your primary partitions to have the hole next to th } else { my ($ext, $ext_size) = is_empty_array_ref($hd->{extended}) ? - ($hd->{primary}, -1) : # -1 size will be computed by adjust_main_extended + ($hd->{primary}, -1) : #- -1 size will be computed by adjust_main_extended (top(@{$hd->{extended}}), $part->{size}); my %ext = ( type => 5, start => $part->{start}, size => $ext_size ); @@ -394,7 +394,7 @@ The only solution is to move your primary partitions to have the hole next to th $ext->{extended} = \%ext; push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part }; } - $part->{start}++; $part->{size}--; # let it start after the extended partition sector + $part->{start}++; $part->{size}--; #- let it start after the extended partition sector adjustStartAndEnd($hd, $part); adjust_main_extended($hd); @@ -407,7 +407,7 @@ sub add($$;$) { $part->{isFormatted} = 0; $part->{rootDevice} = $hd->{device}; $hd->{isDirty} = $hd->{needKernelReread} = 1; - $part->{start} ||= 1; # starting at sector 0 is not allowed + $part->{start} ||= 1; #- starting at sector 0 is not allowed adjustStartAndEnd($hd, $part); my $e = $hd->{primary}{extended}; @@ -417,10 +417,10 @@ sub add($$;$) { eval { add_primary($hd, $part) }; return unless $@; } - eval { add_extended($hd, $part) }; # try adding extended + eval { add_extended($hd, $part) }; #- try adding extended if (my $err = $@) { eval { add_primary($hd, $part) }; - die $@ if $@; # send the add extended error which should be better + die $@ if $@; #- send the add extended error which should be better } } @@ -471,7 +471,7 @@ sub load($$;$) { $h{totalsectors} == $hd->{totalsectors} or $force or cdie("Bad totalsectors"); - # unsure we don't modify totalsectors + #- unsure we don't modify totalsectors local $hd->{totalsectors}; @{$hd}{@fields2save} = @$h; diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm index ff54ef765..c97a8a094 100644 --- a/perl-install/partition_table_raw.pm +++ b/perl-install/partition_table_raw.pm @@ -26,7 +26,7 @@ sub compute_CHS($$) { sub CHS2rawCHS($$$) { my ($c, $h, $s) = @_; - $c = min($c, 1023); # no way to have a #cylinder >= 1024 + $c = min($c, 1023); #- no way to have a #cylinder >= 1024 ($c & 0xff, $h, $s | ($c >> 2 & 0xc0)); } @@ -73,7 +73,7 @@ sub read($$) { \%h; } (1..$nb_primary); - # check magic number + #- check magic number sysread F, $tmp, length $magic or die "error reading magic number"; $tmp eq $magic or die "bad magic number"; @@ -92,7 +92,7 @@ sub write($$$) { foreach (@$pt) { compute_CHS($hd, $_); local $_->{start} = $_->{local_start} || 0; - $_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; # for no warning + $_->{active} ||= 0; $_->{type} ||= 0; $_->{size} ||= 0; #- for no warning syswrite F, pack($format, @$_{@fields}), psizeof($format) or return 0; } syswrite F, $magic, length $magic or return 0; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 0f50ed3a5..edb6f441c 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -24,11 +24,11 @@ sub Package { sub select($$;$) { my ($packages, $p, $base) = @_; $p->{base} ||= $base; - $p->{selected} = -1; # selected by user + $p->{selected} = -1; #- selected by user my @l = @{$p->{deps} || die "missing deps file"}; while (@l) { my $n = shift @l; - $n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice + $n =~ /|/ and $n = first(split '\|', $n); #-TODO better handling of choice my $i = Package($packages, $n) or next; $i->{base} ||= $base; $i->{deps} or log::l("missing deps for $n"); @@ -42,11 +42,11 @@ sub unselect($$) { my $set = set_new($p->{name}); my $l = $set->{list}; - # get the list of provided packages + #- get the list of provided packages foreach my $q (@$l) { my $i = Package($packages, $q); $i->{selected} && !$i->{base} or next; - $i->{selected} = 1; # that way, its counter will be zero the first time + $i->{selected} = 1; #- that way, its counter will be zero the first time set_add($set, @{$i->{provides} || []}); } @@ -60,7 +60,7 @@ sub unselect($$) { } } - # garbage collect for circular dependencies + #- garbage collect for circular dependencies my $changed = 1; while ($changed) { $changed = 0; @@ -280,7 +280,7 @@ sub install { log::ld("starting installation: ", $nb, " packages, ", $total, " bytes"); - # !! do not translate these messages, they are used when catched (cf install_steps_graphical) + #- !! do not translate these messages, they are used when catched (cf install_steps_graphical) my $callbackOpen = sub { my $fd = install_any::getFile($_[0]) or log::l("bad file $_[0]"); $fd ? fileno $fd : -1; diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm index e4747dc87..26c98f886 100644 --- a/perl-install/resize_fat/any.pm +++ b/perl-install/resize_fat/any.pm @@ -18,7 +18,7 @@ $DIRECTORY = 2; 1; -# returns the number of clusters for a given filesystem type +#- returns the number of clusters for a given filesystem type sub min_cluster_count($) { my ($fs) = @_; (1 << $ {{ FAT16 => 12, FAT32 => 12 }}{$fs->{fs_type}}) - 12; @@ -30,20 +30,20 @@ sub max_cluster_count($) { -# calculates the minimum size of a partition, in physical sectors +#- calculates the minimum size of a partition, in physical sectors sub min_size($) { my ($fs) = @_; my $count = $fs->{clusters}{count}; - # directories are both in `used' and `dirs', so are counted twice - # It's done on purpose since we're moving all directories. So at the worse - # moment, 2 directories are there, but that way nothing wrong can happen :) + #- directories are both in `used' and `dirs', so are counted twice + #- It's done on purpose since we're moving all directories. So at the worse + #- moment, 2 directories are there, but that way nothing wrong can happen :) my $min_cluster_count = max(2 + $count->{used} + $count->{bad} + $count->{dirs}, min_cluster_count($fs)); $min_cluster_count * divide($fs->{cluster_size}, $SECTORSIZE) + divide($fs->{cluster_offset}, $SECTORSIZE); } -# calculates the maximum size of a partition, in physical sectors +#- calculates the maximum size of a partition, in physical sectors sub max_size($) { my ($fs) = @_; @@ -53,8 +53,8 @@ sub max_size($) { divide($fs->{cluster_offset}, $SECTORSIZE); } -# fills in $fs->{fat_flag_map}. -# Each FAT entry is flagged as either FREE, FILE or DIRECTORY. +#- fills in $fs->{fat_flag_map}. +#- Each FAT entry is flagged as either FREE, FILE or DIRECTORY. sub flag_clusters { my ($fs) = @_; my ($cluster, $entry, $type); diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm index cd8f52cac..6da81e420 100644 --- a/perl-install/resize_fat/boot_sector.pm +++ b/perl-install/resize_fat/boot_sector.pm @@ -11,41 +11,41 @@ use resize_fat::directory; my $format = "a3 a8 S C S C S S C S S S I I I S S I S S a458 S"; my @fields = ( - 'boot_jump', # boot strap short or near jump - 'system_id', # Name - can be used to special case partition manager volumes - 'sector_size', # bytes per logical sector - 'cluster_size_in_sectors', # sectors/cluster - 'nb_reserved', # reserved sectors - 'nb_fats', # number of FATs - 'nb_root_dir_entries', # number of root directory entries - 'small_nb_sectors', # number of sectors: big_nb_sectors supersedes - 'media', # media code - 'fat16_fat_length', # sectors/FAT for FAT12/16 + 'boot_jump', #- boot strap short or near jump + 'system_id', #- Name - can be used to special case partition manager volumes + 'sector_size', #- bytes per logical sector + 'cluster_size_in_sectors', #- sectors/cluster + 'nb_reserved', #- reserved sectors + 'nb_fats', #- number of FATs + 'nb_root_dir_entries', #- number of root directory entries + 'small_nb_sectors', #- number of sectors: big_nb_sectors supersedes + 'media', #- media code + 'fat16_fat_length', #- sectors/FAT for FAT12/16 'sectors_per_track', 'nb_heads', - 'nb_hidden', # (unused) - 'big_nb_sectors', # number of sectors (if small_nb_sectors == 0) - -# FAT32-only entries - 'fat32_fat_length', # size of FAT in sectors - 'fat32_flags', # bit8: fat mirroring, - # low4: active fat - 'fat32_version', # minor * 256 + major + 'nb_hidden', #- (unused) + 'big_nb_sectors', #- number of sectors (if small_nb_sectors == 0) + +#- FAT32-only entries + 'fat32_fat_length', #- size of FAT in sectors + 'fat32_flags', #- bit8: fat mirroring, + #- low4: active fat + 'fat32_version', #- minor * 256 + major 'fat32_root_dir_cluster', 'info_offset_in_sectors', 'fat32_backup_sector', -# Common again... - 'boot_code', # Boot code (or message) - 'boot_sign', # 0xAA55 +#- Common again... + 'boot_code', #- Boot code (or message) + 'boot_sign', #- 0xAA55 ); 1; -# trimfs_init_boot_sector() - reads in the boot sector - gets important info out -# of boot sector, and puts in main structure - performs sanity checks - returns 1 -# on success, 0 on failureparameters: filesystem an empty structure to fill. +#- trimfs_init_boot_sector() - reads in the boot sector - gets important info out +#- of boot sector, and puts in main structure - performs sanity checks - returns 1 +#- on success, 0 on failureparameters: filesystem an empty structure to fill. sub read($) { my ($fs) = @_; @@ -60,11 +60,11 @@ sub read($) { $fs->{nb_sectors} < 32 and die "Too few sectors for viable file system\n"; if ($fs->{fat16_fat_length}) { - # asserting FAT16, will be verified later on + #- asserting FAT16, will be verified later on $fs->{fs_type} = 'FAT16'; $fs->{fs_type_size} = 16; $fs->{fat_length} = $fs->{fat16_fat_length}; - $resize_fat::bad_cluster_value = 0xfff7; # 2**16 - 1 + $resize_fat::bad_cluster_value = 0xfff7; #- 2**16 - 1 } else { $resize_fat::isFAT32 = 1; $fs->{fs_type} = 'FAT32'; @@ -84,12 +84,12 @@ sub read($) { $fs->{nb_fat_entries} = divide($fs->{fat_size}, $fs->{fs_type_size} / 8); - # - 2 because clusters 0 & 1 doesn't exist + #- - 2 because clusters 0 & 1 doesn't exist $fs->{nb_clusters} = divide($fs->{nb_sectors} * $fs->{sector_size} - $fs->{cluster_offset}, $fs->{cluster_size}) - 2; $fs->{dir_entries_per_cluster} = divide($fs->{cluster_size}, psizeof($format)); -# $fs->{nb_clusters} >= resize_fat::any::min_cluster_count($fs) or die "error: not enough sectors for a $fs->{fs_type}\n"; +#- $fs->{nb_clusters} >= resize_fat::any::min_cluster_count($fs) or die "error: not enough sectors for a $fs->{fs_type}\n"; $fs->{nb_clusters} < resize_fat::any::max_cluster_count($fs) or die "error: too many sectors for a $fs->{fs_type}\n"; } @@ -100,7 +100,7 @@ sub write($) { eval { resize_fat::io::write($fs, 0, $SECTORSIZE, $boot) }; $@ and die "writing the boot sector failed on device $fs->{fs_name}"; if ($resize_fat::isFAT32) { - # write backup + #- write backup eval { resize_fat::io::write($fs, $fs->{fat32_backup_sector} * $SECTORSIZE, $SECTORSIZE, $boot) }; $@ and die "writing the backup boot sector (#$fs->{fat32_backup_sector}) failed on device $fs->{fs_name}"; } diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm index fa5ebb344..47f326735 100644 --- a/perl-install/resize_fat/dir_entry.pm +++ b/perl-install/resize_fat/dir_entry.pm @@ -46,7 +46,7 @@ sub is_special_entry($) { my ($entry) = @_; my ($c) = unpack "C", $entry->{name}; - # skip empty slots, deleted files, and 0xF6?? (taken from kernel) + #- skip empty slots, deleted files, and 0xF6?? (taken from kernel) $c == 0 || $c == $DELETED_FLAG || $c == 0xF6 and return 1; $entry->{attributes} == $VFAT_ATTR and return 1; @@ -54,7 +54,7 @@ sub is_special_entry($) { } -# return true if entry has been modified +#- return true if entry has been modified sub remap { my ($fat_remap, $entry) = @_; @@ -63,9 +63,9 @@ sub remap { my $cluster = get_cluster($entry); my $new_cluster = $fat_remap->[$cluster]; - #print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster"; + #-print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster"; - $new_cluster == $cluster and return; # no need to modify + $new_cluster == $cluster and return; #- no need to modify set_cluster($entry, $new_cluster); 1; diff --git a/perl-install/resize_fat/directory.pm b/perl-install/resize_fat/directory.pm index 00ae6a870..3b779e2de 100644 --- a/perl-install/resize_fat/directory.pm +++ b/perl-install/resize_fat/directory.pm @@ -14,11 +14,11 @@ my @fields = ( 'extension', 'attributes', 'is_upper_case_name', - 'creation_time_low', # milliseconds + 'creation_time_low', #- milliseconds 'creation_time_high', 'creation_date', 'access_date', - 'first_cluster_high', # for FAT32 + 'first_cluster_high', #- for FAT32 'time', 'date', 'first_cluster', @@ -29,15 +29,15 @@ my @fields = ( sub entry_size { psizeof($format) } -# call `f' for each entry of the directory -# if f return true, then modification in the entry are taken back +#- call `f' for each entry of the directory +#- if f return true, then modification in the entry are taken back sub traverse($$$) { my ($fs, $directory, $f) = @_; for (my $i = 0;; $i++) { my $raw = \substr($directory, $i * psizeof($format), psizeof($format)); - # empty entry means end of directory + #- empty entry means end of directory $$raw =~ /^\0*$/ and return $directory; my $entry; @{$entry}{@fields} = unpack $format, $$raw; @@ -59,7 +59,7 @@ sub traverse_all($$) { resize_fat::dir_entry::is_directory($entry) and traverse($fs, resize_fat::io::read_file($fs, resize_fat::dir_entry::get_cluster($entry)), $traverse_all); - undef; # no need to write back (cf traverse) + undef; #- no need to write back (cf traverse) }; my $directory = $resize_fat::isFAT32 ? @@ -69,8 +69,8 @@ sub traverse_all($$) { } -# function used by construct_dir_tree to translate the `cluster' fields in each -# directory entry +#- function used by construct_dir_tree to translate the `cluster' fields in each +#- directory entry sub remap { my ($fs, $directory) = @_; diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm index 87ce2af71..5c0b259b4 100644 --- a/perl-install/resize_fat/fat.pm +++ b/perl-install/resize_fat/fat.pm @@ -42,10 +42,10 @@ sub write($) { -# allocates where all the clusters will be moved to. Clusters before cut_point -# remain in the same position, however cluster that are part of a directory are -# moved regardless (this is a mechanism to prevent data loss) (cut_point is the -# first cluster that won't occur in the new fs) +#- allocates where all the clusters will be moved to. Clusters before cut_point +#- remain in the same position, however cluster that are part of a directory are +#- moved regardless (this is a mechanism to prevent data loss) (cut_point is the +#- first cluster that won't occur in the new fs) sub allocate_remap { my ($fs, $cut_point) = @_; my ($cluster, $new_cluster); @@ -53,8 +53,8 @@ sub allocate_remap { my $get_new = sub { $new_cluster = get_free($fs); 0 < $new_cluster && $new_cluster < $cut_point or die "no free clusters"; - set_eof($fs, $new_cluster); # mark as used - #log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster..."); + set_eof($fs, $new_cluster); #- mark as used + #-log::ld("resize_fat: [$cluster,", &next($fs, $cluster), "...]->$new_cluster..."); }; $fs->{fat_remap}[0] = 0; @@ -75,7 +75,7 @@ sub allocate_remap { } -# updates the fat for the resized filesystem +#- updates the fat for the resized filesystem sub update { my ($fs) = @_; @@ -95,9 +95,9 @@ sub update { } -# - compares the two FATs (one's a backup that should match) - skips first entry -# - its just a signature (already checked above) NOTE: checks for cross-linking -# are done in count.c +#- - compares the two FATs (one's a backup that should match) - skips first entry +#- - its just a signature (already checked above) NOTE: checks for cross-linking +#- are done in count.c sub check($) { my ($fs) = @_; foreach (@{$fs->{fats}}) { @@ -140,7 +140,7 @@ sub get_free($) { die "no free clusters"; } -# returns true if <cluster> represents an EOF marker +#- returns true if <cluster> represents an EOF marker sub is_eof($) { my ($cluster) = @_; $cluster >= $resize_fat::bad_cluster_value; @@ -150,13 +150,13 @@ sub set_eof($$) { set_next($fs, $cluster, $resize_fat::bad_cluster_value + 1); } -# returns true if <cluster> is empty. Note that this includes bad clusters. +#- returns true if <cluster> is empty. Note that this includes bad clusters. sub is_empty($) { my ($cluster) = @_; $cluster == 0 || $cluster == $resize_fat::bad_cluster_value; } -# returns true if <cluster> is available. +#- returns true if <cluster> is available. sub is_available($) { my ($cluster) = @_; $cluster == 0; diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm index 2eacf58ca..3a6f7cfed 100644 --- a/perl-install/resize_fat/info_sector.pm +++ b/perl-install/resize_fat/info_sector.pm @@ -9,9 +9,9 @@ use resize_fat::io; my $format = "a484 I I I a16"; my @fields = ( 'unused', - 'signature', # should be 0x61417272 - 'free_clusters', # -1 for unknown - 'next_cluster', # most recently allocated cluster + 'signature', #- should be 0x61417272 + 'free_clusters', #- -1 for unknown + 'next_cluster', #- most recently allocated cluster 'unused2', ); diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm index 55cc34d7b..692ade0cb 100644 --- a/perl-install/resize_fat/main.pm +++ b/perl-install/resize_fat/main.pm @@ -36,7 +36,7 @@ use resize_fat::any; 1; -# - reads in the boot sector/partition info., and tries to make some sense of it +#- - reads in the boot sector/partition info., and tries to make some sense of it sub new($$$) { my ($type, $device, $fs_name) = @_; my $fs = { device => $device, fs_name => $fs_name } ; @@ -51,9 +51,9 @@ sub new($$$) { bless $fs, $type; } -# copy all clusters >= <start_cluster> to a new place on the partition, less -# than <start_cluster>. Only copies files, not directories. -# (use of buffer needed because the seeks slow like hell the hard drive) +#- copy all clusters >= <start_cluster> to a new place on the partition, less +#- than <start_cluster>. Only copies files, not directories. +#- (use of buffer needed because the seeks slow like hell the hard drive) sub copy_clusters { my ($fs, $cluster) = @_; my @buffer; @@ -71,13 +71,13 @@ sub copy_clusters { &$flush(); } -# Constructs the new directory tree to match the new file locations. +#- Constructs the new directory tree to match the new file locations. sub construct_dir_tree { my ($fs) = @_; if ($resize_fat::isFAT32) { - # fat32's root must remain in the first 64k clusters - # so don't set it as DIRECTORY, it will be specially handled + #- fat32's root must remain in the first 64k clusters + #- so don't set it as DIRECTORY, it will be specially handled $fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE; } @@ -91,12 +91,12 @@ sub construct_dir_tree { sync(); - # until now, only free clusters have been written. it's a null operation if we stop here. - # it means no corruption :) + #- until now, only free clusters have been written. it's a null operation if we stop here. + #- it means no corruption :) # - # now we must be as fast as possible! + #- now we must be as fast as possible! - # remapping non movable root directory + #- remapping non movable root directory if ($resize_fat::isFAT32) { my $cluster = $fs->{fat32_root_dir_cluster}; @@ -112,10 +112,10 @@ sub construct_dir_tree { sub min_size($) { &resize_fat::any::min_size } sub max_size($) { &resize_fat::any::max_size } -# resize -# - size is in sectors -# - checks boundaries before starting -# - copies all data beyond new_cluster_count behind the frontier +#- resize +#- - size is in sectors +#- - checks boundaries before starting +#- - copies all data beyond new_cluster_count behind the frontier sub resize { my ($fs, $size) = @_; @@ -158,7 +158,7 @@ sub resize { resize_fat::boot_sector::write($fs); - $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; # doesn't matter if this fails - its pretty useless! + $resize_fat::isFAT32 and eval { resize_fat::info_sector::write($fs) }; #- doesn't matter if this fails - its pretty useless! sync(); log::l("resize_fat: done"); diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc index 585595df4..f16dc101a 100644 --- a/perl-install/share/install.rc +++ b/perl-install/share/install.rc @@ -1,54 +1,34 @@ style "default-font" { - fontset = "-*-helvetica-medium-r-normal--*-*-*-*-*-*-*-*,\ - -*-arial-medium-r-normal--*-*-*-*-*-*-*-*,\ - -*-*helvetica*-medium-r-normal--*-*-*-*-*-*-*-*,\ - -*-*arial*-medium-r-normal--*-*-*-*-*-*-*-*,\ - -*-tahoma-medium-r-normal--*-*-*-*-*-*-*-*,\ - -ricoh-*-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\ - -misc-fixed-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\ - -*-*-medium-r-normal--*-*-*-*-*-*-jisx0208.1983-0,\ - -*-*-medium-r-normal--*-*-*-*-*-*-jisx0201.1976-0,\ - -*-*-medium-r-normal--*-*-*-*-*-*-georgian-academy,\ - -*-*-medium-r-normal--*-*-*-*-*-*-georgian-rs,\ - -*-*-medium-*-*--*-*-*-*-*-*-ksc5601.1987-*,\ - -*-*-medium-r-normal-*-*-*-*-*-*-*-mulelao-1,\ - -*-*-medium-r-normal-*-*-*-*-*-*-*-ibm-cp1133,\ - -*-*-medium-r-normal-*-*-*-*-*-*-*-iso10646-1,\ - -taipei-*-medium-r-normal--*-*-*-*-*-*-big5-0" -# fontset = "-adobe-helvetica-medium-r-normal-*-*-100-*-*-p-*-iso8859-1" + fontset = "\ +-*-helvetica-medium-r-normal-*-*-100-*-*-*-*-*-*,\ +-*-arial-medium-r-normal-*-*-*-*-*-*-*-*-*,\ +-*-*helvetica*-medium-r-normal-*-*-*-*-*-*-*-*-*,\ +-*-*arial*-medium-r-normal-*-*-*-*-*-*-*-*-*,\ +-*-tahoma-medium-r-normal-*-*-*-*-*-*-*-*-*,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0208.1990-0,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0208.1983-0,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-jisx0201.1976-0,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-georgian-academy,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-georgian-rs,\ +-*-*-medium-*-*-*-*-*-*-*-*-*-ksc5601.1987-*,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-mulelao-1,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-ibm-cp1133,\ +-*-*-medium-r-normal-*-*-*-*-*-*-*-iso10646-1,\ +-taipei-*-medium-r-normal-*-*-*-*-*-*-*-big5-0" } style "steps" { bg[NORMAL] = { 0, 0, 0 } fg[NORMAL] = { 1.0, 1.0, 1.0 } -# fontset = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1" + + fontset = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*" } style "logo" { bg[NORMAL] = { 1.0, 1.0, 1.0 } - fg[NORMAL] = { 1.0, 1.0, 1.0 } - text[NORMAL] = { 1.0, 1.0, 1.0 } - fg[ACTIVE] = { 1.0, 1.0, 1.0 } - text[ACTIVE] = { 1.0, 1.0, 1.0 } - fg[PRELIGHT] = { 1.0, 1.0, 1.0 } - text[PRELIGHT] = { 1.0, 1.0, 1.0 } - fg[SELECTED] = { 1.0, 1.0, 1.0 } - text[SELECTED] = { 1.0, 1.0, 1.0 } - fg[INSENSITIVE] = { 1.0, 1.0, 1.0 } - text[INSENSITIVE] = { 1.0, 1.0, 1.0 } - bg[NORMAL] = { 1.0, 1.0, 1.0 } - base[NORMAL] = { 1.0, 1.0, 1.0 } - bg[ACTIVE] = { 1.0, 1.0, 1.0 } - base[ACTIVE] = { 1.0, 1.0, 1.0 } - bg[PRELIGHT] = { 1.0, 1.0, 1.0 } - base[PRELIGHT] = { 1.0, 1.0, 1.0 } - bg[SELECTED] = { 1.0, 1.0, 1.0 } - base[SELECTED] = { 1.0, 1.0, 1.0 } - bg[INSENSITIVE] = { 1.0, 1.0, 1.0 } - base[INSENSITIVE] = { 1.0, 1.0, 1.0 } } widget "*" style "default-font" diff --git a/perl-install/swap.pm b/perl-install/swap.pm index 879794ca9..bf8f608ed 100644 --- a/perl-install/swap.pm +++ b/perl-install/swap.pm @@ -21,9 +21,9 @@ my $signature_page = "\0" x $pagesize; my $V0_MAX_PAGES = 8 * $pagesize - 10; my $V1_OLD_MAX_PAGES = int 0x7fffffff / $pagesize - 1; -my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; # (1 << 24) - 1; +my $V1_MAX_PAGES = $V1_OLD_MAX_PAGES; #- (1 << 24) - 1; my $MAX_BADPAGES = int ($pagesize - 1024 - 128 * $common::sizeof_int - 10) / $common::sizeof_int; -my $signature_format_v1 = "x1024 I I I I125"; # bootbits, version, last_page, nr_badpages, padding +my $signature_format_v1 = "x1024 I I I I125"; #- bootbits, version, last_page, nr_badpages, padding 1; @@ -52,7 +52,7 @@ sub check_blocks { vec($signature_page, $i, 1) = bool($last_read_ok) if $version == 0; } - # TODO: add interface + #- TODO: add interface $badpages and log::l("$badpages bad pages\n"); return $badpages; @@ -114,7 +114,7 @@ sub make($;$) { syswrite(F, substr($signature_page, $offset)) or die "unable to write signature page: $!"; - # A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.) + #- A subsequent swapon() will fail if the signature is not actually on disk. (This is a kernel bug.) syscall_('fsync', fileno(F)) or die "fsync failed: $!"; close F; } diff --git a/perl-install/unused/cdrom.pm b/perl-install/unused/cdrom.pm index 46bb4fc3f..6ba5f5152 100644 --- a/perl-install/unused/cdrom.pm +++ b/perl-install/unused/cdrom.pm @@ -30,11 +30,11 @@ sub findSCSIcdrom { sub setupCDdevice { my ($cddev, $dl) = @_; - #TODO + #-TODO } sub removeCDmodule { - # this wil fail silently if no CD module has been loaded + #- this wil fail silently if no CD module has been loaded removeDeviceDriver('cdrom'); 1; } diff --git a/perl-install/unused/scsi.pm b/perl-install/unused/scsi.pm index 77fe8fe44..1b185a8ad 100644 --- a/perl-install/unused/scsi.pm +++ b/perl-install/unused/scsi.pm @@ -58,7 +58,7 @@ sub ideGetDevices { -r "/proc/ide" or die "sorry, /proc/ide not available, seems like you have a pre-2.2 kernel\n => not handled yet :("; - # Great. 2.2 kernel, things are much easier and less error prone. + #- Great. 2.2 kernel, things are much easier and less error prone. foreach my $d (glob_('/proc/ide/hd*')) { my ($t) = chop_(cat_("$d/media")); my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next; @@ -93,8 +93,8 @@ sub dac960GetDevices { local *F; open F, $file or die "Failed to open $file: $!"; - # We are looking for lines of this format:DAC960#0: - # /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012 + #- We are looking for lines of this format:DAC960#0: + #- /dev/rd/c0d0: RAID-7, Online, 17928192 blocks, Write Thru0123456790123456789012 foreach (<F>) { my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next; push @idi, { info => $info, type => 'hd', devicename => $devicename }; |