summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorPascal Rigaux <pixel@mandriva.com>1999-10-10 22:36:46 +0000
committerPascal Rigaux <pixel@mandriva.com>1999-10-10 22:36:46 +0000
commitde08b3c99e81030d1455dc7b3bf869559a234495 (patch)
tree71639bb74323bb82e7203d84511e8b81702ca2fa /perl-install
parenteaf1f7e94354b3bf37db6864de8364ffbda223f7 (diff)
downloaddrakx-de08b3c99e81030d1455dc7b3bf869559a234495.tar
drakx-de08b3c99e81030d1455dc7b3bf869559a234495.tar.gz
drakx-de08b3c99e81030d1455dc7b3bf869559a234495.tar.bz2
drakx-de08b3c99e81030d1455dc7b3bf869559a234495.tar.xz
drakx-de08b3c99e81030d1455dc7b3bf869559a234495.zip
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile2
-rw-r--r--perl-install/Xconfigurator.pm10
-rw-r--r--perl-install/Xconfigurator_consts.pm2
-rw-r--r--perl-install/c/Makefile2
-rw-r--r--perl-install/c/stuff.pm2
-rw-r--r--perl-install/common.pm3
-rw-r--r--perl-install/fs.pm2
-rw-r--r--perl-install/fsedit.pm2
-rw-r--r--perl-install/install2.pm1
-rw-r--r--perl-install/install_steps.pm6
-rw-r--r--perl-install/install_steps_interactive.pm1
-rw-r--r--perl-install/log.pm1
-rw-r--r--perl-install/mouse.pm6
-rw-r--r--perl-install/network.pm1
-rw-r--r--perl-install/pkgs.pm16
-rw-r--r--perl-install/resize_fat/Makefile2
-rw-r--r--perl-install/resize_fat/any.pm1
-rw-r--r--perl-install/share/diskdrake.rc17
-rw-r--r--perl-install/share/install.rc1
19 files changed, 45 insertions, 33 deletions
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 = <F>; 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"