summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authorFrancois Pons <fpons@mandriva.com>2000-04-14 15:11:57 +0000
committerFrancois Pons <fpons@mandriva.com>2000-04-14 15:11:57 +0000
commit21066f8c4d8d136cca65f7138cabb25d4b4cfe8c (patch)
treee51a023cbbbdea6ad22b962dc4e573603c67f31a /perl-install
parent3f3ced984833bf1084447c1afd3cfc7d17d0838b (diff)
downloaddrakx-backup-do-not-use-21066f8c4d8d136cca65f7138cabb25d4b4cfe8c.tar
drakx-backup-do-not-use-21066f8c4d8d136cca65f7138cabb25d4b4cfe8c.tar.gz
drakx-backup-do-not-use-21066f8c4d8d136cca65f7138cabb25d4b4cfe8c.tar.bz2
drakx-backup-do-not-use-21066f8c4d8d136cca65f7138cabb25d4b4cfe8c.tar.xz
drakx-backup-do-not-use-21066f8c4d8d136cca65f7138cabb25d4b4cfe8c.zip
*** empty log message ***
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/crypto.pm2
-rw-r--r--perl-install/fs.pm1
-rw-r--r--perl-install/install_any.pm10
-rw-r--r--perl-install/install_steps.pm9
-rw-r--r--perl-install/install_steps_gtk.pm17
-rw-r--r--perl-install/install_steps_interactive.pm16
-rw-r--r--perl-install/modules.pm6
-rw-r--r--perl-install/my_gtk.pm3
-rw-r--r--perl-install/pkgs.pm30
-rw-r--r--perl-install/printer.pm2
-rw-r--r--perl-install/resize_fat/c_rewritten.xs31
-rw-r--r--perl-install/resize_fat/dir_entry.pm4
12 files changed, 76 insertions, 55 deletions
diff --git a/perl-install/crypto.pm b/perl-install/crypto.pm
index 6490fb0de..9c1514954 100644
--- a/perl-install/crypto.pm
+++ b/perl-install/crypto.pm
@@ -53,7 +53,7 @@ sub getPackages($) {
#- extract hdlist of crypto, then depslist.
require pkgs;
- pkgs::psUsingHdlist($prefix, '', $packages, getHdlist($mirror), "hdlistCrypto.cz2", "Crypto", "Crytographic site", 1) and
+ pkgs::psUsingHdlist($prefix, '', $packages, getHdlist($mirror), "hdlistCrypto.cz2", "Crypto", '', "Crytographic site", 1) and
pkgs::getOtherDeps($packages, getDepslist($mirror));
#- produce an output suitable for visualization.
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index 0f89057e7..623701c2d 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -340,6 +340,7 @@ sub write_fstab($;$$) {
my @new = grep { $_ ne 'none' } map { @$_[0,1] } @to_add;
my %new; @new{@new} = undef;
+ require fsedit;
unshift @to_add,
map {
my ($dir, $options, $freq, $passno) = qw(/dev/ defaults 0 0);
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
index f7387056f..25a9a56c2 100644
--- a/perl-install/install_any.pm
+++ b/perl-install/install_any.pm
@@ -41,8 +41,8 @@ XFree86 dhcpxd pump ppp ypbind rhs-printfilters samba ncpfs kernel-fb
#- Media change variables&functions
#-######################################################################################
my $postinstall_rpms = '';
-my $current_medium = '';
-my $asked_medium = '';
+my $current_medium = 1;
+my $asked_medium = 1;
sub useMedium($) {
#- before ejecting the first CD, there are some files to copy!
#- does nothing if the function has already been called.
@@ -61,8 +61,8 @@ sub relGetFile($) {
m,^(Mandrake|lnx4win)/, and return $_;
/\.img$/ and return "images/$_";
my $dir = m|/| ? "mdkinst" : /^(?:compss|compssList|compssUsers|filelist|depslist.*|hdlist.*)$/ ?
- "base/": "RPMS$asked_medium/";
- "Mandrake/$dir$_";
+ "Mandrake/base/": "$::o->{packages}[2]{$asked_medium}{rpmsdir}/";
+ "$dir$_";
}
sub askChangeMedium($$) {
my ($method, $medium) = @_;
@@ -166,7 +166,7 @@ sub setup_postinstall_rpms($$) {
#- the complete filename of each package.
#- copy the package files in the postinstall RPMS directory.
#- last arg is default medium '' known as the CD#1.
- pkgs::extractHeaders($prefix, \@toCopy, $packages->[2]{''});
+ pkgs::extractHeaders($prefix, \@toCopy, $packages->[2]{1});
commands::cp((map { "/tmp/rhimage/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms);
}
sub clean_postinstall_rpms() {
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index cb81ad4ff..e5062bd66 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -427,7 +427,8 @@ sub pppConfig {
$toreplace{$_} = $o->{modem}{$_} foreach qw(connection phone login passwd auth domain dns1 dns2);
$toreplace{kpppauth} = ${{ 'Script-based' => 0, 'PAP' => 1, 'Terminal-based' => 2, 'CHAP' => 3, }}{$o->{modem}{auth}};
$toreplace{phone} =~ s/\D//g;
- $toreplace{dnsserver} = join '', map { "$o->{modem}{$_}," } "dns1", "dns2";
+ $toreplace{dnsserver} = join ',', map { $o->{modem}{$_} } "dns1", "dns2";
+ $toreplace{dnsserver} .= $toreplace{dnsserver} && ',';
#- using peerdns or dns1,dns2 avoid writing a /etc/resolv.conf file.
$toreplace{peerdns} = "yes";
@@ -437,7 +438,8 @@ sub pppConfig {
$toreplace{intf} ||= 'ppp0';
if ($o->{modem}{auth} eq 'PAP') {
- template2file("/usr/share/ifcfg-ppp.pap.in", "$o->{prefix}/etc/sysconfig/network-scripts/ifcfg-ppp0", %toreplace);
+ template2file($toreplace{dnsserver} ? "/usr/share/ifcfg-ppp.pap.dns.in" : "/usr/share/ifcfg-ppp.pap.in",
+ "$o->{prefix}/etc/sysconfig/network-scripts/ifcfg-ppp0", %toreplace);
template2file("/usr/share/chat-ppp.pap.in", "$o->{prefix}/etc/sysconfig/network-scripts/chat-ppp0", %toreplace);
my @l = cat_("$o->{prefix}/etc/ppp/pap-secrets");
@@ -452,7 +454,8 @@ sub pppConfig {
print F "$toreplace{login} ppp0 $toreplace{passwd}\n";
}
} elsif ($o->{modem}{auth} eq 'Terminal-based' || $o->{modem}{auth} eq 'Script-based') {
- template2file("/usr/share/ifcfg-ppp.script.in", "$o->{prefix}/etc/sysconfig/network-scripts/ifcfg-ppp0", %toreplace);
+ template2file($toreplace{dnsserver} ? "/usr/share/ifcfg-ppp.script.dns.in" : "/usr/share/ifcfg-ppp.script.in",
+ "$o->{prefix}/etc/sysconfig/network-scripts/ifcfg-ppp0", %toreplace);
template2file("/usr/share/chat-ppp.script.in", "$o->{prefix}/etc/sysconfig/network-scripts/chat-ppp0", %toreplace);
} #- no CHAP currently.
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index e007303f1..1e6af32e0 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -542,23 +542,14 @@ sub installPackages {
undef *install_any::changeMedium;
*install_any::changeMedium = sub {
my ($method, $medium) = @_;
- my %medium_msg = ();
- $medium_msg{$medium} or $medium_msg{$medium} = _("Installation CD Nr %s", ($medium || 1));
- my %method_msg = (
- cdrom =>
+ my $msg =
_("Change your Cd-Rom!
Please insert the Cd-Rom labelled \"%s\" in your drive and press Ok when done.
-If you don't have it press Cancel to avoid installation from this Cd-Rom.", $medium_msg{$medium}),
- );
- $method_msg{$method} or $method_msg{$method} =
-_("Update installation image!
+If you don't have it press Cancel to avoid installation from this Cd-Rom.", pkgs::mediumDescr($packages, $medium));
-Ask your system administrator or reboot to update your installation image to include
-the Cd-Rom image labelled \"%s\". Press Ok if image has been updated or press Cancel
-to avoid installation from this Cd-Rom image.", $medium_msg{$medium});
-
- $o->ask_okcancel('', $method_msg{$method});
+ #- if not using a cdrom medium, always abort.
+ $method eq 'cdrom' && $o->ask_okcancel('', $msg);
};
catch_cdie { $o->install_steps::installPackages($packages); }
sub {
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index ba7d28b58..58b64a4dd 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -266,8 +266,8 @@ sub choosePackages {
my ($o, $packages, $compss, $compssUsers, $compssUsersSorted, $first_time) = @_;
#- this is done at the very beginning to take into account
- #- selection of CD by user.
- $o->chooseCD($packages);
+ #- selection of CD by user if using a cdrom.
+ $o->chooseCD($packages) if $o->{method} eq 'cdrom';
require pkgs;
unless ($o->{isUpgrade}) {
@@ -340,15 +340,12 @@ sub chooseGroups {
sub chooseCD {
my ($o, $packages) = @_;
-
- #- get default values according to method, always skip empty medium
- #- which is the default (or current) CD which is always available...
- map { $packages->[2]{$_}{selected} = $o->{method} ne 'cdrom' } grep { $_ } keys %{$packages->[2]};
+ my @mediums = pkgs::allMediums($packages);
$o->ask_many_from_list_ref('',
_("Choose other CD to install"),
- [ map { $packages->[2]{$_}{descr} || _("Cd-Rom Nr %s", $_) } grep { $_ } keys %{$packages->[2]} ],
- [ map { \$packages->[2]{$_}{selected} } grep { $_ } keys %{$packages->[2]} ]
+ [ map { _("Cd-Rom labeled \"%s\"", pkgs::mediumDescr($packages, $_)) } grep { $_ > 1 } @mediums ],
+ [ map { \$packages->[2]{$_}{selected} } grep { $_ } @mediums ] #- check for change!
) or goto &chooseCD unless $::beginner;
}
@@ -490,8 +487,7 @@ sub pppConfig {
detect_devices::probeSerialDevices();
foreach (0..3) {
next if $o->{mouse}{device} =~ /ttyS$_/;
- detect_devices::hasModem("$o->{prefix}/dev/ttyS$_")
- and $m->{device} = "ttyS$_", last;
+ detect_devices::hasModem("/dev/ttyS$_") and $m->{device} = "ttyS$_", last;
}
}
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 8ec397a4d..1b8d58dfa 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -569,6 +569,8 @@ sub get_pcmcia_devices($$) {
}
sub load_ide {
- load("ide-mod", 'prereq', 'options="' . detect_devices::hasUltra66() . '"');
- load_multi(qw(ide-probe ide-disk ide-cd));
+ eval {
+ load("ide-mod", 'prereq', 'options="' . detect_devices::hasUltra66() . '"');
+ load_multi(qw(ide-probe ide-disk ide-cd));
+ }
}
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index 02037f5b5..2c0c185d3 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -556,7 +556,8 @@ sub _ask_from_list_with_help {
my $leave = sub { $o->{retval} = $l->[$curr]; Gtk->main_quit };
my $select = sub {
- $list->select_item($_[1]);
+ $list->select_item($_[0]);
+ $list->moveto($_[0], 0, 0.5, 0);
};
ref $title && !@okcancel ?
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index 4aa8edb4d..3824fb1dd 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -205,6 +205,15 @@ sub packagesToInstall {
grep { pkgs::packageFlagSelected($_) && !pkgs::packageFlagInstalled($_) } values %{$packages->[0]};
}
+sub allMediums {
+ my ($packages) = @_;
+ keys %{$packages->[2]};
+}
+sub mediumDescr {
+ my ($packages, $medium) = @_;
+ $packages->[2]{$medium}{descr};
+}
+
#- selection, unselection of package.
sub selectPackage($$;$$$) {
my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_;
@@ -315,19 +324,21 @@ sub psUsingHdlists {
my @hdlists;
#- parse hdlist.list file.
+ my $medium = 1;
foreach (<$listf>) {
chomp;
s/\s*#.*$//;
/^\s*$/ and next;
- m/^hdlist(.*)\.cz2?\s*(.*)$/ or die "invalid hdlist filename $_";
- push @hdlists, [ $_, $1, $2 ];
+ m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file";
+ push @hdlists, [ $1, $medium, $2, $3 ];
+ ++$medium;
}
foreach (@hdlists) {
- my ($hdlist, $medium, $descr) = @$_;
+ my ($hdlist, $medium, $rpmsdir, $descr) = @$_;
my $f = install_any::getFile($hdlist) or die "no $hdlist found";
- psUsingHdlist($prefix, $method, \@packages, $f, $hdlist, $medium, $descr, !$medium);
+ psUsingHdlist($prefix, $method, \@packages, $f, $hdlist, $medium, $rpmsdir, $descr, (!$medium || $method ne 'cdrom'));
}
log::l("psUsingHdlists read " . scalar keys(%{$packages[0]}) . " headers on " . scalar keys(%{$packages[2]}) . " hdlists");
@@ -336,15 +347,16 @@ sub psUsingHdlists {
}
sub psUsingHdlist {
- my ($prefix, $method, $packages, $f, $hdlist, $medium, $descr, $selected) = @_;
+ my ($prefix, $method, $packages, $f, $hdlist, $medium, $rpmsdir, $descr, $selected) = @_;
#- if the medium already exist, use it.
$packages->[2]{$medium} and return;
- my $fakemedium = $method . ($medium || 1);
+ my $fakemedium = $method . $medium;
my $m = $packages->[2]{$medium} = { hdlist => $hdlist,
- medium => $medium, #- default medium is ''.
- descr => $descr, #- default value is '' too.
+ medium => $medium,
+ rpmsdir => $rpmsdir, #- where is RPMS directory.
+ descr => $descr,
fakemedium => $fakemedium,
min => scalar keys %{$packages->[0]},
max => -1, #- will be updated after reading current hdlist.
@@ -864,7 +876,7 @@ sub install($$$;$$) {
#- place (install_steps_gtk.pm,...).
installCallback("Starting installation", $nb, $total);
- my ($i, $min, $medium) = (0, 0);
+ my ($i, $min, $medium) = (0, 0, 1);
do {
my @transToInstall;
diff --git a/perl-install/printer.pm b/perl-install/printer.pm
index 66db36844..ab3464b9a 100644
--- a/perl-install/printer.pm
+++ b/perl-install/printer.pm
@@ -331,7 +331,7 @@ sub read_printer_db(;$) {
scalar(keys %thedb) > 3 and return; #- try reparse if using only ppa, POSTSCRIPT, TEXT.
my %available_devices; #- keep only available devices in our database.
- local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix ") . "/usr/bin/gs --help |";
+ local *AVAIL; open AVAIL, ($::testing ? "$prefix" : "chroot $prefix/ ") . "/usr/bin/gs --help |";
foreach (<AVAIL>) {
if (/^Available devices:/ ... /^\S/) {
@available_devices{split /\s+/, $_} = () if /^\s+/;
diff --git a/perl-install/resize_fat/c_rewritten.xs b/perl-install/resize_fat/c_rewritten.xs
index 33171c614..92361097d 100644
--- a/perl-install/resize_fat/c_rewritten.xs
+++ b/perl-install/resize_fat/c_rewritten.xs
@@ -23,7 +23,7 @@ unsigned int next(unsigned int cluster) {
free_all();
croak("fat::next: trying to use null pointer");
}
- if (cluster > nb_clusters + 2) {
+ if (cluster >= nb_clusters + 2) {
free_all();
croak("fat::next: cluster %d outside filesystem", cluster);
}
@@ -36,7 +36,7 @@ void set_next(unsigned int cluster, unsigned int val) {
free_all();
croak("fat::set_next: trying to use null pointer");
}
- if (cluster > nb_clusters + 2) {
+ if (cluster >= nb_clusters + 2) {
free_all();
croak("fat::set_next: cluster %d outside filesystem", cluster);
}
@@ -97,7 +97,7 @@ scan_fat(nb_clusters_, type_size_)
short *p;
type_size = type_size_; nb_clusters = nb_clusters_;
- bad_cluster_value = type_size == 32 ? 0xffffff7 : 0xfff7;
+ bad_cluster_value = type_size == 32 ? 0x0ffffff7 : 0xfff7;
if (type_size % 16) {
free_all();
@@ -162,7 +162,10 @@ checkFat(cluster, type, name)
free_all();
croak("Bad FAT: unterminated chain for %s\n", name);
}
-
+ if (cluster >= nb_clusters + 2) {
+ free_all();
+ croak("Bad FAT: chain outside filesystem for %s\n", name);
+ }
if (fat_flag_map[cluster]) {
free_all();
croak("Bad FAT: cluster %d is cross-linked for %s\n", cluster, name);
@@ -182,6 +185,10 @@ flag(cluster)
free_all();
croak("Bad FAT: trying to use null pointer");
}
+ if (cluster >= nb_clusters + 2) {
+ free_all();
+ croak("Bad FAT: going outside filesystem");
+ }
RETVAL = fat_flag_map[cluster];
OUTPUT:
RETVAL
@@ -195,6 +202,10 @@ set_flag(cluster, flag)
free_all();
croak("Bad FAT: trying to use null pointer");
}
+ if (cluster >= nb_clusters + 2) {
+ free_all();
+ croak("Bad FAT: going outside filesystem");
+ }
fat_flag_map[cluster] = flag;
void
@@ -219,10 +230,6 @@ fat_remap(cluster)
if (cluster >= bad_cluster_value) {
RETVAL = cluster; /* special cases */
} else {
- if (fat_remap == NULL) {
- free_all();
- croak("fat_remap: NULL in fat_remap");
- }
if (cluster >= fat_remap_size) {
free_all();
croak("fat_remap: cluster %d >= %d in fat_remap", cluster, fat_remap_size);
@@ -241,4 +248,12 @@ set_fat_remap(cluster, val)
free_all();
croak("set_fat_remap: trying to use null pointer");
}
+ if (cluster >= fat_remap_size) {
+ free_all();
+ croak("set_fat_remap: cluster %d >= %d in set_fat_remap", cluster, fat_remap_size);
+ }
+ if (val < bad_cluster_value && val >= fat_remap_size) {
+ free_all();
+ croak("set_fat_remap: remapping cluster %d to cluster %d >= %d in set_fat_remap", cluster, val, fat_remap_size);
+ }
fat_remap[cluster] = val;
diff --git a/perl-install/resize_fat/dir_entry.pm b/perl-install/resize_fat/dir_entry.pm
index 390659b0e..d944c04ac 100644
--- a/perl-install/resize_fat/dir_entry.pm
+++ b/perl-install/resize_fat/dir_entry.pm
@@ -17,7 +17,7 @@ my $DIRECTORY_ATTR = 0x10;
sub get_cluster($) {
my ($entry) = @_;
- $entry->{first_cluster} + ($resize_fat::isFAT32 ? $entry->{first_cluster_high} * 65536 : 0);
+ $entry->{first_cluster} + ($resize_fat::isFAT32 ? $entry->{first_cluster_high} * (1 << 16) : 0);
}
sub set_cluster($$) {
my ($entry, $val) = @_;
@@ -68,7 +68,7 @@ sub remap {
my $cluster = get_cluster($entry);
my $new_cluster = resize_fat::c_rewritten::fat_remap($cluster);
- #-print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster";
+ #-print "remapping cluster ", get_cluster($entry), " to $new_cluster";
$new_cluster == $cluster and return; #- no need to modify