diff options
Diffstat (limited to 'perl-install')
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; -} |