* added perl-ified slxos-setup script and the relevant perl-modules, still not done, but

  nearly there


git-svn-id: http://svn.openslx.org/svn/openslx/trunk@698 95ad53e4-c205-0410-b2fa-d234c58c8868

1 files changed, 650 insertions, 0 deletions

diff --git a/installer/OpenSLX/OSSetup/Engine.pm b/installer/OpenSLX/OSSetup/Engine.pm
new file mode 100644
index 00000000..b17a094b
--- /dev/null
+++ b/installer/OpenSLX/OSSetup/Engine.pm
@@ -0,0 +1,650 @@
+# Engine.pm - provides driver enginge for the OSSetup API.
+#
+# (c) 2006 - OpenSLX.com
+#
+# Oliver Tappe <ot@openslx.com>
+#
+package OpenSLX::OSSetup::Engine;
+
+use vars qw($VERSION);
+$VERSION = 1.01;		# API-version . implementation-version
+
+use strict;
+use Carp;
+use File::Basename;
+use OpenSLX::Basics;
+
+################################################################################
+### interface methods
+################################################################################
+sub new
+{
+	my $class = shift;
+
+	my $self = {
+	};
+
+	return bless $self, $class;
+}
+
+sub initialize
+{
+	my $self = shift;
+	my $distroName = shift;
+	my $protectSystemPath = shift;
+
+	# load module for the requested distro:
+	$distroName = uc($distroName);
+	$distroName =~ tr[-.][_];
+	my $distroModule = "OpenSLX::OSSetup::Distro::$distroName";
+	unless (eval "require $distroModule") {
+		if ($! == 2) {
+			die _tr("Distro-module <%s> not found!\n", $distroModule);
+		} else {
+			die _tr("Unable to load distro-module <%s> (%s)\n", $distroModule, $@);
+		}
+	}
+	my $modVersion = $distroModule->VERSION;
+	if ($modVersion < 1.01) {
+		die _tr('Could not load module <%s> (Version <%s> required, but <%s> found)',
+				$distroModule, 1.01, $modVersion);
+	}
+	$distroModule->import;
+	my $distro = $distroModule->new;
+	$distro->initialize($self);
+	$self->{distro} = $distro;
+
+	# setup path to distribution-specific info:
+	my $distroInfoDir = "../lib/distro-info/$distro->{'base-name'}";
+	if (!-d $distroInfoDir) {
+		die _tr("unable to find distro-info for system '%s'", $distro->{'base-name'})."\n";
+	}
+	$self->{'distro-info-dir'} = $distroInfoDir;
+	$self->readDistroInfo();
+
+	$self->setupSystemPaths($protectSystemPath);
+
+	$self->createPackager();
+	$self->createMetaPackager();
+}
+
+sub setupStage1A
+{
+	my $self = shift;
+
+	vlog 1, "setting up stage1a for $self->{distro}->{'base-name'}...";
+	$self->stage1A_createBusyboxEnvironment();
+	$self->stage1A_setupResolver();
+	$self->stage1A_copyPrerequiredFiles();
+	$self->stage1A_copyTrustedPackageKeys();
+	$self->stage1A_createRequiredFiles();
+}
+
+sub setupStage1B
+{
+	my $self = shift;
+
+	vlog 1, "setting up stage1b for $self->{distro}->{'base-name'}...";
+	$self->stage1B_chrootAndBootstrap();
+}
+
+sub setupStage1C
+{
+	my $self = shift;
+
+	vlog 1, "setting up stage1c for $self->{distro}->{'base-name'}...";
+	$self->stage1C_chrootAndInstallBasicSystem();
+}
+
+sub setupStage1D
+{
+	my $self = shift;
+
+	vlog 1, "setting up stage1d for $self->{distro}->{'base-name'}...";
+	$self->stage1D_setupPackageSources();
+	$self->stage1D_updateBasicSystem();
+	$self->stage1D_installPackageSelection();
+}
+
+sub setupStage1
+{
+	my $self = shift;
+
+	$self->setupStage1A();
+	my $pid = fork();
+	if (!$pid) {
+		# child, execute the tasks that involve a chrooted environment:
+		$self->setupStage1B();
+		$self->setupStage1C();
+		exit 0;
+	}
+
+	# parent, wait for child to do its work inside the chroot
+	waitpid($pid, 0);
+	$self->stage1C_cleanupBasicSystem();
+	$self->setupStage1D();
+}
+
+sub setupRepositories
+{
+	my $self = shift;
+
+	$self->setupStage1D();
+}
+
+sub fixPrerequiredFiles
+{
+}
+
+################################################################################
+### implementation methods
+################################################################################
+sub readDistroInfo
+{
+	my $self = shift;
+
+	vlog 1, "reading configuration info for $self->{distro}->{'base-name'}...";
+	my (%repository,
+		%selection,
+		$base_url,
+		$package_subdir,
+		$prereq_packages,
+		$bootstrap_prereq_packages,
+		$bootstrap_packages);
+	foreach my $fn ('settings', 'settings.local') {
+		my $file = "$self->{'distro-info-dir'}/$fn";
+		if (-e $file) {
+			vlog 3, "reading configuration file $file...";
+			my $config = slurpFile($file);
+			if (!eval $config) {
+				die _tr("error in config-file <%s> (%s)", $file, $@)."\n";
+			}
+		}
+	}
+	$self->{'distro-info'} = {
+		'package-subdir' => $package_subdir,
+		'prereq-packages' => $prereq_packages,
+		'bootstrap-prereq-packages' => $bootstrap_prereq_packages,
+		'bootstrap-packages' => $bootstrap_packages,
+		'repository' => \%repository,
+		'selection' => \%selection,
+	};
+	if ($openslxConfig{'verbose-level'} >= 2) {
+		# dump distro-info:
+		foreach my $r (sort keys %repository) {
+			vlog 2, "repository '$r':";
+			foreach my $k (sort keys %{$repository{$r}}) {
+				vlog 2, "\t$k = '$repository{$r}->{$k}'";
+			}
+		}
+		foreach my $s (sort keys %selection) {
+			my @selLines = split "\n", $selection{$s};
+			vlog 2, "selection '$s':";
+			foreach my $sl (@selLines) {
+				vlog 2, "\t$sl";
+			}
+		}
+	}
+}
+
+sub setupSystemPaths
+{
+	my $self = shift;
+	my $protectSystemPath = shift;
+
+	$self->{'system-path'}
+		= "$openslxConfig{'stage1-path'}/$self->{distro}->{'base-name'}";
+	vlog 1, "system will be installed to '$self->{'system-path'}'";
+	if ($protectSystemPath && -e $self->{'system-path'}) {
+		die _tr("'%s' already exists, giving up!", $self->{'system-path'});
+	}
+
+	# specify individual paths for the respective substages:
+	$self->{stage1aDir} = "$self->{'system-path'}/stage1a";
+	$self->{stage1bSubdir} = 'slxbootstrap';
+	$self->{stage1cSubdir} = 'slxfinal';
+
+	# we create *all* of the above folders by creating stage1cDir:
+	my $stage1cDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}";
+	if (system("mkdir -p $stage1cDir")) {
+		die _tr("unable to create directory '%s', giving up! (%s)",
+				$stage1cDir, $!);
+	}
+}
+
+sub createPackager
+{
+	my $self = shift;
+
+	my $packagerModule
+		= "OpenSLX::OSSetup::Packager::$self->{distro}->{'packager-type'}";
+	unless (eval "require $packagerModule") {
+		if ($! == 2) {
+			die _tr("Packager-module <%s> not found!\n", $packagerModule);
+		} else {
+			die _tr("Unable to load packager-module <%s> (%s)\n", $packagerModule, $@);
+		}
+	}
+	my $modVersion = $packagerModule->VERSION;
+	if ($modVersion < 1.01) {
+		die _tr('Could not load module <%s> (Version <%s> required, but <%s> found)',
+				$packagerModule, 1.01, $modVersion);
+	}
+	$packagerModule->import;
+	my $packager = $packagerModule->new;
+	$packager->initialize($self);
+	$self->{'packager'} = $packager;
+}
+
+sub createMetaPackager
+{
+	my $self = shift;
+
+	my $metaPackagerModule
+		= "OpenSLX::OSSetup::MetaPackager::$self->{distro}->{'meta-packager-type'}";
+	unless (eval "require $metaPackagerModule") {
+		if ($! == 2) {
+			die _tr("Meta-packager-module <%s> not found!\n", $metaPackagerModule);
+		} else {
+			die _tr("Unable to load meta-packager-module <%s> (%s)\n", $metaPackagerModule, $@);
+		}
+	}
+	my $modVersion = $metaPackagerModule->VERSION;
+	if ($modVersion < 1.01) {
+		die _tr('Could not load module <%s> (Version <%s> required, but <%s> found)',
+				$metaPackagerModule, 1.01, $modVersion);
+	}
+	$metaPackagerModule->import;
+	my $metaPackager = $metaPackagerModule->new;
+	$metaPackager->initialize($self);
+	$self->{'meta-packager'} = $metaPackager;
+}
+
+sub selectBaseURL
+{
+	my $self = shift;
+	my $repoInfo = shift;
+
+	my $baseURL = $repoInfo->{url};
+	if (!defined $baseURL) {
+		my @baseURLs = string2Array($repoInfo->{urls});
+		# TODO: insert a closest mirror algorithm here!
+		$baseURL = $baseURLs[0];
+	}
+	return $baseURL;
+}
+
+sub stage1A_createBusyboxEnvironment
+{
+	my $self = shift;
+
+	# copy busybox and all required binaries into stage1a-dir:
+	vlog 1, "creating busybox-environment...";
+	copyFile("$openslxConfig{'share-path'}/busybox/busybox",
+			 "$self->{stage1aDir}/bin");
+
+	# determine all required libraries and copy those, too:
+	vlog 2, "calling slxldd for busybox";
+	my $requiredLibsStr = `slxldd $openslxConfig{'share-path'}/busybox/busybox`;
+	chomp $requiredLibsStr;
+	vlog 2, "slxldd results:\n$requiredLibsStr";
+	foreach my $lib (split "\n", $requiredLibsStr) {
+		vlog 3, "copying lib '$lib'";
+		my $libDir = dirname($lib);
+		copyFile($lib, "$self->{stage1aDir}/$libDir");
+	}
+
+	# create all needed links to busybox:
+	my $links
+		= slurpFile("$openslxConfig{'share-path'}/busybox/busybox.links");
+	foreach my $linkTarget (split "\n", $links) {
+		linkFile('/bin/busybox', "$self->{stage1aDir}/$linkTarget");
+	}
+}
+
+sub stage1A_setupResolver
+{
+	my $self = shift;
+
+	copyFile('/etc/resolv.conf', "$self->{stage1aDir}/etc");
+	copyFile('/lib/libresolv*', "$self->{stage1aDir}/lib");
+	copyFile('/lib/libnss_dns*', "$self->{stage1aDir}/lib");
+
+	my $stage1cDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}";
+	copyFile('/etc/resolv.conf', "$stage1cDir/etc");
+}
+
+sub stage1A_copyPrerequiredFiles
+{
+	my $self = shift;
+
+	return unless -d "$self->{'distro-info-dir'}/prereqfiles";
+
+	vlog 2, "copying folder with pre-required files...";
+	my $stage1cDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}";
+	my $cmd = qq[
+		tar --exclude=.svn -cp -C $self->{'distro-info-dir'}/prereqfiles . \\
+		| tar -xp -C $stage1cDir
+	];
+	if (system($cmd)) {
+		die _tr("unable to copy folder with pre-required files to folder <%s> (%s)",
+				$stage1cDir, $!);
+	}
+	$self->{distro}->fixPrerequiredFiles($stage1cDir);
+}
+
+sub stage1A_copyTrustedPackageKeys
+{
+	my $self = shift;
+
+	return unless -d "$self->{'distro-info-dir'}/trusted-package-keys";
+
+	vlog 2, "copying folder with trusted package keys...";
+	my $stage1bDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}";
+	my $cmd = qq[
+		tar --exclude=.svn -cp -C $self->{'distro-info-dir'} trusted-package-keys \\
+		| tar -xp -C $stage1bDir
+	];
+	if (system($cmd)) {
+		die _tr("unable to copy folder with trusted package keys to folder <%s> (%s)",
+				$stage1bDir, $!);
+	}
+	system("chmod 444 $stage1bDir/trusted-package-keys/*");
+
+	# install ultimately trusted keys (from distributor):
+	my $stage1cDir
+		= "$stage1bDir/$self->{'stage1cSubdir'}";
+	my $keyDir = "$self->{'distro-info-dir'}/trusted-package-keys";
+	copyFile("$keyDir/pubring.gpg", "$stage1cDir/usr/lib/rpm/gnupg");
+}
+
+sub stage1A_createRequiredFiles
+{
+	my $self = shift;
+
+	vlog 2, "creating required files...";
+	# fake all files required by stage1b (by creating them empty):
+	my $stage1bDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}";
+	foreach my $fake (@{$self->{distro}->{'stage1b-faked-files'}}) {
+		fakeFile("$stage1bDir/$fake");
+	}
+
+	# fake all files required by stage1c (by creating them empty):
+	my $stage1cDir
+		= "$stage1bDir/$self->{'stage1cSubdir'}";
+	foreach my $fake (@{$self->{distro}->{'stage1c-faked-files'}}) {
+		fakeFile("$stage1cDir/$fake");
+	}
+
+	mkdir "$stage1cDir/dev";
+	if (system("mknod $stage1cDir/dev/null c 1 3")) {
+		die _tr("unable to create node <%s> (%s)", "$stage1cDir/dev/null", $!);
+	}
+}
+
+sub stage1B_chrootAndBootstrap
+{
+	my $self = shift;
+
+	vlog 2, "chrooting into $self->{stage1aDir}...";
+	# chdir into stage1aDir...
+	chdir $self->{stage1aDir}
+		or die _tr("unable to chdir into <%s> (%s)", $self->{stage1aDir}, $!);
+	# ...do chroot
+	chroot "."
+		or die _tr("unable to chroot into <%s> (%s)", $self->{stage1aDir}, $!);
+
+	$ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin";
+
+	# chdir into slxbootstrap, as we want to drop packages into there:
+	chdir "/$self->{stage1bSubdir}"
+		or die _tr("unable to chdir into <%s> (%s)", "/$self->{stage1bSubdir}", $!);
+
+	# fetch prerequired packages:
+	my $baseURL
+		= $self->selectBaseURL($self->{'distro-info'}->{repository}->{base});
+	my $pkgDirURL = $baseURL;
+	if (length($self->{'distro-info'}->{'package-subdir'})) {
+		$pkgDirURL .= "/$self->{'distro-info'}->{'package-subdir'}";
+	}
+	my @pkgs = string2Array($self->{'distro-info'}->{'prereq-packages'});
+	my @prereqPkgs = downloadFilesFrom(\@pkgs, $pkgDirURL);
+	$self->{packager}->unpackPackages(\@prereqPkgs);
+
+	@pkgs = string2Array($self->{'distro-info'}->{'bootstrap-prereq-packages'});
+	my @bootstrapPrereqPkgs = downloadFilesFrom(\@pkgs, $pkgDirURL);
+	$self->{'local-bootstrap-prereq-packages'} = \@bootstrapPrereqPkgs;
+
+	@pkgs = string2Array($self->{'distro-info'}->{'bootstrap-packages'});
+	my @bootstrapPkgs = downloadFilesFrom(\@pkgs, $pkgDirURL);
+	my @allPkgs = (@prereqPkgs, @bootstrapPrereqPkgs, @bootstrapPkgs);
+	$self->{'local-bootstrap-packages'}	= \@allPkgs;
+}
+
+sub stage1C_chrootAndInstallBasicSystem
+{
+	my $self = shift;
+
+	my $stage1bDir = "/$self->{stage1bSubdir}";
+	vlog 2, "chrooting into $stage1bDir...";
+	# chdir into stage1bDir...
+	chdir $stage1bDir
+		or die _tr("unable to chdir into <%s> (%s)", $stage1bDir, $!);
+	# ...do chroot
+	chroot "."
+		or die _tr("unable to chroot into <%s> (%s)", $stage1bDir, $!);
+
+	$ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin";
+	my $stage1cDir = "/$self->{stage1cSubdir}";
+
+	# install all prerequired bootstrap packages
+	$self->{packager}->installPrerequiredPackages(
+		$self->{'local-bootstrap-prereq-packages'}, $stage1cDir
+	);
+
+	# import any additional trusted package keys to rpm-DB:
+	my $keyDir = "/trusted-package-keys";
+	opendir(KEYDIR, $keyDir)
+		or die _tr("unable to opendir <%s> (%s)", $keyDir, $!);
+	my @keyFiles
+		= map { "$keyDir/$_" }
+		  grep { $_ !~ m[^(\.\.?|pubring.gpg)$] }
+		  readdir(KEYDIR);
+	closedir(KEYDIR);
+	$self->{packager}->importTrustedPackageKeys(\@keyFiles, $stage1cDir);
+
+	# install all other bootstrap packages
+	$self->{packager}->installPackages(
+		$self->{'local-bootstrap-packages'}, $stage1cDir
+	);
+}
+
+sub stage1C_cleanupBasicSystem
+{
+	my $self = shift;
+
+	my $stage1cDir
+		= "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}";
+	if (system("mv $stage1cDir/* $self->{'system-path'}/")) {
+		die _tr("unable to move final setup to <%s> (%s)",
+				$self->{'system-path'}, $!);
+	}
+	if (system("rm -rf $self->{stage1aDir}")) {
+		die _tr("unable to remove temporary folder <%s> (%s)",
+				$self->{stage1aDir}, $!);
+	}
+}
+
+sub stage1D_setupPackageSources()
+{
+	my $self = shift;
+
+	vlog 1, "setting up package sources for meta packager...";
+	my ($rk, $repo);
+	while(($rk, $repo) = each %{$self->{'distro-info'}->{repository}}) {
+		vlog 2, "setting up package source $rk...";
+		$self->{'meta-packager'}->setupPackageSource($rk, $repo);
+	}
+}
+
+sub stage1D_updateBasicSystem()
+{
+	my $self = shift;
+
+	# chdir into systemDir...
+	my $systemDir = $self->{'system-path'};
+	vlog 2, "chrooting into $systemDir...";
+	chdir $systemDir
+		or die _tr("unable to chdir into <%s> (%s)", $systemDir, $!);
+	# ...do chroot
+	chroot "."
+		or die _tr("unable to chroot into <%s> (%s)", $systemDir, $!);
+
+	vlog 1, "updating basic system...";
+	$self->{'meta-packager'}->updateBasicSystem();
+}
+
+sub stage1D_installPackageSelection
+{
+	my $self = shift;
+
+	vlog 1, "installing package selection...";
+}
+
+################################################################################
+### utility functions
+################################################################################
+sub copyFile
+{
+	my $fileName = shift;
+	my $dirName = shift;
+
+	my $baseName = basename($fileName);
+	my $targetName = "$dirName/$baseName";
+	if (!-e $targetName) {
+		my $targetDir = dirname($targetName);
+		system("mkdir -p $targetDir") 	unless -d $targetDir;
+		if (system("cp -p $fileName $targetDir/")) {
+			die _tr("unable to copy file '%s' to dir '%s' (%s)",
+					$fileName, $targetDir, $!);
+		}
+	}
+}
+
+sub fakeFile
+{
+	my $fullPath = shift;
+
+	my $targetDir = dirname($fullPath);
+	system("mkdir", "-p", $targetDir) 	unless -d $targetDir;
+	if (system("touch", $fullPath)) {
+		die _tr("unable to create file '%s' (%s)",
+				$fullPath, $!);
+	}
+}
+
+sub linkFile
+{
+	my $linkTarget = shift;
+	my $linkName = shift;
+
+	my $targetDir = dirname($linkName);
+	system("mkdir -p $targetDir") 	unless -d $targetDir;
+	if (system("ln -s $linkTarget $linkName")) {
+		die _tr("unable to create link '%s' to '%s' (%s)",
+				$linkName, $linkTarget, $!);
+	}
+}
+
+sub slurpFile
+{
+	my $file = shift;
+	open(F, "< $file")
+		or die _tr("could not open file '%s' for reading! (%s)", $file, $!);
+	$/ = undef;
+	my $text = <F>;
+	close(F);
+	return $text;
+}
+
+sub string2Array
+{
+	my $str = shift;
+
+	return
+		map { $_ =~ s[^\s*(.+?)\s*$][$1]; $_ }
+		grep { length($_) > 0 } split "\n", $str;
+}
+
+sub downloadFilesFrom
+{
+	my $files = shift;
+	my $baseURL = shift;
+
+	my @foundFiles;
+	foreach my $fileVariantStr (@$files) {
+		my $foundFile;
+		foreach my $file (split '\s+', $fileVariantStr) {
+		vlog 2, "fetching $file...";
+			if (system("wget", "$baseURL/$file") == 0) {
+				$foundFile = basename($file);
+				last;
+			}
+		}
+		if (!defined $foundFile) {
+			die _tr("unable to fetch <%s> from <%s> (%s)", $fileVariantStr,
+					$baseURL, $!);
+		}
+		push @foundFiles, $foundFile;
+	}
+	return @foundFiles;
+}
+
+1;
+################################################################################
+
+=pod
+
+=head1 NAME
+
+OpenSLX::OSSetup::System::Base - the base class for all OSSetup backends
+
+=head1 SYNOPSIS
+
+  package OpenSLX::OSSetup::coolnewOS;
+
+  use vars qw(@ISA $VERSION);
+  @ISA = ('OpenSLX::OSSetup::Base');
+  $VERSION = 1.01;
+
+  use coolnewOS;
+
+  sub new
+  {
+      my $class = shift;
+      my $self = {};
+      return bless $self, $class;
+  }
+
+  # override all methods of OpenSLX::OSSetup::Base in order to implement
+  # a full OS-setup backend
+  ...
+
+I<The synopsis above outlines a class that implements a
+OSSetup backend for the (imaginary) operating system B<coolnewOS>>
+
+=head1 DESCRIPTION
+
+This class defines the OSSetup interface for the OpenSLX.
+
+Aim of the OSSetup abstraction is to make it possible to install a large set
+of different operating systems transparently.
+
+...
+
+=cut