summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/.cvsignore7
-rw-r--r--perl-install/Makefile212
-rw-r--r--perl-install/c/.cvsignore6
-rw-r--r--perl-install/c/Makefile.PL15
-rwxr-xr-xperl-install/commands15
-rw-r--r--perl-install/commands.pm496
-rw-r--r--perl-install/common.pm361
-rw-r--r--perl-install/detect_devices.pm218
-rw-r--r--perl-install/devices.pm109
-rw-r--r--perl-install/fs.pm273
-rw-r--r--perl-install/fsedit.pm335
-rw-r--r--perl-install/ftp.pm54
-rw-r--r--perl-install/help.pm302
-rwxr-xr-xperl-install/install231
-rw-r--r--perl-install/install2.pm636
-rw-r--r--perl-install/install_any.pm156
-rw-r--r--perl-install/install_steps.pm307
-rw-r--r--perl-install/install_steps_interactive.pm758
-rw-r--r--perl-install/install_steps_stdio.pm73
-rw-r--r--perl-install/interactive.pm162
-rw-r--r--perl-install/keyboard.pm154
-rw-r--r--perl-install/lang.pm233
-rw-r--r--perl-install/log.pm47
-rw-r--r--perl-install/modules.pm324
-rw-r--r--perl-install/mouse.pm87
-rw-r--r--perl-install/partition_table.pm488
-rwxr-xr-xperl-install/perl2etags8
-rw-r--r--perl-install/pkgs.pm353
-rw-r--r--perl-install/resize_fat/Makefile12
-rw-r--r--perl-install/resize_fat/README8
-rw-r--r--perl-install/resize_fat/any.pm82
-rw-r--r--perl-install/resize_fat/boot_sector.pm107
-rw-r--r--perl-install/resize_fat/dir_entry.pm72
-rw-r--r--perl-install/resize_fat/directory.pm78
-rw-r--r--perl-install/resize_fat/fat.pm167
-rw-r--r--perl-install/resize_fat/info_sector.pm36
-rw-r--r--perl-install/resize_fat/io.pm74
-rw-r--r--perl-install/resize_fat/main.pm166
-rw-r--r--perl-install/run_program.pm55
-rw-r--r--perl-install/share/diskdrake.rc30
-rw-r--r--perl-install/share/po/Makefile22
-rw-r--r--perl-install/share/themes-blue.rc47
-rw-r--r--perl-install/timezone.pm80
-rw-r--r--perl-install/unused/.cvsignore1
-rw-r--r--perl-install/unused/cdrom.pm41
-rw-r--r--perl-install/unused/dns.pm64
-rw-r--r--perl-install/unused/otherinsmod.pm26
-rw-r--r--perl-install/unused/scsi.pm104
-rwxr-xr-xperl-install/verify_c14
49 files changed, 0 insertions, 7506 deletions
diff --git a/perl-install/.cvsignore b/perl-install/.cvsignore
deleted file mode 100644
index 125d80f93..000000000
--- a/perl-install/.cvsignore
+++ /dev/null
@@ -1,7 +0,0 @@
-keymaps
-consolefonts
-modparm.lst
-locales.tar.bz2
-debug.log
-auto_inst.cfg
-perl
diff --git a/perl-install/Makefile b/perl-install/Makefile
deleted file mode 100644
index 9b0d037f7..000000000
--- a/perl-install/Makefile
+++ /dev/null
@@ -1,212 +0,0 @@
-VERSION = 2.2.10-BOOT
-SUDO = sudo
-SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm c/*.pm resize_fat/*.pm pci_probing/*.pm commands install2 diskdrake XFdrake g_auto_install
-ROOTDEST = /export
-DEST = $(ROOTDEST)/Mandrake/mdkinst
-STAGE2 = $(ROOTDEST)/Mandrake/base/mdkinst_stage2
-BASE = $(ROOTDEST)/Mandrake/base
-DESTREP4PMS = $(DEST)/usr/bin/perl-install
-STAGE2TMP = /tmp/stage2_tmp
-PERL = perl
-LOCALFILES = $(PERL) mouseconfig ddcxinfos
-DIRS = po pci_probing
-EXCLUDE = $(LOCALFILES) boot.img keymaps consolefonts install
-RPMS = $(wildcard $(ROOTDEST)/Mandrake/RPMS/*.rpm)
-CFLAGS = -Wall
-override CFLAGS += -pipe
-
-.PHONY: all $(DIRS) tags install clean stage2 full_stage2 verify_c
-
-all: $(SO_FILES) $(DIRS)
-
-tags:
- etags -o - $(PMS) | ./perl2etags > TAGS
-
-clean:
- test ! -e c/Makefile || $(MAKE) -C c clean
- for i in $(DIRS); do $(MAKE) -C $$i clean; done
- rm -rf c/c.xs gendepslist ../diskdrake*
- find . -name "*~" -o -name "TAGS" -o -name "*.old" | xargs rm -f
-
-tar: clean
- cd .. ; tar cfy perl-install.tar.bz2 $(EXCLUDE:%=--exclude %) perl-install
-
-floppy:
- dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cp -a ../install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
-
-tar-diskdrake: clean pci_probing
- cd .. ; rm -rf diskdrake ; cp -af perl-install diskdrake
-
- l=`./perl2fcalls -uses -excludec diskdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/diskdrake\//' -e 's/$$/.pm/'` ; \
- cd .. ; tar cfz diskdrake.tgz --exclude CVS $(patsubst %,diskdrake/%,c po diskdrake*) $$l
-
-tar-XFdrake: clean
- cd .. ; rm -rf XFdrake ; cp -af perl-install XFdrake
-
- l=`./perl2fcalls -uses -excludec -excludepci_probing::ids XFdrake | sort | uniq | sed -e 's/::/\//' -e 's/^/XFdrake\//' -e 's/$$/.pm/'` ; \
- cd .. ; tar cfz XFdrake.tgz --exclude CVS $(patsubst %,XFdrake/%,c MonitorsDB po pci_probing XFdrake*) $$l
-
-c/c.xs: c/c.xs.pm
- rm -f $@
- export C_RPM=1 ; perl $< > $@
- chmod a-w $@
-
-$(SO_FILES): c/c.xs
- test -e c/Makefile || (cd c; export C_RPM=1 ; perl Makefile.PL)
- $(MAKE) -C c
-
-$(DIRS):
- $(MAKE) -C $@
-
-test_pms: verify_c
- ./perl2fcalls -excludec install2
- perl -cw -I. -Ic -Ic/blib/arch install2
- perl -cw -I. -Ic -Ic/blib/arch install_steps_graphical.pm
-
-verify_c:
- ./verify_c $(PMS)
-
-gendepslist: %: %.cc
- $(CXX) -I/usr/include/rpm $(CFLAGS) $< -lrpm -ldb1 -lz -o $@
-
-$(BASE)/depslist: gendepslist $(RPMS)
- ./gendepslist $(BASE)/depslist $(ROOTDEST)/Mandrake/RPMS/*.rpm
-
-$(BASE)/hdlist: $(RPMS)
- $(ROOTDEST)/misc/genhdlist $(ROOTDEST)
-
-install_pms: all
- for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done
-
- install -d $(DESTREP4PMS)
- for i in $(PMS); do \
- dest=$(DESTREP4PMS)/`dirname $$i`; \
- install -d $$dest; \
- perl -ne 'print' $$i > $(DESTREP4PMS)/$$i; \
- done
-# perl -ne 's/\s*#-.*//; print unless (/^=head/ .. /^=cut/) || /use (diagnostics|vars|strict)/' $$i > $(DESTREP4PMS)/$$i; \
-# /
-
- rm $(DESTREP4PMS)/c/c.xs.pm
- mv -f $(DESTREP4PMS)/c/c.pm $(DESTREP4PMS)
-
- cp *.rc $(DESTREP4PMS)
- install -d $(DESTREP4PMS)/po
- cp po/*.po* $(DESTREP4PMS)/po
- ln -sf perl-install/install2 $(DEST)/usr/bin
- ln -sf perl-install/commands $(DEST)/usr/bin
- chmod a+x $(DESTREP4PMS)/install2
- chmod a+x $(DESTREP4PMS)/commands
- chmod a+x $(DESTREP4PMS)/XFdrake
- chmod a+x $(DESTREP4PMS)/g_auto_install
-
- cp -af */blib/arch/auto $(DESTREP4PMS)
- find $(DESTREP4PMS) -name "*.so" | xargs strip
-
-get_needed_files: $(SO_FILES)
-# export PERL_INSTALL_TEST=1 ; strace -f -e trace=file -o '| grep -v "(No such file or directory)" | sed -e "s/[^\"]*\"//" -e "s/\".*//" | grep "^/" | grep -v -e "^/tmp" -e "^/home" -e "^/proc" -e "^/var" -e "^/dev" -e "^/etc" -e "^/usr/lib/rpm" > /tmp/list ' $(PERL) -d install2 < /dev/null
- cp -f list /tmp/list
- for i in c/blib/arch/auto/c/c.so $(LOCALFILES) `cat /tmp/list` ; do \
- 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
- install -d $(DEST)/usr/lib
- install -d $(DEST)/usr/share
- install -d $(DEST)/usr/share/xmodmap
- install -d $(ROOTDEST)/Mandrake/base
- install -s $(LOCALFILES) $(DEST)/usr/bin
-
- for i in `cat /tmp/list`; do \
- if (echo $$i | grep -q "lib/[^/]*\.so"); then \
- install -s $$i $(DEST)/lib; \
- else \
- d=`echo $(DEST)/$$i | sed 's/\/usr\/local\//\/usr\//'`; \
- install -d `dirname $$d` && \
- if (echo $$i | grep -q "\.pm"); then \
- perl -pe '$$_ =~ /^__END__/ and exit(0);' $$i > $$d; \
- else \
- cp -f $$i $$d; \
- strip $$d 2>/dev/null || true; \
- fi; \
- fi; \
- done
-
- mv -f $(DEST)/bin/* $(DEST)/sbin/* $(DEST)/usr/bin
- cd $(DEST)/usr/bin ; mv insmod insmod_
- rmdir $(DEST)/bin $(DEST)/sbin
-
- ln -sf ash $(DEST)/usr/bin/sh
-
- tar xfy locales.tar.bz2 -C $(DEST)
-# DEST=$(DEST) perl -I. -MForMakefile -e 'locale()'
- DEST=$(DEST) perl -I. -MForMakefile -e 'xmodmap()'
-
- cp -a keymaps $(DEST)/usr/share
- cp -a consolefonts $(DEST)/usr/share
- cp modparm.lst MonitorsDB $(DEST)/usr/share
- cp logo-mandrake.xpm $(DEST)/usr/share
- cp compss compssList $(ROOTDEST)/Mandrake/base
-
- cp -f ../modules/modules.cpio.bz2 $(DEST)/lib/
- install -d $(DEST)/lib/modules
- cp -f ../modules/pristine/* $(DEST)/lib/modules
-
- ln -s install2 $(DEST)/usr/bin/runinstall2
-# echo -e "#!/bin/sh\n\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2
-# chmod a+x $(DEST)/usr/bin/runinstall2
-
-as_root:
- /bin/dd if=/dev/zero of=/tmp/initrd bs=1k count=4000
- echo y | /sbin/mke2fs /tmp/initrd
- losetup /dev/loop0 /tmp/initrd
- mount /dev/loop0 /mnt/initrd
- chmod a+w /mnt/initrd
-
-full_stage2: $(BASE)/depslist $(BASE)/hdlist
- rm -rf $(DEST)
- mkdir -p $(DEST)
- $(MAKE) get_needed_files
- $(MAKE) stage2
-
-stage2:
- $(MAKE) install_pms
-
- $(SUDO) rm -rf $(STAGE2TMP)
- install -d $(STAGE2TMP)
- $(SUDO) cp -a $(DEST)/* $(STAGE2TMP)
-
- $(SUDO) umount /mnt/stage2 ; true
- dd if=/dev/zero of=$(STAGE2) bs=1M count=14
- echo y | /sbin/mke2fs $(STAGE2)
- $(SUDO) mount -t ext2 $(STAGE2) /mnt/stage2 -o loop
-
-# hack to reduce the STAGE2 image
- rm $(STAGE2TMP)/usr/X11R6/bin/XF86_VGA16
- for i in /usr/share/locale /usr/share/keymaps /usr/share/xmodmap; do \
- name=`basename $$i` ; \
- (cd $(STAGE2TMP)/$$i ; find * | cpio -o 2>/dev/null | bzip2 > ../$$name.cpio.bz2 ; cd .. ; rm -rf $$name) \
- done
- $(SUDO) cp -a $(STAGE2TMP)/* /mnt/stage2
- $(SUDO) rm -rf $(STAGE2TMP)
-
- $(SUDO) umount $(STAGE2)
- gzip -f -9 $(STAGE2)
-# cd $(ROOTDEST) ; tar cfz /tmp/instimage-full.tgz Mandrake
-# cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/base/compss Mandrake/mdkinst/usr/[bl]*
-
- @#rm -rf /mnt/initrd/*
- @#cp -a $(DEST)/* /mnt/initrd
- @#sync
- @#dd if=/dev/loop0 | gzip -9 > /tmp/t/Mandrake/base/stage2.img
-
-# function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; }
-
-#
-# install -s install/install install1/bin/install ; install -s installinit/init install1/bin/init
-# mount /tmp/initrd /mnt/disk/ -o loop ; ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a:
-
diff --git a/perl-install/c/.cvsignore b/perl-install/c/.cvsignore
deleted file mode 100644
index 0c6427c49..000000000
--- a/perl-install/c/.cvsignore
+++ /dev/null
@@ -1,6 +0,0 @@
-Makefile
-c.c
-c.bs
-pm_to_blib
-blib
-c.xs
diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL
deleted file mode 100644
index edbabef13..000000000
--- a/perl-install/c/Makefile.PL
+++ /dev/null
@@ -1,15 +0,0 @@
-use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-
-my $libs = '-L/usr/X11R6/lib -lX11 -lgdk';
-
-$libs .= ' -lrpm -ldb1 -lz' if $ENV{C_RPM};
-
-WriteMakefile(
- 'NAME' => 'c',
- 'VERSION_FROM' => 'c.pm', # finds $VERSION
- 'LIBS' => [$libs], # e.g., '-lm'
- 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
- 'INC' => '-I/usr/include/rpm -Wall `gtk-config --cflags`', # e.g., '-I/usr/include/other'
-);
diff --git a/perl-install/commands b/perl-install/commands
deleted file mode 100755
index e00f215de..000000000
--- a/perl-install/commands
+++ /dev/null
@@ -1,15 +0,0 @@
-#!/usr/bin/perl
-
-use diagnostics;
-use strict;
-
-use lib qw(/usr/bin/perl-install . c c/blib/arch);
-use common qw(:file);
-use commands;
-
-my $progname = basename($0);
-
-# hack as some functions are defined by perl... so chmod -> chmod_
-&{$commands::{$progname} || $commands::{$progname . "_"} || \&err}(@ARGV), exit 0;
-
-sub err { die "$0: unknown program (unimplemented)\n"; }
diff --git a/perl-install/commands.pm b/perl-install/commands.pm
deleted file mode 100644
index 3ff726617..000000000
--- a/perl-install/commands.pm
+++ /dev/null
@@ -1,496 +0,0 @@
-package commands;
-
-use diagnostics;
-use strict;
-use vars qw($printable_chars);
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :file :system :constant);
-
-#-#####################################################################################
-#- Globals
-#-#####################################################################################
-my $BUFFER_SIZE = 1024;
-
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-sub getopts {
- my $o = shift;
- my @r = map { '' } (@_ = split //, $_[0]);
- while (1) {
- local $_ = $o->[0];
- $_ && /^-/ or return @r;
- for (my $i = 0; $i < @_; $i++) { /$_[$i]/ and $r[$i] = $_[$i]; }
- shift @$o;
- }
- @r;
-}
-
-sub true { exit 0 }
-sub false { exit 1 }
-sub cat { @ARGV = @_; print while <> }
-sub which { ARG: foreach (@_) { foreach my $c (split /:/, $ENV{PATH}) { -x "$c/$_" and print("$c/$_\n"), next ARG; }}}
-sub dirname_ { print dirname(@_), "\n" }
-sub basename_ { print basename(@_), "\n" }
-sub rmdir_ { foreach (@_) { rmdir $_ or die "rmdir: can't remove $_\n" } }
-sub lsmod { print "Module Size Used by\n"; cat("/proc/modules"); }
-
-sub grep_ {
- my ($h, $v, $i) = getopts(\@_, qw(hvi));
- @_ == 0 || $h and die "usage: grep <regexp> [files...]\n";
- my $r = shift;
- $r = qr/$r/i if $i;
- @ARGV = @_; (/$r/ ? $v || print : $v && print) while <>
-}
-
-sub tr_ {
- my ($s, $c, $d) = getopts(\@_, qw(s c d));
- @_ >= 1 + (!$d || $s) or die "usage: tr [-c] [-s [-d]] <set1> <set2> [files...]\n or tr [-c] -d <set1> [files...]\n";
- my $set1 = shift;
- my $set2; !$d || $s and $set2 = shift;
- @ARGV = @_;
- eval "(tr/$set1/$set2/$s$d$c, print) while <>";
-}
-
-sub mount {
- @_ or return cat("/proc/mounts");
- my ($t) = getopts(\@_, qw(t));
- my $fs = $t && shift;
-
- @_ == 2 or die "usage: mount [-t <fs>] <device> <dir>\n",
- " (if /dev/ is left off the device name, a temporary node will be created)\n";
-
- my ($dev, $where) = @_;
- $fs ||= $where =~ /:/ ? "nfs" :
- $dev =~ /fd/ ? "vfat" : "ext2";
-
- require 'fs.pm';
- fs::mount($dev, $where, $fs, 0, 1);
-}
-
-sub umount {
- @_ == 1 or die "umount expects a single argument\n";
-
- require 'fs.pm';
- fs::umount($_[0]);
-}
-
-sub mkdir_ {
- my ($rec) = getopts(\@_, qw(p));
-
- my $mkdir; $mkdir = sub {
- my $root = dirname $_[0];
- if (-e $root) {
- -d $root or die "mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n";
- } else {
- $rec or die "mkdir: $root does not exist (try option -p)\n";
- &$mkdir($root);
- }
- mkdir $_[0], 0755 or die "mkdir: error creating directory $_: $!\n";
- };
- &$mkdir($_) foreach @_;
-}
-
-
-sub mknod {
- if (@_ == 1) {
- require 'devices.pm';
- eval { devices::make($_[0]) }; $@ and die "mknod: failed to create $_[0]\n";
- } elsif (@_ == 4) {
- require 'c.pm';
- my $mode = $ {{"b" => c::S_IFBLK(), "c" => c::S_IFCHR()}}{$_[1]} or die "unknown node type $_[1]\n";
- syscall_('mknod', my $a = $_[0], $mode | 0600, makedev($_[2], $_[3])) or die "mknod failed: $!\n";
- } else { die "usage: mknod <path> [b|c] <major> <minor> or mknod <path>\n"; }
-}
-
-sub ln {
- my ($force, $soft) = getopts(\@_, qw(fs));
- @_ >= 1 or die "usage: ln [-s] [-f] <source> [<dest>]\n";
-
- my ($source, $dest) = @_;
- $dest ||= basename($source);
-
- $force and unlink $dest;
-
- ($soft ? symlink($source, $dest) : link($source, $dest)) or die "ln failed: $!\n";
-}
-
-sub rm {
- my ($rec, undef) = getopts(\@_, qw(rf));
-
- my $rm; $rm = sub {
- foreach (@_) {
- if (-d $_) {
- $rec or die "$_ is a directory\n";
- &$rm(glob_($_));
- rmdir $_ or die "can't remove directory $_: $!\n";
- } else { unlink $_ or die "rm of $_ failed: $!\n" }
- }
- };
- &$rm(@_);
-}
-
-sub chmod_ {
- @_ >= 2 or die "usage: chmod <mode> <files>\n";
-
- my $mode = shift;
- $mode =~ /^[0-7]+$/ or die "illegal mode $mode\n";
-
- foreach (@_) { chmod oct($mode), $_ or die "chmod failed $_: $!\n" }
-}
-
-sub chown_ {
- my ($rec, undef) = getopts(\@_, qw(r));
- local $_ = shift or die "usage: chown [-r] name[.group] <files>\n";
-
- my ($name, $group) = (split('\.'), $_);
-
- my ($uid, $gid) = (getpwnam($name) || $name, getgrnam($group) || $group);
-
- my $chown; $chown = sub {
- foreach (@_) {
- chown $uid, $gid, $_ or die "chown of file $_ failed: $!\n";
- -d $_ && $rec and &$chown(glob_($_));
- }
- };
- &$chown(@_);
-}
-
-sub mkswap {
- @_ == 1 or die "mkswap <device>\n";
-
- require 'swap.pm';
- swap::enable($_[0], 0);
-}
-
-sub swapon {
- @_ == 1 or die "swapon <file>\n";
-
- require 'swap.pm';
- swap::swapon($_[0]);
-}
-sub swapoff {
- @_ == 1 or die "swapoff <file>\n";
- require 'swap.pm';
- swap::swapoff($_[0]);
-}
-
-sub uncpio {
- @_ and die "uncpio reads from stdin\n";
-
-# cpioInstallArchive(gzdopen(0, "r"), NULL, 0, NULL, NULL, &fail);
-}
-
-
-sub rights {
- my $r = '-' x 9;
- my @rights = (qw(x w r x w r x w r), ['t', 0], ['s', 3], ['s', 6]);
- for (my $i = 0; $i < @rights; $i++) {
- if (vec(pack("S", $_[0]), $i, 1)) {
- my ($val, $place) = $i >= 9 ? @{$rights[$i]} : ($rights[$i], $i);
- my $old = \substr($r, 8 - $place, 1);
- $$old = ($$old eq '-' && $i >= 9) ? uc $val : $val;
- }
- }
- my @types = split //, "_pc_d_b_-_l_s";
- $types[$_[0] >> 12 & 0xf] . $r;
-}
-
-sub ls {
- my ($l , $h) = getopts(\@_, qw(lh));
- $h and die "usage: ls [-l] <files...>\n";
-
- @_ or @_ = '.';
- @_ == 1 && -d $_[0] and @_ = glob_($_[0]);
- foreach (sort @_) {
- if ($l) {
- my @s = lstat or warn("can't stat file $_\n"), next;
- formline(
-"@<<<<<<<<< @<<<<<<< @<<<<<<< @>>>>>>>> @>>>>>>>>>>>>>>> @*\n",
- rights($s[2]), getpwuid $s[4] || $s[4], getgrgid $s[5] || $s[5],
- $s[6] ? join ", ", unmakedev($s[6]) : $s[7],
- scalar localtime $s[9], -l $_ ? "$_ -> " . readlink $_ : $_);
- print $^A; $^A = '';
- } else { print "$_\n"; }
- }
-}
-sub cp {
- my ($force) = getopts(\@_, qw(f));
- @_ >= 2 or die "usage: cp [-f] <sources> <dest>\n(this cp does -Rl by default)\n";
-
- my $cp; $cp = sub {
- my $dest = pop @_;
-
- @_ or return;
- @_ == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n";
-
- foreach my $src (@_) {
- my $dest = $dest;
- -d $dest and $dest .= "/" . basename($src);
-
- if (-e $dest) {
- $force ? unlink $dest : die "file $dest already exist\n";
- }
-
- if (-d $src) {
- -d $dest or mkdir $dest, mode($src) or die "mkdir: can't create directory $dest: $!\n";
- &$cp(glob_($src), $dest);
- } elsif (-l $src) {
- symlink((readlink($src) || die "readlink failed: $!"), $dest) or die "symlink: can't create symlink $dest: $!\n";
- } else {
- local (*F, *G);
- open F, $src or die "can't open $src for reading: $!\n";
- open G, "> $dest" or $force or die "can't create $dest : $!\n";
- foreach (<F>) { print G $_ }
- chmod mode($src), $dest;
- }
- }
- };
- &$cp(@_);
-}
-
-sub ps {
- @_ and die "usage: ps\n";
- my ($pid, $cpu, $cmd);
- my ($uptime) = split ' ', first(cat_("/proc/uptime"));
- my $hertz = 100;
-
- open PS, ">&STDOUT";
- format PS_TOP =
- PID %CPU CMD
-.
- format PS =
-@>>>> @>>> @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$pid, $cpu, $cmd
-.
- foreach $pid (sort {$a <=> $b} grep { /\d+/ } all('/proc')) {
- my @l = split(' ', cat_("/proc/$pid/stat"));
- $cpu = sprintf "%2.1f", max(0, min(99, ($l[13] + $l[14]) * 100 / $hertz / ($uptime - $l[21] / $hertz)));
- (($cmd) = cat_("/proc/$pid/cmdline")) =~ s/\0/ /g;
- $cmd ||= (split ' ', (cat_("/proc/$pid/stat"))[0])[1];
- write PS;
- }
-}
-
-
-sub dd {
- 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;
- $h{$1} = $2;
- }
- local (*IF, *OF); my ($tmp, $nb, $read);
- ref $h{if} eq 'GLOB' ? *IF = $h{if} : sysopen(IF, $h{if}, 0 ) || die "error: can't open file $h{if}\n";
- ref $h{of} eq 'GLOB' ? *OF = $h{of} : sysopen(OF, $h{of}, 0x41) || die "error: can't open file $h{of}\n";
-
- $h{bs} =~ /(\d+)k$/ and $h{bs} = $1 * 1024;
- $h{bs} =~ /(\d+)M$/ and $h{bs} = $1 * 1024 * 1024;
- $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 "\r$nb+$read records in\n";
- print STDERR "$nb+$read records out\n";
-}
-
-sub head_tail {
- my ($h, $n) = getopts(\@_, qw(hn));
- $h || @_ > 1 + bool($n) and die "usage: $0 [-h] [-n lines] [<file>]\n";
- $n = $n ? shift : 10;
- local *F; @_ ? open(F, $_[0]) || die "error: can't open file $_[0]\n" : (*F = \*STDIN);
-
- if ($0 eq 'head') {
- foreach (<F>) { $n-- or return; print }
- } else {
- @_ = (); foreach (<F>) { push @_, $_; @_ > $n and shift; }
- print @_;
- }
-}
-sub head { $0 = 'head'; &head_tail }
-sub tail { $0 = 'tail'; &head_tail }
-
-sub strings {
- my ($h, $o, $n) = getopts(\@_, qw(hon));
- $h and die "usage: strings [-o] [-n min-length] [<files>]\n";
- $n = $n ? shift : 4;
- $/ = "\0"; @ARGV = @_; my $l = 0; while (<>) {
- while (/[$printable_chars]\{$n,}/og) {
- printf "%07d ", ($l + length $') if $o;
- print "$&\n" ;
- }
- $l += length;
- } continue { $l = 0 if eof }
-}
-
-sub hexdump {
- my $i = 0; $/ = \16; @ARGV = @_; while (<>) {
- printf "%08lX ", $i; $i += 16;
- print join(" ", map({ sprintf "%02X", $_ } unpack("C*", $_)),
- ($_ =~ s/[^$printable_chars]/./og, $_)[1]), "\n";
- }
-}
-
-sub more {
- @ARGV = @_;
- require 'devices.pm';
- my $tty = devices::make('tty');
- local *IN; open IN, "<$tty" or die "can't open $tty\n";
- my $n = 0; while (<>) {
- ++$n == 25 and $n = <IN>, $n = 0;
- print
- }
-}
-
-sub pack_ {
- my $t;
- foreach (@_) {
- if (-d $_) {
- pack_(glob_($_));
- } else {
- print -s $_, "\n";
- print $_, "\n";
-
- local *F;
- open F, $_ or die "can't read file $_: $!\n";
- while (read F, $t, $BUFFER_SIZE) { print $t; }
- }
- }
-}
-
-sub unpack_ {
- my $t;
- @_ == 1 or die "give me one and only one file to unpack\n";
- local *F;
- open F, $_[0] or die "can't open file $_: $!\n";
- while (1) {
- my ($size) = chop_(scalar <F>);
- defined $size or last;
- $size =~ /^\d+$/ or die "bad format (can't find file size)\n";
- my ($filename) = chop_(scalar <F>) or die "expecting filename\n";
-
- print "$filename\n";
- my $dir = dirname($filename);
- -d $dir or mkdir_('-p', $dir);
-
- local *G;
- open G, "> $filename" or die "can't write file $filename: $!\n";
- while ($size) {
- $size -= read(F, $t, min($size, $BUFFER_SIZE)) || die "data for file $filename is missing\n";
- print G $t or die "error writing to file $filename: $!\n";
- }
- }
-}
-
-sub insmod {
- my ($h) = getopts(\@_, qw(h));
- $h || @_ == 0 and die "usage: insmod <module> [options]\n";
- my $f = local $_ = shift;
-
- require 'run_program.pm';
-
- unless (m|/|) {
- m/(.*)\.o/ and die "either give ./$_ or $1\n";
- unless (-r ($f = "/lib/modules/$_.o")) {
- $f = "/tmp/$_.o";
- run_program::run("cd /tmp ; bzip2 -cd /lib/modules.cpio.bz2 | cpio -i $_.o");
- }
- }
- -r $f or die "can't find module $_";
- run_program::run(["insmod_", "insmod"], $f, @_) or die("insmod $_ failed");
- unlink $f;
-}
-
-sub modprobe {
- my ($h) = getopts(\@_, qw(h));
- $h || @_ == 0 and die "usage: modprobe <module> [options]\n";
- my $name = shift;
- require 'modules.pm';
- modules::load_deps("/modules/modules.dep");
- modules::load($name, '', @_);
-}
-
-sub route {
- @_ == 0 or die "usage: route\nsorry, no modification handled\n";
- my ($titles, @l) = cat_("/proc/net/route");
- my @titles = split ' ', $titles;
- my %l;
- open ROUTE, ">&STDOUT";
- format ROUTE_TOP =
-Destination Gateway Mask Iface
-.
- format ROUTE =
-@<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<<<<<< @<<<<<<<
-$l{Destination}, $l{Gateway}, $l{Mask}, $l{Iface}
-.
- foreach (@l) {
- /^\s*$/ and next;
- @l{@titles} = split;
- $_ = join ".", reverse map { hex } unpack "a2a2a2a2", $_ foreach @l{qw(Destination Gateway Mask)};
- $l{Destination} = 'default' if $l{Destination} eq "0.0.0.0";
- $l{Gateway} = '*' if $l{Gateway} eq "0.0.0.0";
- write ROUTE;
- }
-}
-
-sub df {
- my ($h) = getopts(\@_, qw(h));
- my ($dev, $size, $free, $used, $use, $mntpoint);
- open DF, ">&STDOUT";
- format DF_TOP =
-Filesystem Size Used Avail Use Mounted on
-.
- format DF =
-@<<<<<<<<<<<<<<<< @>>>>>>> @>>>>>>> @>>>>>>> @>>>>>% @<<<<<<<<<<<<<<<<<<<<<<<<<
-$dev, $size, $used, $free, $use, $mntpoint
-.
- my %h;
- foreach (cat_("/proc/mounts"), cat_("/etc/mtab")) {
- ($dev, $mntpoint) = split;
- $h{$dev} = $mntpoint;
- }
- foreach $dev (sort keys %h) {
- $mntpoint = $h{$dev};
- my $buf = ' ' x 20000;
- syscall_('statfs', $mntpoint, $buf) or next;
- (undef, undef, $size, $free) = unpack "l7", $buf;
- $size or next;
-
- $use = int (100 * ($size - $free) / $size);
- $used = $size - $free;
- if ($h) {
- $used = int ($used / 1024) . "M";
- $size = int ($size / 1024) . "M";
- $free = int ($free / 1024) . "M";
- }
- write DF if $size;
- }
-}
-
-sub kill {
- my $signal = 15;
- @_ or die "usage: kill [-<signal>] pids\n";
- $signal = (shift, $1)[1] if $_[0] =~ /^-(.*)/;
- kill $signal, @_ or die "kill failed: $!\n";
-}
-
-sub lspci {
- require 'pci_probing/main.pm';
- print join "\n", pci_probing::main::list (), '';
-}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1; #
-
diff --git a/perl-install/common.pm b/perl-install/common.pm
deleted file mode 100644
index 8d6bf4307..000000000
--- a/perl-install/common.pm
+++ /dev/null
@@ -1,361 +0,0 @@
-package common;
-
-use diagnostics;
-use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE);
-
-@ISA = qw(Exporter);
-%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) ],
- system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_ getVarsFromSh setVarsInSh) ],
- constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
-);
-@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-
-
-#-#####################################################################################
-#- Globals
-#-#####################################################################################
-$printable_chars = "\x20-\x7E";
-$sizeof_int = psizeof("i");
-$bitof_int = $sizeof_int * 8;
-$SECTORSIZE = 512;
-
-#-#####################################################################################
-#- Functions
-#-#####################################################################################
-
-sub fold_left(&@) {
- my $f = shift;
- local $a = shift;
- foreach $b (@_) { $a = &$f() }
- $a
-}
-
-sub _ { my $s = shift @_; sprintf translate($s), @_ }
-#-delete $main::{'_'};
-sub __ { $_[0] }
-sub even($) { $_[0] % 2 == 0 }
-sub odd($) { $_[0] % 2 == 1 }
-sub min { fold_left { $a < $b ? $a : $b } @_ }
-sub max { fold_left { $a > $b ? $a : $b } @_ }
-sub sum { fold_left { $a + $b } @_ }
-sub sqr { $_[0] * $_[0] }
-sub sign { $_[0] <=> 0 }
-sub product { fold_left { $a * $b } @_ }
-sub first { $_[0] }
-sub second { $_[1] }
-sub top { $_[$#_] }
-sub uniq { my %l; @l{@_} = (); keys %l }
-sub to_int { $_[0] =~ /(\d*)/; $1 }
-sub to_float { $_[0] =~ /(\d*(\.\d*)?)/; $1 }
-sub ikeys { my %l = @_; sort { $a <=> $b } keys %l }
-sub add2hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} ||= $v } }
-sub add2hash_ { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { exists $a->{$k} or $a->{$k} = $v } }
-sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
-sub dirname { @_ == 1 or die "usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' }
-sub basename { @_ == 1 or die "usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
-sub bool { $_[0] ? 1 : 0 }
-sub listlength { scalar @_ }
-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 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) }
-sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; }
-sub round_down { my ($i, $r) = @_; $i -= $i % $r; }
-sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 }
-sub is_empty_hash_ref { my $a = shift; !defined $a || keys(%$a) == 0 }
-sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
-sub intersection { my (%l, @m); @l{@{shift @_}} = (); foreach (@_) { @m = grep { exists $l{$_} } @$_; %l = (); @l{@m} = (); } keys %l }
-
-sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } }
-sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}{$_} and next; push @{$o->{list}}, $_; $o->{hash}{$_} = undef } }
-
-sub sync { syscall_('sync') }
-sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) }
-
-sub remove_spaces { local $_ = shift; s/^ +//; s/ +$//; $_ }
-sub mode { my @l = stat $_[0] or die "unable to get mode of file $_[0]: $!\n"; $l[2] }
-sub psizeof { length pack $_[0] }
-
-sub touch {
- my $f = shift;
- unless (-e $f) {
- local *F;
- open F, ">$f";
- }
- my $now = time;
- utime $now, $now, $f;
-}
-
-sub map_index(&@) {
- my $f = shift;
- my $v; local $::i = 0;
- map { $v = &$f($::i); $::i++; $v } @_;
-}
-sub grep_index(&@) {
- my $f = shift;
- my $v; local $::i = 0;
- grep { $v = &$f($::i); $::i++; $v } @_;
-}
-sub map_each(&%) {
- my ($f, %h) = @_;
- my @l;
- local ($::a, $::b);
- while (($::a, $::b) = each %h) { push @l, &$f($::a, $::b) }
- @l;
-}
-sub grep_each(&%) {
- my ($f, %h) = @_;
- my %l;
- local ($::a, $::b);
- while (($::a, $::b) = each %h) { $l{$::a} = $::b if &$f($::a, $::b) }
- %l;
-}
-
-#- pseudo-array-hash :)
-sub map_tab_hash(&$@) {
- my ($f, $fields, @tab_hash) = @_;
- my %hash;
- my $key = { map_index {($_, $::i + 1)} @{$fields} };
-
- for (my $i = 0; $i < @tab_hash; $i += 2) {
- my $h = [$key, @{$tab_hash[$i + 1]}];
- &$f($i, $h) if $f;
- $hash{ $tab_hash[$i] } = $h;
- }
- %hash;
-}
-
-sub smapn {
- my $f = shift;
- my $n = shift;
- my @r = ();
- for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_); }
- @r
-}
-sub mapn(&@) {
- my $f = shift;
- smapn($f, min(map { scalar @$_ } @_), @_);
-}
-sub mapn_(&@) {
- my $f = shift;
- smapn($f, max(map { scalar @$_ } @_), @_);
-}
-
-
-sub add_f4before_leaving {
- my ($f, $b, $name) = @_;
-
- unless ($common::before_leaving::{$name}) {
- no strict 'refs';
- ${"common::before_leaving::$name"} = 1;
- ${"common::before_leaving::list"} = 1;
- }
- local *N = *{$common::before_leaving::{$name}};
- my $list = *common::before_leaving::list;
- $list->{$b}{$name} = $f;
- *N = sub {
- my $f = $list->{$_[0]}{$name} or die '';
- $name eq 'DESTROY' and delete $list->{$_[0]};
- goto $f;
- } unless defined &{*N};
-
-}
-
-#- ! 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';
- add_f4before_leaving($f, $b, 'DESTROY');
- $b;
-}
-
-sub catch_cdie(&&) {
- my ($f, $catch) = @_;
-
- local @common::cdie_catches;
- unshift @common::cdie_catches, $catch;
- &$f();
-}
-
-sub cdie($;&) {
- my ($err, $f) = @_;
- foreach (@common::cdie_catches) {
- $@ = $err;
- &{$_}(\$err) and return;
- }
- die $err;
-}
-
-sub all {
- my $d = shift;
-
- local *F;
- opendir F, $d or die "all: can't open dir $d: $!\n";
- grep { $_ ne '.' && $_ ne '..' } readdir F;
-}
-
-sub glob_ {
- my ($d, $f) = ($_[0] =~ /\*/) ? (dirname($_[0]), basename($_[0])) : ($_[0], '*');
-
- $d =~ /\*/ and die "glob_: wildcard in directory not handled ($_[0])\n";
- ($f = quotemeta $f) =~ s/\\\*/.*/g;
-
- $d =~ m|/$| or $d .= '/';
- map { $d eq './' ? $_ : "$d$_" } grep { /$f/ } all($d);
-}
-
-
-sub syscall_ {
- my $f = shift;
-
- require 'syscall.ph';
- syscall(&{$common::{"SYS_$f"}}, @_) == 0;
-}
-
-
-sub crypt_ {
- local $_ = (gettimeofday())[1] % 0x40;
- tr [\0-\x3f] [0-9a-zA-Z./];
- crypt($_[0], $_)
-}
-
-sub makedev { ($_[0] << 8) | $_[1] }
-sub unmakedev { $_[0] >> 8, $_[0] & 0xff }
-
-sub translate {
- my ($s) = @_;
- my ($lang) = substr($ENV{LC_ALL} || $ENV{LANGUAGE} || $ENV{LC_MESSAGES} || $ENV{LANG} || '', 0, 2);
-
- require 'lang.pm';
- lang::load_po ($lang) unless defined $po::I18N::{$lang}; #- the space if needed to mislead perl2fcalls (as lang is not included here)
- $po::I18N::{$lang} or return $s;
- my $l = *{$po::I18N::{$lang}};
- $l->{$s} || $s;
-}
-
-sub untranslate($@) {
- my $s = shift;
- foreach (@_) { translate($_) eq $s and return $_ }
- die "untranslate failed";
-}
-
-sub warp_text($;$) {
- my ($text, $width) = @_;
- $width ||= 80;
-
- my @l;
- foreach (split "\n", $text) {
- my $t = '';
- foreach (split /\s+/, $_) {
- if (length "$t $_" > $width) {
- push @l, $t;
- $t = $_;
- } else {
- $t = "$t $_";
- }
- }
- push @l, $t;
- }
- @l;
-}
-
-sub formatAlaTeX($) {
- my ($t, $tmp);
- foreach (split "\n", $_[0]) {
- if (/^$/) {
- $t .= ($t && "\n") . $tmp;
- $tmp = '';
- } else {
- $tmp = ($tmp && "$tmp ") . $_;
- }
- }
- $t . ($t && $tmp && "\n") . $tmp;
-}
-
-sub getVarsFromSh($) {
- my %l;
- local *F;
- open F, $_[0] or return;
- foreach (<F>) {
- my ($v, $val, $val2) =
- /^\s* # leading space
- (\w+) = # variable
- (
- "([^"]*)" # double-quoted text
- | '([^']*)' # single-quoted text
- | [^'"\s]+ # normal text
- )
- \s*$ # end of line
- /x or next;
- $l{$v} = $val2 || $val;
- }
- %l;
-}
-
-sub setVarsInSh {
- my ($file, $l, @fields) = @_;
- @fields = keys %$l unless @fields;
-
- local *F;
- open F, "> $_[0]" or die "cannot create config file $file";
- $l->{$_} and print F "$_=$l->{$_}\n" foreach @fields;
-}
-
-sub best_match {
- my ($str, @lis) = @_;
- my @words = split /\W+/, $str;
- my ($max, $res) = 0;
-
- foreach (@lis) {
- my $count = 0;
- foreach my $i (@words) {
- $count++ if /$i/i;
- }
- $max = $count, $res = $_ if $count >= $max;
- }
- $res;
-}
-
-sub bestMatchSentence {
-
- my $best = -1;
- my $bestSentence;
- my @s = split /\W+/, shift;
- foreach (@_) {
- my $count = 0;
- foreach my $e (@s) {
- $count++ if /$e/i;
- }
- $best = $count, $bestSentence = $_ if $count > $best;
- }
- $bestSentence;
-}
-
-# count the number of character that match
-sub bestMatchSentence2 {
-
- my $best = -1;
- my $bestSentence;
- my @s = split /\W+/, shift;
- foreach (@_) {
- my $count = 0;
- foreach my $e (@s) {
- $count+= length ($e) if /$e/i;
- }
- $best = $count, $bestSentence = $_ if $count > $best;
- }
- $bestSentence;
-}
-
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1; #
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
deleted file mode 100644
index 35a85dfc5..000000000
--- a/perl-install/detect_devices.pm
+++ /dev/null
@@ -1,218 +0,0 @@
-package detect_devices;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use log;
-use common qw(:common :file);
-use devices;
-use c;
-
-#-#####################################################################################
-#- Globals
-#-#####################################################################################
-my @netdevices = map { my $l = $_; map { "$l$_" } (0..3) } qw(eth tr plip fddi);
-my $scsiDeviceAvailable;
-my $CSADeviceAvailable;
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-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.
-
- map { &{$_->[0]}() ? &{$_->[1]}() : () }
- [ \&hasIDE, \&getIDE ],
- [ \&hasSCSI, \&getSCSI ],
- [ \&hasDAC960, \&getDAC960 ],
- [ \&hasCompaqSmartArray, \&getCompaqSmartArray ];
-}
-sub hds() { grep { $_->{type} eq 'hd' } get(); }
-sub cdroms() { grep { $_->{type} eq 'cdrom' } get(); }
-sub floppies() {
- (grep { tryOpen($_) } qw(fd0 fd1)),
- (grep { $_->{type} eq 'fd' } get());
-}
-
-sub hasSCSI() {
- defined $scsiDeviceAvailable and return $scsiDeviceAvailable;
- local *F;
- open F, "/proc/scsi/scsi" or log::l("failed to open /proc/scsi/scsi: $!"), return 0;
- foreach (<F>) {
- /devices: none/ and log::l("no scsi devices are available"), return $scsiDeviceAvailable = 0;
- }
- log::l("scsi devices are available");
- $scsiDeviceAvailable = 1;
-}
-sub hasIDE() { -e "/proc/ide" }
-sub hasDAC960() { 1 }
-
-sub hasCompaqSmartArray() {
- defined $CSADeviceAvailable and return $CSADeviceAvailable;
- -r "/proc/array/ida0" or log::l("failed to open /proc/array/ida0: $!"), return $CSADeviceAvailable = 0;
- log::l("Compaq Smart Array controllers available");
- $CSADeviceAvailable = 1;
-}
-
-sub getSCSI() {
- my @drives;
- my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
- my $err = sub { chop; die "unexpected line in /proc/scsi/scsi: $_"; };
- local $_;
-
- local *F;
- open F, "/proc/scsi/scsi" or die "failed to open /proc/scsi/scsi";
- local $_ = <F>; /^Attached devices:/ or return &$err();
- while ($_ = <F>) {
- my ($id) = /^Host:.*?Id: (\d+)/ or return &$err();
- $_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or return &$err();
- $_ = <F>; my ($type) = /^\s*Type:\s*(.*)/ or &$err();
- my $device;
- if ($type =~ /Direct-Access/) {
- $type = 'hd';
- $device = "sd" . chr($driveNum++ + ord('a'));
- } elsif ($type =~ /Sequential-Access/) {
- $type = 'tape';
- $device = "st" . $tapeNum++;
- } elsif ($type =~ /CD-ROM/) {
- $type = 'cdrom';
- $device = "scd" . $cdromNum++;
- }
- $device and push @drives, { device => $device, type => $type, info => "$vendor $model", id => $id, bus => 0 };
- }
- @drives;
-}
-
-sub getIDE() {
- my @idi;
-
- #- Great. 2.2 kernel, things are much easier and less error prone.
- foreach my $d (sort @{[glob_('/proc/ide/hd*')]}) {
- my ($t) = chop_(cat_("$d/media"));
- my $type = $ {{disk => 'hd', cdrom => 'cdrom', tape => 'tape', floppy => 'fd'}}{$t} or next;
- my ($info) = chop_(cat_("$d/model")); $info ||= "(none)";
-
- my $num = ord (($d =~ /(.)$/)[0]) - ord 'a';
- push @idi, { type => $type, device => basename($d), info => $info, bus => $num/2, id => $num%2 };
- }
- @idi;
-}
-
-sub getCompaqSmartArray() {
- my @idi;
- my $f;
-
- for (my $i = 0; -r ($f = "/proc/array/ida$i"); $i++) {
- foreach (cat_($f)) {
- if (m|^(ida/.*?):|) {
- push @idi, { device => $1, info => "Compaq RAID logical disk", type => 'hd' };
- last;
- }
- }
- }
- @idi;
-}
-
-sub getDAC960() {
- my @idi;
-
- #- 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 };
- log::l("DAC960: $devicename: $info");
- }
- @idi;
-}
-
-sub net2module() {
- my @modules = map { quotemeta first(split) } cat_("/proc/modules");
- my $modules = join '|', @modules;
- my $net = join '|', @netdevices;
- my ($module, %l);
- foreach (syslog()) {
- if (/^($modules)\.c:/) {
- $module = $1;
- } elsif (/^($net):/) {
- $l{$1} = $module if $module;
- }
- }
- %l;
-}
-
-sub getNet() {
- grep { hasNetDevice($_) } @netdevices;
-}
-sub getPlip() {
- foreach (0..2) {
- hasNetDevice("plip$_") and log::l("plip$_ will be used for PLIP"), return "plip$_";
- }
- undef;
-}
-
-sub hasNet() { goto &getNet }
-sub hasPlip() { goto &getPlip }
-sub hasEthernet() { hasNetDevice("eth0"); }
-sub hasTokenRing() { hasNetDevice("tr0"); }
-sub hasNetDevice($) { c::hasNetDevice($_[0]) }
-
-sub tryOpen($) {
- local *F;
- sysopen F, devices::make($_[0]), c::O_NONBLOCK() and \*F;
-}
-
-sub tryWrite($) {
- local *F;
- sysopen F, devices::make($_[0]), 1 | c::O_NONBLOCK() and \*F;
-}
-
-sub syslog {
- -r "/tmp/syslog" and return map { /<\d+>(.*)/ } cat_("/tmp/syslog");
- `dmesg`
-}
-
-sub hasSMP {
- my $nb = grep { /^processor/ } cat_("/proc/cpuinfo");
- $nb > 1;
-}
-
-sub whatParport() {
- my @res =();
- foreach (0..3) {
- local *F;
- my $elem = {};
- open F, "/proc/parport/$_/autoprobe" or next;
- foreach (<F>) { $elem->{$1} = $2 if /(.*):(.*);/ }
- push @res, { port => "/dev/lp$_", val => $elem};
- }
- @res;
-}
-
-#-CLASS:PRINTER;
-#-MODEL:HP LaserJet 1100;
-#-MANUFACTURER:Hewlett-Packard;
-#-DESCRIPTION:HP LaserJet 1100 Printer;
-#-COMMAND SET:MLC,PCL,PJL;
-sub whatPrinter() {
- my @res = whatParport();
- grep { $_->{val}{CLASS} eq "PRINTER"} @res;
-}
-
-sub whatPrinterPort() {
- grep { tryWrite($_)} qw(/dev/lp0 /dev/lp1 /dev/lp2);
-}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1; #
-
diff --git a/perl-install/devices.pm b/perl-install/devices.pm
deleted file mode 100644
index b7f3a54d9..000000000
--- a/perl-install/devices.pm
+++ /dev/null
@@ -1,109 +0,0 @@
-package devices;
-
-use diagnostics;
-use strict;
-
-use common qw(:system :file);
-use run_program;
-use log;
-use c;
-
-1;
-
-
-sub size($) {
- local *F;
- sysopen F, $_[0], 0 or log::l("open $_[0]: $!"), return 0;
-
- my $valid_offset = sub { sysseek(F, $_[0], 0) && sysread(F, my $a, 1) };
-
- #- 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!
- my $low = 0;
- my ($high, $mid);
-
- #- 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) {
- $mid = int ($low + $high) / 2;
- &$valid_offset($mid) ? $low : $high = $mid;
- }
- $low + 1;
-}
-
-sub make($) {
- local $_ = my $file = $_[0];
- my ($type, $major, $minor);
- my $prefix = '';
-
- if (m,^(.*/(?:dev|tmp))/(.*),) {
- $_ = $2;
- } else {
- $file = "$prefix/dev/$_";
- -e $file or $file = "$prefix/tmp/$_";
- }
- -e $file and return $file; #- assume nobody takes fun at creating files named as device
-
- if (/^sd(.)(\d{0,2})/) {
- $type = c::S_IFBLK();
- $major = 8;
- $minor = 16 * (ord($1) - ord('a')) + ($2 || 0);
- } elsif (/^hd(.)(\d{0,2})/) {
- $type = c::S_IFBLK();
- ($major, $minor) =
- @{ $ {{'a' => [3, 0], 'b' => [3, 64],
- 'c' => [22,0], 'd' => [22,64],
- 'e' => [33,0], 'f' => [33,64],
- 'g' => [34,0], 'h' => [34,64],
- }}{$1} or die "unknown device $_" };
- $minor += $2 || 0;
- } elsif (/^ram(.*)/) {
- $type = c::S_IFBLK();
- $major = 1;
- $minor = $1 eq '' ? 1 : $1;
- } elsif (m|^rd/c(\d+)d(\d+)(p(\d+))?|) {
- # dac 960 "/rd/cXdXXpX"
- $type = c::S_IFBLK();
- $major = 48 + $1;
- $minor = 8 * $2 + $4;
- } elsif (m|ida/c(\d+)d(\d+)(p(\d+))?|) {
- # Compaq Smart Array "ida/c0d0{p1}"
- $type = c::S_IFBLK();
- $major = 72 + $1;
- $minor = 16 * $2 + ($4 || 0);
- } else {
- ($type, $major, $minor) =
- @{ $ {{"aztcd" => [ c::S_IFBLK(), 29, 0 ],
- "bpcd" => [ c::S_IFBLK(), 41, 0 ],
- "cdu31a" => [ c::S_IFBLK(), 15, 0 ],
- "cdu535" => [ c::S_IFBLK(), 24, 0 ],
- "cm206cd" => [ c::S_IFBLK(), 32, 0 ],
- "tty" => [ c::S_IFCHR(), 5, 0 ],
- "fd0" => [ c::S_IFBLK(), 2, 0 ],
- "fd1" => [ c::S_IFBLK(), 2, 1 ],
- "gscd" => [ c::S_IFBLK(), 16, 0 ],
- "lp0" => [ c::S_IFCHR(), 6, 0 ],
- "lp1" => [ c::S_IFCHR(), 6, 1 ],
- "lp2" => [ c::S_IFCHR(), 6, 2 ],
- "mcd" => [ c::S_IFBLK(), 23, 0 ],
- "mcdx" => [ c::S_IFBLK(), 20, 0 ],
- "nst0" => [ c::S_IFCHR(), 9, 128 ],
- "optcd" => [ c::S_IFBLK(), 17, 0 ],
- "sbpcd" => [ c::S_IFBLK(), 25, 0 ],
- "scd0" => [ c::S_IFBLK(), 11, 0 ],
- "scd1" => [ c::S_IFBLK(), 11, 1 ],
- "sjcd" => [ c::S_IFBLK(), 18, 0 ],
- }}{$_} or die "unknown device $_" };
- }
-
- #- 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 $_): $!";
-
- $file;
-}
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
deleted file mode 100644
index 23ef5e380..000000000
--- a/perl-install/fs.pm
+++ /dev/null
@@ -1,273 +0,0 @@
-package fs;
-
-use diagnostics;
-use strict;
-
-use common qw(:common :file :system);
-use log;
-use devices;
-use partition_table qw(:types);
-use run_program;
-use nfs;
-use swap;
-use detect_devices;
-use commands;
-use modules;
-
-1;
-
-
-sub read_fstab($) {
- my ($file) = @_;
-
- local *F;
- open F, $file or return;
-
- map {
- my ($dev, @l) = split;
- $dev =~ s,/(tmp|dev)/,,;
- { device => $dev, mntpoint => $l[0], type => $l[1], options => $l[2] }
- } <F>;
-}
-
-sub check_mounted($) {
- my ($fstab) = @_;
-
- local (*F, *G, *H);
- open F, "/etc/mtab";
- open G, "/proc/mounts";
- open H, "/proc/swaps";
- foreach (<F>, <G>, <H>) {
- foreach my $p (@$fstab) {
- /$p->{device}\s+([^\s]*)\s+/ and $p->{currentMntpoint} = $1, $p->{isMounted} = $p->{isFormatted} = 1;
- }
- }
-}
-
-sub get_mntpoints_from_fstab($) {
- my ($fstab) = @_;
-
- foreach (read_fstab('/etc/fstab')) {
- foreach my $p (@$fstab) {
- $p->{device} eq $_->{device} or next;
- $p->{mntpoint} ||= $_->{mntpoint};
- $p->{options} ||= $_->{options};
- $_->{type} ne 'auto' && $_->{type} ne type2fs($p->{type}) and
- log::l("err, fstab and partition table do not agree for $_->{device} type: " . (type2fs($p->{type}) || type2name($p->{type})) . " vs $_->{type}");
- }
- }
-}
-
-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.
- $bad_blocks and push @options, "-c";
-
- run_program::run("mke2fs", devices::make($dev), @options) or die _("%s formatting of %s failed", "ext2", $dev);
-}
-
-sub format_dos($;$@) {
- my ($dev, $bad_blocks, @options) = @_;
-
- run_program::run("mkdosfs", devices::make($dev), @options, $bad_blocks ? "-c" : ()) or die _("%s formatting of %s failed", "dos", $dev);
-}
-
-sub format_part($;$) {
- my ($part, $bad_blocks) = @_;
-
- $part->{isFormatted} and return;
-
- log::l("formatting device $part->{device} (type ", type2name($part->{type}), ")");
-
- if (isExt2($part)) {
- format_ext2($part->{device}, $bad_blocks);
- } elsif (isDos($part)) {
- format_dos($part->{device}, $bad_blocks);
- } elsif (isWin($part)) {
- format_dos($part->{device}, $bad_blocks, '-F', 32);
- } elsif (isSwap($part)) {
- swap::make($part->{device}, $bad_blocks);
- } else {
- die _("don't know how to format %s in type %s", $_->{device}, type2name($_->{type}));
- }
- $part->{isFormatted} = 1;
-}
-
-sub mount($$$;$) {
- my ($dev, $where, $fs, $rdonly) = @_;
- log::l("mounting $dev on $where as type $fs");
-
- -d $where or commands::mkdir_('-p', $where);
-
- if ($fs eq 'nfs') {
- log::l("calling nfs::mount($dev, $where)");
- nfs::mount($dev, $where) or die _("nfs mount failed");
- } elsif ($fs eq 'smb') {
- die "no smb yet...";
- } else {
- $dev = devices::make($dev) if $fs ne 'proc';
-
- my $flag = 0;#c::MS_MGC_VAL();
- $flag |= c::MS_RDONLY() if $rdonly;
- my $mount_opt = "";
-
- if ($fs eq 'vfat') {
- $mount_opt = "check=relaxed";
- 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
- print F "$dev $where $fs defaults 0 0\n";
-}
-
-#- takes the mount point to umount (can also be the device)
-sub umount($) {
- my ($mntpoint) = @_;
- log::l("calling umount($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)
- local *F;
- open F, ">/etc/mtab" or return;
- foreach (@mtab) { print F $_ unless /(^|\s)$mntpoint\s/; }
-}
-
-sub mount_part($;$) {
- my ($part, $prefix) = @_;
-
- $part->{isMounted} and return;
-
- if (isSwap($part)) {
- swap::swapon($part->{device});
- } else {
- $part->{mntpoint} or die "missing mount point";
- mount(devices::make($part->{device}), ($prefix || '') . $part->{mntpoint}, type2fs($part->{type}),
- $part->{mntreadonly} ? 1 : 0);
- }
- $part->{isMounted} = $part->{isFormatted} = 1; #- assume that if mount works, partition is formatted
-}
-
-sub umount_part($;$) {
- my ($part, $prefix) = @_;
-
- $part->{isMounted} or return;
-
- isSwap($part) ?
- swap::swapoff($part->{device}) :
- umount(($prefix || '') . ($part->{mntpoint} || devices::make($part->{device})));
- $part->{isMounted} = 0;
-}
-
-sub mount_all($;$) {
- my ($fstab, $prefix) = @_;
-
- log::l("mounting all filesystems");
-
- #- order mount by alphabetical ordre, that way / < /home < /home/httpd...
- foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
- mount_part($_, $prefix) if $_->{mntpoint};
- }
-}
-
-sub umount_all($;$) {
- my ($fstab, $prefix) = @_;
-
- log::l("unmounting all filesystems");
-
- foreach (sort { $b->{mntpoint} cmp $a->{mntpoint} } @$fstab) {
- $_->{mntpoint} and umount_part($_, $prefix);
- }
-}
-
-#- do some stuff before calling write_fstab
-sub write($$) {
- my ($prefix, $fstab) = @_;
- my @cd_drives = detect_devices::cdroms();
-
- log::l("scanning /proc/mounts for iso9660 filesystems");
- 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.
- my $cddev = first(grep { $_ ne 'root' } map { $_->{device} } @cd_drives);
-
- log::l("resetting /etc/mtab");
- local *F;
- open F, "> $prefix/etc/mtab" or die "error resetting $prefix/etc/mtab";
-
- if ($cddev) {
- mkdir "$prefix/mnt/cdrom", 0755 or log::l("failed to mkdir $prefix/mnt/cdrom: $!");
- symlink $cddev, "$prefix/dev/cdrom" or log::l("failed to symlink $prefix/dev/cdrom: $!");
- }
- write_fstab($fstab, $prefix, $cddev);
-
- return if $::g_auto_install;
-
- devices::make "$prefix/dev/$_->{device}" foreach grep { $_->{device} && !isNfs($_) } @$fstab;
-}
-
-sub write_fstab($;$$) {
- my ($fstab, $prefix, $cddev) = @_;
- $prefix ||= '';
-
- my @to_add =
- map {
- my ($dir, $options, $freq, $passno) = qw(/dev/ defaults 0 0);
- $options ||= $_->{options};
-
- isExt2($_) and ($freq, $passno) = (1, ($_->{mntpoint} eq '/') ? 1 : 2);
- isNfs($_) and ($dir, $options) = ('', 'ro');
-
- [ "$dir$_->{device}", $_->{mntpoint}, type2fs($_->{type}), $options, $freq, $passno ];
-
- } grep { $_->{mntpoint} && type2fs($_->{type}) } @$fstab;
-
- {
- push @to_add, [ split ' ', '/dev/fd0 /mnt/floppy auto sync,user,noauto,nosuid,nodev,unhide 0 0' ];
- push @to_add, [ split ' ', '/dev/cdrom /mnt/cdrom auto user,noauto,nosuid,exec,nodev,ro 0 0' ] if $cddev;
- push @to_add, [ split ' ', 'none /proc proc defaults 0 0' ];
- push @to_add, [ split ' ', 'none /dev/pts devpts mode=0620 0 0' ];
- }
-
- #- get the list of devices and mntpoint
- my @new = grep { $_ ne 'none' } map { @$_[0,1] } @to_add;
- my %new; @new{@new} = undef;
-
- my @current = cat_("$prefix/etc/fstab");
-
- log::l("writing $prefix/etc/fstab");
- local *F;
- 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
- exists $new{$a} || exists $new{$b} and next;
- print F $_;
- }
- print F join(" ", @$_), "\n" foreach @to_add;
-}
-
-sub check_mount_all_fstab($;$) {
- my ($fstab, $prefix) = @_;
- $prefix ||= '';
-
- foreach (sort { ($a->{mntpoint} || '') cmp ($b->{mntpoint} || '') } @$fstab) {
- #- avoid unwanted mount in fstab.
- next if ($_->{device} =~ /none/ || $_->{type} =~ /nfs|smbfs|ncpfs|proc/ || $_->{options} =~ /noauto|ro/);
-
- #- TODO fsck
-
- eval { mount(devices::make($_->{device}), $prefix . $_->{mntpoint}, $_->{type}, 0); };
- if ($@) {
- log::l("unable to mount partition $_->{device} on $prefix/$_->{mntpoint}");
- }
- }
-}
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
deleted file mode 100644
index c4e43e148..000000000
--- a/perl-install/fsedit.pm
+++ /dev/null
@@ -1,335 +0,0 @@
-package fsedit;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :constant :functional);
-use partition_table qw(:types);
-use partition_table_raw;
-use Data::Dumper;
-use devices;
-use log;
-
-#-#####################################################################################
-#- Globals
-#-#####################################################################################
-my @suggestions = (
- { mntpoint => "/boot", minsize => 10 << 11, size => 16 << 11, type => 0x83 },
- { mntpoint => "/", minsize => 50 << 11, size => 100 << 11, type => 0x83 },
- { mntpoint => "swap", minsize => 30 << 11, size => 60 << 11, type => 0x82 },
- { mntpoint => "/usr", minsize => 200 << 11, size => 600 << 11, type => 0x83 },
- { mntpoint => "/home", minsize => 50 << 11, size => 200 << 11, type => 0x83 },
- { mntpoint => "/var", minsize => 200 << 11, size => 250 << 11, type => 0x83 },
- { mntpoint => "/tmp", minsize => 50 << 11, size => 100 << 11, type => 0x83 },
- { mntpoint => "/mnt/iso", minsize => 700 << 11, size => 800 << 11, type => 0x83 },
-);
-my @suggestions_mntpoints = qw(/mnt/dos);
-
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-sub suggestions_mntpoint($) {
- my ($hds) = @_;
- sort grep { !/swap/ && !has_mntpoint($_, $hds) }
- (@suggestions_mntpoints, map { $_->{mntpoint} } @suggestions);
-}
-
-sub hds($$) {
- my ($drives, $flags) = @_;
- my @hds;
- my $rc;
-
- 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, "$!");
- $hd = { (%$_, %$hd) };
- $hd->{file} = $file;
- $hd->{prefix} = $hd->{device};
- # for RAID arrays of format c0d0p1
- $hd->{prefix} .= "p" if $hd->{prefix} =~ m,(rd|ida)/,;
-
- eval { partition_table::read($hd, $flags->{clearall}) };
- if ($@) {
- cdie($@) unless $flags->{eraseBadPartitions};
- partition_table_raw::zero_MBR($hd);
- }
- push @hds, $hd;
- }
- [ @hds ];
-}
-
-sub get_fstab(@) {
- map { partition_table::get_normal_parts($_) } @_;
-}
-
-sub get_root($) {
- my ($fstab) = @_;
- $_->{mntpoint} eq "/" and return $_ foreach @$fstab;
- undef;
-}
-sub get_root_ { get_root([ get_fstab(@{$_[0]}) ]) }
-
-sub suggest_part($$$;$) {
- my ($hd, $part, $hds, $suggestions) = @_;
- $suggestions ||= \@suggestions;
- foreach (@$suggestions) { $_->{minsize} ||= $_->{size} }
-
- my $has_swap = grep { isSwap($_) } get_fstab(@$hds);
-
- my ($best, $second) =
- grep { $part->{size} >= $_->{minsize} }
- grep { ! has_mntpoint($_->{mntpoint}, $hds) || isSwap($_) && !$has_swap }
- @$suggestions or return;
-
- $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
-
- defined $best or return; #- sorry no suggestion :(
-
- $part->{mntpoint} = $best->{mntpoint};
- $part->{type} = $best->{type};
- $part->{size} = min($part->{size}, $best->{size});
- 1;
-}
-
-
-#-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($$) {
- my ($mntpoint, $hds) = @_;
- scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds);
-}
-
-#- do this before modifying $part->{mntpoint}
-#- $part->{mntpoint} should not be used here, use $mntpoint instead
-sub check_mntpoint {
- my ($mntpoint, $hd, $part, $hds) = @_;
-
- $mntpoint eq '' || isSwap($part) and return;
-
- 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 /";
-
- has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint);
-
- if ($part->{start} + $part->{size} > 1024 * partition_table::cylinder_size($hd)) {
- die "/boot ending on cylinder > 1024" if $mntpoint eq "/boot";
- die "/ ending on cylinder > 1024" if $mntpoint eq "/" && !has_mntpoint("/boot", $hds);
- }
-}
-
-sub add($$$;$) {
- my ($hd, $part, $hds, $options) = @_;
-
- isSwap($part) ?
- ($part->{mntpoint} = 'swap') :
- $options->{force} || check_mntpoint($part->{mntpoint}, $hd, $part, $hds);
-
- partition_table::add($hd, $part, $options->{primaryOrExtended});
-}
-
-sub removeFromList($$$) {
- my ($start, $end, $list) = @_;
- my $err = "error in removeFromList: removing an non-free block";
-
- for (my $i = 0; $i < @$list; $i += 2) {
- $start < $list->[$i] and die $err;
- $start > $list->[$i + 1] and next;
-
- 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
- splice(@$list, 0, 2);
- } else {
- #- the free block now start just after this block
- $list->[$i] = $end;
- }
- } else {
- $end <= $list->[$i + 1] or die $err;
- if ($end < $list->[$i + 1]) {
- splice(@$list, $i + 2, 0, $end, $list->[$i + 1]);
- }
- $list->[$i + 1] = $start; #- shorten the free block
- }
- return;
- }
-}
-
-
-sub allocatePartitions($$) {
- my ($hds, $to_add) = @_;
- 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;
-
- foreach (get_fstab(@$hds)) { &$remove($_); }
-
- FSTAB: foreach (@$to_add) {
- my %e = %$_;
- foreach my $hd (@$hds) {
- my $v = $free_sectors{$hd->{device}};
- for (my $i = 0; $i < @$v; $i += 2) {
- my $size = $v->[$i + 1] - $v->[$i];
- $e{size} > $size and next;
-
- if ($v->[$i] + $e{size} > 1024 * partition_table::cylinder_size($hd)) {
- next if $e{mntpoint} eq "/boot" ||
- $e{mntpoint} eq "/" && !has_mntpoint("/boot", $hds);
- }
- $e{start} = $v->[$i];
- $e{rootDevice} = $hd->{device};
- partition_table::adjustStartAndEnd($hd, \%e);
- &$remove(\%e);
- partition_table::add($hd, \%e);
- $success++;
- next FSTAB;
- }
- }
- log::ld("can't allocate partition $e{mntpoint} of size $e{size}, not enough room");
- }
- $success;
-}
-
-sub auto_allocate($;$) {
- my ($hds, $suggestions) = @_;
- allocatePartitions($hds, [
- grep { ! has_mntpoint($_->{mntpoint}, $hds) }
- @{ $suggestions || \@suggestions }
- ]);
- map { partition_table::assign_device_numbers($_) } @$hds;
-}
-
-sub undo_prepare($) {
- my ($hds) = @_;
- $Data::Dumper::Purity = 1;
- foreach (@$hds) {
- my @h = @{$_}{@partition_table::fields2save};
- push @{$_->{undo}}, Data::Dumper->Dump([\@h], ['$h']);
- }
-}
-sub undo_forget($) {
- my ($hds) = @_;
- pop @{$_->{undo}} foreach @$hds;
-}
-
-sub undo($) {
- my ($hds) = @_;
- foreach (@$hds) {
- my $h; eval pop @{$_->{undo}} || next;
- @{$_}{@partition_table::fields2save} = @$h;
-
- $_->{isDirty} = $_->{needKernelReread} = 1;
- }
-}
-
-sub move {
- my ($hd, $part, $hd2, $sector2) = @_;
-
- my $part2 = { %$part };
- $part2->{start} = $sector2;
- $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
- partition_table::add($hd2, $part2);
- }
-
- return if $part2->{notFormatted} && !$part2->{isFormatted} || $::testing;
-
- local (*F, *G);
- sysopen F, $hd->{file}, 0 or die '';
- sysopen G, $hd2->{file}, 2 or die _("Error opening %s for writing: %s", $hd2->{file}, "$!");
-
- my $base = $part->{start};
- my $base2 = $part2->{start};
- my $step = 1 << 10;
- if ($hd eq $hd2) {
- $part->{start} == $part2->{start} and return;
- $step = min($step, abs($part->{start} - $part2->{start}));
-
- if ($part->{start} < $part2->{start}) {
- $base += $part->{size} - $step;
- $base2 += $part->{size} - $step;
- $step = -$step;
- }
- }
-
- my $f = sub {
- c::lseek_sector(fileno(F), $base, 0) or die "seeking to sector $base failed on drive $hd->{device}";
- c::lseek_sector(fileno(G), $base2, 0) or die "seeking to sector $base2 failed on drive $hd2->{device}";
-
- my $buf;
- sysread F, $buf, $SECTORSIZE * abs($_[0]) or die '';
- syswrite G, $buf;
- };
-
- for (my $i = 0; $i < $part->{size} / abs($step); $i++, $base += $step, $base2 += $step) {
- &$f($step);
- }
- if (my $v = $part->{size} % abs($step) * sign($step)) {
- $base += $v;
- $base2 += $v;
- &$f($v);
- }
-}
-
-sub rescuept($) {
- my ($hd) = @_;
- my ($ext, @hd);
-
- my $dev = devices::make($hd->{device});
- open F, "rescuept $dev|";
- foreach (<F>) {
- my ($st, $si, $id) = /start=\s*(\d+),\s*size=\s*(\d+),\s*Id=\s*(\d+)/ or next;
- my $part = { start => $st, size => $si, type => hex($id) };
- if (isExtended($part)) {
- $ext = $part;
- } else {
- push @hd, $part;
- }
- }
- close F or die "rescuept failed";
-
- partition_table_raw::zero_MBR($hd);
- foreach (@hd) {
- my $b = partition_table::verifyInside($_, $ext);
- if ($b) {
- $_->{start}--;
- $_->{size}++;
- }
- local $b->{notFormatted};
-
- partition_table::add($hd, $_, ($b ? 'Extended' : 'Primary'), 1);
- }
-}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1; #
diff --git a/perl-install/ftp.pm b/perl-install/ftp.pm
deleted file mode 100644
index 6e1002840..000000000
--- a/perl-install/ftp.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-package ftp;
-
-use Net::FTP;
-
-use install_any;
-use log;
-
-# non-rentrant!!
-
-my $retr;
-
-1;
-
-
-sub new {
- my %options = (Passive => 1);
- $options{Firewall} = $ENV{PROXY} if $ENV{PROXY};
- $options{Port} = $ENV{PROXYPORT} if $ENV{PROXYPORT};
- my @l;
- unless ($ENV{HOST}) {
- # must be in kickstart, using URLPREFIX to find out information
- ($ENV{LOGIN}, $ENV{PASSWORD}, $ENV{HOST}, $ENV{PREFIX}) = @l =
- $ENV{URLPREFIX} =~ m|
- ://
- (?: ([^:]*) # login
- (?: :([^@]*))? # password
- @)?
- ([^/]*) # host
- /?(.*) # prefix
- |x;
- }
- unless ($ENV{LOGIN}) {
- $ENV{LOGIN} = 'anonymous';
- $ENV{PASSWORD} = 'mdkinst@test';
- }
-
- my $host = $ENV{HOST};
- if ($host !~ /^[.\d]+$/) {
- $host = join ".", unpack "C4", (gethostbyname $host)[4];
- }
-
- my $ftp = Net::FTP->new($host, %options) or die '';
- $ftp->login($ENV{LOGIN}, $ENV{PASSWORD}) or die '';
- $ftp->binary;
-
- $ftp;
-}
-
-
-sub getFile($) {
- $ftp ||= new();
- $retr->close if $retr;
- $retr = $ftp->retr($ENV{PREFIX} . "/" . install_any::relGetFile($_[0]));
-}
diff --git a/perl-install/help.pm b/perl-install/help.pm
deleted file mode 100644
index af8b15632..000000000
--- a/perl-install/help.pm
+++ /dev/null
@@ -1,302 +0,0 @@
-package help;
-
-use common qw(:common);
-
-%steps = (
-selectLanguage =>
- __("Choose preferred language for install and system usage."),
-
-selectKeyboard =>
- __("Choose on the list of keyboards, the one corresponding to yours"),
-
-selectPath =>
- __("Choose \"Installation\" if there are no previous versions of Linux
-installed, or if you wish use to multiple distributions or versions.
-
-
-Choose \"Update\" if you wish to update a previous version of Mandrake
-Linux: 5.1 (Venice), 5.2 (Leeloo), 5.3 (Festen) or 6.0 (Venus)."),
-
-selectInstallClass =>
- __("Select:
-
- - Beginner: If you have not installed Linux before, or wish to install
-the distribution elected \"Product of the year\" for 1999, click here.
-
- - Developer: If you are familiar with Linux and will be using the
-computer primarily for software development, you will find happiness
-here.
-
- - Server: If you wish to install a general purpose server, or the
-Linux distribution elected \"Distribution/Server\" for 1999, select
-this.
-
- - Expert: If you know GNU/Linux and want to perform a highly
-customized installation, this Install Class is for you."),
-
-setupSCSI =>
- __("The system did not detect a SCSI card. If you have one (or several)
-click on \"Yes\" and choose the module(s) to be tested. Otherwise,
-select \"No\".
-
-
-If you don't know if your computer has SCSI interfaces, consult the
-original documentation delivered with the computer, or if you use
-Microsoft Windows 95/98, inspect the information available via the \"Control
-panel\", \"System's icon, \"Device Manager\" tab."),
-
-partitionDisks =>
- __("At this point, hard drive partitions must be defined. (Unless you
-are overwriting a previous install of Linux and have already defined
-your hard drives partitions as desired.) This operation consists of
-logically dividing the computer's hard drive capacity into separate
-areas for use. Two common partition are: \"root\" which is the point at
-which the filesystem's directory structure starts, and \"boot\", which
-contains those files necessary to start the operating system when the
-computer is first turned on. Because the effects of this process are
-usually irreversible, partitioning can be intimidating and stressful to
-the inexperienced. DiskDrake simplifies the process so that it need not
-be. Consult the documentation and take your time before proceeding."),
-
-formatPartitions =>
- __("Any partitions that have been newly defined must be formatted for
-use. At this time, you may wish to re-format some pre-existing
-partitions to erase the data they contain. Note: it is not necessary to
-re-format pre-existing partitions, particularly if they contain files or
-data you wish to keep. Typically retained are: /home and /usr/local."),
-
-choosePackages =>
- __("You may now select the packages you wish to install.
-
-
-Please note that some packages require the installation of others. These
-are referred to as package dependencies. The packages you select, and
-the packages they require will automatically be added to the
-installation configuration. It is impossible to install a package
-without installing all of its dependencies.
-
-
-Information on each category and specific package is available in the
-area titled \"Info\". This is located above the buttons: [confirmation]
-[selection] [unselection]."),
-
-doInstallStep =>
- __("The packages selected are now being installed. This operation
-should only take a few minutes."),
-
-configureMouse =>
- __("Help"),
-
-configureNetwork =>
- __("Help"),
-
-configureTimezone =>
- __("Help"),
-
-configureServices =>
- __("Help"),
-
-configurePrinter =>
- __("Help"),
-
-setRootPassword =>
- __("An administrator password for your Linux system must now be
-assigned. The password must be entered twice to verify that both
-password entries are identical.
-
-
-Choose this password carefully. Only persons with access to an
-administrator account can maintain and administer the system.
-Alternatively, unauthorized use of an administrator account can be
-extremely dangerous to the integrity of the system, the data upon it,
-and other systems with which it is interfaced. The password should be a
-mixture of alphanumeric characters and a least 8 characters long. It
-should never be written down. Do not make the password too long or
-complicated that it will be difficult to remember.
-
-
-When you login as Administrator, at \"login\" type \"root\" and at
-\"password\", type the password that was created here."),
-
-addUser =>
- __("You can now authorize one or more people to use your Linux
-system. Each user account will have their own customizable environment.
-
-
-It is very important that you create a regular user account, even if
-there will only be one principle user of the system. The administrative
-\"root\" account should not be used for day to day operation of the
-computer. It is a security risk. The use of a regular user account
-protects you and the system from yourself. The root account should only
-be used for administrative and maintenance tasks that can not be
-accomplished from a regular user account."),
-
-createBootdisk =>
- __("Help"),
-
-setupBootloader =>
- __("You need to indicate where you wish
-to place the information required to boot to Linux.
-
-
-Unless you know exactly what you are doing, choose \"First sector of
-drive\"."),
-
-configureX =>
- __("It is now time to configure the video card and monitor
-configuration for the X Window Graphic User Interface (GUI). First
-select your monitor. Next, you may test the configuration and change
-your selections if necessary."),
-exitInstall =>
- __("Help"),
-);
-
-#- ################################################################################
-%steps_long = (
-selectLanguage =>
- __("Choose preferred language for install and system usage."),
-
-selectKeyboard =>
- __("Choose on the list of keyboards, the one corresponding to yours"),
-
-selectPath =>
- __("Choose \"Installation\" if there are no previous versions of Linux
-installed, or if you wish use to multiple distributions or versions.
-
-
-Choose \"Update\" if you wish to update a previous version of Mandrake
-Linux: 5.1 (Venice), 5.2 (Leeloo), 5.3 (Festen) or 6.0 (Venus)."),
-
-selectInstallClass =>
- __("Select:
-
- - Beginner: If you have not installed Linux before, or wish to install
-the distribution elected \"Product of the year\" for 1999, click here.
-
- - Developer: If you are familiar with Linux and will be using the
-computer primarily for software development, you will find happiness
-here.
-
- - Server: If you wish to install a general purpose server, or the
-Linux distribution elected \"Distribution/Server\" for 1999, select
-this.
-
- - Expert: If you know GNU/Linux and want to perform a highly
-customized installation, this Install Class is for you."),
-
-setupSCSI =>
- __("The system did not detect a SCSI card. If you have one (or several)
-click on \"Yes\" and choose the module(s) to be tested. Otherwise,
-select \"No\".
-
-
-If you don't know if your computer has SCSI interfaces, consult the
-original documentation delivered with the computer, or if you use
-Microsoft Windows 95/98, inspect the information available via the \"Control
-panel\", \"System's icon, \"Device Manager\" tab."),
-
-partitionDisks =>
- __("At this point, hard drive partitions must be defined. (Unless you
-are overwriting a previous install of Linux and have already defined
-your hard drives partitions as desired.) This operation consists of
-logically dividing the computer's hard drive capacity into separate
-areas for use. Two common partition are: \"root\" which is the point at
-which the filesystem's directory structure starts, and \"boot\", which
-contains those files necessary to start the operating system when the
-computer is first turned on. Because the effects of this process are
-usually irreversible, partitioning can be intimidating and stressful to
-the inexperienced. DiskDrake simplifies the process so that it need not
-be. Consult the documentation and take your time before proceeding."),
-
-formatPartitions =>
- __("Any partitions that have been newly defined must be formatted for
-use. At this time, you may wish to re-format some pre-existing
-partitions to erase the data they contain. Note: it is not necessary to
-re-format pre-existing partitions, particularly if they contain files or
-data you wish to keep. Typically retained are: /home and /usr/local."),
-
-choosePackages =>
- __("You may now select the packages you wish to install.
-
-
-Please note that some packages require the installation of others. These
-are referred to as package dependencies. The packages you select, and
-the packages they require will automatically be added to the
-installation configuration. It is impossible to install a package
-without installing all of its dependencies.
-
-
-Information on each category and specific package is available in the
-area titled \"Info\". This is located above the buttons: [confirmation]
-[selection] [unselection]."),
-
-doInstallStep =>
- __("The packages selected are now being installed. This operation
-should only take a few minutes."),
-
-configureMouse =>
- __("Help"),
-
-configureNetwork =>
- __("Help"),
-
-configureTimezone =>
- __("Help"),
-
-configureServices =>
- __("Help"),
-
-configurePrinter =>
- __("Help"),
-
-setRootPassword =>
- __("An administrator password for your Linux system must now be
-assigned. The password must be entered twice to verify that both
-password entries are identical.
-
-
-Choose this password carefully. Only persons with access to an
-administrator account can maintain and administer the system.
-Alternatively, unauthorized use of an administrator account can be
-extremely dangerous to the integrity of the system, the data upon it,
-and other systems with which it is interfaced. The password should be a
-mixture of alphanumeric characters and a least 8 characters long. It
-should never be written down. Do not make the password too long or
-complicated that it will be difficult to remember.
-
-
-When you login as Administrator, at \"login\" type \"root\" and at
-\"password\", type the password that was created here."),
-
-addUser =>
- __("You can now authorize one or more people to use your Linux
-system. Each user account will have their own customizable environment.
-
-
-It is very important that you create a regular user account, even if
-there will only be one principle user of the system. The administrative
-\"root\" account should not be used for day to day operation of the
-computer. It is a security risk. The use of a regular user account
-protects you and the system from yourself. The root account should only
-be used for administrative and maintenance tasks that can not be
-accomplished from a regular user account."),
-
-createBootdisk =>
- __("Help"),
-
-setupBootloader =>
- __("You need to indicate where you wish
-to place the information required to boot to Linux.
-
-
-Unless you know exactly what you are doing, choose \"First sector of
-drive\"."),
-
-configureX =>
- __("It is now time to configure the video card and monitor
-configuration for the X Window Graphic User Interface (GUI). First
-select your monitor. Next, you may test the configuration and change
-your selections if necessary."),
-exitInstall =>
- __("Help"),
-);
diff --git a/perl-install/install2 b/perl-install/install2
deleted file mode 100755
index b9459d527..000000000
--- a/perl-install/install2
+++ /dev/null
@@ -1,31 +0,0 @@
-#!/usr/bin/perl
-
-#- Mandrake Graphic Install
-#- Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
-#-
-#- This program is free software; you can redistribute it and/or modify
-#- it under the terms of the GNU General Public License as published by
-#- the Free Software Foundation; either version 2, or (at your option)
-#- any later version.
-#-
-#- This program is distributed in the hope that it will be useful,
-#- but WITHOUT ANY WARRANTY; without even the implied warranty of
-#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-#- GNU General Public License for more details.
-#-
-#- You should have received a copy of the GNU General Public License
-#- along with this program; if not, write to the Free Software
-#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-use diagnostics;
-use strict;
-
-use lib qw(/usr/bin/perl-install . c c/blib/arch);
-use install2;
-
-$::testing = $ENV{PERL_INSTALL_TEST};
-$::isStandalone = 0;
-
-install2::main(@ARGV);
-
-exec "true";
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
deleted file mode 100644
index b18895f3e..000000000
--- a/perl-install/install2.pm
+++ /dev/null
@@ -1,636 +0,0 @@
-package install2;
-
-use diagnostics;
-use strict;
-use Data::Dumper;
-
-use vars qw($o);
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :file :system :functional);
-use install_any qw(:all);
-use log;
-use help;
-use network;
-use lang;
-use keyboard;
-use lilo;
-use mouse;
-use fs;
-use timezone;
-use fsedit;
-use devices;
-use partition_table qw(:types);
-use pkgs;
-use printer;
-use modules;
-use detect_devices;
-use modparm;
-use install_steps_graphical;
-use run_program;
-
-#-######################################################################################
-#- Steps table
-#-######################################################################################
-my @installStepsFields = qw(text redoable onError needs entered reachable toBeDone help next done);
-my @installSteps = (
- selectLanguage => [ __("Choose your language"), 1, 1 ],
- selectInstallClass => [ __("Select installation class"), 1, 1 ],
- setupSCSI => [ __("Setup SCSI"), 1, 0 ],
- selectPath => [ __("Choose install or upgrade"), 0, 0, "selectInstallClass" ],
- selectMouse => [ __("Configure mouse"), 1, 1 ],
- selectKeyboard => [ __("Choose your keyboard"), 1, 1 ],
- partitionDisks => [ __("Setup filesystems"), 1, 0 ],
- formatPartitions => [ __("Format partitions"), 1, -1, "partitionDisks" ],
- choosePackages => [ __("Choose packages to install"), 1, 1, "selectInstallClass" ],
- doInstallStep => [ __("Install system"), 1, -1, ["formatPartitions", "selectPath"] ],
- configureNetwork => [ __("Configure networking"), 1, 1, "formatPartitions" ],
- configureTimezone => [ __("Configure timezone"), 1, 1, "doInstallStep" ],
-#- 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" ],
- createBootdisk => [ __("Create bootdisk"), 1, 0, "doInstallStep" ],
- setupBootloader => [ __("Install bootloader"), 1, 1, "doInstallStep" ],
- configureX => [ __("Configure X"), 1, 0, "formatPartitions" ],
- exitInstall => [ __("Exit install"), 0, 0 ],
-);
-
-my (%installSteps, %upgradeSteps, @orderedInstallSteps, @orderedUpgradeSteps);
-
-for (my $i = 0; $i < @installSteps; $i += 2) {
- my %h; @h{@installStepsFields} = @{ $installSteps[$i + 1] };
- $h{help} = $help::steps{$installSteps[$i]} || __("Help");
- $h{next} = $installSteps[$i + 2];
- $h{entered} = 0;
- $h{onError} = $installSteps[$i + 2 * $h{onError}];
- $installSteps{ $installSteps[$i] } = \%h;
- push @orderedInstallSteps, $installSteps[$i];
-}
-
-$installSteps{first} = $installSteps[0];
-
-#-#####################################################################################
-#-INTERN CONSTANT
-#-#####################################################################################
-my @install_classes = (__("beginner"), __("developer"), __("server"), __("expert"));
-
-#-#####################################################################################
-#-Default value
-#-#####################################################################################
-#- partition layout
-my %suggestedPartitions = (
- beginner => [
- { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
- { mntpoint => "swap", size => 128 << 11, type => 0x82 },
- { mntpoint => "/", size => 700 << 11, type => 0x83 },
- { mntpoint => "/home", size => 300 << 11, type => 0x83 },
- ],
- developer => [
- { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
- { mntpoint => "swap", size => 128 << 11, type => 0x82 },
- { mntpoint => "/", size => 200 << 11, type => 0x83 },
- { mntpoint => "/usr", size => 600 << 11, type => 0x83 },
- { mntpoint => "/home", size => 500 << 11, type => 0x83 },
- ],
- server => [
- { mntpoint => "/boot", size => 16 << 11, type => 0x83 },
- { mntpoint => "swap", size => 512 << 11, type => 0x82 },
- { mntpoint => "/", size => 200 << 11, type => 0x83 },
- { mntpoint => "/usr", size => 600 << 11, type => 0x83 },
- { mntpoint => "/var", size => 600 << 11, type => 0x83 },
- { mntpoint => "/home", size => 500 << 11, type => 0x83 },
- ],
- expert => [
- { mntpoint => "/", size => 200 << 11, type => 0x83 },
- ],
-);
-
-#-#######################################################################################
-#-$O
-#-the big struct which contain, well everything (globals + the interactive methods ...)
-#-if you want to do a kickstart file, you just have to add all the required fields (see for example
-#-the variable $default)
-#-#######################################################################################
-$o = $::o = {
-# bootloader => { linear => 0, message => 1, keytable => 1, timeout => 5, restricted => 0 },
- autoSCSI => 0,
- mkbootdisk => 1, #- no mkbootdisk if 0 or undef, find a floppy with 1
-#- packages => [ qw() ],
- partitioning => { clearall => 0, 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 },
-#- ],
- shells => [ map { "/bin/$_" } qw(bash tcsh zsh ash ksh) ],
- lang => 'en',
- isUpgrade => 0,
- installClass => "beginner",
-
- timezone => {
-#- timezone => "Europe/Paris",
-#- GMT => 1,
- },
- printer => {
- want => 0,
- complete => 0,
- str_type => $printer::printer_type_default,
- QUEUE => "lp",
- SPOOLDIR => "/var/spool/lpd/lp",
- DBENTRY => "DeskJet670",
- PAPERSIZE => "legal",
- CRLF => 0,
-
- DEVICE => "/dev/lp",
-
- REMOTEHOST => "",
- REMOTEQUEUE => "",
-
- NCPHOST => "printerservername",
- NCPQUEUE => "queuename",
- NCPUSER => "user",
- NCPPASSWD => "pass",
-
- SMBHOST => "hostname",
- SMBHOSTIP => "1.2.3.4",
- SMBSHARE => "printername",
- SMBUSER => "user",
- 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' },
-
-#- 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 perl) ],
-#- 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)
-
-};
-
-#-######################################################################################
-#- Steps Functions
-#- each step function are called with two arguments : clicked(because if you are a
-#- beginner you can force the the step) and the entered number
-#-######################################################################################
-
-#------------------------------------------------------------------------------
-sub selectLanguage {
- $o->selectLanguage;
-
- addToBeDone {
- lang::write($o->{prefix});
- keyboard::write($o->{prefix}, $o->{keyboard});
- } 'doInstallStep' unless $::g_auto_install;
-}
-
-#------------------------------------------------------------------------------
-sub selectMouse {
- my ($clicked) = $_[0];
-
- $o->{mouse} or $o->{mouse} = {};
- add2hash($o->{mouse}, { mouse::read($o->{prefix}) }) if $o->{isUpgrade} && !$clicked;
-
- $o->selectMouse($clicked);
- addToBeDone { mouse::write($o->{prefix}, $o->{mouse}); } 'formatPartitions';
-}
-
-#------------------------------------------------------------------------------
-sub selectKeyboard {
- my ($clicked) = $_[0];
-
- return unless $o->{isUpgrade} || !$::beginner || $clicked;
-
- $o->{keyboard} = (keyboard::read($o->{prefix}))[0] if $o->{isUpgrade} && !$clicked && !$o->{keyboard};
- $o->selectKeyboard if !$::beginner || $clicked;
-
- #- if we go back to the selectKeyboard, you must rewrite
- addToBeDone {
- keyboard::write($o->{prefix}, $o->{keyboard});
- } 'doInstallStep' unless $::g_auto_install;
-}
-
-#------------------------------------------------------------------------------
-sub selectPath {
- $o->selectPath;
-
- if ($o->{isUpgrade}) {
- #- try to find the partition where the system is installed if beginner
- #- else ask the user the right partition, and test it after.
- unless ($o->{hds}) {
- $o->{drives} = [ detect_devices::hds() ];
- $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
- sub { 1; };
-
- unless (@{$o->{hds}} > 0) {
- $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
- }
- }
-
- my @normal_partitions = fsedit::get_fstab(@{$o->{hds}});
-
- fs::check_mounted([@normal_partitions]);
-
- #- get all ext2 partition that may be root partition.
- my %partitions_lookup;
- my @partitions = map {
- $partitions_lookup{$_->{device}} = $_;
- type2fs($_->{type}) eq 'ext2' ? $_->{device} : (); } @normal_partitions;
-
- my $root;
- my $root_partition;
- my $selected_partition;
- do {
- if ($selected_partition->{mntpoint} && !$selected_partition->{currentMntpoint}) {
- $o->ask_warn(_("Information"), "$selected_partition->{device}" . _(" : This is not a root partition, try again."))
- unless $::beginner;
- log::l("umounting non root partition $selected_partition->{device}");
- eval { fs::umount_part($selected_partition); };
- $selected_partition->{mntpoint} = '';
- $selected_partition->{mntreadonly} = undef;
- }
-
- $root_partition = $::beginner ? $partitions[0] : $o->selectRootPartition(@partitions);
- $selected_partition = $partitions_lookup{$root_partition};
-
- unless ($root = $selected_partition->{currentMntpoint}) {
- $selected_partition->{mntpoint} = $root = $o->{prefix};
- $selected_partition->{mntreadonly} = 1;
- log::l("trying to mount root partition $root_partition");
- eval { fs::mount_part($selected_partition); };
- }
-
- #- avoid testing twice a partition.
- for my $i (0..$#partitions) {
- splice @partitions, $i, 1 if $partitions[$i] eq $root_partition;
- }
- } until $root && -d "$root/etc/sysconfig" && -r "$root/etc/fstab" || !(scalar @partitions);
-
-
- if ($root && -d "$root/etc/sysconfig" && -r "$root/etc/fstab") {
- $o->ask_warn(_("Information"), _("Found root partition : ") . $root_partition);
- $o->{prefix} = $root;
- $o->{fstab} = \@normal_partitions;
-
- #- test if the partition has to be fschecked and remounted rw.
- if ($selected_partition->{mntpoint} && !$selected_partition->{currentMntpoint}) {
- my @fstab = fs::read_fstab("$root/etc/fstab");
-
- eval { fs::umount_part($selected_partition); };
- $selected_partition->{mntpoint} = '';
- $selected_partition->{mntreadonly} = undef;
-
- foreach (@fstab) {
- if ($selected_partition = $partitions_lookup{$_->{device}}) {
- $selected_partition->{mntpoint} = $_->{mntpoint};
- }
- }
- #- TODO fsck, create check_mount_all ?
- fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
- }
- } else {
- $o->ask_warn(_("Error"), _("No root partition found"));
- }
- }
-}
-
-#------------------------------------------------------------------------------
-sub selectInstallClass {
- $o->selectInstallClass(@install_classes);
-
- $::expert = $o->{installClass} eq "expert";
- $::beginner = $o->{installClass} eq "beginner";
- $o->{partitions} ||= $suggestedPartitions{$o->{installClass}};
- $o->{partitioning}{auto_allocate} ||= -1 if $::beginner;
-
- $o->setPackages(\@install_classes)
- if $o->{steps}{choosePackages}{entered} >= 1 &&
- !$o->{steps}{doInstallStep}{done};
-}
-
-#------------------------------------------------------------------------------
-sub setupSCSI {
- my ($clicked) = $_[0];
- $o->{autoSCSI} ||= $::beginner;
-
- $o->setupSCSI($o->{autoSCSI} && !$clicked, $clicked);
-}
-
-#------------------------------------------------------------------------------
-sub partitionDisks {
- return if ($o->{isUpgrade});
-
- unless ($o->{hds}) {
- $o->{drives} = [ detect_devices::hds() ];
- $o->{hds} = catch_cdie { fsedit::hds($o->{drives}, $o->{partitioning}) }
- sub {
- $o->ask_warn(_("Error"),
-_("I can't read your partition table, it's too corrupted for me :(
-I'll try to go on blanking bad partitions"));
- $o->{partitioning}{auto_allocate} = 0;
- 1;
- };
-
- unless (@{$o->{hds}} > 0) {
- $o->setupSCSI if $o->{autoSCSI}; #- ask for an unautodetected scsi card
- }
- }
- if (@{$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");
- }
-
- $o->{partitioning}{auto_allocate} = 0
- if $o->{partitioning}{auto_allocate} == -1 && fsedit::get_fstab(@{$o->{hds}}) >= 4;
-
- eval { fsedit::auto_allocate($o->{hds}, $o->{partitions}) } if
- $o->{partitioning}{auto_allocate} && ($o->{partitioning}{auto_allocate} != -1 || $::beginner);
-
- if ($o->{partitioning}{auto_allocated} = ($::beginner && fsedit::get_root_($o->{hds}) && $_[1] == 1)) {
- install_steps::doPartitionDisks($o, $o->{hds});
- } else {
- $o->doPartitionDisks($o->{hds});
- }
-
- unless ($::testing) {
- $o->rebootNeeded foreach grep { $_->{rebootNeeded} } @{$o->{hds}};
- }
-
- $o->{fstab} = [ fsedit::get_fstab(@{$o->{hds}}) ];
-
- fsedit::get_root($o->{fstab}) or die _("partitioning failed: no root filesystem");
-}
-
-sub formatPartitions {
- return if ($o->{isUpgrade});
-
- $o->choosePartitionsToFormat($o->{fstab});
-
- unless ($::testing) {
- $o->formatPartitions(@{$o->{fstab}});
- fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
- }
- mkdir "$o->{prefix}/$_", 0755 foreach
- qw(dev etc etc/sysconfig etc/sysconfig/console etc/sysconfig/network-scripts
- etc/sysconfig/network-scripts
- home mnt root tmp var var/tmp var/lib var/lib/rpm);
-}
-
-#------------------------------------------------------------------------------
-#-PADTODO
-sub choosePackages {
- $o->setPackages($o, \@install_classes) if $_[1] == 1;
- $o->choosePackages($o->{packages}, $o->{compss});
- $o->{packages}{$_}{selected} = 1 foreach @{$o->{base}};
-}
-
-#------------------------------------------------------------------------------
-sub doInstallStep {
- $o->beforeInstallPackages;
- $o->installPackages($o->{packages});
- $o->afterInstallPackages;
-}
-
-#------------------------------------------------------------------------------
-sub configureNetwork {
- my ($clicked, $entered) = @_;
-
- if ($o->{isUpgrade} && !$clicked) {
- $o->{netc} or $o->{netc} = {};
- add2hash($o->{netc}, { network::read_conf("$o->{prefix}/etc/sysconfig/network") });
- add2hash($o->{netc}, { network::read_resolv_conf("$o->{prefix}/etc/resolv.conf") });
- foreach (all("$o->{prefix}/etc/sysconfig/network-scripts")) {
- if (/ifcfg-(\w*)/) {
- push @{$o->{intf}}, { network::read_conf("$o->{prefix}/etc/sysconfig/network-scripts/$_") };
- }
- }
- }
-
- $o->configureNetwork($entered == 1 && !$clicked)
-}
-#------------------------------------------------------------------------------
-#-PADTODO
-sub configureTimezone {
- my ($clicked) = $_[0];
- my $f = "$o->{prefix}/etc/sysconfig/clock";
- return if ((-s $f) || 0) > 0 && $_[1] == 1 && !$clicked && !$::testing;
-
- add2hash($o->{timezone}, { timezone::read($f) }) if $o->{isUpgrade} && !$clicked;
- $o->{timezone}{GMT} = 1 unless exists $o->{timezone}{GMT}; #- take GMT by default if nothing else.
-
- $o->timeConfig($f);
-}
-#------------------------------------------------------------------------------
-sub configureServices { $o->servicesConfig }
-#------------------------------------------------------------------------------
-sub configurePrinter { $o->printerConfig }
-#------------------------------------------------------------------------------
-sub setRootPassword {
- return if ($o->{isUpgrade});
-
- $o->setRootPassword;
-}
-#------------------------------------------------------------------------------
-sub addUser {
- return if ($o->{isUpgrade});
-
- $o->addUser;
-
- addToBeDone {
- run_program::rooted($o->{prefix}, "pwconv") or log::l("pwconv failed"); #- use shadow passwords
- } 'doInstallStep';
-}
-
-#------------------------------------------------------------------------------
-#-PADTODO
-sub createBootdisk {
- fs::write($o->{prefix}, $o->{fstab});
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
- $o->createBootdisk($_[1] == 1);
-}
-
-#------------------------------------------------------------------------------
-sub setupBootloader {
- $o->setupBootloaderBefore if $_[1] == 1;
- $o->setupBootloader($_[1] > 1);
-}
-#------------------------------------------------------------------------------
-sub configureX {
- my ($clicked) = $_[0];
- $o->setupXfree if $o->{packages}{XFree86}{installed} || $clicked;
-}
-#------------------------------------------------------------------------------
-sub exitInstall { $o->exitInstall(getNextStep() eq "exitInstall") }
-
-
-#-######################################################################################
-#- MAIN
-#-######################################################################################
-sub main {
- $SIG{__DIE__} = sub { chomp $_[0]; log::l("ERROR: $_[0]") };
-
- $::beginner = $::expert = $::g_auto_install = 0;
- while (@_) {
- local $_ = shift;
- if (/--method/) {
- $o->{method} = shift;
- } elsif (/--step/) {
- $o->{steps}{first} = shift;
- } elsif (/--expert/) {
- $::expert = 1;
- } elsif (/--beginner/) {
- $::beginner = 1;
- #} elsif (/--ks/ || /--kickstart/) {
- # $::auto_install = 1;
- } elsif (/--g_auto_install/) {
- $::testing = $::g_auto_install = 1;
- $o->{partitioning}{auto_allocate} = 1;
- } elsif (/--pcmcia/) {
- $o->{pcmcia} = shift;
- }
- }
-
- #- if this fails, it's okay -- it might help with free space though
- unlink "/sbin/install" unless $::testing;
- unlink "/sbin/insmod" unless $::testing;
-
- print STDERR "in second stage install\n";
- log::openLog(($::testing || $o->{localInstall}) && 'debug.log');
- log::l("second stage install running");
- log::ld("extra log messages are enabled");
-
- #-really needed ??
- #-spawnSync();
- eval { spawnShell() };
-
- $o->{prefix} = $::testing ? "/tmp/test-perl-install" : "/mnt";
- $o->{root} = $::testing ? "/tmp/root-perl-install" : "/";
- mkdir $o->{prefix}, 0755;
- mkdir $o->{root}, 0755;
-
- #- 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" unless $::g_auto_install;
- $ENV{LD_LIBRARY_PATH} = "";
-
- if ($::auto_install) {
- require 'install_steps.pm';
- fs::mount(devices::make("fd0"), "/mnt", "vfat", 0);
-
- my $O = $o;
- my $f = "/mnt/auto_inst.cfg";
- {
- local *F;
- open F, $f or die _("Error reading file $f");
-
- local $/ = "\0";
- eval <F>;
- }
- $@ and die _("Bad kickstart file %s (failed %s)", $f, $@);
- fs::umount("/mnt");
- add2hash($o, $O);
- } else {
- require 'install_steps_graphical.pm';
- }
-
- $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
- $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} = "";
-
- #- needed very early for install_steps_graphical
- eval { $o->{mouse} ||= mouse::detect() };
-
- $::o = $o = $::auto_install ?
- install_steps->new($o) :
- install_steps_graphical->new($o);
-
- $o->{netc} = network::read_conf("/tmp/network");
- if (my ($file) = glob_('/tmp/ifcfg-*')) {
- log::l("found network config file $file");
- my $l = network::read_interface_conf($file);
- add2hash(network::findIntf($o->{intf} ||= [], $l->{DEVICE}), $l);
- }
-
- modules::load_deps("/modules/modules.dep");
- $o->{modules} = modules::get_stage1_conf($o->{modules}, "/tmp/conf.modules");
- modules::read_already_loaded();
- modparm::read_modparm_file(-e "modparm.lst" ? "modparm.lst" : "/usr/share/modparm.lst");
-
- #-the main cycle
- my $clicked = 0;
- MAIN: for ($o->{step} = $o->{steps}{first};; $o->{step} = getNextStep()) {
- $o->{steps}{$o->{step}}{entered}++;
- $o->enteringStep($o->{step});
- eval {
- &{$install2::{$o->{step}}}($clicked, $o->{steps}{$o->{step}}{entered});
- };
- $o->kill_action;
- $clicked = 0;
- while ($@) {
- local $_ = $@;
- $o->kill_action;
- /^setstep (.*)/ and $o->{step} = $1, $clicked = 1, redo MAIN;
- /^theme_changed$/ and redo MAIN;
- eval { $o->errorInStep($_) } unless /^already displayed/;
- $@ and next;
- $o->{step} = $o->{steps}{$o->{step}}{onError};
- redo MAIN;
- }
- $o->leavingStep($o->{step});
- $o->{steps}{$o->{step}}{done} = 1;
-
- last if $o->{step} eq 'exitInstall';
- }
-
- fs::write($o->{prefix}, $o->{fstab});
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
-
- killCardServices();
-
- log::l("installation complete, leaving");
-
- if ($::g_auto_install) {
- my $h = $o; $o = {};
- $h->{$_} and $o->{$_} = $h->{$_} foreach qw(lang autoSCSI printer mouse netc timezone bootloader superuser intf keyboard mkbootdisk base user modules installClass partitions);
-
- delete $o->{user}{password2};
- delete $o->{superuser}{password2};
-
- print Data::Dumper->Dump([$o], ['$o']), "\0";
- }
-}
-
-sub killCardServices {
- my $pid = chop_(cat_("/tmp/cardmgr.pid"));
- $pid and kill(15, $pid); #- send SIGTERM
-}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
deleted file mode 100644
index 9812c3efb..000000000
--- a/perl-install/install_any.pm
+++ /dev/null
@@ -1,156 +0,0 @@
-package install_any;
-
-use diagnostics;
-use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
-
-@ISA = qw(Exporter);
-%EXPORT_TAGS = (
- all => [ qw(getNextStep spawnSync spawnShell addToBeDone) ],
-);
-@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :system);
-use commands;
-use run_program;
-use detect_devices;
-use pkgs;
-use log;
-
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-sub relGetFile($) {
- local $_ = $_[0];
- my $dir = m|/| ? "mdkinst" :
- (member($_, qw(compss compssList depslist hdlist)) ? "base" : "RPMS");
- $_ = "Mandrake/$dir/$_";
- s/i386/i586/;
- $_;
-}
-sub getFile($) {
- local $^W = 0;
- if ($::o->{method} && $::o->{method} eq "ftp") {
- require 'ftp.pm';
- *install_any::getFile = \&ftp::getFile;
- } else {
- *install_any::getFile = sub($) {
- open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or return;
- \*getFile;
- };
- }
- goto &getFile;
-}
-
-sub kernelVersion {
- local $_ = readlink("$::o->{prefix}/boot/vmlinuz") || $::testing && "vmlinuz-2.2.testversion" or die "I couldn't find the kernel package!";
- first(/vmlinuz-(.*)/);
-}
-
-
-sub getNextStep {
- my ($s) = $::o->{steps}{first};
- $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done};
- $s;
-}
-
-sub spawnSync {
- return if $::o->{localInstall} || $::testing;
- fork and return;
- while (1) { sleep(30); sync(); }
-}
-
-sub spawnShell {
- return if $::o->{localInstall} || $::testing;
-
- -x "/bin/sh" or die "cannot open shell - /usr/bin/sh doesn't exist";
-
- fork and return;
-
- local *F;
- sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided";
-
- open STDIN, "<&F" or die '';
- open STDOUT, ">&F" or die '';
- open STDERR, ">&F" or die '';
- close F;
-
- c::setsid();
-
- ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!";
-
- exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!");
-}
-
-sub shells($) {
- my ($o) = @_;
- my @l = grep { -x "$o->{prefix}$_" } @{$o->{shells}};
- @l ? @l : "/bin/bash";
-}
-
-sub getAvailableSpace {
- my ($o) = @_;
-
- do { $_->{mntpoint} eq '/usr' and return $_->{size} * 512 } foreach @{$o->{fstab}};
- do { $_->{mntpoint} eq '/' and return $_->{size} * 512 } foreach @{$o->{fstab}};
-
- if ($::testing) {
- log::l("taking 200MB for testing");
- return 200 << 20;
- }
- die "missing root partition";
-}
-
-sub setPackages($$) {
- my ($o, $install_classes) = @_;
-
- if ($o->{packages}) {
- $_->{selected} = 0 foreach values %{$o->{packages}};
- } else {
- my $useHdlist = $o->{method} !~ /nfs|hd/;
- eval { $o->{packages} = pkgs::psUsingHdlist() } if $useHdlist;
- $o->{packages} = pkgs::psUsingDirectory() if !$useHdlist || $@;
-
- pkgs::getDeps($o->{packages});
-
- $o->{compss} = pkgs::readCompss($o->{packages});
- $o->{compssListLevels} = pkgs::readCompssList($o->{packages});
- $o->{compssListLevels} ||= $install_classes;
- push @{$o->{base}}, "kernel-smp" if detect_devices::hasSMP();
- push @{$o->{base}}, "kernel-pcmcia-cs" if $o->{pcmcia};
- }
-
- do {
- my $p = $o->{packages}{$_} or log::l("missing base package $_"), next;
- pkgs::select($o->{packages}, $p, 1);
- } foreach @{$o->{base}};
-
- pkgs::setShowFromCompss($o->{compss}, $o->{installClass}, $o->{lang});
- ($o->{packages_}{ind}, $o->{packages_}{select_level}) = pkgs::setSelectedFromCompssList($o->{compssListLevels}, $o->{packages}, getAvailableSpace($o) * 0.7, $o->{installClass}, $o->{lang});
-}
-
-sub addToBeDone(&$) {
- my ($f, $step) = @_;
-
- return &$f() if $::o->{steps}{$step}{done};
-
- push @{$::o->{steps}{$step}{toBeDone}}, $f;
-}
-
-sub install_cpio {
- my ($dir, $name) = @_;
-
- return "$dir/$name" if -e "$dir/$name";
-
- my $cpio = "$dir.cpio.bz2";
- -e $cpio or return;
-
- eval { commands::rm("-r", $dir) };
- mkdir $dir, 0755;
- run_program::run("cd $dir ; bzip2 -cd $cpio | cpio -id $name $name/*");
- "$dir/$name";
-}
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
deleted file mode 100644
index 42dd72d17..000000000
--- a/perl-install/install_steps.pm
+++ /dev/null
@@ -1,307 +0,0 @@
-package install_steps;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:file :system :common);
-use install_any qw(:all);
-use partition_table qw(:types);
-use detect_devices;
-use timezone;
-use modules;
-use run_program;
-use lilo;
-use lang;
-use keyboard;
-use printer;
-use pkgs;
-use log;
-use fsedit;
-use commands;
-use network;
-use fs;
-
-
-#-######################################################################################
-#- OO Stuff
-#-######################################################################################
-sub new($$) {
- my ($type, $o) = @_;
-
- bless $o, ref $type || $type;
- return $o;
-}
-
-#-######################################################################################
-#- In/Out Steps Functions
-#-######################################################################################
-sub enteringStep($$) {
- my ($o, $step) = @_;
- log::l("starting step `$step'");
-
- for (my $s = $o->{steps}{first}; $s; $s = $o->{steps}{$s}{next}) {
-
- next if $o->{steps}{$s}{done} && !$o->{steps}{$s}{redoable};
- next if $o->{steps}{$s}{reachable};
-
- my $reachable = 1;
- if (my $needs = $o->{steps}{$s}{needs}) {
- my @l = ref $needs ? @$needs : $needs;
- $reachable = min(map { $o->{steps}{$_}{done} || 0 } @l);
- }
- $o->{steps}{$s}{reachable} = 1 if $reachable;
- }
-}
-sub leavingStep($$) {
- my ($o, $step) = @_;
- log::l("step `$step' finished");
-
- $o->{steps}{$step}{reachable} = $o->{steps}{$step}{redoable};
-
- while (my $f = shift @{$o->{steps}{$step}{toBeDone} || []}) {
- eval { &$f() };
- $o->ask_warn(_("Error"), [
-_("An error occurred, i don't know how to handle it nicely,
-so continue at your own risk :("), $@ ]) if $@;
- }
-}
-
-sub errorInStep($$) { print "error :(\n"; exit 1 }
-sub kill_action {}
-
-
-#-######################################################################################
-#- Steps Functions
-#-######################################################################################
-#------------------------------------------------------------------------------
-sub selectLanguage {
- my ($o) = @_;
- lang::set($o->{lang});
-
- unless ($o->{keyboard_force}) {
- $o->{keyboard} = keyboard::lang2keyboard($o->{lang});
- selectKeyboard($o);
- }
-}
-#------------------------------------------------------------------------------
-sub selectKeyboard {
- my ($o) = @_;
- keyboard::setup($o->{keyboard})
-}
-#------------------------------------------------------------------------------
-sub selectPath {}
-#------------------------------------------------------------------------------
-sub selectInstallClass($@) {}
-#------------------------------------------------------------------------------
-sub setupSCSI { modules::load_thiskind('scsi') }
-#------------------------------------------------------------------------------
-sub doPartitionDisks($$) {
- my ($o, $hds) = @_;
- return if $::testing;
- partition_table::write($_) foreach @$hds;
-}
-
-#------------------------------------------------------------------------------
-sub rebootNeeded($) {
- my ($o) = @_;
- log::l("Rebooting...");
- exec "true";
-}
-
-sub choosePartitionsToFormat($$) {
- my ($o, $fstab) = @_;
-
- $_->{mntpoint} = "swap" foreach grep { isSwap($_) } @$fstab;
- $_->{toFormat} = $_->{mntpoint} &&
- ($_->{notFormatted} || $o->{partitioning}{autoformat}) foreach @$fstab;
-}
-
-sub formatPartitions {
- my $o = shift;
- foreach (@_) {
- fs::format_part($_) if $_->{toFormat};
- }
-}
-
-#------------------------------------------------------------------------------
-sub setPackages {
- my ($o, $install_classes) = @_;
- install_any::setPackages($o, $install_classes);
-}
-sub choosePackages($$$) {
- my ($o, $packages, $compss) = @_;
-}
-
-sub beforeInstallPackages {
- my ($o) = @_;
-
- network::add2hosts("$o->{prefix}/etc/hosts", "localhost.localdomain", "127.0.0.1");
- pkgs::init_db($o->{prefix}, $o->{isUpgrade});
-}
-
-sub installPackages($$) {
- my ($o, $packages) = @_;
- my $toInstall = [ grep { $_->{selected} && !$_->{installed} } values %$packages ];
- pkgs::install($o->{prefix}, $toInstall);
-}
-
-sub afterInstallPackages($) {
- my ($o) = @_;
-
- #- why not? cuz weather is nice today :-) [pixel]
- sync(); sync();
-
- $o->pcmciaConfig();
-}
-
-#------------------------------------------------------------------------------
-sub selectMouse($) {
- my ($o) = @_;
-}
-
-#------------------------------------------------------------------------------
-sub configureNetwork($) {
- my ($o) = @_;
- my $etc = "$o->{prefix}/etc";
-
- network::write_conf("$etc/sysconfig/network", $o->{netc});
- network::write_resolv_conf("$etc/resolv.conf", $o->{netc});
- network::write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$_->{DEVICE}", $_) foreach @{$o->{intf}};
- 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
-}
-
-#------------------------------------------------------------------------------
-sub pcmciaConfig($) {
- my ($o) = @_;
- my $t = $o->{pcmcia};
- my $f = "$o->{prefix}/etc/sysconfig/pcmcia";
-
- #- should be set after installing the package above else the file will be renamed.
- setVarsInSh($f, {
- PCMCIA => $t ? "yes" : "no",
- PCIC => $t,
- PCIC_OPTS => "",
- CORE_OPTS => "",
- });
-}
-
-#------------------------------------------------------------------------------
-sub timeConfig {
- my ($o, $f) = @_;
- timezone::write($o->{prefix}, $o->{timezone}, $f);
-}
-
-#------------------------------------------------------------------------------
-sub servicesConfig {}
-#------------------------------------------------------------------------------
-sub printerConfig {
- my($o) = @_;
- if ($o->{printer}{complete}) {
-
- pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'});
- $o->installPackages($o->{packages});
-
- printer::configure_queue($o->{printer});
- }
-}
-
-#------------------------------------------------------------------------------
-my @etc_pass_fields = qw(name password uid gid realname home shell);
-sub setRootPassword($) {
- my ($o) = @_;
- my %u = %{$o->{superuser}};
- my $p = $o->{prefix};
-
- $u{password} = crypt_($u{password}) if $u{password};
-
- my @lines = cat_(my $f = "$p/etc/passwd") or log::l("missing passwd file"), return;
-
- local *F;
- open F, "> $f" or die "failed to write file $f: $!\n";
- foreach (@lines) {
- if (/^root:/) {
- chomp;
- my %l; @l{@etc_pass_fields} = split ':';
- add2hash(\%u, \%l);
- $_ = join(':', @u{@etc_pass_fields}) . "\n";
- }
- print F $_;
- }
-}
-
-#------------------------------------------------------------------------------
-sub addUser($) {
- my ($o) = @_;
- my %u = %{$o->{user}};
- my $p = $o->{prefix};
- my @passwd = cat_("$p/etc/passwd");;
-
- !$u{name} || getpwnam($u{name}) and return;
-
- for ($u{uid} = 500; getpwuid($u{uid}); $u{uid}++) {}
- for ($u{gid} = 500; getgrgid($u{gid}); $u{gid}++) {}
- $u{home} ||= "/home/$u{name}";
-
- $u{password} = crypt_($u{password}) if $u{password};
-
- return if $::testing;
-
- local *F;
- open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!";
- print F join(':', @u{@etc_pass_fields}), "\n";
-
- open F, ">> $p/etc/group" or die "can't append to group file: $!";
- print F "$u{name}::$u{gid}:\n";
-
- eval { commands::cp("-f", "$p/etc/skel", "$p$u{home}") }; $@ and log::l("copying of skel failed: $@"), mkdir("$p$u{home}", 0750);
- commands::chown_("-r", "$u{uid}.$u{gid}", "$p$u{home}");
-}
-
-#------------------------------------------------------------------------------
-sub createBootdisk($) {
- my ($o) = @_;
- my $dev = $o->{mkbootdisk} or return;
-
- my @l = detect_devices::floppies();
-
- $dev = shift @l || die _("no floppy available")
- if $dev eq "1"; #- special case meaning autochoose
-
- return if $::testing;
-
- lilo::mkbootdisk($o->{prefix}, install_any::kernelVersion(), $dev);
- $o->{mkbootdisk} = $dev;
-}
-
-#------------------------------------------------------------------------------
-sub setupBootloaderBefore {
- my ($o) = @_;
- add2hash($o->{bootloader} ||= {}, lilo::read($o->{prefix}, "/etc/lilo.conf"));
- lilo::suggest($o->{prefix}, $o->{bootloader}, $o->{hds}, $o->{fstab}, install_any::kernelVersion());
- $o->{bootloader}{keytable} ||= keyboard::kmap($o->{keyboard});
-}
-
-sub setupBootloader($) {
- my ($o) = @_;
- return if $::g_auto_install;
- lilo::install($o->{prefix}, $o->{bootloader});
-}
-
-#------------------------------------------------------------------------------
-sub setupXfree {
- my ($o) = @_;
-}
-
-#------------------------------------------------------------------------------
-sub exitInstall {}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
deleted file mode 100644
index 5b616bd2c..000000000
--- a/perl-install/install_steps_interactive.pm
+++ /dev/null
@@ -1,758 +0,0 @@
-package install_steps_interactive;
-
-
-use diagnostics;
-use strict;
-use vars qw(@ISA);
-
-@ISA = qw(install_steps);
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :file :functional);
-use partition_table qw(:types);
-use install_steps;
-use pci_probing::main;
-use install_any;
-use detect_devices;
-use timezone;
-use network;
-use mouse;
-use modules;
-use lang;
-use pkgs;
-use keyboard;
-use fs;
-use modparm;
-use log;
-use printer;
-use lilo;
-#-######################################################################################
-#- In/Out Steps Functions
-#-######################################################################################
-sub errorInStep($$) {
- my ($o, $err) = @_;
- $o->ask_warn(_("Error"), [ _("An error occurred"), $err ]);
-}
-
-sub kill_action {
- my ($o) = @_;
- $o->kill;
-}
-
-#-######################################################################################
-#- Steps Functions
-#-######################################################################################
-#------------------------------------------------------------------------------
-sub selectLanguage($) {
- my ($o) = @_;
- $o->{lang} =
- lang::text2lang($o->ask_from_list("Language",
- _("Which language do you want?"),
- # the translation may be used for the help
- [ lang::list() ],
- lang::lang2text($o->{lang})));
- install_steps::selectLanguage($o);
-}
-#------------------------------------------------------------------------------
-sub selectKeyboard($) {
- my ($o) = @_;
- $o->{keyboard} =
- keyboard::text2keyboard($o->ask_from_list_("Keyboard",
- _("Which keyboard do you have?"),
- [ keyboard::list() ],
- keyboard::keyboard2text($o->{keyboard})));
- $o->{keyboard_force} = 1;
- install_steps::selectKeyboard($o);
-}
-#------------------------------------------------------------------------------
-sub selectPath($) {
- my ($o) = @_;
- $o->{isUpgrade} =
- $o->ask_from_list_(_("Install/Upgrade"),
- _("Is this an install or an upgrade?"),
- [ __("Install"), __("Upgrade") ],
- $o->{isUpgrade} ? "Upgrade" : "Install") eq "Upgrade";
- install_steps::selectPath($o);
-}
-#------------------------------------------------------------------------------
-sub selectRootPartition($@) {
- my ($o,@partitions) = @_;
- $o->{upgradeRootPartition} =
- $o->ask_from_list_(_("Root Partition"),
- _("What is the root partition of your system?"),
- [ @partitions ], $o->{upgradeRootPartitions});
-#- TODO check choice, then mount partition in $o->{prefix} and autodetect.
-#- install_steps::selectRootPartition($o);
-}
-#------------------------------------------------------------------------------
-sub selectInstallClass($@) {
- my ($o, @classes) = @_;
- $o->{installClass} =
- $o->ask_from_list_(_("Install Class"),
- _("What type of user will you have?"),
- [ @classes ], $o->{installClass});
- install_steps::selectInstallClass($o);
-}
-
-#------------------------------------------------------------------------------
-sub selectMouse {
- my ($o, $force) = @_;
-
- my $name = $o->{mouse}{FULLNAME};
- if (!$name || $::expert || $force) {
- $name = $o->ask_from_list_('', _("Which mouse do you have"), [ mouse::names() ], $name);
- $o->{mouse} = mouse::name2mouse($name);
- }
- my $b = $o->{mouse}{nbuttons} < 3;
- $o->{mouse}{XEMU3} = 'yes' if $::expert && $o->ask_yesorno('', _("Emulate third button"), $b) || $b;
-
- $o->{mouse}{device} = mouse::serial_ports_names2dev(
- $o->ask_from_list(_("Mouse Port"),
- _("Which serial port is your mouse connected to?"),
- [ mouse::serial_ports_names() ])) if $o->{mouse}{device} eq "ttyS";
-
- $o->SUPER::selectMouse;
-}
-#------------------------------------------------------------------------------
-sub setupSCSI { setup_thiskind($_[0], 'scsi', $_[1], $_[2]) }
-#------------------------------------------------------------------------------
-sub rebootNeeded($) {
- my ($o) = @_;
- $o->ask_warn('', _("You need to reboot for the partition table modifications to take place"));
-
- install_steps::rebootNeeded($o);
-}
-sub choosePartitionsToFormat($$) {
- my ($o, $fstab) = @_;
-
- $o->SUPER::choosePartitionsToFormat($fstab);
-
- my @l = grep { $_->{mntpoint} && !($::beginner && isSwap($_)) } @$fstab;
-
- return if $::beginner && 0 == grep { ! $_->{toFormat} } @l;
-
- $o->ask_many_from_list_ref('', _("Choose the partitions you want to format"),
- [ map { isSwap($_) ? type2name($_->{type}) . " ($_->{device})" : $_->{mntpoint} } @l ],
- [ map { \$_->{toFormat} } @l ]) or die "cancel";
-}
-
-sub formatPartitions {
- my $o = shift;
- my $w = $o->wait_message('', '');
- foreach (@_) {
- if ($_->{toFormat}) {
- $w->set(_("Formatting partition %s", $_->{device}));
- fs::format_part($_);
- }
- }
-}
-#------------------------------------------------------------------------------
-sub setPackages {
- my ($o, $install_classes) = @_;
- my $w = $o->wait_message('', _("Searching for available packages"));
- $o->SUPER::setPackages($install_classes);
-}
-
-#------------------------------------------------------------------------------
-sub configureNetwork($) {
- my ($o, $first_time) = @_;
- my $r = '';
- if ($o->{intf}) {
- if ($first_time) {
- my @l = (
- __("Keep the current IP configuration"),
- __("Reconfigure network now"),
- __("Don't set up networking"),
- );
- $r = $o->ask_from_list_(_("Network Configuration"),
- _("LAN networking has already been configured. Do you want to:"),
- [ @l ]);
- $r ||= "Don't";
- }
- } else {
- $o->ask_yesorno(_("Network Configuration"),
- _("Do you want to configure LAN (not dialup) networking for your installed system?")) or $r = "Don't";
- }
-
- if ($r =~ /^Don\'t/) {
- $o->{netc}{NETWORKING} = "false";
- } elsif ($r !~ /^Keep/) {
- $o->setup_thiskind('net', !$::expert, 1);
- my @l = detect_devices::getNet() or die _("no network card found");
-
- my $last; foreach ($::beginner ? $l[0] : @l) {
- my $intf = network::findIntf($o->{intf} ||= [], $_);
- add2hash($intf, $last);
- add2hash($intf, { NETMASK => '255.255.255.0' });
- $o->configureNetworkIntf($intf) or return;
-
- $o->{netc} ||= {};
- delete $o->{netc}{dnsServer};
- delete $o->{netc}{GATEWAY};
- $last = $intf;
- }
- #- {
- #- my $wait = $o->wait_message(_("Hostname"), _("Determining host name and domain..."));
- #- network::guessHostname($o->{prefix}, $o->{netc}, $o->{intf});
- #- }
- $o->configureNetworkNet($o->{netc}, $last ||= {}, @l) or return;
- }
- install_steps::configureNetwork($o);
-}
-
-sub configureNetworkIntf {
- my ($o, $intf) = @_;
- delete $intf->{NETWORK};
- delete $intf->{BROADCAST};
- my @fields = qw(IPADDR NETMASK);
- $o->ask_from_entries_ref(_("Configuring network device %s", $intf->{DEVICE}),
-_("Please enter the IP configuration for this machine.
-Each item should be entered as an IP address in dotted-decimal
-notation (for example, 1.2.3.4)."),
- [ _("IP address:"), _("Netmask:")],
- [ \$intf->{IPADDR}, \$intf->{NETMASK} ],
- complete => sub {
- for (my $i = 0; $i < @fields; $i++) {
- unless (network::is_ip($intf->{$fields[$i]})) {
- $o->ask_warn('', _("IP address should be in format 1.2.3.4"));
- return (1,$i);
- }
- return 0;
- }
- },
- focus_out => sub {
- $intf->{NETMASK} = network::netmask($intf->{IPADDR}) unless $_[0]
- }
-
- );
-}
-
-sub configureNetworkNet {
- my ($o, $netc, $intf, @devices) = @_;
- $netc->{dnsServer} ||= network::dns($intf->{IPADDR});
- $netc->{GATEWAY} ||= network::gateway($intf->{IPADDR});
-
- $o->ask_from_entries_ref(_("Configuring network"),
-_("Please enter your host name.
-Your host name should be a fully-qualified host name,
-such as ``mybox.mylab.myco.com''.
-Also give the gateway if you have one"),
- [_("Host name:"), _("DNS server:"), _("Gateway:"), !$::beginner ? _("Gateway device:") : ()],
- [(map { \$netc->{$_}} qw(HOSTNAME dnsServer GATEWAY)),
- {val => \$netc->{GATEWAYDEV}, list => \@devices}]
- );
-}
-
-#------------------------------------------------------------------------------
-sub timeConfig {
- my ($o, $f) = @_;
-
- $o->{timezone}{GMT} = $o->ask_yesorno('', _("Is your hardware clock set to GMT?"), $o->{timezone}{GMT});
- $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang}));
- $o->{timezone}{timezone} = $o->ask_from_list('', _("In which timezone are you"), [ timezone::getTimeZones($::g_auto_install ? '' : $o->{prefix}) ], $o->{timezone}{timezone});
- install_steps::timeConfig($o,$f);
-}
-
-#------------------------------------------------------------------------------
-#-sub servicesConfig {}
-#------------------------------------------------------------------------------
-sub printerConfig($) {
- my ($o) = @_;
- $o->{printer}{want} =
- $o->ask_yesorno(_("Printer"),
- _("Would you like to configure a printer?"),
- $o->{printer}{want});
- return if !$o->{printer}{want};
-
- unless (($::testing)) {
- printer::set_prefix($o->{prefix});
- pkgs::select($o->{packages}, $o->{packages}{'rhs-printfilters'});
- $o->installPackages($o->{packages});
-
- }
- printer::read_printer_db();
-
- $o->{printer}{complete} = 0;
- if ($::expert) {
- #std info
- #Don't wait, if the user enter something, you must remember it
- $o->ask_from_entries_ref(_("Standard Printer Options"),
- _("Every print queue (which print jobs are directed to) needs a
-name (often lp) and a spool directory associated with it. What
-name and directory should be used for this queue?"),
- [_("Name of queue:"), _("Spool directory:")],
- [\$o->{printer}{QUEUE}, \$o->{printer}{SPOOLDIR}],
- changed => sub
- {
- $o->{printer}{SPOOLDIR}
- = "$printer::spooldir/$o->{printer}{QUEUE}" unless $_[0];
- },
- );
- }
-
- $o->{printer}{str_type} =
- $o->ask_from_list_(_("Select Printer Connection"),
- _("How is the printer connected?"),
- [keys %printer::printer_type],
- ${$o->{printer}}{str_type},
- );
- $o->{printer}{TYPE} = $printer::printer_type{$o->{printer}{str_type}};
-
- if ($o->{printer}{TYPE} eq "LOCAL") {
- {
- my $w = $o->wait_message(_("Test ports"), _("Detecting devices..."));
- eval { modules::load("lp");modules::load("parport_probe"); };
- }
-
- my @port = ();
- my @parport = detect_devices::whatPrinter();
- eval { modules::unload("parport_probe") };
- my $str;
- if ($parport[0]) {
- my $port = $parport[0]{port};
- $o->{printer}{DEVICE} = $port;
- my $descr = common::bestMatchSentence2($parport[0]{val}{DESCRIPTION}, @printer::entry_db_description);
- $o->{printer}{DBENTRY} = $printer::descr_to_db{$descr};
- $str = _("I have detected a %s on ", $parport[0]{val}{DESCRIPTION}) . $port;
- @port = map { $_->{port}} @parport;
- } else {
- @port = detect_devices::whatPrinterPort();
- }
- $o->{printer}{DEVICE} = $port[0] if $port[0];
-
- return if !$o->ask_from_entries_ref(_("Local Printer Device"),
- _("What device is your printer connected to \n(note that /dev/lp0 is equivalent to LPT1:)?\n") . $str ,
- [_("Printer Device:")],
- [{val => \$o->{printer}{DEVICE}, list => \@port }],
- );
- #-TAKE A GOODDEFAULT TODO
-
- } elsif ($o->{printer}{TYPE} eq "REMOTE") {
- return if !$o->ask_from_entries_ref(_("Remote lpd Printer Options"),
- _("To use a remote lpd print queue, you need to supply
-the hostname of the printer server and the queue name
-on that server which jobs should be placed in."),
- [_("Remote hostname:"), _("Remote queue:")],
- [\$o->{printer}{REMOTEHOST}, \$o->{printer}{REMOTEQUEUE}],
- );
-
- } elsif ($o->{printer}{TYPE} eq "SMB") {
- return if !$o->ask_from_entries_ref(
- _("SMB/Windows 95/NT Printer Options"),
- _("To print to a SMB printer, you need to provide the
-SMB host name (this is not always the same as the machines
-TCP/IP hostname) and possibly the IP address of the print server, as
-well as the share name for the printer you wish to access and any
-applicable user name, password, and workgroup information."),
- [_("SMB server host:"), _("SMB server IP:"),
- _("Share name:"), _("User name:"), _("Password:"),
- _("Workgroup:")],
- [\$o->{printer}{SMBHOST}, \$o->{printer}{SMBHOSTIP},
- \$o->{printer}{SMBSHARE}, \$o->{printer}{SMBUSER},
- {val => \$o->{printer}{SMBPASSWD}, hidden => 1}, \$o->{printer}{SMBWORKGROUP}
- ],
- complete => sub {
- unless (network::is_ip($o->{printer}{SMBHOSTIP})) {
- $o->ask_warn('', _("IP address should be in format 1.2.3.4"));
- return (1,1);
- }
- return 0;
- },
-
- );
- } else {#($o->{printer}{TYPE} eq "NCP") {
- return if !$o->ask_from_entries_ref(_("NetWare Printer Options"),
- _("To print to a NetWare printer, you need to provide the
-NetWare print server name (this is not always the same as the machines
-TCP/IP hostname) as well as the print queue name for the printer you
-wish to access and any applicable user name and password."),
- [_("Printer Server:"), _("Print Queue Name:"),
- _("User name:"), _("Password:")],
- [\$o->{printer}{NCPHOST}, \$o->{printer}{NCPQUEUE},
- \$o->{printer}{NCPUSER}, {val => \$o->{printer}{NCPPASSWD}, hidden => 1}],
- );
- }
-
-
-
- $o->{printer}{DBENTRY} =
- $printer::descr_to_db{
- $o->ask_from_list_(_("Configure Printer"),
- _("What type of printer do you have?"),
- [@printer::entry_db_description],
- $printer::db_to_descr{$o->{printer}{DBENTRY}},
- )
- };
-
- my %db_entry = %{$printer::thedb{$o->{printer}{DBENTRY}}};
-
-
- #-paper size conf
- $o->{printer}{PAPERSIZE} =
- $o->ask_from_list_(_("Paper Size"),
- _("Paper Size"),
- \@printer::papersize_type,
- $o->{printer}{PAPERSIZE}
- );
-
- #-resolution size conf
- my @list_res = @{$db_entry{RESOLUTION}};
- my @res = map { "${$_}{XDPI}x${$_}{YDPI}" } @list_res;
- if (@list_res) {
- $o->{printer}{RESOLUTION} = $o->ask_from_list_(_("Resolution"),
- _("Resolution"),
- \@res,
- $o->{printer}{RESOLUTION},
- );
- } else {
- $o->{printer}{RESOLUTION} = "Default";
- }
-
- $o->{printer}{CRLF} = $db_entry{DESCR} =~ /HP/;
- $o->{printer}{CRLF}= $o->ask_yesorno(_("CRLF"),
- _("Fix stair-stepping of text?"),
- $o->{printer}{CRLF});
-
-
- #-color_depth
- if ($db_entry{BITSPERPIXEL}) {
- my @list_col = @{$db_entry{BITSPERPIXEL}};
- my @col = map { "$_->{DEPTH} $_->{DESCR}" } @list_col;
- my %col_to_depth = map { ("$_->{DEPTH} $_->{DESCR}", $_->{DEPTH}) } @list_col;
- my %depth_to_col = reverse %col_to_depth;
-
- if (@list_col) {
- my $is_uniprint = $db_entry{GSDRIVER} eq "uniprint";
- if ($is_uniprint) {
- $o->{printer}{BITSPERPIXEL} =
- $col_to_depth{$o->ask_from_list_
- (_("Configure Uniprint Driver"),
- _("You may now configure the uniprint options for this printer."),
- \@col,
- $depth_to_col{$o->{printer}{BITSPERPIXEL}},
- )};
-
- } else {
- $o->{printer}{BITSPERPIXEL} =
- $col_to_depth{$o->ask_from_list_
- (_("Configure Color Depth"),
- _("You may now configure the color options for this printer."),
- \@col,
- $depth_to_col{$o->{printer}{BITSPERPIXEL}},
- )};
- }
- } else {
- $o->{printer}{BITSPERPIXEL} = "Default";
- }
- }
- $o->{printer}{complete} = 1;
-
- install_steps::printerConfig($o);
-}
-
-
-#------------------------------------------------------------------------------
-sub setRootPassword($) {
- my ($o) = @_;
- $o->{superuser}{password2} ||= $o->{user}{password} ||= "";
- my $sup = $o->{superuser};
-
- $o->ask_from_entries_ref(_("Set root password"),
- _("Set root password"),
- [_("Password"), _("Password (again)")],
- [{ val => \$sup->{password}, hidden => 1},
- { val => \$sup->{password2}, hidden => 1}],
- complete => sub {
- $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,1);
- (length $sup->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,0);
- return 0
- }
- );
- install_steps::setRootPassword($o);
-}
-
-#------------------------------------------------------------------------------
-#-addUser
-#------------------------------------------------------------------------------
-sub addUser($) {
- my ($o) = @_;
- $o->{user}{password2} ||= $o->{user}{password} ||= "";
- my $u = $o->{user};
- my @fields = qw(realname name password password2);
- my @shells = install_any::shells($o);
-
- $o->ask_from_entries_ref(
- _("Add user"),
- _("Enter a user"),
- [ _("Real name"), _("User name"), _("Password"), _("Password (again)"), _("Shell") ],
- [ \$u->{realname}, \$u->{name},
- {val => \$u->{password}, hidden => 1}, {val => \$u->{password2}, hidden => 1},
- {val => \$u->{shell}, list => \@shells, not_edit => !$::expert},
- ],
- focus_out => sub {
- if ($_[0] eq 0) {
- $u->{name} = lc first($u->{realname} =~ /((\w|-)+)/);
- }
- },
- complete => sub {
- $u->{password} eq $u->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,3);
- #(length $u->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,2);
- $u->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0);
- $u->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0);
- return 0;
- },
- ) or return;
- install_steps::addUser($o);
- $o->{user} = {};
- goto &addUser if $::expert;
-}
-
-
-
-
-#------------------------------------------------------------------------------
-sub createBootdisk {
- my ($o, $first_time) = @_;
- my @l = detect_devices::floppies();
-
- if ($first_time || @l == 1) {
- $o->ask_yesorno('',
- _("A custom bootdisk provides a way of booting into your Linux system without
-depending on the normal bootloader. This is useful if you don't want to install
-lilo on your system, or another operating system removes lilo, or lilo doesn't
-work with your hardware configuration. A custom bootdisk can also be used with
-the Mandrake rescue image, making it much easier to recover from severe system
-failures. Would you like to create a bootdisk for your system?"), $o->{mkbootdisk}) or return;
- $o->{mkbootdisk} = $l[0] if !$o->{mkbootdisk} || $o->{mkbootdisk} eq "1";
- } else {
- @l or die _("Sorry, no floppy drive available");
-
- $o->{mkbootdisk} = $o->ask_from_list('',
- _("Choose the floppy drive you want to use to make the bootdisk"),
- [ @l, "Cancel" ], $o->{mkbootdisk});
- return if $o->{mkbootdisk} eq "Cancel";
- }
-
- $o->ask_warn('', _("Insert a floppy in drive %s", $o->{mkbootdisk}));
- my $w = $o->wait_message('', _("Creating bootdisk"));
- install_steps::createBootdisk($o);
-}
-
-#------------------------------------------------------------------------------
-sub setupBootloaderBefore {
- my ($o) = @_;
- my $w = $o->wait_message('', _("Preparing bootloader"));
- $o->SUPER::setupBootloaderBefore($o);
-}
-
-sub setupBootloader {
- my ($o, $more) = @_;
- my $b = $o->{bootloader};
-
- if ($::beginner && !$more) {
- my @l = (__("First sector of drive"), __("First sector of boot partition"));
-
- my $boot = $o->{hds}[0]{device};
- my $onmbr = "/dev/$boot" eq $b->{boot};
- $b->{boot} = "/dev/$boot" if !$onmbr &&
- $o->ask_from_list_(_("Lilo Installation"),
- _("Where do you want to install the bootloader?"),
- \@l, $l[!$onmbr]) eq $l[0];
- } else {
- $::expert and $o->ask_yesorno('', _("Do you want to use lilo?"), 1) || return;
-
- my @l = (
-_("Boot device") => { val => \$b->{boot}, list => [ map { "/dev/$_->{device}" } @{$o->{hds}}, @{$o->{fstab}} ], not_edit => !$::expert },
-_("Linear (needed for some SCSI drives)") => { val => \$b->{linear}, type => "bool", text => _("linear") },
-_("Compact") => { val => \$b->{compact}, type => "bool", text => _("compact") },
-_("Delay before choosing default choice") => \$b->{timeout},
-_("Video mode") => { val => \$b->{vga}, list => [ keys %lilo::vga_modes ], not_edit => $::beginner },
-_("Password") => { val => \$b->{password}, hidden => 1 },
-_("Restrict command line options") => { val => \$b->{restricted}, type => "bool", text => _("restrict") },
- );
- @l = @l[0..3] if $::beginner;
-
- $b->{vga} ||= 'Normal';
- $o->ask_from_entries_ref('',
- _("Lilo main options"),
- [ grep_index { even($::i) } @l ],
- [ grep_index { odd($::i) } @l ],
- complete => sub {
- $b->{restricted} && !$b->{password} and $o->ask_warn('', _("Option ``Restrict command line options'' is of no use without a password")), return 1;
- 0;
- }
- ) or return;
- $b->{vga} = $lilo::vga_modes{$b->{vga}} || $b->{vga};
- }
-
- until ($::beginner && !$more) {
- my $c = $o->ask_from_list_('',
-_("Here are the following entries in lilo
-You can add some more or change the existent ones."),
- [ (sort @{[map_each { "$::b->{label} ($::a)" . ($b->{default} eq $::b->{label} && " *") } %{$b->{entries}}]}), __("Add"), __("Done") ],
- );
- $c eq "Done" and last;
-
- my $e = {};
- my $name = '';
-
- if ($c ne "Add") {
- ($name) = $c =~ /\((.*?)\)/;
- $e = $b->{entries}{$name};
- }
- my $old_name = $name;
- my $default = my $old_default = $e->{label} eq $b->{default};
-
- my @l;
- if ($e->{type} eq "image") {
- @l = (
-_("Image") => { val => \$name, list => [ eval { glob_("/boot/vmlinuz*") } ] },
-_("Root") => { val => \$e->{root}, list => [ map { "/dev/$_->{device}" } @{$o->{fstab}} ], not_edit => !$::expert },
-_("Append") => \$e->{append},
-_("Initrd") => { val => \$e->{initrd}, list => [ eval { glob_("/boot/initrd*") } ] },
-_("Read-write") => { val => \$e->{'read-write'}, type => 'bool' }
- );
- @l = @l[0..3] if $::beginner;
- } else {
- @l = (
-_("Root") => { val => \$name, list => [ map { "/dev/$_->{device}" } @{$o->{fstab}} ], not_edit => !$::expert },
-_("Table") => { val => \$e->{table}, list => [ map { "/dev/$_->{device}" } @{$o->{hds}} ], not_edit => !$::expert },
-_("Unsafe") => { val => \$e->{unsafe}, type => 'bool' }
- );
- @l = @l[0..1] if $::beginner;
- }
- @l = (
-_("Label") => \$e->{label},
-@l,
-_("Default") => { val => \$default, type => 'bool' },
- );
-
- $o->ask_from_entries_ref('',
- '',
- [ grep_index { even($::i) } @l ],
- [ grep_index { odd($::i) } @l ],
- ) or return;
-
- $b->{default} = $old_default ^ $default ? $default && $e->{label} : $b->{default};
-
- delete $b->{entries}{$old_name};
- $b->{entries}{$name} = $e;
- }
- eval { $o->SUPER::setupBootloader };
- if ($@) {
- $o->ask_warn('',
- [ _("Lilo failed. The following error occured:"),
- grep { !/^Warning:/ } cat_("$o->{prefix}/tmp/.error") ]);
- die "already displayed";
- }
-}
-
-#------------------------------------------------------------------------------
-sub exitInstall {
- my ($o, $alldone) = @_;
-
- return $o->{step} = '' unless $alldone || $o->ask_yesorno('',
-_("Some steps are not completed
-Do you really want to quit now?"), 0);
-
- $o->ask_warn('',
-_("Congratulations, installation is complete.
-Remove the boot media and press return to reboot.
-For information on fixes which are available for this release of Linux Mandrake,
-consult the Errata available from http://www.linux-mandrake.com/.
-Information on configuring your system is available in the post
-install chapter of the Official Linux Mandrake User's Guide.")) if $alldone;
-}
-
-
-#-######################################################################################
-#- Misc Steps Functions
-#-######################################################################################
-sub loadModule {
- my ($o, $type) = @_;
- my @options;
-
- my $l = $o->ask_from_list('',
- _("What %s card have you?", $type),
- [ modules::text_of_type($type) ]) or return;
- my $m = modules::text2driver($l);
-
- my @names = modparm::get_options_name($m);
-
- if ((!defined @names || @names > 0) && $o->ask_from_list('',
-_("In some cases, the %s driver needs to have extra information to work
-properly, although it normally works fine without. Would you like to specify
-extra options for it or allow the driver to probe your machine for the
-information it needs? Occasionally, probing will hang a computer, but it should
-not cause any damage.", $l),
- [ __("Autoprobe"), __("Specify options") ], "Autoprobe") ne "Autoprobe") {
- ASK:
- if (defined @names) {
- my @l = $o->ask_from_entries('',
-_("Here must give the different options for the module %s.", $l),
- \@names) or return;
- @options = modparm::get_options_result($m, @l);
- } else {
- @options = split ' ',
- $o->ask_from_entry('',
-_("Here must give the different options for the module %s.
-Options are in format ``name=value name2=value2 ...''.
-For example you can have ``io=0x300 irq=7''", $l),
- _("Module options:"),
- );
- }
- }
- eval { modules::load($m, $type, @options) };
- if ($@) {
- $o->ask_yesorno('',
-_("Loading of module %s failed
-Do you want to try again with other parameters?", $l), 1) or return;
- goto ASK;
- }
- $l, $m;
-}
-
-#------------------------------------------------------------------------------
-sub load_thiskind {
- my ($o, $type) = @_;
- my $w;
- modules::load_thiskind($type, sub {
- $w = $o->wait_message('',
- [ _("Installing driver for %s card %s", $type, $_->[0]),
- $::beginner ? () : _("(module %s)", $_->[1])
- ]);
- });
-}
-
-#------------------------------------------------------------------------------
-sub setup_thiskind {
- my ($o, $type, $auto, $at_least_one) = @_;
- my @l = $o->load_thiskind($type) unless $::expert && $o->ask_yesorno('', _("Skip %s pci probe", $type), 1);
- return if $auto && (@l || !$at_least_one);
- while (1) {
- my $msg = @l ?
- [ _("Found %s %s interfaces", join(", ", map { $_->[0] } @l), $type),
- _("Do you have another one?") ] :
- _("Do you have an %s interface?", $type);
-
- my $opt = [ __("Yes"), __("No") ];
- push @$opt, __("See hardware info") if $::expert;
- my $r = "Yes";
- $r = $o->ask_from_list_('', $msg, $opt, "No") unless $at_least_one && @l == 0;
- if ($r eq "No") { return }
- elsif ($r eq "Yes") {
- my @r = $o->loadModule($type) or return;
- push @l, \@r;
- } else {
- $o->ask_warn('', [ pci_probing::main::list() ]);
- }
- }
-}
-
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/install_steps_stdio.pm b/perl-install/install_steps_stdio.pm
deleted file mode 100644
index 651f3ba16..000000000
--- a/perl-install/install_steps_stdio.pm
+++ /dev/null
@@ -1,73 +0,0 @@
-package install_steps_stdio;
-
-use diagnostics;
-use strict;
-use vars qw(@ISA);
-
-@ISA = qw(install_steps_interactive interactive_stdio);
-
-use common qw(:common);
-use devices;
-use run_program;
-use interactive_stdio;
-use install_steps_interactive;
-use install_any;
-use log;
-
-1;
-
-sub enteringStep($$$) {
- my ($o, $step) = @_;
- print _("Starting step `%s'\n", $o->{steps}{$step}{text});
-}
-sub leavingStep {
- my ($o) = @_;
- print "--------\n";
-}
-
-sub installPackages {
- my $o = shift;
-
- my $old = \&log::ld;
- local *log::ld = sub {
- my $m = shift;
- if ($m =~ /^starting installing/) {
- my $name = first($_[0] =~ m|([^/]*)-.+?-|);
- print("installing package $name");
- } else { goto $old }
- };
- $o->SUPER::installPackages(@_);
-}
-
-
-sub setRootPassword($) {
- my ($o) = @_;
-
- my (%w);
- do {
- $w{password} and print "You must enter the same password, please try again\n";
- print "Password: "; $w{password} = $o->readln();
- print "Password (again for confirmation): ";
- } until ($w{password} eq $o->readln());
-
- $o->{default}{rootPassword} = $w{password};
- $o->SUPER::setRootPassword;
-}
-
-sub addUser($) {
- my ($o) = @_;
- my %w;
- print "\nCreating a normal user account:\n";
- print "Name: "; $w{name} = $o->readln() or return;
- do {
- $w{password} and print "You must enter the same password, please try again\n";
- print "Password: "; $w{password} = $o->readln();
- print "Password (again for confirmation): ";
- } until ($w{password} eq $o->readln());
- print "Real name: "; $w{realname} = $o->readln();
-
- $w{shell} = $o->ask_from_list('', 'Shell', [ install_any::shells($o) ], "/bin/bash");
-
- $o->{default}{user} = { map { $_ => $w{$_}->get_text } qw(name password realname shell) };
- $o->SUPER::addUser;
-}
diff --git a/perl-install/interactive.pm b/perl-install/interactive.pm
deleted file mode 100644
index ed2c79de4..000000000
--- a/perl-install/interactive.pm
+++ /dev/null
@@ -1,162 +0,0 @@
-package interactive;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-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.
-
-
-
-#-######################################################################################
-#- OO Stuff
-#-######################################################################################
-sub new($) {
- my ($type) = @_;
-
- bless {}, ref $type || $type;
-}
-
-
-#-######################################################################################
-#- Interactive functions
-#-######################################################################################
-sub ask_warn($$$) {
- my ($o, $title, $message) = @_;
- ask_from_list2($o, $title, $message, [ _("Ok") ]);
-}
-
-sub ask_yesorno($$$;$) {
- my ($o, $title, $message, $def) = @_;
- ask_from_list2_($o, $title, $message, [ __("Yes"), __("No") ], $def ? "Yes" : "No") eq "Yes";
-}
-
-sub ask_okcancel($$$;$) {
- my ($o, $title, $message, $def) = @_;
- ask_from_list2_($o, $title, $message, [ __("Ok"), __("Cancel") ], $def ? "Ok" : "Cancel") eq "Ok";
-}
-
-sub ask_from_list_ {
- my ($o, $title, $message, $l, $def) = @_;
- @$l == 0 and die '';
- @$l == 1 and return $l->[0];
- goto &ask_from_list2_;
-}
-
-sub ask_from_list {
- my ($o, $title, $message, $l, $def) = @_;
- @$l == 0 and die '';
- @$l == 1 and return $l->[0];
- goto &ask_from_list2;
-}
-
-sub ask_from_list2_($$$$;$) {
- my ($o, $title, $message, $l, $def) = @_;
- untranslate(
- ask_from_list($o, $title, $message, [ map { translate($_) } @$l ], translate($def)),
- @$l);
-}
-
-sub ask_from_list2($$$$;$) {
- my ($o, $title, $message, $l, $def) = @_;
-
- $message = ref $message ? $message : [ $message ];
-
- @$l > 10 and $l = [ sort @$l ];
-
- $o->ask_from_listW($title, $message, $l, $def || $l->[0]);
-}
-sub ask_many_from_list_ref($$$$;$) {
- my ($o, $title, $message, $l, $val) = @_;
-
- $message = ref $message ? $message : [ $message ];
-
- $o->ask_many_from_list_refW($title, $message, $l, $val);
-}
-sub ask_many_from_list($$$$;$) {
- my ($o, $title, $message, $l, $def) = @_;
-
- my $val = [ map { my $i = $_; \$i } @$def ];
-
- $o->ask_many_from_list_ref($title, $message, $l, $val) ?
- [ map { $$_ } @$val ] : undef;
-}
-
-sub ask_from_entry {
- my ($o, $title, $message, $label, $def, %callback) = @_;
-
- $message = ref $message ? $message : [ $message ];
- first ($o->ask_from_entries($title, $message, [ $label ], [ $def ], %callback));
-}
-
-sub ask_from_entries($$$$;$%) {
- my ($o, $title, $message, $l, $def, %callback) = @_;
-
- my $val = [ map { my $i = $_; \$i } @{$def || [('') x @$l]} ];
-
- $o->ask_from_entries_ref($title, $message, $l, $val, %callback) ?
- 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
-sub ask_from_entries_ref($$$$;$%) {
- my ($o, $title, $message, $l, $val, %callback) = @_;
-
- return unless @$l;
-
- $message = ref $message ? $message : [ $message ];
-
- my $val_hash = [ map {
- if ((ref $_) eq "SCALAR") {
- { val => $_ }
- } else {
- ($_->{list} && (@{$_->{list}} > 1)) ?
- { %$_, type => "list"} : $_;
- }
- } @$val ];
-
- $o->ask_from_entries_refW($title, $message, $l, $val_hash, %callback)
-
-}
-sub wait_message($$$) {
- my ($o, $title, $message) = @_;
-
- $message = ref $message ? $message : [ $message ];
-
- my $w = $o->wait_messageW($title, [ _("Please wait"), @$message ]);
- my $b = before_leaving { $o->wait_message_endW($w) };
-
- #- enable access through set
- common::add_f4before_leaving(sub { $o->wait_message_nextW($_[1], $w) }, $b, 'set');
- $b;
-}
-
-sub kill {}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm
deleted file mode 100644
index 3247f177c..000000000
--- a/perl-install/keyboard.pm
+++ /dev/null
@@ -1,154 +0,0 @@
-
-package keyboard;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :system :file);
-use run_program;
-use install_any;
-use log;
-use c;
-
-
-#-######################################################################################
-#- Globals
-#-######################################################################################
-my $KMAP_MAGIC = 0x8B39C07F;
-
-my %lang2keyboard =
-(
- "en" => "us",
-);
-
-#- [1] = name for loadkeys, [2] = extension for Xmodmap
-my %keyboards = (
-#- 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" ],
- "de" => [ __("German"), "de-latin1", "de" ],
- "dk" => [ __("Danish"), "dk-latin1", "dk" ],
-"dvorak" => [ __("Dvorak"), "dvorak", "dvorak" ],
- "ee" => [ __("Estonian"), "ee-latin9", "ee" ],
- "es" => [ __("Spanish"), "es-latin1", "es" ],
- "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"],
- "gr" => [ __("Greek"), "gr-8859_7", "gr" ],
- "hu" => [ __("Hungarian"), "hu-latin2", "hu" ],
- "il" => [ __("Israelian"), "il-8859_8", "il" ],
- "is" => [ __("Icelandic"), "is-latin1", "is" ],
- "it" => [ __("Italian"), "it-latin1", "it" ],
- "la" => [ __("Latin American"), "la-latin1", "la" ],
- "nl" => [ __("Dutch"), "nl-latin1", "nl" ],
- "no" => [ __("Norwegian"), "no-latin1", "no" ],
- "pl" => [ __("Polish"), "pl-latin2", "pl" ],
- "pt" => [ __("Portuguese"), "pt-latin1", "pt" ],
- "qc" => [ __("Canadian (Quebec)"), "qc-latin1","qc" ],
- "ru" => [ __("Russian"), "ru-koi8", "ru" ],
- "se" => [ __("Swedish"), "se-latin1", "se" ],
- "sf" => [ __("Swiss (french layout)"), "sf-latin1", "sf" ],
- "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" ],
- "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" ],
- "us" => [ __("US keyboard"), "us-latin", "us" ],
- "yu" => [ __("Yugoslavian (latin layout)"), "yu-latin2", "yu" ],
-);
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-sub list { map { $_->[0] } values %keyboards }
-sub xmodmaps { map { $_->[2] } values %keyboards }
-sub keyboard2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] }
-sub text2keyboard {
- my ($t) = @_;
- while (my ($k, $v) = each %keyboards) {
- lc($v->[0]) eq lc($t) and return $k;
- }
- die "unknown keyboard $t";
-}
-
-sub kmap($) {
- my ($keyboard) = @_;
- ($keyboards{$keyboard} || [])->[1];
-}
-
-sub lang2keyboard($) {
- local ($_) = @_;
- $keyboards{$_} && $_ || $lang2keyboard{$_} || substr($_, 0, 2);
-}
-
-sub load($) {
- my ($keymap) = @_;
-
- my ($magic, @keymaps) = unpack "I i" . c::MAX_NR_KEYMAPS() . "a*", $keymap;
- $keymap = pop @keymaps;
-
- $magic != $KMAP_MAGIC and die "failed to read kmap magic";
-
- local *F;
- sysopen F, "/dev/console", 2 or die "failed to open /dev/console: $!";
-
- my $count = 0;
- foreach (0 .. c::MAX_NR_KEYMAPS() - 1) {
- $keymaps[$_] or next;
-
- my @keymap = unpack "s" . c::NR_KEYS() . "a*", $keymap;
- $keymap = pop @keymap;
-
- my $key = -1;
- foreach my $value (@keymap) {
- $key++;
- c::KTYP($value) != c::KT_SPEC() or next;
- ioctl(F, c::KDSKBENT(), pack("CCS", $_, $key, $value)) or die "keymap ioctl failed ($_ $key $value): $!";
- }
- $count++;
- }
- log::l("loaded $count keymap tables");
-}
-
-sub setup($) {
- my ($keyboard) = @_;
- my $o = $keyboards{$keyboard} or return;
-
- if (my $file = install_any::install_cpio("/usr/share/keymaps", "$o->[1].kmap")) {
- log::l("loading keymap $o->[1]");
- load(cat_($file)) if -e $file;
- }
- if (my $file = install_any::install_cpio("/usr/share/xmodmap", "xmodmap.$o->[2]")) {
- eval { run_program::run('xmodmap', $file) } unless $::testing;
- }
-}
-
-sub write($$) {
- my ($prefix, $keyboard) = @_;
-
- setVarsInSh("$prefix/etc/sysconfig/keyboard", { KEYTABLE => kmap($keyboard) });
-
- run_program::rooted($prefix, "dumpkeys > /etc/sysconfig/console/default.kmap") or die "dumpkeys failed";
-}
-
-sub read($) {
- my ($prefix) = @_;
-
- my %keyf = getVarsFromSh("$prefix/etc/sysconfig/keyboard");
- map { kmap($_) eq $keyf{KEYTABLE} ? $_ : (); } keys %keyboards;
-}
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
deleted file mode 100644
index 724f63f18..000000000
--- a/perl-install/lang.pm
+++ /dev/null
@@ -1,233 +0,0 @@
- package lang;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:file);
-use commands;
-use install_any;
-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)
-my %languages = (
- 'en' => [ 'English', undef, 'en', 'en_US' ],
- 'hy' => [ 'Armenian', 'armscii-8', 'hy', 'hy' ],
-'zh_TW.Big5' => [ 'Chinese (Big5)', 'Big5', 'zh_TW.Big5', 'zh_TW.Big5:zh_TW.big5' ],
-'fr_FR' => [ 'French (France)', 'iso-8859-1', 'fr', 'fr_FR' ],
- 'ka' => [ 'Georgian', 'georgian-academy', 'ka', 'ka' ],
-'de_DE' => [ 'German (Germany)', 'iso-8859-1', 'de', 'de_DE' ],
- 'el' => [ 'Greek', 'iso-8859-7', 'el', 'el' ],
- 'hu' => [ 'Hungarian', 'iso-8859-2', 'hu', 'hu' ],
- 'is' => [ 'Icelandic', 'iso-8859-1', 'is', 'is' ],
-#- 'in' was the old code for indonesian language; by putting LANGUAGE=id:in
-#- we catch the few catalog files still using the wrong code
- 'id' => [ 'Indonesian', 'iso-8859-1', 'id', 'id:in' ],
- 'it' => [ 'Italian', 'iso-8859-1', 'it', 'it_IT' ],
- 'ja' => [ 'Japanese', 'jisx0208', 'ja', 'ja_JP.ujis' ],
- 'ko' => [ 'Korean', 'ksc5601', 'ko', 'ko' ],
- 'no' => [ 'Norwegian (Bokmaal)', 'iso-8859-1', 'no', 'no:no@nynorsk' ],
-'no@nynorsk' => [ 'Norwegian (Nynorsk)','iso-8859-1','no', 'no@nynorsk' ],
-'pt_BR' => [ 'Portuguese (Brazil)', 'iso-8859-1', 'pt', 'pt_BR:pt_PT' ],
-'pt_PT' => [ 'Portuguese (Portugal)', 'iso-8859-1', 'pt', 'pt_PT:pt_BR' ],
- 'ro' => [ 'Romanian', 'iso-8859-2', 'ro', 'ro' ],
- 'ru' => [ 'Russian', 'koi8-r', 'ru', 'ru' ],
- 'sk' => [ 'Slovak', 'iso-8859-2', 'sk', 'sk' ],
-'es_ES' => [ 'Spanish (Spain)', 'iso-8859-1', 'es', 'es' ],
- 'tr' => [ 'Turkish', 'iso-8859-9', 'tr', 'tr' ],
- 'uk' => [ 'Ukrainian', 'koi8-u', 'uk', 'uk' ],
- 'vi' => [ 'Vietnamese (TCVN)', 'tcvn', 'vi',
- 'vi_VN.tcvn:vi_VN.tcvn-5712' ],
-'vi_VN.viscii' => [ 'Vietnamese (VISCII)','viscii', 'vi',
- 'vi_VN.viscii:vi_VN.tcvn-viscii1.1-1' ],
- 'wa' => [ 'Walon', 'iso-8859-1', 'wa', 'wa:fr_BE' ],
-);
-
-my %charsets = (
- "armscii-8" => [ "arm8", "armscii8",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-*helv*-medium-r-normal--14-*-*-*-*-armscii-8" ],
-#- chinese needs special console driver for text mode
- "Big5" => [ "?????", "????",
- "*-helvetica-medium-r-normal--14-*-*-*-*-*-iso8859-1," .
- "-taipei-*-medium-r-normal--16-*-*-*-*-*-big5-0" ],
- "iso-8859-1" => [ "lat0-sun16", "iso15",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1" ],
- "iso-8859-2" => [ "lat2-sun16", "iso02",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-2" ],
- "iso-8859-3" => [ "iso03.f16", "iso03",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-3" ],
- "iso-8859-4" => [ "lat4u-16", "iso04",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-4" ],
- "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)
- "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)
- "iso-8859-8" => [ "iso08.f16", "iso08",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-8" ],
- "iso-8859-9" => [ "lat5-16", "iso09",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-9" ],
- "iso-8859-15" => [ "lat0-sun16", "iso15",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-15" ],
-#- japanese needs special console driver for text mode [kon2]
- "jisx0208" => [ "????", "????",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "-*-*-medium-r-normal--14-*-*-*-*-*-jisx0208.*-0," .
- "-*-*-medium-r-normal--14-*-*-*-*-*-jisx0201.*-0" ],
- "koi8-r" => [ "Cyr_a8x16", "koi2alt",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-koi8-r" ],
- "koi8-u" => [ "ruscii_8x16", "koi2alt",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-koi8-u" ],
-#- korean needs special console driver for text mode
- "ksc5601" => [ "?????", "?????",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "-*-*-medium-*-*--14-*-*-*-*-*-ksc5601.1987-*" ],
- "tcvn" => [ "tcvn8x16", "tcvn",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-tcvn-5712" ],
- "viscii" => [ "viscii10-8x16", "viscii",
- "*-helvetica-medium-r-normal--14-*-*-*-*-iso8859-1," .
- "*-helvetica-medium-r-normal--14-*-*-*-*-viscii1.1-1" ],
-);
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-
-sub list { map { $_->[0] } values %languages }
-sub lang2text { $languages{$_[0]} && $languages{$_[0]}[0] }
-sub text2lang {
- my ($t) = @_;
- while (my ($k, $v) = each %languages) {
- lc($v->[0]) eq lc($t) and return $k;
- }
- die "unknown language $t";
-}
-
-sub set {
- my ($lang, $prefix) = @_;
-
- if ($lang) {
- $ENV{LC_ALL} = $lang;
- $ENV{LANG} = $languages{$lang}[2];
- $ENV{LANGUAGES} = $languages{$lang}[3];
- } else {
- # stick with the default (English) */
- delete $ENV{LANG};
- delete $ENV{LC_ALL};
- delete $ENV{LINGUAS};
- }
- install_any::install_cpio("/usr/share/locale", $lang);
-}
-
-sub write {
- my ($prefix) = @_;
- my $lang = $ENV{LC_ALL};
-
- $lang or return;
- local *F;
- open F, "> $prefix/etc/sysconfig/i18n" or die "failed to reset $prefix/etc/sysconfig/i18n for writing";
- my $f = sub { $_[1] and print F "$_[0]=$_[1]\n"; };
-
- &$f("LC_ALL", $lang);
- if (my $l = $languages{$lang}) {
- &$f("LANG", $l->[2]);
- &$f("LANGUAGE", $l->[3]);
-
- $l->[1] or return;
- if (my $c = $charsets{$l->[1]}) {
- &$f("SYSFONT", $c->[0]);
- &$f("SYSFONTACM", $c->[1]);
-
- my $p = "$prefix/usr/lib/kbd";
- commands::cp("-f",
- "$p/consolefonts/$c->[0].psf.gz",
- glob_("$p/consoletrans/$c->[1]*"),
- "$prefix/etc/sysconfig/console");
- }
- }
-}
-
-sub load_po($) {
- my ($lang) = @_;
- my ($s, $from, $to, $state, $fuzzy);
-
- $s .= "package po::I18N;\n";
- $s .= "\%$lang = (";
-
- my $f; -e ($f = "$_/po/$lang.po") and last foreach @INC;
- local *F; open F, $f or return;
- foreach (<F>) {
- /^msgstr/ and $state = 1;
- /^msgid/ && !$fuzzy and $state = 2;
-
- if (/^(#|$)/ && $state != 3) {
- $state = 3;
- $s .= qq("$from" => "$to",\n) if $from;
- $from = $to = '';
- }
- $to .= (/"(.*)"/)[0] if $state == 1;
- $from .= (/"(.*)"/)[0] if $state == 2;
-
- $fuzzy = /^#, fuzzy/;
- }
- $s .= ");";
- no strict "vars";
- eval $s;
- !$@;
-}
-
-
-#-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;
diff --git a/perl-install/log.pm b/perl-install/log.pm
deleted file mode 100644
index e29dc410e..000000000
--- a/perl-install/log.pm
+++ /dev/null
@@ -1,47 +0,0 @@
-package log;
-
-use diagnostics;
-use strict;
-
-
-#-#####################################################################################
-#- Globals
-#-#####################################################################################
-my $logOpen = 0;
-my $logDebugMessages = 0;
-
-
-#-######################################################################################
-#- Functions
-#-######################################################################################
-sub fd() { fileno LOG }
-
-sub l {
- $logOpen or openLog();
- print LOG "* ", @_, "\n";
- print LOG2 "* ", @_, "\n";
-}
-sub ld { $logDebugMessages and &l }
-sub w { &l }
-
-sub openLog(;$) {
- if ($::isStandalone) {
- open LOG, ">&STDERR";
- } 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 :(";
- }
- open LOG2, ">> /tmp/ddebug.log";# or die "no log possible :(";
- select((select(LOG), $| = 1)[0]);
- select((select(LOG2), $| = 1)[0]);
- exists $ENV{DEBUG} and $logDebugMessages = 1;
- $logOpen = 1;
-}
-
-sub closeLog() { close LOG; close LOG2; }
-
-#-######################################################################################
-#- Wonderful perl :(
-#-######################################################################################
-1;
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
deleted file mode 100644
index a829247fc..000000000
--- a/perl-install/modules.pm
+++ /dev/null
@@ -1,324 +0,0 @@
-package modules;
-
-use diagnostics;
-use strict;
-
-use common qw(:common :file);
-use pci_probing::main;
-use detect_devices;
-use run_program;
-use log;
-
-
-my %conf;
-my $scsi = 0;
-my %deps = ();
-
-my @drivers_by_category = (
-[ \&detect_devices::hasEthernet, 'net', 'ethernet', {
- "3c509" => "3com 3c509",
- "3c501" => "3com 3c501",
- "3c503" => "3com 3c503",
- "3c505" => "3com 3c505",
- "3c507" => "3com 3c507",
- "3c515" => "3com 3c515",
- "3c59x" => "3com 3c59x (Vortex)",
- "3c59x" => "3com 3c90x (Boomerang)",
- "at1700" => "Allied Telesis AT1700",
- "ac3200" => "Ansel Communication AC3200",
- "pcnet32" => "AMD PC/Net 32",
- "apricot" => "Apricot 82596",
- "atp" => "ATP",
- "e2100" => "Cabletron E2100",
- "tlan" => "Compaq Netelligent",
- "de4x5" => "Digital 425,434,435,450,500",
- "depca" => "Digital DEPCA and EtherWORKS",
- "ewrk3" => "Digital EtherWORKS 3",
- "tulip" => "Digital 21040 (Tulip)",
- "de600" => "D-Link DE-600 pocket adapter",
- "de620" => "D-Link DE-620 pocket adapter",
- "epic100" => "EPIC 100",
- "hp100" => "HP10/100VG any LAN ",
- "hp" => "HP LAN/AnyLan",
- "hp-plus" => "HP PCLAN/plus",
- "eth16i" => "ICL EtherTeam 16i",
- "eexpress" => "Intel EtherExpress",
- "eepro" => "Intel EtherExpress Pro",
- "eepro100" => "Intel EtherExpress Pro 100",
- "lance" => "Lance",
- "lne390" => "Mylex LNE390",
- "ne" => "NE2000 and compatible",
- "ne2k-pci" => "NE2000 PCI",
- "ne3210" => "NE3210",
- "ni5010" => "NI 5010",
- "ni52" => "NI 5210",
- "ni65" => "NI 6510",
- "rtl8139" => "RealTek RTL8129/8139",
- "es3210" => "Racal-Interlan ES3210",
- "rcpci45" => "RedCreek PCI45 LAN",
- "epic100" => "SMC 83c170 EPIC/100",
- "smc9194" => "SMC 9000 series",
- "smc-ultra" => "SMC Ultra",
- "smc-ultra32" => "SMC Ultra 32",
- "via-rhine" => "VIA Rhine",
- "wd" => "WD8003, WD8013 and compatible",
-}],
-[ \&detect_devices::hasSCSI, 'scsi', undef, {
- "aha152x" => "Adaptec 152x",
- "aha1542" => "Adaptec 1542",
- "aha1740" => "Adaptec 1740",
- "aic7xxx" => "Adaptec 2740, 2840, 2940",
- "advansys" => "AdvanSys Adapters",
- "in2000" => "Always IN2000",
- "AM53C974" => "AMD SCSI",
- "megaraid" => "AMI MegaRAID",
- "BusLogic" => "BusLogic Adapters",
- "cpqarray" => "Compaq Smart-2/P RAID Controller",
- "dtc" => "DTC 3180/3280",
- "eata_dma" => "EATA DMA Adapters",
- "eata_pio" => "EATA PIO Adapters",
- "seagate" => "Future Domain TMC-885, TMC-950",
- "fdomain" => "Future Domain TMC-16x0",
- "gdth" => "ICP Disk Array Controller",
- "ppa" => "Iomega PPA3 (parallel port Zip)",
- "g_NCR5380" => "NCR 5380",
- "NCR53c406a" => "NCR 53c406a",
- "53c7,8xx" => "NCR 53c7xx",
- "ncr53c8xx" => "NCR 53C8xx PCI",
- "pci2000" => "Perceptive Solutions PCI-2000",
- "pas16" => "Pro Audio Spectrum/Studio 16",
- "qlogicfas" => "Qlogic FAS",
- "qlogicisp" => "Qlogic ISP",
- "seagate" => "Seagate ST01/02",
- "t128" => "Trantor T128/T128F/T228",
- "u14-34f" => "UltraStor 14F/34F",
- "ultrastor" => "UltraStor 14F/24F/34F",
- "wd7000" => "Western Digital wd7000",
-}],
-[ undef, 'cdrom', 'none', {
- "sbpcd" => "SoundBlaster/Panasonic",
- "aztcd" => "Aztech CD",
- "bpcd" => "Backpack CDROM",
- "gscd" => "Goldstar R420",
- "mcd" => "Mitsumi",
- "mcdx" => "Mitsumi (alternate)",
- "optcd" => "Optics Storage 8000",
- "cm206" => "Phillips CM206/CM260",
- "sjcd" => "Sanyo",
- "cdu31a" => "Sony CDU-31A",
- "sonycd535" => "Sony CDU-5xx",
-}]
-);
-
-my @drivers_fields = qw(text detect type minor);
-my %drivers = (
- "plip" => [ "PLIP (parallel port)", \&detect_devices::hasPlip, 'net', 'plip' ],
- "ibmtr" => [ "Token Ring", \&detect_devices::hasTokenRing, 'net', 'tr' ],
- "DAC960" => [ "Mylex DAC960", undef, 'scsi', undef ],
- "pcmcia_core" => [ "PCMCIA core support", undef, 'pcmcia', undef ],
- "ds" => [ "PCMCIA card support", undef, 'pcmcia', undef ],
- "i82365" => [ "PCMCIA i82365 controller", undef, 'pcmcia', undef ],
- "tcic" => [ "PCMCIA tcic controller", undef, 'pcmcia', undef ],
- "isofs" => [ "iso9660", undef, 'fs', undef ],
- "nfs" => [ "Network File System (nfs)", undef, 'fs', undef ],
- "smbfs" => [ "Windows SMB", undef, 'fs', undef ],
- "loop" => [ "Loopback device", undef, 'other', undef ],
- "lp" => [ "Parallel Printer", undef, 'other', undef ],
-);
-foreach (@drivers_by_category) {
- my @l = @$_;
- my $l = pop @l;
- foreach (keys %$l) { $drivers{$_} = [ $l->{$_}, @l ]; }
-}
-while (my ($k, $v) = each %drivers) {
- my %l; @l{@drivers_fields} = @$v;
- $drivers{$k} = \%l;
-}
-
-
-1;
-
-
-sub text_of_type($) {
- my ($type) = @_;
-
- map { $_->{text} } grep { $_->{type} eq $type } values %drivers;
-}
-
-sub text2driver($) {
- my ($text) = @_;
- while (my ($k, $v) = each %drivers) {
- $v->{text} eq $text and return $k;
- }
- die "$text is not a valid module description";
-}
-
-
-sub load($;$@) {
- my ($name, $type, @options) = @_;
-
- if ($::testing) {
- print join ",", @options, "\n";
- log::l("i try to install $name module (@options)");
- } else {
- $conf{$name}{loaded} and return;
-
- $type ||= $drivers{$name}{type};
-
- load($_, 'prereq') foreach @{$deps{$name}};
- load_raw($name, @options);
- }
-
- $conf{'scsi_hostadapter' . ($scsi++ || '')}{alias} = $name
- if $type && $type eq 'scsi';
-
- $conf{$name}{options} = join " ", @options if @options;
-}
-
-sub unload($) {
- if ($::testing) {
- log::l("rmmod $_[0]");
- } else {
- run_program::run("rmmod", $_[0]);
- }
-}
-
-sub load_raw($@) {
- my ($name, @options) = @_;
-
- run_program::run("insmod", $name, @options) or die("insmod $name failed");
-
- #- this is a hack to make plip go
- if ($name eq "parport_pc") {
- foreach (@options) {
- /^irq=(\d+)/ or next;
- log::l("writing to /proc/parport/0/irq");
- local *F;
- open F, "> /proc/parport/0/irq" or last;
- print F $1;
- }
- }
- $conf{$name}{loaded} = 1;
-}
-
-sub read_already_loaded() {
- foreach (cat_("/proc/modules", "die")) {
- my ($name) = split;
- $conf{$name}{loaded} = 1;
- }
-}
-
-sub load_deps($) {
- my ($file) = @_;
-
- local *F;
- open F, $file or log::l("error opening $file: $!"), return 0;
- foreach (<F>) {
- my ($f, $deps) = split ':';
- push @{$deps{$f}}, split ' ', $deps;
- }
-}
-
-sub read_conf($;$) {
- my ($file, $scsi) = @_;
- my %c;
-
- foreach (cat_($file)) {
- do {
- $c{$2}{$1} = $3;
- $$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
- while (my ($k, $v) = each %c) {
- $$scsi ||= $v->{scsi_hostadapter} if $scsi;
- if (my $a = $v->{alias}) {
- local $c{$a}{alias};
- add2hash($c{$a}, $v);
- }
- }
- %c;
-}
-
-sub write_conf {
- my ($file) = @_;
- my %written = read_conf($file);
-
- my %net = detect_devices::net2module();
- while (my ($k, $v) = each %net) {
- $conf{$k}{alias} ||= $v;
- }
-
- local *F;
- open F, ">> $file" or die("cannot write module config file $file: $!\n");
-
- while (my ($mod, $h) = each %conf) {
- while (my ($type, $v2) = each %$h) {
- print F "$type $mod $v2\n" if $v2 && $type ne "loaded" && !$written{$mod}{$type};
- }
- }
-}
-
-sub get_stage1_conf {
- %conf = read_conf($_[1], \$scsi);
- add2hash(\%conf, $_[0]);
- $conf{parport_lowlevel}{alias} ||= "parport_pc";
- $conf{pcmcia_core}{"pre-install"} ||= "/etc/rc.d/init.d/pcmcia start";
- $conf{plip}{"pre-install"} ||= "modprobe parport_pc ; echo 7 > /proc/parport/0/irq";
- \%conf;
-}
-
-sub load_thiskind($;&) {
- my ($type, $f) = @_;
-
- my @pcidevs = pci_probing::main::probe($type);
- log::l("pci probe found " . scalar @pcidevs . " $type devices");
-
- my @pcmciadevs = get_pcmcia_devices($type);
- log::l("pcmcia probe found " . scalar @pcmciadevs . " $type devices");
-
- my @devs = (@pcidevs, @pcmciadevs);
-
- my %devs; foreach (@devs) {
- my ($text, $mod) = @$_;
- $devs{$mod}++ and log::l("multiple $mod devices found"), next;
- $drivers{$mod} or log::l("module $mod not in install table"), next;
- log::l("found driver for $mod");
- &$f($text, $mod) if $f;
- load($mod, $type);
- }
- @devs;
-}
-
-sub get_pcmcia_devices($) {
- my ($type) = @_;
- my $file = "/var/run/stab";
- my @devs;
- my $module;
- my $desc;
-
- local *F;
- open F, $file or return; #- no pcmcia is not an error.
- while (<F>) {
- $desc = $1 if /^Socket\s+\d+:\s+(.*)/;
- $module = $1 if /^\d+\s+$type[^\s]*\s+([^\s]+)/;
- if ($desc && $module) {
- push @devs, [ $desc, $module ];
- $desc = $module = undef;
- }
- }
- @devs;
-}
-
-#-#- 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/mouse.pm b/perl-install/mouse.pm
deleted file mode 100644
index 27979ea8d..000000000
--- a/perl-install/mouse.pm
+++ /dev/null
@@ -1,87 +0,0 @@
-package mouse;
-
-use diagnostics;
-use strict;
-
-#-######################################################################################
-#- misc imports
-#-######################################################################################
-use common qw(:common :system :functional);
-use modules;
-use log;
-
-my @mouses_fields = qw(nbuttons device MOUSETYPE XMOUSETYPE FULLNAME);
-my @mouses = (
- [ 0, "none", "none", "Microsoft", __("No Mouse") ],
- [ 2, "ttyS", "pnp", "Auto", __("Microsoft Rev 2.1A or higher (serial)") ],
- [ 3, "ttyS", "logim", "MouseMan", __("Logitech CC Series (serial)") ],
- [ 5, "ttyS", "pnp", "IntelliMouse", __("Logitech MouseMan+/FirstMouse+ (serial)") ],
- [ 5, "ttyS", "ms3", "IntelliMouse", __("ASCII MieMouse (serial)") ],
- [ 5, "ttyS", "ms3", "IntelliMouse", __("Genius NetMouse (serial)") ],
- [ 5, "ttyS", "ms3", "IntelliMouse", __("Microsoft IntelliMouse (serial)") ],
- [ 2, "ttyS", "MMSeries", "MMSeries", __("MM Series (serial)") ],
- [ 2, "ttyS", "MMHitTab", "MMHittab", __("MM HitTablet (serial)") ],
- [ 3, "ttyS", "Logitech", "Logitech", __("Logitech Mouse (serial, old C7 type)") ],
- [ 3, "ttyS", "MouseMan", "MouseMan", __("Logitech MouseMan/FirstMouse (serial)") ],
- [ 2, "ttyS", "Microsoft", "Microsoft", __("Generic Mouse (serial)") ],
- [ 2, "ttyS", "Microsoft", "Microsoft", __("Microsoft compatible (serial)") ],
- [ 3, "ttyS", "Microsoft", "Microsoft", __("Generic 3 Button Mouse (serial)") ],
- [ 2, "ttyS", "MouseSystems", "MouseSystems", __("Mouse Systems (serial)") ],
- [ 2, "psaux", "ps/2", "PS/2", __("Generic Mouse (PS/2)") ],
- [ 3, "psaux", "ps/2", "PS/2", __("Logitech MouseMan/FirstMouse (ps/2)") ],
- [ 3, "psaux", "ps/2", "PS/2", __("Generic 3 Button Mouse (PS/2)") ],
- [ 2, "psaux", "ps/2", "GlidePointPS/2", __("ALPS GlidePoint (PS/2)") ],
- [ 5, "psaux", "ps/2", "MouseManPlusPS/2", __("Logitech MouseMan+/FirstMouse+ (PS/2)") ],
- [ 5, "psaux", "ps/2", "ThinkingMousePS/2", __("Kensington Thinking Mouse (PS/2)") ],
- [ 5, "psaux", "ps/2", "NetMousePS/2", __("ASCII MieMouse (PS/2)") ],
- [ 5, "psaux", "netmouse", "NetMousePS/2", __("Genius NetMouse (PS/2)") ],
- [ 5, "psaux", "netmouse", "NetMousePS/2", __("Genius NetMouse Pro (PS/2)") ],
- [ 5, "psaux", "netmouse", "NetScrollPS/2", __("Genius NetScroll (PS/2)") ],
- [ 5, "psaux", "imps2", "IMPS/2", __("Microsoft IntelliMouse (PS/2)") ],
- [ 2, "atibm", "Busmouse", "BusMouse", __("ATI Bus Mouse") ],
- [ 2, "inportbm", "Busmouse", "BusMouse", __("Microsoft Bus Mouse") ],
- [ 3, "logibm", "Busmouse", "BusMouse", __("Logitech Bus Mouse") ],
-);
-map_index {
- my %l; @l{@mouses_fields} = @$_;
- $mouses[$::i] = \%l;
-} @mouses;
-
-sub names { map { $_->{FULLNAME} } @mouses }
-
-sub name2mouse {
- my ($name) = @_;
- foreach (@mouses) {
- return { %$_ } if $name eq $_->{FULLNAME};
- }
- die "$name not found";
-}
-
-sub serial_ports_names {
- map { "ttyS" . ($_ - 1) . " / COM$_" } 1..4;
-}
-sub serial_ports_names2dev {
- local ($_) = @_;
- /(\w+)/;
-}
-
-sub read($) {
- my ($prefix) = @_;
- my %mouse = getVarsFromSh "$prefix/etc/sysconfig/mouse";
- $mouse{device} = readlink "$prefix/dev/mouse" or log::l("reading $prefix/dev/mouse symlink failed");
- %mouse;
-}
-
-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");
-}
-
-sub detect() {
- my %l;
- eval { modules::load("serial") };
- @l{qw(FULLNAME nbuttons MOUSETYPE XMOUSETYPE device)} = split("\n", `mouseconfig --nointeractive 2>/dev/null`) or die "mouseconfig failed";
- \%l;
-}
diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm
deleted file mode 100644
index 9cb2aee6f..000000000
--- a/perl-install/partition_table.pm
+++ /dev/null
@@ -1,488 +0,0 @@
-package partition_table;
-
-use diagnostics;
-use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @important_types @fields2save);
-
-@ISA = qw(Exporter);
-%EXPORT_TAGS = (
- types => [ qw(type2name type2fs name2type fs2type isExtended isExt2 isSwap isDos isWin isPrimary isNfs) ],
-);
-@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
-
-
-use common qw(:common :system :functional);
-use partition_table_raw;
-use Data::Dumper;
-
-
-@important_types = ("Linux native", "Linux swap", "DOS FAT16", "Win98 FAT32");
-
-@fields2save = qw(primary extended totalsectors);
-
-
-my %types = (
- 0 => "Empty",
- 1 => "DOS 12-bit FAT",
- 2 => "XENIX root",
- 3 => "XENIX usr",
- 4 => "DOS 16-bit <32M",
- 5 => "Extended",
- 6 => "DOS FAT16",
- 7 => "OS/2 HPFS", #- or QNX?
- 8 => "AIX",
- 9 => "AIX bootable",
- 10 => "OS/2 Boot Manager",
- 0xb => "Win98 FAT32 0xb",
- 0xc => "Win98 FAT32",
- 0xe => "Win98 FAT32 0xd",
- 0xf => "Win95 Ext'd (LBA)",
- 0x12 => "Compaq setup",
- 0x40 => "Venix 80286",
- 0x51 => "Novell?",
- 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
-
- 0x81 => "Linux/MINIX", #- Minix 1.4b and later
- 0x82 => "Linux swap",
- 0x83 => "Linux native",
-
- 0x93 => "Amoeba",
- 0x94 => "Amoeba BBT", #- (bad block table)
- 0xa5 => "BSD/386",
- 0xb7 => "BSDI fs",
- 0xb8 => "BSDI swap",
- 0xc7 => "Syrinx",
- 0xdb => "CP/M", #- or Concurrent DOS?
- 0xe1 => "DOS access",
- 0xe3 => "DOS R/O",
- 0xf2 => "DOS secondary",
- 0xff => "BBT" #- (bad track table)
-);
-
-my %type2fs = (
- 0x01 => 'vfat',
- 0x04 => 'vfat',
- 0x05 => 'ignore',
- 0x06 => 'vfat',
- 0x07 => 'hpfs',
- 0x0b => 'vfat',
- 0x0c => 'vfat',
- 0x0e => 'vfat',
- 0x82 => 'swap',
- 0x83 => 'ext2',
- nfs => 'nfs', #- hack
-);
-my %types_rev = reverse %types;
-my %fs2type = reverse %type2fs;
-
-
-1;
-
-sub important_types { $_[0] and return sort values %types; @important_types }
-
-sub type2name($) { $types{$_[0]} || 'unknown' }
-sub type2fs($) { $type2fs{$_[0]} }
-sub name2type($) { $types_rev{$_[0]} }
-sub fs2type($) { $fs2type{$_[0]} }
-
-sub isExtended($) { $_[0]{type} == 5 || $_[0]{type} == 0xf }
-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 isPrimary($$) {
- my ($part, $hd) = @_;
- foreach (@{$hd->{primary}{raw}}) { $part eq $_ and return 1; }
- 0;
-}
-
-sub cylinder_size($) {
- my ($hd) = @_;
- $hd->{geom}{sectors} * $hd->{geom}{heads};
-}
-
-sub adjustStart($$) {
- my ($hd, $part) = @_;
- my $end = $part->{start} + $part->{size};
-
- $part->{start} = round_up($part->{start},
- $part->{start} % cylinder_size($hd) < 2 * $hd->{geom}{sectors} ?
- $hd->{geom}{sectors} : cylinder_size($hd));
- $part->{size} = $end - $part->{start};
-}
-sub adjustEnd($$) {
- my ($hd, $part) = @_;
- my $end = $part->{start} + $part->{size};
- my $end2 = round_down($end, cylinder_size($hd));
- unless ($part->{start} < $end2) {
- $end2 = round_up($end, cylinder_size($hd));
- }
- $part->{size} = $end2 - $part->{start};
-}
-sub adjustStartAndEnd($$) {
- &adjustStart;
- &adjustEnd;
-}
-
-sub verifyNotOverlap($$) {
- my ($a, $b) = @_;
- $a->{start} + $a->{size} <= $b->{start} || $b->{start} + $b->{size} <= $a->{start};
-}
-sub verifyInside($$) {
- my ($a, $b) = @_;
- $b->{start} <= $a->{start} && $a->{start} + $a->{size} <= $b->{start} + $b->{size};
-}
-
-sub verifyParts_ {
- foreach my $i (@_) { foreach (@_) {
- $i != $_ and verifyNotOverlap($i, $_) || die "partitions $i->{start} $i->{size} and $_->{start} $_->{size} are overlapping!";
- }}
-}
-sub verifyParts($) {
- my ($hd) = @_;
- verifyParts_(get_normal_parts($hd));
-}
-sub verifyPrimary($) {
- my ($pt) = @_;
- verifyParts_(@{$pt->{normal}}, $pt->{extended});
-}
-
-sub assign_device_numbers($) {
- my ($hd) = @_;
-
- my $i = 1;
- $_->{device} = $hd->{prefix} . $i++ foreach @{$hd->{primary}{raw}},
- map { $_->{normal} } @{$hd->{extended} || []};
-
- #- 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 :(
- my ($c, @others) = grep { isDos($_) || isWin($_) } @{$hd->{primary}{normal}};
- $c or return;
-
- $i = ord 'D';
- foreach (grep { isDos($_) || isWin($_) } map { $_->{normal} } @{$hd->{extended}}) {
- $_->{device_windobe} = chr($i++);
- }
- $c->{device_windobe} = 'C';
- $_->{device_windobe} = chr($i++) foreach @others;
-}
-
-sub remove_empty_extended($) {
- my ($hd) = @_;
- my $last = $hd->{primary}{extended} or return;
- @{$hd->{extended}} = grep {
- if ($_->{normal}) {
- $last = $_;
- } else {
- %{$last->{extended}} = $_->{extended} ? %{$_->{extended}} : ();
- }
- $_->{normal};
- } @{$hd->{extended}};
- adjust_main_extended($hd);
-}
-
-sub adjust_main_extended($) {
- my ($hd) = @_;
-
- if (!is_empty_array_ref $hd->{extended}) {
- my ($l, @l) = @{$hd->{extended}};
-
- # the first is a special case, must recompute its real size
- my $start = round_down($l->{normal}{start} - 1, $hd->{geom}{sectors});
- my $end = $l->{normal}{start} + $l->{normal}{size};
- foreach (map $_->{normal}, @l) {
- $start = min($start, $_->{start});
- $end = max($end, $_->{start} + $_->{size});
- }
- $l->{start} = $hd->{primary}{extended}{start} = $start;
- $l->{size} = $hd->{primary}{extended}{size} = $end - $start;
- }
- unless (@{$hd->{extended} || []} || !$hd->{primary}{extended}) {
- %{$hd->{primary}{extended}} = (); #- modify the raw entry
- delete $hd->{primary}{extended};
- }
- verifyParts($hd); #- verify everything is all right
-}
-
-
-sub get_normal_parts($) {
- my ($hd) = @_;
-
- @{$hd->{primary}{normal} || []}, map { $_->{normal} } @{$hd->{extended} || []}
-}
-
-
-sub read_one($$) {
- my ($hd, $sector) = @_;
-
- my $pt = partition_table_raw::read($hd, $sector) or return;
-
- my @extended = grep { isExtended($_) } @$pt;
- my @normal = grep { $_->{size} && $_->{type} && !isExtended($_) } @$pt;
-
- @extended > 1 and die "more than one extended partition";
-
- $_->{rootDevice} = $hd->{device} foreach @normal, @extended;
- { raw => $pt, extended => $extended[0], normal => \@normal };
-}
-
-sub read($;$) {
- my ($hd, $clearall) = @_;
- my $pt = $clearall ?
- partition_table_raw::clear_raw() :
- read_one($hd, 0) || return 0;
-
- $hd->{primary} = $pt;
- $hd->{extended} = undef;
- $clearall and return $hd->{isDirty} = $hd->{needKernelReread} = 1;
- verifyPrimary($pt);
-
- eval {
- $pt->{extended} and read_extended($hd, $pt->{extended}) || return 0;
- }; die "extended partition: $@" if $@;
- assign_device_numbers($hd);
- remove_empty_extended($hd);
- 1;
-}
-
-sub read_extended($$) {
- my ($hd, $extended) = @_;
-
- my $pt = read_one($hd, $extended->{start}) or return 0;
- $pt = { %$extended, %$pt };
-
- push @{$hd->{extended}}, $pt;
- @{$hd->{extended}} > 100 and die "oops, seems like we're looping here :( (or you have more than 100 extended partitions!)";
-
- @{$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!
- $pt->{normal}{start} += $pt->{start};
-
- verifyInside($pt->{normal}, $extended) or die "partition $pt->{normal}{device} is not inside its extended partition";
-
- if ($pt->{extended}) {
- $pt->{extended}{start} += $hd->{primary}{extended}{start};
- read_extended($hd, $pt->{extended}) or return 0;
- }
- 1;
-}
-
-# write the partition table
-sub write($) {
- my ($hd) = @_;
-
- #- 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;
- }
- partition_table_raw::write($hd, 0, $hd->{primary}{raw}) or die "writing of partition table failed";
-
- foreach (@{$hd->{extended}}) {
- # in case of extended partitions, the start sector must be local to the partition
- $_->{normal}{local_start} = $_->{normal}{start} - $_->{start};
- $_->{extended} and $_->{extended}{local_start} = $_->{extended}{start} - $hd->{primary}{extended}{start};
-
- partition_table_raw::write($hd, $_->{start}, $_->{raw}) or die "writing of partition table failed";
- }
- $hd->{isDirty} = 0;
-
- #- now sync disk and re-read the partition table
- if ($hd->{needKernelReread}) {
- sync();
- partition_table_raw::kernel_read($hd);
- $hd->{needKernelReread} = 0;
- }
-}
-
-sub active($$) {
- my ($hd, $part) = @_;
-
- $_->{active} = 0 foreach @{$hd->{primary}{normal}};
- $part->{active} = 0x80;
-}
-
-
-# remove a normal partition from hard drive hd
-sub remove($$) {
- my ($hd, $part) = @_;
- my $i;
-
- #- first search it in the primary partitions
- $i = 0; foreach (@{$hd->{primary}{normal}}) {
- if ($_ eq $part) {
- splice(@{$hd->{primary}{normal}}, $i, 1);
- %$_ = (); #- blank it
-
- return $hd->{isDirty} = $hd->{needKernelReread} = 1;
- }
- $i++;
- }
- #- otherwise search it in extended partitions
- foreach (@{$hd->{extended}}) {
- $_->{normal} eq $part or next;
-
- delete $_->{normal}; #- remove it
- remove_empty_extended($hd);
-
- return $hd->{isDirty} = $hd->{needKernelReread} = 1;
- }
- 0;
-}
-
-# create of partition at starting at `start', of size `size' and of type `type' (nice comment, uh?)
-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
- push @{$hd->{primary}{normal}}, $part;
- adjust_main_extended($hd); #- verify
- raw_add($hd->{primary}{raw}, $part);
- }
- push @{$hd->{primary}{normal}}, $part; #- really do it
-}
-
-sub add_extended($$) {
- my ($hd, $part) = @_;
-
- my $e = $hd->{primary}{extended};
-
- if ($e && !verifyInside($part, $e)) {
- #-die "sorry, can't add outside the main extended partition" unless $::unsafe;
- my $end = $e->{start} + $e->{size};
- 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
- local $e->{start} = $start;
- local $e->{size} = $end - $start;
- eval { verifyPrimary($hd->{primary}) };
- $@ and die
-_("You have a hole in your partition table but I can't use it.
-The only solution is to move your primary partitions to have the hole next to the extended partitions");
- }
- }
-
- if ($e && $part->{start} < $e->{start}) {
- my $l = first (@{$hd->{extended}});
-
- #- the first is a special case, must recompute its real size
- $l->{start} = round_down($l->{normal}{start} - 1, cylinder_size($hd));
- $l->{size} = $l->{normal}{start} + $l->{normal}{size} - $l->{start};
- my $ext = { %$l };
- unshift @{$hd->{extended}}, { type => 5, raw => [ $part, $ext, {}, {} ], normal => $part, extended => $ext };
- #- size will be autocalculated :)
- } else {
- my ($ext, $ext_size) = is_empty_array_ref($hd->{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 );
-
- raw_add($ext->{raw}, \%ext);
- $ext->{extended} = \%ext;
- push @{$hd->{extended}}, { %ext, raw => [ $part, {}, {}, {} ], normal => $part };
- }
- $part->{start}++; $part->{size}--; #- let it start after the extended partition sector
- adjustStartAndEnd($hd, $part);
-
- adjust_main_extended($hd);
-}
-
-sub add($$;$$) {
- my ($hd, $part, $primaryOrExtended, $forceNoAdjust) = @_;
-
- $part->{notFormatted} = 1;
- $part->{isFormatted} = 0;
- $part->{rootDevice} = $hd->{device};
- $hd->{isDirty} = $hd->{needKernelReread} = 1;
- $part->{start} ||= 1; #- starting at sector 0 is not allowed
- adjustStartAndEnd($hd, $part) unless $forceNoAdjust;
-
- my $e = $hd->{primary}{extended};
-
- if ($primaryOrExtended eq 'Primary' ||
- $primaryOrExtended ne 'Extended' && is_empty_array_ref($hd->{primary}{normal})) {
- eval { add_primary($hd, $part) };
- return unless $@;
- }
- 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
- }
-}
-
-# search for the next partition
-sub next($$) {
- my ($hd, $part) = @_;
-
- first(
- sort { $a->{start} <=> $b->{start} }
- grep { $_->{start} >= $part->{start} + $part->{size} }
- get_normal_parts($hd)
- );
-}
-sub next_start($$) {
- my ($hd, $part) = @_;
- my $next = &next($hd, $part);
- $next ? $next->{start} : $hd->{totalsectors};
-}
-
-
-sub raw_add($$) {
- my ($raw, $part) = @_;
-
- foreach (@$raw) {
- $_->{size} || $_->{type} and next;
- $_ = $part;
- return;
- }
- die "raw_add: partition table already full";
-}
-
-sub load($$;$) {
- my ($hd, $file, $force) = @_;
-
- local *F;
- open F, $file or die _("Error reading file %s", $file);
-
- my $h;
- {
- local $/ = "\0";
- eval <F>;
- }
- $@ and die _("Restoring from file %s failed: %s", $file, $@);
-
- ref $h eq 'ARRAY' or die _("Bad backup file");
-
- my %h; @h{@fields2save} = @$h;
-
- $h{totalsectors} == $hd->{totalsectors} or $force or cdie("Bad totalsectors");
-
- #- unsure we don't modify totalsectors
- local $hd->{totalsectors};
-
- @{$hd}{@fields2save} = @$h;
-
- $hd->{isDirty} = $hd->{needKernelReread} = 1;
-}
-
-sub save($$) {
- my ($hd, $file) = @_;
- my @h = @{$hd}{@fields2save};
- local *F;
- open F, ">$file"
- and print F Data::Dumper->Dump([\@h], ['$h']), "\0"
- or die _("Error writing to file %s", $file);
-}
diff --git a/perl-install/perl2etags b/perl-install/perl2etags
deleted file mode 100755
index 7a15bf78c..000000000
--- a/perl-install/perl2etags
+++ /dev/null
@@ -1,8 +0,0 @@
-#!/usr/bin/perl -p
-
-if (/^ / ... !/^ /) {
- ($package) = /(.*).pm,/;
- $package =~ s|/|::|g;
-}
-
-s/(\x7F)sub\s+(\w+)(\([^)]*\))?/$1${package}::$2/;
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
deleted file mode 100644
index 7adb586fd..000000000
--- a/perl-install/pkgs.pm
+++ /dev/null
@@ -1,353 +0,0 @@
-package pkgs;
-
-use diagnostics;
-use strict;
-use vars qw($fd $size_correction_ratio);
-
-use common qw(:common :file :functional);
-use install_any;
-use log;
-use pkgs;
-use fs;
-use lang;
-use c;
-
-$size_correction_ratio = 1.04;
-
-my @skip_list = qw(
-XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono
-XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128
-XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs kernel-BOOT
-MySQL MySQL_GPL mod_php3 midgard postfix metroess metrotmpl
-hackkernel hackkernel-BOOT hackkernel-fb hackkernel-headers
-hackkernel-pcmcia-cs hackkernel-smp hackkernel-smp-fb
-);#)
-
-sub Package {
- my ($packages, $name) = @_;
- $packages->{$name} or log::l("unknown package `$name'") && undef;
-}
-
-sub allpackages {
- my ($packages) = @_;
- my %skip_list; @skip_list{@skip_list} = ();
- grep { !exists $skip_list{$_->{name}} } values %$packages;
-}
-
-sub select($$;$) {
- my ($packages, $p, $base) = @_;
- my ($n, $v);
- $p->{base} ||= $base;
- $p->{selected} = -1; #- selected by user
- my %l; @l{@{$p->{deps} || die "missing deps file"}} = ();
- while (do { my %l = %l; while (($n, $v) = each %l) { last if $v != 1; } $n }) {
- $l{$n} = 1;
- my $i = Package($packages, $n) or next;
- $i->{base} ||= $base;
- $i->{deps} or log::l("missing deps for $n");
- unless ($i->{selected}) {
- $l{$_} ||= 0 foreach @{$i->{deps} || []};
- }
- $i->{selected}++ unless $i->{selected} == -1;
- }
- 1;
-}
-sub unselect($$;$) {
- my ($packages, $p, $size) = @_;
- $p->{base} and return;
- my $set = set_new($p->{name});
- my $l = $set->{list};
-
- #- 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
- set_add($set, @{$i->{provides} || []});
- }
- while (@$l) {
- my $n = shift @$l;
- my $i = Package($packages, $n);
-
- $i->{selected} <= 0 || $i->{base} and next;
- if (--$i->{selected} == 0) {
- push @$l, @{$i->{deps} || []} if !$size || ($size -= $i->{size}) > 0;
- }
- }
- return if defined $size && $size <= 0;
-
-# #- garbage collect for circular dependencies
-# my $changed = 0; #1;
-# while ($changed) {
-# $changed = 0;
-# NEXT: foreach my $p (grep { $_->{selected} > 0 && !$_->{base} } values %$packages) {
-# my $set = set_new(@{$p->{provides}});
-# foreach (@{$set->{list}}) {
-# my $q = Package($packages, $_);
-# $q->{selected} == -1 || $q->{base} and next NEXT;
-# set_add($set, @{$q->{provides}}) if $q->{selected};
-# }
-# $p->{selected} = 0;
-# $changed = 1;
-# }
-# }
-}
-sub toggle($$) {
- my ($packages, $p) = @_;
- $p->{selected} ? unselect($packages, $p) : &select($packages, $p);
-}
-sub set($$$) {
- my ($packages, $p, $val) = @_;
- $val ? &select($packages, $p) : unselect($packages, $p);
-}
-
-sub unselect_all($) {
- my ($packages) = @_;
- $_->{selected} = $_->{base} foreach values %$packages;
-}
-
-sub psUsingDirectory() {
- my $dirname = "/tmp/rhimage/Mandrake/RPMS";
- my %packages;
-
- log::l("scanning $dirname for packages");
- foreach (all("$dirname")) {
- my ($name, $version, $release) = /(.*)-([^-]+)-([^-.]+)\.[^.]+\.rpm/ or log::l("skipping $_"), next;
-
- $packages{$name} = {
- name => $name, version => $version, release => $release,
- file => $_, selected => 0, deps => [],
- };
- }
- \%packages;
-}
-
-sub psUsingHdlist() {
- my $f = install_any::getFile('hdlist') or die "no hdlist found";
- my %packages;
-
-# 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} = {
- name => $name, header => $header, selected => 0, deps => [],
- version => c::headerGetEntry($header, 'version'),
- release => c::headerGetEntry($header, 'release'),
- size => c::headerGetEntry($header, 'size'),
- };
- }
- log::l("psUsingHdlist read " . scalar keys(%packages) . " headers");
-
- \%packages;
-}
-
-sub chop_version($) {
- first($_[0] =~ /(.*)-[^-]+-[^-.]+/) || $_[0];
-}
-
-sub getDeps($) {
- my ($packages) = @_;
-
- 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(first(split '\|')) } ($name, @deps); #-TODO better handling of choice
- $packages->{$name} or next;
- $packages->{$name}{size} = $size;
- $packages->{$name}{deps} = \@deps;
- map { push @{$packages->{$_}{provides}}, $name if $packages->{$_} } @deps;
- }
-}
-
-sub readCompss($) {
- my ($packages) = @_;
- my (@compss, $ps);
-
- my $f = install_any::getFile("compss") or die "can't find compss";
- foreach (<$f>) {
- /^\s*$/ || /^#/ and next;
- s/#.*//;
-
- if (/^(\S+)/) {
- $ps = [];
- push @compss, { name => $1, packages => $ps };
- } else {
- /(\S+)/ or log::l("bad line in compss: $_"), next;
- push @$ps, $packages->{$1} || do { log::l("unknown package $1 (in compss)"); next };
- }
- }
- \@compss;
-}
-
-sub readCompssList($) {
- my ($packages, $compss) = @_;
- my %compss; map { $compss{$_->{name}} = $_ } @$compss;
-
- my $f = install_any::getFile("compssList") or die "can't find compssList";
- local $_ = <$f>;
- my $level = [ split ];
-
- my $e;
- foreach (<$f>) {
- /^\s*$/ || /^#/ and next;
-
- /^packages\s*$/ and do { $e = $packages; next };
- /^categories\s*$/ and do { $e = \%compss; next };
-
- my ($name, @values) = split;
-
- $e or log::l("neither packages nor categories");
-
- my $p = $e->{$name} or log::l("unknown entry $name (in compssList)"), next;
- $p->{values} = \@values;
- }
- $level;
-}
-
-sub verif_lang($$) {
- my ($p, $lang) = @_;
- local $SIG{__DIE__} = 'none';
- $p->{options} =~ /l/ or return 1;
- $p->{name} =~ /-([^-]*)$/ or return 1;
- !($1 eq $lang || eval { lang::text2lang($1) eq $lang } && !$@);
-}
-
-sub setShowFromCompss($$$) {
- my ($compss, $install_class, $lang) = @_;
-
- my $l = substr($install_class, 0, 1);
-
- foreach my $c (@$compss) {
- $c->{show} = bool($c->{options} =~ /($l|\*)/);
- foreach my $p (@{$c->{packages}}) {
- local $_ = $p->{options};
- $p->{show} = /$l|\*/ && verif_lang($p, $lang);
- }
- }
-}
-
-sub setSelectedFromCompssList($$$$$) {
- my ($compssListLevels, $packages, $size, $install_class, $lang) = @_;
- my ($level, $ind) = 100;
-
- my @packages = values %$packages;
- my @places = do {
- map_index { $ind = $::i if $_ eq $install_class } @{$compssListLevels};
- defined $ind or log::l("unknown install class $install_class in compssList"), return;
-
- my @values = map { $_->{values}[$ind] } @packages;
- sort { $values[$b] <=> $values[$a] } 0 .. $#packages;
- };
- foreach (@places) {
- my $p = $packages[$_];
- $level = min($level, $p->{values}[$ind]);
- last if $level == 0;
-
- verif_lang($p, $lang) or next;
- &select($packages, $p);
-
- my $nb = 0; foreach (@packages) {
- $nb += $_->{size} if $_->{selected};
- }
- if ($nb > $size) {
- unselect($packages, $p, $nb - $size);
- last;
- }
- }
- $ind, $level;
-}
-
-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();
-
- log::l("reading /usr/lib/rpm/rpmrc");
- c::rpmReadConfigFiles() or die "can't read rpm config files";
- log::l("\tdone");
-
- $isUpgrade ? c::rpmdbRebuild($prefix) : c::rpmdbInit($prefix, 0644) or die "creation/rebuilding of rpm database failed: ", c::rpmErrorString();
-}
-
-sub getHeader($) {
- my ($p) = @_;
-
- 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};
-}
-
-sub install($$) {
- my ($prefix, $toInstall) = @_;
-
- return if $::g_auto_install;
-
- c::rpmReadConfigFiles() or die "can't read rpm config files";
-
- my $db = c::rpmdbOpen($prefix) or die "error opening RPM database: ", c::rpmErrorString();
- log::l("opened rpm database");
-
- my $trans = c::rpmtransCreateSet($db, $prefix);
-
- my ($total, $nb);
-
- foreach my $p (@$toInstall) {
- eval { getHeader($p) }; $@ and next;
- $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}, $p->{name} !~ /kernel/); #- TODO: replace `named kernel' by `provides kernel'
- $nb++;
- $total += $p->{size};
- }
-
- c::rpmdepOrder($trans) or
- cdie "error ordering package list: " . c::rpmErrorString(),
- sub {
- c::rpmdbClose($db);
- c::rpmtransFree($trans);
- };
- c::rpmtransSetScriptFd($trans, $fd);
-
- eval { fs::mount("/proc", "$prefix/proc", "proc", 0) };
-
- 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 {
- my $fd = install_any::getFile($_[0]) or log::l("bad file $_[0]");
- $fd ? fileno $fd : -1;
- };
- 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, $callbackOpen, $callbackClose,
- $callbackStart, $callbackProgress, 0)) {
- my %parts;
- @probs = reverse grep {
- if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) {
- $parts{$3} ? 0 : ($parts{$3} = 1);
- } else { 1; }
- } reverse @probs;
- die "installation of rpms failed:\n ", join("\n ", @probs);
- }
- c::rpmtransFree($trans);
- c::rpmdbClose($db);
- log::l("rpm database closed");
-
- $_->{installed} = 1 foreach @$toInstall;
-}
-
-1;
diff --git a/perl-install/resize_fat/Makefile b/perl-install/resize_fat/Makefile
deleted file mode 100644
index 34c257a4e..000000000
--- a/perl-install/resize_fat/Makefile
+++ /dev/null
@@ -1,12 +0,0 @@
-PRODUCT = libresize
-TARSOURCE = $(PRODUCT).tar.bz2
-
-.PHONY: clean tar
-
-clean:
- rm -f *~ TAGS $(TARSOURCE)
-
-tar: clean
- cp -f ../common.pm .
- cd .. ; tar cfy $(TARSOURCE) $(PRODUCT) ; mv $(TARSOURCE) $(PRODUCT)
- rm -f common.pm
diff --git a/perl-install/resize_fat/README b/perl-install/resize_fat/README
deleted file mode 100644
index 1c4798c82..000000000
--- a/perl-install/resize_fat/README
+++ /dev/null
@@ -1,8 +0,0 @@
-TODO:
-
-resize_fat::fat::update($fs) should be called before doing undoable things
-(before the sync in construct_dir_tree)
-
-BUGS:
-no known bugs :)
-if you found one, please mail pixel@linux-mandrake.com !!
diff --git a/perl-install/resize_fat/any.pm b/perl-install/resize_fat/any.pm
deleted file mode 100644
index 6acd0b52c..000000000
--- a/perl-install/resize_fat/any.pm
+++ /dev/null
@@ -1,82 +0,0 @@
-package resize_fat::any;
-
-use diagnostics;
-use strict;
-use vars qw($FREE $FILE $DIRECTORY);
-
-use common qw(:common :constant);
-use resize_fat::fat;
-use resize_fat::directory;
-use resize_fat::dir_entry;
-
-
-$FREE = 0;
-$FILE = 1;
-$DIRECTORY = 2;
-
-
-1;
-
-
-#- 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;
-}
-sub max_cluster_count($) {
- my ($fs) = @_;
- 2 ** $fs->{fs_type_size} - 11;
-}
-
-
-
-#- 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 :)
- 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
-sub max_size($) {
- my ($fs) = @_;
-
- my $max_cluster_count = min($fs->{nb_fat_entries} - 2, max_cluster_count($fs));
-
- $max_cluster_count * divide($fs->{cluster_size}, $SECTORSIZE) +
- divide($fs->{cluster_offset}, $SECTORSIZE);
-}
-
-#- 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);
-
- my $f = sub {
- ($entry) = @_;
- $cluster = resize_fat::dir_entry::get_cluster($entry);
-
- if (resize_fat::dir_entry::is_file($entry)) {
- $type = $FILE;
- } elsif (resize_fat::dir_entry::is_directory($entry)) {
- $type = $DIRECTORY;
- } else { return }
-
- for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
- $cluster == 0 and die "Bad FAT: unterminated chain for $entry->{name}\n";
- $fs->{fat_flag_map}[$cluster] and die "Bad FAT: cluster $cluster is cross-linked for $entry->{name}\n";
- $fs->{fat_flag_map}[$cluster] = $type;
- $fs->{clusters}{count}{dirs}++ if $type == $DIRECTORY;
- }
- };
- $fs->{fat_flag_map} = [ ($FREE) x ($fs->{nb_clusters} + 2) ];
- $fs->{clusters}{count}{dirs} = 0;
- resize_fat::directory::traverse_all($fs, $f);
-}
diff --git a/perl-install/resize_fat/boot_sector.pm b/perl-install/resize_fat/boot_sector.pm
deleted file mode 100644
index 48e2a8d4e..000000000
--- a/perl-install/resize_fat/boot_sector.pm
+++ /dev/null
@@ -1,107 +0,0 @@
-package resize_fat::boot_sector;
-
-use diagnostics;
-use strict;
-
-use common qw(:common :system :constant);
-use resize_fat::io;
-use resize_fat::any;
-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
- '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
- 'fat32_root_dir_cluster',
- 'info_offset_in_sectors',
- 'fat32_backup_sector',
-
-#- 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.
-sub read($) {
- my ($fs) = @_;
-
- my $boot = eval { resize_fat::io::read($fs, 0, $SECTORSIZE) }; $@ and die "reading boot sector failed on device $fs->{fs_name}";
- @{$fs}{@fields} = unpack $format, $boot;
-
- $fs->{nb_sectors} = $fs->{small_nb_sectors} || $fs->{big_nb_sectors};
- $fs->{cluster_size} = $fs->{cluster_size_in_sectors} * $fs->{sector_size};
-
- $fs->{boot_sign} == 0xAA55 or die "Invalid signature for a MS-based filesystem.";
- $fs->{nb_fats} == 2 or die "Weird number of FATs: $fs->{nb_fats}, not 2.",
- $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
- $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
- } else {
- $resize_fat::isFAT32 = 1;
- $fs->{fs_type} = 'FAT32';
- $fs->{fs_type_size} = 32;
- $fs->{fat_length} = $fs->{fat32_fat_length};
-
- $fs->{nb_root_dir_entries} = 0;
- $fs->{info_offset} = $fs->{info_offset_in_sectors} * $fs->{sector_size};
- $resize_fat::bad_cluster_value = 0xffffff7;
- }
-
- $fs->{fat_offset} = $fs->{nb_reserved} * $fs->{sector_size};
- $fs->{fat_size} = $fs->{fat_length} * $fs->{sector_size};
- $fs->{root_dir_offset} = $fs->{fat_offset} + $fs->{fat_size} * $fs->{nb_fats};
- $fs->{root_dir_size} = $fs->{nb_root_dir_entries} * resize_fat::directory::entry_size();
- $fs->{cluster_offset} = $fs->{root_dir_offset} + $fs->{root_dir_size} - 2 * $fs->{cluster_size};
-
- $fs->{nb_fat_entries} = divide($fs->{fat_size}, $fs->{fs_type_size} / 8);
-
- #- - 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::max_cluster_count($fs) or die "error: too many sectors for a $fs->{fs_type}\n";
-}
-
-sub write($) {
- my ($fs) = @_;
- my $boot = pack($format, @{$fs}{@fields});
-
- 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
- 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
deleted file mode 100644
index cfee23dae..000000000
--- a/perl-install/resize_fat/dir_entry.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package resize_fat::dir_entry;
-
-use diagnostics;
-use strict;
-
-
-my $DELETED_FLAG = 0xe5;
-my $VOLUME_LABEL_ATTR = 0x08;
-my $VFAT_ATTR = 0x0f;
-my $DIRECTORY_ATTR = 0x10;
-
-1;
-
-sub get_cluster($) {
- my ($entry) = @_;
- $entry->{first_cluster} + ($resize_fat::isFAT32 ? $entry->{first_cluster_high} * 65536 : 0);
-}
-sub set_cluster($$) {
- my ($entry, $val) = @_;
- $entry->{first_cluster} = $val & (1 << 16) - 1;
- $entry->{first_cluster_high} = $val >> 16 if $resize_fat::isFAT32;
-}
-
-sub is_directory_raw($) {
- my ($entry) = @_;
- !is_special_entry($entry) && $entry->{attributes} & $DIRECTORY_ATTR;
-}
-
-sub is_directory($) {
- my ($entry) = @_;
- is_directory_raw($entry) && $entry->{name} !~ /^\.\.? /;
-}
-
-sub is_volume($) {
- my ($entry) = @_;
- !is_special_entry($entry) && $entry->{attributes} & $VOLUME_LABEL_ATTR;
-}
-
-sub is_file($) {
- my ($entry) = @_;
- !is_special_entry($entry) && !is_directory($entry) && !is_volume($entry) && $entry->{length};
-}
-
-
-sub is_special_entry($) {
- my ($entry) = @_;
- my ($c) = unpack "C", $entry->{name};
-
- #- 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;
- 0;
-}
-
-
-#- return true if entry has been modified
-sub remap {
- my ($fat_remap, $entry) = @_;
-
- is_special_entry($entry) and return;
-
- my $cluster = get_cluster($entry);
- my $new_cluster = $fat_remap->[$cluster];
-
- #-print "remapping cluster ", get_first_cluster($fs, $entry), " to $new_cluster";
-
- $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
deleted file mode 100644
index 46e810021..000000000
--- a/perl-install/resize_fat/directory.pm
+++ /dev/null
@@ -1,78 +0,0 @@
-package resize_fat::directory;
-
-use diagnostics;
-use strict;
-
-use common qw(:system);
-use resize_fat::dir_entry;
-use resize_fat::io;
-
-
-my $format = "a8 a3 C C C S7 I";
-my @fields = (
- 'name',
- 'extension',
- 'attributes',
- 'is_upper_case_name',
- 'creation_time_low', #- milliseconds
- 'creation_time_high',
- 'creation_date',
- 'access_date',
- 'first_cluster_high', #- for FAT32
- 'time',
- 'date',
- 'first_cluster',
- 'length',
-);
-
-1;
-
-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
-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
- $$raw =~ /^\0*$/ and return $directory;
-
- my $entry; @{$entry}{@fields} = unpack $format, $$raw;
-
- &$f($entry)
- and $$raw = pack $format, @{$entry}{@fields};
- }
- $directory;
-}
-
-sub traverse_all($$) {
- my ($fs, $f) = @_;
-
- my $traverse_all; $traverse_all = sub {
- my ($entry) = @_;
-
- &$f($entry);
-
- 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)
- };
-
- my $directory = $resize_fat::isFAT32 ?
- resize_fat::io::read_file($fs, $fs->{fat32_root_dir_cluster}) :
- resize_fat::io::read($fs, $fs->{root_dir_offset}, $fs->{root_dir_size});
- traverse($fs, $directory, $traverse_all);
-}
-
-
-#- function used by construct_dir_tree to translate the `cluster' fields in each
-#- directory entry
-sub remap {
- my ($fs, $directory) = @_;
-
- traverse($fs->{fat_remap}, $directory, sub { resize_fat::dir_entry::remap($fs->{fat_remap}, $_[0]) });
-}
diff --git a/perl-install/resize_fat/fat.pm b/perl-install/resize_fat/fat.pm
deleted file mode 100644
index e6039077a..000000000
--- a/perl-install/resize_fat/fat.pm
+++ /dev/null
@@ -1,167 +0,0 @@
-package resize_fat::fat;
-
-use diagnostics;
-use strict;
-
-use resize_fat::any;
-use resize_fat::io;
-
-1;
-
-sub read($) {
- my ($fs) = @_;
-
- @{$fs->{fats}} = map {
- my $fat = eval { resize_fat::io::read($fs, $fs->{fat_offset} + $_ * $fs->{fat_size}, $fs->{fat_size}) };
- $@ and die "reading fat #$_ failed";
- vec($fat, 0, 8) == $fs->{media} or die "FAT $_ has invalid signature";
- $fat;
- } (0 .. $fs->{nb_fats} - 1);
-
- $fs->{fat} = $fs->{fats}[0];
-
- my ($free, $bad, $used) = (0, 0, 0);
-
- for (my $i = 2; $i < $fs->{nb_clusters} + 2; $i++) {
- my $cluster = &next($fs, $i);
- if ($cluster == 0) { $free++; }
- elsif ($cluster == $resize_fat::bad_cluster_value) { $bad++; }
- else { $used++; }
- }
- @{$fs->{clusters}{count}}{qw(free bad used)} = ($free, $bad, $used);
-}
-
-sub write($) {
- my ($fs) = @_;
-
- sysseek $fs->{fd}, $fs->{fat_offset}, 0 or die "write_fat: seek failed";
- foreach (1..$fs->{nb_fats}) {
- syswrite $fs->{fd}, $fs->{fat} or die "write_fat: write failed";
- }
-}
-
-
-
-#- 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);
- my $remap = sub { $fs->{fat_remap}[$cluster] = $new_cluster; };
- 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...");
- };
-
- $fs->{fat_remap}[0] = 0;
- $fs->{last_free_cluster} = 2;
- for ($cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- if ($cluster < $cut_point) {
- if ($fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY) {
- &$get_new();
- } else {
- $new_cluster = $cluster;
- }
- &$remap();
- } elsif (!is_empty(&next($fs, $cluster))) {
- &$get_new();
- &$remap();
- }
- }
-}
-
-
-#- updates the fat for the resized filesystem
-sub update {
- my ($fs) = @_;
-
- for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- if ($fs->{fat_flag_map}[$cluster]) {
- my $old_next = &next($fs, $cluster);
- my $new = $fs->{fat_remap}[$cluster];
- my $new_next = $fs->{fat_remap}[$old_next];
-
- set_available($fs, $cluster);
-
- is_eof($old_next) ?
- set_eof($fs, $new) :
- set_next($fs, $new, $new_next);
- }
- }
-}
-
-
-#- - 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}}) {
- $_ eq $fs->{fats}[0] or die "FAT tables do not match";
- }
-}
-
-sub endianness16($) { (($_[0] & 0xff) << 8) + ($_[0] >> 8); }
-sub endianness($$) {
- my ($val, $nb_bits) = @_;
- my $r = 0;
- for (; $nb_bits > 0; $nb_bits -= 8) {
- $r <<= 8;
- $r += $val & 0xff;
- $val >>= 8;
- }
- $nb_bits < 0 and die "error: endianness only handle numbers divisible by 8";
- $r;
-}
-
-sub next($$) {
- my ($fs, $cluster) = @_;
- $cluster > $fs->{nb_clusters} + 2 and die "fat::next: cluster $cluster outside filesystem";
- endianness(vec($fs->{fat}, $cluster, $fs->{fs_type_size}), $fs->{fs_type_size});
-
-}
-sub set_next($$$) {
- my ($fs, $cluster, $new_v) = @_;
- $cluster > $fs->{nb_clusters} + 2 and die "fat::set_next: cluster $cluster outside filesystem";
- vec($fs->{fat}, $cluster, $fs->{fs_type_size}) = endianness($new_v, $fs->{fs_type_size});
-}
-
-
-sub get_free($) {
- my ($fs) = @_;
- foreach (my $i = 0; $i < $fs->{nb_clusters}; $i++) {
- my $cluster = ($i + $fs->{last_free_cluster} - 2) % $fs->{nb_clusters} + 2;
- is_available(&next($fs, $cluster)) and return $fs->{last_free_cluster} = $cluster;
- }
- die "no free clusters";
-}
-
-#- returns true if <cluster> represents an EOF marker
-sub is_eof($) {
- my ($cluster) = @_;
- $cluster >= $resize_fat::bad_cluster_value;
-}
-sub set_eof($$) {
- my ($fs, $cluster) = @_;
- set_next($fs, $cluster, $resize_fat::bad_cluster_value + 1);
-}
-
-#- 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.
-sub is_available($) {
- my ($cluster) = @_;
- $cluster == 0;
-}
-sub set_available($$) {
- my ($fs, $cluster) = @_;
- set_next($fs, $cluster, 0);
-}
diff --git a/perl-install/resize_fat/info_sector.pm b/perl-install/resize_fat/info_sector.pm
deleted file mode 100644
index 3a6f7cfed..000000000
--- a/perl-install/resize_fat/info_sector.pm
+++ /dev/null
@@ -1,36 +0,0 @@
-package resize_fat::info_sector;
-
-use diagnostics;
-use strict;
-
-use common qw(:system);
-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
- 'unused2',
-);
-
-1;
-
-
-sub read($) {
- my ($fs) = @_;
- my $info = resize_fat::io::read($fs, $fs->{info_offset}, psizeof($format));
- @{$fs->{info_sector}}{@fields} = unpack $format, $info;
- $fs->{info_sector}{signature} == 0x61417272 or die "Invalid information sector signature\n";
-}
-
-sub write($) {
- my ($fs) = @_;
- $fs->{info_sector}{free_clusters} = $fs->{clusters}->{count}->{free};
- $fs->{info_sector}{next_cluster} = 2;
-
- my $info = pack $format, @{$fs->{info_sector}}{@fields};
-
- resize_fat::io::write($fs, $fs->{info_offset}, psizeof($format), $info);
-}
diff --git a/perl-install/resize_fat/io.pm b/perl-install/resize_fat/io.pm
deleted file mode 100644
index 48309db91..000000000
--- a/perl-install/resize_fat/io.pm
+++ /dev/null
@@ -1,74 +0,0 @@
-package resize_fat::io;
-
-use diagnostics;
-use strict;
-
-use resize_fat::fat;
-
-1;
-
-
-sub read($$$) {
- my ($fs, $pos, $size) = @_;
- my $buf;
- sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
- sysread $fs->{fd}, $buf, $size or die "reading at byte #$pos failed on device $fs->{fs_name}";
- $buf;
-}
-sub write($$$$) {
- my ($fs, $pos, $size, $buf) = @_;
- sysseek $fs->{fd}, $pos, 0 or die "seeking to byte #$pos failed on device $fs->{fs_name}";
- syswrite $fs->{fd}, $buf or die "writing at byte #$pos failed on device $fs->{fs_name}";
-}
-
-sub read_cluster($$) {
- my ($fs, $cluster) = @_;
- my $buf;
-
- eval {
- $buf = &read($fs,
- $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
- $fs->{cluster_size});
- }; @$ and die "reading cluster #$cluster failed on device $fs->{fs_name}";
- $buf;
-}
-sub write_cluster($$$) {
- my ($fs, $cluster, $buf) = @_;
-
- eval {
- &write($fs,
- $fs->{cluster_offset} + $cluster * $fs->{cluster_size},
- $fs->{cluster_size},
- $buf);
- }; @$ and die "writing cluster #$cluster failed on device $fs->{fs_name}";
-}
-
-sub read_file($$) {
- my ($fs, $cluster) = @_;
- my $buf = '';
-
- for (; !resize_fat::fat::is_eof($cluster); $cluster = resize_fat::fat::next($fs, $cluster)) {
- $cluster == 0 and die "Bad FAT: unterminated chain\n";
- $buf .= read_cluster($fs, $cluster);
- }
- $buf;
-}
-
-sub check_mounted($) {
- my ($f) = @_;
-
- local *F;
- open F, "/proc/mounts" or die "error opening /proc/mounts\n";
- foreach (<F>) {
- /^$f\s/ and die "device is mounted";
- }
-}
-
-sub open($) {
- my ($fs) = @_;
-
- check_mounted($fs->{device});
-
- sysopen F, $fs->{fs_name}, 2 or sysopen F, $fs->{fs_name}, 0 or die "error opening device $fs->{fs_name} for writing\n";
- $fs->{fd} = \*F;
-}
diff --git a/perl-install/resize_fat/main.pm b/perl-install/resize_fat/main.pm
deleted file mode 100644
index 1e5ac62be..000000000
--- a/perl-install/resize_fat/main.pm
+++ /dev/null
@@ -1,166 +0,0 @@
-#!/usr/bin/perl
-
-# DiskDrake
-# Copyright (C) 1999 MandrakeSoft (pixel@linux-mandrake.com)
-#
-# This program is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2, or (at your option)
-# any later version.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with this program; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-# This is mainly a perl rewrite of the work of Andrew Clausen (libresize)
-
-package resize_fat::main;
-
-use diagnostics;
-use strict;
-
-use log;
-use common qw(:common :system :constant);
-use resize_fat::boot_sector;
-use resize_fat::info_sector;
-use resize_fat::directory;
-use resize_fat::io;
-use resize_fat::fat;
-use resize_fat::any;
-
-
-1;
-
-#- - 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 } ;
-
- resize_fat::io::open($fs);
- resize_fat::boot_sector::read($fs);
- $resize_fat::isFAT32 and eval { resize_fat::info_sector::read($fs) };
- resize_fat::fat::read($fs);
- resize_fat::fat::check($fs);
- resize_fat::any::flag_clusters($fs);
-
- 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)
-sub copy_clusters {
- my ($fs, $cluster) = @_;
- my @buffer;
- my $flush = sub {
- while (@buffer) {
- my $cluster = shift @buffer;
- resize_fat::io::write_cluster($fs, $cluster, shift @buffer);
- }
- };
- for (; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- $fs->{fat_flag_map}[$cluster] == $resize_fat::any::FILE or next;
- push @buffer, $fs->{fat_remap}[$cluster], resize_fat::io::read_cluster($fs, $cluster);
- @buffer > 50 and &$flush();
- }
- &$flush();
-}
-
-#- 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
- $fs->{fat_flag_map}[$fs->{fat32_root_dir_cluster}] = $resize_fat::any::FREE;
- }
-
- for (my $cluster = 2; $cluster < $fs->{nb_clusters} + 2; $cluster++) {
- $fs->{fat_flag_map}[$cluster] == $resize_fat::any::DIRECTORY or next;
-
- resize_fat::io::write_cluster($fs,
- $fs->{fat_remap}[$cluster],
- resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
- }
-
- sync();
-
- #- 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!
-
- #- remapping non movable root directory
- if ($resize_fat::isFAT32) {
- my $cluster = $fs->{fat32_root_dir_cluster};
-
- resize_fat::io::write_cluster($fs,
- $fs->{fat_remap}[$cluster],
- resize_fat::directory::remap($fs, resize_fat::io::read_cluster($fs, $cluster)));
- } else {
- resize_fat::io::write($fs, $fs->{root_dir_offset}, $fs->{root_dir_size},
- resize_fat::directory::remap($fs, resize_fat::io::read($fs, $fs->{root_dir_offset}, $fs->{root_dir_size})));
- }
-}
-
-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
-sub resize {
- my ($fs, $size) = @_;
-
- my ($min, $max) = (min_size($fs), max_size($fs));
-
-
- $size += $min if $size =~ /^\+/;
-
- $size >= $min or die "Minimum filesystem size is $min sectors";
- $size <= $max or die "Maximum filesystem size is $max sectors";
-
- log::l("resize_fat: Partition size fill be ", $size * $SECTORSIZE >> 20, "Mb (well exactly ${size} sectors)");
-
- my $new_data_size = $size * $SECTORSIZE - $fs->{cluster_offset};
- my $new_nb_clusters = divide($new_data_size, $fs->{cluster_size});
-
- log::l("resize_fat: Allocating new clusters");
- resize_fat::fat::allocate_remap($fs, $new_nb_clusters);
-
- log::l("resize_fat: Copying files");
- copy_clusters($fs, $new_nb_clusters);
-
- log::l("resize_fat: Copying directories");
- construct_dir_tree($fs);
-
- log::l("Writing new FAT...");
- resize_fat::fat::update($fs);
- resize_fat::fat::write($fs);
-
- $fs->{nb_sectors} = $size;
- $fs->{nb_clusters} = $new_nb_clusters;
- $fs->{clusters}{count}->{free} =
- $fs->{nb_clusters} - $fs->{clusters}{count}->{used} - $fs->{clusters}->{count}->{bad} - 2;
-
- $fs->{system_id} = 'was here!';
- $fs->{small_nb_sectors} = 0;
- $fs->{big_nb_sectors} = $size;
-
- log::l("resize_fat: Writing new boot sector...");
-
- 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!
-
- sync();
- log::l("resize_fat: done");
-}
-
diff --git a/perl-install/run_program.pm b/perl-install/run_program.pm
deleted file mode 100644
index 7e91437e7..000000000
--- a/perl-install/run_program.pm
+++ /dev/null
@@ -1,55 +0,0 @@
-package run_program;
-
-use diagnostics;
-use strict;
-
-use log;
-
-1;
-
-sub run($@) { rooted('', @_) }
-
-sub rooted {
- my ($root, $name, @args) = @_;
- my $str = ref $name ? $name->[0] : $name;
- log::l("running: $str @args" . ($root ? " with root $root" : ""));
- $root ? $root .= '/' : ($root = '');
-
- fork and wait, return $? == 0;
- {
- my ($stdout, $stdoutm, $stderr, $stderrm);
- ($stdoutm, $stdout, @args) = @args if $args[0] =~ /^>>?$/;
- ($stderrm, $stderr, @args) = @args if $args[0] =~ /^2>>?$/;
-
- open STDIN, "/dev/null" or die "can't open /dev/null as stdin";
-
- if ($stderr) {
- $stderrm =~ s/2//;
- open STDERR, "$stderrm $root$stderr" or die "run_program can't output in $root$stderr (mode `$stderrm')";
- } else {
- open STDERR, ">> /dev/tty7" or open STDERR, ">> /tmp/exec.log" or die "run_program can't log :(";
- }
- if ($stdout) {
- open STDOUT, "$stdoutm $root$stdout" or die "run_program can't output in $root$stdout (mode `$stdoutm')";
- } else {
- open STDOUT, ">> /dev/tty7" or open STDOUT, ">> /tmp/exec.log" or die "run_program can't log :(";
- }
-
- $root and chroot $root;
- chdir "/";
-
- if (ref $name) {
- unless (exec { $name->[0] } $name->[1], @args) {
- log::l("exec of $name->[0] failed: $!");
- exec('false') or exit(1);
- }
- } else {
- unless (exec $name, @args) {
- log::l("exec of $name failed: $!");
- exec('false') or exit(1);
- }
-
- }
- }
-
-}
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
deleted file mode 100644
index e92a089b4..000000000
--- a/perl-install/share/diskdrake.rc
+++ /dev/null
@@ -1,30 +0,0 @@
-style "font"
-{
- font = "-adobe-helvetica-medium-r-normal-*-*-80-*-*-p-*-iso8859-1"
-}
-
-style "red" = "font"
-{
- bg[NORMAL] = { 1.0, 0, 0 }
- bg[PRELIGHT] = { 0.9, 0, 0 }
-}
-style "green" = "font"
-{
- bg[NORMAL] = { 0, 1.0, 0 }
- bg[PRELIGHT] = { 0, 0.9, 0 }
-}
-style "blue" = "font"
-{
- bg[NORMAL] = { 0, 0, 1.0 }
- bg[PRELIGHT] = { 0, 0, 0.9 }
-}
-style "white" = "font"
-{
- bg[NORMAL] = { 1.0, 1.0, 1.0 }
- bg[PRELIGHT] = { 0.67, 0.67, 0.67 }
-}
-
-widget "*Linux*" style "red"
-widget "*Linux swap" style "green"
-widget "*FAT*" style "blue"
-widget "*Empty*" style "white"
diff --git a/perl-install/share/po/Makefile b/perl-install/share/po/Makefile
deleted file mode 100644
index ad4f9486b..000000000
--- a/perl-install/share/po/Makefile
+++ /dev/null
@@ -1,22 +0,0 @@
-PMSFILES = $(shell find .. -name "*.pm" | grep -v "^../po" | grep -v "^../c/")
-PMSCFILES = $(PMSFILES:%=%_.c)
-POFILES = $(shell ls *.po)
-
-all: $(POFILES)
-
-clean:
- rm -f empty.po $(POFILES:%=%t) $(PMSCFILES)
-
-$(POFILES): panoramix.pot
- cp -f $@ $@t
- msgmerge $@t $< > $@
- rm $@t
-
-panoramix.pot: $(PMSFILES)
- $(MAKE) $(PMSCFILES);
- xgettext -F -n --keyword=_ --keyword=__ -o panoramix.pot $(PMSCFILES)
- rm $(PMSCFILES)
-
-$(PMSCFILES): %_.c: %
- perl -pe 's|^(__?\()| $$1|; s|#(.*)|/*\1*\/|; s|$$|\\n\\|' $< > $@
-
diff --git a/perl-install/share/themes-blue.rc b/perl-install/share/themes-blue.rc
deleted file mode 100644
index ab2344f8b..000000000
--- a/perl-install/share/themes-blue.rc
+++ /dev/null
@@ -1,47 +0,0 @@
-style "any"
-{
- base[NORMAL] = { 0, 0, 0.67 }
- bg[NORMAL] = { 0, 0, 0.67 }
- bg[INSENSITIVE] = { 0, 0, 0.67 }
- base[INSENSITIVE]={ 0, 0, 0.67 }
- bg[ACTIVE] = { 0, 0.67, 1.0 }
- bg[PRELIGHT] = { 0, 0, 1.0 }
-
- text[NORMAL] = { 1.0, 1.0, 1.0 }
- fg[NORMAL] = { 1.0, 1.0, 1.0 }
- fg[INSENSITIVE] = { 1.0, 1.0, 1.0 }
- text[INSENSITIVE]={ 1.0, 1.0, 1.0 }
- fg[ACTIVE] = { 1.0, 1.0, 1.0 }
- fg[PRELIGHT] = { 1.0, 1.0, 1.0 }
-}
-
-style "entry"
-{
- base[NORMAL] = { 0, 1.0, 1.0 }
- base[ACTIVE] = { 0, 1.0, 1.0 }
- fg[NORMAL] = { 0.67, 0, 0.67 }
-
- bg[SELECTED] = { 1.0, 1.0, 1.0 }
- fg[SELECTED] = { 0, 0, 1.0 }
-}
-
-style "button" = "any"
-{
- bg[NORMAL] = { 0, 0, 1.0 }
- fg[NORMAL] = { 1.0, 1.0, 1.0 }
- bg[PRELIGHT] = { 0, 0, 1.0 }
- fg[PRELIGHT] = { 0, 1.0, 1.0 }
-}
-
-style "background"
-{
- bg[NORMAL] = { 0, 0, 0.67 }
- bg[PRELIGHT] = { 0, 0, 0.67 }
-}
-
-widget_class "*" style "any"
-widget_class "*GtkSpin*" style "entry"
-widget_class "*GtkEntry*" style "entry"
-widget_class "*Gtk*List*" style "entry"
-widget "*GtkButton*" style "button"
-widget "*background*" style "background"
diff --git a/perl-install/timezone.pm b/perl-install/timezone.pm
deleted file mode 100644
index e5851b1dd..000000000
--- a/perl-install/timezone.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package timezone;
-
-use diagnostics;
-use strict;
-
-use common qw(:common :system);
-use commands;
-use log;
-
-
-sub getTimeZones {
- my ($prefix) = @_;
- local *F;
- open F, "cd $prefix/usr/share/zoneinfo && find [A-Z]* -type f |";
- my @l = sort map { chop; $_ } <F>;
- close F or die "cannot list the available zoneinfos";
- @l;
-}
-
-sub read ($) {
- my ($f) = @_;
- my %t = getVarsFromSh($f) or die "cannot open file $f: $!";
-
- ("timezone", $t{ZONE}, "GMT", text2bool($t{GMT}));
-}
-
-sub write($$$) {
- my ($prefix, $t, $f) = @_;
-
- eval { commands::cp("-f", "$prefix/usr/share/zoneinfo/$t->{timezone}", "$prefix/etc/localtime") };
- $@ and log::l("installing /etc/localtime failed");
- setVarsInSh($f, {
- ZONE => $t->{timezone},
- GMT => bool2text($t->{GMT}),
- ARC => "false",
- });
-}
-
-my %l2t = (
-'Danish (Denmark)' => 'Europe/Copenhagen',
-'English (USA)' => 'America/New_York',
-'English (UK)' => 'Europe/London',
-'Estonian (Estonia)' => 'Europe/Tallinn',
-'Finnish (Finland)' => 'Europe/Helsinki',
-'French (France)' => 'Europe/Paris',
-'French (Belgium)' => 'Europe/Brussels',
-'French (Canada)' => 'Canada/Atlantic', # or Newfoundland ? or Eastern ?
-'German (Germany)' => 'Europe/Berlin',
-'Hungarian (Hungary)' => 'Europe/Budapest',
-'Icelandic (Iceland)' => 'Atlantic/Reykjavik',
-'Indonesian (Indonesia)' => 'Asia/Jakarta',
-'Italian (Italy)' => 'Europe/Rome',
-'Italian (San Marino)' => 'Europe/San_Marino',
-'Italian (Vatican)' => 'Europe/Vatican',
-'Italian (Switzerland)' => 'Europe/Zurich',
-'Japanese' => 'Asia/Tokyo',
-'Latvian (Latvia)' => 'Europe/Riga',
-'Lithuanian (Lithuania)' => 'Europe/Vilnius',
-'Norwegian (Bokmaal)' => 'Europe/Oslo',
-'Norwegian (Nynorsk)' => 'Europe/Oslo',
-'Polish (Poland)' => 'Europe/Warsaw',
-'Portuguese (Brazil)' => 'Brazil/East', # most people live on the east coast
-'Portuguese (Portugal)' => 'Europe/Lisbon',
-'Romanian (Rumania)' => 'Europe/Bucharest',
-'Russian (Russia)' => 'Europe/Moscow',
-'Slovak (Slovakia)' => 'Europe/Bratislava',
-'Spanish (Spain)' => 'Europe/Madrid',
-'Swedish (Finland)' => 'Europe/Helsinki',
-'Swedish (Sweden)' => 'Europe/Stockholm',
-'Turkish (Turkey)' => 'Europe/Istanbul',
-'Ukrainian (Ukraine)' => 'Europe/Kiev',
-'Walon (Belgium)' => 'Europe/Brussels',
-);
-
-sub bestTimezone {
- my ($langtext) = @_;
- $l2t{common::bestMatchSentence($langtext, keys %l2t)};
-}
-
-1;
diff --git a/perl-install/unused/.cvsignore b/perl-install/unused/.cvsignore
deleted file mode 100644
index 72e8ffc0d..000000000
--- a/perl-install/unused/.cvsignore
+++ /dev/null
@@ -1 +0,0 @@
-*
diff --git a/perl-install/unused/cdrom.pm b/perl-install/unused/cdrom.pm
deleted file mode 100644
index b9b6ea699..000000000
--- a/perl-install/unused/cdrom.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-package cdrom;
-
-use diagnostics;
-use strict;
-
-use detect_devices;
-
-
-my %transTable = ( cm206 => 'cm206cd', sonycd535 => 'cdu535');
-
-1;
-
-
-sub setupCDdevicePanel {
- my ($type) = @_;
-}
-
-sub findAtapi {
- my $ide = ideGetDevices();
- foreach (@$ide) { $_->{type} eq 'cdrom' and return $_->{device} }
- error();
-}
-
-sub findSCSIcdrom {
- detect_devices::isSCSI() or return error();
- my $scsi = detect_devices::getSCSI();
- foreach (@$scsi) { $_->{type} eq 'cdrom' and return $_->{device} }
- error();
-}
-
-sub setupCDdevice {
- my ($cddev, $dl) = @_;
- #-TODO
-}
-
-sub removeCDmodule {
- #- this wil fail silently if no CD module has been loaded
- removeDeviceDriver('cdrom');
- 1;
-}
-
diff --git a/perl-install/unused/dns.pm b/perl-install/unused/dns.pm
deleted file mode 100644
index 5e6bb5f5b..000000000
--- a/perl-install/unused/dns.pm
+++ /dev/null
@@ -1,64 +0,0 @@
-use diagnostics;
-use strict;
-
-# This is dumb, but glibc doesn't like to do hostname lookups w/o libc.so
-
-
-#TODO TODO
-sub doQuery {
-# my ($query, $queryType, $domainName, $ipNum) = @_;
-#
-# _res.retry = 2;
-#
-# len = res_search(query, C_IN, queryType, (void *) &response,
-# sizeof(response));
-# if (len <= 0) return -1;
-#
-# if (ntohs(response.hdr.rcode) != NOERROR) return -1;
-# ancount = ntohs(response.hdr.ancount);
-# if (ancount < 1) return -1;
-#
-# data = response.buf + sizeof(HEADER);
-# end = response.buf + len;
-#
-# # skip the question
-# data += dn_skipname(data, end) + QFIXEDSZ;
-#
-# # parse the answer(s)
-# while (--ancount >= 0 && data < end) {
-#
-# # skip the domain name portion of the RR record
-# data += dn_skipname(data, end);
-#
-# # get RR information
-# GETSHORT(type, data);
-# data += INT16SZ; # skipp class
-# data += INT32SZ; # skipp TTL
-# GETSHORT(len, data);
-#
-# if (type == T_PTR) {
-# # we got a pointer
-# len = dn_expand(response.buf, end, data, name, sizeof(name));
-# if (len <= 0) return -1;
-# if (queryType == T_PTR && domainName) {
-# # we wanted a pointer
-# *domainName = malloc(strlen(name) + 1);
-# strcpy(*domainName, name);
-# return 0;
-# }
-# } else if (type == T_A) {
-# # we got an address
-# if (queryType == T_A && ipNum) {
-# # we wanted an address
-# memcpy(ipNum, data, sizeof(*ipNum));
-# return 0;
-# }
-# }
-#
-# # move ahead to next RR
-# data += len;
-# }
-#
-# return -1;
-}
-
diff --git a/perl-install/unused/otherinsmod.pm b/perl-install/unused/otherinsmod.pm
deleted file mode 100644
index 1a8eee9ff..000000000
--- a/perl-install/unused/otherinsmod.pm
+++ /dev/null
@@ -1,26 +0,0 @@
-use diagnostics;
-use strict;
-
-sub insmod {
-
- @_ or die "usage: insmod <module>.o [params]\n";
-
- my $file = shift;
- my $tmpname;
-
- unless (-r $file) {
- local *F;
- open F, "/modules/modules.cgz" or die "error opening /modules/modules.cgz";
-
- $tmpname = "/tmp/" . basename($file);
-
- installCpioFile(\*F, $file, $tmpname, 0) or die "error extracting file";
- }
-
- my $rc = insmod_main($tmpname || $file, @_);
-
- unlink($tmpname);
-
- return $rc;
-}
-sub modprobe { &insmod }
diff --git a/perl-install/unused/scsi.pm b/perl-install/unused/scsi.pm
deleted file mode 100644
index b92185d46..000000000
--- a/perl-install/unused/scsi.pm
+++ /dev/null
@@ -1,104 +0,0 @@
-use diagnostics;
-use strict;
-
-my $scsiDeviceAvailable;
-my $CSADeviceAvailable;
-
-1;
-
-sub scsiDeviceAvailable {
- defined $scsiDeviceAvailable and return $scsiDeviceAvailable;
- local *F;
- open F, "/proc/scsi/scsi" or log::l("failed to open /proc/scsi/scsi: $!"), return 0;
- foreach (<F>) {
- /devices: none/ and log::l("no scsi devices are available"), return $scsiDeviceAvailable = 0;
- }
- log::l("scsi devices are available");
- $scsiDeviceAvailable = 1;
-}
-
-sub CompaqSmartArrayDeviceAvailable {
- defined $CSADeviceAvailable and return $CSADeviceAvailable;
- -r "/proc/array/ida0" or log::l("failed to open /proc/array/ida0: $!"), return $CSADeviceAvailable = 0;
- log::l("Compaq Smart Array controllers available");
- $CSADeviceAvailable = 1;
-}
-
-sub scsiGetDevices {
- my @drives;
- my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
- my $err = sub { chop; log::l("unexpected line in /proc/scsi/scsi: $_"); error() };
- local $_;
-
- local *F;
- open F, "/proc/scsi/scsi" or return &$err();
- $_ = <F>; /^Attached devices:/ or return &$err();
- while ($_ = <F>) {
- my ($id) = /^Host:.*?Id: (\d+)/ or return &$err();
- $_ = <F>; my ($vendor, $model) = /^\s*Vendor:\s*(.*?)\s+Model:\s*(.*?)\s+Rev:/ or return &$err();
- $_ = <F>; my ($type) = /^\s*Type:\s*(.*)/ or &$err();
- my $device;
- if ($type =~ /Direct-Access/) {
- $type = 'hd';
- $device = "sd" . chr($driveNum++ + ord('a'));
- } elsif ($type =~ /Sequential-Access/) {
- $type = 'tape';
- $device = "st" . $tapeNum++;
- } elsif ($type =~ /CD-ROM/) {
- $type = 'cdrom';
- $device = "scd" . $cdromNum++;
- }
- $device and push @drives, { device => $device, type => $type, info => "$vendor $model", id => $id, bus => 0 };
- }
- [ @drives ];
-}
-
-sub ideGetDevices {
- my @idi;
-
- -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.
- 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;
- my ($info) = chop_(cat_("$d/model")); $info ||= "(none)";
-
- my $num = ord (($d =~ /(.)$/)[0]) - ord 'a';
- push @idi, { type => $type, device => basename($d), info => $info, bus => $num/2, id => $num%2 };
- }
- [ @idi ];
-}
-
-
-sub CompaqSmartArrayGetDevices {
- my @idi;
- my $f;
-
- for (my $i = 0; -r ($f = "/proc/array/ida$i"); $i++) {
- local *F;
- open F, $f or die;
- local $_ = <F>;
- my ($name) = m|ida/(.*?):| or next;
- push @idi, { device => $name, info => "Compaq RAID logical disk", type => 'hd' };
- }
- [ @idi ];
-}
-
-sub dac960GetDevices {
- my @idi;
- my $file = "/var/log/dmesg";
- -r $file or $file = "/tmp/syslog";
-
- 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
- foreach (<F>) {
- my ($devicename, $info) = m|/dev/rd/(.*?): (.*?),| or next;
- push @idi, { info => $info, type => 'hd', devicename => $devicename };
- log::l("DAC960: $devicename: $info");
- }
- [ @idi ];
-}
diff --git a/perl-install/verify_c b/perl-install/verify_c
deleted file mode 100755
index a306348dd..000000000
--- a/perl-install/verify_c
+++ /dev/null
@@ -1,14 +0,0 @@
-#!/usr/bin/perl -n
-
-/^#/ and next;
-/c::(\w+)/ and push @c, [ $1, $ARGV, $. ] ;
-
-eof && close ARGV;
-
-END {
- $_ = join '', `cat c/c.xs.pm`;
- foreach $c (@c) {
- /$c->[0]/ or $err = print "$c->[1]:$c->[2]: $c->[0] not in c.xs\n";
- }
- exit $err;
-}