summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/Makefile4
-rw-r--r--perl-install/c/Makefile.PL2
-rwxr-xr-xperl-install/commands2
-rw-r--r--perl-install/common.pm8
-rw-r--r--perl-install/detect_devices.pm6
-rw-r--r--perl-install/fsedit.pm2
-rw-r--r--perl-install/install2.pm117
-rw-r--r--perl-install/install_any.pm161
-rw-r--r--perl-install/install_steps.pm151
-rw-r--r--perl-install/lang.pm2
-rw-r--r--perl-install/modules.pm2
-rw-r--r--perl-install/my_gtk.pm287
-rw-r--r--perl-install/pkgs.pm11
13 files changed, 442 insertions, 313 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile
index 178b3c15a..d71fdb961 100644
--- a/perl-install/Makefile
+++ b/perl-install/Makefile
@@ -1,5 +1,5 @@
SO_FILES = c/blib/arch/auto/c/c.so
-PMS = *.pm resize_fat/*.pm commands diskdrake
+PMS = *.pm c/*.pm resize_fat/*.pm commands diskdrake
DEST = /tmp/t
DESTREP4PMS = $(DEST)/usr/bin/perl-install
PERL = ./perl
@@ -21,7 +21,7 @@ tar: clean
cd .. ; tar cfy perl-install.tar.bz2 --exclude perl-install/perl perl-install
c/c.xs: c/c.xs.pm
- chmod u+w $@
+ rm -f $@
perl $< > $@
chmod a-w $@
diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL
index bb7eed0d1..355087a52 100644
--- a/perl-install/c/Makefile.PL
+++ b/perl-install/c/Makefile.PL
@@ -4,7 +4,7 @@ use ExtUtils::MakeMaker;
WriteMakefile(
'NAME' => 'c',
'VERSION_FROM' => 'c.pm', # finds $VERSION
- 'LIBS' => ['-ldb1 -lz'], # e.g., '-lm'
+ 'LIBS' => ['-lrpm -ldb1 -lz'], # e.g., '-lm'
# 'OBJECT' => 'c.o librpm.a',
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '-Wall', # e.g., '-I/usr/include/other'
diff --git a/perl-install/commands b/perl-install/commands
index 66574c7dc..e00f215de 100755
--- a/perl-install/commands
+++ b/perl-install/commands
@@ -3,7 +3,7 @@
use diagnostics;
use strict;
-use lib qw(/usr/bin/perl-install /home/pixel/perl-install . c c/blib/arch);
+use lib qw(/usr/bin/perl-install . c c/blib/arch);
use common qw(:file);
use commands;
diff --git a/perl-install/common.pm b/perl-install/common.pm
index 6c12961ef..e03c03114 100644
--- a/perl-install/common.pm
+++ b/perl-install/common.pm
@@ -2,11 +2,11 @@ package common;
use diagnostics;
use strict;
-use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $error $cancel $SECTORSIZE);
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int $cancel $SECTORSIZE);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- common => [ qw(min max bool member divide error cancel is_empty_array_ref round_up round_down first top) ],
+ common => [ qw(min max bool member divide is_empty_array_ref round_up round_down first top) ],
file => [ qw(dirname basename all glob_ cat_ chop_ mode) ],
system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ],
constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ],
@@ -16,8 +16,6 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int
$printable_chars = "\x20-\x7E";
$sizeof_int = psizeof("i");
$bitof_int = $sizeof_int * 8;
-$error = 0;
-$cancel = 0;
$SECTORSIZE = 512;
1;
@@ -29,8 +27,6 @@ sub top { $_[$#_] }
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 error { $error = 1; 0 }
-sub cancel { $cancel = 1; 0 }
sub bool { $_[0] ? 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>; @l }
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 8f1fac97d..6cc170368 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -53,12 +53,12 @@ sub hasCompaqSmartArray() {
sub getSCSI() {
my @drives;
my ($driveNum, $cdromNum, $tapeNum) = qw(0 0 0);
- my $err = sub { chop; log::l("unexpected line in /proc/scsi/scsi: $_"); error() };
+ my $err = sub { chop; die "unexpected line in /proc/scsi/scsi: $_"; };
local $_;
local *F;
- open F, "/proc/scsi/scsi" or return &$err();
- $_ = <F>; /^Attached devices:/ or return &$err();
+ 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();
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 62c384832..ecc13a79f 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -42,7 +42,7 @@ sub hds($$) {
eval { $rc = partition_table::read($hd, $flags->{clearall}) };
if ($@) {
$@ =~ /bad magic number/ or die;
- partition_table_raw::zero_MBR($hd) if $flags->{forcezero};
+ partition_table_raw::zero_MBR($hd) if $flags->{eraseBadPartitions};
}
$rc ? push @hds, $hd : log::l("An error occurred reading the partition table for the block device $_->{device}");
}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index d752a17d6..6b5d722e1 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -4,38 +4,27 @@
use diagnostics;
use strict;
-use vars qw($testing $error $cancel $INSTALL_VERSION);
+use vars qw($testing $INSTALL_VERSION $o);
-use lib qw(/usr/bin/perl-install . c/blib/arch);
-use install2more;
-use c;
+use lib qw(/usr/bin/perl-install . c c/blib/arch);
use common qw(:common :file :system);
-use devices;
+use install_any qw(:all);
use log;
use net;
use keyboard;
-use pkgs;
-use smp;
use fs;
-use setup;
use fsedit;
+use install_steps;
use install_methods;
-use lilo;
-use swap;
-use install_steps_graphical;
use modules;
use partition_table qw(:types);
use detect_devices;
-use commands;
-$error = 0;
-$cancel = 0;
-$testing = $ENV{PERL_INSTALL_TEST};
+$testing = 1;#$ENV{PERL_INSTALL_TEST};
$INSTALL_VERSION = 0;
my @installStepsFields = qw(text skipOnCancel skipOnLocal prev next);
my @installSteps = (
- selectPath => [ "Select installation path", 0, 0, 'none' ],
selectInstallClass => [ "Select installation class", 0, 0 ],
setupSCSI => [ "Setup SCSI", 0, 1 ],
partitionDisks => [ "Setup filesystems", 0, 1 ],
@@ -49,7 +38,6 @@ my @installSteps = (
# configurePrinter => [ "Configure printer", 0, 0 ],
setRootPassword => [ "Set root password", 0, 0 ],
addUser => [ "Add a user", 0, 0 ],
- configureAuth => [ "Configure authentication", 0, 0 ],
createBootdisk => [ "Create bootdisk", 0, 1 ],
setupBootloader => [ "Install bootloader", 0, 1 ],
# configureX => [ "Configure X", 0, 0 ],
@@ -58,7 +46,6 @@ my @installSteps = (
# this table is translated at run time
my @upgradeSteps = (
- selectPath => [ "Select installation path", 0, 0 , 'none' ],
setupSCSI => [ "Setup SCSI", 0, 0 ],
upgrFindInstall => [ "Find current installation", 0, 0 ],
findInstallFiles => [ "Find installation files", 1, 0 ],
@@ -99,15 +86,14 @@ my $default = {
display => "129.104.42.9:0",
user => { name => 'foo', password => 'foo', shell => '/bin/bash', realname => 'really, it is foo' },
rootPassword => 'toto',
- keyboard => 'us',
+ lang => 'us',
isUpgrade => 0,
installClass => 'Server',
- bootloader => { onmbr => 1,
- linear => 1,
- },
+ bootloader => { onmbr => 0, linear => 0 },
mkbootdisk => 0,
comps => [ qw() ],
packages => [ qw() ],
+ partitionning => { clearall => 1, eraseBadPartitions => 1 },
partitions => [
{ mntpoint => "/boot", size => 16 << 11, type => 0x83 },
{ mntpoint => "/", size => 300 << 11, type => 0x83 },
@@ -115,7 +101,7 @@ my $default = {
{ mntpoint => "swap", size => 64 << 11, type => 0x82 }
],
};
-my $o = { default => $default };
+$o = { default => $default };
sub selectPath {
@@ -125,10 +111,14 @@ sub selectPath {
sub selectInstallClass {
$o->{installClass} = $o->selectInstallClass;
+
+ if ($o->{installClass} eq 'Server') {
+ #TODO
+ }
}
sub setupSCSI {
- $o->{direction} < 0 && detect_devices::hasSCSI() and return cancel();
+ $o->{direction} < 0 && detect_devices::hasSCSI() and return;
# If we have any scsi adapters configured from earlier, then don't bother asking again
while (my ($k, $v) = each %modules::loaded) {
@@ -139,14 +129,16 @@ sub setupSCSI {
sub partitionDisks {
$o->{drives} = [ detect_devices::hds() ];
- $o->{hds} = fsedit::hds($o->{drives}, $o->{hints}->{partitioning}->{flags});
+ $o->{hds} = fsedit::hds($o->{drives}, $o->{default}->{partitionning});
@{$o->{hds}} > 0 or 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";
unless ($o->{isUpgrade}) {
- $o->doPartitionDisks($o->{hds}, $o->{fstab_wanted});
+ $o->doPartitionDisks($o->{hds});
- # Write partitions to disk
- foreach (@{$o->{hds}}) { partition_table::write($_); }
+ unless ($testing) {
+ # Write partitions to disk
+ foreach (@{$o->{hds}}) { partition_table::write($_); }
+ }
}
$o->{fstab} = [ fsedit::get_fstab(@{$o->{hds}}) ];
@@ -154,6 +146,7 @@ sub partitionDisks {
my $root_fs; map { $_->{mntpoint} eq '/' and $root_fs = $_ } @{$o->{fstab}};
$root_fs or die "partitionning failed: no root filesystem";
+ $testing and return;
if ($o->{hints}->{flags}->{autoformat}) {
log::l("formatting all filesystems");
@@ -169,77 +162,41 @@ sub findInstallFiles {
$o->{comps} = $o->{method}->getComponentSet($o->{packages});
}
-sub choosePackages {
- $o->choosePackages($o->{packages}, $o->{comps}, $o->{isUpgrade});
-}
+sub choosePackages { $o->choosePackages($o->{packages}, $o->{comps}); }
sub doInstallStep {
$testing and return 0;
- $o->beforeInstallPackages($o->{fstab});
+ $o->beforeInstallPackages;
$o->installPackages($o->{packages});
- $o->afterInstallPackages($o->{keyboard});
-}
-
-sub configureMouse { setup::mouseConfig($o->{rootPath}); }
-
-sub finishNetworking {
-#
-# rc = checkNetConfig(&$o->{intf}, &$o->{netc}, &$o->{intfFinal},
-# &$o->{netcFinal}, &$o->{driversLoaded}, $o->{direction});
-#
-# if (rc) return rc;
-#
-# sprintf(path, "%s/etc/sysconfig", $o->{rootPath});
-# writeNetConfig(path, &$o->{netcFinal},
-# &$o->{intfFinal}, 0);
-# strcat(path, "/network-scripts");
-# writeNetInterfaceConfig(path, &$o->{intfFinal});
-# sprintf(path, "%s/etc", $o->{rootPath});
-# writeResolvConf(path, &$o->{netcFinal});
-#
-# # this is a bit of a hack
-# writeHosts(path, &$o->{netcFinal},
-# &$o->{intfFinal}, !$o->{isUpgrade});
-#
-# return 0;
-}
-
-sub configureTimezone { setup::timeConfig($o->{rootPath}) }
-sub configureServices { setup::servicesConfig($o->{rootPath}) }
-
-sub setRootPassword {
- $testing and return 0;
-
- $o->setRootPassword($o->{rootPath});
+ $o->afterInstallPackages;
}
-sub addUser {
- $o->addUser($o->{rootPath});
-}
+sub configureMouse { $o->mouseConfig }
+sub finishNetworking { $o->finishNetworking }
+sub configureTimezone { $o->timeConfig }
+sub configureServices { $o->servicesConfig }
+sub setRootPassword { $o->setRootPassword }
+sub addUser { $o->addUser }
sub createBootdisk {
+ $testing and return;
$o->{isUpgrade} or fs::write('mnt', $o->{fstab});
modules::write_conf("/mnt/etc/conf.modules", 'append');
-
- $o->{mkbootdisk} and lilo::mkbootdisk("/mnt", versionString());
+ $o->createBootdisk;
}
sub setupBootloader {
- my $versionString = versionString();
- log::l("installed kernel version $versionString");
-
$o->{isUpgrade} or modules::read_conf("/mnt/etc/conf.modules");
-
- lilo::install("/mnt", $o->{hds}, $o->{fstab}, $versionString, $o->{bootloader});
+ $o->setupBootloader;
}
-sub configureX { $o->setupXfree($o->{method}, $o->{rootPath}, $o->{packages}); }
+sub configureX { $o->setupXfree; }
sub exitInstall { $o->exitInstall }
sub main {
- SIG{__DIE__} = sub { log::l("ERROR: $_[0]") };
+ $SIG{__DIE__} = sub { chomp $_[0]; log::l("ERROR: $_[0]") };
# if this fails, it's okay -- it might help with free space though
unlink "/sbin/install";
@@ -254,7 +211,7 @@ sub main {
$o->{rootPath} = "/mnt";
$o->{method} = install_methods->new('cdrom');
- $o = install_steps_graphical->new($o);
+ $o = install_steps->new($o);
$o->{lang} = $o->chooseLanguage;
@@ -277,6 +234,8 @@ sub main {
$o->{keyboard} = eval { keyboard::read("/tmp/keyboard") } || $default->{keyboard};
+ selectPath();
+
for (my $step = $o->{steps}->{first}; $step ne 'done'; $step = getNextStep($step)) {
log::l("entering step $step");
&{$main::{$step}}() and $o->{steps}->{completed} = 1;
diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm
new file mode 100644
index 000000000..514b940e7
--- /dev/null
+++ b/perl-install/install_any.pm
@@ -0,0 +1,161 @@
+package install_any;
+
+use diagnostics;
+use strict;
+use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
+
+@ISA = qw(Exporter);
+%EXPORT_TAGS = (
+ all => [ qw(versionString getNextStep doSuspend spawnSync spawnShell) ],
+);
+@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+
+use common qw(:system);
+use log;
+
+1;
+
+sub versionString {
+ my $kernel = $::o->{packages}->{kernel} or die "I couldn't find the kernel package!";
+
+ c::headerGetEntry($kernel->{header}, 'version') . "-" .
+ c::headerGetEntry($kernel->{header}, 'release');
+}
+
+
+sub getNextStep {
+ my ($lastStep) = @_;
+
+ $::o->{direction} = 1;
+
+ return $::o->{lastChoice} = $::o->{steps}->{$lastStep}->{next};
+}
+
+sub doSuspend {
+ exit 1 if $::o->{localInstall} || $::testing;
+
+ if (my $pid = fork) {
+ waitpid $pid, 0;
+ } else {
+ print "\n\nType <exit> to return to the install program.\n\n";
+ exec {"/bin/sh"} "-/bin/sh";
+ warn "error execing /bin/sh";
+ sleep 5;
+ exit 1;
+ }
+}
+
+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 upgrFindInstall {
+# int rc;
+#
+# if (!$::o->{table}.parts) {
+# rc = findAllPartitions(NULL, &$::o->{table});
+# if (rc) return rc;
+# }
+#
+# umountFilesystems(&$::o->{fstab});
+#
+# # rootpath upgrade support
+# if (strcmp($::o->{rootPath} ,"/mnt"))
+# return INST_OKAY;
+#
+# # this also turns on swap for us
+# rc = readMountTable($::o->{table}, &$::o->{fstab});
+# if (rc) return rc;
+#
+# if (!testing) {
+# mountFilesystems(&$::o->{fstab});
+#
+# if ($::o->{method}->prepareMedia) {
+# rc = $::o->{method}->prepareMedia($::o->{method}, &$::o->{fstab});
+# if (rc) {
+# umountFilesystems(&$::o->{fstab});
+# return rc;
+# }
+# }
+# }
+#
+# return 0;
+}
+
+sub upgrChoosePackages {
+# static int firstTime = 1;
+# char * rpmconvertbin;
+# int rc;
+# char * path;
+# char * argv[] = { NULL, NULL };
+# char buf[128];
+#
+# if (testing)
+# path = "/";
+# else
+# path = $::o->{rootPath};
+#
+# if (firstTime) {
+# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath},
+# "/var/lib/rpm/packages.rpm");
+# if (access(buf, R_OK)) {
+# snprintf(buf, sizeof(buf), "%s%s", $::o->{rootPath},
+# "/var/lib/rpm/packages");
+# if (access(buf, R_OK)) {
+# errorWindow("No RPM database exists!");
+# return INST_ERROR;
+# }
+#
+# if ($::o->{method}->getFile($::o->{method}, "rpmconvert",
+# &rpmconvertbin)) {
+# return INST_ERROR;
+# }
+#
+# symlink("/mnt/var", "/var");
+# winStatus(35, 3, _("Upgrade"), _("Converting RPM database..."));
+# chmod(rpmconvertbin, 0755);
+# argv[0] = rpmconvertbin;
+# rc = runProgram(RUN_LOG, rpmconvertbin, argv);
+# if ($::o->{method}->rmFiles)
+# unlink(rpmconvertbin);
+#
+# newtPopWindow();
+# if (rc) return INST_ERROR;
+# }
+# winStatus(35, 3, "Upgrade", _("Finding packages to upgrade..."));
+# rc = ugFindUpgradePackages(&$::o->{packages}, path);
+# newtPopWindow();
+# if (rc) return rc;
+# firstTime = 0;
+# psVerifyDependencies(&$::o->{packages}, 1);
+# }
+#
+# return psSelectPackages(&$::o->{packages}, &$::o->{comps}, NULL, 0, 1);
+}
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 9e4a3c1c0..2cee5dbe2 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -4,6 +4,8 @@ use diagnostics;
use strict;
use common qw(:file :system);
+use install_any qw(:all);
+use lilo;
use lang;
use keyboard;
use pkgs;
@@ -14,48 +16,50 @@ use commands;
use smp;
+my $o;
+
1;
sub new($$) {
- my ($type, $o) = @_;
+ my ($type, $o_) = @_;
+
+ $o = bless $o_, ref $type || $type;
+}
- bless $o, ref $type || $type;
+sub chooseLanguage($) {
+ $o->{default}->{lang}
}
sub selectInstallOrUpgrade($) {
- my ($o) = @_;
- $o->{isUpgrade} || $o->{default}->{isUpgrade} || 0;
+ $o->{default}->{isUpgrade} || 0;
}
sub selectInstallClass($) {
- my ($o) = @_;
- $o->{installClass} || $o->{default}->{installClass} || 'Custom';
+ $o->{default}->{installClass} || 'Custom';
}
sub setupSCSIInterfaces {
die "TODO";
}
-sub doPartitionDisks($$$) {
+sub doPartitionDisks($$) {
my ($o, $hds) = @_;
- fsedit::auto_allocate($hds, $o->{partitions});
+ fsedit::auto_allocate($hds, $o->{default}->{partitions});
}
sub choosePackages($$$) {
my ($o, $packages, $comps) = @_;
- foreach ('base', @{$o->{comps}}) {
+ foreach ('base', @{$o->{default}->{comps}}) {
$comps->{$_}->{selected} = 1;
- foreach (@{$_->{packages}}) { $_->{selected} = 1; }
+ foreach (@{$comps->{$_}->{packages}}) { $_->{selected} = 1; }
}
- foreach (@{$o->{packages}}) { $_->{selected} = 1; }
+ foreach (@{$o->{default}->{packages}}) { $packages->{$_}->{selected} = 1; }
smp::detect() and $packages->{"kernel-smp"}->{selected} = 1;
}
-sub beforeInstallPackages($$) {
- my ($o, $fstab) = @_;
-
- $o->{method}->prepareMedia($fstab);
+sub beforeInstallPackages($) {
+ $o->{method}->prepareMedia($o->{fstab});
foreach (qw(dev etc home mnt tmp var var/tmp var/lib var/lib/rpm)) {
mkdir "$o->{prefix}/$_", 0755;
@@ -75,11 +79,11 @@ sub installPackages($$) {
pkgs::install($o->{prefix}, $o->{method}, $toInstall, $o->{isUpgrade}, 0);
}
-sub afterInstallPackages($$) {
- my ($o, $keymap) = @_;
+sub afterInstallPackages($) {
+ my ($o) = @_;
unless ($o->{isUpgrade}) {
- keyboard::write($o->{prefix}, $keymap);
+ keyboard::write($o->{prefix}, $o->{keymap});
lang::write($o->{prefix});
}
# why not?
@@ -88,6 +92,36 @@ sub afterInstallPackages($$) {
# configPCMCIA($o->{rootPath}, $o->{pcmcia});
}
+sub mouseConfig($) {
+ #TODO
+}
+
+sub finishNetworking($) {
+ my ($o) = @_;
+#
+# rc = checkNetConfig(&$o->{intf}, &$o->{netc}, &$o->{intfFinal},
+# &$o->{netcFinal}, &$o->{driversLoaded}, $o->{direction});
+#
+# if (rc) return rc;
+#
+# sprintf(path, "%s/etc/sysconfig", $o->{rootPath});
+# writeNetConfig(path, &$o->{netcFinal},
+# &$o->{intfFinal}, 0);
+# strcat(path, "/network-scripts");
+# writeNetInterfaceConfig(path, &$o->{intfFinal});
+# sprintf(path, "%s/etc", $o->{rootPath});
+# writeResolvConf(path, &$o->{netcFinal});
+#
+# # this is a bit of a hack
+# writeHosts(path, &$o->{netcFinal},
+# &$o->{intfFinal}, !$o->{isUpgrade});
+#
+# return 0;
+}
+
+sub timeConfig {}
+sub servicesConfig {}
+
sub addUser($) {
my ($o) = @_;
my $p = $o->{prefix};
@@ -106,6 +140,7 @@ sub addUser($) {
my $pw = crypt_($o->{user}->{password});
+ $::testing and return;
local *F;
open F, ">> $p/etc/passwd" or die "can't append to passwd file: $!";
print F "$o->{user}->{name}:$pw:$new_uid:$new_gid:$o->{user}->{realname}:/home/$o->{user}->{name}:$o->{user}->{shell}\n";
@@ -117,13 +152,25 @@ sub addUser($) {
commands::chown_("-r", "$new_uid.$new_gid", $homedir);
}
-sub setRootPassword($$) {
+sub createBootdisk($) {
+ lilo::mkbootdisk("/mnt", versionString()) if $o->{mkbootdisk} || $o->{default}->{mkbootdisk};
+}
+
+sub setupBootloader($) {
+ my ($o) = @_;
+ my $versionString = versionString();
+ log::l("installed kernel version $versionString");
+ lilo::install($o->{prefix}, $o->{hds}, $o->{fstab}, $versionString, $o->{bootloader} || $o->{default}->{bootloader});
+}
+
+sub setRootPassword($) {
my ($o) = @_;
my $p = $o->{prefix};
my $pw = $o->{rootPassword};
$pw = crypt_($pw);
my @lines = cat_("$p/etc/passwd", 'die');
+ $::testing and return;
local *F;
open F, "> $p/etc/passwd" or die "can't write in passwd: $!\n";
foreach (@lines) {
@@ -134,68 +181,14 @@ sub setRootPassword($$) {
sub setupXfree {
+ my ($o) = @_;
+ my $x = $o->{default}->{Xserver} or return;
+ $o->{packages}->{$x} or die "can't find X server $x";
- if (rpmdbOpen(prefix, &db, O_RDWR | O_CREAT, 0644)) {
- errorWindow(_("Fatal error reopening RPM database"));
- return INST_ERROR;
- }
- log::l("reopened rpm database");
-
- sprintf(path, "%s/tmp/SERVER", prefix);
- if ((fd = open(path, O_RDONLY)) < 0) {
- log::l("failed to open %s: %s", path, strerror(errno));
- return INST_ERROR;
- }
-
- buf[0] = '\0';
- read(fd, buf, sizeof(buf));
- close(fd);
- chptr = buf;
- while (chptr < (buf + sizeof(buf) - 1) && *chptr && *chptr != ' ')
- chptr++;
-
- if (chptr >= (buf + sizeof(buf) - 1) || *chptr != ' ') {
- log::l("couldn't find ' ' in %s", path);
- return INST_ERROR;
- }
-
- *chptr = '\0';
- strcpy(server, "XFree86-");
- strcat(server, buf);
-
- log::l("I will install the %s package", server);
-
- for (i = 0; i < psp->numPackages; i++) {
- if (!strcmp(psp->packages[i]->name, server)) {
- log::l("\tfound package: %s", psp->packages[i]->name);
- swOpen(1, psp->packages[i]->size);
- trans = rpmtransCreateSet(db, prefix);
- rpmtransAddPackage(trans, psp->packages[i]->h, NULL,
- psp->packages[i], 0, NULL);
-
- cbi.method = method;
- cbi.upgrade = 0;
-
- rpmRunTransactions(trans, swCallback, &cbi, NULL, &probs, 0,
- 0xffffffff);
-
- swClose();
- break;
- }
- }
-
- # this handles kickstart and normal/expert modes
- if ((rc=xfree86Config(prefix, "--continue")))
- return INST_ERROR;
-
- # done with proc now
- umount(procPath);
-
- rpmdbClose(db);
-
- log::l("rpm database closed");
+ log::l("I will install the $x package");
+ pkgs::install($o->{prefix}, $o->{method}, $o->{packages}->{$x}, $o->{isUpgrade}, 0);
- return INST_OKAY;
+ #TODO
}
sub exitInstall {}
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index 1d2d6a7f8..a14c7c3ca 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -24,6 +24,8 @@ my %languages = (
1;
+sub list { keys %languages }
+
sub set {
my $lang = shift;
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 8e072ec25..c4fd81798 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -217,7 +217,7 @@ sub load_raw($$$@) {
# @options or @options = guiGetModuleOptions($name);
- run_program::run("/usr/bin/insmod", "/modules/$name.o", @options) or die("insmod module $name");
+ run_program::run("/usr/bin/insmod", "/modules/$name.o", @options) or die("insmod $name failed");
# this is a hack to make plip go
if ($name eq "parport_pc") {
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index a6f1101d5..1205a7eda 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK);
@ISA = qw(Exporter);
%EXPORT_TAGS = (
- all => [ qw(create_window create_yesorno createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment mymain my_signal_connect mypack mypack_ myappend myadd label_align myset_usize myset_justify myshow mysync myflush mydestroy) ],
+ all => [ qw(ask_warn ask_yesorno ask_from_entry ask_from_list create_yesorno createScrolledWindow create_menu create_notebook create_packtable create_hbox create_adjustment gtksignal_connect gtkpack gtkpack_ gtkappend gtkadd gtkset_usize gtkset_justify gtkshow gtkdestroy) ],
);
@EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
@@ -14,101 +14,118 @@ use Gtk;
1;
-
+################################################################################
+# OO stuff
+################################################################################
sub new {
my ($type, $title, @opts) = @_;
Gtk->init;
parse Gtk::Rc "$ENV{HOME}/etc/any/Gtkrc";
my $o = bless { @opts }, $type;
- $o->{window} = $o->create_window($title);
+ $o->{window} = $o->_create_window($title);
$o;
}
+sub main($) {
+ my $o = shift;
+ $o->{window}->show;
+ Gtk->main;
+ $o->destroy;
+ $o->{retval}
+}
sub destroy($) {
my ($o) = @_;
$o->{window}->destroy;
- myflush();
+ flush();
}
+sub sync($) {
+ my ($o) = @_;
+ $o->{window}->show;
-sub ask_from_entry($$@) {
- my ($o, @msgs) = @_;
- my $entry = new Gtk::Entry;
- my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit };
-
- myadd($o->{window},
- mypack($o->create_box_with_title(@msgs),
- my_signal_connect($entry, 'activate' => $f),
- ($o->{hide_buttons} ? () : mypack(new Gtk::HBox(0,0),
- my_signal_connect(new Gtk::Button('Ok'), 'clicked' => $f),
- my_signal_connect(new Gtk::Button('Cancel'), 'clicked' => sub { $o->{retval} = undef; Gtk->main_quit }),
- )),
- ),
- );
- $entry->grab_focus();
- mymain($o);
+ my $h = Gtk->idle_add(sub { Gtk->main_quit; 1 });
+ map { Gtk->main } (1..4);
+ Gtk->idle_remove($h);
+}
+sub flush(;$) {
+ Gtk->main_iteration while Gtk::Gdk->events_pending;
+}
+sub bigsize($) {
+ $_[0]->{window}->set_usize(600,400);
}
-sub ask_from_list($\@$@) {
- my ($o, $l, @msgs) = @_;
- my $f = sub { $o->{retval} = $_[1]; Gtk->main_quit };
- my @l = map { my_signal_connect(new Gtk::Button($_), "clicked" => $f, $_) } @$l;
+sub gtkshow($) { $_[0]->show; $_[0] }
+sub gtkdestroy($) { $_[0] and $_[0]->destroy }
+sub gtkset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
+sub gtkset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
-# myadd($o->{window},
-# mypack_(myset_usize(new Gtk::VBox(0,0), 0, 200),
-# 0, $o->create_box_with_title(@msgs),
-# 1, createScrolledWindow(mypack(new Gtk::VBox(0,0), @l))));
- myadd($o->{window},
- mypack($o->create_box_with_title(@msgs), @l));
- $l[0]->grab_focus();
- mymain($o)
+sub gtksignal_connect($@) {
+ my $w = shift;
+ $w->signal_connect(@_);
+ $w
+}
+sub gtkpack($@) {
+ my $box = shift;
+ foreach (@_) {
+ my $l = $_;
+ ref $l or $l = new Gtk::Label($l);
+ $box->pack_start($l, 1, 1, 0);
+ $l->show;
+ }
+ $box
+}
+sub gtkpack_($@) {
+ my $box = shift;
+ for (my $i = 0; $i < @_; $i += 2) {
+ my $l = $_[$i + 1];
+ ref $l or $l = new Gtk::Label($l);
+ $box->pack_start($l, $_[$i], 1, 0);
+ $_[$i + 1]->show;
+ }
+ $box
+}
+sub gtkappend($@) {
+ my $w = shift;
+ foreach (@_) {
+ my $l = $_;
+ ref $l or $l = new Gtk::Label($l);
+ $w->append($l);
+ $l->show;
+ }
+ $w
+}
+sub gtkadd($@) {
+ my $w = shift;
+ foreach (@_) {
+ my $l = $_;
+ ref $l or $l = new Gtk::Label($l);
+ $w->add($l);
+ $l->show;
+ }
+ $w
}
-sub ask_warn($@) {
- my ($o, @msgs) = @_;
-
- myadd($o->{window},
- mypack($o->create_box_with_title(@msgs),
- my_signal_connect(my $w = new Gtk::Button("Ok"), "clicked" => sub { Gtk->main_quit }),
- ),
- );
- $w->grab_focus();
- mymain($o)
-}
-sub ask_yesorno($@) {
- my ($o, @msgs) = @_;
- myadd($o->{window},
- mypack(create_box_with_title($o, @msgs),
- create_yesorno($o),
- )
- );
- $o->{ok}->grab_focus();
- mymain($o)
-}
+################################################################################
+# createXXX functions
-sub create_window($$) {
- my ($o, $title) = @_;
- $o->{window} = new Gtk::Window;
- $o->{window}->set_title($title);
- $o->{window}->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
- $o->{window}
-}
+# these functions return a widget
+################################################################################
sub create_yesorno($) {
my ($w) = @_;
- myadd(create_hbox(),
- my_signal_connect($w->{ok} = new Gtk::Button("Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
- my_signal_connect(new Gtk::Button("Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
+ gtkadd(create_hbox(),
+ gtksignal_connect($w->{ok} = new Gtk::Button("Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }),
+ gtksignal_connect(new Gtk::Button("Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }),
);
}
sub create_box_with_title($@) {
my $o = shift;
- $o->{box} = mypack(new Gtk::VBox(0,0),
+ $o->{box} = gtkpack(new Gtk::VBox(0,0),
map({ new Gtk::Label(" $_ ") } @_),
new Gtk::HSeparator,
)
@@ -125,7 +142,7 @@ sub createScrolledWindow($) {
sub create_menu($@) {
my $title = shift;
my $w = new Gtk::MenuItem($title);
- $w->set_submenu(myshow(myappend(new Gtk::Menu, @_)));
+ $w->set_submenu(gtkshow(gtkappend(new Gtk::Menu, @_)));
$w
}
@@ -174,88 +191,88 @@ sub create_hbox {
$w;
}
-sub mymain($) {
- my $o = shift;
- $o->{window}->show;
- Gtk->main;
- $o->{window}->destroy;
- myflush();
- $o->{retval}
+sub _create_window($$) {
+ my ($o, $title) = @_;
+ $o->{window} = new Gtk::Window;
+ $o->{window}->set_title($title);
+ $o->{window}->signal_connect("delete_event" => sub { $o->{retval} = undef; Gtk->main_quit });
+ $o->{window}
}
-sub my_signal_connect($@) {
- my $w = shift;
- $w->signal_connect(@_);
- $w
-}
-sub mypack($@) {
- my $box = shift;
- foreach (@_) {
- my $l = $_;
- ref $l or $l = new Gtk::Label($l);
- $box->pack_start($l, 1, 1, 0);
- $l->show;
- }
- $box
-}
-sub mypack_($@) {
- my $box = shift;
- for (my $i = 0; $i < @_; $i += 2) {
- my $l = $_[$i + 1];
- ref $l or $l = new Gtk::Label($l);
- $box->pack_start($l, $_[$i], 1, 0);
- $_[$i + 1]->show;
- }
- $box
+
+################################################################################
+# ask_XXX
+
+# just give a title and some args, and it will return the value given by the user
+################################################################################
+
+sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); }
+sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_yesorno(@_, "Is it ok?"); main($w); }
+sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); }
+sub ask_from_list { my $w = my_gtk->new(shift @_); $w->_ask_from_list(pop @_, @_); main($w); }
+
+sub _ask_from_entry($$@) {
+ my ($o, @msgs) = @_;
+ my $entry = new Gtk::Entry;
+ my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit };
+
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@msgs),
+ gtksignal_connect($entry, 'activate' => $f),
+ ($o->{hide_buttons} ? () : gtkpack(new Gtk::HBox(0,0),
+ gtksignal_connect(new Gtk::Button('Ok'), 'clicked' => $f),
+ gtksignal_connect(new Gtk::Button('Cancel'), 'clicked' => sub { $o->{retval} = undef; Gtk->main_quit }),
+ )),
+ ),
+ );
+ $entry->grab_focus();
}
+sub _ask_from_list($\@$@) {
+ my ($o, $l, @msgs) = @_;
+ my $f = sub { $o->{retval} = $_[1]; Gtk->main_quit };
+ my @l = map { gtksignal_connect(new Gtk::Button($_), "clicked" => $f, $_) } @$l;
-sub myappend($@) {
- my $w = shift;
- foreach (@_) {
- my $l = $_;
- ref $l or $l = new Gtk::Label($l);
- $w->append($l);
- $l->show;
- }
- $w
+# gtkadd($o->{window},
+# gtkpack_(myset_usize(new Gtk::VBox(0,0), 0, 200),
+# 0, $o->create_box_with_title(@msgs),
+# 1, createScrolledWindow(gtkpack(new Gtk::VBox(0,0), @l))));
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@msgs), @l));
+ $l[0]->grab_focus();
}
-sub myadd($@) {
- my $w = shift;
- foreach (@_) {
- my $l = $_;
- ref $l or $l = new Gtk::Label($l);
- $w->add($l);
- $l->show;
- }
- $w
+
+sub _ask_warn($@) {
+ my ($o, @msgs) = @_;
+ gtkadd($o->{window},
+ gtkpack($o->create_box_with_title(@msgs),
+ gtksignal_connect(my $w = new Gtk::Button("Ok"), "clicked" => sub { Gtk->main_quit }),
+ ),
+ );
+ $w->grab_focus();
}
-sub myshow($) { $_[0]->show; $_[0] }
-sub mysync(;$) {
- my ($o) = @_;
- $o and $o->{window}->show;
+sub _ask_yesorno($@) {
+ my ($o, @msgs) = @_;
- my $h = Gtk->idle_add(sub { Gtk->main_quit; 1 });
- map { Gtk->main } (1..4);
- Gtk->idle_remove($h);
-}
-sub myflush(;$) {
- Gtk->main_iteration while Gtk::Gdk->events_pending;
+ gtkadd($o->{window},
+ gtkpack(create_box_with_title($o, @msgs),
+ create_yesorno($o),
+ )
+ );
+ $o->{ok}->grab_focus();
}
+################################################################################
+# rubbish
+################################################################################
-sub bigsize($) { $_[0]->{window}->set_usize(600,400); }
-sub myset_usize($$$) { $_[0]->set_usize($_[1],$_[2]); $_[0] }
-sub myset_justify($$) { $_[0]->set_justify($_[1]); $_[0] }
-sub mydestroy($) { $_[0] and $_[0]->destroy }
-
-sub label_align($$) {
- my $w = shift;
- local $_ = shift;
- $w->set_alignment(!/W/i, !/N/i);
- $w
-}
+#sub label_align($$) {
+# my $w = shift;
+# local $_ = shift;
+# $w->set_alignment(!/W/i, !/N/i);
+# $w
+#}
diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm
index e5d4247ac..79a7ae6ca 100644
--- a/perl-install/pkgs.pm
+++ b/perl-install/pkgs.pm
@@ -2,6 +2,7 @@ package pkgs;
use diagnostics;
use strict;
+use vars qw($fd);
use common qw(:common :file);
use log;
@@ -15,12 +16,12 @@ my @skipThesesPackages = qw(XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach
1;
-sub skipThisPackage { member($_[0], @skipList) }
+sub skipThisPackage { member($_[0], @skipThesesPackages) }
sub addInfosFromHeader($$) {
my ($packages, $header) = @_;
- $packages{c::headerGetEntry($header, 'name')} = {
+ $packages->{c::headerGetEntry($header, 'name')} = {
header => $header, size => c::headerGetEntry($header, 'size'),
group => c::headerGetEntry($header, 'group') || "(unknown group)",
};
@@ -37,7 +38,7 @@ sub psUsingDirectory {
open F, $_ or log::l("failed to open package $_: $!");
my $header = c::rpmReadPackageHeader($_) or log::l("failed to rpmReadPackageHeader $basename: $!");
my $name = c::headerGetEntry($header, 'name');
- addInfosFromHeader($package, $header);
+ addInfosFromHeader(\%packages, $header);
}
\%packages;
}
@@ -128,7 +129,7 @@ sub psFromHeaderListDesc {
$noSeek and last;
die "error reading header at offset ", sysseek($fd, 0, 1);
}
- addInfosFromHeader($packages, $header);
+ addInfosFromHeader(\%packages, $header);
$noSeek or $end <= sysseek($fd, 0, 1) and last;
}
@@ -149,7 +150,7 @@ sub init_db {
my $f = "$prefix/tmp/" . ($isUpgrade ? "upgrade" : "install") . ".log";
open(F, "> $f") ? log::l("opened $f") : log::l("Failed to open $f. No install log will be kept.");
- my $fd = fileno(F) || log::fd() || 2;
+ $fd = fileno(F) || log::fd() || 2;
c::rpmErrorSetCallback($fd);
# c::rpmSetVeryVerbose();
generated by cgit v1.2.1 (git 2.21.0) at 2024-11-02 23:40:38 +0000