From de08b3c99e81030d1455dc7b3bf869559a234495 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Sun, 10 Oct 1999 22:36:46 +0000 Subject: no_comment --- perl-install/Makefile | 2 +- perl-install/Xconfigurator.pm | 10 +++------- perl-install/Xconfigurator_consts.pm | 2 +- perl-install/c/Makefile | 2 +- perl-install/c/stuff.pm | 2 +- perl-install/common.pm | 3 ++- perl-install/fs.pm | 2 +- perl-install/fsedit.pm | 2 +- perl-install/install2.pm | 1 + perl-install/install_steps.pm | 6 ++++-- perl-install/install_steps_interactive.pm | 1 + perl-install/log.pm | 1 + perl-install/mouse.pm | 6 +++--- perl-install/network.pm | 1 + perl-install/pkgs.pm | 16 +++++++++------- perl-install/resize_fat/Makefile | 2 +- perl-install/resize_fat/any.pm | 1 + perl-install/share/diskdrake.rc | 17 ++++++++++++----- perl-install/share/install.rc | 1 - 19 files changed, 45 insertions(+), 33 deletions(-) (limited to 'perl-install') diff --git a/perl-install/Makefile b/perl-install/Makefile index 6fd9061db..c6cd2bf6d 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -172,7 +172,7 @@ stage2: $(SUDO) cp -a $(DEST)/* $(STAGE2TMP) $(SUDO) umount /mnt/stage2 ; true - dd if=/dev/zero of=$(STAGE2) bs=1M count=14 + dd if=/dev/zero of=$(STAGE2) bs=1M count=15 echo y | /sbin/mke2fs $(STAGE2) $(SUDO) mount -t ext2 $(STAGE2) /mnt/stage2 -o loop diff --git a/perl-install/Xconfigurator.pm b/perl-install/Xconfigurator.pm index 5d57a2521..53d4a233f 100644 --- a/perl-install/Xconfigurator.pm +++ b/perl-install/Xconfigurator.pm @@ -172,10 +172,7 @@ sub cardConfiguration(;$$) { -x "$prefix$card->{prog}" or !defined $install or &$install($card->{server}); -x "$prefix$card->{prog}" or die "server $card->{server} is not available (should be in $prefix$card->{prog})"; - unless ($::testing) { - unlink("$prefix/etc/X11/X"); - symlink("../..$card->{prog}", "$prefix/etc/X11/X"); - } + symlinkf "../..$card->{prog}", "$prefix/etc/X11/X" unless $::testing; unless ($card->{type}) { $card->{flags}{noclockprobe} = member($card->{server}, qw(I128 S3 S3V Mach64)); @@ -266,8 +263,7 @@ sub testFinalConfig($;$) { #- 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; + symlinkf "$prefix/tmp/.X11-unix/X9", "/tmp/.X11-unix/X9" if $prefix; my $f_err = "$prefix/tmp/Xoutput"; my $pid; @@ -665,7 +661,7 @@ sub XF86check_link { 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; + symlinkf "../../../../etc/X11/XF86Config", $l; } } diff --git a/perl-install/Xconfigurator_consts.pm b/perl-install/Xconfigurator_consts.pm index 5a31ac17b..da996ea8c 100644 --- a/perl-install/Xconfigurator_consts.pm +++ b/perl-install/Xconfigurator_consts.pm @@ -107,7 +107,7 @@ $resolution_wanted = "1024x768"; %lines = ( - 'Cirrus Logic|GD 5446' => [ ' Option "noblt"' ], + 'Cirrus Logic|GD 5446' => [ ' Option "no_bitblt"' ], ); %xkb_options = ( diff --git a/perl-install/c/Makefile b/perl-install/c/Makefile index 16f42def5..cd8256d97 100644 --- a/perl-install/c/Makefile +++ b/perl-install/c/Makefile @@ -3,7 +3,7 @@ stuff: %: %.xs test -e Makefile_c || C_RPM=1 perl Makefile.PL $(MAKE) -f Makefile_c - rm ../auto/c ; ln -s ../c/blib/arch/auto ../auto/c + rm -f ../auto/c ; ln -s ../c/blib/arch/auto ../auto/c clean: test ! -e Makefile_c || $(MAKE) -f Makefile_c clean diff --git a/perl-install/c/stuff.pm b/perl-install/c/stuff.pm index ad5cf316d..70f2b3222 100644 --- a/perl-install/c/stuff.pm +++ b/perl-install/c/stuff.pm @@ -14,7 +14,7 @@ bootstrap c::stuff $VERSION; sub headerGetEntry { my ($h, $q) = @_; - + $h or log::l("empty header in headerGetEntry"), return; $q eq 'name' and return headerGetEntry_string($h, RPMTAG_NAME()); $q eq 'group' and return headerGetEntry_string($h, RPMTAG_GROUP()); $q eq 'version' and return headerGetEntry_string($h, RPMTAG_VERSION()); diff --git a/perl-install/common.pm b/perl-install/common.pm index 9dc3e3c6a..2c9121e6e 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -8,7 +8,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int %EXPORT_TAGS = ( common => [ qw(__ even odd min max sqr sum sign product bool listlength bool2text text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX) ], functional => [ qw(fold_left compose map_index grep_index map_each grep_each map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie) ], - file => [ qw(dirname basename touch all glob_ cat_ chop_ mode typeFromMagic) ], + file => [ qw(dirname basename touch all glob_ cat_ symlinkf chop_ mode typeFromMagic) ], system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ], constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ], ); @@ -63,6 +63,7 @@ sub bool2text { $_[0] ? "true" : "false" } sub text2bool { my $t = lc($_[0]); $t eq "true" || $t eq "yes" ? 1 : 0 } sub strcpy { substr($_[0], $_[2] || 0, length $_[1]) = $_[1] } sub cat_ { local *F; open F, $_[0] or $_[1] ? die "cat of file $_[0] failed: $!\n" : return; my @l = ; wantarray ? @l : join '', @l } +sub symlinkf { unlink $_[1]; symlink $_[0], $_[1] } sub chop_ { map { my $l = $_; chomp $l; $l } @_ } sub divide { my $d = int $_[0] / $_[1]; wantarray ? ($d, $_[0] % $_[1]) : $d } sub round { int ($_[0] + 0.5) } diff --git a/perl-install/fs.pm b/perl-install/fs.pm index 55f7367a9..eac303647 100644 --- a/perl-install/fs.pm +++ b/perl-install/fs.pm @@ -199,7 +199,7 @@ sub write($$) { map_index { my $i = $::i ? $::i + 1 : ''; mkdir "$prefix/mnt/cdrom$i", 0755 or log::l("failed to mkdir $prefix/mnt/cdrom$i: $!"); - symlink $_->{device}, "$prefix/dev/cdrom$i" or log::l("failed to symlink $prefix/dev/cdrom$i: $!"); + symlinkf $_->{device}, "$prefix/dev/cdrom$i" or log::l("failed to symlink $prefix/dev/cdrom$i: $!"); [ "/dev/cdrom$i", "/mnt/cdrom$i", "auto", "user,noauto,nosuid,exec,nodev,ro", 0, 0 ]; } detect_devices::cdroms()); write_fstab($fstab, $prefix, @to_add); diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index b0ec2a664..644789957 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -58,7 +58,7 @@ sub hds($$) { foreach (@$drives) { my $file = devices::make($_->{device}); - my $hd = partition_table_raw::get_geometry($file) or die _("An error occurred while getting the geometry of block device %s: %s", $file, "$!"); + my $hd = partition_table_raw::get_geometry($file) or log::l("An error occurred while getting the geometry of block device $file: $!"), next; $hd = { (%$_, %$hd) }; $hd->{file} = $file; $hd->{prefix} = $hd->{device}; diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 470799d39..d2904f14e 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -524,6 +524,7 @@ sub main { killCardServices(); log::l("installation complete, leaving"); + print "\n" x 30; if ($::g_auto_install) { my $h = $o; $o = {}; diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 353a0e1a1..9c916cc5b 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -59,6 +59,8 @@ sub leavingStep($$) { my ($o, $step) = @_; log::l("step `$step' finished"); + eval { commands::cp('-f', "/tmp/ddebug.log", "$o->{prefix}/root") } if -d "$o->{prefix}/root"; + $o->{steps}{$step}{reachable} = $o->{steps}{$step}{redoable}; while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) { @@ -141,9 +143,9 @@ sub choosePartitionsToFormat($$) { unless ($_->{toFormat} = $_->{notFormatted} || $o->{partitioning}{autoformat}) { my $t = fsedit::typeOfPart($_->{device}); - $_->{toFormatUnsure} = + $_->{toFormatUnsure} = $_->{mntpoint} eq "/" || #- if detected dos/win, it's not precise enough to just compare the types (too many of them) - isFat({ type => $t }) ? !isFat($_) : $t != $_->{type}; + (isFat({ type => $t }) ? !isFat($_) : $t != $_->{type}); } } } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 8498f6320..27a2cf897 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -103,6 +103,7 @@ sub selectMouse { my $name = $o->{mouse}{FULLNAME}; if (!$name || $::expert || $force) { + $name ||= "Generic Mouse (serial)"; $name = $o->ask_from_list_('', _("What is the type of your mouse?"), [ mouse::names() ], $name); $o->{mouse} = mouse::name2mouse($name); } diff --git a/perl-install/log.pm b/perl-install/log.pm index e29dc410e..2e1da1a77 100644 --- a/perl-install/log.pm +++ b/perl-install/log.pm @@ -15,6 +15,7 @@ my $logDebugMessages = 0; #- Functions #-###################################################################################### sub fd() { fileno LOG } +sub F() { *LOG } sub l { $logOpen or openLog(); diff --git a/perl-install/mouse.pm b/perl-install/mouse.pm index 27979ea8d..795d859b1 100644 --- a/perl-install/mouse.pm +++ b/perl-install/mouse.pm @@ -6,7 +6,7 @@ use strict; #-###################################################################################### #- misc imports #-###################################################################################### -use common qw(:common :system :functional); +use common qw(:common :system :functional :file); use modules; use log; @@ -62,7 +62,7 @@ sub serial_ports_names { } sub serial_ports_names2dev { local ($_) = @_; - /(\w+)/; + first(/(\w+)/); } sub read($) { @@ -76,7 +76,7 @@ sub write($;$) { my ($prefix, $mouse) = @_; local $mouse->{FULLNAME} = qq("$mouse->{FULLNAME}"); setVarsInSh("$prefix/etc/sysconfig/mouse", $mouse, qw(MOUSETYPE XMOUSETYPE FULLNAME XEMU3)); - symlink $mouse->{device}, "$prefix/dev/mouse" or log::l("creating $prefix/dev/mouse symlink failed"); + symlinkf $mouse->{device}, "$prefix/dev/mouse" or log::l("creating $prefix/dev/mouse symlink failed"); } sub detect() { diff --git a/perl-install/network.pm b/perl-install/network.pm index 31fcd7e0f..c5d1b6a97 100644 --- a/perl-install/network.pm +++ b/perl-install/network.pm @@ -107,6 +107,7 @@ sub add2hosts { log::l("writing host information to $file"); open F, ">$file" or die "cannot write $file: $!"; while (my ($ip, $v) = each %l) { + $ip or next; print F "$ip"; if ($v =~ /^\s/) { print F $v; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index c46d26b93..b78ec1d24 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -2,7 +2,7 @@ package pkgs; use diagnostics; use strict; -use vars qw($fd $size_correction_ratio); +use vars qw(*LOG $size_correction_ratio); use common qw(:common :file :functional); use install_any; @@ -270,10 +270,11 @@ sub init_db { my ($prefix, $isUpgrade) = @_; my $f = "$prefix/root/install.log"; - open(F, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept."); - $fd = fileno(F) || log::fd() || 2; - c::rpmErrorSetCallback($fd); -# c::rpmSetVeryVerbose(); + open(LOG, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept."); + *LOG or *LOG = log::F() or *LOG = *STDERR; + CORE::select((CORE::select(LOG), $| = 1)[0]); + c::rpmErrorSetCallback(fileno LOG); +#- c::rpmSetVeryVerbose(); log::l("reading /usr/lib/rpm/rpmrc"); c::rpmReadConfigFiles() or die "can't read rpm config files"; @@ -287,7 +288,7 @@ sub getHeader($) { unless ($p->{header}) { my $f = install_any::getFile($p->{file}) or die "error opening package $p->{name} (file $p->{file})"; - $p->{header} = c::rpmReadPackageHeader(fileno $f); + $p->{header} = c::rpmReadPackageHeader(fileno $f) or die "bad package $p->{name}"; } $p->{header}; } @@ -432,7 +433,7 @@ sub install($$) { c::rpmdbClose($db); c::rpmtransFree($trans); }; - c::rpmtransSetScriptFd($trans, $fd); + c::rpmtransSetScriptFd($trans, fileno LOG); eval { fs::mount("/proc", "$prefix/proc", "proc", 0) }; @@ -440,6 +441,7 @@ sub install($$) { #- !! do not translate these messages, they are used when catched (cf install_steps_graphical) my $callbackOpen = sub { + print LOG "$_[0]\n"; my $fd = install_any::getFile($_[0]) or log::l("bad file $_[0]"); $fd ? fileno $fd : -1; }; diff --git a/perl-install/resize_fat/Makefile b/perl-install/resize_fat/Makefile index 4b41e1bef..14a578ea3 100644 --- a/perl-install/resize_fat/Makefile +++ b/perl-install/resize_fat/Makefile @@ -3,7 +3,7 @@ c_rewritten: %: %.xs test -e Makefile_c || perl Makefile.PL $(MAKE) -f Makefile_c - rm ../auto/resize_fat ; ln -s ../resize_fat/blib/arch/auto ../auto/resize_fat + rm -f ../auto/resize_fat ; ln -s ../resize_fat/blib/arch/auto ../auto/resize_fat clean: test ! -e Makefile_c || $(MAKE) -f Makefile_c clean diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm index 7d7d006fa..ff0045d0b 100644 --- a/perl-install/resize_fat/any.pm +++ b/perl-install/resize_fat/any.pm @@ -8,6 +8,7 @@ use common qw(:common :constant); use resize_fat::fat; use resize_fat::directory; use resize_fat::dir_entry; +use resize_fat::c_rewritten; $FREE = 0; diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc index e92a089b4..814c0f924 100644 --- a/perl-install/share/diskdrake.rc +++ b/perl-install/share/diskdrake.rc @@ -1,6 +1,8 @@ style "font" { - font = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1" + # to be sure + font = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*" + fontset = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*" } style "red" = "font" @@ -12,6 +14,7 @@ style "green" = "font" { bg[NORMAL] = { 0, 1.0, 0 } bg[PRELIGHT] = { 0, 0.9, 0 } + fg[NORMAL] = { 0, 0, 0 } } style "blue" = "font" { @@ -22,9 +25,13 @@ style "white" = "font" { bg[NORMAL] = { 1.0, 1.0, 1.0 } bg[PRELIGHT] = { 0.67, 0.67, 0.67 } + fg[NORMAL] = { 0, 0, 0 } } -widget "*Linux*" style "red" -widget "*Linux swap" style "green" -widget "*FAT*" style "blue" -widget "*Empty*" style "white" +widget "*Linux*" style "red" +widget "*Ext2*" style "red" +widget "*Linux swap*" style "green" +widget "*Swap*" style "green" +widget "*FAT*" style "blue" +widget "*Empty*" style "white" +widget "*Other*" style "font" diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc index 68a02053c..eba8c2f1c 100644 --- a/perl-install/share/install.rc +++ b/perl-install/share/install.rc @@ -38,7 +38,6 @@ style "steps" -*-*-medium-r-normal-*-*-*-*-*-*-*-iso10646-1,\ -taipei-*-medium-r-normal-*-*-*-*-*-*-*-big5-0" - } style "logo" -- cgit v1.2.1