diff options
author | Pascal Rigaux <pixel@mandriva.com> | 1999-08-28 10:19:54 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 1999-08-28 10:19:54 +0000 |
commit | 2d3b13d3b7e6f08f6310467ece7d399c5858d233 (patch) | |
tree | 61e0a5cc6284c4e8dc138385da6329f2b8e83e0f /perl-install | |
parent | 90f7bb2359c71498b66bf6eb4ed764671816ace6 (diff) | |
download | drakx-2d3b13d3b7e6f08f6310467ece7d399c5858d233.tar drakx-2d3b13d3b7e6f08f6310467ece7d399c5858d233.tar.gz drakx-2d3b13d3b7e6f08f6310467ece7d399c5858d233.tar.bz2 drakx-2d3b13d3b7e6f08f6310467ece7d399c5858d233.tar.xz drakx-2d3b13d3b7e6f08f6310467ece7d399c5858d233.zip |
no_comment
Diffstat (limited to 'perl-install')
-rw-r--r-- | perl-install/Makefile | 1 | ||||
-rw-r--r-- | perl-install/commands.pm | 10 | ||||
-rw-r--r-- | perl-install/common.pm | 2 | ||||
-rw-r--r-- | perl-install/detect_devices.pm | 10 | ||||
-rw-r--r-- | perl-install/install2.pm | 53 | ||||
-rw-r--r-- | perl-install/install_any.pm | 19 | ||||
-rw-r--r-- | perl-install/install_steps.pm | 2 | ||||
-rw-r--r-- | perl-install/partition_table_raw.pm | 8 | ||||
-rw-r--r-- | perl-install/pkgs.pm | 57 | ||||
-rw-r--r-- | perl-install/share/list | 43 |
10 files changed, 118 insertions, 87 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile index 99ffe5ee1..fe296c0a4 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -99,6 +99,7 @@ get_needed_files: $(SO_FILES) ldd $$i 2>/dev/null | grep -v "not a dynamic" | sed -e 's/.*=> //' -e 's/ .*//' | uniq | sort >> /tmp/list; \ done + install -d $(DEST)/etc install -d $(DEST)/lib install -d $(DEST)/bin install -d $(DEST)/usr/bin diff --git a/perl-install/commands.pm b/perl-install/commands.pm index 44a49a17f..1e09d7329 100644 --- a/perl-install/commands.pm +++ b/perl-install/commands.pm @@ -274,8 +274,9 @@ $pid, $cpu, $cmd sub dd { - my $u = "usage: dd [-h] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n"; - (getopts(\@_, qw(h)))[0] and die $u; + my $u = "usage: dd [-h] [-p] [if=<file>] [of=<file>] [bs=<number>] [count=<number>]\n"; + my ($help, $percent) = getopts(\@_, qw(hp)); + die $u if $help; my %h = (if => \*STDIN, of => \*STDOUT, bs => 512, count => undef); foreach (@_) { /(.*?)=(.*)/ && exists $h{$1} or die $u; @@ -290,12 +291,13 @@ sub dd { $h{bs} =~ /(\d+)G$/ and $h{bs} = $1 * 1024 * 1024 * 1024; for ($nb = 0; !$h{count} || $nb < $h{count}; $nb++) { + printf "\r%02.1d%%", 100 * $nb / $h{count} if $h{count} && $percent; $read = sysread(IF, $tmp, $h{bs}) or $h{count} ? die "error: can't read block $nb\n" : last; syswrite(OF, $tmp) or die "error: can't write block $nb\n"; $read < $h{bs} and $read = 1, last; } - print STDERR "$nb+$read records in\n"; - print STDERR "$nb+$read records out\n"; + print STDERR "\r$nb+$read records in\n"; + print STDERR "$nb+$read records out\n"; } sub head_tail { diff --git a/perl-install/common.pm b/perl-install/common.pm index 4e5dccf9c..ee9101f96 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -204,7 +204,7 @@ sub warp_text($;$) { my @l; foreach (split "\n", $text) { - my $t; + my $t = ''; foreach (split /\s+/, $_) { if (length "$t $_" > $width) { push @l, $t; diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index 327f12754..b8e9c9993 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -29,6 +29,11 @@ sub get { } sub hds() { grep { $_->{type} eq 'hd' } get(); } sub cdroms() { grep { $_->{type} eq 'cdrom' } get(); } +sub floppies() { + my @l = grep { $_->{type} eq 'fd' } get(); + unshift @l, "fd0" if tryOpen("fd0"); + @l; +} sub hasSCSI() { defined $scsiDeviceAvailable and return $scsiDeviceAvailable; @@ -143,3 +148,8 @@ sub hasPlip() { goto &getPlip } sub hasEthernet() { hasNetDevice("eth0"); } sub hasTokenRing() { hasNetDevice("tr0"); } sub hasNetDevice($) { c::hasNetDevice($_[0]) } + +sub tryOpen($) { + local *F; + sysopen F, "/dev/$_[0]", c::O_NONBLOCK(); +} diff --git a/perl-install/install2.pm b/perl-install/install2.pm index c198a8c86..749d9ac5b 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -64,17 +64,17 @@ before use them."), formatPartitions => __("The partitions lately created must be formatted so that the system can use them. -You can also format partitions previously created and used if you wish to remove all the data they -contain. Note that it is not necessary to format the partitions already created and in use -if they contain data you want to keep (typical cases: /home and /usr/local)."), +You can also format partitions before created and used if you wish to remove all the data which +contain. Note that it is not necessary to format the partitions created before used if they contain data to +which you want to keep (typical cases: / home and / usr/local)."), choosePackages => - __("You now have the possibility of choosing the software that you wish to install. + __("You now have the possibility of choosing the software which you wish to install. Please note that packages manage the dependences: that means that if you wish to install -a software requiring the presence of another software, the latter will be automatically selected -and that it will be impossible for you to install the former without installing the latter. +a software requiring the presence of another software, this last will be automatically selected +and that it will be impossible for you to install the first without installing the second. -Information on each category of packages and each one of them is available in the zone \"Infos\" +Information on each category of packages and each one of enter of them are available in zone \"Infos\" located above buttons of confirmation/selection/deselection."), doInstallStep => __("Selected packages are now getting installed on your system. This operation take only a few minutes."), @@ -88,7 +88,7 @@ The password should not be too simple so that whoever cannot be connected under It should not be either too sophisticated under penalty of being difficult to retain and, finally, forgotten. When you wish to connect yourselves on your Linux system as an administrator, the \"login\" -is \"root\" and the \"password\", this one which you now will indicate."), +is \"root\" and the \"passswrd\", this one which you now will indicate."), addUser => __("You can now authorize one or more people to be connected on your Linux system. Each one of them will profit from his own environment will be able to configure. @@ -99,8 +99,8 @@ is a very bad idea. This last having all the rights it is certain that at one ti This is highly preferable you connect as simple user and that you use the account \"root\" only when that is essential."), doInstallStep => - __("The system being now copied on your disk, he is now time to indicate to it from where he will have to start. -Unless than you know exactly what you do, always choose \"First sector of drive\"."), + __("The system being now copied on your disk, he is now time to indicate to him from where he will have to start. +With less than you know exactly what you do, always choose \"First sector of drive\"."), configureX => __("It is now time to configure the graphic server. First of all, choose your monitor. You have then @@ -156,28 +156,25 @@ my @serverPartitioning = ( ); my $default = { - lang => 'us', - isUpgrade => 0, - installClass => 'beginner', # display => "192.168.1.9:0", bootloader => { onmbr => 1, linear => 0 }, autoSCSI => 0, mkbootdisk => 0, packages => [ qw() ], - partitionning => { clearall => $::testing, eraseBadPartitions => 1, auto_allocate => 0, autoformat => 0 }, + partitionning => { clearall => $::testing, eraseBadPartitions => 0, auto_allocate => 0, autoformat => 0 }, partitions => [ { 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) ], + shells => [ map { "/bin/$_" } qw(bash tcsh zsh ash ksh) ], }; $o = $::o = { -# lang => 'fr', -# isUpgrade => 0, -# installClass => 'beginner', + lang => 'us', + isUpgrade => 0, + installClass => 'beginner', # intf => [ { DEVICE => "eth0", IPADDR => '1.2.3.4', NETMASK => '255.255.255.128' } ], default => $default, @@ -235,13 +232,7 @@ sub partitionDisks { $o->doPartitionDisks($o->{hds}); unless ($::testing) { - # Write partitions to disk - my $need_reboot = 0; - foreach (@{$o->{hds}}) { - eval { partition_table::write($_); }; - $need_reboot ||= $@; - } - $need_reboot and $o->rebootNeeded; + $o->rebootNeeded foreach grep { $_->{rebootNeeded} } @{$o->{hds}}; } } @@ -341,6 +332,18 @@ sub main { modules::load_deps("/modules/modules.dep"); modules::read_conf("/tmp/conf.modules"); + while (@_) { + local $_ = shift; + if (/--method/) { + $_ = shift; + if (/ftp/) { + require 'ftp.pm'; + local $^W = 0; + *install_any::getFile = \&ftp::getFile; + } + } + } + my $clicked = 0; for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) { $o->enteringStep($o->{step}); diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 48b0d0863..4ec01334c 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -17,14 +17,15 @@ use log; 1; -sub fileInBase { member($_[0], qw(compss depslist hdlist)); } - -sub imageGetFile { - fileInBase($_[0]) and return "/tmp/rhimage/Mandrake/base/$_[0]"; - my $f = "/tmp/rhimage/Mandrake/RPMS/$_[0]"; - -r $f and return $f; - $f =~ s/i386/i586/; - $f; +sub relGetFile($) { + local $_ = member($_[0], qw(compss depslist hdlist)) ? "base" : "RPMS"; + $_ = "Mandrake/$_/$_[0]"; + s/i386/i586/; + $_; +} +sub getFile($) { + open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or return; + \*getFile; } sub versionString { @@ -95,7 +96,7 @@ sub setPackages { $o->{packages}{$_}{base} = 1 foreach @{$o->{base}}; - pkgs::setCompssSelected($o->{compss}, $o->{packages}, $o->{installClass}); + pkgs::setCompssSelected($o->{compss}, $o->{packages}, $o->{installClass}, $o->{lang}); } sub addToBeDone(&$) { diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 8dac8db20..a7720e692 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -51,7 +51,7 @@ sub enteringStep($$) { my $reachable = 1; if (my $needs = $o->{steps}{$s}{needs}) { my @l = ref $needs ? @$needs : $needs; - $reachable = min(map { $o->{steps}{$_}{done} } @l); + $reachable = min(map { $o->{steps}{$_}{done} || 0 } @l); } if ($reachable && !$o->{steps}{$s}{reachable}) { $o->{steps}{$s}{reachable} = 1; diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm index aa25321a2..7d74debb5 100644 --- a/perl-install/partition_table_raw.pm +++ b/perl-install/partition_table_raw.pm @@ -57,7 +57,7 @@ sub openit($$;$) { sysopen $_[1], $_[0]{file}, $_[2] || 0; } sub kernel_read($) { my ($hd) = @_; local *F; openit($hd, \*F) or return 0; - ioctl(F, c::BLKRRPART(), 0) or die "kernel_read failed: need to reboot"; + $hd->{rebootNeeded} = !ioctl(F, c::BLKRRPART(), 0); } sub read($$) { @@ -102,6 +102,8 @@ sub write($$$) { sub clear_raw { { raw => [ ({}) x $nb_primary ] } } sub zero_MBR($) { - $_[0]{primary} = clear_raw(); - delete $_[0]{extended}; + my ($hd) = @_; + $hd->{isDirty} = $hd->{needKernelReread} = 1; + $hd->{primary} = clear_raw(); + delete $hd->{extended}; } diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index e377cf361..2a9947e60 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -30,7 +30,7 @@ sub select($$;$) { while (@l) { my $n = shift @l; $n =~ /|/ and $n = first(split '\|', $n); #TODO better handling of choice - my $i = Package($packages, $n); + my $i = Package($packages, $n) or next; $i->{base} ||= $base; $i->{deps} or log::l("missing deps for $n"); push @l, @{$i->{deps} || []} unless $i->{selected}; @@ -87,7 +87,7 @@ sub set($$$) { } sub psUsingDirectory() { - my $dirname = install_any::imageGetFile(''); + my $dirname = "/tmp/rhimage/Mandrake/RPMS"; my %packages; log::l("scanning $dirname for packages"); @@ -96,25 +96,22 @@ sub psUsingDirectory() { $packages{$name} = { name => $name, version => $version, release => $release, - file => "$dirname/$_", selected => 0, deps => [], + file => $_, selected => 0, deps => [], }; } \%packages; } sub psUsingHdlist() { - my $file = install_any::imageGetFile('hdlist'); - my ($noSeek, $end, %packages) = 0; - - local *F; - sysopen F, $file, 0 or die "error opening header file $file: $!"; - - $end = sysseek F, 0, 2 or die "seek failed"; - sysseek F, 0, 0 or die "seek failed"; + my $f = install_any::getFile('hdlist') or die "no hdlist found"; + my %packages; - while (sysseek(F, 0, 1) < $end) { - my $header = c::headerRead(fileno F, 1) or die "error reading header at offset ", sysseek(F, 0, 1); +# my ($noSeek, $end) = 0; +# $end = sysseek F, 0, 2 or die "seek failed"; +# sysseek F, 0, 0 or die "seek failed"; + while (my $header = c::headerRead(fileno $f, 1)) { +# or die "error reading header at offset ", sysseek(F, 0, 1); my $name = c::headerGetEntry($header, 'name'); $packages{$name} = { @@ -134,9 +131,8 @@ sub chop_version($) { sub getDeps($) { my ($packages) = @_; - local *F; - open F, install_any::imageGetFile("depslist") or die "can't find dependencies list"; - foreach (<F>) { + my $f = install_any::getFile("depslist") or die "can't find dependencies list"; + foreach (<$f>) { my ($name, $size, @deps) = split; ($name, @deps) = map { chop_version($_) } ($name, @deps); $packages->{$name} or next; @@ -150,9 +146,8 @@ sub readCompss($) { my ($packages) = @_; my (@compss, $ps, $category); - local *F; - open F, install_any::imageGetFile("compss") or die "can't find compss"; - foreach (<F>) { + my $f = install_any::getFile("compss") or die "can't find compss"; + foreach (<$f>) { /^\s*$/ || /^#/ and next; s/#.*//; my ($options, $name) = /^(\S*)\s+(.*?)\s*$/ or die "bad line in compss: $_"; @@ -170,8 +165,8 @@ sub readCompss($) { [ @compss, $category ]; } -sub setCompssSelected($$$) { - my ($compss, $packages, $install_class, $select) = @_; +sub setCompssSelected($$$$) { + my ($compss, $packages, $install_class, $lang) = @_; my $l = substr($install_class, 0, 1); my $L = uc $l; @@ -179,7 +174,7 @@ sub setCompssSelected($$$) { my $verif_lang = sub { local $SIG{__DIE__} = 'none'; $_[0] =~ /-([^-]*)$/; - $1 eq $ENV{LANG} || eval { lang::text2lang($1) eq $ENV{LANG} } && !$@; + $1 eq $lang || eval { lang::text2lang($1) eq $lang } && !$@; }; foreach my $c (@$compss) { @@ -217,9 +212,8 @@ sub getHeader($) { my ($p) = @_; unless ($p->{header}) { - local *F; - open F, $p->{file} or die "error opening package $p->{name} (file $p->{file})"; - $p->{header} = c::rpmReadPackageHeader(fileno F); + 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}; } @@ -238,11 +232,9 @@ sub install { foreach my $p (@$toInstall) { $p->{installed} = 1; - $p->{file} ||= install_any::imageGetFile(sprintf "%s-%s-%s.%s.rpm", - $p->{name}, - $p->{version}, - $p->{release}, - c::headerGetEntry(getHeader($p), 'arch')); + $p->{file} ||= sprintf "%s-%s-%s.%s.rpm", + $p->{name}, $p->{version}, $p->{release}, + c::headerGetEntry(getHeader($p), 'arch'); c::rpmtransAddPackage($trans, getHeader($p), $p->{file}, $isUpgrade); $nb++; $total += $p->{size}; @@ -256,10 +248,13 @@ sub install { log::ld("starting installation: ", $nb, " packages, ", $total, " bytes"); # !! do not translate these messages, they are used when catched (cf install_steps_graphical) + my $callbackOpen = sub { fileno install_any::getFile($_[0]) || log::l("bad file $_[0]") }; + my $callbackClose = sub { }; my $callbackStart = sub { log::ld("starting installing package ", $_[0]) }; my $callbackProgress = sub { log::ld("progressing installation ", $_[0], "/", $_[1]) }; - if (my @probs = c::rpmRunTransactions($trans, $callbackStart, $callbackProgress, $force)) { + if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, + $callbackStart, $callbackProgress, $force)) { die "installation of rpms failed:\n ", join("\n ", @probs); } c::rpmtransFree($trans); diff --git a/perl-install/share/list b/perl-install/share/list index 14ed9111f..4cc1dcdf3 100644 --- a/perl-install/share/list +++ b/perl-install/share/list @@ -1,45 +1,62 @@ /bin/ash /bin/cpio +/lib/libnss_nis.so.2 +/lib/libnss_files.so.2 +/etc/protocols /sbin/insmod -/sbin/mke2fs /sbin/mkdosfs -/usr/bin/bzip2 -/usr/lib/rpm/rpmrc -/usr/X11R6/bin/xmodmap +/sbin/mke2fs /usr/X11R6/bin/XF86_VGA16 -/usr/X11R6/lib/X11/locale/compose.dir -/usr/X11R6/lib/X11/locale/iso8859-1/Compose -/usr/X11R6/lib/X11/locale/iso8859-1/XLC_LOCALE -/usr/X11R6/lib/X11/locale/locale.alias -/usr/X11R6/lib/X11/locale/locale.dir +/usr/X11R6/bin/xmodmap +/usr/bin/bzip2 /usr/lib/perl5/5.00503/AutoLoader.pm /usr/lib/perl5/5.00503/Carp.pm +/usr/lib/perl5/5.00503/Data/Dumper.pm /usr/lib/perl5/5.00503/Exporter.pm +/usr/lib/perl5/5.00503/FileHandle.pm +/usr/lib/perl5/5.00503/SelectSaver.pm /usr/lib/perl5/5.00503/SelfLoader.pm +/usr/lib/perl5/5.00503/Symbol.pm /usr/lib/perl5/5.00503/Term/Cap.pm /usr/lib/perl5/5.00503/Term/ReadLine.pm -/usr/lib/perl5/5.00503/Data/Dumper.pm +/usr/lib/perl5/5.00503/Time/Local.pm /usr/lib/perl5/5.00503/diagnostics.pm /usr/lib/perl5/5.00503/dumpvar.pl /usr/lib/perl5/5.00503/i386-linux/Config.pm /usr/lib/perl5/5.00503/i386-linux/DynaLoader.pm +/usr/lib/perl5/5.00503/i386-linux/Fcntl.pm +/usr/lib/perl5/5.00503/i386-linux/auto/Fcntl +/usr/lib/perl5/5.00503/i386-linux/auto/Fcntl/Fcntl.bs +/usr/lib/perl5/5.00503/i386-linux/auto/Fcntl/Fcntl.so +/usr/lib/perl5/5.00503/i386-linux/IO/File.pm +/usr/lib/perl5/5.00503/i386-linux/IO/Handle.pm +/usr/lib/perl5/5.00503/i386-linux/IO/Seekable.pm +/usr/lib/perl5/5.00503/i386-linux/IO/Socket.pm /usr/lib/perl5/5.00503/i386-linux/Socket.pm +/usr/lib/perl5/5.00503/i386-linux/_h2ph_pre.ph +/usr/lib/perl5/5.00503/i386-linux/asm/unistd.ph /usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.bs /usr/lib/perl5/5.00503/i386-linux/auto/Data/Dumper/Dumper.so +/usr/lib/perl5/5.00503/i386-linux/auto/IO/IO.so /usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.bs /usr/lib/perl5/5.00503/i386-linux/auto/Socket/Socket.so /usr/lib/perl5/5.00503/i386-linux/bits/syscall.ph /usr/lib/perl5/5.00503/i386-linux/sys/syscall.ph /usr/lib/perl5/5.00503/i386-linux/syscall.ph -/usr/lib/perl5/5.00503/i386-linux/_h2ph_pre.ph -/usr/lib/perl5/5.00503/i386-linux/asm/unistd.ph /usr/lib/perl5/5.00503/lib.pm +/usr/lib/perl5/5.00503/overload.pm /usr/lib/perl5/5.00503/perl5db.pl /usr/lib/perl5/5.00503/pod/perldiag.pod -/usr/lib/perl5/5.00503/overload.pm /usr/lib/perl5/5.00503/strict.pm /usr/lib/perl5/5.00503/vars.pm /usr/lib/perl5/site_perl/5.005/i386-linux/Gtk.pm /usr/lib/perl5/site_perl/5.005/i386-linux/Gtk/Types.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/Cmd.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/Config.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/FTP.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/FTP/I.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/FTP/dataconn.pm +/usr/lib/perl5/site_perl/5.005/i386-linux/Net/Netrc.pm /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Gtk/Gtk.bs /usr/lib/perl5/site_perl/5.005/i386-linux/auto/Gtk/Gtk.so +/usr/lib/rpm/rpmrc |