From a0ce0340d0f95514008cfac751fe58748bbadd88 Mon Sep 17 00:00:00 2001 From: Oliver Tappe Date: Thu, 20 Mar 2008 00:04:16 +0000 Subject: * Switched indent used in Perl-code and settings files from tabs to 4 spaces. May need some manual corrections here and there, but should basically be ok. git-svn-id: http://svn.openslx.org/svn/openslx/openslx/trunk@1658 95ad53e4-c205-0410-b2fa-d234c58c8868 --- README | 4 +- README.de | 4 +- bin/devel-tools/determineMinimumPackageSet.pl | 154 +- bin/devel-tools/extractTranslations.pl | 242 +- bin/devel-tools/parseSusePatterns.pl | 152 +- bin/slxldd | 30 +- bin/slxsettings | 242 +- config-db/OpenSLX/AttributeRoster.pm | 768 ++--- config-db/OpenSLX/ConfigDB.pm | 1466 +++++----- config-db/OpenSLX/ConfigExport/DHCP/ISC.pm | 20 +- config-db/OpenSLX/DBSchema.pm | 1292 ++++----- config-db/OpenSLX/MetaDB/Base.pm | 20 +- config-db/OpenSLX/MetaDB/DBI.pm | 1978 ++++++------- config-db/OpenSLX/MetaDB/SQLite.pm | 138 +- config-db/OpenSLX/MetaDB/mysql.pm | 234 +- config-db/devel-tools/test-config-db.pl | 174 +- config-db/devel-tools/test-config-demuxer.pl | 202 +- config-db/slxconfig | 2246 +++++++-------- config-db/slxconfig-demuxer | 1184 ++++---- config-db/t/01-basics.t | 6 +- config-db/t/10-vendor-os.t | 166 +- config-db/t/11-export.t | 160 +- config-db/t/12-system.t | 304 +- config-db/t/13-client.t | 298 +- config-db/t/14-group.t | 282 +- config-db/t/15-global_info.t | 18 +- config-db/t/20-client_system_ref.t | 166 +- config-db/t/21-group_system_ref.t | 154 +- config-db/t/22-group_client_ref.t | 146 +- config-db/t/25-attributes.t | 1044 +++---- config-db/t/29-transaction.t | 2 +- config-db/t/run-all-tests.pl | 4 +- initramfs/OpenSLX/LibScanner.pm | 388 +-- initramfs/OpenSLX/MakeInitRamFS/Distro/Base.pm | 16 +- initramfs/OpenSLX/MakeInitRamFS/Distro/Debian.pm | 22 +- initramfs/OpenSLX/MakeInitRamFS/Distro/SUSE.pm | 20 +- initramfs/OpenSLX/MakeInitRamFS/Distro/Ubuntu.pm | 22 +- initramfs/OpenSLX/MakeInitRamFS/Engine.pm | 1170 ++++---- installer/OpenSLX/OSExport/BlockDevice/AoE.pm | 72 +- installer/OpenSLX/OSExport/BlockDevice/Base.pm | 6 +- installer/OpenSLX/OSExport/BlockDevice/DNBD2.pm | 78 +- installer/OpenSLX/OSExport/BlockDevice/NBD.pm | 70 +- installer/OpenSLX/OSExport/Distro/Any.pm | 56 +- installer/OpenSLX/OSExport/Distro/Base.pm | 18 +- installer/OpenSLX/OSExport/Distro/Debian.pm | 50 +- installer/OpenSLX/OSExport/Distro/Fedora.pm | 62 +- installer/OpenSLX/OSExport/Distro/Gentoo.pm | 50 +- installer/OpenSLX/OSExport/Distro/SUSE.pm | 158 +- installer/OpenSLX/OSExport/Distro/Ubuntu.pm | 54 +- installer/OpenSLX/OSExport/Engine.pm | 492 ++-- installer/OpenSLX/OSExport/FileSystem/Base.pm | 104 +- installer/OpenSLX/OSExport/FileSystem/NFS.pm | 212 +- installer/OpenSLX/OSExport/FileSystem/SquashFS.pm | 412 +-- installer/OpenSLX/OSSetup/Distro/Any_Clone.pm | 8 +- installer/OpenSLX/OSSetup/Distro/Base.pm | 428 +-- installer/OpenSLX/OSSetup/Distro/Debian.pm | 134 +- installer/OpenSLX/OSSetup/Distro/Debian_3_1.pm | 40 +- installer/OpenSLX/OSSetup/Distro/Fedora.pm | 28 +- installer/OpenSLX/OSSetup/Distro/Gentoo.pm | 50 +- installer/OpenSLX/OSSetup/Distro/SUSE.pm | 68 +- installer/OpenSLX/OSSetup/Distro/Ubuntu.pm | 108 +- installer/OpenSLX/OSSetup/Engine.pm | 3026 ++++++++++---------- installer/OpenSLX/OSSetup/MetaPackager/Base.pm | 14 +- installer/OpenSLX/OSSetup/MetaPackager/apt.pm | 166 +- installer/OpenSLX/OSSetup/MetaPackager/smart.pm | 148 +- installer/OpenSLX/OSSetup/MetaPackager/yum.pm | 110 +- installer/OpenSLX/OSSetup/MetaPackager/zypper.pm | 106 +- installer/OpenSLX/OSSetup/Packager/Base.pm | 14 +- installer/OpenSLX/OSSetup/Packager/dpkg.pm | 102 +- installer/OpenSLX/OSSetup/Packager/rpm.pm | 76 +- installer/slxos-export | 214 +- installer/slxos-setup | 256 +- lib/OpenSLX/Basics.pm | 704 ++--- lib/OpenSLX/ConfigFolder.pm | 116 +- lib/OpenSLX/Translations/de.pm | 486 ++-- lib/OpenSLX/Translations/posix.pm | 486 ++-- lib/OpenSLX/Utils.pm | 428 +-- lib/distro-info/debian-3.1/settings.default | 50 +- lib/distro-info/debian-3.1/settings.example | 8 +- lib/distro-info/debian-4.0/settings.default | 36 +- lib/distro-info/debian-4.0/settings.example | 8 +- lib/distro-info/debian-4.0_amd64/settings.default | 50 +- lib/distro-info/debian-4.0_amd64/settings.example | 8 +- lib/distro-info/fedora-6/settings.default | 220 +- lib/distro-info/fedora-6/settings.example | 8 +- lib/distro-info/fedora-6_x86_64/settings.default | 220 +- lib/distro-info/fedora-6_x86_64/settings.example | 8 +- lib/distro-info/suse-10.1/settings.default | 1902 ++++++------ lib/distro-info/suse-10.1/settings.example | 8 +- lib/distro-info/suse-10.1_x86_64/settings.default | 1904 ++++++------ lib/distro-info/suse-10.1_x86_64/settings.example | 8 +- lib/distro-info/suse-10.2/settings.default | 2076 +++++++------- lib/distro-info/suse-10.2/settings.example | 8 +- lib/distro-info/suse-10.2_x86_64/settings.default | 2074 +++++++------- lib/distro-info/suse-10.2_x86_64/settings.example | 8 +- lib/distro-info/suse-10.3/settings.default | 1900 ++++++------ lib/distro-info/suse-10.3/settings.example | 8 +- lib/distro-info/suse-10.3__x86_64/settings.default | 1896 ++++++------ lib/distro-info/suse-10.3__x86_64/settings.example | 8 +- lib/distro-info/ubuntu-6.10/settings.default | 64 +- lib/distro-info/ubuntu-6.10/settings.example | 8 +- lib/distro-info/ubuntu-6.10_amd64/settings.default | 64 +- lib/distro-info/ubuntu-6.10_amd64/settings.example | 8 +- lib/distro-info/ubuntu-7.04/settings.default | 64 +- lib/distro-info/ubuntu-7.04/settings.example | 8 +- lib/distro-info/ubuntu-7.04_amd64/settings.default | 64 +- lib/distro-info/ubuntu-7.04_amd64/settings.example | 8 +- lib/distro-info/ubuntu-7.10/settings.default | 64 +- lib/distro-info/ubuntu-7.10/settings.example | 8 +- lib/distro-info/ubuntu-7.10_amd64/settings.default | 64 +- lib/distro-info/ubuntu-7.10_amd64/settings.example | 8 +- lib/distro-info/ubuntu-8.04/settings.default | 64 +- lib/distro-info/ubuntu-8.04/settings.example | 8 +- lib/distro-info/ubuntu-8.04_amd64/settings.default | 64 +- lib/distro-info/ubuntu-8.04_amd64/settings.example | 8 +- os-plugins/OpenSLX/OSPlugin/Base.pm | 224 +- os-plugins/OpenSLX/OSPlugin/Engine.pm | 616 ++-- os-plugins/OpenSLX/OSPlugin/Roster.pm | 152 +- .../bootsplash/OpenSLX/OSPlugin/bootsplash.pm | 222 +- os-plugins/plugins/desktop/OpenSLX/Distro/Base.pm | 212 +- .../plugins/desktop/OpenSLX/Distro/debian.pm | 2 +- .../plugins/desktop/OpenSLX/Distro/fedora.pm | 28 +- .../plugins/desktop/OpenSLX/Distro/gentoo.pm | 50 +- os-plugins/plugins/desktop/OpenSLX/Distro/suse.pm | 2 +- .../plugins/desktop/OpenSLX/Distro/ubuntu.pm | 2 +- .../plugins/desktop/OpenSLX/OSPlugin/desktop.pm | 746 ++--- .../OpenSLX/OSPlugin/displaymanager.pm | 178 +- .../plugins/example/OpenSLX/OSPlugin/example.pm | 214 +- os-plugins/plugins/theme/OpenSLX/OSPlugin/theme.pm | 302 +- .../vmchooser/OpenSLX/OSPlugin/vmchooser.pm | 180 +- os-plugins/plugins/vmware/OpenSLX/Distro/base.pm | 14 +- .../vmwarebinary/OpenSLX/OSPlugin/vmwarebinary.pm | 160 +- .../plugins/x11vnc/OpenSLX/OSPlugin/x11vnc.pm | 380 +-- os-plugins/slxos-plugin | 470 +-- 134 files changed, 20647 insertions(+), 20647 deletions(-) diff --git a/README b/README index 3ed97772..96b9f5f4 100644 --- a/README +++ b/README @@ -42,8 +42,8 @@ FEEDBACK Questions, wishes and general feedback are very welcome. Please direct them to the appropriate mailing list, in this case the english users list: - mailto:openslx-users@openslx.org + mailto:openslx-users@openslx.org Have fun, - the OpenSLX-team + the OpenSLX-team diff --git a/README.de b/README.de index 37e5b1d5..8ad631b8 100644 --- a/README.de +++ b/README.de @@ -46,8 +46,8 @@ Fragen, Wünsche und generelles Feedback sind ausdrücklich erbeten, am besten benutzt man dazu die passende Mailingliste, in diesem Fall die deutschprachige Benutzerliste: - mailto:openslx-users-de@openslx.org + mailto:openslx-users-de@openslx.org Viel Spaß, - das OpenSLX-Team + das OpenSLX-Team diff --git a/bin/devel-tools/determineMinimumPackageSet.pl b/bin/devel-tools/determineMinimumPackageSet.pl index e2747674..52d13fc5 100755 --- a/bin/devel-tools/determineMinimumPackageSet.pl +++ b/bin/devel-tools/determineMinimumPackageSet.pl @@ -28,26 +28,26 @@ use Getopt::Long; use Pod::Usage; my ( - $helpReq, - $verbose, - $versionReq, + $helpReq, + $verbose, + $versionReq, - %pkgs, - @leafPkgs, + %pkgs, + @leafPkgs, ); my $rpmOutFile = "/tmp/minpkgset.rpmout"; my $rpmErrFile = "/tmp/minpkgset.rpmerr"; GetOptions( - 'help|?' => \$helpReq, - 'verbose' => \$verbose, - 'version' => \$versionReq, + 'help|?' => \$helpReq, + 'verbose' => \$verbose, + 'version' => \$versionReq, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; if ($versionReq) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } determineMinimumPackageSet(); @@ -60,90 +60,90 @@ exit; sub slurpFile { - my $file = shift; - - my $fh; - open($fh, '<', $file) - or die _tr("could not open file '%s' for reading! (%s)", $file, $!); - local $/ = undef; - my $text = <$fh>; - close($fh); - return $text; + my $file = shift; + + my $fh; + open($fh, '<', $file) + or die _tr("could not open file '%s' for reading! (%s)", $file, $!); + local $/ = undef; + my $text = <$fh>; + close($fh); + return $text; } sub rpmDie { - my $rpmCmd = shift; - - print "\n*** An error occurred when executing the following rpm-command:\n"; - print "\t$rpmCmd\n"; - my $err = slurpFile($rpmErrFile); - print "*** The error was:\n"; - print "\t$err\n"; - exit 5; + my $rpmCmd = shift; + + print "\n*** An error occurred when executing the following rpm-command:\n"; + print "\t$rpmCmd\n"; + my $err = slurpFile($rpmErrFile); + print "*** The error was:\n"; + print "\t$err\n"; + exit 5; } sub callRpm { - my $rpmCmd = shift; + my $rpmCmd = shift; - my $res = system("$rpmCmd >$rpmOutFile 2>$rpmErrFile"); - exit 1 if ($res & 127); # child caught a signal - rpmDie($rpmCmd) if -s $rpmErrFile; - my $out = slurpFile($rpmOutFile); - return ($res, $out); + my $res = system("$rpmCmd >$rpmOutFile 2>$rpmErrFile"); + exit 1 if ($res & 127); # child caught a signal + rpmDie($rpmCmd) if -s $rpmErrFile; + my $out = slurpFile($rpmOutFile); + return ($res, $out); } sub handlePackage { - my $pkgName = shift; - - # if any other package requires it, the current package is not a leaf! - print "\tdirectly required..." if $verbose; - my ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --whatrequires "$pkgName"]); - print $rpmRes ? "no\n" : "yes\n" if $verbose; - return 0 unless $rpmRes; - - print "\tany of its provides required..." if $verbose; - ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --provides "$pkgName"]); - my $provides - = join ' ', - map { - my $rpm = $_; - $rpm =~ s[^\s*(.+?)\s*$][$1]; - qq["$rpm"]; - } - split "\n", $rpmOut; - ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --whatrequires $provides]); - if ($rpmRes == 0) { - # ignore if rpm tells us that a provides is required by - # the package that provides it: - $rpmRes = 1; - while($rpmOut =~ m[^\s*(.+?)\s*]gm) { - if ($1 ne $pkgName) { - $rpmRes = 0; - last; - } - } - } - print $rpmRes ? "no\n" : "yes\n" if $verbose; - return 0 unless $rpmRes; - - print "!!! adding $pkgName\n" if $verbose; - push @leafPkgs, $pkgName; - return 1; + my $pkgName = shift; + + # if any other package requires it, the current package is not a leaf! + print "\tdirectly required..." if $verbose; + my ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --whatrequires "$pkgName"]); + print $rpmRes ? "no\n" : "yes\n" if $verbose; + return 0 unless $rpmRes; + + print "\tany of its provides required..." if $verbose; + ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --provides "$pkgName"]); + my $provides + = join ' ', + map { + my $rpm = $_; + $rpm =~ s[^\s*(.+?)\s*$][$1]; + qq["$rpm"]; + } + split "\n", $rpmOut; + ($rpmRes, $rpmOut) = callRpm(qq[rpm -q --whatrequires $provides]); + if ($rpmRes == 0) { + # ignore if rpm tells us that a provides is required by + # the package that provides it: + $rpmRes = 1; + while($rpmOut =~ m[^\s*(.+?)\s*]gm) { + if ($1 ne $pkgName) { + $rpmRes = 0; + last; + } + } + } + print $rpmRes ? "no\n" : "yes\n" if $verbose; + return 0 unless $rpmRes; + + print "!!! adding $pkgName\n" if $verbose; + push @leafPkgs, $pkgName; + return 1; } sub determineMinimumPackageSet { - my ($rpmRes, $allPkgs) - = callRpm(qq[rpm -qa --queryformat "%{NAME}\n"]); - foreach my $p (sort split "\n", $allPkgs) { - print "$p...\n" if $verbose; - print "." unless $verbose; - handlePackage($p); - } - return; + my ($rpmRes, $allPkgs) + = callRpm(qq[rpm -qa --queryformat "%{NAME}\n"]); + foreach my $p (sort split "\n", $allPkgs) { + print "$p...\n" if $verbose; + print "." unless $verbose; + handlePackage($p); + } + return; } __END__ diff --git a/bin/devel-tools/extractTranslations.pl b/bin/devel-tools/extractTranslations.pl index eab71f04..789a70ad 100755 --- a/bin/devel-tools/extractTranslations.pl +++ b/bin/devel-tools/extractTranslations.pl @@ -11,8 +11,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # extractTranslations.pl -# - OpenSLX-script to extract translatable strings from other scripts -# and modules. +# - OpenSLX-script to extract translatable strings from other scripts +# and modules. # ----------------------------------------------------------------------------- use strict; use warnings; @@ -36,34 +36,34 @@ use Pod::Usage; use OpenSLX::Utils; my ( - $helpReq, - $show, - $update, - $verbose, - $versionReq, - - %translatableStrings, - $fileCount, + $helpReq, + $show, + $update, + $verbose, + $versionReq, + + %translatableStrings, + $fileCount, ); GetOptions( - 'help|?' => \$helpReq, - 'update' => \$update, - 'show' => \$show, - 'verbose' => \$verbose, - 'version' => \$versionReq, + 'help|?' => \$helpReq, + 'update' => \$update, + 'show' => \$show, + 'verbose' => \$verbose, + 'version' => \$versionReq, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; if ($versionReq) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } # chdir to the repository's root folder: use FindBin; my $path = "$FindBin::RealBin/../.."; chdir($path) - or die "can't chdir to repository-root <$path> ($!)"; + or die "can't chdir to repository-root <$path> ($!)"; print "searching in ".cwd()."\n"; find(\&ExtractTrStrings, '.'); @@ -72,122 +72,122 @@ my $trCount = scalar keys %translatableStrings; print "Found $trCount translatable strings in $fileCount files.\n"; if ($show) { - foreach my $tr (sort {lc($a) cmp lc($b)} keys %translatableStrings) { - print "\tqq{$tr}\n\t\t=> qq{$tr}\n"; - } + foreach my $tr (sort {lc($a) cmp lc($b)} keys %translatableStrings) { + print "\tqq{$tr}\n\t\t=> qq{$tr}\n"; + } } if ($update) { - find(\&UpdateTrModule, 'lib/OpenSLX/Translations'); + find(\&UpdateTrModule, 'lib/OpenSLX/Translations'); } exit; sub ExtractTrStrings { - $File::Find::prune = 1 if ($_ eq '.svn' - || $_ eq 'Translations' - || $_ eq 'devel-tools'); - return if -d; - my $text = slurpFile($_); - if ($File::Find::name !~ m[\.pm$] && $text !~ m[^#!.+/perl]im) { - # ignore anything other than perl-modules and -scripts - return; - } - print "$File::Find::name...\n"; - $fileCount++; - while($text =~ m[_tr\s*\(\s*(.+?)\s*\);]gos) { - # NOTE: that cheesy regex relies on the string ');' not being used - # inside of translatable strings... so SLX_DONT_DO_THAT! - # As an alternative, we could implement a real parser, but - # I'd like to postpone that until the current scheme proves - # simply not good enough. - my $tr = $1; - if (!($tr =~ m[^'([^']+)'\s*(,.+?)*\s*$]os - || $tr =~ m[^\"([^"]+)\"\s*(,.+?)*\s*$]os - || $tr =~ m{^qq?\[([^\]]+)\]\s*(,.+?)*\s*$}os)) { - die "$File::Find::name: could not parse _tr()-argument \n" - ."\t$tr\nPlease correct and retry.\n"; - } - $tr = $1; - if ($tr =~ m[(\$\w+)]) { - die "$File::Find::name: _tr()-argument\n\t$tr\n" - ."contains variable '$1'.\nPlease correct and retry.\n"; - } - $tr =~ s[\n][\\n]g; - $tr =~ s[\t][\\t]g; - $translatableStrings{$tr} = $tr; - print "\t$tr\n" if $verbose; - } + $File::Find::prune = 1 if ($_ eq '.svn' + || $_ eq 'Translations' + || $_ eq 'devel-tools'); + return if -d; + my $text = slurpFile($_); + if ($File::Find::name !~ m[\.pm$] && $text !~ m[^#!.+/perl]im) { + # ignore anything other than perl-modules and -scripts + return; + } + print "$File::Find::name...\n"; + $fileCount++; + while($text =~ m[_tr\s*\(\s*(.+?)\s*\);]gos) { + # NOTE: that cheesy regex relies on the string ');' not being used + # inside of translatable strings... so SLX_DONT_DO_THAT! + # As an alternative, we could implement a real parser, but + # I'd like to postpone that until the current scheme proves + # simply not good enough. + my $tr = $1; + if (!($tr =~ m[^'([^']+)'\s*(,.+?)*\s*$]os + || $tr =~ m[^\"([^"]+)\"\s*(,.+?)*\s*$]os + || $tr =~ m{^qq?\[([^\]]+)\]\s*(,.+?)*\s*$}os)) { + die "$File::Find::name: could not parse _tr()-argument \n" + ."\t$tr\nPlease correct and retry.\n"; + } + $tr = $1; + if ($tr =~ m[(\$\w+)]) { + die "$File::Find::name: _tr()-argument\n\t$tr\n" + ."contains variable '$1'.\nPlease correct and retry.\n"; + } + $tr =~ s[\n][\\n]g; + $tr =~ s[\t][\\t]g; + $translatableStrings{$tr} = $tr; + print "\t$tr\n" if $verbose; + } } sub UpdateTrModule { - $File::Find::prune = 1 if ($_ eq '.svn'); - return if -d || !/.pm$/; - print "updating $File::Find::name...\n"; - my $trModule = $_; - my $useKeyAsTranslation = ($trModule eq 'posix.pm'); - my $text = slurpFile($trModule); - if ($text !~ m[%translations\s*=\s*\(\s*(.+)\s*\);]os) { - print "\t*** No translations found - file will be skipped! ***\n"; - return; - } - my %translations; - # evaluate the hash read from file into %translations: - if (!eval "$&") { - print "\t*** translations can't be evaluated - file will be skipped! ***\n"; - return; - } - my $updatedTranslations = "%translations = (\n"; - my $keepCount = 0; - my $newCount = 0; - foreach my $tr (sort {lc($a) cmp lc($b)} keys %translatableStrings) { - if (!length($translations{$tr})) { - if ($useKeyAsTranslation) { - # POSIX language (English): use key as translation: - $updatedTranslations - .= "\tq{$tr}\n\t=>\n\tqq{$tr},\n\n"; - $newCount++; - } else { - # no translation available, we mark the key, such that a - # search for this key will fall back to the english message: - my $trMark = "NEW:$tr"; - if (exists $translations{$trMark}) { - # the marked string already exists, we keep the translation - # if any (usually, of course, there is none): - my $trValue = $translations{$trMark}; - $trValue =~ s[\n][\\n]g; - $trValue =~ s[\t][\\t]g; - $updatedTranslations - .= "\tq{$trMark}\n\t=>\n\tqq{$trValue},\n\n"; - $keepCount++; - } else { - $updatedTranslations - .= "\tq{$trMark}\n\t=>\n\tqq{},\n\n"; - $newCount++; - } - } - } else { - # use existing translation for key: - my $trValue = $translations{$tr}; - $trValue =~ s[\n][\\n]g; - $trValue =~ s[\t][\\t]g; - $updatedTranslations - .= "\tq{$tr}\n\t=>\n\tqq{$trValue},\n\n"; - $keepCount++; - } - } - my $delCount = scalar(keys %translations) - $keepCount; - $text =~ s[%translations\s*=\s*\(\s*(.+)\s*\);] - [$updatedTranslations);]os; - if ($newCount + $delCount) { - chomp $text; - spitFile($trModule, $text."\n"); - print "\tadded $newCount strings, kept $keepCount and removed $delCount.\n"; - } else { - print "\tnothing changed\n"; - } + $File::Find::prune = 1 if ($_ eq '.svn'); + return if -d || !/.pm$/; + print "updating $File::Find::name...\n"; + my $trModule = $_; + my $useKeyAsTranslation = ($trModule eq 'posix.pm'); + my $text = slurpFile($trModule); + if ($text !~ m[%translations\s*=\s*\(\s*(.+)\s*\);]os) { + print "\t*** No translations found - file will be skipped! ***\n"; + return; + } + my %translations; + # evaluate the hash read from file into %translations: + if (!eval "$&") { + print "\t*** translations can't be evaluated - file will be skipped! ***\n"; + return; + } + my $updatedTranslations = "%translations = (\n"; + my $keepCount = 0; + my $newCount = 0; + foreach my $tr (sort {lc($a) cmp lc($b)} keys %translatableStrings) { + if (!length($translations{$tr})) { + if ($useKeyAsTranslation) { + # POSIX language (English): use key as translation: + $updatedTranslations + .= "\tq{$tr}\n\t=>\n\tqq{$tr},\n\n"; + $newCount++; + } else { + # no translation available, we mark the key, such that a + # search for this key will fall back to the english message: + my $trMark = "NEW:$tr"; + if (exists $translations{$trMark}) { + # the marked string already exists, we keep the translation + # if any (usually, of course, there is none): + my $trValue = $translations{$trMark}; + $trValue =~ s[\n][\\n]g; + $trValue =~ s[\t][\\t]g; + $updatedTranslations + .= "\tq{$trMark}\n\t=>\n\tqq{$trValue},\n\n"; + $keepCount++; + } else { + $updatedTranslations + .= "\tq{$trMark}\n\t=>\n\tqq{},\n\n"; + $newCount++; + } + } + } else { + # use existing translation for key: + my $trValue = $translations{$tr}; + $trValue =~ s[\n][\\n]g; + $trValue =~ s[\t][\\t]g; + $updatedTranslations + .= "\tq{$tr}\n\t=>\n\tqq{$trValue},\n\n"; + $keepCount++; + } + } + my $delCount = scalar(keys %translations) - $keepCount; + $text =~ s[%translations\s*=\s*\(\s*(.+)\s*\);] + [$updatedTranslations);]os; + if ($newCount + $delCount) { + chomp $text; + spitFile($trModule, $text."\n"); + print "\tadded $newCount strings, kept $keepCount and removed $delCount.\n"; + } else { + print "\tnothing changed\n"; + } } __END__ diff --git a/bin/devel-tools/parseSusePatterns.pl b/bin/devel-tools/parseSusePatterns.pl index 317a9c47..a286cd71 100755 --- a/bin/devel-tools/parseSusePatterns.pl +++ b/bin/devel-tools/parseSusePatterns.pl @@ -11,8 +11,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # parseSusePatterns.pl -# - OpenSLX script to extract a package list from a given list of -# SUSE-pattern-files (*.pat). +# - OpenSLX script to extract a package list from a given list of +# SUSE-pattern-files (*.pat). # ----------------------------------------------------------------------------- use strict; use warnings; @@ -27,30 +27,30 @@ use Getopt::Long; use Pod::Usage; my ( - $helpReq, - $versionReq, + $helpReq, + $versionReq, - %patternNames, - %packageNames, + %patternNames, + %packageNames, ); GetOptions( - 'help|?' => \$helpReq, - 'version' => \$versionReq, + 'help|?' => \$helpReq, + 'version' => \$versionReq, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; if ($versionReq) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } if ($ARGV[0] !~ m[^(\w+)-(.+)$]) { - die "can't extract architecture from pattern file name '$ARGV[0]'"; + die "can't extract architecture from pattern file name '$ARGV[0]'"; } my $arch = $2; foreach my $patternFile (@ARGV) { - parsePatternFile($patternFile, 1); + parsePatternFile($patternFile, 1); } print join("\n", sort keys %packageNames)."\n"; @@ -59,78 +59,78 @@ exit; sub parsePatternFile { - my $patternFile = shift; - my $outmost = shift; - - my $patFH; - if (!open($patFH, '<', $patternFile)) { - return unless $outmost; - die "unable to open $patternFile"; - } - undef $/; - my $content = <$patFH>; - close($patFH); - $patternNames{$patternFile} = 1; - - if ($content =~ m[^\=Sum.de:\s*(.+?)\s*$]ms) { - print "+ $1\n"; - } - if ($content =~ m[^\+Sug:\s*?$(.+?)^\-Sug:\s*?$]ms) { - addSubPatterns($1); - } - if ($content =~ m[^\+Req:\s*?$(.+?)^\-Req:\s*?$]ms) { - addSubPatterns($1); - } - if ($content =~ m[^\+Rec:\s*?$(.+?)^\-Rec:\s*?$]ms) { - addSubPatterns($1); - } - if ($content =~ m[^\+Prq:\s*?$(.+?)^\-Prq:\s*?$]ms) { - addPkgNames($1); - } - if ($content =~ m[^\+Prc:\s*?$(.+?)^\-Prc:\s*?$]ms) { - addPkgNames($1); - } - return; + my $patternFile = shift; + my $outmost = shift; + + my $patFH; + if (!open($patFH, '<', $patternFile)) { + return unless $outmost; + die "unable to open $patternFile"; + } + undef $/; + my $content = <$patFH>; + close($patFH); + $patternNames{$patternFile} = 1; + + if ($content =~ m[^\=Sum.de:\s*(.+?)\s*$]ms) { + print "+ $1\n"; + } + if ($content =~ m[^\+Sug:\s*?$(.+?)^\-Sug:\s*?$]ms) { + addSubPatterns($1); + } + if ($content =~ m[^\+Req:\s*?$(.+?)^\-Req:\s*?$]ms) { + addSubPatterns($1); + } + if ($content =~ m[^\+Rec:\s*?$(.+?)^\-Rec:\s*?$]ms) { + addSubPatterns($1); + } + if ($content =~ m[^\+Prq:\s*?$(.+?)^\-Prq:\s*?$]ms) { + addPkgNames($1); + } + if ($content =~ m[^\+Prc:\s*?$(.+?)^\-Prc:\s*?$]ms) { + addPkgNames($1); + } + return; } sub addSubPatterns { - my $patternNames = shift; - - my @subPatterns - = grep { length($_) > 0 } - map { - my $pattern = $_; - $pattern =~ s[^\s*(.+?)\s*$][$1]; - $pattern; - } - split "\n", $patternNames; - - foreach my $subPattern (@subPatterns) { - my $subPatternFile = "$subPattern-$arch"; - if (!exists $patternNames{$subPatternFile}) { - parsePatternFile($subPatternFile); - } - } - return; + my $patternNames = shift; + + my @subPatterns + = grep { length($_) > 0 } + map { + my $pattern = $_; + $pattern =~ s[^\s*(.+?)\s*$][$1]; + $pattern; + } + split "\n", $patternNames; + + foreach my $subPattern (@subPatterns) { + my $subPatternFile = "$subPattern-$arch"; + if (!exists $patternNames{$subPatternFile}) { + parsePatternFile($subPatternFile); + } + } + return; } sub addPkgNames { - my $pkgs = shift; - - my @pkgNames - = grep { length($_) > 0 } - map { - my $pkg = $_; - $pkg =~ s[^\s*(.+?)\s*$][$1]; - $pkg; - } - split "\n", $pkgs; - foreach my $pkgName (@pkgNames) { - $packageNames{$pkgName} = 1; - } - return; + my $pkgs = shift; + + my @pkgNames + = grep { length($_) > 0 } + map { + my $pkg = $_; + $pkg =~ s[^\s*(.+?)\s*$][$1]; + $pkg; + } + split "\n", $pkgs; + foreach my $pkgName (@pkgNames) { + $packageNames{$pkgName} = 1; + } + return; } =head1 NAME diff --git a/bin/slxldd b/bin/slxldd index f7aade3f..8f070461 100755 --- a/bin/slxldd +++ b/bin/slxldd @@ -11,7 +11,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # slxldd -# - OpenSLX-rewrite of ldd that works on multiple architectures. +# - OpenSLX-rewrite of ldd that works on multiple architectures. # ----------------------------------------------------------------------------- use strict; use warnings; @@ -38,41 +38,41 @@ use OpenSLX::Basics; use OpenSLX::LibScanner; my %option = ( - rootPath => '/', + rootPath => '/', ); GetOptions( - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'root-path=s' => \$option{rootPath}, - 'verbose' => \$option{verbose}, - 'version' => \$option{versionReq}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'root-path=s' => \$option{rootPath}, + 'verbose' => \$option{verbose}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; pod2usage(-verbose => 2) if $option{manReq}; if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } openslxInit(); if (!$option{rootPath}) { - print STDERR _tr("You need to specify the root-path!\n"); - pod2usage(2); + print STDERR _tr("You need to specify the root-path!\n"); + pod2usage(2); } $option{rootPath} =~ s[/+$][]; # remove trailing slashes if (!@ARGV) { - print STDERR _tr("You need to specify at least one file!\n"); - pod2usage(2); + print STDERR _tr("You need to specify at least one file!\n"); + pod2usage(2); } my $libScanner = OpenSLX::LibScanner->new({ - 'root-path' => $option{rootPath}, - 'verbose' => $option{verbose}, + 'root-path' => $option{rootPath}, + 'verbose' => $option{verbose}, }); my @libs = $libScanner->determineRequiredLibs(@ARGV); diff --git a/bin/slxsettings b/bin/slxsettings index 643b8026..6c081ddf 100755 --- a/bin/slxsettings +++ b/bin/slxsettings @@ -11,7 +11,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # slxsettings -# - OpenSLX-script to show & change local settings +# - OpenSLX-script to show & change local settings # ----------------------------------------------------------------------------- use strict; use warnings; @@ -46,68 +46,68 @@ use OpenSLX::Utils; my (@reset, %givenSettings, %option); GetOptions( - 'quiet' => \$option{quiet}, - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'version' => \$option{versionReq}, + 'quiet' => \$option{quiet}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, ); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; pod2usage(-verbose => 2) if $option{manReq}; if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } if ($> != 0) { - die _tr("Sorry, this script can only be executed by the superuser!\n"); + die _tr("Sorry, this script can only be executed by the superuser!\n"); } openslxInit() or pod2usage(2); # some settings must match a certain pattern: my %configPattern = ( - 'db-type' => '(SQLite|mysql)', + 'db-type' => '(SQLite|mysql)', ); # the remaining cmdline arguments are set or reset actions, each followed # by a single argument: while (scalar @ARGV) { - my $action = shift || ''; - my $arg = shift || ''; - if ($action eq 'set') { - if ($arg !~ m[^([-\w]+)=(.+)$]) { - die _tr( - "set-argument '%s' has unknown format, expected '=!'", - $arg - ); - } - $givenSettings{$1} = $2; - } - elsif ($action eq 'reset') { - push @reset, $arg; - } - else { - die _tr(unshiftHereDoc(<<' END-OF-HERE'), $arg, $0); - action '%s' is not understood! Known actions are: - set - reset - Try '%s --help' for more info. - END-OF-HERE - } + my $action = shift || ''; + my $arg = shift || ''; + if ($action eq 'set') { + if ($arg !~ m[^([-\w]+)=(.+)$]) { + die _tr( + "set-argument '%s' has unknown format, expected '=!'", + $arg + ); + } + $givenSettings{$1} = $2; + } + elsif ($action eq 'reset') { + push @reset, $arg; + } + else { + die _tr(unshiftHereDoc(<<' END-OF-HERE'), $arg, $0); + action '%s' is not understood! Known actions are: + set + reset + Try '%s --help' for more info. + END-OF-HERE + } } # fetch current content of local settings file... my $fileName = "$openslxConfig{'config-path'}/settings"; if (!-e $fileName) { - # create empty default settings file with tight mode (root-only access) - # [I know this isn't *secure* as such, but it's still better than nothing] - slxsystem("touch $fileName && chmod 0600 $fileName"); + # create empty default settings file with tight mode (root-only access) + # [I know this isn't *secure* as such, but it's still better than nothing] + slxsystem("touch $fileName && chmod 0600 $fileName"); } my $configObj = Config::General->new( - -ConfigFile => $fileName, - -SplitDelimiter => '\s*=\s*', - -SplitPolicy => 'custom', - -StoreDelimiter => '=', + -ConfigFile => $fileName, + -SplitDelimiter => '\s*=\s*', + -SplitPolicy => 'custom', + -StoreDelimiter => '=', ); my %settings = $configObj->getall(); @@ -115,116 +115,116 @@ my %changed; # ...set new values... foreach my $key (keys %givenSettings) { - my $value = $givenSettings{$key}; - next if !defined $value; - if (!exists $openslxConfig{$key}) { - die _tr("option '%s' is not known!", $key); - } - if ($key =~ m{^(base-path|config-path)$}) { - die _tr("option '%s' is fixed!", $key); - } - if (exists $configPattern{$key} && $value !~ m{$configPattern{$key}}) { - die _tr( - "option '%s' must match pattern '%s'!", $key, $configPattern{$key} - ); - } - - vlog(0, _tr("setting %s to '%s'", $key, $value)) unless $option{quiet}; - my $externalKey = externalKeyFor($key); - if (!exists $settings{$externalKey} || $settings{$externalKey} ne $value) { - $settings{$externalKey} = $value; - } - $changed{$key}++; + my $value = $givenSettings{$key}; + next if !defined $value; + if (!exists $openslxConfig{$key}) { + die _tr("option '%s' is not known!", $key); + } + if ($key =~ m{^(base-path|config-path)$}) { + die _tr("option '%s' is fixed!", $key); + } + if (exists $configPattern{$key} && $value !~ m{$configPattern{$key}}) { + die _tr( + "option '%s' must match pattern '%s'!", $key, $configPattern{$key} + ); + } + + vlog(0, _tr("setting %s to '%s'", $key, $value)) unless $option{quiet}; + my $externalKey = externalKeyFor($key); + if (!exists $settings{$externalKey} || $settings{$externalKey} ne $value) { + $settings{$externalKey} = $value; + } + $changed{$key}++; } # reset specified keys to fall back to default: foreach my $key (@reset) { - my $externalKey = externalKeyFor($key); - if (exists $settings{$externalKey}) { - delete $settings{$externalKey}; - vlog(0, - _tr("removing option '%s' from local settings", $key)) - unless $option{quiet}; - } else { - vlog(0, - _tr("option '%s' didn't exist in local settings!", $key)) - unless $option{quiet}; - } - $changed{$key}++; + my $externalKey = externalKeyFor($key); + if (exists $settings{$externalKey}) { + delete $settings{$externalKey}; + vlog(0, + _tr("removing option '%s' from local settings", $key)) + unless $option{quiet}; + } else { + vlog(0, + _tr("option '%s' didn't exist in local settings!", $key)) + unless $option{quiet}; + } + $changed{$key}++; } # ... and write local settings file if necessary if (keys %changed) { - $configObj->save_file($fileName, \%settings); + $configObj->save_file($fileName, \%settings); - openslxInit(); + openslxInit(); - foreach my $key (keys %changed) { - changedHandler($key, $openslxConfig{$key}); - } + foreach my $key (keys %changed) { + changedHandler($key, $openslxConfig{$key}); + } } if (!keys %changed) { - print _tr("paths fixed at installation time:\n"); - print qq[\tbase-path='$openslxConfig{'base-path'}'\n]; - print qq[\tconfig-path='$openslxConfig{'config-path'}'\n]; - my $text = - keys %changed - ? "resulting base settings (cmdline options):\n" - : "current base settings (cmdline options):\n"; - print $text; - my @baseSettings = grep { exists $cmdlineConfig{$_} } keys %openslxConfig; - foreach my $key (sort @baseSettings) { - my $val = $openslxConfig{$key} || ''; - print qq[\t$key='$val'\n]; - } - print _tr("extended settings:\n"); - my @extSettings = grep { !exists $cmdlineConfig{$_} } keys %openslxConfig; - foreach my $key (sort @extSettings) { - next if $key =~ m[^(base-path|config-path)$]; - my $val = $openslxConfig{$key}; - if (defined $val) { - print qq[\t$key='$val'\n]; - } - else { - print qq[\t$key=\n]; - } - } + print _tr("paths fixed at installation time:\n"); + print qq[\tbase-path='$openslxConfig{'base-path'}'\n]; + print qq[\tconfig-path='$openslxConfig{'config-path'}'\n]; + my $text = + keys %changed + ? "resulting base settings (cmdline options):\n" + : "current base settings (cmdline options):\n"; + print $text; + my @baseSettings = grep { exists $cmdlineConfig{$_} } keys %openslxConfig; + foreach my $key (sort @baseSettings) { + my $val = $openslxConfig{$key} || ''; + print qq[\t$key='$val'\n]; + } + print _tr("extended settings:\n"); + my @extSettings = grep { !exists $cmdlineConfig{$_} } keys %openslxConfig; + foreach my $key (sort @extSettings) { + next if $key =~ m[^(base-path|config-path)$]; + my $val = $openslxConfig{$key}; + if (defined $val) { + print qq[\t$key='$val'\n]; + } + else { + print qq[\t$key=\n]; + } + } } sub externalKeyFor { - my $key = shift; + my $key = shift; - $key =~ tr[-][_]; - return "SLX_" . uc($key); + $key =~ tr[-][_]; + return "SLX_" . uc($key); } sub changedHandler { - my $key = shift; - my $value = shift; - - # invoke a key-specific change handler if it exists: - $key =~ tr[-][_]; - - # we do the following function call in an eval as that function may simply - # not exist: - eval { - no strict 'refs'; ## no critic (ProhibitNoStrict) - "${key}_changed_handler"->(); - }; - - return; + my $key = shift; + my $value = shift; + + # invoke a key-specific change handler if it exists: + $key =~ tr[-][_]; + + # we do the following function call in an eval as that function may simply + # not exist: + eval { + no strict 'refs'; ## no critic (ProhibitNoStrict) + "${key}_changed_handler"->(); + }; + + return; } sub private_path_changed_handler { - # create the default config folders (for default system only): - require OpenSLX::ConfigFolder; - OpenSLX::ConfigFolder::createConfigFolderForDefaultSystem(); + # create the default config folders (for default system only): + require OpenSLX::ConfigFolder; + OpenSLX::ConfigFolder::createConfigFolderForDefaultSystem(); - return; + return; } =head1 NAME diff --git a/config-db/OpenSLX/AttributeRoster.pm b/config-db/OpenSLX/AttributeRoster.pm index a44da03b..c37421c8 100644 --- a/config-db/OpenSLX/AttributeRoster.pm +++ b/config-db/OpenSLX/AttributeRoster.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # AttributeRoster.pm -# - provides information about all available attributes +# - provides information about all available attributes # ----------------------------------------------------------------------------- package OpenSLX::AttributeRoster; @@ -32,344 +32,344 @@ my %AttributeInfo; # sub _init { - my $class = shift; - - # set core attributes - %AttributeInfo = ( - 'automnt_dir' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'automnt_src' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'country' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'de', - }, - 'dm_allow_shutdown' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'user', - }, - 'hw_graphic' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'hw_monitor' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'hw_mouse' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'netbios_workgroup' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'slx-network', - }, - 'nis_domain' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'nis_servers' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_fsmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of filesystem kernel modules to load - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_miscmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of miscellaneous kernel modules to load - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'ramfs_nicmods' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - list of network card modules to load - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', - }, - 'sane_scanner' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'scratch' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'slxgrp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - 'start_alsasound' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_atd' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_cron' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_dreshal' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_ntp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'initial', - }, - 'start_nfsv4' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_printer' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_samba' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'may', - }, - 'start_snmp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'start_sshd' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_syslogd' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_x' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'yes', - }, - 'start_xdmcp' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'kdm', - }, - 'tex_enable' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'timezone' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - textual timezone (e.g. 'Europe/Berlin') - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'Europe/Berlin', - }, - 'tvout' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - 'vmware' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - !!!descriptive text missing here!!! - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'no', - }, - ); - - # and add all plugin attributes, too - OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); + my $class = shift; + + # set core attributes + %AttributeInfo = ( + 'automnt_dir' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'automnt_src' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'country' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'de', + }, + 'dm_allow_shutdown' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'user', + }, + 'hw_graphic' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'hw_monitor' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'hw_mouse' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'netbios_workgroup' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'slx-network', + }, + 'nis_domain' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'nis_servers' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_fsmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of filesystem kernel modules to load + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_miscmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of miscellaneous kernel modules to load + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_nicmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of network card modules to load + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + }, + 'sane_scanner' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'scratch' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'slxgrp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'start_alsasound' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_atd' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_cron' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_dreshal' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_ntp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'initial', + }, + 'start_nfsv4' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_printer' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_samba' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'may', + }, + 'start_snmp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_sshd' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_syslogd' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_x' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_xdmcp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'kdm', + }, + 'tex_enable' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'timezone' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + textual timezone (e.g. 'Europe/Berlin') + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'Europe/Berlin', + }, + 'tvout' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'vmware' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + ); + + # and add all plugin attributes, too + OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); } =item C @@ -388,33 +388,33 @@ An hash-ref with info about all known attributes. sub getAttrInfo { - my $class = shift; - my $params = shift; - - $class->_init() if !%AttributeInfo; - - if (defined $params->{name}) { - my $attrInfo = $AttributeInfo{$params->{name}}; - return if !defined $attrInfo; - return { $params->{name} => $AttributeInfo{$params->{name}} }; - } - elsif (defined $params->{scope}) { - my %MatchingAttributeInfo; - my $selectedScope = lc($params->{scope}); - foreach my $attr (keys %AttributeInfo) { - my $attrScope = ''; - if ($attr =~ m{^(.+?)::}) { - $attrScope = lc($1); - } - if ((!$attrScope && $selectedScope eq 'core') - || $attrScope eq $selectedScope) { - $MatchingAttributeInfo{$attr} = $AttributeInfo{$attr}; - } - } - return \%MatchingAttributeInfo; - } - - return \%AttributeInfo; + my $class = shift; + my $params = shift; + + $class->_init() if !%AttributeInfo; + + if (defined $params->{name}) { + my $attrInfo = $AttributeInfo{$params->{name}}; + return if !defined $attrInfo; + return { $params->{name} => $AttributeInfo{$params->{name}} }; + } + elsif (defined $params->{scope}) { + my %MatchingAttributeInfo; + my $selectedScope = lc($params->{scope}); + foreach my $attr (keys %AttributeInfo) { + my $attrScope = ''; + if ($attr =~ m{^(.+?)::}) { + $attrScope = lc($1); + } + if ((!$attrScope && $selectedScope eq 'core') + || $attrScope eq $selectedScope) { + $MatchingAttributeInfo{$attr} = $AttributeInfo{$attr}; + } + } + return \%MatchingAttributeInfo; + } + + return \%AttributeInfo; } =item C @@ -433,16 +433,16 @@ An array of attribute names. sub getStage3Attrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { - $AttributeInfo{$_}->{applies_to_systems} - || $AttributeInfo{$_}->{applies_to_client} - } - keys %AttributeInfo + return + grep { + $AttributeInfo{$_}->{applies_to_systems} + || $AttributeInfo{$_}->{applies_to_client} + } + keys %AttributeInfo } =item C @@ -461,13 +461,13 @@ An array of attribute names. sub getSystemAttrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { $AttributeInfo{$_}->{"applies_to_systems"} } - keys %AttributeInfo + return + grep { $AttributeInfo{$_}->{"applies_to_systems"} } + keys %AttributeInfo } =item C @@ -486,13 +486,13 @@ An array of attribute names. sub getClientAttrs { - my $class = shift; + my $class = shift; - $class->_init() if !%AttributeInfo; + $class->_init() if !%AttributeInfo; - return - grep { $AttributeInfo{$_}->{"applies_to_clients"} } - keys %AttributeInfo + return + grep { $AttributeInfo{$_}->{"applies_to_clients"} } + keys %AttributeInfo } 1; diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm index 8382f066..324a3cf2 100644 --- a/config-db/OpenSLX/ConfigDB.pm +++ b/config-db/OpenSLX/ConfigDB.pm @@ -111,13 +111,13 @@ Returns an object representing a database handle to the config database. sub new { - my $class = shift; + my $class = shift; - my $self = { - 'db-schema' => OpenSLX::DBSchema->new, - }; + my $self = { + 'db-schema' => OpenSLX::DBSchema->new, + }; - return bless $self, $class; + return bless $self, $class; } =item C @@ -145,49 +145,49 @@ The precise name of the database that should be connected (defaults to 'openslx' =cut -sub connect ## no critic (ProhibitBuiltinHomonyms) +sub connect ## no critic (ProhibitBuiltinHomonyms) { - my $self = shift; - my $dbParams = shift; - # hash-ref with any additional info that might be required by - # specific metadb-module (not used yet) + my $self = shift; + my $dbParams = shift; + # hash-ref with any additional info that might be required by + # specific metadb-module (not used yet) - my $dbType = $openslxConfig{'db-type'}; - # name of underlying database module... + my $dbType = $openslxConfig{'db-type'}; + # name of underlying database module... - my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; - my $dbModule = "OpenSLX::MetaDB::$dbType"; - unless (eval { require $dbModuleName } ) { - if ($! == 2) { - die _tr( - "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", - $dbModuleName - ); - } else { - die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); - } - } - my $metaDB = $dbModule->new(); - if (!$metaDB->connect($dbParams)) { - warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); - warn _tr("These DB-modules seem to work ok:"); - foreach my $dbMod ('mysql', 'SQLite') { - my $fullDbModName = "DBD/$dbMod.pm"; - if (eval { require $fullDbModName }) { - vlog(0, "\t$dbMod\n"); - } - } - die _tr( - 'Please use slxsettings if you want to switch to another db-type.' - ); - } + my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; + my $dbModule = "OpenSLX::MetaDB::$dbType"; + unless (eval { require $dbModuleName } ) { + if ($! == 2) { + die _tr( + "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", + $dbModuleName + ); + } else { + die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); + } + } + my $metaDB = $dbModule->new(); + if (!$metaDB->connect($dbParams)) { + warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); + warn _tr("These DB-modules seem to work ok:"); + foreach my $dbMod ('mysql', 'SQLite') { + my $fullDbModName = "DBD/$dbMod.pm"; + if (eval { require $fullDbModName }) { + vlog(0, "\t$dbMod\n"); + } + } + die _tr( + 'Please use slxsettings if you want to switch to another db-type.' + ); + } - $self->{'db-type'} = $dbType; - $self->{'meta-db'} = $metaDB; + $self->{'db-type'} = $dbType; + $self->{'meta-db'} = $metaDB; - $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self); + $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self); - return 1; + return 1; } =item C @@ -198,11 +198,11 @@ Tears down the connection to the database and cleans up. sub disconnect { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->disconnect(); + $self->{'meta-db'}->disconnect(); - return 1; + return 1; } =item C @@ -214,11 +214,11 @@ changes apply as a whole or not at all. sub startTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->startTransaction(); + $self->{'meta-db'}->startTransaction(); - return 1; + return 1; } =item C @@ -230,11 +230,11 @@ will be applied to the database. sub commitTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->commitTransaction(); + $self->{'meta-db'}->commitTransaction(); - return 1; + return 1; } =item C @@ -246,11 +246,11 @@ will be undone. sub rollbackTransaction { - my $self = shift; + my $self = shift; - $self->{'meta-db'}->rollbackTransaction(); + $self->{'meta-db'}->rollbackTransaction(); - return 1; + return 1; } =back @@ -281,10 +281,10 @@ An array of column names. sub getColumnsOfTable { - my $self = shift; - my $tableName = shift; + my $self = shift; + my $tableName = shift; - return $self->{'db-schema'}->getColumnsOfTable($tableName); + return $self->{'db-schema'}->getColumnsOfTable($tableName); } =item C @@ -313,14 +313,14 @@ An array of hash-refs containing the resulting data rows. sub fetchVendorOSByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - my @vendorOS - = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); + my @vendorOS + = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); - return wantarray() ? @vendorOS : shift @vendorOS; + return wantarray() ? @vendorOS : shift @vendorOS; } =item C @@ -347,13 +347,13 @@ An array of hash-refs containing the resulting data rows. sub fetchVendorOSByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); + my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); - return wantarray() ? @vendorOS : shift @vendorOS; + return wantarray() ? @vendorOS : shift @vendorOS; } =item C @@ -381,11 +381,11 @@ An array with the plugin names. sub fetchInstalledPlugins { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); + $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); } =item C @@ -414,13 +414,13 @@ An array of hash-refs containing the resulting data rows. sub fetchExportByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); + my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); - return wantarray() ? @exports : shift @exports; + return wantarray() ? @exports : shift @exports; } =item C @@ -447,13 +447,13 @@ An array of hash-refs containing the resulting data rows. sub fetchExportByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); + my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); - return wantarray() ? @exports : shift @exports; + return wantarray() ? @exports : shift @exports; } =item C @@ -476,10 +476,10 @@ An array of system-IDs. sub fetchExportIDsOfVendorOS { - my $self = shift; - my $vendorOSID = shift; + my $self = shift; + my $vendorOSID = shift; - return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); + return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); } =item C @@ -502,10 +502,10 @@ The value of the requested global info. sub fetchGlobalInfo { - my $self = shift; - my $id = shift; + my $self = shift; + my $id = shift; - return $self->{'meta-db'}->fetchGlobalInfo($id); + return $self->{'meta-db'}->fetchGlobalInfo($id); } =item C @@ -539,25 +539,25 @@ An array of hash-refs containing the resulting data rows. sub fetchSystemByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @systems = $self->{'meta-db'}->fetchSystemByFilter( - $filter, $resultCols, $attrFilter - ); + my @systems = $self->{'meta-db'}->fetchSystemByFilter( + $filter, $resultCols, $attrFilter + ); - # unless specific result cols have been given, we mix in the attributes - # of each system, too: - if (!defined $resultCols) { - foreach my $system (@systems) { - $system->{attrs} - = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); - } - } + # unless specific result cols have been given, we mix in the attributes + # of each system, too: + if (!defined $resultCols) { + foreach my $system (@systems) { + $system->{attrs} + = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); + } + } - return wantarray() ? @systems : shift @systems; + return wantarray() ? @systems : shift @systems; } =item C @@ -584,22 +584,22 @@ An array of hash-refs containing the resulting data rows. sub fetchSystemByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @systems = $self->{'meta-db'}->fetchSystemByID($ids, $resultCols); - - # unless specific result cols have been given, we mix in the attributes - # of each system, too: - if (!defined $resultCols) { - foreach my $system (@systems) { - $system->{attrs} - = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); - } - } + my @systems = $self->{'meta-db'}->fetchSystemByID($ids, $resultCols); + + # unless specific result cols have been given, we mix in the attributes + # of each system, too: + if (!defined $resultCols) { + foreach my $system (@systems) { + $system->{attrs} + = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); + } + } - return wantarray() ? @systems : shift @systems; + return wantarray() ? @systems : shift @systems; } =item C @@ -622,10 +622,10 @@ An array of system-IDs. sub fetchSystemIDsOfExport { - my $self = shift; - my $exportID = shift; + my $self = shift; + my $exportID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); + return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); } =item C @@ -649,10 +649,10 @@ An array of system-IDs. sub fetchSystemIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); } =item C @@ -676,10 +676,10 @@ An array of system-IDs. sub fetchSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); } =item C @@ -708,25 +708,25 @@ An array of hash-refs containing the resulting data rows. sub fetchClientByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @clients = $self->{'meta-db'}->fetchClientByFilter( - $filter, $resultCols, $attrFilter - ); + my @clients = $self->{'meta-db'}->fetchClientByFilter( + $filter, $resultCols, $attrFilter + ); - # unless specific result cols have been given, we mix in the attributes - # of each client, too: - if (!defined $resultCols) { - foreach my $client (@clients) { - $client->{attrs} - = $self->{'meta-db'}->fetchClientAttrs($client->{id}); - } - } + # unless specific result cols have been given, we mix in the attributes + # of each client, too: + if (!defined $resultCols) { + foreach my $client (@clients) { + $client->{attrs} + = $self->{'meta-db'}->fetchClientAttrs($client->{id}); + } + } - return wantarray() ? @clients : shift @clients; + return wantarray() ? @clients : shift @clients; } =item C @@ -753,22 +753,22 @@ An array of hash-refs containing the resulting data rows. sub fetchClientByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); + my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); - # unless specific result cols have been given, we mix in the attributes - # of each client, too: - if (!defined $resultCols) { - foreach my $client (@clients) { - $client->{attrs} - = $self->{'meta-db'}->fetchClientAttrs($client->{id}); - } - } + # unless specific result cols have been given, we mix in the attributes + # of each client, too: + if (!defined $resultCols) { + foreach my $client (@clients) { + $client->{attrs} + = $self->{'meta-db'}->fetchClientAttrs($client->{id}); + } + } - return wantarray() ? @clients : shift @clients; + return wantarray() ? @clients : shift @clients; } =item C @@ -792,10 +792,10 @@ An array of client-IDs. sub fetchClientIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); } =item C @@ -819,10 +819,10 @@ An array of client-IDs. sub fetchClientIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); } =item C @@ -851,25 +851,25 @@ An array of hash-refs containing the resulting data rows. sub fetchGroupByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - my @groups = $self->{'meta-db'}->fetchGroupByFilter( - $filter, $resultCols, $attrFilter - ); + my @groups = $self->{'meta-db'}->fetchGroupByFilter( + $filter, $resultCols, $attrFilter + ); - # unless specific result cols have been given, we mix in the attributes - # of each group, too: - if (!defined $resultCols) { - foreach my $group (@groups) { - $group->{attrs} - = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); - } - } + # unless specific result cols have been given, we mix in the attributes + # of each group, too: + if (!defined $resultCols) { + foreach my $group (@groups) { + $group->{attrs} + = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); + } + } - return wantarray() ? @groups : shift @groups; + return wantarray() ? @groups : shift @groups; } =item C @@ -896,22 +896,22 @@ An array of hash-refs containing the resulting data rows. sub fetchGroupByID { - my $self = shift; - my $ids = _aref(shift); - my $resultCols = shift; + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; - my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); + my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); - # unless specific result cols have been given, we mix in the attributes - # of each group, too: - if (!defined $resultCols) { - foreach my $group (@groups) { - $group->{attrs} - = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); - } - } + # unless specific result cols have been given, we mix in the attributes + # of each group, too: + if (!defined $resultCols) { + foreach my $group (@groups) { + $group->{attrs} + = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); + } + } - return wantarray() ? @groups : shift @groups; + return wantarray() ? @groups : shift @groups; } =item C @@ -935,10 +935,10 @@ An array of client-IDs. sub fetchGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); } =item C @@ -962,10 +962,10 @@ An array of client-IDs. sub fetchGroupIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); } =back @@ -994,13 +994,13 @@ The IDs of the new vendor-OS(es), C if the creation failed. sub addVendorOS { - my $self = shift; - my $valRows = _aref(shift); + my $self = shift; + my $valRows = _aref(shift); - _checkCols($valRows, 'vendor_os', 'name'); + _checkCols($valRows, 'vendor_os', 'name'); - my @IDs = $self->{'meta-db'}->addVendorOS($valRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addVendorOS($valRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1023,19 +1023,19 @@ C<1> if the vendorOS(es) could be removed, C if not. sub removeVendorOS { - my $self = shift; - my $vendorOSIDs = _aref(shift); + my $self = shift; + my $vendorOSIDs = _aref(shift); - # drop all installed plugins before removing the vendor-OS - foreach my $vendorOSID (@$vendorOSIDs) { - my @installedPlugins - = $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID); - foreach my $plugin (@installedPlugins) { - my $pluginName = $plugin->{plugin_name}; - $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); - } - } - return $self->{'meta-db'}->removeVendorOS($vendorOSIDs); + # drop all installed plugins before removing the vendor-OS + foreach my $vendorOSID (@$vendorOSIDs) { + my @installedPlugins + = $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID); + foreach my $plugin (@installedPlugins) { + my $pluginName = $plugin->{plugin_name}; + $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); + } + } + return $self->{'meta-db'}->removeVendorOS($vendorOSIDs); } =item C @@ -1062,11 +1062,11 @@ C<1> if the vendorOS(es) could be changed, C if not. sub changeVendorOS { - my $self = shift; - my $vendorOSIDs = _aref(shift); - my $valRows = _aref(shift); + my $self = shift; + my $vendorOSIDs = _aref(shift); + my $valRows = _aref(shift); - return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); + return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); } =item C @@ -1093,17 +1093,17 @@ The ID of the new reference entry, C if the creation failed. sub addInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $pluginAttrs = shift || {}; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $pluginAttrs = shift || {}; - # make sure the attributes of this plugin are available via default system - $self->{'db-schema'}->synchronizeAttributesWithDefaultSystem($self); + # make sure the attributes of this plugin are available via default system + $self->{'db-schema'}->synchronizeAttributesWithDefaultSystem($self); - return $self->{'meta-db'}->addInstalledPlugin( - $vendorOSID, $pluginName, $pluginAttrs - ); + return $self->{'meta-db'}->addInstalledPlugin( + $vendorOSID, $pluginName, $pluginAttrs + ); } =item C @@ -1130,11 +1130,11 @@ The name of the plugin that has been uninstalled sub removeInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); + return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); } =item C @@ -1157,13 +1157,13 @@ The IDs of the new export(s), C if the creation failed. sub addExport { - my $self = shift; - my $valRows = _aref(shift); + my $self = shift; + my $valRows = _aref(shift); - _checkCols($valRows, 'export', qw(name vendor_os_id type)); + _checkCols($valRows, 'export', qw(name vendor_os_id type)); - my @IDs = $self->{'meta-db'}->addExport($valRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addExport($valRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1186,10 +1186,10 @@ C<1> if the export(s) could be removed, C if not. sub removeExport { - my $self = shift; - my $exportIDs = _aref(shift); + my $self = shift; + my $exportIDs = _aref(shift); - return $self->{'meta-db'}->removeExport($exportIDs); + return $self->{'meta-db'}->removeExport($exportIDs); } =item C @@ -1216,11 +1216,11 @@ C<1> if the export(s) could be changed, C if not. sub changeExport { - my $self = shift; - my $exportIDs = _aref(shift); - my $valRows = _aref(shift); + my $self = shift; + my $exportIDs = _aref(shift); + my $valRows = _aref(shift); - return $self->{'meta-db'}->changeExport($exportIDs, $valRows); + return $self->{'meta-db'}->changeExport($exportIDs, $valRows); } =item C @@ -1243,17 +1243,17 @@ The value the global counter had before it was incremented. sub incrementGlobalCounter { - my $self = shift; - my $counterName = shift; + my $self = shift; + my $counterName = shift; - $self->startTransaction(); - my $value = $self->fetchGlobalInfo($counterName); - return unless defined $value; - my $newValue = $value + 1; - $self->changeGlobalInfo($counterName, $newValue); - $self->commitTransaction(); + $self->startTransaction(); + my $value = $self->fetchGlobalInfo($counterName); + return unless defined $value; + my $newValue = $value + 1; + $self->changeGlobalInfo($counterName, $newValue); + $self->commitTransaction(); - return $value; + return $value; } =item C @@ -1280,13 +1280,13 @@ The value the global counter had before it was incremented. sub changeGlobalInfo { - my $self = shift; - my $id = shift; - my $value = shift; + my $self = shift; + my $id = shift; + my $value = shift; - return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); + return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); - return $self->{'meta-db'}->changeGlobalInfo($id, $value); + return $self->{'meta-db'}->changeGlobalInfo($id, $value); } =item C @@ -1309,31 +1309,31 @@ The IDs of the new system(s), C if the creation failed. sub addSystem { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'system', qw(name export_id)); + _checkCols($inValRows, 'system', qw(name export_id)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - foreach my $valRow (@$valRows) { - if (!$valRow->{kernel}) { - $valRow->{kernel} = 'vmlinuz'; - vlog( - 1, - _tr( - "setting kernel of system '%s' to 'vmlinuz'!", - $valRow->{name} - ) - ); - } - if (!$valRow->{label}) { - $valRow->{label} = $valRow->{name}; - } - } + foreach my $valRow (@$valRows) { + if (!$valRow->{kernel}) { + $valRow->{kernel} = 'vmlinuz'; + vlog( + 1, + _tr( + "setting kernel of system '%s' to 'vmlinuz'!", + $valRow->{name} + ) + ); + } + if (!$valRow->{label}) { + $valRow->{label} = $valRow->{name}; + } + } - my @IDs = $self->{'meta-db'}->addSystem($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addSystem($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1356,15 +1356,15 @@ C<1> if the system(s) could be removed, C if not. sub removeSystem { - my $self = shift; - my $systemIDs = _aref(shift); + my $self = shift; + my $systemIDs = _aref(shift); - foreach my $system (@$systemIDs) { - $self->setGroupIDsOfSystem($system); - $self->setClientIDsOfSystem($system); - } + foreach my $system (@$systemIDs) { + $self->setGroupIDsOfSystem($system); + $self->setClientIDsOfSystem($system); + } - return $self->{'meta-db'}->removeSystem($systemIDs); + return $self->{'meta-db'}->removeSystem($systemIDs); } =item C @@ -1391,13 +1391,13 @@ C<1> if the system(s) could be changed, C if not. sub changeSystem { - my $self = shift; - my $systemIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $systemIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); } #=item C @@ -1429,12 +1429,12 @@ sub changeSystem # #sub setSystemAttr #{ -# my $self = shift; -# my $systemID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $systemID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); +# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); #} =item C @@ -1462,18 +1462,18 @@ C<1> if the system/client references could be set, C if not. sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $clientIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $clientIDs = _aref(shift); - # associating a client to the default system makes no sense - return 0 if $systemID == 0; + # associating a client to the default system makes no sense + return 0 if $systemID == 0; - my @uniqueClientIDs = _unique(@$clientIDs); + my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfSystem( - $systemID, \@uniqueClientIDs - ); + return $self->{'meta-db'}->setClientIDsOfSystem( + $systemID, \@uniqueClientIDs + ); } =item C @@ -1501,14 +1501,14 @@ C<1> if the system/client references could be set, C if not. sub addClientIDsToSystem { - my $self = shift; - my $systemID = shift; - my $newClientIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $newClientIDs = _aref(shift); - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - push @clientIDs, @$newClientIDs; + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + push @clientIDs, @$newClientIDs; - return $self->setClientIDsOfSystem($systemID, \@clientIDs); + return $self->setClientIDsOfSystem($systemID, \@clientIDs); } =item C @@ -1536,17 +1536,17 @@ C<1> if the system/client references could be set, C if not. sub removeClientIDsFromSystem { - my $self = shift; - my $systemID = shift; - my $removedClientIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $removedClientIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); - return $self->setClientIDsOfSystem($systemID, \@clientIDs); + return $self->setClientIDsOfSystem($systemID, \@clientIDs); } =item C @@ -1574,16 +1574,16 @@ C<1> if the system/group references could be set, C if not. sub setGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $groupIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $groupIDs = _aref(shift); - # associating a group to the default system makes no sense - return 0 if $systemID == 0; + # associating a group to the default system makes no sense + return 0 if $systemID == 0; - my @uniqueGroupIDs = _unique(@$groupIDs); + my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); } =item C @@ -1611,14 +1611,14 @@ C<1> if the system/group references could be set, C if not. sub addGroupIDsToSystem { - my $self = shift; - my $systemID = shift; - my $newGroupIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $newGroupIDs = _aref(shift); - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - push @groupIDs, @$newGroupIDs; + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + push @groupIDs, @$newGroupIDs; - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); } =item C @@ -1646,17 +1646,17 @@ C<1> if the system/group references could be set, C if not. sub removeGroupIDsFromSystem { - my $self = shift; - my $systemID = shift; - my $toBeRemovedGroupIDs = _aref(shift); + my $self = shift; + my $systemID = shift; + my $toBeRemovedGroupIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); - return $self->setGroupIDsOfSystem($systemID, \@groupIDs); + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); } =item C @@ -1679,21 +1679,21 @@ The IDs of the new client(s), C if the creation failed. sub addClient { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'client', qw(name mac)); + _checkCols($inValRows, 'client', qw(name mac)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - foreach my $valRow (@$valRows) { - if (!$valRow->{boot_type}) { - $valRow->{boot_type} = 'pxe'; - } - } + foreach my $valRow (@$valRows) { + if (!$valRow->{boot_type}) { + $valRow->{boot_type} = 'pxe'; + } + } - my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; + my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -1716,15 +1716,15 @@ C<1> if the client(s) could be removed, C if not. sub removeClient { - my $self = shift; - my $clientIDs = _aref(shift); + my $self = shift; + my $clientIDs = _aref(shift); - foreach my $client (@$clientIDs) { - $self->setGroupIDsOfClient($client); - $self->setSystemIDsOfClient($client); - } + foreach my $client (@$clientIDs) { + $self->setGroupIDsOfClient($client); + $self->setSystemIDsOfClient($client); + } - return $self->{'meta-db'}->removeClient($clientIDs); + return $self->{'meta-db'}->removeClient($clientIDs); } =item C @@ -1751,13 +1751,13 @@ C<1> if the client(s) could be changed, C if not. sub changeClient { - my $self = shift; - my $clientIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $clientIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); } #=item C @@ -1789,12 +1789,12 @@ sub changeClient # #sub setClientAttr #{ -# my $self = shift; -# my $clientID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $clientID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); +# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); #} =item C @@ -1822,16 +1822,16 @@ C<1> if the client/system references could be set, C if not. sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; - my $systemIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $systemIDs = _aref(shift); - # filter out the default system, as no client should be associated to it - my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); + # filter out the default system, as no client should be associated to it + my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); - return $self->{'meta-db'}->setSystemIDsOfClient( - $clientID, \@uniqueSystemIDs - ); + return $self->{'meta-db'}->setSystemIDsOfClient( + $clientID, \@uniqueSystemIDs + ); } =item C @@ -1859,14 +1859,14 @@ C<1> if the client/system references could be set, C if not. sub addSystemIDsToClient { - my $self = shift; - my $clientID = shift; - my $newSystemIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $newSystemIDs = _aref(shift); - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - push @systemIDs, @$newSystemIDs; + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + push @systemIDs, @$newSystemIDs; - return $self->setSystemIDsOfClient($clientID, \@systemIDs); + return $self->setSystemIDsOfClient($clientID, \@systemIDs); } =item C @@ -1894,17 +1894,17 @@ C<1> if the client/system references could be set, C if not. sub removeSystemIDsFromClient { - my $self = shift; - my $clientID = shift; - my $removedSystemIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $removedSystemIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); - return $self->setSystemIDsOfClient($clientID, \@systemIDs); + return $self->setSystemIDsOfClient($clientID, \@systemIDs); } =item C @@ -1931,13 +1931,13 @@ C<1> if the client/group references could be set, C if not. sub setGroupIDsOfClient { - my $self = shift; - my $clientID = shift; - my $groupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $groupIDs = _aref(shift); - my @uniqueGroupIDs = _unique(@$groupIDs); + my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); } =item C @@ -1965,14 +1965,14 @@ C<1> if the client/group references could be set, C if not. sub addGroupIDsToClient { - my $self = shift; - my $clientID = shift; - my $newGroupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $newGroupIDs = _aref(shift); - my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - push @groupIDs, @$newGroupIDs; + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + push @groupIDs, @$newGroupIDs; - return $self->setGroupIDsOfClient($clientID, \@groupIDs); + return $self->setGroupIDsOfClient($clientID, \@groupIDs); } =item C @@ -2000,17 +2000,17 @@ C<1> if the client/group references could be set, C if not. sub removeGroupIDsFromClient { - my $self = shift; - my $clientID = shift; - my $toBeRemovedGroupIDs = _aref(shift); + my $self = shift; + my $clientID = shift; + my $toBeRemovedGroupIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$toBeRemovedGroupIDs} = (); - my @groupIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); - return $self->setGroupIDsOfClient($clientID, \@groupIDs); + return $self->setGroupIDsOfClient($clientID, \@groupIDs); } =item C @@ -2033,20 +2033,20 @@ The IDs of the new group(s), C if the creation failed. sub addGroup { - my $self = shift; - my $inValRows = _aref(shift); + my $self = shift; + my $inValRows = _aref(shift); - _checkCols($inValRows, 'group', qw(name)); + _checkCols($inValRows, 'group', qw(name)); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - foreach my $valRow (@$valRows) { - if (!defined $valRow->{priority}) { - $valRow->{priority} = '50'; - } - } - my @IDs = $self->{'meta-db'}->addGroup($valRows, $attrValRows); - return wantarray() ? @IDs : $IDs[0]; + foreach my $valRow (@$valRows) { + if (!defined $valRow->{priority}) { + $valRow->{priority} = '50'; + } + } + my @IDs = $self->{'meta-db'}->addGroup($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; } =item C @@ -2069,15 +2069,15 @@ C<1> if the group(s) could be removed, C if not. sub removeGroup { - my $self = shift; - my $groupIDs = _aref(shift); + my $self = shift; + my $groupIDs = _aref(shift); - foreach my $group (@$groupIDs) { - $self->setSystemIDsOfGroup($group, []); - $self->setClientIDsOfGroup($group, []); - } + foreach my $group (@$groupIDs) { + $self->setSystemIDsOfGroup($group, []); + $self->setClientIDsOfGroup($group, []); + } - return $self->{'meta-db'}->removeGroup($groupIDs); + return $self->{'meta-db'}->removeGroup($groupIDs); } #=item C @@ -2109,12 +2109,12 @@ sub removeGroup # #sub setGroupAttr #{ -# my $self = shift; -# my $groupID = shift; -# my $attrName = shift; -# my $attrValue = shift; +# my $self = shift; +# my $groupID = shift; +# my $attrName = shift; +# my $attrValue = shift; # -# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); +# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); #} =item C @@ -2141,13 +2141,13 @@ C<1> if the group(s) could be changed, C if not. sub changeGroup { - my $self = shift; - my $groupIDs = _aref(shift); - my $inValRows = _aref(shift); + my $self = shift; + my $groupIDs = _aref(shift); + my $inValRows = _aref(shift); - my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); - return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); + return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); } =item C @@ -2174,13 +2174,13 @@ C<1> if the group/client references could be set, C if not. sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $clientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $clientIDs = _aref(shift); - my @uniqueClientIDs = _unique(@$clientIDs); + my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); + return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); } =item C @@ -2207,14 +2207,14 @@ C<1> if the group/client references could be set, C if not. sub addClientIDsToGroup { - my $self = shift; - my $groupID = shift; - my $newClientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $newClientIDs = _aref(shift); - my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - push @clientIDs, @$newClientIDs; + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + push @clientIDs, @$newClientIDs; - return $self->setClientIDsOfGroup($groupID, \@clientIDs); + return $self->setClientIDsOfGroup($groupID, \@clientIDs); } =item C @@ -2241,17 +2241,17 @@ C<1> if the group/client references could be set, C if not. sub removeClientIDsFromGroup { - my $self = shift; - my $groupID = shift; - my $removedClientIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $removedClientIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedClientIDs} = (); - my @clientIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); - return $self->setClientIDsOfGroup($groupID, \@clientIDs); + return $self->setClientIDsOfGroup($groupID, \@clientIDs); } =item C @@ -2279,14 +2279,14 @@ C<1> if the group/system references could be set, C if not. sub setSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $systemIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $systemIDs = _aref(shift); - # filter out the default system, as no group should be associated to it - my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); + # filter out the default system, as no group should be associated to it + my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); - return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); + return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); } =item C @@ -2313,14 +2313,14 @@ C<1> if the group/system references could be set, C if not. sub addSystemIDsToGroup { - my $self = shift; - my $groupID = shift; - my $newSystemIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $newSystemIDs = _aref(shift); - my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - push @systemIDs, @$newSystemIDs; + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + push @systemIDs, @$newSystemIDs; - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); } =item C @@ -2347,17 +2347,17 @@ C<1> if the group/system references could be set, C if not. sub removeSystemIDsFromGroup { - my $self = shift; - my $groupID = shift; - my $removedSystemIDs = _aref(shift); + my $self = shift; + my $groupID = shift; + my $removedSystemIDs = _aref(shift); - my %toBeRemoved; - @toBeRemoved{@$removedSystemIDs} = (); - my @systemIDs = - grep { !exists $toBeRemoved{$_} } - $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); - return $self->setSystemIDsOfGroup($groupID, \@systemIDs); + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); } =item C @@ -2375,27 +2375,27 @@ none =cut sub emptyDatabase -{ # clears all user-data from the database - my $self = shift; +{ # clears all user-data from the database + my $self = shift; - my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); - $self->removeGroup(\@groupIDs); + my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); + $self->removeGroup(\@groupIDs); - my @clientIDs = map { $_->{id} } - grep { $_->{name} ne '<<>>' } $self->fetchClientByFilter(); - $self->removeClient(\@clientIDs); + my @clientIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchClientByFilter(); + $self->removeClient(\@clientIDs); - my @sysIDs = map { $_->{id} } - grep { $_->{name} ne '<<>>' } $self->fetchSystemByFilter(); - $self->removeSystem(\@sysIDs); + my @sysIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchSystemByFilter(); + $self->removeSystem(\@sysIDs); - my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); - $self->removeExport(\@exportIDs); + my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); + $self->removeExport(\@exportIDs); - my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); - $self->removeVendorOS(\@vendorOSIDs); + my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); + $self->removeVendorOS(\@vendorOSIDs); - return 1; + return 1; } =back @@ -2425,36 +2425,36 @@ none sub mergeDefaultAttributesIntoSystem { - my $self = shift; - my $system = shift; - my $installedPlugins = shift; - my $originInfo = shift; + my $self = shift; + my $system = shift; + my $installedPlugins = shift; + my $originInfo = shift; - # first look into default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); - mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); + # first look into default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); - # push any attributes found in the plugins that are installed into - # the vendor-OS: - if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { - for my $plugin (@$installedPlugins) { - pushAttributes($system, $plugin, $originInfo, 'vendor-OS'); - } + # push any attributes found in the plugins that are installed into + # the vendor-OS: + if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { + for my $plugin (@$installedPlugins) { + pushAttributes($system, $plugin, $originInfo, 'vendor-OS'); + } - # the above will have merged stage1 attributes, too, so we remove - # these from the resulting system (as they do not apply to systems) - my @stage3AttrNames = OpenSLX::AttributeRoster->getStage3Attrs(); - for my $attr (keys %{$system->{attrs}}) { - next if grep { $attr eq $_ } @stage3AttrNames; - delete $system->{attrs}->{$attr}; - } - } + # the above will have merged stage1 attributes, too, so we remove + # these from the resulting system (as they do not apply to systems) + my @stage3AttrNames = OpenSLX::AttributeRoster->getStage3Attrs(); + for my $attr (keys %{$system->{attrs}}) { + next if grep { $attr eq $_ } @stage3AttrNames; + delete $system->{attrs}->{$attr}; + } + } - # finally push the attributes specified for the system itself - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - pushAttributes($system, $defaultClient, $originInfo, 'default-client'); + # finally push the attributes specified for the system itself + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + pushAttributes($system, $defaultClient, $originInfo, 'default-client'); - return 1; + return 1; } =item C @@ -2477,34 +2477,34 @@ none sub mergeDefaultAndGroupAttributesIntoClient { - my $self = shift; - my $client = shift; - my $originInfo = shift; - - # step over all groups this client belongs to - # (ordered by priority from highest to lowest): - my @groupIDs = _unique( - $self->fetchGroupIDsOfClient(0), - $self->fetchGroupIDsOfClient($client->{id}) - ); - my @groups - = sort { $a->{priority} <=> $b->{priority} } - $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # merge configuration from this group into the current client: - vlog( - 3, - _tr('merging from group %d:%s...', $group->{id}, $group->{name}) - ); - mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); - } - - # merge configuration from default client: - vlog(3, _tr('merging from default client...')); - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); - - return 1; + my $self = shift; + my $client = shift; + my $originInfo = shift; + + # step over all groups this client belongs to + # (ordered by priority from highest to lowest): + my @groupIDs = _unique( + $self->fetchGroupIDsOfClient(0), + $self->fetchGroupIDsOfClient($client->{id}) + ); + my @groups + = sort { $a->{priority} <=> $b->{priority} } + $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # merge configuration from this group into the current client: + vlog( + 3, + _tr('merging from group %d:%s...', $group->{id}, $group->{name}) + ); + mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); + } + + # merge configuration from default client: + vlog(3, _tr('merging from default client...')); + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); + + return 1; } =item C @@ -2528,25 +2528,25 @@ A list of unqiue system-IDs. sub aggregatedSystemIDsOfClient { - my $self = shift; - my $client = shift; + my $self = shift; + my $client = shift; - # add all systems directly linked to client: - my @systemIDs = $self->fetchSystemIDsOfClient($client->{id}); + # add all systems directly linked to client: + my @systemIDs = $self->fetchSystemIDsOfClient($client->{id}); - # step over all groups this client belongs to: - my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); - my @groups = $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # add all systems that the client inherits from the current group: - push @systemIDs, $self->fetchSystemIDsOfGroup($group->{id}); - } + # step over all groups this client belongs to: + my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all systems that the client inherits from the current group: + push @systemIDs, $self->fetchSystemIDsOfGroup($group->{id}); + } - # add all systems inherited from default client - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); + # add all systems inherited from default client + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); - return _unique(@systemIDs); + return _unique(@systemIDs); } =item C @@ -2570,36 +2570,36 @@ A list of unqiue client-IDs. sub aggregatedClientIDsOfSystem { - my $self = shift; - my $system = shift; + my $self = shift; + my $system = shift; - # add all clients directly linked to system: - my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); - my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); + # add all clients directly linked to system: + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); - if (grep { $_ == $defaultClient->{id}; } @clientIDs) { - # add *all* client-IDs if the system is being referenced by - # the default client, as that means that all clients should offer - # this system for booting: - push( - @clientIDs, - map { $_->{id} } $self->fetchClientByFilter(undef, 'id') - ); - } + if (grep { $_ == $defaultClient->{id}; } @clientIDs) { + # add *all* client-IDs if the system is being referenced by + # the default client, as that means that all clients should offer + # this system for booting: + push( + @clientIDs, + map { $_->{id} } $self->fetchClientByFilter(undef, 'id') + ); + } - # step over all groups this system belongs to: - my @groupIDs = $self->fetchGroupIDsOfSystem($system->{id}); - my @groups = $self->fetchGroupByID(\@groupIDs); - foreach my $group (@groups) { - # add all clients that the system inherits from the current group: - push @clientIDs, $self->fetchClientIDsOfGroup($group->{id}); - } + # step over all groups this system belongs to: + my @groupIDs = $self->fetchGroupIDsOfSystem($system->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all clients that the system inherits from the current group: + push @clientIDs, $self->fetchClientIDsOfGroup($group->{id}); + } - # add all clients inherited from default system - my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); - push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); + # add all clients inherited from default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); - return _unique(@clientIDs); + return _unique(@clientIDs); } =item C @@ -2624,65 +2624,65 @@ this system, as well as the specific kernel-file and export-URI being used. sub aggregatedSystemFileInfoFor { - my $self = shift; - my $system = shift; - - my $info = dclone($system); - - my $export = $self->fetchExportByID($system->{export_id}); - if (!defined $export) { - die _tr( - "DB-problem: system '%s' references export with id=%s, but that doesn't exist!", - $system->{name}, $system->{export_id} || '' - ); - } - $info->{'export'} = $export; - - my $vendorOS = $self->fetchVendorOSByID($export->{vendor_os_id}); - if (!defined $vendorOS) { - die _tr( - "DB-problem: export '%s' references vendor-OS with id=%s, but that doesn't exist!", - $export->{name}, $export->{vendor_os_id} || '' - ); - } - $info->{'vendor-os'} = $vendorOS; - - my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); - $info->{'installed-plugins'} = \@installedPlugins; - - # check if the specified kernel file really exists (follow links while - # checking) and if not, find the newest kernel file that is available. - my $kernelPath - = "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; - my $kernelFile = "$kernelPath/$system->{kernel}"; - while (-l $kernelFile) { - $kernelFile = followLink($kernelFile); - } - if (!-e $kernelFile) { - # pick best kernel file available - my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); - $osSetupEngine->initialize($vendorOS->{name}, 'none'); - $kernelFile = $osSetupEngine->pickKernelFile($kernelPath); - warn( - _tr( - "setting kernel of system '%s' to '%s'!", - $info->{name}, $kernelFile - ) - ); - } - $info->{'kernel-file'} = $kernelFile; - - # auto-generate export_uri if none has been given - my $exportURI = $export->{'uri'} || ''; - if ($exportURI !~ m[\w]) { - # instantiate OSExport engine and ask it for exportURI - my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); - $osExportEngine->initializeFromExisting($export->{name}); - $exportURI = $osExportEngine->generateExportURI($export, $vendorOS); - } - $info->{'export-uri'} = $exportURI; - - return $info; + my $self = shift; + my $system = shift; + + my $info = dclone($system); + + my $export = $self->fetchExportByID($system->{export_id}); + if (!defined $export) { + die _tr( + "DB-problem: system '%s' references export with id=%s, but that doesn't exist!", + $system->{name}, $system->{export_id} || '' + ); + } + $info->{'export'} = $export; + + my $vendorOS = $self->fetchVendorOSByID($export->{vendor_os_id}); + if (!defined $vendorOS) { + die _tr( + "DB-problem: export '%s' references vendor-OS with id=%s, but that doesn't exist!", + $export->{name}, $export->{vendor_os_id} || '' + ); + } + $info->{'vendor-os'} = $vendorOS; + + my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); + $info->{'installed-plugins'} = \@installedPlugins; + + # check if the specified kernel file really exists (follow links while + # checking) and if not, find the newest kernel file that is available. + my $kernelPath + = "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; + my $kernelFile = "$kernelPath/$system->{kernel}"; + while (-l $kernelFile) { + $kernelFile = followLink($kernelFile); + } + if (!-e $kernelFile) { + # pick best kernel file available + my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); + $osSetupEngine->initialize($vendorOS->{name}, 'none'); + $kernelFile = $osSetupEngine->pickKernelFile($kernelPath); + warn( + _tr( + "setting kernel of system '%s' to '%s'!", + $info->{name}, $kernelFile + ) + ); + } + $info->{'kernel-file'} = $kernelFile; + + # auto-generate export_uri if none has been given + my $exportURI = $export->{'uri'} || ''; + if ($exportURI !~ m[\w]) { + # instantiate OSExport engine and ask it for exportURI + my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); + $osExportEngine->initializeFromExisting($export->{name}); + $exportURI = $osExportEngine->generateExportURI($export, $vendorOS); + } + $info->{'export-uri'} = $exportURI; + + return $info; } =back @@ -2715,32 +2715,32 @@ none sub mergeAttributes { - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; - foreach my $key (keys %$sourceAttrs) { - my $sourceVal = $sourceAttrs->{$key}; - my $targetVal = $targetAttrs->{$key}; - if (!defined $targetVal) { - vlog(3, _tr( - "merging %s (val=%s)", $key, - defined $sourceVal ? $sourceVal : '' - )); - $targetAttrs->{$key} = $sourceVal; - if (defined $originInfo) { - $originInfo->{$key} = $origin; - } - } - } + foreach my $key (keys %$sourceAttrs) { + my $sourceVal = $sourceAttrs->{$key}; + my $targetVal = $targetAttrs->{$key}; + if (!defined $targetVal) { + vlog(3, _tr( + "merging %s (val=%s)", $key, + defined $sourceVal ? $sourceVal : '' + )); + $targetAttrs->{$key} = $sourceVal; + if (defined $originInfo) { + $originInfo->{$key} = $origin; + } + } + } - return 1; + return 1; } =item C @@ -2767,28 +2767,28 @@ none sub pushAttributes { - my $target = shift; - my $source = shift; - my $originInfo = shift; - my $origin = shift; + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; - foreach my $key (keys %$sourceAttrs) { - my $sourceVal = $sourceAttrs->{$key}; - if (defined $sourceVal) { - vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal)); - $targetAttrs->{$key} = $sourceVal; - if (defined $originInfo) { - $originInfo->{$key} = $origin; - } - } - } + foreach my $key (keys %$sourceAttrs) { + my $sourceVal = $sourceAttrs->{$key}; + if (defined $sourceVal) { + vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal)); + $targetAttrs->{$key} = $sourceVal; + if (defined $originInfo) { + $originInfo->{$key} = $origin; + } + } + } - return 1; + return 1; } =item C @@ -2812,14 +2812,14 @@ The external ID (name) of the given system. sub externalIDForSystem { - my $system = shift; + my $system = shift; - return "default" if $system->{name} eq '<<>>'; + return "default" if $system->{name} eq '<<>>'; - my $name = $system->{name}; - $name =~ tr[/][_]; + my $name = $system->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C @@ -2843,15 +2843,15 @@ The external ID (MAC) of the given client. sub externalIDForClient { - my $client = shift; + my $client = shift; - return "default" if $client->{name} eq '<<>>'; + return "default" if $client->{name} eq '<<>>'; - my $mac = lc($client->{mac}); - # PXE seems to expect MACs being all lowercase - $mac =~ tr[:][-]; + my $mac = lc($client->{mac}); + # PXE seems to expect MACs being all lowercase + $mac =~ tr[:][-]; - return "01-$mac"; + return "01-$mac"; } =item C @@ -2875,14 +2875,14 @@ The external name of the given client. sub externalConfigNameForClient { - my $client = shift; + my $client = shift; - return "default" if $client->{name} eq '<<>>'; + return "default" if $client->{name} eq '<<>>'; - my $name = $client->{name}; - $name =~ tr[/][_]; + my $name = $client->{name}; + $name =~ tr[/][_]; - return $name; + return $name; } =item C @@ -2905,59 +2905,59 @@ The given variable as a placeholder string. sub generatePlaceholderFor { - my $varName = shift; + my $varName = shift; - return '@@@' . $varName . '@@@'; + return '@@@' . $varName . '@@@'; } ################################################################################ ### private stuff ################################################################################ sub _aref -{ # transparently converts the given reference to an array-ref - my $ref = shift; +{ # transparently converts the given reference to an array-ref + my $ref = shift; - return [] unless defined $ref; - $ref = [$ref] unless ref($ref) eq 'ARRAY'; + return [] unless defined $ref; + $ref = [$ref] unless ref($ref) eq 'ARRAY'; - return $ref; + return $ref; } sub _unique -{ # return given array filtered to unique elements - my %seenIDs; - return grep { !$seenIDs{$_}++; } @_; +{ # return given array filtered to unique elements + my %seenIDs; + return grep { !$seenIDs{$_}++; } @_; } sub _checkCols { - my $valRows = shift; - my $table = shift; - my @colNames = @_; + my $valRows = shift; + my $table = shift; + my @colNames = @_; - foreach my $valRow (@$valRows) { - foreach my $col (@colNames) { - die "need to set '$col' for $table!" if !$valRow->{$col}; - } - } + foreach my $valRow (@$valRows) { + foreach my $col (@colNames) { + die "need to set '$col' for $table!" if !$valRow->{$col}; + } + } - return 1; + return 1; } sub _cloneAndUnhingeAttrs { - my $inValRows = shift; + my $inValRows = shift; - # clone data and unhinge attrs - my (@valRows, @attrValRows); - foreach my $inValRow (@$inValRows) { - push @attrValRows, $inValRow->{attrs}; - my $valRow = dclone($inValRow); - delete $valRow->{attrs}; - push @valRows, $valRow; - } + # clone data and unhinge attrs + my (@valRows, @attrValRows); + foreach my $inValRow (@$inValRows) { + push @attrValRows, $inValRow->{attrs}; + my $valRow = dclone($inValRow); + delete $valRow->{attrs}; + push @valRows, $valRow; + } - return (\@valRows, \@attrValRows); + return (\@valRows, \@attrValRows); } 1; diff --git a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm b/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm index e3dd0738..14b427c8 100644 --- a/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm +++ b/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # ISC.pm -# - provides ISC-specific implementation of DHCP export. +# - provides ISC-specific implementation of DHCP export. # ----------------------------------------------------------------------------- package OpenSLX::ConfigExport::DHCP::ISC; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version ################################################################################ ### This class provides an ISC specific implementation for DHCP export. @@ -28,18 +28,18 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub execute { - my $self = shift; - my $clients = shift; + my $self = shift; + my $clients = shift; - vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); - foreach my $client (@$clients) { + vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); + foreach my $client (@$clients) { print "ISC-DHCP: $client->{name}\n"; - } + } } \ No newline at end of file diff --git a/config-db/OpenSLX/DBSchema.pm b/config-db/OpenSLX/DBSchema.pm index 2be6dc7c..1195ddc1 100644 --- a/config-db/OpenSLX/DBSchema.pm +++ b/config-db/OpenSLX/DBSchema.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # DBSchema.pm -# - provides database schema of the OpenSLX config-db. +# - provides database schema of the OpenSLX config-db. # ----------------------------------------------------------------------------- package OpenSLX::DBSchema; @@ -21,220 +21,220 @@ use OpenSLX::Basics; ################################################################################ ### DB-schema definition -### This hash-ref describes the current OpenSLX configuration database -### schema. -### Each table is defined by a list of column descriptions (and optionally -### a list of default values). -### A column description is simply the name of the column followed by ':' -### followed by the data type description. The following data types are -### currently supported: -### b => boolean (providing the values 1 and 0 only) -### i => integer (32-bit, signed) -### s.20 => string, followed by length argument (in this case: 20) -### pk => primary key (integer) -### fk => foreign key (integer) +### This hash-ref describes the current OpenSLX configuration database +### schema. +### Each table is defined by a list of column descriptions (and optionally +### a list of default values). +### A column description is simply the name of the column followed by ':' +### followed by the data type description. The following data types are +### currently supported: +### b => boolean (providing the values 1 and 0 only) +### i => integer (32-bit, signed) +### s.20 => string, followed by length argument (in this case: 20) +### pk => primary key (integer) +### fk => foreign key (integer) ################################################################################ my $VERSION = 0.29; my $DbSchema = { - 'version' => $VERSION, - 'tables' => { - 'client' => { - # a client is a PC booting via network - 'cols' => [ - 'id:pk', # primary key - 'name:s.128', # official name of PC (e.g. as given by sticker - # on case) - 'mac:s.20', # MAC of NIC used for booting - 'boot_type:s.20', # type of remote boot procedure (PXE, ...) - 'unbootable:b', # unbootable clients simply won't boot - 'kernel_params:s.128', # client-specific kernel-args (e.g. console) - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default client - 'id' => 0, - 'name' => '<<>>', - 'comment' => 'internal client that holds default values', - 'unbootable' => 0, - }, - ], - }, - 'client_attr' => { - # attributes of clients - 'cols' => [ - 'id:pk', # primary key - 'client_id:fk', # foreign key to client - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'client_system_ref' => { - # clients referring to the systems they should offer for booting - 'cols' => [ - 'client_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, - 'export' => { - # an export describes a vendor-OS "wrapped" in some kind of exporting - # format (NFS or NBD-squash). This represents the rootfs that the - # clients will see. - 'cols' => [ - 'id:pk', # primary key - 'name:s.64', # unique name of export, is automatically - # constructed like this: - # - - 'vendor_os_id:fk', # foreign key - 'comment:s.1024', # internal comment (optional, for admins) - 'type:s.10', # 'nbd', 'nfs', ... - 'server_ip:s.16', # IP of exporting server, if empty the - # boot server will be used - 'port:i', # some export types need to use a specific - # port for each incarnation, if that's the - # case you can specify it here - 'uri:s.255', # path to export (squashfs or NFS-path), if - # empty it will be auto-generated by - # config-demuxer - ], - }, - 'global_info' => { - # a home for global counters and other info - 'cols' => [ - 'id:s.32', # key - 'value:s.128', # value - ], - 'vals' => [ - { # add nbd-server-port - 'id' => 'next-nbd-server-port', - 'value' => '5000', - }, - ], - }, - 'groups' => { - # a group encapsulates a set of clients as one entity, managing - # a group-specific attribute set. All the different attribute - # sets a client inherits via group membership are folded into - # one resulting attribute set with respect to each group's priority. - 'cols' => [ - 'id:pk', # primary key - 'name:s.128', # name of group - 'priority:i', # priority, used for order in group-list - # (from 0-highest to 99-lowest) - 'comment:s.1024', # internal comment (optional, for admins) - ], - }, - 'group_attr' => { - # attributes of groups - 'cols' => [ - 'id:pk', # primary key - 'group_id:fk', # foreign key to group - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'group_client_ref' => { - # groups referring to their clients - 'cols' => [ - 'group_id:fk', # foreign key - 'client_id:fk', # foreign key - ], - }, - 'group_system_ref' => { - # groups referring to the systems each of their clients should - # offer for booting - 'cols' => [ - 'group_id:fk', # foreign key - 'system_id:fk', # foreign key - ], - }, - 'installed_plugin' => { - # holds the plugins that have been installed into a specific - # vendor-OS - 'cols' => [ - 'id:pk', # primary key - 'vendor_os_id:fk', # foreign key - 'plugin_name:s.64', # name of installed plugin - # (e.g. suse-9.3-kde, debian-3.1-ppc, - # suse-10.2-cloned-from-kiwi). - # This is used as the folder name for the - # corresponding stage1, too. - ], - }, - 'installed_plugin_attr' => { - # (stage1-)attributes of installed plugins - 'cols' => [ - 'id:pk', # primary key - 'installed_plugin_id:fk', # foreign key to installed plugin - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'meta' => { - # information about the database as such - 'cols' => [ - 'schema_version:s.5', # schema-version currently implemented by DB - ], - 'vals' => [ - { - 'schema_version' => $VERSION, - }, - ], - }, - 'system' => { - # a system describes one bootable instance of an export, it - # represents a selectable line in the PXE boot menu of all the - # clients associated with this system - 'cols' => [ - 'id:pk', # primary key - 'export_id:fk', # foreign key - 'name:s.64', # unique name of system, is automatically - # constructed like this: - # -- - 'label:s.64', # name visible to user (pxe-label) - # if empty, this will be autocreated from - # the name - 'kernel:s.128', # path to kernel file, relative to /boot - 'kernel_params:s.512', # kernel-param string for pxe - 'hidden:b', # hidden systems won't be offered for booting - 'description:s.512',# visible description (for PXE TEXT) - 'comment:s.1024', # internal comment (optional, for admins) - ], - 'vals' => [ - { # add default system - 'id' => 0, - 'name' => '<<>>', - 'hidden' => 1, - 'comment' => 'internal system that holds default values', - }, - ], - }, - 'system_attr' => { - # attributes of systems - 'cols' => [ - 'id:pk', # primary key - 'system_id:fk', # foreign key to system - 'name:s.128', # attribute name - 'value:s.255', # attribute value - ], - }, - 'vendor_os' => { - # a vendor-OS describes a folder containing an operating system as - # provided by the vendor (a.k.a. unchanged and thus updatable) - 'cols' => [ - 'id:pk', # primary key - 'name:s.48', # structured name of OS installation - # (e.g. suse-9.3-kde, debian-3.1-ppc, - # suse-10.2-cloned-from-kiwi). - # This is used as the folder name for the - # corresponding stage1, too. - 'comment:s.1024', # internal comment (optional, for admins) - 'clone_source:s.255', # if vendor-OS was cloned, this contains - # the rsync-URI pointing to the original - ], - }, - }, + 'version' => $VERSION, + 'tables' => { + 'client' => { + # a client is a PC booting via network + 'cols' => [ + 'id:pk', # primary key + 'name:s.128', # official name of PC (e.g. as given by sticker + # on case) + 'mac:s.20', # MAC of NIC used for booting + 'boot_type:s.20', # type of remote boot procedure (PXE, ...) + 'unbootable:b', # unbootable clients simply won't boot + 'kernel_params:s.128', # client-specific kernel-args (e.g. console) + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default client + 'id' => 0, + 'name' => '<<>>', + 'comment' => 'internal client that holds default values', + 'unbootable' => 0, + }, + ], + }, + 'client_attr' => { + # attributes of clients + 'cols' => [ + 'id:pk', # primary key + 'client_id:fk', # foreign key to client + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'client_system_ref' => { + # clients referring to the systems they should offer for booting + 'cols' => [ + 'client_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, + 'export' => { + # an export describes a vendor-OS "wrapped" in some kind of exporting + # format (NFS or NBD-squash). This represents the rootfs that the + # clients will see. + 'cols' => [ + 'id:pk', # primary key + 'name:s.64', # unique name of export, is automatically + # constructed like this: + # - + 'vendor_os_id:fk', # foreign key + 'comment:s.1024', # internal comment (optional, for admins) + 'type:s.10', # 'nbd', 'nfs', ... + 'server_ip:s.16', # IP of exporting server, if empty the + # boot server will be used + 'port:i', # some export types need to use a specific + # port for each incarnation, if that's the + # case you can specify it here + 'uri:s.255', # path to export (squashfs or NFS-path), if + # empty it will be auto-generated by + # config-demuxer + ], + }, + 'global_info' => { + # a home for global counters and other info + 'cols' => [ + 'id:s.32', # key + 'value:s.128', # value + ], + 'vals' => [ + { # add nbd-server-port + 'id' => 'next-nbd-server-port', + 'value' => '5000', + }, + ], + }, + 'groups' => { + # a group encapsulates a set of clients as one entity, managing + # a group-specific attribute set. All the different attribute + # sets a client inherits via group membership are folded into + # one resulting attribute set with respect to each group's priority. + 'cols' => [ + 'id:pk', # primary key + 'name:s.128', # name of group + 'priority:i', # priority, used for order in group-list + # (from 0-highest to 99-lowest) + 'comment:s.1024', # internal comment (optional, for admins) + ], + }, + 'group_attr' => { + # attributes of groups + 'cols' => [ + 'id:pk', # primary key + 'group_id:fk', # foreign key to group + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'group_client_ref' => { + # groups referring to their clients + 'cols' => [ + 'group_id:fk', # foreign key + 'client_id:fk', # foreign key + ], + }, + 'group_system_ref' => { + # groups referring to the systems each of their clients should + # offer for booting + 'cols' => [ + 'group_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, + 'installed_plugin' => { + # holds the plugins that have been installed into a specific + # vendor-OS + 'cols' => [ + 'id:pk', # primary key + 'vendor_os_id:fk', # foreign key + 'plugin_name:s.64', # name of installed plugin + # (e.g. suse-9.3-kde, debian-3.1-ppc, + # suse-10.2-cloned-from-kiwi). + # This is used as the folder name for the + # corresponding stage1, too. + ], + }, + 'installed_plugin_attr' => { + # (stage1-)attributes of installed plugins + 'cols' => [ + 'id:pk', # primary key + 'installed_plugin_id:fk', # foreign key to installed plugin + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'meta' => { + # information about the database as such + 'cols' => [ + 'schema_version:s.5', # schema-version currently implemented by DB + ], + 'vals' => [ + { + 'schema_version' => $VERSION, + }, + ], + }, + 'system' => { + # a system describes one bootable instance of an export, it + # represents a selectable line in the PXE boot menu of all the + # clients associated with this system + 'cols' => [ + 'id:pk', # primary key + 'export_id:fk', # foreign key + 'name:s.64', # unique name of system, is automatically + # constructed like this: + # -- + 'label:s.64', # name visible to user (pxe-label) + # if empty, this will be autocreated from + # the name + 'kernel:s.128', # path to kernel file, relative to /boot + 'kernel_params:s.512', # kernel-param string for pxe + 'hidden:b', # hidden systems won't be offered for booting + 'description:s.512',# visible description (for PXE TEXT) + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default system + 'id' => 0, + 'name' => '<<>>', + 'hidden' => 1, + 'comment' => 'internal system that holds default values', + }, + ], + }, + 'system_attr' => { + # attributes of systems + 'cols' => [ + 'id:pk', # primary key + 'system_id:fk', # foreign key to system + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'vendor_os' => { + # a vendor-OS describes a folder containing an operating system as + # provided by the vendor (a.k.a. unchanged and thus updatable) + 'cols' => [ + 'id:pk', # primary key + 'name:s.48', # structured name of OS installation + # (e.g. suse-9.3-kde, debian-3.1-ppc, + # suse-10.2-cloned-from-kiwi). + # This is used as the folder name for the + # corresponding stage1, too. + 'comment:s.1024', # internal comment (optional, for admins) + 'clone_source:s.255', # if vendor-OS was cloned, this contains + # the rsync-URI pointing to the original + ], + }, + }, }; ################################################################################ @@ -244,97 +244,97 @@ my $DbSchema = { ################################################################################ sub new { - my $class = shift; + my $class = shift; - my $self = { - }; + my $self = { + }; - return bless $self, $class; + return bless $self, $class; } sub checkAndUpgradeDBSchemaIfNecessary { - my $self = shift; - my $configDB = shift; + my $self = shift; + my $configDB = shift; - my $metaDB = $configDB->{'meta-db'}; + my $metaDB = $configDB->{'meta-db'}; - vlog(2, "trying to determine schema version..."); - my $currVersion = $metaDB->schemaFetchDBVersion(); - if (!defined $currVersion) { - # that's bad, someone has messed with our DB: there is a - # database, but the 'meta'-table is empty. - # There might still be data in the other tables, but we have no way to - # find out which schema version they're in. So it's safer to give up. - croak _tr('Could not determine schema version of database'); - } + vlog(2, "trying to determine schema version..."); + my $currVersion = $metaDB->schemaFetchDBVersion(); + if (!defined $currVersion) { + # that's bad, someone has messed with our DB: there is a + # database, but the 'meta'-table is empty. + # There might still be data in the other tables, but we have no way to + # find out which schema version they're in. So it's safer to give up. + croak _tr('Could not determine schema version of database'); + } - if ($currVersion == 0) { - vlog(1, _tr('Creating DB (schema version: %s)', $DbSchema->{version})); - foreach my $tableName (keys %{$DbSchema->{tables}}) { - # create table (optionally inserting default values, too) - $metaDB->schemaAddTable( - $tableName, - $DbSchema->{tables}->{$tableName}->{cols}, - $DbSchema->{tables}->{$tableName}->{vals} - ); - } - $metaDB->schemaSetDBVersion($DbSchema->{version}); - $self->synchronizeAttributesWithDefaultSystem($configDB); - vlog(1, _tr('DB has been created successfully')); - } elsif ($currVersion < $DbSchema->{version}) { - vlog( - 1, - _tr( - 'Our schema-version is %s, DB is %s, upgrading DB...', - $DbSchema->{version}, $currVersion - ) - ); - $self->_schemaUpgradeDBFrom($metaDB, $currVersion); - $self->synchronizeAttributesWithDefaultSystem($configDB); - vlog(1, _tr('upgrade done')); - } else { - vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); - } + if ($currVersion == 0) { + vlog(1, _tr('Creating DB (schema version: %s)', $DbSchema->{version})); + foreach my $tableName (keys %{$DbSchema->{tables}}) { + # create table (optionally inserting default values, too) + $metaDB->schemaAddTable( + $tableName, + $DbSchema->{tables}->{$tableName}->{cols}, + $DbSchema->{tables}->{$tableName}->{vals} + ); + } + $metaDB->schemaSetDBVersion($DbSchema->{version}); + $self->synchronizeAttributesWithDefaultSystem($configDB); + vlog(1, _tr('DB has been created successfully')); + } elsif ($currVersion < $DbSchema->{version}) { + vlog( + 1, + _tr( + 'Our schema-version is %s, DB is %s, upgrading DB...', + $DbSchema->{version}, $currVersion + ) + ); + $self->_schemaUpgradeDBFrom($metaDB, $currVersion); + $self->synchronizeAttributesWithDefaultSystem($configDB); + vlog(1, _tr('upgrade done')); + } else { + vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); + } - return 1; + return 1; } sub getColumnsOfTable { - my $self = shift; - my $tableName = shift; + my $self = shift; + my $tableName = shift; - return - map { (/^(\w+)\W/) ? $1 : $_; } - @{$DbSchema->{tables}->{$tableName}->{cols}}; + return + map { (/^(\w+)\W/) ? $1 : $_; } + @{$DbSchema->{tables}->{$tableName}->{cols}}; } sub synchronizeAttributesWithDefaultSystem { - my $self = shift; - my $configDB = shift; + my $self = shift; + my $configDB = shift; - my $defaultSystem = $configDB->fetchSystemByID(0); - return if !$defaultSystem; + my $defaultSystem = $configDB->fetchSystemByID(0); + return if !$defaultSystem; - # fetch all known attributes from attribute roster and merge these - # into the existing attributes of the default system - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); - foreach my $attr (keys %$attrInfo) { - next if exists $defaultSystem->{attrs}->{$attr}; - $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; - } - - # remove unknown attributes from default system - my @unknownAttrs - = grep { !exists $attrInfo->{$_} } keys %{$defaultSystem->{attrs}}; - foreach my $unknownAttr (@unknownAttrs) { - delete $defaultSystem->{attrs}->{$unknownAttr}; - } - - # now write back the updated default system - return $configDB->changeSystem(0, $defaultSystem); + # fetch all known attributes from attribute roster and merge these + # into the existing attributes of the default system + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + foreach my $attr (keys %$attrInfo) { + next if exists $defaultSystem->{attrs}->{$attr}; + $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; + } + + # remove unknown attributes from default system + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$defaultSystem->{attrs}}; + foreach my $unknownAttr (@unknownAttrs) { + delete $defaultSystem->{attrs}->{$unknownAttr}; + } + + # now write back the updated default system + return $configDB->changeSystem(0, $defaultSystem); } ################################################################################ @@ -346,380 +346,380 @@ my %DbSchemaHistory; sub _schemaUpgradeDBFrom { - my $self = shift; - my $metaDB = shift; - my $currVersion = shift; + my $self = shift; + my $metaDB = shift; + my $currVersion = shift; - foreach my $version (sort { $a <=> $b } keys %DbSchemaHistory) { - next if $currVersion >= $version; + foreach my $version (sort { $a <=> $b } keys %DbSchemaHistory) { + next if $currVersion >= $version; - vlog(0, "upgrading schema version to $version"); - if ($DbSchemaHistory{$version}->($metaDB)) { - $metaDB->schemaSetDBVersion($version); - } - } + vlog(0, "upgrading schema version to $version"); + if ($DbSchemaHistory{$version}->($metaDB)) { + $metaDB->schemaSetDBVersion($version); + } + } - return 1; + return 1; } %DbSchemaHistory = ( - 0.2 => sub { - my $metaDB = shift; - - # move attributes into separate tables ... - # - # ... system attributes ... - $metaDB->schemaAddTable( - 'system_attr', - [ - 'id:pk', - 'system_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $system ($metaDB->fetchSystemByFilter()) { - my %attrs; - foreach my $key (keys %$system) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $system->{$key} || ''; - next if $system->{id} > 0 && !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setSystemAttrs($system->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'system', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_ramfs_fsmods', - 'attr_ramfs_miscmods', - 'attr_ramfs_nicmods', - 'attr_ramfs_screen', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'export_id:fk', - 'name:s.64', - 'label:s.64', - 'kernel:s.128', - 'kernel_params:s.512', - 'hidden:b', - 'comment:s.1024', - ] - ); - # - # ... client attributes ... - $metaDB->schemaAddTable( - 'client_attr', - [ - 'id:pk', - 'client_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $client ($metaDB->fetchClientByFilter()) { - my %attrs; - foreach my $key (keys %$client) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $client->{$key} || ''; - next if !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setClientAttrs($client->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'client', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'name:s.128', - 'mac:s.20', - 'boot_type:s.20', - 'unbootable:b', - 'kernel_params:s.128', - 'comment:s.1024', - ] - ); - # - # ... group attributes ... - $metaDB->schemaAddTable( - 'group_attr', - [ - 'id:pk', - 'group_id:fk', - 'name:s.128', - 'value:s.255', - ] - ); - foreach my $group ($metaDB->fetchGroupByFilter()) { - my %attrs; - foreach my $key (keys %$group) { - next if substr($key, 0, 5) ne 'attr_'; - my $attrValue = $group->{$key} || ''; - next if !length($attrValue); - my $newAttrName = substr($key, 5); - $attrs{$newAttrName} = $attrValue; - } - $metaDB->setGroupAttrs($group->{id}, \%attrs); - } - $metaDB->schemaDropColumns( - 'groups', - [ - 'attr_automnt_dir', - 'attr_automnt_src', - 'attr_country', - 'attr_dm_allow_shutdown', - 'attr_hw_graphic', - 'attr_hw_monitor', - 'attr_hw_mouse', - 'attr_late_dm', - 'attr_netbios_workgroup', - 'attr_nis_domain', - 'attr_nis_servers', - 'attr_sane_scanner', - 'attr_scratch', - 'attr_slxgrp', - 'attr_start_alsasound', - 'attr_start_atd', - 'attr_start_cron', - 'attr_start_dreshal', - 'attr_start_ntp', - 'attr_start_nfsv4', - 'attr_start_printer', - 'attr_start_samba', - 'attr_start_snmp', - 'attr_start_sshd', - 'attr_start_syslog', - 'attr_start_x', - 'attr_start_xdmcp', - 'attr_tex_enable', - 'attr_timezone', - 'attr_tvout', - 'attr_vmware', - ], - [ - 'id:pk', - 'name:s.128', - 'priority:i', - 'comment:s.1024', - ] - ); - - return 1; - }, - 0.21 => sub { - my $metaDB = shift; - - # add new table installed_plugin - $metaDB->schemaAddTable( - 'installed_plugin', - [ - 'id:pk', - 'vendor_os_id:fk', - 'plugin_name:s.64', - ] - ); - - return 1; - }, - 0.22 => sub { - my $metaDB = shift; - - # dummy schema change, just to trigger the attribute synchronization - # into the default system - - return 1; - }, - 0.23 => sub { - my $metaDB = shift; + 0.2 => sub { + my $metaDB = shift; + + # move attributes into separate tables ... + # + # ... system attributes ... + $metaDB->schemaAddTable( + 'system_attr', + [ + 'id:pk', + 'system_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $system ($metaDB->fetchSystemByFilter()) { + my %attrs; + foreach my $key (keys %$system) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $system->{$key} || ''; + next if $system->{id} > 0 && !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setSystemAttrs($system->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'system', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_ramfs_fsmods', + 'attr_ramfs_miscmods', + 'attr_ramfs_nicmods', + 'attr_ramfs_screen', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'export_id:fk', + 'name:s.64', + 'label:s.64', + 'kernel:s.128', + 'kernel_params:s.512', + 'hidden:b', + 'comment:s.1024', + ] + ); + # + # ... client attributes ... + $metaDB->schemaAddTable( + 'client_attr', + [ + 'id:pk', + 'client_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $client ($metaDB->fetchClientByFilter()) { + my %attrs; + foreach my $key (keys %$client) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $client->{$key} || ''; + next if !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setClientAttrs($client->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'client', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'name:s.128', + 'mac:s.20', + 'boot_type:s.20', + 'unbootable:b', + 'kernel_params:s.128', + 'comment:s.1024', + ] + ); + # + # ... group attributes ... + $metaDB->schemaAddTable( + 'group_attr', + [ + 'id:pk', + 'group_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $group ($metaDB->fetchGroupByFilter()) { + my %attrs; + foreach my $key (keys %$group) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $group->{$key} || ''; + next if !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setGroupAttrs($group->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'groups', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'name:s.128', + 'priority:i', + 'comment:s.1024', + ] + ); + + return 1; + }, + 0.21 => sub { + my $metaDB = shift; + + # add new table installed_plugin + $metaDB->schemaAddTable( + 'installed_plugin', + [ + 'id:pk', + 'vendor_os_id:fk', + 'plugin_name:s.64', + ] + ); + + return 1; + }, + 0.22 => sub { + my $metaDB = shift; + + # dummy schema change, just to trigger the attribute synchronization + # into the default system + + return 1; + }, + 0.23 => sub { + my $metaDB = shift; - # add new column system.description - $metaDB->schemaAddColumns( - 'system', - [ - 'description:s.512', - ], - undef, - [ - 'id:pk', - 'export_id:fk', - 'name:s.64', - 'label:s.64', - 'kernel:s.128', - 'kernel_params:s.512', - 'hidden:b', - 'description:s.512', - 'comment:s.1024', - ] - ); - - return 1; - }, - 0.24 => sub { - my $metaDB = shift; - - # split theme::name into theme::splash, theme::displaymanager and - # theme::desktop - foreach my $system ($metaDB->fetchSystemByFilter()) { - my $attrs = $system->{attrs} || {}; - next if !exists $attrs->{'theme::name'}; - $attrs->{'theme::splash'} - = $attrs->{'theme::displaymanager'} - = $attrs->{'theme::desktop'} - = $attrs->{'theme::name'}; - delete $attrs->{'theme::name'}; - $metaDB->setSystemAttrs($system->{id}, $attrs); - } - - # force all plugin names to lowercase - foreach my $vendorOS ($metaDB->fetchVendorOSByFilter()) { - my @installedPlugins - = $metaDB->fetchInstalledPlugins($vendorOS->{id}); - foreach my $plugin (@installedPlugins) { - my $pluginName = $plugin->{plugin_name}; - $metaDB->removeInstalledPlugin($vendorOS->{id}, $pluginName); - $metaDB->addInstalledPlugin($vendorOS->{id}, lc($pluginName)); - } - } + # add new column system.description + $metaDB->schemaAddColumns( + 'system', + [ + 'description:s.512', + ], + undef, + [ + 'id:pk', + 'export_id:fk', + 'name:s.64', + 'label:s.64', + 'kernel:s.128', + 'kernel_params:s.512', + 'hidden:b', + 'description:s.512', + 'comment:s.1024', + ] + ); + + return 1; + }, + 0.24 => sub { + my $metaDB = shift; + + # split theme::name into theme::splash, theme::displaymanager and + # theme::desktop + foreach my $system ($metaDB->fetchSystemByFilter()) { + my $attrs = $system->{attrs} || {}; + next if !exists $attrs->{'theme::name'}; + $attrs->{'theme::splash'} + = $attrs->{'theme::displaymanager'} + = $attrs->{'theme::desktop'} + = $attrs->{'theme::name'}; + delete $attrs->{'theme::name'}; + $metaDB->setSystemAttrs($system->{id}, $attrs); + } + + # force all plugin names to lowercase + foreach my $vendorOS ($metaDB->fetchVendorOSByFilter()) { + my @installedPlugins + = $metaDB->fetchInstalledPlugins($vendorOS->{id}); + foreach my $plugin (@installedPlugins) { + my $pluginName = $plugin->{plugin_name}; + $metaDB->removeInstalledPlugin($vendorOS->{id}, $pluginName); + $metaDB->addInstalledPlugin($vendorOS->{id}, lc($pluginName)); + } + } - return 1; - }, - 0.25 => sub { - my $metaDB = shift; - - # drop attribute ramfs_screen - $metaDB->removeAttributeByName('ramfs_screen'); - - return 1; - }, - 0.26 => sub { - my $metaDB = shift; - - # rename all exports and systems that contain a single colon to - # the current naming scheme with a double colon - foreach my $system ($metaDB->fetchSystemByFilter()) { - if ($system->{name} =~ m{^([^:]+):([^:]+)$}) { - if ($system->{label} eq $system->{name}) { - $system->{label} = "${1}::${2}"; - } - $system->{name} = "${1}::${2}"; - $metaDB->changeSystem([ $system->{id} ], [ $system ]); - } - } - foreach my $export ($metaDB->fetchExportByFilter()) { - if ($export->{name} =~ m{^([^:]+):([^:]+)$}) { - $export->{name} = "${1}::${2}"; - $metaDB->changeExport([ $export->{id} ], [ $export ]); - } - } - - return 1; - }, - 0.27 => sub { - my $metaDB = shift; - - # add default vendor-OS, which holds info about the plugins that shall - # be automatically installed into all vendor-OS that are being created. - $metaDB->addVendorOS([{ - id => '0', - name => '<<>>', - comment => 'holds default plugins for all vendor-OS', - }]); - - return 1; - }, - 0.28 => sub { - my $metaDB = shift; - - # correct effects of implementation error last time around that caused - # the default vendor-OS to not have any plugins at all - so we add - # the default plugins here: - $metaDB->addInstalledPlugin(0, 'theme'); - - return 1; - }, - 0.29 => sub { - my $metaDB = shift; - - # add new table installed_plugin_attrs - $metaDB->schemaAddTable( - 'installed_plugin_attr', - [ - 'id:pk', - 'installed_plugin_id:fk', - 'name:s.128', - 'value:s.255', - ], - ); - - return 1; - }, + return 1; + }, + 0.25 => sub { + my $metaDB = shift; + + # drop attribute ramfs_screen + $metaDB->removeAttributeByName('ramfs_screen'); + + return 1; + }, + 0.26 => sub { + my $metaDB = shift; + + # rename all exports and systems that contain a single colon to + # the current naming scheme with a double colon + foreach my $system ($metaDB->fetchSystemByFilter()) { + if ($system->{name} =~ m{^([^:]+):([^:]+)$}) { + if ($system->{label} eq $system->{name}) { + $system->{label} = "${1}::${2}"; + } + $system->{name} = "${1}::${2}"; + $metaDB->changeSystem([ $system->{id} ], [ $system ]); + } + } + foreach my $export ($metaDB->fetchExportByFilter()) { + if ($export->{name} =~ m{^([^:]+):([^:]+)$}) { + $export->{name} = "${1}::${2}"; + $metaDB->changeExport([ $export->{id} ], [ $export ]); + } + } + + return 1; + }, + 0.27 => sub { + my $metaDB = shift; + + # add default vendor-OS, which holds info about the plugins that shall + # be automatically installed into all vendor-OS that are being created. + $metaDB->addVendorOS([{ + id => '0', + name => '<<>>', + comment => 'holds default plugins for all vendor-OS', + }]); + + return 1; + }, + 0.28 => sub { + my $metaDB = shift; + + # correct effects of implementation error last time around that caused + # the default vendor-OS to not have any plugins at all - so we add + # the default plugins here: + $metaDB->addInstalledPlugin(0, 'theme'); + + return 1; + }, + 0.29 => sub { + my $metaDB = shift; + + # add new table installed_plugin_attrs + $metaDB->schemaAddTable( + 'installed_plugin_attr', + [ + 'id:pk', + 'installed_plugin_id:fk', + 'name:s.128', + 'value:s.255', + ], + ); + + return 1; + }, ); 1; diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm index 13ebe171..f1fbd0f5 100644 --- a/config-db/OpenSLX/MetaDB/Base.pm +++ b/config-db/OpenSLX/MetaDB/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX MetaDB API. +# - provides empty base of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -25,10 +25,10 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; + confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; } -sub connect ## no critic (ProhibitBuiltinHomonyms) +sub connect ## no critic (ProhibitBuiltinHomonyms) { } @@ -119,12 +119,12 @@ sub fetchGroupIDsOfSystem ### data manipulation interface ################################################################################ sub generateNextIdForTable -{ # some DBs (CSV for instance) aren't able to generate any IDs, so we - # offer an alternative way (by pre-specifying IDs for INSERTs). - # NB: if this method is called without a tablename, it returns: - # 1 if this backend requires manual ID generation - # 0 if not. - return; +{ # some DBs (CSV for instance) aren't able to generate any IDs, so we + # offer an alternative way (by pre-specifying IDs for INSERTs). + # NB: if this method is called without a tablename, it returns: + # 1 if this backend requires manual ID generation + # 0 if not. + return; } sub addVendorOS diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm index 1d706d8c..819d8350 100644 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # DBI.pm -# - provides DBI-based implementation of the OpenSLX MetaDB API. +# - provides DBI-based implementation of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::DBI; @@ -27,44 +27,44 @@ use OpenSLX::Utils; ################################################################################ sub new { - confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; + confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; } sub disconnect { - my $self = shift; + my $self = shift; - $self->{'dbh'}->disconnect; - $self->{'dbh'} = undef; - return; + $self->{'dbh'}->disconnect; + $self->{'dbh'} = undef; + return; } sub quote -{ # default implementation quotes any given values through the DBI - my $self = shift; +{ # default implementation quotes any given values through the DBI + my $self = shift; - return $self->{'dbh'}->quote(@_); + return $self->{'dbh'}->quote(@_); } sub startTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->begin_work(); + return $self->{'dbh'}->begin_work(); } sub commitTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->commit(); + return $self->{'dbh'}->commit(); } sub rollbackTransaction -{ # default implementation passes on the request to the DBI - my $self = shift; +{ # default implementation passes on the request to the DBI + my $self = shift; - return $self->{'dbh'}->rollback(); + return $self->{'dbh'}->rollback(); } ################################################################################ @@ -72,442 +72,442 @@ sub rollbackTransaction ################################################################################ sub _trim { - my $s = shift; - $s =~ s[^\s*(.*?)\s*$][$1]; - return $s; + my $s = shift; + $s =~ s[^\s*(.*?)\s*$][$1]; + return $s; } sub _buildFilterClause { - my $self = shift; - my $filter = shift || {}; - my $filterClause = shift || ''; - - my ($connector, $quotedVal); - foreach my $col (keys %$filter) { - $connector = !length($filterClause) ? 'WHERE' : 'AND'; - if (defined $filter->{$col}) { - $quotedVal = $self->{dbh}->quote($filter->{$col}); - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector $col = $quotedVal - End-of-Here - } else { - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector $col IS NULL - End-of-Here - } - } - - return $filterClause || ''; + my $self = shift; + my $filter = shift || {}; + my $filterClause = shift || ''; + + my ($connector, $quotedVal); + foreach my $col (keys %$filter) { + $connector = !length($filterClause) ? 'WHERE' : 'AND'; + if (defined $filter->{$col}) { + $quotedVal = $self->{dbh}->quote($filter->{$col}); + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector $col = $quotedVal + End-of-Here + } else { + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector $col IS NULL + End-of-Here + } + } + + return $filterClause || ''; } sub _buildAttrFilterClause { - my $self = shift; - my $attrFilter = shift || {}; - my $table = shift; - my $filterClause = shift || ''; - - my %tableMap = ( - 'client' => 'client', - 'group' => 'groups', - 'system' => 'system', - ); - - my ($connector, $quotedName, $quotedValue); - foreach my $name (keys %$attrFilter) { - $connector = !length($filterClause) ? 'WHERE' : 'AND'; - $quotedName = $self->{dbh}->quote($name); - if (defined $attrFilter->{$name}) { - $quotedValue = $self->{dbh}->quote($attrFilter->{$name}); - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector EXISTS ( - SELECT name FROM ${table}_attr - WHERE name = $quotedName - AND value = $quotedValue - AND ${table}_id = $tableMap{$table}.id - ) - End-of-Here - } else { - $filterClause .= unshiftHereDoc(<<" End-of-Here"); - $connector NOT EXISTS ( - SELECT name FROM ${table}_attr - WHERE name = $quotedName - AND ${table}_id = $tableMap{$table}.id - ) - End-of-Here - } - } - - return $filterClause; + my $self = shift; + my $attrFilter = shift || {}; + my $table = shift; + my $filterClause = shift || ''; + + my %tableMap = ( + 'client' => 'client', + 'group' => 'groups', + 'system' => 'system', + ); + + my ($connector, $quotedName, $quotedValue); + foreach my $name (keys %$attrFilter) { + $connector = !length($filterClause) ? 'WHERE' : 'AND'; + $quotedName = $self->{dbh}->quote($name); + if (defined $attrFilter->{$name}) { + $quotedValue = $self->{dbh}->quote($attrFilter->{$name}); + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector EXISTS ( + SELECT name FROM ${table}_attr + WHERE name = $quotedName + AND value = $quotedValue + AND ${table}_id = $tableMap{$table}.id + ) + End-of-Here + } else { + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector NOT EXISTS ( + SELECT name FROM ${table}_attr + WHERE name = $quotedName + AND ${table}_id = $tableMap{$table}.id + ) + End-of-Here + } + } + + return $filterClause; } sub _doSelect { - my $self = shift; - my $sql = shift; - my $resultCol = shift; - - my $dbh = $self->{'dbh'}; - - vlog(3, _trim($sql)); - my $sth = $dbh->prepare($sql) - or croak _tr( - q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr - ); - $sth->execute() - or croak _tr( - q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr - ); - my @vals; - while (my $row = $sth->fetchrow_hashref()) { - if (defined $resultCol) { - return $row->{$resultCol} unless wantarray(); - push @vals, $row->{$resultCol}; - } else { - return $row unless wantarray(); - push @vals, $row; - } - } - - # return undef if there's no result in scalar context - return if !wantarray(); - - return @vals; + my $self = shift; + my $sql = shift; + my $resultCol = shift; + + my $dbh = $self->{'dbh'}; + + vlog(3, _trim($sql)); + my $sth = $dbh->prepare($sql) + or croak _tr( + q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); + $sth->execute() + or croak _tr( + q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); + my @vals; + while (my $row = $sth->fetchrow_hashref()) { + if (defined $resultCol) { + return $row->{$resultCol} unless wantarray(); + push @vals, $row->{$resultCol}; + } else { + return $row unless wantarray(); + push @vals, $row; + } + } + + # return undef if there's no result in scalar context + return if !wantarray(); + + return @vals; } sub fetchVendorOSByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - my $sql = "SELECT $resultCols FROM vendor_os $filterClause"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + my $sql = "SELECT $resultCols FROM vendor_os $filterClause"; + return $self->_doSelect($sql); } sub fetchVendorOSByID { - my $self = shift; - my $ids = shift; - my $resultCols = shift; + my $self = shift; + my $ids = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)"; + return $self->_doSelect($sql); } sub fetchInstalledPlugins { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $fullInfo = shift || 0; - - return if !defined $vendorOSID; - my $nameClause - = defined $pluginName - ? "AND plugin_name = '$pluginName'" - : ''; - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT * FROM installed_plugin - WHERE vendor_os_id = '$vendorOSID' - $nameClause - End-of-Here - my @pluginInfos = $self->_doSelect($sql); - return if !@pluginInfos; - - @pluginInfos = map { - my $pluginInfo = $_; - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT * FROM installed_plugin_attr - WHERE installed_plugin_id = '$pluginInfo->{id}' - End-of-Here - my @attrs = $self->_doSelect($sql); - $pluginInfo->{attrs} = { - map { - ( $_->{name}, $fullInfo ? $_ : $_->{value} ) - } @attrs - }; - $pluginInfo; - } - @pluginInfos; - - return wantarray() ? @pluginInfos : $pluginInfos[0]; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $fullInfo = shift || 0; + + return if !defined $vendorOSID; + my $nameClause + = defined $pluginName + ? "AND plugin_name = '$pluginName'" + : ''; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT * FROM installed_plugin + WHERE vendor_os_id = '$vendorOSID' + $nameClause + End-of-Here + my @pluginInfos = $self->_doSelect($sql); + return if !@pluginInfos; + + @pluginInfos = map { + my $pluginInfo = $_; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT * FROM installed_plugin_attr + WHERE installed_plugin_id = '$pluginInfo->{id}' + End-of-Here + my @attrs = $self->_doSelect($sql); + $pluginInfo->{attrs} = { + map { + ( $_->{name}, $fullInfo ? $_ : $_->{value} ) + } @attrs + }; + $pluginInfo; + } + @pluginInfos; + + return wantarray() ? @pluginInfos : $pluginInfos[0]; } sub fetchExportByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - my $sql = "SELECT $resultCols FROM export $filterClause"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + my $sql = "SELECT $resultCols FROM export $filterClause"; + return $self->_doSelect($sql); } sub fetchExportByID { - my $self = shift; - my $ids = shift; - my $resultCols = shift; + my $self = shift; + my $ids = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)"; + return $self->_doSelect($sql); } sub fetchExportIDsOfVendorOS { - my $self = shift; - my $vendorOSID = shift; + my $self = shift; + my $vendorOSID = shift; - my $sql = qq[ - SELECT id FROM export WHERE vendor_os_id = '$vendorOSID' - ]; - return $self->_doSelect($sql, 'id'); + my $sql = qq[ + SELECT id FROM export WHERE vendor_os_id = '$vendorOSID' + ]; + return $self->_doSelect($sql, 'id'); } sub fetchGlobalInfo { - my $self = shift; - my $id = shift; + my $self = shift; + my $id = shift; - return if !length($id); - my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id); - return $self->_doSelect($sql, 'value'); + return if !length($id); + my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id); + return $self->_doSelect($sql, 'value'); } sub fetchSystemByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'system', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM system - $filterClause - End-of-Here - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'system', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM system + $filterClause + End-of-Here + return $self->_doSelect($sql); } sub fetchSystemByID { - my $self = shift; - my $ids = shift; - my $resultCols = shift; + my $self = shift; + my $ids = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)"; + return $self->_doSelect($sql); } sub fetchSystemAttrs { - my $self = shift; - my $systemID = $self->{dbh}->quote(shift); + my $self = shift; + my $systemID = $self->{dbh}->quote(shift); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM system_attr - WHERE system_id = $systemID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM system_attr + WHERE system_id = $systemID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; } sub fetchSystemIDsOfExport { - my $self = shift; - my $exportID = shift; + my $self = shift; + my $exportID = shift; - my $sql = qq[ - SELECT id FROM system WHERE export_id = '$exportID' - ]; - return $self->_doSelect($sql, 'id'); + my $sql = qq[ + SELECT id FROM system WHERE export_id = '$exportID' + ]; + return $self->_doSelect($sql, 'id'); } sub fetchSystemIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - my $sql = qq[ - SELECT system_id FROM client_system_ref WHERE client_id = '$clientID' - ]; - return $self->_doSelect($sql, 'system_id'); + my $sql = qq[ + SELECT system_id FROM client_system_ref WHERE client_id = '$clientID' + ]; + return $self->_doSelect($sql, 'system_id'); } sub fetchSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - my $sql = qq[ - SELECT system_id FROM group_system_ref WHERE group_id = '$groupID' - ]; - return $self->_doSelect($sql, 'system_id'); + my $sql = qq[ + SELECT system_id FROM group_system_ref WHERE group_id = '$groupID' + ]; + return $self->_doSelect($sql, 'system_id'); } sub fetchClientByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'client', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM client - $filterClause - End-of-Here - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'client', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM client + $filterClause + End-of-Here + return $self->_doSelect($sql); } sub fetchClientByID { - my $self = shift; - my $ids = shift; - my $resultCols = shift; + my $self = shift; + my $ids = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)"; + return $self->_doSelect($sql); } sub fetchClientAttrs { - my $self = shift; - my $clientID = $self->{dbh}->quote(shift); + my $self = shift; + my $clientID = $self->{dbh}->quote(shift); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM client_attr - WHERE client_id = $clientID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM client_attr + WHERE client_id = $clientID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; } sub fetchClientIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - my $sql = qq[ - SELECT client_id FROM client_system_ref WHERE system_id = '$systemID' - ]; - return $self->_doSelect($sql, 'client_id'); + my $sql = qq[ + SELECT client_id FROM client_system_ref WHERE system_id = '$systemID' + ]; + return $self->_doSelect($sql, 'client_id'); } sub fetchClientIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; - my $sql = qq[ - SELECT client_id FROM group_client_ref WHERE group_id = '$groupID' - ]; - return $self->_doSelect($sql, 'client_id'); + my $sql = qq[ + SELECT client_id FROM group_client_ref WHERE group_id = '$groupID' + ]; + return $self->_doSelect($sql, 'client_id'); } sub fetchGroupByFilter { - my $self = shift; - my $filter = shift; - my $resultCols = shift; - my $attrFilter = shift; + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; - $resultCols = '*' unless (defined $resultCols); - my $filterClause = $self->_buildFilterClause($filter); - $filterClause = $self->_buildAttrFilterClause( - $attrFilter, 'group', $filterClause - ); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT $resultCols FROM groups - $filterClause - End-of-Here - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'group', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM groups + $filterClause + End-of-Here + return $self->_doSelect($sql); } sub fetchGroupByID { - my $self = shift; - my $ids = shift; - my $resultCols = shift; + my $self = shift; + my $ids = shift; + my $resultCols = shift; - $resultCols = '*' unless (defined $resultCols); - my $idStr = join ',', @$ids; - return if !length($idStr); - my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)"; - return $self->_doSelect($sql); + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)"; + return $self->_doSelect($sql); } sub fetchGroupAttrs { - my $self = shift; - my $groupID = $self->{dbh}->quote(shift); + my $self = shift; + my $groupID = $self->{dbh}->quote(shift); - my $sql = unshiftHereDoc(<<" End-of-Here"); - SELECT name, value FROM group_attr - WHERE group_id = $groupID - End-of-Here - my @attrs = $self->_doSelect($sql); - my $Result = {}; - foreach my $attr (@attrs) { - $Result->{$attr->{name}} = $attr->{value}; - } - return $Result; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM group_attr + WHERE group_id = $groupID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; } sub fetchGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; - my $sql = qq[ - SELECT group_id FROM group_system_ref WHERE system_id = '$systemID' - ]; - return $self->_doSelect($sql, 'group_id'); + my $sql = qq[ + SELECT group_id FROM group_system_ref WHERE system_id = '$systemID' + ]; + return $self->_doSelect($sql, 'group_id'); } sub fetchGroupIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; - my $sql = qq[ - SELECT group_id FROM group_client_ref WHERE client_id = '$clientID' - ]; - return $self->_doSelect($sql, 'group_id'); + my $sql = qq[ + SELECT group_id FROM group_client_ref WHERE client_id = '$clientID' + ]; + return $self->_doSelect($sql, 'group_id'); } ################################################################################ @@ -515,611 +515,611 @@ sub fetchGroupIDsOfClient ################################################################################ sub _doInsert { - my $self = shift; - my $table = shift; - my $valRows = shift; - my $ignoreIDs = shift; - - my $dbh = $self->{'dbh'}; - my $valRow = (@$valRows)[0]; - return if !defined $valRow || !scalar keys %$valRow; - - if ($table =~ m[_ref$]) { - # reference tables do not have IDs: - $ignoreIDs = 1; - } - - my $needToGenerateIDs = $self->generateNextIdForTable(undef); - if (!$ignoreIDs && $needToGenerateIDs) { - # DB requires pre-specified IDs, so we add the 'id' column: - $valRow->{id} = undef unless exists $valRow->{id}; - } - my @ids; - foreach my $valRow (@$valRows) { - if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) { - # let DB-backend pre-specify ID, as current DB can't generate IDs: - $valRow->{id} = $self->generateNextIdForTable($table); - vlog(3, "generated id for <$table> is <$valRow->{id}>"); - } - my $cols = join ', ', keys %$valRow; - my $values = join ', ', - map { $self->quote($valRow->{$_}) } keys %$valRow; - my $sql = "INSERT INTO $table ( $cols ) VALUES ( $values )"; - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't insert into table <%s> (%s)], $table, - $dbh->errstr); - if (!$ignoreIDs && !defined $valRow->{id}) { - # id has not been pre-specified, we need to fetch it from DB: - $valRow->{'id'} = $dbh->last_insert_id(undef, undef, $table, 'id'); - vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); - } - push @ids, $valRow->{'id'}; - } - return wantarray() ? @ids : shift @ids; + my $self = shift; + my $table = shift; + my $valRows = shift; + my $ignoreIDs = shift; + + my $dbh = $self->{'dbh'}; + my $valRow = (@$valRows)[0]; + return if !defined $valRow || !scalar keys %$valRow; + + if ($table =~ m[_ref$]) { + # reference tables do not have IDs: + $ignoreIDs = 1; + } + + my $needToGenerateIDs = $self->generateNextIdForTable(undef); + if (!$ignoreIDs && $needToGenerateIDs) { + # DB requires pre-specified IDs, so we add the 'id' column: + $valRow->{id} = undef unless exists $valRow->{id}; + } + my @ids; + foreach my $valRow (@$valRows) { + if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) { + # let DB-backend pre-specify ID, as current DB can't generate IDs: + $valRow->{id} = $self->generateNextIdForTable($table); + vlog(3, "generated id for <$table> is <$valRow->{id}>"); + } + my $cols = join ', ', keys %$valRow; + my $values = join ', ', + map { $self->quote($valRow->{$_}) } keys %$valRow; + my $sql = "INSERT INTO $table ( $cols ) VALUES ( $values )"; + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); + if (!$ignoreIDs && !defined $valRow->{id}) { + # id has not been pre-specified, we need to fetch it from DB: + $valRow->{'id'} = $dbh->last_insert_id(undef, undef, $table, 'id'); + vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); + } + push @ids, $valRow->{'id'}; + } + return wantarray() ? @ids : shift @ids; } sub _doDelete { - my $self = shift; - my $table = shift; - my $IDs = shift; - my $idCol = shift; - my $additionalWhereClause = shift; - - my $dbh = $self->{'dbh'}; - - $IDs = [undef] unless defined $IDs; - $idCol = 'id' unless defined $idCol; - foreach my $id (@$IDs) { - my $sql = "DELETE FROM $table"; - if (defined $id) { - $sql .= " WHERE $idCol = " . $self->quote($id); - if (defined $additionalWhereClause) { - $sql .= $additionalWhereClause; - } - } - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't delete from table <%s> (%s)], $table, - $dbh->errstr); - } - return 1; + my $self = shift; + my $table = shift; + my $IDs = shift; + my $idCol = shift; + my $additionalWhereClause = shift; + + my $dbh = $self->{'dbh'}; + + $IDs = [undef] unless defined $IDs; + $idCol = 'id' unless defined $idCol; + foreach my $id (@$IDs) { + my $sql = "DELETE FROM $table"; + if (defined $id) { + $sql .= " WHERE $idCol = " . $self->quote($id); + if (defined $additionalWhereClause) { + $sql .= $additionalWhereClause; + } + } + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); + } + return 1; } sub _doUpdate { - my $self = shift; - my $table = shift; - my $IDs = shift; - my $valRows = shift; - - my $dbh = $self->{'dbh'}; - my $valRow = (@$valRows)[0]; - return 1 if !defined $valRow || !scalar keys %$valRow; - - my $idx = 0; - foreach my $valRow (@$valRows) { - my $id = $IDs->[$idx++]; - my %valData = %$valRow; - # fail if asked to change the column 'id', as that is bogus - return if exists $valData{id} && $valData{id} ne $id; - # filter column 'id' if present, as we don't want to write it - delete $valData{id}; - my @cols = map { "$_ = " . $self->quote($valRow->{$_}) } - grep { $_ ne 'id' } - # filter column 'id' if present, as we don't want - # to update it! - keys %$valRow; - next if !@cols; - my $cols = join ', ', @cols; - my $sql = "UPDATE $table SET $cols"; - if (defined $id) { - $sql .= " WHERE id = " . $self->quote($id); - } - vlog(3, $sql); - my $sth = $dbh->prepare($sql) - or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); - $sth->execute() - or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); - } - return 1; + my $self = shift; + my $table = shift; + my $IDs = shift; + my $valRows = shift; + + my $dbh = $self->{'dbh'}; + my $valRow = (@$valRows)[0]; + return 1 if !defined $valRow || !scalar keys %$valRow; + + my $idx = 0; + foreach my $valRow (@$valRows) { + my $id = $IDs->[$idx++]; + my %valData = %$valRow; + # fail if asked to change the column 'id', as that is bogus + return if exists $valData{id} && $valData{id} ne $id; + # filter column 'id' if present, as we don't want to write it + delete $valData{id}; + my @cols = map { "$_ = " . $self->quote($valRow->{$_}) } + grep { $_ ne 'id' } + # filter column 'id' if present, as we don't want + # to update it! + keys %$valRow; + next if !@cols; + my $cols = join ', ', @cols; + my $sql = "UPDATE $table SET $cols"; + if (defined $id) { + $sql .= " WHERE id = " . $self->quote($id); + } + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + } + return 1; } sub _updateRefTable { - my $self = shift; - my $table = shift; - my $keyID = shift; - my $newValueIDs = shift; - my $keyCol = shift; - my $valueCol = shift; - my $oldValueIDs = shift; - - my %lastValueIDs; - @lastValueIDs{@$oldValueIDs} = (); - - foreach my $valueID (@$newValueIDs) { - if (!exists $lastValueIDs{$valueID}) { - # value-ID is new, create it - my $valRow = { - $keyCol => $keyID, - $valueCol => $valueID, - }; - $self->_doInsert($table, [$valRow]); - } else { - # value-ID already exists, leave as is, but remove from hash: - delete $lastValueIDs{$valueID}; - } - } - - # all the remaining value-IDs need to be removed: - if (scalar keys %lastValueIDs) { - $self->_doDelete($table, [keys %lastValueIDs], - $valueCol, " AND $keyCol='$keyID'"); - } - return 1; + my $self = shift; + my $table = shift; + my $keyID = shift; + my $newValueIDs = shift; + my $keyCol = shift; + my $valueCol = shift; + my $oldValueIDs = shift; + + my %lastValueIDs; + @lastValueIDs{@$oldValueIDs} = (); + + foreach my $valueID (@$newValueIDs) { + if (!exists $lastValueIDs{$valueID}) { + # value-ID is new, create it + my $valRow = { + $keyCol => $keyID, + $valueCol => $valueID, + }; + $self->_doInsert($table, [$valRow]); + } else { + # value-ID already exists, leave as is, but remove from hash: + delete $lastValueIDs{$valueID}; + } + } + + # all the remaining value-IDs need to be removed: + if (scalar keys %lastValueIDs) { + $self->_doDelete($table, [keys %lastValueIDs], + $valueCol, " AND $keyCol='$keyID'"); + } + return 1; } sub _updateOneToManyRefAttr { - my $self = shift; - my $table = shift; - my $oneID = shift; - my $newManyIDs = shift; - my $fkCol = shift; - my $oldManyIDs = shift; - - my %lastManyIDs; - @lastManyIDs{@$oldManyIDs} = (); - - foreach my $id (@$newManyIDs) { - if (!exists $lastManyIDs{$id}) { - # ID has changed, update it - $self->_doUpdate($table, $id, [{$fkCol => $oneID}]); - } else { - # ID hasn't changed, leave as is, but remove from hash: - delete $lastManyIDs{$id}; - } - } - - # all the remaining many-IDs need to be set to 0: - foreach my $id (scalar keys %lastManyIDs) { - $self->_doUpdate($table, $id, [{$fkCol => '0'}]); - } - return 1; + my $self = shift; + my $table = shift; + my $oneID = shift; + my $newManyIDs = shift; + my $fkCol = shift; + my $oldManyIDs = shift; + + my %lastManyIDs; + @lastManyIDs{@$oldManyIDs} = (); + + foreach my $id (@$newManyIDs) { + if (!exists $lastManyIDs{$id}) { + # ID has changed, update it + $self->_doUpdate($table, $id, [{$fkCol => $oneID}]); + } else { + # ID hasn't changed, leave as is, but remove from hash: + delete $lastManyIDs{$id}; + } + } + + # all the remaining many-IDs need to be set to 0: + foreach my $id (scalar keys %lastManyIDs) { + $self->_doUpdate($table, $id, [{$fkCol => '0'}]); + } + return 1; } sub addVendorOS { - my $self = shift; - my $valRows = shift; + my $self = shift; + my $valRows = shift; - return $self->_doInsert('vendor_os', $valRows); + return $self->_doInsert('vendor_os', $valRows); } sub removeVendorOS { - my $self = shift; - my $vendorOSIDs = shift; + my $self = shift; + my $vendorOSIDs = shift; - return $self->_doDelete('vendor_os', $vendorOSIDs); + return $self->_doDelete('vendor_os', $vendorOSIDs); } sub changeVendorOS { - my $self = shift; - my $vendorOSIDs = shift; - my $valRows = shift; + my $self = shift; + my $vendorOSIDs = shift; + my $valRows = shift; - return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); + return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); } sub addInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; - my $pluginAttrs = shift; - - return if !defined $vendorOSID || !$pluginName; - - my $installedPlugin - = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); - if (!$installedPlugin) { - return if !$self->_doInsert('installed_plugin', [ { - vendor_os_id => $vendorOSID, - plugin_name => $pluginName, - } ] ); - $installedPlugin - = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); - } - return if !$installedPlugin; - for my $pluginAttrName (keys %$pluginAttrs) { - if (exists $installedPlugin->{attrs}->{$pluginAttrName}) { - my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName}; - my $currVal - = defined $attrInfo->{value} ? $attrInfo->{value} : '-'; - my $givenVal - = defined $pluginAttrs->{$pluginAttrName} - ? $pluginAttrs->{$pluginAttrName} - : '-'; - next if $currVal eq $givenVal; - return if ! $self->_doUpdate( - 'installed_plugin_attr', [ $attrInfo->{id} ], [ { - value => $pluginAttrs->{$pluginAttrName}, - } ] - ); - } - else { - return if ! $self->_doInsert('installed_plugin_attr', [ { - installed_plugin_id => $installedPlugin->{id}, - name => $pluginAttrName, - value => $pluginAttrs->{$pluginAttrName}, - } ] ); - } - } - return 1; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $pluginAttrs = shift; + + return if !defined $vendorOSID || !$pluginName; + + my $installedPlugin + = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); + if (!$installedPlugin) { + return if !$self->_doInsert('installed_plugin', [ { + vendor_os_id => $vendorOSID, + plugin_name => $pluginName, + } ] ); + $installedPlugin + = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); + } + return if !$installedPlugin; + for my $pluginAttrName (keys %$pluginAttrs) { + if (exists $installedPlugin->{attrs}->{$pluginAttrName}) { + my $attrInfo = $installedPlugin->{attrs}->{$pluginAttrName}; + my $currVal + = defined $attrInfo->{value} ? $attrInfo->{value} : '-'; + my $givenVal + = defined $pluginAttrs->{$pluginAttrName} + ? $pluginAttrs->{$pluginAttrName} + : '-'; + next if $currVal eq $givenVal; + return if ! $self->_doUpdate( + 'installed_plugin_attr', [ $attrInfo->{id} ], [ { + value => $pluginAttrs->{$pluginAttrName}, + } ] + ); + } + else { + return if ! $self->_doInsert('installed_plugin_attr', [ { + installed_plugin_id => $installedPlugin->{id}, + name => $pluginAttrName, + value => $pluginAttrs->{$pluginAttrName}, + } ] ); + } + } + return 1; } sub removeInstalledPlugin { - my $self = shift; - my $vendorOSID = shift; - my $pluginName = shift; + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; - return if !defined $vendorOSID || !$pluginName; + return if !defined $vendorOSID || !$pluginName; - my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName); - return if !$plugin; - return if !$self->_doDelete( - 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id' - ); - return $self->_doDelete('installed_plugin', [ $plugin->{id} ] ); + my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName); + return if !$plugin; + return if !$self->_doDelete( + 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id' + ); + return $self->_doDelete('installed_plugin', [ $plugin->{id} ] ); } sub addExport { - my $self = shift; - my $valRows = shift; + my $self = shift; + my $valRows = shift; - return $self->_doInsert('export', $valRows); + return $self->_doInsert('export', $valRows); } sub removeExport { - my $self = shift; - my $exportIDs = shift; + my $self = shift; + my $exportIDs = shift; - return $self->_doDelete('export', $exportIDs); + return $self->_doDelete('export', $exportIDs); } sub changeExport { - my $self = shift; - my $exportIDs = shift; - my $valRows = shift; + my $self = shift; + my $exportIDs = shift; + my $valRows = shift; - return $self->_doUpdate('export', $exportIDs, $valRows); + return $self->_doUpdate('export', $exportIDs, $valRows); } sub changeGlobalInfo { - my $self = shift; - my $id = shift; - my $value = shift; + my $self = shift; + my $id = shift; + my $value = shift; - return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); + return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); } sub addSystem { - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the systems to get the IDs ... - my @systemIDs = $self->_doInsert('system', $valRows); + # ... store the systems to get the IDs ... + my @systemIDs = $self->_doInsert('system', $valRows); - # ... finally store the individual attribute sets - foreach my $id (@systemIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setSystemAttrs($id, $attrs); - } + # ... finally store the individual attribute sets + foreach my $id (@systemIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setSystemAttrs($id, $attrs); + } - return @systemIDs; + return @systemIDs; } sub removeSystem { - my $self = shift; - my $systemIDs = shift; + my $self = shift; + my $systemIDs = shift; - return $self->_doDelete('system', $systemIDs); + return $self->_doDelete('system', $systemIDs); } sub changeSystem { - my $self = shift; - my $systemIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $systemIDs = shift; + my $valRows = shift; + my $attrValRows = shift; - # store the attribute hashes individually - foreach my $id (@$systemIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setSystemAttrs($id, $attrs); - } + # store the attribute hashes individually + foreach my $id (@$systemIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setSystemAttrs($id, $attrs); + } - # finally update all systems in one go - return $self->_doUpdate('system', $systemIDs, $valRows); + # finally update all systems in one go + return $self->_doUpdate('system', $systemIDs, $valRows); } sub setSystemAttrs { - my $self = shift; - my $systemID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('system_attr', [ $systemID ], 'system_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - system_id => $systemID, - name => $_, - value => $attrs->{$_}, - } - } - grep { - # Write undefined attributes for the default system, such that - # it shows all existing attributes. All other systems never - # write undefined attributes (if they have not defined a - # specific attribute, it is inherited from "above"). - $systemID == 0 || defined $attrs->{$_} - } - keys %$attrs; - $self->_doInsert('system_attr', \@attrData); - return 1; + my $self = shift; + my $systemID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('system_attr', [ $systemID ], 'system_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + system_id => $systemID, + name => $_, + value => $attrs->{$_}, + } + } + grep { + # Write undefined attributes for the default system, such that + # it shows all existing attributes. All other systems never + # write undefined attributes (if they have not defined a + # specific attribute, it is inherited from "above"). + $systemID == 0 || defined $attrs->{$_} + } + keys %$attrs; + $self->_doInsert('system_attr', \@attrData); + return 1; } sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $clientIDs = shift; + my $self = shift; + my $systemID = shift; + my $clientIDs = shift; - my @currClients = $self->fetchClientIDsOfSystem($systemID); - return $self->_updateRefTable( - 'client_system_ref', $systemID, $clientIDs, 'system_id', 'client_id', - \@currClients - ); + my @currClients = $self->fetchClientIDsOfSystem($systemID); + return $self->_updateRefTable( + 'client_system_ref', $systemID, $clientIDs, 'system_id', 'client_id', + \@currClients + ); } sub setGroupIDsOfSystem { - my $self = shift; - my $systemID = shift; - my $groupIDs = shift; + my $self = shift; + my $systemID = shift; + my $groupIDs = shift; - my @currGroups = $self->fetchGroupIDsOfSystem($systemID); - return $self->_updateRefTable( - 'group_system_ref', $systemID, $groupIDs, 'system_id', 'group_id', - \@currGroups - ); + my @currGroups = $self->fetchGroupIDsOfSystem($systemID); + return $self->_updateRefTable( + 'group_system_ref', $systemID, $groupIDs, 'system_id', 'group_id', + \@currGroups + ); } sub addClient { - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the clients to get the IDs ... - my @clientIDs = $self->_doInsert('client', $valRows); + # ... store the clients to get the IDs ... + my @clientIDs = $self->_doInsert('client', $valRows); - # ... finally store the individual attribute sets - foreach my $id (@clientIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setClientAttrs($id, $attrs); - } + # ... finally store the individual attribute sets + foreach my $id (@clientIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setClientAttrs($id, $attrs); + } - return @clientIDs; + return @clientIDs; } sub removeAttributeByName { - my $self = shift; - my $attrName = shift; + my $self = shift; + my $attrName = shift; - return $self->_doDelete('system_attr', [ $attrName ], 'name') - && $self->_doDelete('client_attr', [ $attrName ], 'name') - && $self->_doDelete('group_attr', [ $attrName ], 'name'); + return $self->_doDelete('system_attr', [ $attrName ], 'name') + && $self->_doDelete('client_attr', [ $attrName ], 'name') + && $self->_doDelete('group_attr', [ $attrName ], 'name'); } sub removeClient { - my $self = shift; - my $clientIDs = shift; + my $self = shift; + my $clientIDs = shift; - return $self->_doDelete('client', $clientIDs); + return $self->_doDelete('client', $clientIDs); } sub changeClient { - my $self = shift; - my $clientIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $clientIDs = shift; + my $valRows = shift; + my $attrValRows = shift; - # store the attribute hashes individually - foreach my $id (@$clientIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setClientAttrs($id, $attrs); - } + # store the attribute hashes individually + foreach my $id (@$clientIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setClientAttrs($id, $attrs); + } - # finally update all systems in one go - return $self->_doUpdate('client', $clientIDs, $valRows); + # finally update all systems in one go + return $self->_doUpdate('client', $clientIDs, $valRows); } sub setClientAttrs { - my $self = shift; - my $clientID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('client_attr', [ $clientID ], 'client_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - client_id => $clientID, - name => $_, - value => $attrs->{$_}, - } - } - grep { defined $attrs->{$_} } - keys %$attrs; - $self->_doInsert('client_attr', \@attrData); - return 1; + my $self = shift; + my $clientID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('client_attr', [ $clientID ], 'client_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + client_id => $clientID, + name => $_, + value => $attrs->{$_}, + } + } + grep { defined $attrs->{$_} } + keys %$attrs; + $self->_doInsert('client_attr', \@attrData); + return 1; } sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; - my $systemIDs = shift; + my $self = shift; + my $clientID = shift; + my $systemIDs = shift; - my @currSystems = $self->fetchSystemIDsOfClient($clientID); - return $self->_updateRefTable( - 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id', - \@currSystems - ); + my @currSystems = $self->fetchSystemIDsOfClient($clientID); + return $self->_updateRefTable( + 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id', + \@currSystems + ); } sub setGroupIDsOfClient { - my $self = shift; - my $clientID = shift; - my $groupIDs = shift; + my $self = shift; + my $clientID = shift; + my $groupIDs = shift; - my @currGroups = $self->fetchGroupIDsOfClient($clientID); - return $self->_updateRefTable( - 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id', - \@currGroups - ); + my @currGroups = $self->fetchGroupIDsOfClient($clientID); + return $self->_updateRefTable( + 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id', + \@currGroups + ); } sub addGroup { - my $self = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; - # ... store the groups to get the IDs ... - my @groupIDs = $self->_doInsert('groups', $valRows); + # ... store the groups to get the IDs ... + my @groupIDs = $self->_doInsert('groups', $valRows); - # ... finally store the individual attribute sets - foreach my $id (@groupIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setGroupAttrs($id, $attrs); - } + # ... finally store the individual attribute sets + foreach my $id (@groupIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setGroupAttrs($id, $attrs); + } - return @groupIDs; + return @groupIDs; } sub removeGroup { - my $self = shift; - my $groupIDs = shift; + my $self = shift; + my $groupIDs = shift; - return $self->_doDelete('groups', $groupIDs); + return $self->_doDelete('groups', $groupIDs); } sub changeGroup { - my $self = shift; - my $groupIDs = shift; - my $valRows = shift; - my $attrValRows = shift; + my $self = shift; + my $groupIDs = shift; + my $valRows = shift; + my $attrValRows = shift; - # store the attribute hashes individually - foreach my $id (@$groupIDs) { - my $attrs = shift @$attrValRows; - next if !defined $attrs; - return if !$self->setGroupAttrs($id, $attrs); - } + # store the attribute hashes individually + foreach my $id (@$groupIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setGroupAttrs($id, $attrs); + } - # finally update all groups in one go - return $self->_doUpdate('groups', $groupIDs, $valRows); + # finally update all groups in one go + return $self->_doUpdate('groups', $groupIDs, $valRows); } sub setGroupAttrs { - my $self = shift; - my $groupID = shift; - my $attrs = shift; - - # TODO: improve this, as it is pretty slow! - # for now we take the simple path and remove all attributes ... - $self->_doDelete('group_attr', [ $groupID ], 'group_id'); - - # ... and (re-)insert the given ones - my @attrData - = map { - { - group_id => $groupID, - name => $_, - value => $attrs->{$_}, - } - } - grep { defined $attrs->{$_} } - keys %$attrs; - $self->_doInsert('group_attr', \@attrData); - return 1; + my $self = shift; + my $groupID = shift; + my $attrs = shift; + + # TODO: improve this, as it is pretty slow! + # for now we take the simple path and remove all attributes ... + $self->_doDelete('group_attr', [ $groupID ], 'group_id'); + + # ... and (re-)insert the given ones + my @attrData + = map { + { + group_id => $groupID, + name => $_, + value => $attrs->{$_}, + } + } + grep { defined $attrs->{$_} } + keys %$attrs; + $self->_doInsert('group_attr', \@attrData); + return 1; } sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $clientIDs = shift; + my $self = shift; + my $groupID = shift; + my $clientIDs = shift; - my @currClients = $self->fetchClientIDsOfGroup($groupID); - return $self->_updateRefTable( - 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id', - \@currClients - ); + my @currClients = $self->fetchClientIDsOfGroup($groupID); + return $self->_updateRefTable( + 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id', + \@currClients + ); } sub setSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; - my $systemIDs = shift; + my $self = shift; + my $groupID = shift; + my $systemIDs = shift; - my @currSystems = $self->fetchSystemIDsOfGroup($groupID); - return $self->_updateRefTable( - 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id', - \@currSystems - ); + my @currSystems = $self->fetchSystemIDsOfGroup($groupID); + return $self->_updateRefTable( + 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id', + \@currSystems + ); } ################################################################################ @@ -1127,274 +1127,274 @@ sub setSystemIDsOfGroup ################################################################################ sub _convertColDescrsToDBNativeString { - my $self = shift; - my $colDescrs = shift; + my $self = shift; + my $colDescrs = shift; - my $colDescrString = join ', ', map { - # convert each column description into database native format - # (e.g. convert 'name:s.45' to 'name char(45)'): - if (!m[^\s*(\S+?)\s*:\s*(\S+?)\s*$]) { - croak _tr('UnknownDbSchemaColumnDescr', $_); - } - "$1 " . $self->schemaConvertTypeDescrToNative($2); - } @$colDescrs; - return $colDescrString; + my $colDescrString = join ', ', map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:\s*(\S+?)\s*$]) { + croak _tr('UnknownDbSchemaColumnDescr', $_); + } + "$1 " . $self->schemaConvertTypeDescrToNative($2); + } @$colDescrs; + return $colDescrString; } sub _convertColDescrsToColNames { - my $self = shift; - my $colDescrs = shift; + my $self = shift; + my $colDescrs = shift; - return map { - # convert each column description into database native format - # (e.g. convert 'name:s.45' to 'name char(45)'): - if (!m[^\s*(\S+?)\s*:.+$]) { - croak _tr('UnknownDbSchemaColumnDescr', $_); - } - $1; - } @$colDescrs; + return map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:.+$]) { + croak _tr('UnknownDbSchemaColumnDescr', $_); + } + $1; + } @$colDescrs; } sub _convertColDescrsToColNamesString { - my $self = shift; - my $colDescrs = shift; + my $self = shift; + my $colDescrs = shift; - return join ', ', $self->_convertColDescrsToColNames($colDescrs); + return join ', ', $self->_convertColDescrsToColNames($colDescrs); } sub schemaFetchDBVersion { - my $self = shift; + my $self = shift; - my $dbh = $self->{dbh}; - local $dbh->{RaiseError} = 1; - my $row = - eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); }; - return 0 if $@; - # no database access possible - return unless defined $row; - # no entry in meta-table - return $row->{schema_version}; + my $dbh = $self->{dbh}; + local $dbh->{RaiseError} = 1; + my $row = + eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); }; + return 0 if $@; + # no database access possible + return unless defined $row; + # no entry in meta-table + return $row->{schema_version}; } sub schemaSetDBVersion { - my $self = shift; - my $dbVersion = shift; + my $self = shift; + my $dbVersion = shift; - $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'") - or croak _tr('Unable to set DB-schema version to %s!', $dbVersion); + $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'") + or croak _tr('Unable to set DB-schema version to %s!', $dbVersion); - return 1; + return 1; } sub schemaConvertTypeDescrToNative -{ # a default implementation, many DBs need to override... - my $self = shift; - my $typeDescr = lc(shift); - - if ($typeDescr eq 'b') { - return 'integer'; - } elsif ($typeDescr eq 'i') { - return 'integer'; - } elsif ($typeDescr eq 'pk') { - return 'integer primary key'; - } elsif ($typeDescr eq 'fk') { - return 'integer'; - } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { - return "varchar($1)"; - } else { - croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } +{ # a default implementation, many DBs need to override... + my $self = shift; + my $typeDescr = lc(shift); + + if ($typeDescr eq 'b') { + return 'integer'; + } elsif ($typeDescr eq 'i') { + return 'integer'; + } elsif ($typeDescr eq 'pk') { + return 'integer primary key'; + } elsif ($typeDescr eq 'fk') { + return 'integer'; + } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { + return "varchar($1)"; + } else { + croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } } sub schemaAddTable { - my $self = shift; - my $table = shift; - my $colDescrs = shift; - my $initialVals = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "adding table <$table> to schema...") unless $isSubCmd; - my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $table ($colDescrString)"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); - if (defined $initialVals) { - my $ignoreIDs = ($colDescrString !~ m[\bid\b]); - # don't care about IDs if there's no 'id' column in this table - $self->_doInsert($table, $initialVals, $ignoreIDs); - } - return; + my $self = shift; + my $table = shift; + my $colDescrs = shift; + my $initialVals = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "adding table <$table> to schema...") unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $table ($colDescrString)"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); + if (defined $initialVals) { + my $ignoreIDs = ($colDescrString !~ m[\bid\b]); + # don't care about IDs if there's no 'id' column in this table + $self->_doInsert($table, $initialVals, $ignoreIDs); + } + return; } sub schemaDropTable { - my $self = shift; - my $table = shift; - my $isSubCmd = shift; + my $self = shift; + my $table = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - vlog(1, "dropping table <$table> from schema...") unless $isSubCmd; - my $sql = "DROP TABLE $table"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); - return; + my $dbh = $self->{'dbh'}; + vlog(1, "dropping table <$table> from schema...") unless $isSubCmd; + my $sql = "DROP TABLE $table"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); + return; } sub schemaRenameTable { # a rather simple-minded implementation that renames a table in several - # steps: - # - create the new table - # - copy the data over from the old one - # - drop the old table - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE RENAME TO ' SQL-command (which - # is much more efficient). - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; - my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); - my $sql = "CREATE TABLE $newTable ($colDescrString)"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); - $self->_doInsert($newTable, \@dataRows); - $sql = "DROP TABLE $oldTable"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); - return; + # steps: + # - create the new table + # - copy the data over from the old one + # - drop the old table + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE RENAME TO ' SQL-command (which + # is much more efficient). + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $newTable ($colDescrString)"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); + $self->_doInsert($newTable, \@dataRows); + $sql = "DROP TABLE $oldTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); + return; } sub schemaAddColumns { # a rather simple-minded implementation that adds columns to a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these more often than not - # implement the 'ALTER TABLE ADD COLUMN ' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); - my $newColStr = join ', ', @newColNames; - vlog(1, "adding columns <$newColStr> to table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - # N.B.: for the insert, we rely on the caller having added the new - # columns to the end of the table (if that isn't the case, things - # break here!) - - if (defined $newColDefaultVals) { - # default values have been provided, we apply them now: - $self->_doUpdate($tempTable, undef, $newColDefaultVals); - } - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE
ADD COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); + my $newColStr = join ', ', @newColNames; + vlog(1, "adding columns <$newColStr> to table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + # N.B.: for the insert, we rely on the caller having added the new + # columns to the end of the table (if that isn't the case, things + # break here!) + + if (defined $newColDefaultVals) { + # default values have been provided, we apply them now: + $self->_doUpdate($tempTable, undef, $newColDefaultVals); + } + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } sub schemaDropColumns { # a rather simple-minded implementation that drops columns from a table - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE
DROP COLUMN ' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $dropColStr = join ', ', @$dropColNames; - vlog(1, "dropping columns <$dropColStr> from table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE
DROP COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $dropColStr = join ', ', @$dropColNames; + vlog(1, "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } sub schemaChangeColumns { # a rather simple-minded implementation that changes columns - # in several steps: - # - create a temp table with the new layout - # - copy the data from the old table into the new one - # - drop the old table - # - rename the temp table to the original name - # This should be overriden for advanced DBs, as these sometimes - # implement the 'ALTER TABLE
CHANGE COLUMN ' SQL-command (which - # is much more efficient). - my $self = shift; - my $table = shift; - my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $tempTable = "${table}_temp"; - my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> of table <$table>...") - unless $isSubCmd; - $self->schemaAddTable($tempTable, $colDescrs, undef, 1); - - # copy the data from the old table to the new: - my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); - my @dataRows = $self->_doSelect("SELECT * FROM $table"); - foreach my $oldCol (keys %$colChanges) { - my $newCol = - $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); - # rename current column in all data-rows: - foreach my $row (@dataRows) { - $row->{$newCol} = $row->{$oldCol}; - delete $row->{$oldCol}; - } - } - $self->_doInsert($tempTable, \@dataRows); - - $self->schemaDropTable($table, 1); - $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); - return; + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE
CHANGE COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $changeColStr = join ', ', keys %$colChanges; + vlog(1, "changing columns <$changeColStr> of table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + foreach my $oldCol (keys %$colChanges) { + my $newCol = + $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); + # rename current column in all data-rows: + foreach my $row (@dataRows) { + $row->{$newCol} = $row->{$oldCol}; + delete $row->{$oldCol}; + } + } + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; } 1; diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index c0725191..ce5c51f3 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SQLite.pm -# - provides SQLite-specific overrides of the OpenSLX MetaDB API. +# - provides SQLite-specific overrides of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::SQLite; @@ -30,102 +30,102 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub databaseExists { - my $self = shift; - - my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + my $self = shift; + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; print "$fullDBPath\n"; - return -e $fullDBPath; + return -e $fullDBPath; } sub dropDatabase { - my $self = shift; - - if ($self->{dbh}) { - die "need to disconnect before you can drop the database!"; - } - - my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; - system("rm -rf $fullDBPath") if -e $fullDBPath; + my $self = shift; + + if ($self->{dbh}) { + die "need to disconnect before you can drop the database!"; + } + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + system("rm -rf $fullDBPath") if -e $fullDBPath; } -sub connect ## no critic (ProhibitBuiltinHomonyms) +sub connect ## no critic (ProhibitBuiltinHomonyms) { - my $self = shift; + my $self = shift; - my $dbSpec = $openslxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - my $dbPath = $self->_getDBPath; - system("mkdir -p $dbPath") unless -e $dbPath; - $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; - } - vlog(1, "trying to connect to SQLite-database <$dbSpec>"); - $self->{'dbh'} = DBI->connect( - "dbi:SQLite:$dbSpec", undef, undef, - {PrintError => 0, AutoCommit => 1, unicode => 1} - ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); - return 1; + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + my $dbPath = $self->_getDBPath; + system("mkdir -p $dbPath") unless -e $dbPath; + $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; + } + vlog(1, "trying to connect to SQLite-database <$dbSpec>"); + $self->{'dbh'} = DBI->connect( + "dbi:SQLite:$dbSpec", undef, undef, + {PrintError => 0, AutoCommit => 1, unicode => 1} + ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); + return 1; } sub schemaRenameTable { - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; - my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; - vlog(3, $sql); - $dbh->do($sql) - or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr)); - return; + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr)); + return; } sub schemaAddColumns { - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; - my $dbh = $self->{'dbh'}; - my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog(1, "adding columns <$newColNames> to table <$table>") - unless $isSubCmd; - foreach my $colDescr (@$newColDescrs) { - my $colDescrString = - $self->_convertColDescrsToDBNativeString([$colDescr]); - my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString"; - vlog(3, $sql); - $dbh->do($sql) - or croak(_tr(q[Can't add column to table <%s> (%s)], $table, - $dbh->errstr)); - } - # if default values have been provided, we apply them now: - if (defined $newColDefaultVals) { - $self->_doUpdate($table, undef, $newColDefaultVals); - } - return; + my $dbh = $self->{'dbh'}; + my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); + vlog(1, "adding columns <$newColNames> to table <$table>") + unless $isSubCmd; + foreach my $colDescr (@$newColDescrs) { + my $colDescrString = + $self->_convertColDescrsToDBNativeString([$colDescr]); + my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString"; + vlog(3, $sql); + $dbh->do($sql) + or croak(_tr(q[Can't add column to table <%s> (%s)], $table, + $dbh->errstr)); + } + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } + return; } sub _getDBPath { - my $self = shift; + my $self = shift; - return "$openslxConfig{'private-path'}/db/sqlite"; + return "$openslxConfig{'private-path'}/db/sqlite"; } 1; diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm index 6b298bc8..0b6569dd 100644 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # mysql.pm -# - provides mysql-specific overrides of the OpenSLX MetaDB API. +# - provides mysql-specific overrides of the OpenSLX MetaDB API. # ----------------------------------------------------------------------------- package OpenSLX::MetaDB::mysql; @@ -31,146 +31,146 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } -sub connect ## no critic (ProhibitBuiltinHomonyms) +sub connect ## no critic (ProhibitBuiltinHomonyms) { - my $self = shift; - - my $dbSpec = $openslxConfig{'db-spec'}; - if (!defined $dbSpec) { - # build $dbSpec from individual parameters: - $dbSpec = "database=$openslxConfig{'db-name'}"; - } - my $dbUser - = $openslxConfig{'db-user'} - ? $openslxConfig{'db-user'} - : (getpwuid($>))[0]; - my $dbPasswd = $openslxConfig{'db-passwd'}; - if (!defined $dbPasswd) { + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + $dbSpec = "database=$openslxConfig{'db-name'}"; + } + my $dbUser + = $openslxConfig{'db-user'} + ? $openslxConfig{'db-user'} + : (getpwuid($>))[0]; + my $dbPasswd = $openslxConfig{'db-passwd'}; + if (!defined $dbPasswd) { $dbPasswd = readPassword("db-password> "); - } - - vlog(1, "trying to connect user '$dbUser' to mysql-database '$dbSpec'"); - $self->{'dbh'} = DBI->connect( - "dbi:mysql:$dbSpec", $dbUser, $dbPasswd, {PrintError => 0} - ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); - return 1; + } + + vlog(1, "trying to connect user '$dbUser' to mysql-database '$dbSpec'"); + $self->{'dbh'} = DBI->connect( + "dbi:mysql:$dbSpec", $dbUser, $dbPasswd, {PrintError => 0} + ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); + return 1; } sub schemaConvertTypeDescrToNative { - my $self = shift; - my $typeDescr = lc(shift); - - if ($typeDescr eq 'b') { - return 'integer'; - } elsif ($typeDescr eq 'i') { - return 'integer'; - } elsif ($typeDescr eq 'pk') { - return 'integer AUTO_INCREMENT primary key'; - } elsif ($typeDescr eq 'fk') { - return 'integer'; - } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { - return "varchar($1)"; - } else { - croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); - } - return; + my $self = shift; + my $typeDescr = lc(shift); + + if ($typeDescr eq 'b') { + return 'integer'; + } elsif ($typeDescr eq 'i') { + return 'integer'; + } elsif ($typeDescr eq 'pk') { + return 'integer AUTO_INCREMENT primary key'; + } elsif ($typeDescr eq 'fk') { + return 'integer'; + } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { + return "varchar($1)"; + } else { + croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } + return; } sub schemaRenameTable { - my $self = shift; - my $oldTable = shift; - my $newTable = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; - my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); - return; + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); + return; } sub schemaAddColumns { - my $self = shift; - my $table = shift; - my $newColDescrs = shift; - my $newColDefaultVals = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog(1, "adding columns <$newColNames> to table <$table>") unless $isSubCmd; - my $addClause = join ', ', - map { "ADD COLUMN " . $self->_convertColDescrsToDBNativeString([$_]); } - @$newColDescrs; - my $sql = "ALTER TABLE $table $addClause"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't add columns to table <%s> (%s)], $table, - $dbh->errstr); - # if default values have been provided, we apply them now: - if (defined $newColDefaultVals) { - $self->_doUpdate($table, undef, $newColDefaultVals); - } - return; + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); + vlog(1, "adding columns <$newColNames> to table <$table>") unless $isSubCmd; + my $addClause = join ', ', + map { "ADD COLUMN " . $self->_convertColDescrsToDBNativeString([$_]); } + @$newColDescrs; + my $sql = "ALTER TABLE $table $addClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't add columns to table <%s> (%s)], $table, + $dbh->errstr); + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } + return; } sub schemaDropColumns { - my $self = shift; - my $table = shift; - my $dropColNames = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $dropColStr = join ', ', @$dropColNames; - vlog(1, - "dropping columns <$dropColStr> from table <$table>...") - unless $isSubCmd; - my $dropClause = join ', ', map { "DROP COLUMN $_" } @$dropColNames; - my $sql = "ALTER TABLE $table $dropClause"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't drop columns from table <%s> (%s)], $table, - $dbh->errstr); - return; + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $dropColStr = join ', ', @$dropColNames; + vlog(1, + "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; + my $dropClause = join ', ', map { "DROP COLUMN $_" } @$dropColNames; + my $sql = "ALTER TABLE $table $dropClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop columns from table <%s> (%s)], $table, + $dbh->errstr); + return; } sub schemaChangeColumns { - my $self = shift; - my $table = shift; - my $colChanges = shift; - my $colDescrs = shift; - my $isSubCmd = shift; - - my $dbh = $self->{'dbh'}; - my $changeColStr = join ', ', keys %$colChanges; - vlog(1, "changing columns <$changeColStr> in table <$table>...") - unless $isSubCmd; - my $changeClause = join ', ', map { - "CHANGE COLUMN $_ " - . $self->_convertColDescrsToDBNativeString([$colChanges->{$_}]); - } - keys %$colChanges; - my $sql = "ALTER TABLE $table $changeClause"; - vlog(3, $sql); - $dbh->do($sql) - or croak _tr(q[Can't change columns in table <%s> (%s)], $table, - $dbh->errstr); - return; + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $changeColStr = join ', ', keys %$colChanges; + vlog(1, "changing columns <$changeColStr> in table <$table>...") + unless $isSubCmd; + my $changeClause = join ', ', map { + "CHANGE COLUMN $_ " + . $self->_convertColDescrsToDBNativeString([$colChanges->{$_}]); + } + keys %$colChanges; + my $sql = "ALTER TABLE $table $changeClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't change columns in table <%s> (%s)], $table, + $dbh->errstr); + return; } 1; diff --git a/config-db/devel-tools/test-config-db.pl b/config-db/devel-tools/test-config-db.pl index 8a572e28..825800c4 100755 --- a/config-db/devel-tools/test-config-db.pl +++ b/config-db/devel-tools/test-config-db.pl @@ -13,7 +13,7 @@ use strict; use FindBin; use lib "$FindBin::RealBin/../../lib"; use lib "$FindBin::RealBin/.."; - # development path to config-db stuff + # development path to config-db stuff print "THIS IS CURRENTLY BROKEN!!!\n"; exit 5; @@ -26,27 +26,27 @@ openslxInit(); my $openslxDB = connectConfigDB(); addVendorOS($openslxDB, { - 'name' => "suse-93-minimal", - 'descr' => "SuSE 9.3 minimale Installation", + 'name' => "suse-93-minimal", + 'descr' => "SuSE 9.3 minimale Installation", }); addVendorOS($openslxDB, { - 'name' => "suse-93-KDE", - 'descr' => "SuSE 9.3 grafische Installation mit KDE", + 'name' => "suse-93-KDE", + 'descr' => "SuSE 9.3 grafische Installation mit KDE", }); addVendorOS($openslxDB, { - 'name' => "debian-31", - 'descr' => "Debian 3.1 Default-Installation", + 'name' => "debian-31", + 'descr' => "Debian 3.1 Default-Installation", }); my @systems; foreach my $id (1..10) { - push @systems, { - 'name' => "name of $id", - 'descr' => "descr of $id", - 'vendor_os_id' => 1 + $id % 3, - }; + push @systems, { + 'name' => "name of $id", + 'descr' => "descr of $id", + 'vendor_os_id' => 1 + $id % 3, + }; } addSystem($openslxDB, \@systems); @@ -63,31 +63,31 @@ changeSystem($openslxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); my $metaDB = $openslxDB->{'meta-db'}; my $colDescrs = [ - 'id:pk', - 'name:s.30', - 'descr:s.1024', - 'counter:i', - 'hidden:b', - 'dropped1:b', - 'dropped2:b', + 'id:pk', + 'name:s.30', + 'descr:s.1024', + 'counter:i', + 'hidden:b', + 'dropped1:b', + 'dropped2:b', ]; my $initialVals = [ - { - 'name' => '123456789012345678901234567890xxx', - 'descr' => 'descr-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', - 'counter' => 34567, - 'hidden' => 1, - 'dropped1' => 0, - 'dropped2' => 1, - }, - { - 'name' => 'name', - 'descr' => q[from_äöüß#'"$...\to_here], - 'counter' => -1, - 'hidden' => 0, - 'dropped1' => 1, - 'dropped2' => 0, - }, + { + 'name' => '123456789012345678901234567890xxx', + 'descr' => 'descr-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', + 'counter' => 34567, + 'hidden' => 1, + 'dropped1' => 0, + 'dropped2' => 1, + }, + { + 'name' => 'name', + 'descr' => q[from_äöüß#'"$...\to_here], + 'counter' => -1, + 'hidden' => 0, + 'dropped1' => 1, + 'dropped2' => 0, + }, ]; @@ -98,15 +98,15 @@ $metaDB->schemaRenameTable('test', 'test2', $colDescrs); push @$colDescrs, 'added:s.20'; push @$colDescrs, 'added2:s.20'; $metaDB->schemaAddColumns('test2', - ['added:s.20', 'added2:b'], - [{'added' => 'added'}, {'added2' => '1'}], - $colDescrs); + ['added:s.20', 'added2:b'], + [{'added' => 'added'}, {'added2' => '1'}], + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $colDescrs = [grep {$_ !~ m[dropped]} @$colDescrs]; @@ -114,93 +114,93 @@ $metaDB->schemaDropColumns('test2', ['dropped1', 'dropped2'], $colDescrs); $colDescrs = [ - map { - if ($_ =~ m[counter]) { - "count:i"; - } elsif ($_ =~ m[descr]) { - "description:s.30"; - } else { - $_ - } - } @$colDescrs + map { + if ($_ =~ m[counter]) { + "count:i"; + } elsif ($_ =~ m[descr]) { + "description:s.30"; + } else { + $_ + } + } @$colDescrs ]; $metaDB->schemaChangeColumns('test2', - { 'counter' => 'count:i', - 'descr' => 'description:s.30' }, - $colDescrs); + { 'counter' => 'count:i', + 'descr' => 'description:s.30' }, + $colDescrs); @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $metaDB->schemaDropTable('test2'); my $clientG01ID = addClient($openslxDB, { - 'name' => "PC-G-01", - 'mac' => "00:14:85:80:00:35", - 'boot_type' => 'pxe', + 'name' => "PC-G-01", + 'mac' => "00:14:85:80:00:35", + 'boot_type' => 'pxe', }); my $clientG02ID = addClient($openslxDB, { - 'name' => "PC-G-02", - 'mac' => "00:14:85:80:00:36", - 'boot_type' => 'pxe', + 'name' => "PC-G-02", + 'mac' => "00:14:85:80:00:36", + 'boot_type' => 'pxe', }); my $clientG03ID = addClient($openslxDB, { - 'name' => "PC-G-03", - 'mac' => "00:14:85:80:00:37", - 'boot_type' => 'pxe', + 'name' => "PC-G-03", + 'mac' => "00:14:85:80:00:37", + 'boot_type' => 'pxe', }); my $clientG04ID = addClient($openslxDB, { - 'name' => "PC-G-04", - 'mac' => "00:14:85:80:00:38", - 'boot_type' => 'pxe', - 'unbootable' => 1, + 'name' => "PC-G-04", + 'mac' => "00:14:85:80:00:38", + 'boot_type' => 'pxe', + 'unbootable' => 1, }); my $clientF01ID = addClient($openslxDB, { - 'name' => "PC-F-01", - 'mac' => "00:14:85:80:00:31", - 'boot_type' => 'other', + 'name' => "PC-F-01", + 'mac' => "00:14:85:80:00:31", + 'boot_type' => 'other', }); my $clientF02ID = addClient($openslxDB, { - 'name' => "PC-F-02", - 'mac' => "00:14:85:80:00:32", - 'boot_type' => 'pxe', + 'name' => "PC-F-02", + 'mac' => "00:14:85:80:00:32", + 'boot_type' => 'pxe', }); my $clientF03ID = addClient($openslxDB, { - 'name' => "PC-F-03", - 'mac' => "00:14:85:80:00:33", - 'boot_type' => 'pxe', + 'name' => "PC-F-03", + 'mac' => "00:14:85:80:00:33", + 'boot_type' => 'pxe', }); -addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); +addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); my $group1ID = addGroup($openslxDB, { - 'name' => "Gell-PCs", - 'descr' => "Gell-Threemansion PCs from 2002", - 'attrHwMouse' => 'serial', + 'name' => "Gell-PCs", + 'descr' => "Gell-Threemansion PCs from 2002", + 'attrHwMouse' => 'serial', }); addClientIDsToGroup($openslxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); my $group2ID = addGroup($openslxDB, { - 'name' => "Teacher-PCs", - 'descr' => "all PCs sitting on teacher's desks", - 'attrHwMonitor' => '1600x1200', + 'name' => "Teacher-PCs", + 'descr' => "all PCs sitting on teacher's desks", + 'attrHwMonitor' => '1600x1200', }); addClientIDsToGroup($openslxDB, $group2ID, [$clientG01ID, $clientF01ID]); addSystemIDsToGroup($openslxDB, $group2ID, [2, 3]); my $group3ID = addGroup($openslxDB, { - 'name' => "PCs in room G", - 'descr' => "all PCs of room 234", + 'name' => "PCs in room G", + 'descr' => "all PCs of room 234", }); addClientIDsToGroup($openslxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); diff --git a/config-db/devel-tools/test-config-demuxer.pl b/config-db/devel-tools/test-config-demuxer.pl index 8c1da03c..e212343f 100755 --- a/config-db/devel-tools/test-config-demuxer.pl +++ b/config-db/devel-tools/test-config-demuxer.pl @@ -13,7 +13,7 @@ use strict; use FindBin; use lib "$FindBin::RealBin/../../lib"; use lib "$FindBin::RealBin/.."; - # development path to config-db stuff + # development path to config-db stuff print "THIS IS CURRENTLY BROKEN!!!\n"; exit 5; @@ -24,46 +24,46 @@ use OpenSLX::ConfigDB qw(:access :manipulation); openslxInit(); $openslxConfig{'db-name'} = 'openslx_testscript'; - # make sure to use a database of our own! + # make sure to use a database of our own! my $openslxDB = connectConfigDB(); emptyDatabase($openslxDB); addVendorOS($openslxDB,{ - 'name' => "suse-10-minimal", - 'comment' => "SuSE 10 minimale Installation", - 'path' => "suse-10.0", - # relative to /var/lib/openslx/stage1 + 'name' => "suse-10-minimal", + 'comment' => "SuSE 10 minimale Installation", + 'path' => "suse-10.0", + # relative to /var/lib/openslx/stage1 }); addVendorOS($openslxDB, { - 'name' => "suse-10-KDE", - 'comment' => "SuSE 10 grafische Installation mit KDE", - 'path' => "suse-10.0", + 'name' => "suse-10-KDE", + 'comment' => "SuSE 10 grafische Installation mit KDE", + 'path' => "suse-10.0", }); addVendorOS($openslxDB, { - 'name' => "debian-31", - 'comment' => "Debian 3.1 Default-Installation", + 'name' => "debian-31", + 'comment' => "Debian 3.1 Default-Installation", }); my @systems; foreach my $id (1..10) { - push @systems, { - 'name' => "name of $id", - 'label' => "label of $id", - 'comment' => "comment of $id", - 'vendor_os_id' => 1 + $id % 3, - 'ramfs_debug_level' => $id%2, - 'ramfs_use_glibc' => 0, - 'ramfs_use_busybox' => 0, - 'ramfs_nicmods' => ($id % 3) ? 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32' : '', - 'ramfs_fsmods' => ($id % 3)==2 ? 'nbd ext3 nfs reiserfs xfs' : '', - 'kernel' => "boot/vmlinuz-2.6.13-15-default", - 'kernel_params' => "splash=silent", - 'export_type' => 'nfs', - }; + push @systems, { + 'name' => "name of $id", + 'label' => "label of $id", + 'comment' => "comment of $id", + 'vendor_os_id' => 1 + $id % 3, + 'ramfs_debug_level' => $id%2, + 'ramfs_use_glibc' => 0, + 'ramfs_use_busybox' => 0, + 'ramfs_nicmods' => ($id % 3) ? 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32' : '', + 'ramfs_fsmods' => ($id % 3)==2 ? 'nbd ext3 nfs reiserfs xfs' : '', + 'kernel' => "boot/vmlinuz-2.6.13-15-default", + 'kernel_params' => "splash=silent", + 'export_type' => 'nfs', + }; } addSystem($openslxDB, \@systems); @@ -80,31 +80,31 @@ changeSystem($openslxDB, 4, { 'id' => 114, 'name' => 'id should still be 4'} ); my $metaDB = $openslxDB->{'meta-db'}; my $colDescrs = [ - 'id:pk', - 'name:s.30', - 'comment:s.1024', - 'counter:i', - 'hidden:b', - 'dropped1:b', - 'dropped2:b', + 'id:pk', + 'name:s.30', + 'comment:s.1024', + 'counter:i', + 'hidden:b', + 'dropped1:b', + 'dropped2:b', ]; my $initialVals = [ - { - 'name' => '123456789012345678901234567890xxx', - 'comment' => 'comment-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', - 'counter' => 34567, - 'hidden' => 1, - 'dropped1' => 0, - 'dropped2' => 1, - }, - { - 'name' => 'name', - 'comment' => q[from_äöüß#'"$...\to_here], - 'counter' => -1, - 'hidden' => 0, - 'dropped1' => 1, - 'dropped2' => 0, - }, + { + 'name' => '123456789012345678901234567890xxx', + 'comment' => 'comment-value-XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', + 'counter' => 34567, + 'hidden' => 1, + 'dropped1' => 0, + 'dropped2' => 1, + }, + { + 'name' => 'name', + 'comment' => q[from_äöüß#'"$...\to_here], + 'counter' => -1, + 'hidden' => 0, + 'dropped1' => 1, + 'dropped2' => 0, + }, ]; @@ -115,15 +115,15 @@ $metaDB->schemaRenameTable('test', 'test2', $colDescrs); push @$colDescrs, 'added:s.20'; push @$colDescrs, 'added2:s.20'; $metaDB->schemaAddColumns('test2', - ['added:s.20', 'added2:b'], - [{'added' => 'added'}, {'added2' => '1'}], - $colDescrs); + ['added:s.20', 'added2:b'], + [{'added' => 'added'}, {'added2' => '1'}], + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $colDescrs = [grep {$_ !~ m[dropped]} @$colDescrs]; @@ -131,94 +131,94 @@ $metaDB->schemaDropColumns('test2', ['dropped1', 'dropped2'], $colDescrs); $colDescrs = [ - map { - if ($_ =~ m[counter]) { - "count:i"; - } elsif ($_ =~ m[comment]) { - "description:s.30"; - } else { - $_ - } - } @$colDescrs + map { + if ($_ =~ m[counter]) { + "count:i"; + } elsif ($_ =~ m[comment]) { + "description:s.30"; + } else { + $_ + } + } @$colDescrs ]; $metaDB->schemaChangeColumns('test2', - { 'counter' => 'count:i', - 'comment' => 'description:s.30' }, - $colDescrs); + { 'counter' => 'count:i', + 'comment' => 'description:s.30' }, + $colDescrs); my @rows = $metaDB->_doSelect("SELECT * FROM test2"); foreach my $row (@rows) { - foreach my $r (keys %$row) { - print "$r = $row->{$r}\n"; - } + foreach my $r (keys %$row) { + print "$r = $row->{$r}\n"; + } } $metaDB->schemaDropTable('test2'); my $clientG01ID = addClient($openslxDB, { - 'name' => "PC-G-01", - 'mac' => "00:50:56:0D:03:35", - 'boot_type' => 'pxe', + 'name' => "PC-G-01", + 'mac' => "00:50:56:0D:03:35", + 'boot_type' => 'pxe', }); my $clientG02ID = addClient($openslxDB, { - 'name' => "PC-G-02", - 'mac' => "00:50:56:0D:03:36", - 'boot_type' => 'pxe', - 'unbootable' => 1, + 'name' => "PC-G-02", + 'mac' => "00:50:56:0D:03:36", + 'boot_type' => 'pxe', + 'unbootable' => 1, }); my $clientG03ID = addClient($openslxDB, { - 'name' => "PC-G-03", - 'mac' => "00:50:56:0D:03:37", - 'boot_type' => 'pxe', + 'name' => "PC-G-03", + 'mac' => "00:50:56:0D:03:37", + 'boot_type' => 'pxe', }); my $clientG04ID = addClient($openslxDB, { - 'name' => "PC-G-04", - 'mac' => "00:50:56:0D:03:38", - 'boot_type' => 'pxe', - 'kernel_params' => 'console=ttyS0,19200', + 'name' => "PC-G-04", + 'mac' => "00:50:56:0D:03:38", + 'boot_type' => 'pxe', + 'kernel_params' => 'console=ttyS0,19200', }); my $clientF01ID = addClient($openslxDB, { - 'name' => "PC-F-01", - 'mac' => "00:50:56:0D:03:31", - 'boot_type' => 'other', + 'name' => "PC-F-01", + 'mac' => "00:50:56:0D:03:31", + 'boot_type' => 'other', }); my $clientF02ID = addClient($openslxDB, { - 'name' => "PC-F-02", - 'mac' => "00:50:56:0D:03:32", - 'boot_type' => 'pxe', + 'name' => "PC-F-02", + 'mac' => "00:50:56:0D:03:32", + 'boot_type' => 'pxe', }); my $clientF03ID = addClient($openslxDB, { - 'name' => "PC-F-03", - 'mac' => "00:50:56:0D:03:33", - 'boot_type' => 'pxe', + 'name' => "PC-F-03", + 'mac' => "00:50:56:0D:03:33", + 'boot_type' => 'pxe', }); -addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); +addClientIDsToSystem($openslxDB, 6, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID, $clientF01ID, $clientF02ID, $clientF03ID]); my $group1ID = addGroup($openslxDB, { - 'name' => "Gell-PCs", - 'comment' => "Gell-Threemansion PCs from 2002", - 'attr_hw_mouse' => 'serial', + 'name' => "Gell-PCs", + 'comment' => "Gell-Threemansion PCs from 2002", + 'attr_hw_mouse' => 'serial', }); addClientIDsToGroup($openslxDB, $group1ID, [$clientG01ID, $clientF02ID, $clientG03ID]); my $group2ID = addGroup($openslxDB, { - 'name' => "Teacher-PCs", - 'comment' => "all PCs sitting on teacher's desks", - 'attr_hw_monitor' => '1600x1200', + 'name' => "Teacher-PCs", + 'comment' => "all PCs sitting on teacher's desks", + 'attr_hw_monitor' => '1600x1200', }); addClientIDsToGroup($openslxDB, $group2ID, [$clientG01ID, $clientF01ID]); addSystemIDsToGroup($openslxDB, $group2ID, [2, 3]); my $group3ID = addGroup($openslxDB, { - 'name' => "PCs in room G", - 'comment' => "all PCs of room 234", + 'name' => "PCs in room G", + 'comment' => "all PCs of room 234", }); addClientIDsToGroup($openslxDB, $group3ID, [$clientG01ID, $clientG02ID, $clientG03ID, $clientG04ID]); diff --git a/config-db/slxconfig b/config-db/slxconfig index 8900a3c1..8453b6b9 100755 --- a/config-db/slxconfig +++ b/config-db/slxconfig @@ -17,7 +17,7 @@ my $abstract = q[ slxconfig This script can be used to display or change the OpenSLX configuration database. You can create systems that use a specific vendor-OS - and you can create clients for these systems, too. + and you can create clients for these systems, too. ]; use Getopt::Long qw(:config pass_through); @@ -44,28 +44,28 @@ use OpenSLX::Utils; my %option; GetOptions( - 'help|?' => \$option{helpReq}, - 'inherited' => \$option{inherited}, - 'man' => \$option{manReq}, - 'verbose' => \$option{verbose}, - 'version' => \$option{versionReq}, + 'help|?' => \$option{helpReq}, + 'inherited' => \$option{inherited}, + 'man' => \$option{manReq}, + 'verbose' => \$option{verbose}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } # if the user requested to see inherited attributes, we activate verbose mode, # too, such that we actually show attributes if ($option{inherited}) { - $option{verbose} = 1; + $option{verbose} = 1; } openslxInit(); @@ -75,1309 +75,1309 @@ $openslxDB->connect(); my $action = shift @ARGV || ''; if ($action =~ m[^add-c]i) { - addClientToConfigDB(@ARGV); + addClientToConfigDB(@ARGV); } elsif ($action =~ m[^add-g]i) { - addGroupToConfigDB(@ARGV); + addGroupToConfigDB(@ARGV); } elsif ($action =~ m[^add-s]i) { - addSystemToConfigDB(@ARGV); + addSystemToConfigDB(@ARGV); } elsif ($action =~ m[^change-v]i) { - changeVendorOSInConfigDB(@ARGV); + changeVendorOSInConfigDB(@ARGV); } elsif ($action =~ m[^change-e]i) { - changeExportInConfigDB(@ARGV); + changeExportInConfigDB(@ARGV); } elsif ($action =~ m[^change-g]i) { - changeGroupInConfigDB(@ARGV); + changeGroupInConfigDB(@ARGV); } elsif ($action =~ m[^change-s]i) { - changeSystemInConfigDB(@ARGV); + changeSystemInConfigDB(@ARGV); } elsif ($action =~ m[^change-c]i) { - changeClientInConfigDB(@ARGV); + changeClientInConfigDB(@ARGV); } elsif ($action =~ m[^list-a]) { - print @ARGV - ? _tr("List of known attributes for scope '%s':\n", $ARGV[0]) - : _tr("List of known attributes:\n"); - listAttributes(@ARGV); + print @ARGV + ? _tr("List of known attributes for scope '%s':\n", $ARGV[0]) + : _tr("List of known attributes:\n"); + listAttributes(@ARGV); } elsif ($action =~ m[^list-c]) { - print _tr("List of clients:\n"); - listClients(@ARGV); + print _tr("List of clients:\n"); + listClients(@ARGV); } elsif ($action =~ m[^list-e]) { - print _tr("List of exports:\n"); - listExports(@ARGV); + print _tr("List of exports:\n"); + listExports(@ARGV); } elsif ($action =~ m[^list-g]) { - print _tr("List of groups:\n"); - listGroups(@ARGV); + print _tr("List of groups:\n"); + listGroups(@ARGV); } elsif ($action =~ m[^list-s]) { - print _tr("List of systems:\n"); - listSystems(@ARGV); + print _tr("List of systems:\n"); + listSystems(@ARGV); } elsif ($action =~ m[^list-v]) { - print _tr("List of vendor-OSes:\n"); - listVendorOSes(@ARGV); + print _tr("List of vendor-OSes:\n"); + listVendorOSes(@ARGV); } elsif ($action =~ m[^search-c]) { - print _tr("Matching clients:\n"); - searchClients(@ARGV); + print _tr("Matching clients:\n"); + searchClients(@ARGV); } elsif ($action =~ m[^search-e]) { - print _tr("Matching exports:\n"); - searchExports(@ARGV); + print _tr("Matching exports:\n"); + searchExports(@ARGV); } elsif ($action =~ m[^search-g]) { - print _tr("Matching groups:\n"); - searchGroups(@ARGV); + print _tr("Matching groups:\n"); + searchGroups(@ARGV); } elsif ($action =~ m[^search-s]) { - print _tr("Matching systems:\n"); - searchSystems(@ARGV); + print _tr("Matching systems:\n"); + searchSystems(@ARGV); } elsif ($action =~ m[^search-v]) { - print _tr("Matching vendor-OSes:\n"); - searchVendorOSes(@ARGV); + print _tr("Matching vendor-OSes:\n"); + searchVendorOSes(@ARGV); } elsif ($action =~ m[^remove-c]i) { - removeClientFromConfigDB(@ARGV); + removeClientFromConfigDB(@ARGV); } elsif ($action =~ m[^remove-g]i) { - removeGroupFromConfigDB(@ARGV); + removeGroupFromConfigDB(@ARGV); } elsif ($action =~ m[^remove-s]i) { - removeSystemFromConfigDB(@ARGV); + removeSystemFromConfigDB(@ARGV); } else { - vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); - You need to specify exactly one of these actions: - add-client - add-group - add-system - change-client - change-export - change-group - change-system - change-vendor-os - list-attributes - list-client - list-export - list-group - list-system - list-vendor-os - remove-client - remove-group - remove-system - search-client - search-export - search-group - search-system - search-vendor-os - Try '%s --help' for more info. - END-OF-HERE + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one of these actions: + add-client + add-group + add-system + change-client + change-export + change-group + change-system + change-vendor-os + list-attributes + list-client + list-export + list-group + list-system + list-vendor-os + remove-client + remove-group + remove-system + search-client + search-export + search-group + search-system + search-vendor-os + Try '%s --help' for more info. + END-OF-HERE } $openslxDB->disconnect(); sub parseKeyValueArgs { - my $allowedKeys = shift; - my $table = shift; - - my %dataHash; - while (my $param = shift) { - if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { - die _tr( - "value specification %s has unknown format, expected =\n", - $param - ); - } - my $key = lc($1); - my $value = $2; - if (!grep { $_ eq $key } @$allowedKeys) { - die _tr("unknown key '%s' specified for %s\n", $key, $table); - } - - # replace escaped newlines and tab chars by the respective real thing - $value =~ s{\\n}{\n}gms; - $value =~ s{\\t}{\t}gms; - - # accept '-' as placeholder for undefined - if ($value eq '-') { - $value = undef; - } - - $dataHash{$key} = $value; - } - - return \%dataHash; + my $allowedKeys = shift; + my $table = shift; + + my %dataHash; + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + if (!grep { $_ eq $key } @$allowedKeys) { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + $dataHash{$key} = $value; + } + + return \%dataHash; } sub parseKeyValueArgsWithAttrs { - my $allowedKeys = shift; - my $allowedAttrKeys = shift; - my $table = shift; - - my (%dataHash, %attrHash); - while (my $param = shift) { - if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { - die _tr( - "value specification %s has unknown format, expected =\n", - $param - ); - } - my $key = lc($1); - my $value = $2; - - # replace escaped newlines and tab chars by the respective real thing - $value =~ s{\\n}{\n}gms; - $value =~ s{\\t}{\t}gms; - - # accept '-' as placeholder for undefined - if ($value eq '-') { - $value = undef; - } - - if (grep { $_ eq $key } @$allowedKeys) { - $dataHash{$key} = $value; - } elsif (grep { $_ eq $key } @$allowedAttrKeys) { - $attrHash{$key} = $value; - } else { - die _tr("unknown key '%s' specified for %s\n", $key, $table); - } - } - - if (wantarray) { - return (\%dataHash, \%attrHash); - } - else { - if (%attrHash) { - $dataHash{attrs} = \%attrHash; - } - return \%dataHash; - } + my $allowedKeys = shift; + my $allowedAttrKeys = shift; + my $table = shift; + + my (%dataHash, %attrHash); + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + if (grep { $_ eq $key } @$allowedKeys) { + $dataHash{$key} = $value; + } elsif (grep { $_ eq $key } @$allowedAttrKeys) { + $attrHash{$key} = $value; + } else { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + } + + if (wantarray) { + return (\%dataHash, \%attrHash); + } + else { + if (%attrHash) { + $dataHash{attrs} = \%attrHash; + } + return \%dataHash; + } } sub mergeNonExistingAttributes { - my $target = shift; - my $source = shift; + my $target = shift; + my $source = shift; - my $sourceAttrs = $source->{attrs} || {}; + my $sourceAttrs = $source->{attrs} || {}; - $target->{attrs} ||= {}; - my $targetAttrs = $target->{attrs}; + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; - foreach my $key (keys %$sourceAttrs) { - next if exists $targetAttrs->{$key}; - $targetAttrs->{$key} = $sourceAttrs->{$key}; - } + foreach my $key (keys %$sourceAttrs) { + next if exists $targetAttrs->{$key}; + $targetAttrs->{$key} = $sourceAttrs->{$key}; + } - return 1; + return 1; } sub dumpElements { - my $objName = shift; - my $nameClause = shift || sub { "\t$_->{name}\n" }; - - if ($option{verbose}) { - my $ind = ' ' x 4; - foreach my $elem (@_) { - print "$objName '$elem->{name}':\n"; - my $spcLen = max map { length($_) } keys %$elem; - print join( - '', - map { - my $elemVal = defined $elem->{$_} ? $elem->{$_} : '-'; - if (ref($elemVal) eq 'HASH') { - my $spcLen - = max(map { length($_) } keys %$elemVal) || 0; - my $spc = ' ' x $spcLen; - my $subLines = join( - "\n", - map { - my $spc = ' ' x $spcLen; - my $val - = defined $elemVal->{$_} - ? $elemVal->{$_} - : ''; - $val =~ s[\n][\n$ind$spc ]g; - "$ind$_" . substr($spc, length($_)) . " = $val"; - } - sort { - # drop [] construct (origin) from key for - # sorting purposes - (my $aa = $a) =~ s{^\s*\[.+\]\s*}{}; - (my $bb = $b) =~ s{^\s*\[.+\]\s*}{}; - return $aa cmp $bb; - } keys %$elemVal - ); - $subLines ||= "$ind"; - " $_:\n$subLines\n"; - } elsif (ref($elemVal) eq 'ARRAY') { - my $subLines - = join( "\n", map { "$ind$_" } sort @$elemVal); - $subLines ||= "$ind"; - " $_:\n$subLines\n"; - } else { - my $spc = ' ' x $spcLen; - $elemVal =~ s[\n][\n$ind$spc ]g; - "$ind$_" . substr($spc, length($_)) . " = $elemVal\n"; - } - } - sort { - my $refCmp = ref($elem->{$a}) cmp ref($elem->{$b}); - return $refCmp ? $refCmp : $a cmp $b; - } - grep { - $_ ne 'name'; - } - keys %$elem - ); - } - } - else { - print join('', sort map { $nameClause->($_); } @_); - } - - return 1; + my $objName = shift; + my $nameClause = shift || sub { "\t$_->{name}\n" }; + + if ($option{verbose}) { + my $ind = ' ' x 4; + foreach my $elem (@_) { + print "$objName '$elem->{name}':\n"; + my $spcLen = max map { length($_) } keys %$elem; + print join( + '', + map { + my $elemVal = defined $elem->{$_} ? $elem->{$_} : '-'; + if (ref($elemVal) eq 'HASH') { + my $spcLen + = max(map { length($_) } keys %$elemVal) || 0; + my $spc = ' ' x $spcLen; + my $subLines = join( + "\n", + map { + my $spc = ' ' x $spcLen; + my $val + = defined $elemVal->{$_} + ? $elemVal->{$_} + : ''; + $val =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $val"; + } + sort { + # drop [] construct (origin) from key for + # sorting purposes + (my $aa = $a) =~ s{^\s*\[.+\]\s*}{}; + (my $bb = $b) =~ s{^\s*\[.+\]\s*}{}; + return $aa cmp $bb; + } keys %$elemVal + ); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } elsif (ref($elemVal) eq 'ARRAY') { + my $subLines + = join( "\n", map { "$ind$_" } sort @$elemVal); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } else { + my $spc = ' ' x $spcLen; + $elemVal =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $elemVal\n"; + } + } + sort { + my $refCmp = ref($elem->{$a}) cmp ref($elem->{$b}); + return $refCmp ? $refCmp : $a cmp $b; + } + grep { + $_ ne 'name'; + } + keys %$elem + ); + } + } + else { + print join('', sort map { $nameClause->($_); } @_); + } + + return 1; } sub listAttributes { - my $scope = shift; - - my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo( { scope => $scope } ); - dumpElements( - 'attribute', undef, - map { - my $attr = dclone($attrInfo->{$_}); - $attr->{name} = $_; - delete $attr->{content_regex}; # no use for display purposes - $attr; - } - sort keys %$attrInfo - ); - - return 1; + my $scope = shift; + + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo( { scope => $scope } ); + dumpElements( + 'attribute', undef, + map { + my $attr = dclone($attrInfo->{$_}); + $attr->{name} = $_; + delete $attr->{content_regex}; # no use for display purposes + $attr; + } + sort keys %$attrInfo + ); + + return 1; } sub listClients { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'client', undef, - _expandClients( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByFilter(\%nameSpec) - ) - ); + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listGroups { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'group', undef, - _expandGroups( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchGroupByFilter(\%nameSpec) - ) - ); + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listExports { - my $name = _cleanName(shift); - - my %nameSpec; - - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } - - dumpElements( - 'export', - sub { - "\t$_->{name}" - . substr(' ' x 30, length($_->{name})) - . "($_->{type})\n"; - }, - map { - my $vendorOS = - $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); - if (defined $vendorOS) { - $_->{vendor_os_id} .= " ($vendorOS->{name})"; - } - $_; - } - sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } - $openslxDB->fetchExportByFilter(\%nameSpec) - ); - - return 1; + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter(\%nameSpec) + ); + + return 1; } sub listSystems { - my $name = _cleanName(shift); + my $name = _cleanName(shift); - my %nameSpec; + my %nameSpec; - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } - dumpElements( - 'system', undef, - _expandSystems( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByFilter(\%nameSpec) - ) - ); + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter(\%nameSpec) + ) + ); - return 1; + return 1; } sub listVendorOSes { - my $name = _cleanName(shift); - - my %nameSpec; - - # set verbose mode if any params have been passed in: - if (defined $name) { - $option{verbose} = 1; - $nameSpec{name} = $name; - } - - dumpElements('vendor-OS', undef, - map { - my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); - $_->{plugins} - = @plugins - ? join(',', sort map { $_->{plugin_name} } @plugins) - : ''; - $_; - } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchVendorOSByFilter(\%nameSpec)); - - return 1; + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements('vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + $_->{plugins} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter(\%nameSpec)); + + return 1; } sub searchClients { - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my ($clientData, $clientAttrs) = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$clientData; - - dumpElements( - 'client', undef, - _expandClients( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByFilter($clientData, undef, $clientAttrs) - ) - ); - - return 1; + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($clientData, $clientAttrs) = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$clientData; + + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter($clientData, undef, $clientAttrs) + ) + ); + + return 1; } sub searchGroups { - my @groupKeys = $openslxDB->getColumnsOfTable('groups'); - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my ($groupData, $groupAttrs) = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$groupData; - - dumpElements( - 'group', undef, - _expandGroups( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchGroupByFilter($groupData, undef, $groupAttrs) - ) - ); - - return 1; + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($groupData, $groupAttrs) = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$groupData; + + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter($groupData, undef, $groupAttrs) + ) + ); + + return 1; } sub searchExports { - my @exportKeys = $openslxDB->getColumnsOfTable('export'); - my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$exportData; - - dumpElements( - 'export', - sub { - "\t$_->{name}" - . substr(' ' x 30, length($_->{name})) - . "($_->{type})\n"; - }, - map { - my $vendorOS = - $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); - if (defined $vendorOS) { - $_->{vendor_os_id} .= " ($vendorOS->{name})"; - } - $_; - } - sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } - $openslxDB->fetchExportByFilter($exportData) - ); - - return 1; + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$exportData; + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter($exportData) + ); + + return 1; } sub searchSystems { - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my ($systemData, $systemAttrs) = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$systemData; - - dumpElements( - 'system', undef, - _expandSystems( - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByFilter($systemData, undef, $systemAttrs) - ) - ); - - return 1; + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my ($systemData, $systemAttrs) = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$systemData; + + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter($systemData, undef, $systemAttrs) + ) + ); + + return 1; } sub searchVendorOSes { - my @vendorOSKeys = $openslxDB->getColumnsOfTable('vendor_os'); - my $vendorOSData = parseKeyValueArgs(\@vendorOSKeys, 'vendor_os', @_); - - # set verbose mode if any params have been passed in: - $option{verbose} = 1 if %$vendorOSData; - - dumpElements( - 'vendor-OS', undef, - map { - my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); - $_->{plugins} - = @plugins - ? join(',', sort map { $_->{plugin_name} } @plugins) - : ''; - $_; - } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchVendorOSByFilter($vendorOSData) - ); - - return 1; + my @vendorOSKeys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@vendorOSKeys, 'vendor_os', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$vendorOSData; + + dumpElements( + 'vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + $_->{plugins} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter($vendorOSData) + ); + + return 1; } sub changeVendorOSInConfigDB { - my $vendorOSName = _cleanName(shift || ''); + my $vendorOSName = _cleanName(shift || ''); - if (!length($vendorOSName)) { - die _tr( - "you have to specify the name for the vendor-OS you'd like to change!\n" - ); - } + if (!length($vendorOSName)) { + die _tr( + "you have to specify the name for the vendor-OS you'd like to change!\n" + ); + } - my @keys = $openslxDB->getColumnsOfTable('vendor_os'); - my $vendorOSData = parseKeyValueArgs(\@keys, 'vendor_os', @_); + my @keys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@keys, 'vendor_os', @_); - my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); - if (!defined $vendorOS) { - die _tr("the vendor-OS '%s' doesn't exists in the DB, giving up!\n", - $vendorOSName); - } + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (!defined $vendorOS) { + die _tr("the vendor-OS '%s' doesn't exists in the DB, giving up!\n", + $vendorOSName); + } - $openslxDB->changeVendorOS($vendorOS->{id}, [$vendorOSData]); - vlog( - 0, _tr("vendor-OS '%s' has been successfully changed\n", $vendorOSName) - ); + $openslxDB->changeVendorOS($vendorOS->{id}, [$vendorOSData]); + vlog( + 0, _tr("vendor-OS '%s' has been successfully changed\n", $vendorOSName) + ); - listVendorOSes("id=$vendorOS->{id}") if $option{verbose}; + listVendorOSes("id=$vendorOS->{id}") if $option{verbose}; - return 1; + return 1; } sub changeExportInConfigDB { - my $exportName = _cleanName(shift || ''); + my $exportName = _cleanName(shift || ''); - if (!length($exportName)) { - die _tr( - "you have to specify the name for the export you'd like to change!\n" - ); - } + if (!length($exportName)) { + die _tr( + "you have to specify the name for the export you'd like to change!\n" + ); + } - my @exportKeys = $openslxDB->getColumnsOfTable('export'); - my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); - if (!defined $export) { - die _tr("the export '%s' doesn't exists in the DB, giving up!\n", - $exportName); - } + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("the export '%s' doesn't exists in the DB, giving up!\n", + $exportName); + } - $openslxDB->changeExport($export->{id}, [$exportData]); - vlog(0, _tr("export '%s' has been successfully changed\n", $exportName)); + $openslxDB->changeExport($export->{id}, [$exportData]); + vlog(0, _tr("export '%s' has been successfully changed\n", $exportName)); - listExports("id=$export->{id}") if $option{verbose}; + listExports("id=$export->{id}") if $option{verbose}; - return 1; + return 1; } sub addClientToConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr("you have to specify the name for the new client\n"); - } - - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - push @clientKeys, 'systems'; - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $clientData = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - $clientData->{name} = $clientName; - - my @systemIDs; - if (exists $clientData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split '\s*,\s*', $clientData->{systems}; - delete $clientData->{systems}; - } - - if (!$clientData->{mac}) { - die _tr("you have to specify the MAC for the new client\n"); - } - if ($clientData->{mac} !~ - m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) - { - die _tr( - "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" - ); - } - - if ($openslxDB->fetchClientByFilter({'name' => $clientName})) { - die _tr("the client '%s' already exists in the DB, giving up!\n", - $clientName); - } - if ($openslxDB->fetchClientByFilter({'mac' => $clientData->{mac}})) { - die _tr( - "a client with the MAC '%s' already exists in the DB, giving up!\n", - $clientData->{mac} - ); - } - my $clientID = $openslxDB->addClient([$clientData]); - vlog( - 0, - _tr( - "client '%s' has been successfully added to DB (ID=%s)\n", - $clientName, $clientID - ) - ); - if (@systemIDs) { - $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); - } - if ($option{verbose}) { - listClients("id=$clientID"); - } - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr("you have to specify the name for the new client\n"); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + $clientData->{name} = $clientName; + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $clientData->{systems}; + delete $clientData->{systems}; + } + + if (!$clientData->{mac}) { + die _tr("you have to specify the MAC for the new client\n"); + } + if ($clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + if ($openslxDB->fetchClientByFilter({'name' => $clientName})) { + die _tr("the client '%s' already exists in the DB, giving up!\n", + $clientName); + } + if ($openslxDB->fetchClientByFilter({'mac' => $clientData->{mac}})) { + die _tr( + "a client with the MAC '%s' already exists in the DB, giving up!\n", + $clientData->{mac} + ); + } + my $clientID = $openslxDB->addClient([$clientData]); + vlog( + 0, + _tr( + "client '%s' has been successfully added to DB (ID=%s)\n", + $clientName, $clientID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); + } + if ($option{verbose}) { + listClients("id=$clientID"); + } + + return 1; } sub addGroupToConfigDB { - my $groupName = _cleanName(shift || ''); - if (!length($groupName)) { - die _tr("you have to specify the name for the new group\n"); - } - - my @groupKeys = $openslxDB->getColumnsOfTable('groups'); - push @groupKeys, 'systems', 'clients'; - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $groupData = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - $groupData->{name} = $groupName; - - my @systemIDs; - if (exists $groupData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split '\s*,\s*', $groupData->{systems}; - delete $groupData->{systems}; - } - my @clientIDs; - if (exists $groupData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split '\s*,\s*', $groupData->{clients}; - delete $groupData->{clients}; - } - - if (!defined $groupData->{priority} || !length($groupData->{priority})) { - $groupData->{priority} = 50; - vlog(0, _tr("priority of new group has been set to default (50).")); - } - - if ($openslxDB->fetchGroupByFilter({'name' => $groupName})) { - die _tr("the group '%s' already exists in the DB, giving up!\n", - $groupName); - } - my $groupID = $openslxDB->addGroup([$groupData]); - vlog( - 0, - _tr( - "group '%s' has been successfully added to DB (ID=%s)\n", - $groupName, $groupID - ) - ); - if (@systemIDs) { - $openslxDB->addSystemIDsToGroup($groupID, \@systemIDs); - } - if (@clientIDs) { - $openslxDB->addClientIDsToGroup($groupID, \@clientIDs); - } - listGroups("id=$groupID") if $option{verbose}; - - return 1; + my $groupName = _cleanName(shift || ''); + if (!length($groupName)) { + die _tr("you have to specify the name for the new group\n"); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + push @groupKeys, 'systems', 'clients'; + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + $groupData->{name} = $groupName; + + my @systemIDs; + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $groupData->{systems}; + delete $groupData->{systems}; + } + my @clientIDs; + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $groupData->{clients}; + delete $groupData->{clients}; + } + + if (!defined $groupData->{priority} || !length($groupData->{priority})) { + $groupData->{priority} = 50; + vlog(0, _tr("priority of new group has been set to default (50).")); + } + + if ($openslxDB->fetchGroupByFilter({'name' => $groupName})) { + die _tr("the group '%s' already exists in the DB, giving up!\n", + $groupName); + } + my $groupID = $openslxDB->addGroup([$groupData]); + vlog( + 0, + _tr( + "group '%s' has been successfully added to DB (ID=%s)\n", + $groupName, $groupID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToGroup($groupID, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->addClientIDsToGroup($groupID, \@clientIDs); + } + listGroups("id=$groupID") if $option{verbose}; + + return 1; } sub addSystemToConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr("you have to specify the name of the new system!\n"); - } - - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - push @systemKeys, 'clients', 'export'; - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my $systemData = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - $systemData->{name} = $systemName; - $systemData->{attrs} ||= {}; - - my $exportName = $systemData->{export} || ''; - delete $systemData->{export}; - if (!length($exportName)) { - $exportName = $systemName; - - # try falling back to given system name - } - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); - if (!defined $export) { - die _tr("export '%s' could not be found in DB, giving up!\n", - $exportName); - } - $systemData->{export_id} = $export->{id}; - - my @clientIDs; - if (exists $systemData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split '\s*,\s*', $systemData->{clients}; - delete $systemData->{clients}; - } - else { - # no clients given, so we add this system to the default client, - # which will make this system bootable by *all* clients (unless - # they are configured otherwise). - my $defaultClient = - $openslxDB->fetchClientByFilter({'name' => '<<>>'}); - push @clientIDs, $defaultClient->{id}; - } - - if ($openslxDB->fetchSystemByFilter({'name' => $systemName})) { - die _tr("the system '%s' already exists in the DB, giving up!\n", - $systemName); - } - - # activate kdm and X if system is based on kde: - if ($systemName =~ m[\bkde\b]) { - $systemData->{attrs}->{start_xdmcp} = 'kdm' - unless exists $systemData->{attrs}->{start_xdmcp}; - $systemData->{attrs}->{start_x} = 'yes' - unless exists $systemData->{attrs}->{start_x}; - } - # activate gdm and X if system is based on GNOME: - if ($systemName =~ m[\bgnome\b]) { - $systemData->{attrs}->{start_xdmcp} = 'gdm' - unless exists $systemData->{attrs}->{start_xdmcp}; - $systemData->{attrs}->{start_x} = 'yes' - unless exists $systemData->{attrs}->{start_x}; - } - - my $systemConfigPath = - "$openslxConfig{'private-path'}/config/$systemName/default"; - if (!-e $systemConfigPath) { - # create the default (empty) config folders for this system: - createConfigFolderForSystem($systemName); - } - - my $systemID = $openslxDB->addSystem([$systemData]); - vlog( - 0, - _tr( - "system '%s' has been successfully added to DB (ID=%s)\n", - $systemName, $systemID - ) - ); - if (@clientIDs) { - $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); - } - listSystems("id=$systemID") if $option{verbose}; - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr("you have to specify the name of the new system!\n"); + } + + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'export'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + $systemData->{name} = $systemName; + $systemData->{attrs} ||= {}; + + my $exportName = $systemData->{export} || ''; + delete $systemData->{export}; + if (!length($exportName)) { + $exportName = $systemName; + + # try falling back to given system name + } + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("export '%s' could not be found in DB, giving up!\n", + $exportName); + } + $systemData->{export_id} = $export->{id}; + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $systemData->{clients}; + delete $systemData->{clients}; + } + else { + # no clients given, so we add this system to the default client, + # which will make this system bootable by *all* clients (unless + # they are configured otherwise). + my $defaultClient = + $openslxDB->fetchClientByFilter({'name' => '<<>>'}); + push @clientIDs, $defaultClient->{id}; + } + + if ($openslxDB->fetchSystemByFilter({'name' => $systemName})) { + die _tr("the system '%s' already exists in the DB, giving up!\n", + $systemName); + } + + # activate kdm and X if system is based on kde: + if ($systemName =~ m[\bkde\b]) { + $systemData->{attrs}->{start_xdmcp} = 'kdm' + unless exists $systemData->{attrs}->{start_xdmcp}; + $systemData->{attrs}->{start_x} = 'yes' + unless exists $systemData->{attrs}->{start_x}; + } + # activate gdm and X if system is based on GNOME: + if ($systemName =~ m[\bgnome\b]) { + $systemData->{attrs}->{start_xdmcp} = 'gdm' + unless exists $systemData->{attrs}->{start_xdmcp}; + $systemData->{attrs}->{start_x} = 'yes' + unless exists $systemData->{attrs}->{start_x}; + } + + my $systemConfigPath = + "$openslxConfig{'private-path'}/config/$systemName/default"; + if (!-e $systemConfigPath) { + # create the default (empty) config folders for this system: + createConfigFolderForSystem($systemName); + } + + my $systemID = $openslxDB->addSystem([$systemData]); + vlog( + 0, + _tr( + "system '%s' has been successfully added to DB (ID=%s)\n", + $systemName, $systemID + ) + ); + if (@clientIDs) { + $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); + } + listSystems("id=$systemID") if $option{verbose}; + + return 1; } sub changeClientInConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr( - "you have to specify the name of the client you'd like to change!\n" - ); - } - - my @clientKeys = $openslxDB->getColumnsOfTable('client'); - push @clientKeys, 'systems', 'add-systems', 'remove-systems'; - my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $clientData = parseKeyValueArgsWithAttrs( - \@clientKeys, \@clientAttrKeys, 'client', @_ - ); - - my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("the client '%s' doesn't exists in the DB, giving up!\n", - $clientName); - } - - mergeNonExistingAttributes($clientData, $client); - - my @systemIDs; - if (exists $clientData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $clientData->{systems}; - delete $clientData->{systems}; - } - if (exists $clientData->{'add-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); - push @systemIDs, map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $clientData->{'add-systems'}; - delete $clientData->{'add-systems'}; - } - if (exists $clientData->{'remove-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); - foreach my $sysName (split ",", $clientData->{'remove-systems'}) { - my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $sysName); - } - @systemIDs = grep { $_ != $system->{id} } @systemIDs; - } - delete $clientData->{'remove-systems'}; - } - - if ($clientData->{name} && $client->{name} eq '<<>>') { - die _tr( - "you can't rename the default client - no changes were made!\n"); - } - - if ( $clientData->{mac} - && $clientData->{mac} !~ - m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) - { - die _tr( - "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" - ); - } - - $openslxDB->changeClient($client->{id}, [$clientData]); - vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); - if (@systemIDs) { - $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); - } - listClients("id=$client->{id}") if $option{verbose}; - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to change!\n" + ); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems', 'add-systems', 'remove-systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + + mergeNonExistingAttributes($clientData, $client); + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{systems}; + delete $clientData->{systems}; + } + if (exists $clientData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{'add-systems'}; + delete $clientData->{'add-systems'}; + } + if (exists $clientData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + foreach my $sysName (split ",", $clientData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $clientData->{'remove-systems'}; + } + + if ($clientData->{name} && $client->{name} eq '<<>>') { + die _tr( + "you can't rename the default client - no changes were made!\n"); + } + + if ( $clientData->{mac} + && $clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + $openslxDB->changeClient($client->{id}, [$clientData]); + vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); + } + listClients("id=$client->{id}") if $option{verbose}; + + return 1; } sub changeGroupInConfigDB { - my $groupName = _cleanName(shift || ''); - - if (!length($groupName)) { - die _tr( - "you have to specify the name of the group you'd like to change!\n" - ); - } - - my @groupKeys = $openslxDB->getColumnsOfTable('group'); - push @groupKeys, qw( - systems add-systems remove-systems clients add-clients remove-clients - ); - my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); - my $groupData = parseKeyValueArgsWithAttrs( - \@groupKeys, \@groupAttrKeys, 'group', @_ - ); - - my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); - if (!defined $group) { - die _tr("the group '%s' doesn't exists in the DB, giving up!\n", - $groupName); - } - - mergeNonExistingAttributes($groupData, $group); - - my (@systemIDs, @clientIDs); - if (exists $groupData->{systems}) { - @systemIDs = map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $groupData->{systems}; - delete $groupData->{systems}; - } - if (exists $groupData->{'add-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); - push @systemIDs, map { - my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $_); - } - $system->{id}; - } - split ",", $groupData->{'add-systems'}; - delete $groupData->{'add-systems'}; - } - if (exists $groupData->{'remove-systems'}) { - @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); - foreach my $sysName (split ',', $groupData->{'remove-systems'}) { - my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); - if (!defined $system) { - die _tr("system '%s' doesn't exist!\n", $sysName); - } - @systemIDs = grep { $_ != $system->{id} } @systemIDs; - } - delete $groupData->{'remove-systems'}; - } - if (exists $groupData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split ",", $groupData->{clients}; - delete $groupData->{clients}; - } - if (exists $groupData->{'add-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); - push @clientIDs, map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $_); - } - $client->{id}; - } - split ",", $groupData->{'add-clients'}; - delete $groupData->{'add-clients'}; - } - if (exists $groupData->{'remove-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); - foreach my $clientName (split ",", $groupData->{'remove-clients'}) { - my $client = - $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $clientName); - } - @clientIDs = grep { $_ != $client->{id} } @clientIDs; - } - delete $groupData->{'remove-clients'}; - } - - if (defined $groupData->{priority} && $groupData->{priority} !~ m{^\d+$}) { - die _tr("unknown priority-format given, expected an integer!\n"); - } - - $openslxDB->changeGroup($group->{id}, [$groupData]); - vlog(0, _tr("group '%s' has been successfully changed\n", $groupName)); - if (@systemIDs) { - $openslxDB->setSystemIDsOfGroup($group->{id}, \@systemIDs); - } - if (@clientIDs) { - $openslxDB->setClientIDsOfGroup($group->{id}, \@clientIDs); - } - listGroups("id=$group->{id}") if $option{verbose}; - - return 1; + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to change!\n" + ); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('group'); + push @groupKeys, qw( + systems add-systems remove-systems clients add-clients remove-clients + ); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + + mergeNonExistingAttributes($groupData, $group); + + my (@systemIDs, @clientIDs); + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{systems}; + delete $groupData->{systems}; + } + if (exists $groupData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{'add-systems'}; + delete $groupData->{'add-systems'}; + } + if (exists $groupData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + foreach my $sysName (split ',', $groupData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $groupData->{'remove-systems'}; + } + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{clients}; + delete $groupData->{clients}; + } + if (exists $groupData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{'add-clients'}; + delete $groupData->{'add-clients'}; + } + if (exists $groupData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + foreach my $clientName (split ",", $groupData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $groupData->{'remove-clients'}; + } + + if (defined $groupData->{priority} && $groupData->{priority} !~ m{^\d+$}) { + die _tr("unknown priority-format given, expected an integer!\n"); + } + + $openslxDB->changeGroup($group->{id}, [$groupData]); + vlog(0, _tr("group '%s' has been successfully changed\n", $groupName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfGroup($group->{id}, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->setClientIDsOfGroup($group->{id}, \@clientIDs); + } + listGroups("id=$group->{id}") if $option{verbose}; + + return 1; } sub changeSystemInConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr( - "you have to specify the name of the system you'd like to change!\n" - ); - } - - my @systemKeys = $openslxDB->getColumnsOfTable('system'); - push @systemKeys, 'clients', 'add-clients', 'remove-clients'; - my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); - my $systemData = parseKeyValueArgsWithAttrs( - \@systemKeys, \@systemAttrKeys, 'system', @_ - ); - - my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); - if (!defined $system) { - die _tr("the system '%s' doesn't exists in the DB, giving up!\n", - $systemName); - } - - mergeNonExistingAttributes($systemData, $system); - - my @clientIDs; - if (exists $systemData->{clients}) { - @clientIDs = map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); - } - $client->{id}; - } - split ",", $systemData->{clients}; - delete $systemData->{clients}; - } - if (exists $systemData->{'add-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); - push @clientIDs, map { - my $client = $openslxDB->fetchClientByFilter({'name' => $_}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $_); - } - $client->{id}; - } - split ",", $systemData->{'add-clients'}; - delete $systemData->{'add-clients'}; - } - if (exists $systemData->{'remove-clients'}) { - @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); - foreach my $clientName (split ",", $systemData->{'remove-clients'}) { - my $client = - $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("client '%s' doesn't exist!\n", $clientName); - } - @clientIDs = grep { $_ != $client->{id} } @clientIDs; - } - delete $systemData->{'remove-clients'}; - } - if ($systemData->{name} && $system->{name} eq '<<>>') { - die _tr( - "you can't rename the default system - no changes were made!\n"); - } - - $openslxDB->changeSystem($system->{id}, $systemData); - vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); - if (@clientIDs) { - $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); - } - listSystems("id=$system->{id}")if $option{verbose}; - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to change!\n" + ); + } + + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'add-clients', 'remove-clients'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + + mergeNonExistingAttributes($systemData, $system); + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{clients}; + delete $systemData->{clients}; + } + if (exists $systemData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{'add-clients'}; + delete $systemData->{'add-clients'}; + } + if (exists $systemData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + foreach my $clientName (split ",", $systemData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $systemData->{'remove-clients'}; + } + if ($systemData->{name} && $system->{name} eq '<<>>') { + die _tr( + "you can't rename the default system - no changes were made!\n"); + } + + $openslxDB->changeSystem($system->{id}, $systemData); + vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); + if (@clientIDs) { + $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); + } + listSystems("id=$system->{id}")if $option{verbose}; + + return 1; } sub removeClientFromConfigDB { - my $clientName = _cleanName(shift || ''); - - if (!length($clientName)) { - die _tr( - "you have to specify the name of the client you'd like to remove!\n" - ); - } - - my $clientData = parseKeyValueArgs(['name'], 'client', @_); - - my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); - if (!defined $client) { - die _tr("the client '%s' doesn't exists in the DB, giving up!\n", - $clientName); - } - if ($client->{name} eq '<<>>') { - die _tr("you can't remove the default client!\n"); - } - $openslxDB->removeClient($client->{id}); - vlog(0, - _tr("client '%s' has been successfully removed from DB\n", $clientName) - ); - - return 1; + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to remove!\n" + ); + } + + my $clientData = parseKeyValueArgs(['name'], 'client', @_); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + if ($client->{name} eq '<<>>') { + die _tr("you can't remove the default client!\n"); + } + $openslxDB->removeClient($client->{id}); + vlog(0, + _tr("client '%s' has been successfully removed from DB\n", $clientName) + ); + + return 1; } sub removeGroupFromConfigDB { - my $groupName = _cleanName(shift || ''); - - if (!length($groupName)) { - die _tr( - "you have to specify the name of the group you'd like to remove!\n" - ); - } - - my $groupData = parseKeyValueArgs(['name'], 'group', @_); - - my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); - if (!defined $group) { - die _tr("the group '%s' doesn't exists in the DB, giving up!\n", - $groupName); - } - $openslxDB->removeGroup($group->{id}); - vlog(0, - _tr("group '%s' has been successfully removed from DB\n", $groupName) - ); - - return 1; + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to remove!\n" + ); + } + + my $groupData = parseKeyValueArgs(['name'], 'group', @_); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + $openslxDB->removeGroup($group->{id}); + vlog(0, + _tr("group '%s' has been successfully removed from DB\n", $groupName) + ); + + return 1; } sub removeSystemFromConfigDB { - my $systemName = _cleanName(shift || ''); - - if (!length($systemName)) { - die _tr( - "you have to specify the name of the system you'd like to remove!\n" - ); - } - - my $systemData = parseKeyValueArgs(['name'], 'system', @_); - - my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); - if (!defined $system) { - die _tr("the system '%s' doesn't exists in the DB, giving up!\n", - $systemName); - } - if ($system->{name} eq '<<>>') { - die _tr("you can't remove the default system!\n"); - } - $openslxDB->removeSystem($system->{id}); - vlog(0, - _tr("system '%s' has been successfully removed from DB\n", $systemName) - ); - - return 1; + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to remove!\n" + ); + } + + my $systemData = parseKeyValueArgs(['name'], 'system', @_); + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + if ($system->{name} eq '<<>>') { + die _tr("you can't remove the default system!\n"); + } + $openslxDB->removeSystem($system->{id}); + vlog(0, + _tr("system '%s' has been successfully removed from DB\n", $systemName) + ); + + return 1; } sub _expandClients -{ # expands info for given clients - return - map { - my @sysIDs = $openslxDB->fetchSystemIDsOfClient($_->{id}); - $_->{systems} - = join "\n", - map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByID(\@sysIDs, 'name'); - if ($option{inherited}) { - my $mergedClient = dclone($_); - my $originInfo = {}; - $openslxDB->mergeDefaultAndGroupAttributesIntoClient( - $mergedClient, $originInfo - ); - my $mergedAttrs = $mergedClient->{attrs} || {}; - $_->{attrs} = {}; - foreach my $attr (keys %$mergedAttrs) { - my $origin = $originInfo->{$attr}; - my $enhancedName = $origin ? "[$origin] $attr" : $attr; - $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; - } - } - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given clients + return + map { + my @sysIDs = $openslxDB->fetchSystemIDsOfClient($_->{id}); + $_->{systems} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@sysIDs, 'name'); + if ($option{inherited}) { + my $mergedClient = dclone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAndGroupAttributesIntoClient( + $mergedClient, $originInfo + ); + my $mergedAttrs = $mergedClient->{attrs} || {}; + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _expandGroups -{ # expands info for given groups - return - map { - my @systemIDs = $openslxDB->fetchSystemIDsOfGroup($_->{id}); - $_->{systems} - = join "\n", map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchSystemByID(\@systemIDs, 'name'); - my @clientIDs = $openslxDB->fetchClientIDsOfGroup($_->{id}); - $_->{clients} - = join "\n", map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByID(\@clientIDs, 'name'); - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given groups + return + map { + my @systemIDs = $openslxDB->fetchSystemIDsOfGroup($_->{id}); + $_->{systems} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@systemIDs, 'name'); + my @clientIDs = $openslxDB->fetchClientIDsOfGroup($_->{id}); + $_->{clients} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _expandSystems -{ # expands info for given systems - return - map { - my @clientIDs = $openslxDB->fetchClientIDsOfSystem($_->{id}); - $_->{clients} - = join "\n", - map { $_->{name} } - sort { $a->{name} cmp $b->{name} } - $openslxDB->fetchClientByID(\@clientIDs, 'name'); - my @activePlugins; - my $export = $openslxDB->fetchExportByID($_->{export_id}); - if (defined $export) { - $_->{export_id} - = "$export->{id} ($export->{name})"; - - # fetch detailed info about active plugins - my @installedPlugins = $openslxDB->fetchInstalledPlugins( - $export->{vendor_os_id} - ); - my $mergedSystem = dclone($_); - my $originInfo = {}; - $openslxDB->mergeDefaultAttributesIntoSystem( - $mergedSystem, \@installedPlugins, $originInfo - ); - my $mergedAttrs = $mergedSystem->{attrs} || {}; - foreach my $plugin (@installedPlugins) { - next if !$mergedAttrs->{"$plugin->{plugin_name}::active"}; - push @activePlugins, $plugin; - } - if ($option{inherited}) { - $_->{attrs} = {}; - foreach my $attr (keys %$mergedAttrs) { - my $origin = $originInfo->{$attr}; - my $enhancedName = $origin ? "[$origin] $attr" : $attr; - $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; - } - } - } - $_->{PLUGINS} = [ sort map { $_->{plugin_name} } @activePlugins ]; - # rename attrs to ATTRIBUTES for display - $_->{ATTRIBUTES} = $_->{attrs}; - delete $_->{attrs}; - $_; - } - @_; +{ # expands info for given systems + return + map { + my @clientIDs = $openslxDB->fetchClientIDsOfSystem($_->{id}); + $_->{clients} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + my @activePlugins; + my $export = $openslxDB->fetchExportByID($_->{export_id}); + if (defined $export) { + $_->{export_id} + = "$export->{id} ($export->{name})"; + + # fetch detailed info about active plugins + my @installedPlugins = $openslxDB->fetchInstalledPlugins( + $export->{vendor_os_id} + ); + my $mergedSystem = dclone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAttributesIntoSystem( + $mergedSystem, \@installedPlugins, $originInfo + ); + my $mergedAttrs = $mergedSystem->{attrs} || {}; + foreach my $plugin (@installedPlugins) { + next if !$mergedAttrs->{"$plugin->{plugin_name}::active"}; + push @activePlugins, $plugin; + } + if ($option{inherited}) { + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + } + $_->{PLUGINS} = [ sort map { $_->{plugin_name} } @activePlugins ]; + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; } sub _cleanName -{ # removes 'name=""' constructs from the name, as it is rather tempting - # for the user to type that ... (and we'd like to play along with DWIM) - my $name = shift; +{ # removes 'name=""' constructs from the name, as it is rather tempting + # for the user to type that ... (and we'd like to play along with DWIM) + my $name = shift; - return unless defined $name; + return unless defined $name; - if ($name =~ m[^name=(.+)$]) { - return $1; - } + if ($name =~ m[^name=(.+)$]) { + return $1; + } - return $name; + return $name; } =head1 NAME diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer index 03d2ca2e..f6592b88 100755 --- a/config-db/slxconfig-demuxer +++ b/config-db/slxconfig-demuxer @@ -11,7 +11,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # slxconfig-demuxer -# - OpenSLX configuration demultiplexer +# - OpenSLX configuration demultiplexer # ----------------------------------------------------------------------------- use strict; use warnings; @@ -54,54 +54,54 @@ use OpenSLX::MakeInitRamFS::Engine; use OpenSLX::Utils; my $pxeDefaultTemplate = unshiftHereDoc(<<'End-of-Here'); - NOESCAPE 0 - PROMPT 0 - TIMEOUT 10 - DEFAULT menu.c32 - IMPLICIT 1 - ALLOWOPTIONS 1 - MENU TITLE Was möchten Sie tun (Auswahl mittels Cursortasten)? - MENU MASTER PASSWD secret + NOESCAPE 0 + PROMPT 0 + TIMEOUT 10 + DEFAULT menu.c32 + IMPLICIT 1 + ALLOWOPTIONS 1 + MENU TITLE Was möchten Sie tun (Auswahl mittels Cursortasten)? + MENU MASTER PASSWD secret End-of-Here utf8::decode($pxeDefaultTemplate); my ( - $systemConfCount, - # number of system configurations written - $systemErrCount, - # number of systems that had errors - $clientSystemConfCount, - # number of (system-specific) client configurations written - $initramfsCount, - # number of initramfs that were created - @targetSystems, - # systems to create initramfs for, defaults to all systems - %option, - # cmdline option hash + $systemConfCount, + # number of system configurations written + $systemErrCount, + # number of systems that had errors + $clientSystemConfCount, + # number of (system-specific) client configurations written + $initramfsCount, + # number of initramfs that were created + @targetSystems, + # systems to create initramfs for, defaults to all systems + %option, + # cmdline option hash ); if ($> != 0) { - die _tr("Sorry, this script can only be executed by the superuser!\n"); + die _tr("Sorry, this script can only be executed by the superuser!\n"); } GetOptions( - 'dhcp-export-type=s' => \$option{dhcpType}, - 'dry-run' => \$option{dryRun}, - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'version' => \$option{versionReq}, + 'dhcp-export-type=s' => \$option{dhcpType}, + 'dry-run' => \$option{dryRun}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - slxsystem('slxversion'); - exit 1; + slxsystem('slxversion'); + exit 1; } my ($sec, $min, $hour, $day, $mon, $year) = (localtime); @@ -118,12 +118,12 @@ $openslxDB->connect(); my $clientConfigPath = "$openslxConfig{'private-path'}/config"; # make sure that the default config folders exist: if (createConfigFolderForDefaultSystem()) { - # this path should have been generated by earlier stage (slxsettings), so - # we indicate that there is some kind of problem: - warn _tr( - "Completed client-config-folder '%s', since at least some parts of it didn't exist!", - $clientConfigPath - ); + # this path should have been generated by earlier stage (slxsettings), so + # we indicate that there is some kind of problem: + warn _tr( + "Completed client-config-folder '%s', since at least some parts of it didn't exist!", + $clientConfigPath + ); } chomp(my $slxVersion = qx{slxversion}); @@ -133,55 +133,55 @@ my $haveLock = lockScript($lockFile); END { - unlockScript($lockFile) if $haveLock; + unlockScript($lockFile) if $haveLock; } my $tempPath = "$openslxConfig{'temp-path'}/slxconfig-demuxer"; if (!$option{dryRun}) { - rmtree($tempPath); - mkpath($tempPath); - if (!-d $tempPath) { - die _tr("Unable to create or access temp-path '%s'!", $tempPath); - } + rmtree($tempPath); + mkpath($tempPath); + if (!-d $tempPath) { + die _tr("Unable to create or access temp-path '%s'!", $tempPath); + } } my $tftpbootPath = "$openslxConfig{'public-path'}/tftpboot"; my $tftpbuildPath = "$openslxConfig{'public-path'}/tftpboot.new"; if (!$option{dryRun}) { - mkpath([$tftpbootPath]); - rmtree("$tftpbuildPath/pxelinux.cfg"); - mkpath(["$tftpbuildPath/client-config", "$tftpbuildPath/pxelinux.cfg"]); + mkpath([$tftpbootPath]); + rmtree("$tftpbuildPath/pxelinux.cfg"); + mkpath(["$tftpbuildPath/client-config", "$tftpbuildPath/pxelinux.cfg"]); } my $rsyncDeleteClause; my @demuxableSystems - = grep { $_->{name} ne '<<>>' } $openslxDB->fetchSystemByFilter(); + = grep { $_->{name} ne '<<>>' } $openslxDB->fetchSystemByFilter(); if (@ARGV) { - # create initramfs only for systems given on cmdline - for my $systemName (@ARGV) { - if ($systemName eq '<<>>') { - warn _tr( - 'The default-system can not be demuxed - it will be skipped.' - ); - next; - } - my $system = first { $_->{name} eq $systemName } @demuxableSystems; - if (!$system) { - warn _tr( - 'The system "%s" is unknown and will be ignored.', $systemName - ); - next; - } - push @targetSystems, $system; - } - $rsyncDeleteClause = ''; + # create initramfs only for systems given on cmdline + for my $systemName (@ARGV) { + if ($systemName eq '<<>>') { + warn _tr( + 'The default-system can not be demuxed - it will be skipped.' + ); + next; + } + my $system = first { $_->{name} eq $systemName } @demuxableSystems; + if (!$system) { + warn _tr( + 'The system "%s" is unknown and will be ignored.', $systemName + ); + next; + } + push @targetSystems, $system; + } + $rsyncDeleteClause = ''; } else { - # create initramfs for all systems - @targetSystems = @demuxableSystems; - # let rsync delete old files - $rsyncDeleteClause = '--delete'; + # create initramfs for all systems + @targetSystems = @demuxableSystems; + # let rsync delete old files + $rsyncDeleteClause = '--delete'; } writeConfigurations(); @@ -189,22 +189,22 @@ writeConfigurations(); my $wr = $option{dryRun} ? 'would have written' : 'wrote'; my $errCount = $systemErrCount ? $systemErrCount : 'no'; print "\n", unshiftHereDoc(<<"End-of-Here"); - $wr $systemConfCount system- and $clientSystemConfCount client-specific configurations to $tftpbootPath/client-config - $initramfsCount initramfs were created - $errCount system(s) had errors + $wr $systemConfCount system- and $clientSystemConfCount client-specific configurations to $tftpbootPath/client-config + $initramfsCount initramfs were created + $errCount system(s) had errors End-of-Here $openslxDB->disconnect(); if (!$option{dryRun}) { - rmtree([$tempPath]); - my $rsyncCmd = "rsync -a $rsyncDeleteClause --delay-updates $tftpbuildPath/ $tftpbootPath/"; - slxsystem($rsyncCmd) == 0 - or die _tr( - "unable to rsync files from '%s' to '%s'! (%s)", - $tftpbuildPath, $tftpbootPath, $! - ); - rmtree([$tftpbuildPath]); + rmtree([$tempPath]); + my $rsyncCmd = "rsync -a $rsyncDeleteClause --delay-updates $tftpbuildPath/ $tftpbootPath/"; + slxsystem($rsyncCmd) == 0 + or die _tr( + "unable to rsync files from '%s' to '%s'! (%s)", + $tftpbuildPath, $tftpbootPath, $! + ); + rmtree([$tftpbuildPath]); } exit; @@ -214,181 +214,181 @@ exit; ################################################################################ sub lockScript { - my $lockFile = shift; - - return if $option{dryRun}; - - # use a lock-file to singularize execution of this script: - if (-e $lockFile) { - my $ctime = (stat($lockFile))[10]; - my $now = time(); - if ($now - $ctime > 15 * 60) { - # existing lock file is older than 15 minutes, wipe it: - unlink $lockFile; - } - } - if (!sysopen(LOCKFILE, $lockFile, O_RDWR | O_CREAT | O_EXCL)) { - if ($! == 13) { - die _tr(qq[Unable to create lock-file <%s>, exiting!\n], $lockFile); - } else { - die _tr( - qq[Lock-file <%s> exists, script is already running. + my $lockFile = shift; + + return if $option{dryRun}; + + # use a lock-file to singularize execution of this script: + if (-e $lockFile) { + my $ctime = (stat($lockFile))[10]; + my $now = time(); + if ($now - $ctime > 15 * 60) { + # existing lock file is older than 15 minutes, wipe it: + unlink $lockFile; + } + } + if (!sysopen(LOCKFILE, $lockFile, O_RDWR | O_CREAT | O_EXCL)) { + if ($! == 13) { + die _tr(qq[Unable to create lock-file <%s>, exiting!\n], $lockFile); + } else { + die _tr( + qq[Lock-file <%s> exists, script is already running. Please remove the logfile and try again if you are sure that no one else is executing this script.\n], $lockFile - ); - } - } - return 1; + ); + } + } + return 1; } sub unlockScript { - my $lockFile = shift; + my $lockFile = shift; - return if $option{dryRun}; + return if $option{dryRun}; - close(LOCKFILE); - unlink $lockFile; + close(LOCKFILE); + unlink $lockFile; - return; + return; } sub folderContainsFiles { - my $folder = shift; - - return 0 unless -d $folder; - - my $result = 0; - my $wanted = sub { - if ($result) { - # skip anything else if we have found a file already - $File::Find::prune = 1; - } - $result = 1 if -f; - }; - find({wanted => $wanted, follow_fast => 1}, $folder); - vlog(2, "result for folderContainsFiles($folder): $result\n"); - return $result; + my $folder = shift; + + return 0 unless -d $folder; + + my $result = 0; + my $wanted = sub { + if ($result) { + # skip anything else if we have found a file already + $File::Find::prune = 1; + } + $result = 1 if -f; + }; + find({wanted => $wanted, follow_fast => 1}, $folder); + vlog(2, "result for folderContainsFiles($folder): $result\n"); + return $result; } sub digestAttributes -{ # returns a digest-string for the given attribute hash, in order to - # facilitate comparing different attribute hashes. - my $object = shift; - - my $attrs = $object->{attrs} || {}; - my $attrsAsString - = join ';', - map { "$_=$attrs->{$_}" } - sort - grep { defined $attrs->{$_} } - keys %$attrs; - - vlog(3, "Attribute-string: $attrsAsString"); - return md5_hex($attrsAsString); +{ # returns a digest-string for the given attribute hash, in order to + # facilitate comparing different attribute hashes. + my $object = shift; + + my $attrs = $object->{attrs} || {}; + my $attrsAsString + = join ';', + map { "$_=$attrs->{$_}" } + sort + grep { defined $attrs->{$_} } + keys %$attrs; + + vlog(3, "Attribute-string: $attrsAsString"); + return md5_hex($attrsAsString); } sub writeAttributesToFile { - my $object = shift; - my $fileName = shift; - - return if $option{dryRun}; - - my $content = "# attributes set by slxconfig-demuxer:\n"; - my $attrs = $object->{attrs} || {}; - # filter out any plugin-specific attributes (we only want to handle - # the attributes relevant to the core here) - my @attrs = sort grep { index($_, '::') == -1 } keys %$attrs; - foreach my $attr (@attrs) { - my $attrVal = $attrs->{$attr}; - next if !defined $attrVal; - $content .= qq[$attr="$attrVal"\n]; - } - # Overwrite attribute file even if it exists, to make sure that our users - # will never again try to fiddle with machine-setup directly the - # file-system. From now on the DB is the keeper of that info. - spitFile($fileName, $content); - if ($openslxConfig{'verbose-level'} > 2) { - vlog(0, "--- START OF $fileName ---"); - vlog(0, $content); - vlog(0, "--- END OF $fileName --- "); - } - return; + my $object = shift; + my $fileName = shift; + + return if $option{dryRun}; + + my $content = "# attributes set by slxconfig-demuxer:\n"; + my $attrs = $object->{attrs} || {}; + # filter out any plugin-specific attributes (we only want to handle + # the attributes relevant to the core here) + my @attrs = sort grep { index($_, '::') == -1 } keys %$attrs; + foreach my $attr (@attrs) { + my $attrVal = $attrs->{$attr}; + next if !defined $attrVal; + $content .= qq[$attr="$attrVal"\n]; + } + # Overwrite attribute file even if it exists, to make sure that our users + # will never again try to fiddle with machine-setup directly the + # file-system. From now on the DB is the keeper of that info. + spitFile($fileName, $content); + if ($openslxConfig{'verbose-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + return; } sub writeSlxConfigToFile { - my $slxConf = shift; - my $fileName = shift; + my $slxConf = shift; + my $fileName = shift; - return if $option{dryRun}; + return if $option{dryRun}; - my $content = ''; - foreach my $key (sort keys %$slxConf) { - $content .= qq[$key="$slxConf->{$key}"\n]; - } - spitFile($fileName, $content); - return; + my $content = ''; + foreach my $key (sort keys %$slxConf) { + $content .= qq[$key="$slxConf->{$key}"\n]; + } + spitFile($fileName, $content); + return; } sub copyExternalSystemConfig { # copies local configuration extensions of given system from private # config folder (var/lib/openslx/config/...) into a temporary folder - my $systemName = shift; - my $targetPath = shift; - my $clientName = shift; # optional - - if ($targetPath !~ m[$tempPath]) { - # bail if target-path isn't within temp folder, as we do not dare - # executing 'rm -rf' in that case! - die _tr("system-error: illegal target-path <%s>!", $targetPath); - } - return if $option{dryRun}; - - slxsystem("rm -rf $targetPath"); - mkpath $targetPath; - - # first copy default files ... - my $defaultConfigPath = "$clientConfigPath/default"; - vlog(2, "checking $defaultConfigPath for default config..."); - if (-d $defaultConfigPath) { - slxsystem("cp -a $defaultConfigPath/* $targetPath"); - } - # ... now pour system-specific configuration on top (if any): - my $systemSpecConfigPath = "$clientConfigPath/$systemName/default"; - vlog(2, "checking $systemSpecConfigPath for system config..."); - if (folderContainsFiles($systemSpecConfigPath)) { - slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); - } - if (defined $clientName) { - # client has been given, so we finally pour client-specific - # configuration on top (if any): - my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; - vlog(2, "checking $clientSpecConfigPath for client config..."); - if (folderContainsFiles($clientSpecConfigPath)) { - slxsystem("cp -a $clientSpecConfigPath/* $targetPath"); - } - } - return; + my $systemName = shift; + my $targetPath = shift; + my $clientName = shift; # optional + + if ($targetPath !~ m[$tempPath]) { + # bail if target-path isn't within temp folder, as we do not dare + # executing 'rm -rf' in that case! + die _tr("system-error: illegal target-path <%s>!", $targetPath); + } + return if $option{dryRun}; + + slxsystem("rm -rf $targetPath"); + mkpath $targetPath; + + # first copy default files ... + my $defaultConfigPath = "$clientConfigPath/default"; + vlog(2, "checking $defaultConfigPath for default config..."); + if (-d $defaultConfigPath) { + slxsystem("cp -a $defaultConfigPath/* $targetPath"); + } + # ... now pour system-specific configuration on top (if any): + my $systemSpecConfigPath = "$clientConfigPath/$systemName/default"; + vlog(2, "checking $systemSpecConfigPath for system config..."); + if (folderContainsFiles($systemSpecConfigPath)) { + slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); + } + if (defined $clientName) { + # client has been given, so we finally pour client-specific + # configuration on top (if any): + my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; + vlog(2, "checking $clientSpecConfigPath for client config..."); + if (folderContainsFiles($clientSpecConfigPath)) { + slxsystem("cp -a $clientSpecConfigPath/* $targetPath"); + } + } + return; } sub createTarOfPath { - my $buildPath = shift; - my $tarName = shift; - my $destinationPath = shift; - - my $tarFile = "$destinationPath/$tarName"; - vlog(1, _tr('creating tar %s', $tarFile)); - return if $option{dryRun}; - - mkpath $destinationPath; - my $tarCmd = "cd $buildPath && tar czf $tarFile *"; - if (slxsystem("$tarCmd") != 0) { - die _tr("unable to execute shell-command:\n\t%s \n\t(%s)", $tarCmd, $!); - } + my $buildPath = shift; + my $tarName = shift; + my $destinationPath = shift; + + my $tarFile = "$destinationPath/$tarName"; + vlog(1, _tr('creating tar %s', $tarFile)); + return if $option{dryRun}; + + mkpath $destinationPath; + my $tarCmd = "cd $buildPath && tar czf $tarFile *"; + if (slxsystem("$tarCmd") != 0) { + die _tr("unable to execute shell-command:\n\t%s \n\t(%s)", $tarCmd, $!); + } } ################################################################################ @@ -396,408 +396,408 @@ sub createTarOfPath ################################################################################ sub writePXEMenus { - my @infos = @_; - - my $pxePath = "$tftpbuildPath"; - my $pxeConfigPath = "$tftpbuildPath/pxelinux.cfg"; - - if (!-e "$pxePath/pxelinux.0") { - my $pxelinux0Path = - "$openslxConfig{'base-path'}/share/tftpboot/pxelinux.0"; - slxsystem(qq[cp -p "$pxelinux0Path" $pxePath/]) unless $option{dryRun}; - } - if (!-e "$pxePath/menu.c32") { - my $menuc32Path = "$openslxConfig{'base-path'}/share/tftpboot/menu.c32"; - slxsystem(qq[cp -p "$menuc32Path" $pxePath/]) unless $option{dryRun}; - } - if (!-e "$pxePath/vesamenu.c32") { - my $vesamenuc32Path = - "$openslxConfig{'base-path'}/share/tftpboot/vesamenu.c32"; - slxsystem(qq[cp -p "$vesamenuc32Path" $pxePath/]) unless $option{dryRun}; - } - - # fetch PXE-template, if any - my $pxeTemplate = - "# generated by slxconfig-demuxer (on $callDate at $callTime)\n"; - my $pxeTemplateFile = "$openslxConfig{'config-path'}/PXE-template"; - if (-e $pxeTemplateFile) { - $pxeTemplate .= slurpFile($pxeTemplateFile); - } else { - $pxeTemplate .= $pxeDefaultTemplate; - } - - # now append (and thus override) the PXE-template with the settings of the - # selected PXE-theme, if any - my $pxeTheme = $openslxConfig{'pxe-theme'}; - if (defined $pxeTheme) { - my $pxeThemeConfig - = "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/theme.conf"; - if (-e $pxeThemeConfig) { - $pxeTemplate .= slurpFile($pxeThemeConfig); - } - } - - # fetch info about margin and replace the corresponding placeholders - my $margin = $openslxConfig{'pxe-theme-menu-margin'} || 0; - my $marginAsText = ' ' x $margin; - $pxeTemplate =~ s{\@\@\@MENU_MARGIN\@\@\@}{$margin}g; - my $separatorLine = '-' x (78 - 4 - 2 * $margin); - $pxeTemplate =~ s{\@\@\@SEPARATOR_LINE\@\@\@}{$separatorLine}g; - - # pick out the last background picture and copy it over - my $pic; - while ($pxeTemplate =~ m{^\s*MENU BACKGROUND (\S+?)\s*$}gims) { - chomp($pic = $1); - } - if (defined $pic) { - my $pxeBackground - = defined $pxeTheme - ? "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/$pic" - : $pic; - if (-e $pxeBackground) { - slxsystem(qq[cp "$pxeBackground" $pxePath/]) unless $option{dryRun}; - } - } - - my @clients = $openslxDB->fetchClientByFilter(); - foreach my $client (@clients) { - my $pxeConfig = $pxeTemplate; - my $externalClientID = externalIDForClient($client); - my $pxeFile = "$pxeConfigPath/$externalClientID"; - my $clientAppend = $client->{kernel_params} || ''; - vlog(1, _tr("writing PXE-file %s", $pxeFile)); - next if $option{dryRun}; - my %systemIDs; - @systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = (); - my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos; - # now @systemInfos holds all infos relevant to this client - my $slxLabels = ''; - foreach my $info (@systemInfos) { - my $extID = $info->{'vendor-os'}->{name}; - my $kernelName = basename($info->{'kernel-file'}); - my $append = $info->{kernel_params}; - $append .= " initrd=$extID/$info->{'initramfs-name'}"; - $append .= " $clientAppend"; - $slxLabels .= "LABEL openslx-$info->{'external-id'}\n"; - my $label = $info->{label} || ''; - if (!length($label) || $label eq $info->{name}) { - if ($info->{name} =~ m{^(.+)::(.+)$}) { - my $system = $1; - my $exportType = $2; - $label = $system . ' ' x (40-length($system)) . $exportType; - } else { - $label = $info->{name}; - } - } - $slxLabels .= "\tMENU LABEL ^$label\n"; - $slxLabels .= "\tKERNEL $extID/$kernelName\n"; - $slxLabels .= "\tAPPEND $append\n"; - $slxLabels .= "\tIPAPPEND 1\n"; - my $helpText = $info->{description} || ''; - if (length($helpText)) { - # make sure that text matches the given margin - $helpText =~ s{^}{$marginAsText}gms; - $slxLabels .= "\tTEXT HELP\n$helpText\n\tENDTEXT\n"; - } - } - # now add the slx-labels (inline or appended) and write the config file - if (!($pxeConfig =~ s{\@\@\@SLX_LABELS\@\@\@}{$slxLabels})) { - $pxeConfig .= $slxLabels; - } - - # PXE uses 'cp850' (codepage 850) but our string is in utf-8, we have - # to convert in order to avoid showing gibberish on the client side... - spitFile($pxeFile, $pxeConfig, { 'io-layer' => 'encoding(cp850)' } ); - } - return; + my @infos = @_; + + my $pxePath = "$tftpbuildPath"; + my $pxeConfigPath = "$tftpbuildPath/pxelinux.cfg"; + + if (!-e "$pxePath/pxelinux.0") { + my $pxelinux0Path = + "$openslxConfig{'base-path'}/share/tftpboot/pxelinux.0"; + slxsystem(qq[cp -p "$pxelinux0Path" $pxePath/]) unless $option{dryRun}; + } + if (!-e "$pxePath/menu.c32") { + my $menuc32Path = "$openslxConfig{'base-path'}/share/tftpboot/menu.c32"; + slxsystem(qq[cp -p "$menuc32Path" $pxePath/]) unless $option{dryRun}; + } + if (!-e "$pxePath/vesamenu.c32") { + my $vesamenuc32Path = + "$openslxConfig{'base-path'}/share/tftpboot/vesamenu.c32"; + slxsystem(qq[cp -p "$vesamenuc32Path" $pxePath/]) unless $option{dryRun}; + } + + # fetch PXE-template, if any + my $pxeTemplate = + "# generated by slxconfig-demuxer (on $callDate at $callTime)\n"; + my $pxeTemplateFile = "$openslxConfig{'config-path'}/PXE-template"; + if (-e $pxeTemplateFile) { + $pxeTemplate .= slurpFile($pxeTemplateFile); + } else { + $pxeTemplate .= $pxeDefaultTemplate; + } + + # now append (and thus override) the PXE-template with the settings of the + # selected PXE-theme, if any + my $pxeTheme = $openslxConfig{'pxe-theme'}; + if (defined $pxeTheme) { + my $pxeThemeConfig + = "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/theme.conf"; + if (-e $pxeThemeConfig) { + $pxeTemplate .= slurpFile($pxeThemeConfig); + } + } + + # fetch info about margin and replace the corresponding placeholders + my $margin = $openslxConfig{'pxe-theme-menu-margin'} || 0; + my $marginAsText = ' ' x $margin; + $pxeTemplate =~ s{\@\@\@MENU_MARGIN\@\@\@}{$margin}g; + my $separatorLine = '-' x (78 - 4 - 2 * $margin); + $pxeTemplate =~ s{\@\@\@SEPARATOR_LINE\@\@\@}{$separatorLine}g; + + # pick out the last background picture and copy it over + my $pic; + while ($pxeTemplate =~ m{^\s*MENU BACKGROUND (\S+?)\s*$}gims) { + chomp($pic = $1); + } + if (defined $pic) { + my $pxeBackground + = defined $pxeTheme + ? "$openslxConfig{'base-path'}/share/themes/${pxeTheme}/pxe/$pic" + : $pic; + if (-e $pxeBackground) { + slxsystem(qq[cp "$pxeBackground" $pxePath/]) unless $option{dryRun}; + } + } + + my @clients = $openslxDB->fetchClientByFilter(); + foreach my $client (@clients) { + my $pxeConfig = $pxeTemplate; + my $externalClientID = externalIDForClient($client); + my $pxeFile = "$pxeConfigPath/$externalClientID"; + my $clientAppend = $client->{kernel_params} || ''; + vlog(1, _tr("writing PXE-file %s", $pxeFile)); + next if $option{dryRun}; + my %systemIDs; + @systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = (); + my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos; + # now @systemInfos holds all infos relevant to this client + my $slxLabels = ''; + foreach my $info (@systemInfos) { + my $extID = $info->{'vendor-os'}->{name}; + my $kernelName = basename($info->{'kernel-file'}); + my $append = $info->{kernel_params}; + $append .= " initrd=$extID/$info->{'initramfs-name'}"; + $append .= " $clientAppend"; + $slxLabels .= "LABEL openslx-$info->{'external-id'}\n"; + my $label = $info->{label} || ''; + if (!length($label) || $label eq $info->{name}) { + if ($info->{name} =~ m{^(.+)::(.+)$}) { + my $system = $1; + my $exportType = $2; + $label = $system . ' ' x (40-length($system)) . $exportType; + } else { + $label = $info->{name}; + } + } + $slxLabels .= "\tMENU LABEL ^$label\n"; + $slxLabels .= "\tKERNEL $extID/$kernelName\n"; + $slxLabels .= "\tAPPEND $append\n"; + $slxLabels .= "\tIPAPPEND 1\n"; + my $helpText = $info->{description} || ''; + if (length($helpText)) { + # make sure that text matches the given margin + $helpText =~ s{^}{$marginAsText}gms; + $slxLabels .= "\tTEXT HELP\n$helpText\n\tENDTEXT\n"; + } + } + # now add the slx-labels (inline or appended) and write the config file + if (!($pxeConfig =~ s{\@\@\@SLX_LABELS\@\@\@}{$slxLabels})) { + $pxeConfig .= $slxLabels; + } + + # PXE uses 'cp850' (codepage 850) but our string is in utf-8, we have + # to convert in order to avoid showing gibberish on the client side... + spitFile($pxeFile, $pxeConfig, { 'io-layer' => 'encoding(cp850)' } ); + } + return; } sub makeInitRamFS { - my $info = shift; - my $pxeVendorOSPath = shift; - - vlog(1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath)); - - my $vendorOS = $info->{'vendor-os'}; - my $kernelFile = basename(followLink($info->{'kernel-file'})); - - my $attrs = dclone($info->{attrs} || {}); - - my $params = { - 'attrs' => $attrs, - 'export-name' => $info->{export}->{name}, - 'export-uri' => $info->{'export-uri'}, - 'initramfs' => "$pxeVendorOSPath/$info->{'initramfs-name'}", - 'kernel-params' => [ split ' ', ($info->{kernel_params} || '') ], - 'kernel-version' => $kernelFile =~ m[-(.+)$] ? $1 : '', - 'plugins' => $info->{'active-plugins'}, - 'root-path' - => "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}", - 'slx-version' => $slxVersion, - 'system-name' => $info->{name}, - }; - - # TODO: make debug-level an explicit attribute, it's used in many places! - my $kernelParams = $info->{kernel_params} || ''; - if ($kernelParams =~ m{debug(?:=(\d+))?}) { - my $debugLevel = defined $1 ? $1 : '1'; - $params->{'debug-level'} = $debugLevel; - } - - my $makeInitRamFSEngine = OpenSLX::MakeInitRamFS::Engine->new($params); - $makeInitRamFSEngine->execute($option{dryRun}); - - # copy back kernel-params, as they might have been changed (by plugins) - $info->{kernel_params} = join ' ', $makeInitRamFSEngine->kernelParams(); - - return; + my $info = shift; + my $pxeVendorOSPath = shift; + + vlog(1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath)); + + my $vendorOS = $info->{'vendor-os'}; + my $kernelFile = basename(followLink($info->{'kernel-file'})); + + my $attrs = dclone($info->{attrs} || {}); + + my $params = { + 'attrs' => $attrs, + 'export-name' => $info->{export}->{name}, + 'export-uri' => $info->{'export-uri'}, + 'initramfs' => "$pxeVendorOSPath/$info->{'initramfs-name'}", + 'kernel-params' => [ split ' ', ($info->{kernel_params} || '') ], + 'kernel-version' => $kernelFile =~ m[-(.+)$] ? $1 : '', + 'plugins' => $info->{'active-plugins'}, + 'root-path' + => "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}", + 'slx-version' => $slxVersion, + 'system-name' => $info->{name}, + }; + + # TODO: make debug-level an explicit attribute, it's used in many places! + my $kernelParams = $info->{kernel_params} || ''; + if ($kernelParams =~ m{debug(?:=(\d+))?}) { + my $debugLevel = defined $1 ? $1 : '1'; + $params->{'debug-level'} = $debugLevel; + } + + my $makeInitRamFSEngine = OpenSLX::MakeInitRamFS::Engine->new($params); + $makeInitRamFSEngine->execute($option{dryRun}); + + # copy back kernel-params, as they might have been changed (by plugins) + $info->{kernel_params} = join ' ', $makeInitRamFSEngine->kernelParams(); + + return; } sub writeSystemPXEFiles { - my $info = shift; + my $info = shift; - vlog(0, _tr('copying kernel and creating initramfs')); + vlog(0, _tr('copying kernel and creating initramfs')); - my $kernelFile = $info->{'kernel-file'}; - my $kernelName = basename($kernelFile); + my $kernelFile = $info->{'kernel-file'}; + my $kernelName = basename($kernelFile); - my $pxePath = "$tftpbuildPath"; - my $pxeVendorOSPath = "$pxePath/$info->{'vendor-os'}->{name}"; - mkpath $pxeVendorOSPath unless -e $pxeVendorOSPath || $option{dryRun}; + my $pxePath = "$tftpbuildPath"; + my $pxeVendorOSPath = "$pxePath/$info->{'vendor-os'}->{name}"; + mkpath $pxeVendorOSPath unless -e $pxeVendorOSPath || $option{dryRun}; - my $targetKernel = "$pxeVendorOSPath/$kernelName"; - if (!-e $targetKernel) { - vlog(1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel)); - slxsystem(qq[cp -p "$kernelFile" "$targetKernel"]) unless $option{dryRun}; - } - makeInitRamFS($info, $pxeVendorOSPath); - $initramfsCount++; - return; + my $targetKernel = "$pxeVendorOSPath/$kernelName"; + if (!-e $targetKernel) { + vlog(1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel)); + slxsystem(qq[cp -p "$kernelFile" "$targetKernel"]) unless $option{dryRun}; + } + makeInitRamFS($info, $pxeVendorOSPath); + $initramfsCount++; + return; } sub writeDhcpConfig { - vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); - my $dhcpModule = "OpenSLX::ConfigExport::DHCP::$option{dhcpType}"; - if (!eval { require $dhcpModule } ) { - die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", - $dhcpModule, $@); - } - my $dhcpBackend = $dhcpModule->new(); - my @clients = $openslxDB->fetchClientByFilter(); - $dhcpBackend->execute(\@clients); - return; + vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); + my $dhcpModule = "OpenSLX::ConfigExport::DHCP::$option{dhcpType}"; + if (!eval { require $dhcpModule } ) { + die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", + $dhcpModule, $@); + } + my $dhcpBackend = $dhcpModule->new(); + my @clients = $openslxDB->fetchClientByFilter(); + $dhcpBackend->execute(\@clients); + return; } sub writeClientConfigurationsForSystem { - my $info = shift; - my $buildPath = shift; - my $attrFile = shift; - - my @clientIDs = $openslxDB->aggregatedClientIDsOfSystem($info); - my @clients = $openslxDB->fetchClientByID(\@clientIDs); - foreach my $client (@clients) { - next if $client->{name} eq '<<>>'; - # skip default client, as it doesn't need any config-tgz - - my $externalSystemID = externalIDForSystem($info); - my $externalClientName = externalConfigNameForClient($client); - my $clientConfigPath = - "$clientConfigPath/$externalSystemID/$externalClientName"; - - # merge configurations of client, it's groups, default client and - # system and write the resulting attributes to a configuration file: - $openslxDB->mergeDefaultAndGroupAttributesIntoClient($client); - mergeAttributes($client, $info); - - my $clientAttrDigest = digestAttributes($client); - vlog( - 2, - _tr( - "attribute-digest for client '%s' is '%s'", $client->{name}, - $clientAttrDigest - ) - ); - # export client-specific config only if attributes are different - # from system and/or a client-specific config-folder exists: - if ($clientAttrDigest ne $info->{'attr-digest'} - || -d $clientConfigPath) - { - vlog( - 1, - _tr( - "creating config-tgz for client %d:%s", $client->{id}, - $client->{name} - ) - ); - $clientSystemConfCount++; - - # merge default, system and client configuration files into - # the system configuration for the current client: - copyExternalSystemConfig( - $externalSystemID, $buildPath, $externalClientName - ); - - writeAttributesToFile($client, $attrFile); - - # create tar containing external system configuration - # and client attribute file, this time referring to the client - # via its external ID (the PXE-style MAC), as the TGZ needs to - # be accessed from the client-PC, which doesn't know about the - # name it is referred to in the openslx-config-DB: - my $externalClientID = externalIDForClient($client); - createTarOfPath( - $buildPath, "${externalClientID}.tgz", - "$tftpbuildPath/client-config/$info->{'external-id'}" - ); - } - } - return; + my $info = shift; + my $buildPath = shift; + my $attrFile = shift; + + my @clientIDs = $openslxDB->aggregatedClientIDsOfSystem($info); + my @clients = $openslxDB->fetchClientByID(\@clientIDs); + foreach my $client (@clients) { + next if $client->{name} eq '<<>>'; + # skip default client, as it doesn't need any config-tgz + + my $externalSystemID = externalIDForSystem($info); + my $externalClientName = externalConfigNameForClient($client); + my $clientConfigPath = + "$clientConfigPath/$externalSystemID/$externalClientName"; + + # merge configurations of client, it's groups, default client and + # system and write the resulting attributes to a configuration file: + $openslxDB->mergeDefaultAndGroupAttributesIntoClient($client); + mergeAttributes($client, $info); + + my $clientAttrDigest = digestAttributes($client); + vlog( + 2, + _tr( + "attribute-digest for client '%s' is '%s'", $client->{name}, + $clientAttrDigest + ) + ); + # export client-specific config only if attributes are different + # from system and/or a client-specific config-folder exists: + if ($clientAttrDigest ne $info->{'attr-digest'} + || -d $clientConfigPath) + { + vlog( + 1, + _tr( + "creating config-tgz for client %d:%s", $client->{id}, + $client->{name} + ) + ); + $clientSystemConfCount++; + + # merge default, system and client configuration files into + # the system configuration for the current client: + copyExternalSystemConfig( + $externalSystemID, $buildPath, $externalClientName + ); + + writeAttributesToFile($client, $attrFile); + + # create tar containing external system configuration + # and client attribute file, this time referring to the client + # via its external ID (the PXE-style MAC), as the TGZ needs to + # be accessed from the client-PC, which doesn't know about the + # name it is referred to in the openslx-config-DB: + my $externalClientID = externalIDForClient($client); + createTarOfPath( + $buildPath, "${externalClientID}.tgz", + "$tftpbuildPath/client-config/$info->{'external-id'}" + ); + } + } + return; } sub writePluginConfigurationsForSystem { - my $info = shift || confess 'need to pass in info-hash!'; - my $buildPath = shift || confess 'need to pass in build-path!'; - - my $pluginConfPath = "$buildPath/initramfs/plugin-conf"; - - my $attrs = $info->{attrs} || {}; - - my @activePlugins; - foreach my $pluginInfo (@{$info->{'installed-plugins'}}) { - my $pluginName = $pluginInfo->{plugin_name}; - vlog(2, _tr("checking configuration of plugin '%s'", $pluginName)); - - # skip inactive plugins - next unless $attrs->{"${pluginName}::active"}; - - push @activePlugins, $pluginName; - - next if $option{dryRun}; - - mkpath([ $pluginConfPath ]); - - vlog(2, _tr("writing configuration file for plugin '%s'", $pluginName)); - # write plugin configuration to a file: - my $content; - my @pluginAttrs = grep { $_ =~ m{^${pluginName}::} } keys %$attrs; - foreach my $attr (sort @pluginAttrs) { - my $attrVal = $attrs->{$attr}; - if (!defined $attrVal) { - $attrVal = ''; - } - my $attrName = substr($attr, index($attr, '::')+2); - $content .= qq[${pluginName}_$attrName="$attrVal"\n]; - } - my $fileName = "$pluginConfPath/${pluginName}.conf"; - spitFile($fileName, $content); - if ($openslxConfig{'verbose-level'} > 2) { - vlog(0, "--- START OF $fileName ---"); - vlog(0, $content); - vlog(0, "--- END OF $fileName --- "); - } - } - $info->{'active-plugins'} = \@activePlugins; - my $activePluginStr = @activePlugins ? join ',', @activePlugins : ''; - vlog(0, _tr("active plugins: %s", $activePluginStr)); - return; + my $info = shift || confess 'need to pass in info-hash!'; + my $buildPath = shift || confess 'need to pass in build-path!'; + + my $pluginConfPath = "$buildPath/initramfs/plugin-conf"; + + my $attrs = $info->{attrs} || {}; + + my @activePlugins; + foreach my $pluginInfo (@{$info->{'installed-plugins'}}) { + my $pluginName = $pluginInfo->{plugin_name}; + vlog(2, _tr("checking configuration of plugin '%s'", $pluginName)); + + # skip inactive plugins + next unless $attrs->{"${pluginName}::active"}; + + push @activePlugins, $pluginName; + + next if $option{dryRun}; + + mkpath([ $pluginConfPath ]); + + vlog(2, _tr("writing configuration file for plugin '%s'", $pluginName)); + # write plugin configuration to a file: + my $content; + my @pluginAttrs = grep { $_ =~ m{^${pluginName}::} } keys %$attrs; + foreach my $attr (sort @pluginAttrs) { + my $attrVal = $attrs->{$attr}; + if (!defined $attrVal) { + $attrVal = ''; + } + my $attrName = substr($attr, index($attr, '::')+2); + $content .= qq[${pluginName}_$attrName="$attrVal"\n]; + } + my $fileName = "$pluginConfPath/${pluginName}.conf"; + spitFile($fileName, $content); + if ($openslxConfig{'verbose-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + } + $info->{'active-plugins'} = \@activePlugins; + my $activePluginStr = @activePlugins ? join ',', @activePlugins : ''; + vlog(0, _tr("active plugins: %s", $activePluginStr)); + return; } sub writeSystemConfiguration { - my $info = shift; - my $isTargetSystem = shift; - - # if this is not a target system, we shall not write any configurations, - # but we simply incorporate inherited attributes - if (!$isTargetSystem) { - $openslxDB->mergeDefaultAttributesIntoSystem($info); - $info->{'initramfs-name'} = "initramfs-$info->{id}"; - return; - } - - # write configuration files for this system - my $buildPath = "$tempPath/build"; - copyExternalSystemConfig(externalIDForSystem($info), $buildPath); - - $openslxDB->mergeDefaultAttributesIntoSystem( - $info, $info->{'installed-plugins'} - ); - $info->{'attr-digest'} = digestAttributes($info); - vlog( - 2, - _tr( - "attribute-digest for system '%s' is '%s'", $info->{name}, - $info->{'attr-digest'} - ) - ); - my $attrFile = "$buildPath/initramfs/machine-setup"; - writeAttributesToFile($info, $attrFile); - - writePluginConfigurationsForSystem($info, $buildPath); - - my $systemPath = "$tftpbuildPath/client-config/$info->{'external-id'}"; - createTarOfPath($buildPath, "default.tgz", $systemPath); - - $info->{'initramfs-name'} = "initramfs-$info->{id}"; - writeSystemPXEFiles($info); - - writeClientConfigurationsForSystem($info, $buildPath, $attrFile); - - slxsystem("rm -rf $buildPath") unless $option{dryRun}; - - $systemConfCount++; - - return; + my $info = shift; + my $isTargetSystem = shift; + + # if this is not a target system, we shall not write any configurations, + # but we simply incorporate inherited attributes + if (!$isTargetSystem) { + $openslxDB->mergeDefaultAttributesIntoSystem($info); + $info->{'initramfs-name'} = "initramfs-$info->{id}"; + return; + } + + # write configuration files for this system + my $buildPath = "$tempPath/build"; + copyExternalSystemConfig(externalIDForSystem($info), $buildPath); + + $openslxDB->mergeDefaultAttributesIntoSystem( + $info, $info->{'installed-plugins'} + ); + $info->{'attr-digest'} = digestAttributes($info); + vlog( + 2, + _tr( + "attribute-digest for system '%s' is '%s'", $info->{name}, + $info->{'attr-digest'} + ) + ); + my $attrFile = "$buildPath/initramfs/machine-setup"; + writeAttributesToFile($info, $attrFile); + + writePluginConfigurationsForSystem($info, $buildPath); + + my $systemPath = "$tftpbuildPath/client-config/$info->{'external-id'}"; + createTarOfPath($buildPath, "default.tgz", $systemPath); + + $info->{'initramfs-name'} = "initramfs-$info->{id}"; + writeSystemPXEFiles($info); + + writeClientConfigurationsForSystem($info, $buildPath, $attrFile); + + slxsystem("rm -rf $buildPath") unless $option{dryRun}; + + $systemConfCount++; + + return; } sub writeConfigurations { - $initramfsCount = $systemConfCount = $systemErrCount - = $clientSystemConfCount = 0; - my @infos; - foreach my $system (@demuxableSystems) { - my $isTargetSystem - = first { $_->{name} eq $system->{name} } @targetSystems; - if ($isTargetSystem) { - vlog( - 0, - _tr("\ndemuxing system %d : %s", $system->{id}, $system->{name}) - ); - } - else { - vlog( - 0, - _tr( - "\nlinking demuxed system %d : %s into PXE menu", - $system->{id}, $system->{name} - ) - ); - } - - my $success = eval { - my $info = $openslxDB->aggregatedSystemFileInfoFor($system); - $info->{'external-id'} = externalIDForSystem($system); - - writeSystemConfiguration($info, $isTargetSystem); - - push @infos, $info; - 1; - }; - if (!$success) { - print STDERR $@; - $systemErrCount++; - } - } - writePXEMenus(@infos); - if (defined $option{dhcpType}) { - writeDhcpConfig(); - } - return; + $initramfsCount = $systemConfCount = $systemErrCount + = $clientSystemConfCount = 0; + my @infos; + foreach my $system (@demuxableSystems) { + my $isTargetSystem + = first { $_->{name} eq $system->{name} } @targetSystems; + if ($isTargetSystem) { + vlog( + 0, + _tr("\ndemuxing system %d : %s", $system->{id}, $system->{name}) + ); + } + else { + vlog( + 0, + _tr( + "\nlinking demuxed system %d : %s into PXE menu", + $system->{id}, $system->{name} + ) + ); + } + + my $success = eval { + my $info = $openslxDB->aggregatedSystemFileInfoFor($system); + $info->{'external-id'} = externalIDForSystem($system); + + writeSystemConfiguration($info, $isTargetSystem); + + push @infos, $info; + 1; + }; + if (!$success) { + print STDERR $@; + $systemErrCount++; + } + } + writePXEMenus(@infos); + if (defined $option{dhcpType}) { + writeDhcpConfig(); + } + return; } =head1 NAME diff --git a/config-db/t/01-basics.t b/config-db/t/01-basics.t index 903783c4..1fb7083b 100644 --- a/config-db/t/01-basics.t +++ b/config-db/t/01-basics.t @@ -13,9 +13,9 @@ ok(my $configDB = OpenSLX::ConfigDB->new, 'can create object'); isa_ok($configDB, 'OpenSLX::ConfigDB'); { - # create a second object - should work and yield different objects - ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); - cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); + # create a second object - should work and yield different objects + ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); + cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); } ok($configDB->connect(), 'connecting'); diff --git a/config-db/t/10-vendor-os.t b/config-db/t/10-vendor-os.t index ac16becf..a71ee4ac 100644 --- a/config-db/t/10-vendor-os.t +++ b/config-db/t/10-vendor-os.t @@ -12,46 +12,46 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $vendorOS = $configDB->fetchVendorOSByFilter, undef, - 'no vendor-OS yet (scalar context)' + my $vendorOS = $configDB->fetchVendorOSByFilter, undef, + 'no vendor-OS yet (scalar context)' ); my $wrongVendorOS = { - 'comment' => 'test', + 'comment' => 'test', }; ok( - ! eval { my $vendorOSID = $configDB->addVendorOS($wrongVendorOS); }, - 'trying to insert an unnamed vendor-OS should fail' + ! eval { my $vendorOSID = $configDB->addVendorOS($wrongVendorOS); }, + 'trying to insert an unnamed vendor-OS should fail' ); is( - my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, - 'no vendor-OS yet (array context)' + my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, + 'no vendor-OS yet (array context)' ); my $inVendorOS1 = { - 'name' => 'vos-1', - 'comment' => '', + 'name' => 'vos-1', + 'comment' => '', }; is( - my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, - 'first vendor-OS has ID 1' + my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, + 'first vendor-OS has ID 1' ); my $inVendorOS2 = { - 'name' => 'vos-2.0', - 'comment' => 'batch 2', + 'name' => 'vos-2.0', + 'comment' => 'batch 2', }; my $inVendorOS3 = { - 'name' => 'vos-3.0', - 'comment' => 'batch 2', - 'clone_source' => 'kiwi::test-vos', + 'name' => 'vos-3.0', + 'comment' => 'batch 2', + 'clone_source' => 'kiwi::test-vos', }; ok( - my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ - $inVendorOS2, $inVendorOS3 - ]), - 'add two more vendor-OSes' + my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ + $inVendorOS2, $inVendorOS3 + ]), + 'add two more vendor-OSes' ); is($vendorOS2ID, 2, 'vendor-OS 2 should have ID=2'); is($vendorOS3ID, 3, 'vendor-OS 3 should have ID=3'); @@ -65,8 +65,8 @@ is($vendorOS3->{clone_source}, 'kiwi::test-vos', 'vendor-OS 3 - clone_source'); # fetch vendor-OS 2 by a filter on id and check all values ok( - my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), - 'fetch vendor-OS 2 by filter on id' + my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), + 'fetch vendor-OS 2 by filter on id' ); is($vendorOS2->{id}, 2, 'vendor-OS 2 - id'); is($vendorOS2->{name}, 'vos-2.0', 'vendor-OS 2 - name'); @@ -75,8 +75,8 @@ is($vendorOS2->{clone_source}, undef, 'vendor-OS 2 - clone_source'); # fetch vendor-OS 1 by filter on name and check all values ok( - my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), - 'fetch vendor-OS 1 by filter on name' + my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), + 'fetch vendor-OS 1 by filter on name' ); is($vendorOS1->{id}, 1, 'vendor-OS 1 - id'); is($vendorOS1->{name}, 'vos-1', 'vendor-OS 1 - name'); @@ -85,9 +85,9 @@ is($vendorOS1->{clone_source}, undef, 'vendor-OS 1 - clone_source'); # fetch vendor-OSes 3 & 1 by id ok( - my @vendorOSes3And1 - = $configDB->fetchVendorOSByID([3, 1]), - 'fetch vendor-OSes 3 & 1 by id' + my @vendorOSes3And1 + = $configDB->fetchVendorOSByID([3, 1]), + 'fetch vendor-OSes 3 & 1 by id' ); is(@vendorOSes3And1, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 3 and 1 @@ -97,22 +97,22 @@ is($vendorOSes3And1[1]->{id}, 3, 'second id should be 3'); # fetching vendor-OSes by id without giving any should yield undef is( - $configDB->fetchVendorOSByID(), undef, - 'fetch vendor-OSes by id without giving any' + $configDB->fetchVendorOSByID(), undef, + 'fetch vendor-OSes by id without giving any' ); # fetching vendor-OSes by filter without giving any should yield all of them ok( - @vendorOSes = $configDB->fetchVendorOSByFilter(), - 'fetch vendor-OSes by filter without giving any' + @vendorOSes = $configDB->fetchVendorOSByFilter(), + 'fetch vendor-OSes by filter without giving any' ); is(@vendorOSes, 3, 'should have got all three vendor-OSes'); # fetch vendor-OSes 2 & 3 by filter on comment ok( - my @vendorOSes2And3 - = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), - 'fetch vendor-OSes 2 & 3 by filter on comment' + my @vendorOSes2And3 + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), + 'fetch vendor-OSes 2 & 3 by filter on comment' ); is(@vendorOSes2And3, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 2 and 3 @@ -122,9 +122,9 @@ is($vendorOSes2And3[1]->{id}, 3, 'second id should be 3'); # try to fetch with multi-column filter ok( - ($vendorOS2, $vendorOS3) - = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), - 'fetching vendor-OS with comment="batch 2" and id=2 should work' + ($vendorOS2, $vendorOS3) + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), + 'fetching vendor-OS with comment="batch 2" and id=2 should work' ); is($vendorOS2->{name}, 'vos-2.0', 'should have got vos-2.0'); is($vendorOS3, undef, 'should not get vos-3.0'); @@ -132,9 +132,9 @@ is($vendorOS3, undef, 'should not get vos-3.0'); # try to fetch multiple occurrences of the same vendor-OS, combined with # some unknown IDs ok( - my @vendorOSes1And3 - = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), - 'fetch a complex set of vendor-OSes by ID' + my @vendorOSes1And3 + = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of vendor-OSes by ID' ); is(@vendorOSes1And3, 2, 'should have got 2 vendor-OSes'); # now sort by ID and check if we have really got 1 and 3 @@ -144,37 +144,37 @@ is($vendorOSes1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch a couple of non-existing vendor-OSes by id is( - $configDB->fetchVendorOSByID(-1), undef, - 'vendor-OS with id -1 should not exist' + $configDB->fetchVendorOSByID(-1), undef, + 'vendor-OS with id -1 should not exist' ); is( - $configDB->fetchVendorOSByID(0), undef, - 'vendor-OS with id 0 should not exist' + $configDB->fetchVendorOSByID(0), undef, + 'vendor-OS with id 0 should not exist' ); is( - $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown vendor-OS' + $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown vendor-OS' ); # try to fetch a couple of non-existing vendor-OSes by filter is( - $configDB->fetchVendorOSByFilter({ id => 0 }), undef, - 'fetching vendor-OS with id=0 by filter should fail' + $configDB->fetchVendorOSByFilter({ id => 0 }), undef, + 'fetching vendor-OS with id=0 by filter should fail' ); is( - $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, - 'fetching vendor-OS with name="vos-1.x" should fail' + $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, + 'fetching vendor-OS with name="vos-1.x" should fail' ); is( - $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, - 'fetching vendor-OS with comment="batch 2" and id=1 should fail' + $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, + 'fetching vendor-OS with comment="batch 2" and id=1 should fail' ); # rename vendor-OS 1 and then fetch it by its new name ok($configDB->changeVendorOS(1, { name => q{VOS-'1'} }), 'changing vendor-OS 1'); ok( - $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), - 'fetching renamed vendor-OS 1' + $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), + 'fetching renamed vendor-OS 1' ); is($vendorOS1->{id}, 1, 'really got vendor-OS number 1'); is($vendorOS1->{name}, q{VOS-'1'}, q{really got vendor-OS named "VOS-'1'"}); @@ -184,68 +184,68 @@ ok($configDB->changeVendorOS(1), 'changing nothing at all in vendor-OS 1'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeVendorOS(1, { id => 23 }), 'changing id should fail'); # test adding & removing of installed plugins is( - my @plugins = $configDB->fetchInstalledPlugins(3), - 0, 'there should be no installed plugins' + my @plugins = $configDB->fetchInstalledPlugins(3), + 0, 'there should be no installed plugins' ); ok($configDB->addInstalledPlugin(3, 'Example'), 'adding installed plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' ); is( - $configDB->addInstalledPlugin(3, 'Example'), 1, - 'adding plugin again should work (but do not harm, just update the attrs)' + $configDB->addInstalledPlugin(3, 'Example'), 1, + 'adding plugin again should work (but do not harm, just update the attrs)' ); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should still have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should still have 1 installed plugin' ); is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); ok($configDB->addInstalledPlugin(3, 'Test'), 'adding a second plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 2, - 'should have 2 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 2, + 'should have 2 installed plugin' ); ok( - !$configDB->removeInstalledPlugin(3, 'xxx'), - 'removing unknown plugin should fail' + !$configDB->removeInstalledPlugin(3, 'xxx'), + 'removing unknown plugin should fail' ); ok( - @plugins = $configDB->fetchInstalledPlugins(3, 'Example'), - 'fetching specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'Example'), + 'fetching specific plugin' ); is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); ok( - @plugins = $configDB->fetchInstalledPlugins(3, 'Test'), - 'fetching another specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'Test'), + 'fetching another specific plugin' ); is($plugins[0]->{plugin_name}, 'Test', 'should have got plugin "Test"'); is( - @plugins = $configDB->fetchInstalledPlugins(3, 'xxx'), 0, - 'fetching unknown specific plugin' + @plugins = $configDB->fetchInstalledPlugins(3, 'xxx'), 0, + 'fetching unknown specific plugin' ); ok($configDB->removeInstalledPlugin(3, 'Example'), 'removing installed plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 1, - 'should have 1 installed plugin' + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' ); ok($configDB->removeInstalledPlugin(3, 'Test'), 'removing second plugin'); is( - @plugins = $configDB->fetchInstalledPlugins(3), - 0, - 'should have no installed plugins' + @plugins = $configDB->fetchInstalledPlugins(3), + 0, + 'should have no installed plugins' ); # now remove a vendor-OS and check if that worked diff --git a/config-db/t/11-export.t b/config-db/t/11-export.t index 0cdc688c..3dd0ae6c 100644 --- a/config-db/t/11-export.t +++ b/config-db/t/11-export.t @@ -12,70 +12,70 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $export = $configDB->fetchExportByFilter, undef, - 'no export yet (scalar context)' + my $export = $configDB->fetchExportByFilter, undef, + 'no export yet (scalar context)' ); foreach my $requiredCol (qw(name vendor_os_id type)) { - my $wrongExport = { - 'name' => 'name', - 'vendor_os_id' => 1, - 'type ' => 'nfs', - 'comment' => 'has column missing', - }; - delete $wrongExport->{$requiredCol}; - ok( - ! eval { my $exportID = $configDB->addExport($wrongExport); }, - "inserting an export without '$requiredCol' column should fail" - ); + my $wrongExport = { + 'name' => 'name', + 'vendor_os_id' => 1, + 'type ' => 'nfs', + 'comment' => 'has column missing', + }; + delete $wrongExport->{$requiredCol}; + ok( + ! eval { my $exportID = $configDB->addExport($wrongExport); }, + "inserting an export without '$requiredCol' column should fail" + ); } is( - my @exports = $configDB->fetchExportByFilter, 0, - 'no export yet (array context)' + my @exports = $configDB->fetchExportByFilter, 0, + 'no export yet (array context)' ); is( - my @exportIDs = $configDB->fetchExportIDsOfVendorOS(1), 0, - 'vendor-OS 1 has no export IDs yet' + my @exportIDs = $configDB->fetchExportIDsOfVendorOS(1), 0, + 'vendor-OS 1 has no export IDs yet' ); is( - @exportIDs = $configDB->fetchExportIDsOfVendorOS(2), 0, - 'vendor-OS 2 has no export IDs yet' + @exportIDs = $configDB->fetchExportIDsOfVendorOS(2), 0, + 'vendor-OS 2 has no export IDs yet' ); my $inExport1 = { - 'name' => 'exp-1', - 'type' => 'nfs', - 'vendor_os_id' => 1, - 'comment' => '', + 'name' => 'exp-1', + 'type' => 'nfs', + 'vendor_os_id' => 1, + 'comment' => '', }; is( - my $export1ID = $configDB->addExport($inExport1), 1, - 'first export has ID 1' + my $export1ID = $configDB->addExport($inExport1), 1, + 'first export has ID 1' ); my $inExport2 = { - 'name' => 'exp-2.0', - 'type' => 'sqfs-nbd', - 'vendor_os_id' => 1, - 'comment' => undef, + 'name' => 'exp-2.0', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 1, + 'comment' => undef, }; my $fullExport = { - 'name' => 'exp-nr-3', - 'type' => 'sqfs-nbd', - 'vendor_os_id' => 2, - 'comment' => 'nuff said', - 'server_ip' => '192.168.212.243', - 'port' => '65432', - 'uri' => 'sqfs-nbd://somehost/somepath?param=val&yes=1', + 'name' => 'exp-nr-3', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 2, + 'comment' => 'nuff said', + 'server_ip' => '192.168.212.243', + 'port' => '65432', + 'uri' => 'sqfs-nbd://somehost/somepath?param=val&yes=1', }; ok( - my ($export2ID, $export3ID) = $configDB->addExport([ - $inExport2, $fullExport - ]), - 'add two more exports' + my ($export2ID, $export3ID) = $configDB->addExport([ + $inExport2, $fullExport + ]), + 'add two more exports' ); is($export2ID, 2, 'export 2 should have ID=2'); is($export3ID, 3, 'export 3 should have ID=3'); @@ -90,15 +90,15 @@ is($export3->{comment}, 'nuff said', 'export 3 - comment'); is($export3->{server_ip}, '192.168.212.243', 'export 3 - server_ip'); is($export3->{port}, '65432', 'export 3 - port'); is( - $export3->{uri}, - 'sqfs-nbd://somehost/somepath?param=val&yes=1', - 'export 3 - uri' + $export3->{uri}, + 'sqfs-nbd://somehost/somepath?param=val&yes=1', + 'export 3 - uri' ); # fetch export 2 by a filter on id and check all values ok( - my $export2 = $configDB->fetchExportByFilter({ id => 2 }), - 'fetch export 2 by filter on id' + my $export2 = $configDB->fetchExportByFilter({ id => 2 }), + 'fetch export 2 by filter on id' ); is($export2->{id}, 2, 'export 2 - id'); is($export2->{name}, 'exp-2.0', 'export 2 - name'); @@ -108,8 +108,8 @@ is($export2->{comment}, undef, 'export 2 - comment'); # fetch export 1 by filter on name and check all values ok( - my $export1 = $configDB->fetchExportByFilter({ name => 'exp-1' }), - 'fetch export 1 by filter on name' + my $export1 = $configDB->fetchExportByFilter({ name => 'exp-1' }), + 'fetch export 1 by filter on name' ); is($export1->{id}, 1, 'export 1 - id'); is($export1->{name}, 'exp-1', 'export 1 - name'); @@ -121,22 +121,22 @@ is($export1->{server_ip}, undef, 'export 1 - server_ip'); is($export1->{uri}, undef, 'export 1 - uri'); is( - @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(1)), - 2, 'vendor-OS 1 has two export IDs' + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(1)), + 2, 'vendor-OS 1 has two export IDs' ); is($exportIDs[0], 1, 'first export ID of vendor-OS 1 (1)'); is($exportIDs[1], 2, 'second export ID of vendor-OS 1 (2)'); is( - @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(2)), - 1, 'vendor-OS 2 has one export IDs' + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(2)), + 1, 'vendor-OS 2 has one export IDs' ); is($exportIDs[0], 3, 'first export ID of vendor-OS 2 (3)'); # fetch exports 3 & 1 by id ok( - my @exports3And1 = $configDB->fetchExportByID([3, 1]), - 'fetch exports 3 & 1 by id' + my @exports3And1 = $configDB->fetchExportByID([3, 1]), + 'fetch exports 3 & 1 by id' ); is(@exports3And1, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 3 and 1 @@ -146,21 +146,21 @@ is($exports3And1[1]->{id}, 3, 'second id should be 3'); # fetching exports by id without giving any should yield undef is( - $configDB->fetchExportByID(), undef, - 'fetch exports by id without giving any' + $configDB->fetchExportByID(), undef, + 'fetch exports by id without giving any' ); # fetching exports by filter without giving any should yield all of them ok( - @exports = $configDB->fetchExportByFilter(), - 'fetch exports by filter without giving any' + @exports = $configDB->fetchExportByFilter(), + 'fetch exports by filter without giving any' ); is(@exports, 3, 'should have got all three exports'); # fetch exports 1 & 2 by filter on vendor_os_id ok( - my @exports1And2 = $configDB->fetchExportByFilter({ vendor_os_id => '1' }), - 'fetch exports 1 & 2 by filter on vendor_os_id' + my @exports1And2 = $configDB->fetchExportByFilter({ vendor_os_id => '1' }), + 'fetch exports 1 & 2 by filter on vendor_os_id' ); is(@exports1And2, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 1 and 2 @@ -170,9 +170,9 @@ is($exports1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch with multi-column filter ok( - ($export2, $export3) - = $configDB->fetchExportByFilter({ vendor_os_id => '1', id => 2 }), - 'fetching export with vendor_os_id=1 and id=2 should work' + ($export2, $export3) + = $configDB->fetchExportByFilter({ vendor_os_id => '1', id => 2 }), + 'fetching export with vendor_os_id=1 and id=2 should work' ); is($export2->{name}, 'exp-2.0', 'should have got exp-2.0'); is($export3, undef, 'should not get exp-nr-3'); @@ -180,8 +180,8 @@ is($export3, undef, 'should not get exp-nr-3'); # try to fetch multiple occurrences of the same export, combined with # some unknown IDs ok( - my @exports1And3 = $configDB->fetchExportByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), - 'fetch a complex set of exports by ID' + my @exports1And3 = $configDB->fetchExportByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of exports by ID' ); is(@exports1And3, 2, 'should have got 2 exports'); # now sort by ID and check if we have really got 1 and 3 @@ -191,37 +191,37 @@ is($exports1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch a couple of non-existing exports by id is( - $configDB->fetchExportByID(-1), undef, - 'export with id -1 should not exist' + $configDB->fetchExportByID(-1), undef, + 'export with id -1 should not exist' ); is( - $configDB->fetchExportByID(0), undef, - 'export with id 0 should not exist' + $configDB->fetchExportByID(0), undef, + 'export with id 0 should not exist' ); is( - $configDB->fetchExportByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown export' + $configDB->fetchExportByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown export' ); # try to fetch a couple of non-existing exports by filter is( - $configDB->fetchExportByFilter({ id => 0 }), undef, - 'fetching export with id=0 by filter should fail' + $configDB->fetchExportByFilter({ id => 0 }), undef, + 'fetching export with id=0 by filter should fail' ); is( - $configDB->fetchExportByFilter({ name => 'exp-1.x' }), undef, - 'fetching export with name="exp-1.x" should fail' + $configDB->fetchExportByFilter({ name => 'exp-1.x' }), undef, + 'fetching export with name="exp-1.x" should fail' ); is( - $configDB->fetchExportByFilter({ vendor_os_id => '2', id => 1 }), undef, - 'fetching export with vendor_os_id=2 and id=1 should fail' + $configDB->fetchExportByFilter({ vendor_os_id => '2', id => 1 }), undef, + 'fetching export with vendor_os_id=2 and id=1 should fail' ); # rename export 1 and then fetch it by its new name ok($configDB->changeExport(1, { name => q{EXP-'1'} }), 'changing export 1'); ok( - $export1 = $configDB->fetchExportByFilter({ name => q{EXP-'1'} }), - 'fetching renamed export 1' + $export1 = $configDB->fetchExportByFilter({ name => q{EXP-'1'} }), + 'fetching renamed export 1' ); is($export1->{id}, 1, 'really got export number 1'); is($export1->{name}, q{EXP-'1'}, q{really got export named "EXP-'1'"}); @@ -231,8 +231,8 @@ ok($configDB->changeExport(1), 'changing nothing at all in export 1'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeExport(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeExport(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeExport(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/12-system.t b/config-db/t/12-system.t index 17a0c0dd..7ed740a9 100644 --- a/config-db/t/12-system.t +++ b/config-db/t/12-system.t @@ -12,99 +12,99 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); ok( - my $system = $configDB->fetchSystemByFilter, - 'one system [default] should exist (scalar context)' + my $system = $configDB->fetchSystemByFilter, + 'one system [default] should exist (scalar context)' ); foreach my $requiredCol (qw(name export_id)) { - my $wrongSystem = { - 'name' => 'name', - 'export_id' => 1, - 'comment' => 'has column missing', - }; - delete $wrongSystem->{$requiredCol}; - ok( - ! eval { my $systemID = $configDB->addSystem($wrongSystem); }, - "inserting a system without '$requiredCol' column should fail" - ); + my $wrongSystem = { + 'name' => 'name', + 'export_id' => 1, + 'comment' => 'has column missing', + }; + delete $wrongSystem->{$requiredCol}; + ok( + ! eval { my $systemID = $configDB->addSystem($wrongSystem); }, + "inserting a system without '$requiredCol' column should fail" + ); } is( - my @systems = $configDB->fetchSystemByFilter, 1, - 'still just one system [default] should exist (array context)' + my @systems = $configDB->fetchSystemByFilter, 1, + 'still just one system [default] should exist (array context)' ); my $inSystem1 = { - 'name' => 'sys-1', - 'export_id' => 1, - 'comment' => '', - 'attrs' => { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_nicmods' => 'e1000 forcedeth r8169', - 'start_sshd' => 'yes', - }, + 'name' => 'sys-1', + 'export_id' => 1, + 'comment' => '', + 'attrs' => { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'e1000 forcedeth r8169', + 'start_sshd' => 'yes', + }, }; is( - my $system1ID = $configDB->addSystem($inSystem1), 1, - 'first system has ID 1' + my $system1ID = $configDB->addSystem($inSystem1), 1, + 'first system has ID 1' ); my $inSystem2 = { - 'name' => 'sys-2.0', - 'kernel' => 'vmlinuz', - 'export_id' => 1, - 'comment' => undef, + 'name' => 'sys-2.0', + 'kernel' => 'vmlinuz', + 'export_id' => 1, + 'comment' => undef, }; my $fullSystem = { - 'name' => 'sys-nr-3', - 'kernel' => 'vmlinuz-2.6.22.13-0.3-default', - 'export_id' => 3, - 'comment' => 'nuff said', - 'label' => 'BlingBling System - really kuul!', - 'kernel_params' => 'debug=3 console=ttyS1', - 'hidden' => '1', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'ramfs_fsmods' => 'l', - 'ramfs_miscmods' => 'm', - 'ramfs_nicmods' => 'n', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'sys-nr-3', + 'kernel' => 'vmlinuz-2.6.22.13-0.3-default', + 'export_id' => 3, + 'comment' => 'nuff said', + 'label' => 'BlingBling System - really kuul!', + 'kernel_params' => 'debug=3 console=ttyS1', + 'hidden' => '1', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'ramfs_fsmods' => 'l', + 'ramfs_miscmods' => 'm', + 'ramfs_nicmods' => 'n', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($system2ID, $system3ID) = $configDB->addSystem([ - $inSystem2, $fullSystem - ]), - 'add two more systems' + my ($system2ID, $system3ID) = $configDB->addSystem([ + $inSystem2, $fullSystem + ]), + 'add two more systems' ); is($system2ID, 2, 'system 2 should have ID=2'); is($system3ID, 3, 'system 3 should have ID=3'); @@ -157,8 +157,8 @@ is(keys %{$system3->{attrs}}, 34, 'system 3 - attribu # fetch system 2 by a filter on id and check all values ok( - my $system2 = $configDB->fetchSystemByFilter({ id => 2 }), - 'fetch system 2 by filter on id' + my $system2 = $configDB->fetchSystemByFilter({ id => 2 }), + 'fetch system 2 by filter on id' ); is($system2->{id}, 2, 'system 2 - id'); is($system2->{name}, 'sys-2.0', 'system 2 - name'); @@ -169,8 +169,8 @@ is(keys %{$system2->{attrs}}, 0, 'system 2 - attribute count'); # fetch system 1 by filter on name and check all values ok( - my $system1 = $configDB->fetchSystemByFilter({ name => 'sys-1' }), - 'fetch system 1 by filter on name' + my $system1 = $configDB->fetchSystemByFilter({ name => 'sys-1' }), + 'fetch system 1 by filter on name' ); is($system1->{id}, 1, 'system 1 - id'); is($system1->{name}, 'sys-1', 'system 1 - name'); @@ -187,8 +187,8 @@ is($system1->{attrs}->{start_sshd}, 'yes', 'system 1 - att # fetch systems 3 & 1 by id ok( - my @systems3And1 = $configDB->fetchSystemByID([3, 1]), - 'fetch systems 3 & 1 by id' + my @systems3And1 = $configDB->fetchSystemByID([3, 1]), + 'fetch systems 3 & 1 by id' ); is(@systems3And1, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 3 and 1 @@ -198,21 +198,21 @@ is($systems3And1[1]->{id}, 3, 'second id should be 3'); # fetching systems by id without giving any should yield undef is( - $configDB->fetchSystemByID(), undef, - 'fetch systems by id without giving any' + $configDB->fetchSystemByID(), undef, + 'fetch systems by id without giving any' ); # fetching systems by filter without giving any should yield all of them ok( - @systems = $configDB->fetchSystemByFilter(), - 'fetch systems by filter without giving any' + @systems = $configDB->fetchSystemByFilter(), + 'fetch systems by filter without giving any' ); is(@systems, 4, 'should have got all four systems'); # fetch systems 1 & 2 by filter on export_id ok( - my @systems1And2 = $configDB->fetchSystemByFilter({ export_id => '1' }), - 'fetch systems 1 & 2 by filter on export_id' + my @systems1And2 = $configDB->fetchSystemByFilter({ export_id => '1' }), + 'fetch systems 1 & 2 by filter on export_id' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -222,8 +222,8 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # fetch systems 1 & 2 by filter on hidden being undef'd ok( - @systems1And2 = $configDB->fetchSystemByFilter({ hidden => undef }), - 'fetch systems 1 & 2 by filter on hidden being undefined' + @systems1And2 = $configDB->fetchSystemByFilter({ hidden => undef }), + 'fetch systems 1 & 2 by filter on hidden being undefined' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -233,9 +233,9 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch with multi-column filter ok( - ($system2, $system3) - = $configDB->fetchSystemByFilter({ export_id => '1', id => 2 }), - 'fetching system with export_id=1 and id=2 should work' + ($system2, $system3) + = $configDB->fetchSystemByFilter({ export_id => '1', id => 2 }), + 'fetching system with export_id=1 and id=2 should work' ); is($system2->{name}, 'sys-2.0', 'should have got sys-2.0'); is($system3, undef, 'should not get sys-nr-3'); @@ -243,8 +243,8 @@ is($system3, undef, 'should not get sys-nr-3'); # try to fetch multiple occurrences of the same system, combined with # some unknown IDs ok( - my @systems1And3 = $configDB->fetchSystemByID([ 1, 21, 4-1, 1, 3, 1, 1 ]), - 'fetch a complex set of systems by ID' + my @systems1And3 = $configDB->fetchSystemByID([ 1, 21, 4-1, 1, 3, 1, 1 ]), + 'fetch a complex set of systems by ID' ); is(@systems1And3, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 3 @@ -254,74 +254,74 @@ is($systems1And3[1]->{id}, 3, 'second id should be 3'); # filter systems by different attributes & values in combination ok( - my @system1Only = $configDB->fetchSystemByFilter( {}, undef, { - ramfs_nicmods => 'e1000 forcedeth r8169' - } ), - 'fetch system 1 by filter on attribute ramfs_nicmods' + my @system1Only = $configDB->fetchSystemByFilter( {}, undef, { + ramfs_nicmods => 'e1000 forcedeth r8169' + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); ok( - @system1Only = $configDB->fetchSystemByFilter( undef, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - 'fetch system 1 by filter on attribute ramfs_nicmods' + @system1Only = $configDB->fetchSystemByFilter( undef, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); ok( - @system1Only = $configDB->fetchSystemByFilter( { - export_id => 1, - hidden => undef, - }, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - 'fetch system 1 by multiple filter on values and attributes' + @system1Only = $configDB->fetchSystemByFilter( { + export_id => 1, + hidden => undef, + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by multiple filter on values and attributes' ); is(@system1Only, 1, 'should have got 1 system'); is($system1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchSystemByFilter( { - export_id => 2, - }, 'id', { - ramfs_nicmods => 'e1000 forcedeth r8169', - slxgrp => undef, - } ), - undef, - 'mismatch system 1 by filter with incorrect value' + $configDB->fetchSystemByFilter( { + export_id => 2, + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect value' ); is( - $configDB->fetchSystemByFilter( { - export_id => 1, - }, 'id', { - ramfs_nicmods => 'xxxx', - slxgrp => undef, - } ), - undef, - 'mismatch system 1 by filter with incorrect attribute value' + $configDB->fetchSystemByFilter( { + export_id => 1, + }, 'id', { + ramfs_nicmods => 'xxxx', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect attribute value' ); is( - $configDB->fetchSystemByFilter( { - name => 'sys-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch system 1 by filter with attribute not being empty' + $configDB->fetchSystemByFilter( { + name => 'sys-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch system 1 by filter with attribute not being empty' ); # fetch systems 1 & 2 by filter on attribute start_samba not existing ok( - @systems1And2 = $configDB->fetchSystemByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch systems 1 & 2 by filter on attribute start_samba not existing' + @systems1And2 = $configDB->fetchSystemByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch systems 1 & 2 by filter on attribute start_samba not existing' ); is(@systems1And2, 2, 'should have got 2 systems'); # now sort by ID and check if we have really got 1 and 2 @@ -331,34 +331,34 @@ is($systems1And2[1]->{id}, 2, 'second id should be 2'); # try to fetch a couple of non-existing systems by id is( - $configDB->fetchSystemByID(-1), undef, - 'system with id -1 should not exist' + $configDB->fetchSystemByID(-1), undef, + 'system with id -1 should not exist' ); ok($configDB->fetchSystemByID(0), 'system with id 0 should exist'); is( - $configDB->fetchSystemByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown system' + $configDB->fetchSystemByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown system' ); # try to fetch a couple of non-existing systems by filter is( - $configDB->fetchSystemByFilter({ id => 4 }), undef, - 'fetching system with id=4 by filter should fail' + $configDB->fetchSystemByFilter({ id => 4 }), undef, + 'fetching system with id=4 by filter should fail' ); is( - $configDB->fetchSystemByFilter({ name => 'sys-1.x' }), undef, - 'fetching system with name="sys-1.x" should fail' + $configDB->fetchSystemByFilter({ name => 'sys-1.x' }), undef, + 'fetching system with name="sys-1.x" should fail' ); is( - $configDB->fetchSystemByFilter({ export_id => '2', id => 1 }), undef, - 'fetching system with export_id=2 and id=1 should fail' + $configDB->fetchSystemByFilter({ export_id => '2', id => 1 }), undef, + 'fetching system with export_id=2 and id=1 should fail' ); # rename system 1 and then fetch it by its new name ok($configDB->changeSystem(1, { name => q{SYS-'1'} }), 'changing system 1'); ok( - $system1 = $configDB->fetchSystemByFilter({ name => q{SYS-'1'} }), - 'fetching renamed system 1' + $system1 = $configDB->fetchSystemByFilter({ name => q{SYS-'1'} }), + 'fetching renamed system 1' ); is($system1->{id}, 1, 'really got system number 1'); is($system1->{name}, q{SYS-'1'}, q{really got system named "SYS-'1'"}); @@ -395,8 +395,8 @@ ok(!exists $system1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeSystem(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeSystem(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeSystem(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/13-client.t b/config-db/t/13-client.t index 1c8ea99f..c9c77db9 100644 --- a/config-db/t/13-client.t +++ b/config-db/t/13-client.t @@ -12,96 +12,96 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); ok( - my $client = $configDB->fetchClientByFilter, - 'one client [default] should exist (scalar context)' + my $client = $configDB->fetchClientByFilter, + 'one client [default] should exist (scalar context)' ); foreach my $requiredCol (qw(name mac)) { - my $wrongClient = { - 'name' => 'name', - 'mac' => '01:02:03:04:05:06', - 'comment' => 'has column missing', - }; - delete $wrongClient->{$requiredCol}; - ok( - ! eval { my $clientID = $configDB->addClient($wrongClient); }, - "inserting a client without '$requiredCol' column should fail" - ); + my $wrongClient = { + 'name' => 'name', + 'mac' => '01:02:03:04:05:06', + 'comment' => 'has column missing', + }; + delete $wrongClient->{$requiredCol}; + ok( + ! eval { my $clientID = $configDB->addClient($wrongClient); }, + "inserting a client without '$requiredCol' column should fail" + ); } is( - my @clients = $configDB->fetchClientByFilter, 1, - 'still just one client [default] should exist (array context)' + my @clients = $configDB->fetchClientByFilter, 1, + 'still just one client [default] should exist (array context)' ); my $inClient1 = { - 'name' => 'cli-1', - 'mac' => '01:02:03:04:05:01', - 'comment' => '', - 'attrs' => { - 'slxgrp' => 'slxgrp', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - }, + 'name' => 'cli-1', + 'mac' => '01:02:03:04:05:01', + 'comment' => '', + 'attrs' => { + 'slxgrp' => 'slxgrp', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, }; is( - my $client1ID = $configDB->addClient($inClient1), 1, - 'first client has ID 1' + my $client1ID = $configDB->addClient($inClient1), 1, + 'first client has ID 1' ); my $inClient2 = { - 'name' => 'cli-2.0', - 'unbootable' => 1, - 'mac' => '01:02:03:04:05:02', - 'comment' => undef, - 'boot_type' => 'etherboot', + 'name' => 'cli-2.0', + 'unbootable' => 1, + 'mac' => '01:02:03:04:05:02', + 'comment' => undef, + 'boot_type' => 'etherboot', }; my $fullClient = { - 'name' => 'cli-nr-3', - 'mac' => '01:02:03:04:05:03', - 'comment' => 'nuff said', - 'kernel_params' => 'debug=3 console=ttyS1', - 'unbootable' => '0', - 'boot_type' => 'pxe', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'cli-nr-3', + 'mac' => '01:02:03:04:05:03', + 'comment' => 'nuff said', + 'kernel_params' => 'debug=3 console=ttyS1', + 'unbootable' => '0', + 'boot_type' => 'pxe', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($client2ID, $client3ID) = $configDB->addClient([ - $inClient2, $fullClient - ]), - 'add two more clients' + my ($client2ID, $client3ID) = $configDB->addClient([ + $inClient2, $fullClient + ]), + 'add two more clients' ); is($client2ID, 2, 'client 2 should have ID=2'); is($client3ID, 3, 'client 3 should have ID=3'); @@ -150,8 +150,8 @@ is(keys %{$client3->{attrs}}, 31, 'client 3 - attribu # fetch client 2 by a filter on id and check all values ok( - my $client2 = $configDB->fetchClientByFilter({ id => 2 }), - 'fetch client 2 by filter on id' + my $client2 = $configDB->fetchClientByFilter({ id => 2 }), + 'fetch client 2 by filter on id' ); is($client2->{id}, 2, 'client 2 - id'); is($client2->{name}, 'cli-2.0', 'client 2 - name'); @@ -163,8 +163,8 @@ is(keys %{$client2->{attrs}}, 0, 'client 2 - attribute count') # fetch client 1 by filter on name and check all values ok( - my $client1 = $configDB->fetchClientByFilter({ name => 'cli-1' }), - 'fetch client 1 by filter on name' + my $client1 = $configDB->fetchClientByFilter({ name => 'cli-1' }), + 'fetch client 1 by filter on name' ); is($client1->{id}, 1, 'client 1 - id'); is($client1->{name}, 'cli-1', 'client 1 - name'); @@ -180,8 +180,8 @@ is($client1->{attrs}->{start_sshd}, 'yes', 'client 1 - attr start_sshd') # fetch clients 3 & 1 by id ok( - my @clients3And1 = $configDB->fetchClientByID([3, 1]), - 'fetch clients 3 & 1 by id' + my @clients3And1 = $configDB->fetchClientByID([3, 1]), + 'fetch clients 3 & 1 by id' ); is(@clients3And1, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 3 and 1 @@ -191,21 +191,21 @@ is($clients3And1[1]->{id}, 3, 'second id should be 3'); # fetching clients by id without giving any should yield undef is( - $configDB->fetchClientByID(), undef, - 'fetch clients by id without giving any' + $configDB->fetchClientByID(), undef, + 'fetch clients by id without giving any' ); # fetching clients by filter without giving any should yield all of them ok( - @clients = $configDB->fetchClientByFilter(), - 'fetch clients by filter without giving any' + @clients = $configDB->fetchClientByFilter(), + 'fetch clients by filter without giving any' ); is(@clients, 4, 'should have got all four clients'); # fetch clients 1 & 2 by filter on boot_type ok( - my @clients1And3 = $configDB->fetchClientByFilter({ boot_type => 'pxe' }), - 'fetch clients 1 & 3 by filter on boot_type' + my @clients1And3 = $configDB->fetchClientByFilter({ boot_type => 'pxe' }), + 'fetch clients 1 & 3 by filter on boot_type' ); is(@clients1And3, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 1 and 3 @@ -215,17 +215,17 @@ is($clients1And3[1]->{id}, 3, 'second id should be 3'); # try to fetch with multi-column filter ok( - ($client1, $client3) - = $configDB->fetchClientByFilter({ boot_type => 'pxe', id => 1 }), - 'fetching client with boot_type=pxe and id=1 should work' + ($client1, $client3) + = $configDB->fetchClientByFilter({ boot_type => 'pxe', id => 1 }), + 'fetching client with boot_type=pxe and id=1 should work' ); is($client1->{name}, 'cli-1', 'should have got cli-1'); is($client3, undef, 'should not get cli-nr-3'); # fetch client 1 by filter on unbootable being undef'd ok( - my @client1Only = $configDB->fetchClientByFilter({ unbootable => undef }), - 'fetch client 1 by filter on unbootable being undefined' + my @client1Only = $configDB->fetchClientByFilter({ unbootable => undef }), + 'fetch client 1 by filter on unbootable being undefined' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); @@ -233,8 +233,8 @@ is($client1Only[0]->{id}, 1, 'first id should be 1'); # try to fetch multiple occurrences of the same client, combined with # some unknown IDs ok( - @clients1And3 = $configDB->fetchClientByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), - 'fetch a complex set of clients by ID' + @clients1And3 = $configDB->fetchClientByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of clients by ID' ); is(@clients1And3, 2, 'should have got 2 clients'); # now sort by ID and check if we have really got 1 and 3 @@ -244,74 +244,74 @@ is($clients1And3[1]->{id}, 3, 'second id should be 3'); # filter clients by different attributes & values in combination ok( - @client1Only = $configDB->fetchClientByFilter( {}, undef, { - start_snmp => 'no', - } ), - 'fetch client 1 by filter on attribute start_snmp' + @client1Only = $configDB->fetchClientByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch client 1 by filter on attribute start_snmp' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); ok( - @client1Only = $configDB->fetchClientByFilter( undef, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch client 1 by filter on attribute start_snmp + non-existing attr' + @client1Only = $configDB->fetchClientByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch client 1 by filter on attribute start_snmp + non-existing attr' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); ok( - @client1Only = $configDB->fetchClientByFilter( { - name => 'cli-1', - unbootable => undef, - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch client 1 by multiple filter on values and attributes' + @client1Only = $configDB->fetchClientByFilter( { + name => 'cli-1', + unbootable => undef, + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch client 1 by multiple filter on values and attributes' ); is(@client1Only, 1, 'should have got 1 client'); is($client1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchClientByFilter( { - comment => 'xxx', - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - undef, - 'mismatch client 1 by filter with incorrect value' + $configDB->fetchClientByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect value' ); is( - $configDB->fetchClientByFilter( { - name => 'cli-1', - }, 'id', { - start_snmp => 'yes', - tex_enable => undef, - } ), - undef, - 'mismatch client 1 by filter with incorrect attribute value' + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_snmp => 'yes', + tex_enable => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect attribute value' ); is( - $configDB->fetchClientByFilter( { - name => 'cli-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch client 1 by filter with attribute not being empty' + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch client 1 by filter with attribute not being empty' ); # fetch clients 0, 1 & 2 by filter on attribute start_samba not existing ok( - my @clients01And2 = $configDB->fetchClientByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch clients 0,1 & 2 by filter on attribute start_samba not existing' + my @clients01And2 = $configDB->fetchClientByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch clients 0,1 & 2 by filter on attribute start_samba not existing' ); is(@clients01And2, 3, 'should have got 3 clients'); # now sort by ID and check if we have really got 0, 1 and 2 @@ -322,34 +322,34 @@ is($clients01And2[2]->{id}, 2, 'third id should be 2'); # try to fetch a couple of non-existing clients by id is( - $configDB->fetchClientByID(-1), undef, - 'client with id -1 should not exist' + $configDB->fetchClientByID(-1), undef, + 'client with id -1 should not exist' ); ok($configDB->fetchClientByID(0), 'client with id 0 should exist'); is( - $configDB->fetchClientByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown client' + $configDB->fetchClientByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown client' ); # try to fetch a couple of non-existing clients by filter is( - $configDB->fetchClientByFilter({ id => 4 }), undef, - 'fetching client with id=4 by filter should fail' + $configDB->fetchClientByFilter({ id => 4 }), undef, + 'fetching client with id=4 by filter should fail' ); is( - $configDB->fetchClientByFilter({ name => 'cli-1.x' }), undef, - 'fetching client with name="cli-1.x" should fail' + $configDB->fetchClientByFilter({ name => 'cli-1.x' }), undef, + 'fetching client with name="cli-1.x" should fail' ); is( - $configDB->fetchClientByFilter({ mac => '01:01:01:01:01:01', id => 1 }), undef, - 'fetching client with mac=01:01:01:01:01:01 and id=1 should fail' + $configDB->fetchClientByFilter({ mac => '01:01:01:01:01:01', id => 1 }), undef, + 'fetching client with mac=01:01:01:01:01:01 and id=1 should fail' ); # rename client 1 and then fetch it by its new name ok($configDB->changeClient(1, { name => q{CLI-'1'} }), 'changing client 1'); ok( - $client1 = $configDB->fetchClientByFilter({ name => q{CLI-'1'} }), - 'fetching renamed client 1' + $client1 = $configDB->fetchClientByFilter({ name => q{CLI-'1'} }), + 'fetching renamed client 1' ); is($client1->{id}, 1, 'really got client number 1'); is($client1->{name}, q{CLI-'1'}, q{really got client named "CLI-'1'"}); @@ -386,8 +386,8 @@ ok(!exists $client1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeClient(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeClient(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeClient(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/14-group.t b/config-db/t/14-group.t index b06620ce..5c5d0f81 100644 --- a/config-db/t/14-group.t +++ b/config-db/t/14-group.t @@ -12,90 +12,90 @@ my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); is( - my $group = $configDB->fetchGroupByFilter, undef, - 'no group should exist (scalar context)' + my $group = $configDB->fetchGroupByFilter, undef, + 'no group should exist (scalar context)' ); foreach my $requiredCol (qw(name)) { - my $wrongGroup = { - 'name' => 'name', - 'priority' => 41, - 'comment' => 'has column missing', - }; - delete $wrongGroup->{$requiredCol}; - ok( - ! eval { my $groupID = $configDB->addGroup($wrongGroup); }, - "inserting a group without '$requiredCol' column should fail" - ); + my $wrongGroup = { + 'name' => 'name', + 'priority' => 41, + 'comment' => 'has column missing', + }; + delete $wrongGroup->{$requiredCol}; + ok( + ! eval { my $groupID = $configDB->addGroup($wrongGroup); }, + "inserting a group without '$requiredCol' column should fail" + ); } is( - my @groups = $configDB->fetchGroupByFilter, 0, - 'still no group should exist (array context)' + my @groups = $configDB->fetchGroupByFilter, 0, + 'still no group should exist (array context)' ); my $inGroup1 = { - 'name' => 'grp-1', - 'comment' => '', - 'attrs' => { - 'slxgrp' => 'slxgrp', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - }, + 'name' => 'grp-1', + 'comment' => '', + 'attrs' => { + 'slxgrp' => 'slxgrp', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, }; is( - my $group1ID = $configDB->addGroup($inGroup1), 1, - 'first group has ID 1' + my $group1ID = $configDB->addGroup($inGroup1), 1, + 'first group has ID 1' ); my $inGroup2 = { - 'name' => 'grp-2.0', - 'priority' => 30, - 'comment' => undef, + 'name' => 'grp-2.0', + 'priority' => 30, + 'comment' => undef, }; my $fullGroup = { - 'name' => 'grp-nr-3', - 'priority' => 50, - 'comment' => 'nuff said', - 'attrs' => { - 'automnt_dir' => 'a', - 'automnt_src' => 'b', - 'country' => 'c', - 'dm_allow_shutdown' => 'd', - 'hw_graphic' => 'e', - 'hw_monitor' => 'f', - 'hw_mouse' => 'g', - 'late_dm' => 'h', - 'netbios_workgroup' => 'i', - 'nis_domain' => 'j', - 'nis_servers' => 'k', - 'sane_scanner' => 'p', - 'scratch' => 'q', - 'slxgrp' => 'r', - 'start_alsasound' => 's', - 'start_atd' => 't', - 'start_cron' => 'u', - 'start_dreshal' => 'v', - 'start_ntp' => 'w', - 'start_nfsv4' => 'x', - 'start_printer' => 'y', - 'start_samba' => 'z', - 'start_snmp' => 'A', - 'start_sshd' => 'B', - 'start_syslog' => 'C', - 'start_x' => 'D', - 'start_xdmcp' => 'E', - 'tex_enable' => 'F', - 'timezone' => 'G', - 'tvout' => 'H', - 'vmware' => 'I', - }, + 'name' => 'grp-nr-3', + 'priority' => 50, + 'comment' => 'nuff said', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, }; ok( - my ($group2ID, $group3ID) = $configDB->addGroup([ - $inGroup2, $fullGroup - ]), - 'add two more groups' + my ($group2ID, $group3ID) = $configDB->addGroup([ + $inGroup2, $fullGroup + ]), + 'add two more groups' ); is($group2ID, 2, 'group 2 should have ID=2'); is($group3ID, 3, 'group 3 should have ID=3'); @@ -141,8 +141,8 @@ is(keys %{$group3->{attrs}}, 31, 'group 3 - attribute coun # fetch group 2 by a filter on id and check all values ok( - my $group2 = $configDB->fetchGroupByFilter({ id => 2 }), - 'fetch group 2 by filter on id' + my $group2 = $configDB->fetchGroupByFilter({ id => 2 }), + 'fetch group 2 by filter on id' ); is($group2->{id}, 2, 'group 2 - id'); is($group2->{name}, 'grp-2.0', 'group 2 - name'); @@ -152,8 +152,8 @@ is(keys %{$group2->{attrs}}, 0, 'group 2 - attribute count'); # fetch group 1 by filter on name and check all values ok( - my $group1 = $configDB->fetchGroupByFilter({ name => 'grp-1' }), - 'fetch group 1 by filter on name' + my $group1 = $configDB->fetchGroupByFilter({ name => 'grp-1' }), + 'fetch group 1 by filter on name' ); is($group1->{id}, 1, 'group 1 - id'); is($group1->{name}, 'grp-1', 'group 1 - name'); @@ -166,8 +166,8 @@ is($group1->{attrs}->{start_sshd}, 'yes', 'group 1 - attr start_sshd'); # fetch groups 3 & 1 by id ok( - my @groups3And1 = $configDB->fetchGroupByID([3, 1]), - 'fetch groups 3 & 1 by id' + my @groups3And1 = $configDB->fetchGroupByID([3, 1]), + 'fetch groups 3 & 1 by id' ); is(@groups3And1, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 3 and 1 @@ -177,21 +177,21 @@ is($groups3And1[1]->{id}, 3, 'second id should be 3'); # fetching groups by id without giving any should yield undef is( - $configDB->fetchGroupByID(), undef, - 'fetch groups by id without giving any' + $configDB->fetchGroupByID(), undef, + 'fetch groups by id without giving any' ); # fetching groups by filter without giving any should yield all of them ok( - @groups = $configDB->fetchGroupByFilter(), - 'fetch groups by filter without giving any' + @groups = $configDB->fetchGroupByFilter(), + 'fetch groups by filter without giving any' ); is(@groups, 3, 'should have got all three groups'); # fetch groups 1 & 2 by filter on priority ok( - my @groups1And3 = $configDB->fetchGroupByFilter({ priority => 50 }), - 'fetch groups 1 & 3 by filter on priority' + my @groups1And3 = $configDB->fetchGroupByFilter({ priority => 50 }), + 'fetch groups 1 & 3 by filter on priority' ); is(@groups1And3, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 3 @@ -201,17 +201,17 @@ is($groups1And3[1]->{id}, 3, 'second id should be 3'); # fetch group 2 by filter on comment being undef'd ok( - my @group2Only = $configDB->fetchGroupByFilter({ comment => undef }), - 'fetch group 2 by filter on comment being undefined' + my @group2Only = $configDB->fetchGroupByFilter({ comment => undef }), + 'fetch group 2 by filter on comment being undefined' ); is(@group2Only, 1, 'should have got 1 group'); is($group2Only[0]->{id}, 2, 'first id should be 2'); # try to fetch with multi-column filter ok( - ($group1, $group3) - = $configDB->fetchGroupByFilter({ priority => '50', id => 1 }), - 'fetching group with priority=50 and id=1 should work' + ($group1, $group3) + = $configDB->fetchGroupByFilter({ priority => '50', id => 1 }), + 'fetching group with priority=50 and id=1 should work' ); is($group1->{name}, 'grp-1', 'should have got grp-1'); is($group3, undef, 'should not get grp-nr-3'); @@ -219,8 +219,8 @@ is($group3, undef, 'should not get grp-nr-3'); # try to fetch multiple occurrences of the same group, combined with # some unknown IDs ok( - @groups1And3 = $configDB->fetchGroupByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), - 'fetch a complex set of groups by ID' + @groups1And3 = $configDB->fetchGroupByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of groups by ID' ); is(@groups1And3, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 3 @@ -230,74 +230,74 @@ is($groups1And3[1]->{id}, 3, 'second id should be 3'); # filter groups by different attributes & values in combination ok( - my @group1Only = $configDB->fetchGroupByFilter( {}, undef, { - start_snmp => 'no', - } ), - 'fetch group 1 by filter on attribute start_snmp' + my @group1Only = $configDB->fetchGroupByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch group 1 by filter on attribute start_snmp' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); ok( - @group1Only = $configDB->fetchGroupByFilter( undef, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch group 1 by filter on attribute start_snmp + non-existing attr' + @group1Only = $configDB->fetchGroupByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by filter on attribute start_snmp + non-existing attr' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); ok( - @group1Only = $configDB->fetchGroupByFilter( { - name => 'grp-1', - priority => 50, - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - 'fetch group 1 by multiple filter on values and attributes' + @group1Only = $configDB->fetchGroupByFilter( { + name => 'grp-1', + priority => 50, + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by multiple filter on values and attributes' ); is(@group1Only, 1, 'should have got 1 group'); is($group1Only[0]->{id}, 1, 'first id should be 1'); is( - $configDB->fetchGroupByFilter( { - comment => 'xxx', - }, 'id', { - start_snmp => 'no', - tex_enable => undef, - } ), - undef, - 'mismatch group 1 by filter with incorrect value' + $configDB->fetchGroupByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect value' ); is( - $configDB->fetchGroupByFilter( { - name => 'grp-1', - }, 'id', { - start_snmp => 'yes', - tex_enable => undef, - } ), - undef, - 'mismatch group 1 by filter with incorrect attribute value' + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_snmp => 'yes', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect attribute value' ); is( - $configDB->fetchGroupByFilter( { - name => 'grp-1', - }, 'id', { - start_sshd => undef, - } ), - undef, - 'mismatch group 1 by filter with attribute not being empty' + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch group 1 by filter with attribute not being empty' ); # fetch groups 1 & 2 by filter on attribute start_samba not existing ok( - my @groups1And2 = $configDB->fetchGroupByFilter( {}, undef, { - start_samba => undef, - } ), - 'fetch groups 1 & 2 by filter on attribute start_samba not existing' + my @groups1And2 = $configDB->fetchGroupByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch groups 1 & 2 by filter on attribute start_samba not existing' ); is(@groups1And2, 2, 'should have got 2 groups'); # now sort by ID and check if we have really got 1 and 2 @@ -309,29 +309,29 @@ is($groups1And2[1]->{id}, 2, 'second id should be 2'); is($configDB->fetchGroupByID(-1), undef, 'group with id -1 should not exist'); is($configDB->fetchGroupByID(0), undef, 'group with id 0 should not exist'); is( - $configDB->fetchGroupByID(1 << 31 + 1000), undef, - 'trying to fetch another unknown group' + $configDB->fetchGroupByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown group' ); # try to fetch a couple of non-existing groups by filter is( - $configDB->fetchGroupByFilter({ id => 4 }), undef, - 'fetching group with id=4 by filter should fail' + $configDB->fetchGroupByFilter({ id => 4 }), undef, + 'fetching group with id=4 by filter should fail' ); is( - $configDB->fetchGroupByFilter({ name => 'grp-1.x' }), undef, - 'fetching group with name="grp-1.x" should fail' + $configDB->fetchGroupByFilter({ name => 'grp-1.x' }), undef, + 'fetching group with name="grp-1.x" should fail' ); is( - $configDB->fetchGroupByFilter({ priority => '22', id => 1 }), undef, - 'fetching group with priority=22 and id=1 should fail' + $configDB->fetchGroupByFilter({ priority => '22', id => 1 }), undef, + 'fetching group with priority=22 and id=1 should fail' ); # rename group 1 and then fetch it by its new name ok($configDB->changeGroup(1, { name => q{GRP-'1'} }), 'changing group 1'); ok( - $group1 = $configDB->fetchGroupByFilter({ name => q{GRP-'1'} }), - 'fetching renamed group 1' + $group1 = $configDB->fetchGroupByFilter({ name => q{GRP-'1'} }), + 'fetching renamed group 1' ); is($group1->{id}, 1, 'really got group number 1'); is($group1->{name}, q{GRP-'1'}, q{really got group named "GRP-'1'"}); @@ -368,8 +368,8 @@ ok(!exists $group1->{attrs}->{vmware}, 'attr vmware should be gone'); # changing a non-existing column should fail ok( - ! eval { $configDB->changeGroup(1, { xname => "xx" }) }, - 'changing unknown colum should fail' + ! eval { $configDB->changeGroup(1, { xname => "xx" }) }, + 'changing unknown colum should fail' ); ok(! $configDB->changeGroup(1, { id => 23 }), 'changing id should fail'); diff --git a/config-db/t/15-global_info.t b/config-db/t/15-global_info.t index 628b2495..8f2f8cf1 100644 --- a/config-db/t/15-global_info.t +++ b/config-db/t/15-global_info.t @@ -13,30 +13,30 @@ $configDB->connect(); # fetch global-info 'next-nbd-server-port' ok( - my $globalInfo = $configDB->fetchGlobalInfo('next-nbd-server-port'), - 'fetch global-info' + my $globalInfo = $configDB->fetchGlobalInfo('next-nbd-server-port'), + 'fetch global-info' ); is($globalInfo, '5000', 'global-info - value'); # try to fetch a couple of non-existing global-infos is( - $configDB->fetchGlobalInfo(-1), undef, - 'global-info with id -1 should not exist' + $configDB->fetchGlobalInfo(-1), undef, + 'global-info with id -1 should not exist' ); is($configDB->fetchGlobalInfo('xxx'), undef, - 'global-info with id xxx should not exist'); + 'global-info with id xxx should not exist'); # change value of global-info and then fetch and check the new value ok($configDB->changeGlobalInfo('next-nbd-server-port', '5050'), 'changing global-info'); is( - $configDB->fetchGlobalInfo('next-nbd-server-port'), '5050', - 'fetching changed global-info' + $configDB->fetchGlobalInfo('next-nbd-server-port'), '5050', + 'fetching changed global-info' ); # changing a non-existing global-info should fail ok( - ! eval { $configDB->changeGlobalInfo('xxx', 'new-value') }, - 'changing unknown global-info should fail' + ! eval { $configDB->changeGlobalInfo('xxx', 'new-value') }, + 'changing unknown global-info should fail' ); $configDB->disconnect(); diff --git a/config-db/t/20-client_system_ref.t b/config-db/t/20-client_system_ref.t index 46e56ddf..93b86950 100644 --- a/config-db/t/20-client_system_ref.t +++ b/config-db/t/20-client_system_ref.t @@ -25,184 +25,184 @@ my $system1 = shift @systems; my $system3 = shift @systems; foreach my $client ($defaultClient, $client1, $client3) { - is( - my @systemIDs = $configDB->fetchSystemIDsOfClient($client->{id}), - 0, "client $client->{id} has no system-IDs yet" - ); + is( + my @systemIDs = $configDB->fetchSystemIDsOfClient($client->{id}), + 0, "client $client->{id} has no system-IDs yet" + ); } foreach my $system ($defaultSystem, $system1, $system3) { - is( - my @clientIDs = $configDB->fetchClientIDsOfSystem($system->{id}), - 0, "system $system->{id} has no client-IDs yet" - ); + is( + my @clientIDs = $configDB->fetchClientIDsOfSystem($system->{id}), + 0, "system $system->{id} has no client-IDs yet" + ); } ok( - $configDB->addSystemIDsToClient(1, [3]), - 'system-ID 3 has been associated to client 1' + $configDB->addSystemIDsToClient(1, [3]), + 'system-ID 3 has been associated to client 1' ); is( - my @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no system-ID" + my @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 1, "client 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of client 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 0, "client 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" ); is( - my @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-IDs" + my @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 1, "system 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 1, "system 3 should have one client-ID" ); is($clientIDs[0], 1, "first client of system 3 should have ID 1"); ok( - $configDB->addSystemIDsToClient(3, [1,3,3,1,3]), - 'system-IDs 1 and 3 have been associated to client 3' + $configDB->addSystemIDsToClient(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to client 3' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 1, "client 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of client 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 2, "client 3 should have two system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 2, "client 3 should have two system-IDs" ); is($systemIDs[0], 1, "first system of client 3 should have ID 1"); is($systemIDs[1], 3, "second system of client 3 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 1, "system 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of system 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 2, "system 3 should have two client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 2, "system 3 should have two client-IDs" ); is($clientIDs[0], 1, "first client of system 3 should have ID 1"); is($clientIDs[1], 3, "second client of system 3 should have ID 3"); ok( - $configDB->setClientIDsOfSystem(3, []), - 'client-IDs of system 3 have been set to empty array' + $configDB->setClientIDsOfSystem(3, []), + 'client-IDs of system 3 have been set to empty array' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 0, "system 3 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should have no system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 1, "client 3 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 1, "client 3 should have one system-ID" ); is($systemIDs[0], 1, "first system of client 3 should have ID 1"); ok( - $configDB->addSystemIDsToClient(1, [0]), - 'associating the default system should have no effect' + $configDB->addSystemIDsToClient(1, [0]), + 'associating the default system should have no effect' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should still have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should still have no system-ID" ); ok( - $configDB->removeClientIDsFromSystem(1, [1]), - 'removing an unassociated client-ID should have no effect' + $configDB->removeClientIDsFromSystem(1, [1]), + 'removing an unassociated client-ID should have no effect' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 1, "system 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" ); ok( - $configDB->removeClientIDsFromSystem(1, [3]), - 'removing an associated client-ID should work' + $configDB->removeClientIDsFromSystem(1, [3]), + 'removing an associated client-ID should work' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no more client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no more client-ID" ); $configDB->addSystem({ - 'name' => 'sys-4', - 'export_id' => 1, - 'comment' => 'shortlived', + 'name' => 'sys-4', + 'export_id' => 1, + 'comment' => 'shortlived', }); ok( - $configDB->addClientIDsToSystem(4, [0]), - 'default client has been associated to system 4' + $configDB->addClientIDsToSystem(4, [0]), + 'default client has been associated to system 4' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 1, "default client should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" ); is($systemIDs[0], 4, "first system of default client should have ID 4"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), - 0, "client 1 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), - 0, "client 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), - 0, "default system should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), - 0, "system 1 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), - 0, "system 3 should have no client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfSystem(4)), - 1, "system 4 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfSystem(4)), + 1, "system 4 should have one client-ID" ); is($clientIDs[0], 0, "first client of system 4 should have ID 0"); ok( - $configDB->removeSystemIDsFromClient(0, [6]), - 'removing an unassociated system-ID should have no effect' + $configDB->removeSystemIDsFromClient(0, [6]), + 'removing an unassociated system-ID should have no effect' ); is( - @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 1, "default client should have one system-ID" + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" ); ok( - $configDB->removeSystem(4), - 'removing a system should drop client associations, too' + $configDB->removeSystem(4), + 'removing a system should drop client associations, too' ); is( - @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), - 0, "default client should have no more system-ID" + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no more system-ID" ); $configDB->disconnect(); diff --git a/config-db/t/21-group_system_ref.t b/config-db/t/21-group_system_ref.t index 6f92a8dd..b643f7e0 100644 --- a/config-db/t/21-group_system_ref.t +++ b/config-db/t/21-group_system_ref.t @@ -24,172 +24,172 @@ my $system1 = shift @systems; my $system3 = shift @systems; foreach my $group ($group1, $group3) { - is( - my @systemIDs = $configDB->fetchSystemIDsOfGroup($group->{id}), - 0, "group $group->{id} has no system-IDs yet" - ); + is( + my @systemIDs = $configDB->fetchSystemIDsOfGroup($group->{id}), + 0, "group $group->{id} has no system-IDs yet" + ); } foreach my $system ($defaultSystem, $system1, $system3) { - is( - my @groupIDs = $configDB->fetchGroupIDsOfSystem($system->{id}), - 0, "system $system->{id} has no group-IDs yet" - ); + is( + my @groupIDs = $configDB->fetchGroupIDsOfSystem($system->{id}), + 0, "system $system->{id} has no group-IDs yet" + ); } ok( - $configDB->addSystemIDsToGroup(1, [3]), - 'system-ID 3 has been associated to group 1' + $configDB->addSystemIDsToGroup(1, [3]), + 'system-ID 3 has been associated to group 1' ); is( - my @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 1, "group 1 should have one system-ID" + my @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of group 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 0, "group 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no system-ID" ); is( - my @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-IDs" + my @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 1, "system 3 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 1, "system 3 should have one group-ID" ); is($groupIDs[0], 1, "first group of system 3 should have ID 1"); ok( - $configDB->addSystemIDsToGroup(3, [1,3,3,1,3]), - 'system-IDs 1 and 3 have been associated to group 3' + $configDB->addSystemIDsToGroup(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to group 3' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 1, "group 1 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" ); is($systemIDs[0], 3, "first system of group 1 should have ID 3"); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 2, "group 3 should have two system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 2, "group 3 should have two system-IDs" ); is($systemIDs[0], 1, "first system of group 3 should have ID 1"); is($systemIDs[1], 3, "second system of group 3 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 1, "system 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" ); is($groupIDs[0], 3, "first group of system 1 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 2, "system 3 should have two group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 2, "system 3 should have two group-IDs" ); is($groupIDs[0], 1, "first group of system 3 should have ID 1"); is($groupIDs[1], 3, "second group of system 3 should have ID 3"); ok( - $configDB->setGroupIDsOfSystem(3, []), - 'group-IDs of system 3 have been set to empty array' + $configDB->setGroupIDsOfSystem(3, []), + 'group-IDs of system 3 have been set to empty array' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 0, "system 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should have no more system-IDs" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no more system-IDs" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have one system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" ); is($systemIDs[0], 1, "first system of group 3 should have ID 1"); ok( - $configDB->addSystemIDsToGroup(1, [0]), - 'associating the default system should have no effect' + $configDB->addSystemIDsToGroup(1, [0]), + 'associating the default system should have no effect' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should still have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should still have no system-ID" ); ok( - $configDB->removeGroupIDsFromSystem(1, [1]), - 'removing an unassociated group-ID should have no effect' + $configDB->removeGroupIDsFromSystem(1, [1]), + 'removing an unassociated group-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 1, "system 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" ); ok( - $configDB->removeGroupIDsFromSystem(1, [3]), - 'removing an associated group-ID should work' + $configDB->removeGroupIDsFromSystem(1, [3]), + 'removing an associated group-ID should work' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no more group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no more group-ID" ); $configDB->addSystem({ - 'name' => 'sys-5', - 'export_id' => 1, - 'comment' => 'shortlived', + 'name' => 'sys-5', + 'export_id' => 1, + 'comment' => 'shortlived', }); ok( - $configDB->addGroupIDsToSystem(5, [3]), - 'default group has been associated to system 5' + $configDB->addGroupIDsToSystem(5, [3]), + 'default group has been associated to system 5' ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), - 0, "group 1 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no system-ID" ); is( - @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have no system-ID" + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have no system-ID" ); is($systemIDs[0], 5, "first system of group 3 should have ID 5"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), - 0, "default system should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), - 0, "system 1 should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), - 0, "system 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfSystem(5)), - 1, "system 5 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(5)), + 1, "system 5 should have one group-ID" ); is($groupIDs[0], 3, "first group of system 5 should have ID 3"); ok( - $configDB->removeSystemIDsFromGroup(3, [6]), - 'removing an unassociated system-ID should have no effect' + $configDB->removeSystemIDsFromGroup(3, [6]), + 'removing an unassociated system-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 1, "group 3 should have one system-ID" + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" ); ok( - $configDB->removeSystem(5), - 'removing a system should drop group associations, too' + $configDB->removeSystem(5), + 'removing a system should drop group associations, too' ); is( - @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), - 0, "group 3 should have no more system-ID" + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no more system-ID" ); $configDB->disconnect(); diff --git a/config-db/t/22-group_client_ref.t b/config-db/t/22-group_client_ref.t index d330bc23..ff9d6ca7 100644 --- a/config-db/t/22-group_client_ref.t +++ b/config-db/t/22-group_client_ref.t @@ -24,163 +24,163 @@ my $client1 = shift @clients; my $client3 = shift @clients; foreach my $group ($group1, $group3) { - is( - my @clientIDs = $configDB->fetchClientIDsOfGroup($group->{id}), - 0, "group $group->{id} has no client-IDs yet" - ); + is( + my @clientIDs = $configDB->fetchClientIDsOfGroup($group->{id}), + 0, "group $group->{id} has no client-IDs yet" + ); } foreach my $client ($defaultClient, $client1, $client3) { - is( - my @groupIDs = $configDB->fetchGroupIDsOfClient($client->{id}), - 0, "client $client->{id} has no group-IDs yet" - ); + is( + my @groupIDs = $configDB->fetchGroupIDsOfClient($client->{id}), + 0, "client $client->{id} has no group-IDs yet" + ); } ok( - $configDB->addClientIDsToGroup(1, [3]), - 'client-ID 3 has been associated to group 1' + $configDB->addClientIDsToGroup(1, [3]), + 'client-ID 3 has been associated to group 1' ); is( - my @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 1, "group 1 should have one client-ID" + my @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of group 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 0, "group 3 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no client-ID" ); is( - my @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-IDs" + my @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 1, "client 3 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 1, "client 3 should have one group-ID" ); is($groupIDs[0], 1, "first group of client 3 should have ID 1"); ok( - $configDB->addClientIDsToGroup(3, [1,3,3,1,3]), - 'client-IDs 1 and 3 have been associated to group 3' + $configDB->addClientIDsToGroup(3, [1,3,3,1,3]), + 'client-IDs 1 and 3 have been associated to group 3' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 1, "group 1 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" ); is($clientIDs[0], 3, "first client of group 1 should have ID 3"); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 2, "group 3 should have two client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 2, "group 3 should have two client-IDs" ); is($clientIDs[0], 1, "first client of group 3 should have ID 1"); is($clientIDs[1], 3, "second client of group 3 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 1, "client 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" ); is($groupIDs[0], 3, "first group of client 1 should have ID 3"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 2, "client 3 should have two group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 2, "client 3 should have two group-IDs" ); is($groupIDs[0], 1, "first group of client 3 should have ID 1"); is($groupIDs[1], 3, "second group of client 3 should have ID 3"); ok( - $configDB->setGroupIDsOfClient(3, []), - 'group-IDs of client 3 have been set to empty array' + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set to empty array' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 0, "client 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 0, "group 1 should have no more client-IDs" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no more client-IDs" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); is($clientIDs[0], 1, "first client of group 3 should have ID 1"); ok( - $configDB->removeGroupIDsFromClient(1, [1]), - 'removing an unassociated group-ID should have no effect' + $configDB->removeGroupIDsFromClient(1, [1]), + 'removing an unassociated group-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 1, "client 1 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" ); ok( - $configDB->removeGroupIDsFromClient(1, [3]), - 'removing an associated group-ID should work' + $configDB->removeGroupIDsFromClient(1, [3]), + 'removing an associated group-ID should work' ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no more group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no more group-ID" ); $configDB->addClient({ - 'name' => 'cli-4', - 'mac' => '01:01:01:02:02:02', - 'comment' => 'shortlived', + 'name' => 'cli-4', + 'mac' => '01:01:01:02:02:02', + 'comment' => 'shortlived', }); ok( - $configDB->addGroupIDsToClient(4, [3]), - 'default group has been associated to client 4' + $configDB->addGroupIDsToClient(4, [3]), + 'default group has been associated to client 4' ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), - 0, "group 1 should have no client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no client-ID" ); is( - @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); is($clientIDs[0], 4, "first client of group 3 should have ID 1"); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), - 0, "default client should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), - 0, "client 1 should have no group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-ID" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), - 0, "client 3 should have no group-IDs" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" ); is( - @groupIDs = sort($configDB->fetchGroupIDsOfClient(4)), - 1, "client 4 should have one group-ID" + @groupIDs = sort($configDB->fetchGroupIDsOfClient(4)), + 1, "client 4 should have one group-ID" ); is($groupIDs[0], 3, "first group of client 4 should have ID 3"); ok( - $configDB->removeClientIDsFromGroup(3, [6]), - 'removing an unassociated client-ID should have no effect' + $configDB->removeClientIDsFromGroup(3, [6]), + 'removing an unassociated client-ID should have no effect' ); is( - @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 1, "group 3 should have one client-ID" + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" ); ok( - $configDB->removeClient(4), - 'removing a client should drop group associations, too' + $configDB->removeClient(4), + 'removing a client should drop group associations, too' ); is( - @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), - 0, "group 3 should have no more client-ID" + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no more client-ID" ); $configDB->disconnect(); diff --git a/config-db/t/25-attributes.t b/config-db/t/25-attributes.t index 469d330c..32c1b0fb 100644 --- a/config-db/t/25-attributes.t +++ b/config-db/t/25-attributes.t @@ -13,350 +13,350 @@ use OpenSLX::ConfigDB qw(:support); my $configDB = OpenSLX::ConfigDB->new; $configDB->connect(); -my $defaultAttrs = { # mostly copied from DBSchema - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'no', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'yes', - 'start_xdmcp' => 'kdm', - 'tex_enable' => 'no', - 'timezone' => 'Europe/Berlin', - 'tvout' => 'no', - 'vmware' => 'no', +my $defaultAttrs = { # mostly copied from DBSchema + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'yes', + 'start_xdmcp' => 'kdm', + 'tex_enable' => 'no', + 'timezone' => 'Europe/Berlin', + 'tvout' => 'no', + 'vmware' => 'no', }; ok( - $configDB->changeSystem(0, { attrs => $defaultAttrs } ), - 'attributes of default system have been set' + $configDB->changeSystem(0, { attrs => $defaultAttrs } ), + 'attributes of default system have been set' ); my $defaultSystem = $configDB->fetchSystemByID(0); my $system1 = $configDB->fetchSystemByID(1); my $sys1Attrs = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - 'start_x' => 'no', - 'start_xdmcp' => '', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + 'start_x' => 'no', + 'start_xdmcp' => '', }; ok( - $configDB->changeSystem(1, { attrs => $sys1Attrs } ), - 'attributes of system 1 have been set' + $configDB->changeSystem(1, { attrs => $sys1Attrs } ), + 'attributes of system 1 have been set' ); my $system3 = $configDB->fetchSystemByID(3); my $sys3Attrs = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '13', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => '23', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => '29', - 'tvout' => '30', - 'vmware' => '31', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => '23', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => '29', + 'tvout' => '30', + 'vmware' => '31', }; ok( - $configDB->changeSystem(3, { attrs => $sys3Attrs } ), - 'attributes of system 3 have been set' + $configDB->changeSystem(3, { attrs => $sys3Attrs } ), + 'attributes of system 3 have been set' ); my $defaultClient = $configDB->fetchClientByID(0); my $defaultClientAttrs = { - # pretend the whole computer centre has been warped to London ;-) - 'timezone' => 'Europe/London', - # pretend we wanted to activate snmp globally (e.g. for testing) - 'start_snmp' => 'yes', + # pretend the whole computer centre has been warped to London ;-) + 'timezone' => 'Europe/London', + # pretend we wanted to activate snmp globally (e.g. for testing) + 'start_snmp' => 'yes', }; ok( - $configDB->changeClient(0, { attrs => $defaultClientAttrs } ), - 'attributes of default client have been set' + $configDB->changeClient(0, { attrs => $defaultClientAttrs } ), + 'attributes of default client have been set' ); # check merging of default attributes, the order should be: # default system attributes overruled by system attributes overruled by # default client attributes: my $shouldBeAttrs1 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'Europe/London', - 'tvout' => 'no', - 'vmware' => 'no', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'no', }; my $mergedSystem1 = $configDB->fetchSystemByID(1); ok( - $configDB->mergeDefaultAttributesIntoSystem($mergedSystem1), - 'merging default attributes into system 1' + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem1), + 'merging default attributes into system 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedSystem1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for system 1" - ); + is( + $mergedSystem1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for system 1" + ); } # check merging code for completeness (using all attributes): my $shouldBeAttrs3 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '13', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'Europe/London', - 'tvout' => '30', - 'vmware' => '31', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => '31', }; my $mergedSystem3 = $configDB->fetchSystemByID(3); ok( - $configDB->mergeDefaultAttributesIntoSystem($mergedSystem3), - 'merging default attributes into system 3' + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem3), + 'merging default attributes into system 3' ); foreach my $key (sort keys %$shouldBeAttrs3) { - is( - $mergedSystem3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for system 3" - ); + is( + $mergedSystem3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for system 3" + ); } # setup client / group relations my $group1 = $configDB->fetchGroupByID(1); my $group1Attrs = { - 'priority' => '50', - # this group of clients is connected via underwater cable ... - 'timezone' => 'America/New_York', - # ... and use a local scratch partition - 'scratch' => '/dev/sdd1', - # the following should be a noop (as that attribute is system-specific) -# 'ramfs_nicmods' => 'e1000', + 'priority' => '50', + # this group of clients is connected via underwater cable ... + 'timezone' => 'America/New_York', + # ... and use a local scratch partition + 'scratch' => '/dev/sdd1', + # the following should be a noop (as that attribute is system-specific) +# 'ramfs_nicmods' => 'e1000', }; ok( - $configDB->changeGroup(1, { attrs => $group1Attrs } ), - 'attributes of group 1 have been set' + $configDB->changeGroup(1, { attrs => $group1Attrs } ), + 'attributes of group 1 have been set' ); my $group3 = $configDB->fetchGroupByID(3); my $group3Attrs = { - 'priority' => '30', - # this specific client group is older and thus has a different scratch - 'scratch' => '/dev/hdd1', - 'vmware' => 'yes', + 'priority' => '30', + # this specific client group is older and thus has a different scratch + 'scratch' => '/dev/hdd1', + 'vmware' => 'yes', }; ok( - $configDB->changeGroup(3, { attrs => $group3Attrs } ), - 'attributes of group 3 have been set' + $configDB->changeGroup(3, { attrs => $group3Attrs } ), + 'attributes of group 3 have been set' ); my $client1 = $configDB->fetchClientByID(1); my $client1Attrs = { - # this specific client uses yet another local scratch partition - 'scratch' => '/dev/sdx3', + # this specific client uses yet another local scratch partition + 'scratch' => '/dev/sdx3', }; ok( - $configDB->changeClient(1, { attrs => $client1Attrs } ), - 'attributes of client 1 have been set' + $configDB->changeClient(1, { attrs => $client1Attrs } ), + 'attributes of client 1 have been set' ); ok( - $configDB->setGroupIDsOfClient(1, [1]), - 'group-IDs of client 1 have been set' + $configDB->setGroupIDsOfClient(1, [1]), + 'group-IDs of client 1 have been set' ); ok( - $configDB->setGroupIDsOfClient(3, []), - 'group-IDs of client 3 have been set' + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set' ); # check merging of attributes into client, the order should be: # default client attributes overruled by group attributes (ordered by priority) # overruled by specific client attributes: $shouldBeAttrs1 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'America/New_York', - 'tvout' => undef, - 'vmware' => undef, + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => undef, }; my $mergedClient1 = $configDB->fetchClientByID(1); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), - 'merging default and group attributes into client 1' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for client 1" - ); + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); } $shouldBeAttrs3 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => undef, - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'Europe/London', - 'tvout' => undef, - 'vmware' => undef, + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => undef, }; # remove all attributes from client 3 @@ -364,314 +364,314 @@ $configDB->changeClient(3, { attrs => {} } ); my $mergedClient3 = $configDB->fetchClientByID(3); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), - 'merging default and group attributes into client 3' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for client 3" - ); + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); } # now associate default client with group 3 and try again ok( - $configDB->setGroupIDsOfClient(0, [3]), - 'group-IDs of default client have been set' + $configDB->setGroupIDsOfClient(0, [3]), + 'group-IDs of default client have been set' ); $shouldBeAttrs1 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'America/New_York', - 'tvout' => undef, - 'vmware' => 'yes', + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => 'yes', }; $mergedClient1 = $configDB->fetchClientByID(1); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), - 'merging default and group attributes into client 1' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, - "checking merged attribute $key for client 1" - ); + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); } $shouldBeAttrs3 = { - 'ramfs_fsmods' => undef, - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => undef, - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => undef, - 'dm_allow_shutdown' => undef, - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => undef, - 'netbios_workgroup' => undef, - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/hdd1', - 'slxgrp' => undef, - 'start_alsasound' => undef, - 'start_atd' => undef, - 'start_cron' => undef, - 'start_dreshal' => undef, - 'start_ntp' => undef, - 'start_nfsv4' => undef, - 'start_printer' => undef, - 'start_samba' => undef, - 'start_snmp' => 'yes', - 'start_sshd' => undef, - 'start_syslog' => undef, - 'start_x' => undef, - 'start_xdmcp' => undef, - 'tex_enable' => undef, - 'timezone' => 'Europe/London', - 'tvout' => undef, - 'vmware' => 'yes', + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => 'yes', }; $mergedClient3 = $configDB->fetchClientByID(3); ok( - $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), - 'merging default and group attributes into client 3' + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' ); foreach my $key (sort keys %$shouldBeAttrs1) { - is( - $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, - "checking merged attribute $key for client 3" - ); + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); } # finally we merge systems into clients and check the outcome of that my $fullMerge11 = dclone($mergedClient1); ok( - mergeAttributes($fullMerge11, $mergedSystem1), - 'merging system 1 into client 1' + mergeAttributes($fullMerge11, $mergedSystem1), + 'merging system 1 into client 1' ); my $shouldBeAttrs11 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/sdx3', - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'America/New_York', - 'tvout' => 'no', - 'vmware' => 'yes', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'America/New_York', + 'tvout' => 'no', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs11) { - is( - $fullMerge11->{attrs}->{$key}, $shouldBeAttrs11->{$key}, - "checking merged attribute $key for client 1 / system 1" - ); + is( + $fullMerge11->{attrs}->{$key}, $shouldBeAttrs11->{$key}, + "checking merged attribute $key for client 1 / system 1" + ); } my $fullMerge31 = dclone($mergedClient3); ok( - mergeAttributes($fullMerge31, $mergedSystem1), - 'merging system 1 into client 3' + mergeAttributes($fullMerge31, $mergedSystem1), + 'merging system 1 into client 3' ); my $shouldBeAttrs31 = { - 'ramfs_fsmods' => 'squashfs', - 'ramfs_miscmods' => undef, - 'ramfs_nicmods' => 'forcedeth e1000 r8169', - - 'automnt_dir' => undef, - 'automnt_src' => undef, - 'country' => 'de', - 'dm_allow_shutdown' => 'user', - 'hw_graphic' => undef, - 'hw_monitor' => undef, - 'hw_mouse' => undef, - 'late_dm' => 'no', - 'netbios_workgroup' => 'slx-network', - 'nis_domain' => undef, - 'nis_servers' => undef, - 'sane_scanner' => undef, - 'scratch' => '/dev/hdd1', - 'slxgrp' => undef, - 'start_alsasound' => 'yes', - 'start_atd' => 'no', - 'start_cron' => 'no', - 'start_dreshal' => 'yes', - 'start_ntp' => 'initial', - 'start_nfsv4' => 'no', - 'start_printer' => 'no', - 'start_samba' => 'may', - 'start_snmp' => 'yes', - 'start_sshd' => 'yes', - 'start_syslog' => 'yes', - 'start_x' => 'no', - 'start_xdmcp' => '', - 'tex_enable' => 'no', - 'timezone' => 'Europe/London', - 'tvout' => 'no', - 'vmware' => 'yes', + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs31) { - is( - $fullMerge31->{attrs}->{$key}, $shouldBeAttrs31->{$key}, - "checking merged attribute $key for client 3 / system 1" - ); + is( + $fullMerge31->{attrs}->{$key}, $shouldBeAttrs31->{$key}, + "checking merged attribute $key for client 3 / system 1" + ); } my $fullMerge13 = dclone($mergedClient1); ok( - mergeAttributes($fullMerge13, $mergedSystem3), - 'merging system 3 into client 1' + mergeAttributes($fullMerge13, $mergedSystem3), + 'merging system 3 into client 1' ); my $shouldBeAttrs13 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '/dev/sdx3', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'America/New_York', - 'tvout' => '30', - 'vmware' => 'yes', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/sdx3', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'America/New_York', + 'tvout' => '30', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs13) { - is( - $fullMerge13->{attrs}->{$key}, $shouldBeAttrs13->{$key}, - "checking merged attribute $key for client 1 / system 3" - ); + is( + $fullMerge13->{attrs}->{$key}, $shouldBeAttrs13->{$key}, + "checking merged attribute $key for client 1 / system 3" + ); } my $fullMerge33 = dclone($mergedClient3); ok( - mergeAttributes($fullMerge33, $mergedSystem3), - 'merging system 3 into client 3' + mergeAttributes($fullMerge33, $mergedSystem3), + 'merging system 3 into client 3' ); my $shouldBeAttrs33 = { - 'ramfs_fsmods' => '-4', - 'ramfs_miscmods' => '-3', - 'ramfs_nicmods' => '-2', - - 'automnt_dir' => '1', - 'automnt_src' => '2', - 'country' => '3', - 'dm_allow_shutdown' => '4', - 'hw_graphic' => '5', - 'hw_monitor' => '6', - 'hw_mouse' => '7', - 'late_dm' => '8', - 'netbios_workgroup' => '9', - 'nis_domain' => '10', - 'nis_servers' => '11', - 'sane_scanner' => '12', - 'scratch' => '/dev/hdd1', - 'slxgrp' => '14', - 'start_alsasound' => '15', - 'start_atd' => '16', - 'start_cron' => '17', - 'start_dreshal' => '18', - 'start_ntp' => '19', - 'start_nfsv4' => '20', - 'start_printer' => '21', - 'start_samba' => '22', - 'start_snmp' => 'yes', - 'start_sshd' => '24', - 'start_syslog' => '25', - 'start_x' => '26', - 'start_xdmcp' => '27', - 'tex_enable' => '28', - 'timezone' => 'Europe/London', - 'tvout' => '30', - 'vmware' => 'yes', + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/hdd1', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => 'yes', }; foreach my $key (sort keys %$shouldBeAttrs33) { - is( - $fullMerge33->{attrs}->{$key}, $shouldBeAttrs33->{$key}, - "checking merged attribute $key for client 3 / system 3" - ); + is( + $fullMerge33->{attrs}->{$key}, $shouldBeAttrs33->{$key}, + "checking merged attribute $key for client 3 / system 3" + ); } $configDB->disconnect(); diff --git a/config-db/t/29-transaction.t b/config-db/t/29-transaction.t index 2088a16c..1f1566bf 100644 --- a/config-db/t/29-transaction.t +++ b/config-db/t/29-transaction.t @@ -30,7 +30,7 @@ my @clients2 = $configDB->fetchClientByFilter(); my @groups2 = $configDB->fetchGroupByFilter(); is( - scalar @vendorOSes2, scalar @vendorOSes, "should still have all vendor-OSes" + scalar @vendorOSes2, scalar @vendorOSes, "should still have all vendor-OSes" ); is(scalar @exports2, scalar @exports, "should still have all exports"); is(scalar @systems2, scalar @systems, "should still have all systems"); diff --git a/config-db/t/run-all-tests.pl b/config-db/t/run-all-tests.pl index c082052d..4ae59a7d 100755 --- a/config-db/t/run-all-tests.pl +++ b/config-db/t/run-all-tests.pl @@ -28,8 +28,8 @@ $Test::Harness::Verbose = 1 if $openslxConfig{'verbose-level'}; # remove the test-db if it already exists my $metaDB = OpenSLX::MetaDB::SQLite->new(); if ($metaDB->databaseExists()) { - print "removing leftovers of slx-test-db\n"; - $metaDB->dropDatabase(); + print "removing leftovers of slx-test-db\n"; + $metaDB->dropDatabase(); } runtests(glob("*.t")); diff --git a/initramfs/OpenSLX/LibScanner.pm b/initramfs/OpenSLX/LibScanner.pm index c5cef34a..b1c96d7c 100644 --- a/initramfs/OpenSLX/LibScanner.pm +++ b/initramfs/OpenSLX/LibScanner.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # LibScanner.pm -# - module that recursively scans a given binary for library dependencies +# - module that recursively scans a given binary for library dependencies # ----------------------------------------------------------------------------- package OpenSLX::LibScanner; @@ -27,236 +27,236 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $params = shift || {}; + my $class = shift; + my $params = shift || {}; - checkParams($params, { - 'root-path' => '!', - 'verbose' => '?', - } ); + checkParams($params, { + 'root-path' => '!', + 'verbose' => '?', + } ); - my $self = { - rootPath => $params->{'root-path'}, - verbose => $params->{'verbose'} || 0, - }; + my $self = { + rootPath => $params->{'root-path'}, + verbose => $params->{'verbose'} || 0, + }; - return bless $self, $class; + return bless $self, $class; } sub determineRequiredLibs { - my $self = shift; - my @binaries = @_; + my $self = shift; + my @binaries = @_; - $self->{filesToDo} = []; - $self->{libs} = []; - $self->{libInfo} = {}; + $self->{filesToDo} = []; + $self->{libs} = []; + $self->{libInfo} = {}; - $self->_fetchLoaderConfig(); - - foreach my $binary (@binaries) { - if (substr($binary, 0, 1) ne '/') { - # force relative paths relative to $rootPath: - $binary = "$self->{rootPath}/$binary"; - } - if (!-e $binary) { - warn _tr("$0: unable to find file '%s', skipping it\n", $binary); - next; - } - push @{$self->{filesToDo}}, $binary; - } - - foreach my $file (@{$self->{filesToDo}}) { - $self->_addLibsForBinary($file); - } + $self->_fetchLoaderConfig(); + + foreach my $binary (@binaries) { + if (substr($binary, 0, 1) ne '/') { + # force relative paths relative to $rootPath: + $binary = "$self->{rootPath}/$binary"; + } + if (!-e $binary) { + warn _tr("$0: unable to find file '%s', skipping it\n", $binary); + next; + } + push @{$self->{filesToDo}}, $binary; + } + + foreach my $file (@{$self->{filesToDo}}) { + $self->_addLibsForBinary($file); + } - return @{$self->{libs}}; + return @{$self->{libs}}; } sub _fetchLoaderConfig { - my $self = shift; + my $self = shift; - my @libFolders; + my @libFolders; - if (!-e "$self->{rootPath}/etc") { - die _tr("'%s'-folder not found, maybe wrong root-path?\n", - "$self->{rootPath}/etc"); - } - $self->_fetchLoaderConfigFile("$self->{rootPath}/etc/ld.so.conf"); + if (!-e "$self->{rootPath}/etc") { + die _tr("'%s'-folder not found, maybe wrong root-path?\n", + "$self->{rootPath}/etc"); + } + $self->_fetchLoaderConfigFile("$self->{rootPath}/etc/ld.so.conf"); - # add "trusted" folders /lib and /usr/lib if not already in place: - if (!grep { m[^$self->{rootPath}/lib$] } @libFolders) { - push @libFolders, "$self->{rootPath}/lib"; - } - if (!grep { m[^$self->{rootPath}/usr/lib$] } @libFolders) { - push @libFolders, "$self->{rootPath}/usr/lib"; - } + # add "trusted" folders /lib and /usr/lib if not already in place: + if (!grep { m[^$self->{rootPath}/lib$] } @libFolders) { + push @libFolders, "$self->{rootPath}/lib"; + } + if (!grep { m[^$self->{rootPath}/usr/lib$] } @libFolders) { + push @libFolders, "$self->{rootPath}/usr/lib"; + } - # add lib32-folders for 64-bit Debians, as they do not - # refer those in ld.so.conf (which I find strange...) - if (-e '/lib32' && !grep { m[^$self->{rootPath}/lib32$] } @libFolders) { - push @libFolders, "$self->{rootPath}/lib32"; - } - if (-e '/usr/lib32' - && !grep { m[^$self->{rootPath}/usr/lib32$] } @libFolders) - { - push @libFolders, "$self->{rootPath}/usr/lib32"; - } + # add lib32-folders for 64-bit Debians, as they do not + # refer those in ld.so.conf (which I find strange...) + if (-e '/lib32' && !grep { m[^$self->{rootPath}/lib32$] } @libFolders) { + push @libFolders, "$self->{rootPath}/lib32"; + } + if (-e '/usr/lib32' + && !grep { m[^$self->{rootPath}/usr/lib32$] } @libFolders) + { + push @libFolders, "$self->{rootPath}/usr/lib32"; + } - $self->{libFolders} = \@libFolders; + $self->{libFolders} = \@libFolders; - return; + return; } sub _fetchLoaderConfigFile { - my $self = shift; - my $ldConfFile = shift; + my $self = shift; + my $ldConfFile = shift; - return unless -e $ldConfFile; - my $ldconfFH; - if (!open($ldconfFH, '<', $ldConfFile)) { - warn(_tr("unable to open file '%s' (%s)", $ldConfFile, $!)); - return; - } - while (<$ldconfFH>) { - chomp; - if (m{^\s*include\s+(.+?)\s*$}i) { - my @incFiles = glob("$self->{rootPath}$1"); - foreach my $incFile (@incFiles) { - if ($incFile) { - $self->_fetchLoaderConfigFile($incFile); - } - } - next; - } - if (m{\S+}i) { - s[=.+][]; - # remove any lib-type specifications (e.g. '=libc5') - push @{$self->{libFolders}}, "$self->{rootPath}$_"; - } - } - close $ldconfFH - or die(_tr("unable to close file '%s' (%s)", $ldConfFile, $!)); - return; + return unless -e $ldConfFile; + my $ldconfFH; + if (!open($ldconfFH, '<', $ldConfFile)) { + warn(_tr("unable to open file '%s' (%s)", $ldConfFile, $!)); + return; + } + while (<$ldconfFH>) { + chomp; + if (m{^\s*include\s+(.+?)\s*$}i) { + my @incFiles = glob("$self->{rootPath}$1"); + foreach my $incFile (@incFiles) { + if ($incFile) { + $self->_fetchLoaderConfigFile($incFile); + } + } + next; + } + if (m{\S+}i) { + s[=.+][]; + # remove any lib-type specifications (e.g. '=libc5') + push @{$self->{libFolders}}, "$self->{rootPath}$_"; + } + } + close $ldconfFH + or die(_tr("unable to close file '%s' (%s)", $ldConfFile, $!)); + return; } sub _addLibsForBinary { - my $self = shift; - my $binary = shift; + my $self = shift; + my $binary = shift; - # first do some checks: - warn _tr("analyzing '%s'...\n", $binary) if $self->{verbose}; - my $fileInfo = `file --dereference --brief --mime $binary 2>/dev/null`; - if ($?) { - die _tr("unable to fetch file info for '%s', giving up!\n", $binary); - } - chomp $fileInfo; - warn _tr("\tinfo is: '%s'...\n", $fileInfo) if $self->{verbose}; - if ($fileInfo !~ m[^application/(x-executable|x-shared)]i) { - # ignore anything that's not an executable or a shared library - warn _tr( - "%s: ignored, as it isn't an executable or a shared library\n", - $binary - ); - next; - } + # first do some checks: + warn _tr("analyzing '%s'...\n", $binary) if $self->{verbose}; + my $fileInfo = `file --dereference --brief --mime $binary 2>/dev/null`; + if ($?) { + die _tr("unable to fetch file info for '%s', giving up!\n", $binary); + } + chomp $fileInfo; + warn _tr("\tinfo is: '%s'...\n", $fileInfo) if $self->{verbose}; + if ($fileInfo !~ m[^application/(x-executable|x-shared)]i) { + # ignore anything that's not an executable or a shared library + warn _tr( + "%s: ignored, as it isn't an executable or a shared library\n", + $binary + ); + next; + } - # fetch file info again, this time without '--mime' in order to get the architecture - # bitwidth: - $fileInfo = `file --dereference --brief $binary 2>/dev/null`; - if ($?) { - die _tr("unable to fetch file info for '%s', giving up!\n", $binary); - } - chomp $fileInfo; - warn _tr("\tinfo is: '%s'...\n", $fileInfo) if $self->{verbose}; - my $bitwidth = ($fileInfo =~ m[64-bit]i) ? 64 : 32; - # determine whether binary is 32- or 64-bit platform + # fetch file info again, this time without '--mime' in order to get the architecture + # bitwidth: + $fileInfo = `file --dereference --brief $binary 2>/dev/null`; + if ($?) { + die _tr("unable to fetch file info for '%s', giving up!\n", $binary); + } + chomp $fileInfo; + warn _tr("\tinfo is: '%s'...\n", $fileInfo) if $self->{verbose}; + my $bitwidth = ($fileInfo =~ m[64-bit]i) ? 64 : 32; + # determine whether binary is 32- or 64-bit platform - # now find out about needed libs, we first try objdump... - warn _tr("\ttrying objdump...\n") if $self->{verbose}; - my $res = `objdump -p $binary 2>/dev/null`; - if (!$?) { - # find out if rpath is set for binary: - my $rpath; - if ($res =~ m[^\s*RPATH\s*(\S+)]im) { - $rpath = $1; - warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose}; - } - while ($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) { - $self->_addLib($1, $bitwidth, $rpath); - } - } else { - # ...objdump failed, so we try readelf instead: - warn _tr("\ttrying readelf...\n") if $self->{verbose}; - $res = `readelf -d $binary 2>/dev/null`; - if ($?) { - die _tr( - "neither objdump nor readelf seems to be installed, giving up!\n" - ); - } - # find out if rpath is set for binary: - my $rpath; - if ($res =~ m{Library\s*rpath:\s*\[([^\]]+)}im) { - $rpath = $1; - warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose}; - } - while ($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) { - $self->_addLib($1, $bitwidth, $rpath); - } - } - return; + # now find out about needed libs, we first try objdump... + warn _tr("\ttrying objdump...\n") if $self->{verbose}; + my $res = `objdump -p $binary 2>/dev/null`; + if (!$?) { + # find out if rpath is set for binary: + my $rpath; + if ($res =~ m[^\s*RPATH\s*(\S+)]im) { + $rpath = $1; + warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose}; + } + while ($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) { + $self->_addLib($1, $bitwidth, $rpath); + } + } else { + # ...objdump failed, so we try readelf instead: + warn _tr("\ttrying readelf...\n") if $self->{verbose}; + $res = `readelf -d $binary 2>/dev/null`; + if ($?) { + die _tr( + "neither objdump nor readelf seems to be installed, giving up!\n" + ); + } + # find out if rpath is set for binary: + my $rpath; + if ($res =~ m{Library\s*rpath:\s*\[([^\]]+)}im) { + $rpath = $1; + warn _tr("\trpath='%s'\n", $rpath) if $self->{verbose}; + } + while ($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) { + $self->_addLib($1, $bitwidth, $rpath); + } + } + return; } sub _addLib { - my $self = shift; - my $lib = shift; - my $bitwidth = shift; - my $rpath = shift; + my $self = shift; + my $lib = shift; + my $bitwidth = shift; + my $rpath = shift; - if (!exists $self->{libInfo}->{$lib}) { - my $libPath; - my @folders = @{$self->{libFolders}}; - if (defined $rpath) { - # add rpath if given (explicit paths set during link stage) - push @folders, split ':', $rpath; - } - foreach my $folder (@folders) { - if (-e "$folder/$lib") { - # have library matching name, now check if the platform is ok, too: - my $libFileInfo = - `file --dereference --brief $folder/$lib 2>/dev/null`; - if ($?) { - die _tr("unable to fetch file info for '%s', giving up!\n", - $folder / $lib); - } - my $libBitwidth = ($libFileInfo =~ m[64-bit]i) ? 64 : 32; - if ($bitwidth != $libBitwidth) { - vlog( - 0, - _tr( - '%s has wrong bitwidth (%s instead of %s)', - "$folder/$lib", $libBitwidth, $bitwidth - ) - ) if $self->{verbose}; - next; - } - $libPath = "$folder/$lib"; - last; - } - } - if (!defined $libPath) { - die _tr("unable to find lib %s!\n", $lib); - } - print "found $libPath\n" if $self->{verbose}; - push @{$self->{libs}}, $libPath; - $self->{libInfo}->{$lib} = 1; - push @{$self->{filesToDo}}, $libPath; - } - return; + if (!exists $self->{libInfo}->{$lib}) { + my $libPath; + my @folders = @{$self->{libFolders}}; + if (defined $rpath) { + # add rpath if given (explicit paths set during link stage) + push @folders, split ':', $rpath; + } + foreach my $folder (@folders) { + if (-e "$folder/$lib") { + # have library matching name, now check if the platform is ok, too: + my $libFileInfo = + `file --dereference --brief $folder/$lib 2>/dev/null`; + if ($?) { + die _tr("unable to fetch file info for '%s', giving up!\n", + $folder / $lib); + } + my $libBitwidth = ($libFileInfo =~ m[64-bit]i) ? 64 : 32; + if ($bitwidth != $libBitwidth) { + vlog( + 0, + _tr( + '%s has wrong bitwidth (%s instead of %s)', + "$folder/$lib", $libBitwidth, $bitwidth + ) + ) if $self->{verbose}; + next; + } + $libPath = "$folder/$lib"; + last; + } + } + if (!defined $libPath) { + die _tr("unable to find lib %s!\n", $lib); + } + print "found $libPath\n" if $self->{verbose}; + push @{$self->{libs}}, $libPath; + $self->{libInfo}->{$lib} = 1; + push @{$self->{filesToDo}}, $libPath; + } + return; } 1; diff --git a/initramfs/OpenSLX/MakeInitRamFS/Distro/Base.pm b/initramfs/OpenSLX/MakeInitRamFS/Distro/Base.pm index 53765657..30b9d385 100644 --- a/initramfs/OpenSLX/MakeInitRamFS/Distro/Base.pm +++ b/initramfs/OpenSLX/MakeInitRamFS/Distro/Base.pm @@ -9,15 +9,15 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # MakeInitRamFS::Base.pm -# - provides empty base of the distro-specific part of the OpenSLX -# MakeInitRamFS API. +# - provides empty base of the distro-specific part of the OpenSLX +# MakeInitRamFS API. # ----------------------------------------------------------------------------- package OpenSLX::MakeInitRamFS::Distro::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -26,11 +26,11 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'base', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'base', + }; + return bless $self, $class; } sub applyChanges diff --git a/initramfs/OpenSLX/MakeInitRamFS/Distro/Debian.pm b/initramfs/OpenSLX/MakeInitRamFS/Distro/Debian.pm index 0337b0b3..14d6b12b 100644 --- a/initramfs/OpenSLX/MakeInitRamFS/Distro/Debian.pm +++ b/initramfs/OpenSLX/MakeInitRamFS/Distro/Debian.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # MakeInitRamFS::Distro::Debian.pm -# - provides Debian-specific overrides of the MakeInitRamFS::Distro API. +# - provides Debian-specific overrides of the MakeInitRamFS::Distro API. # ----------------------------------------------------------------------------- package OpenSLX::MakeInitRamFS::Distro::Debian; @@ -25,23 +25,23 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'debian', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'debian', + }; + return bless $self, $class; } sub applyChanges { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $engine->_addFilteredKernelModules( qw( af_packet hid unix )); + $engine->_addFilteredKernelModules( qw( af_packet hid unix )); - $engine->_addRequiredLib('/lib/libnss_compat.so.2'); + $engine->_addRequiredLib('/lib/libnss_compat.so.2'); - return; + return; } 1; \ No newline at end of file diff --git a/initramfs/OpenSLX/MakeInitRamFS/Distro/SUSE.pm b/initramfs/OpenSLX/MakeInitRamFS/Distro/SUSE.pm index 4e5963a9..991a2fd1 100644 --- a/initramfs/OpenSLX/MakeInitRamFS/Distro/SUSE.pm +++ b/initramfs/OpenSLX/MakeInitRamFS/Distro/SUSE.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # MakeInitRamFS::Distro::SUSE.pm -# - provides SUSE-specific overrides of the MakeInitRamFS::Distro API. +# - provides SUSE-specific overrides of the MakeInitRamFS::Distro API. # ----------------------------------------------------------------------------- package OpenSLX::MakeInitRamFS::Distro::SUSE; @@ -25,21 +25,21 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'suse', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'suse', + }; + return bless $self, $class; } sub applyChanges { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $engine->_addFilteredKernelModules( qw( hid unix )); + $engine->_addFilteredKernelModules( qw( hid unix )); - return; + return; } 1; \ No newline at end of file diff --git a/initramfs/OpenSLX/MakeInitRamFS/Distro/Ubuntu.pm b/initramfs/OpenSLX/MakeInitRamFS/Distro/Ubuntu.pm index 121ad030..2ccfe227 100644 --- a/initramfs/OpenSLX/MakeInitRamFS/Distro/Ubuntu.pm +++ b/initramfs/OpenSLX/MakeInitRamFS/Distro/Ubuntu.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # MakeInitRamFS::Distro::Ubuntu.pm -# - provides Ubuntu-specific overrides of the MakeInitRamFS::Distro API. +# - provides Ubuntu-specific overrides of the MakeInitRamFS::Distro API. # ----------------------------------------------------------------------------- package OpenSLX::MakeInitRamFS::Distro::Ubuntu; @@ -25,23 +25,23 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'ubuntu', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'ubuntu', + }; + return bless $self, $class; } sub applyChanges { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $engine->_addFilteredKernelModules( qw( unix )); + $engine->_addFilteredKernelModules( qw( unix )); - $engine->_addRequiredLib('/lib/libnss_compat.so.2'); + $engine->_addRequiredLib('/lib/libnss_compat.so.2'); - return; + return; } 1; \ No newline at end of file diff --git a/initramfs/OpenSLX/MakeInitRamFS/Engine.pm b/initramfs/OpenSLX/MakeInitRamFS/Engine.pm index 6ce692d6..482af6b2 100644 --- a/initramfs/OpenSLX/MakeInitRamFS/Engine.pm +++ b/initramfs/OpenSLX/MakeInitRamFS/Engine.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # MakeInitialRamFS::Engine.pm -# - provides driver engine for MakeInitialRamFS API. +# - provides driver engine for MakeInitialRamFS API. # ----------------------------------------------------------------------------- package OpenSLX::MakeInitRamFS::Engine; @@ -27,105 +27,105 @@ use OpenSLX::OSPlugin::Roster; use OpenSLX::Utils; # TODO: implement support for the following (either here or as plugin): -# wlan -# tpm -# cdboot (must be implemented here!) +# wlan +# tpm +# cdboot (must be implemented here!) ################################################################################ ### interface methods ################################################################################ sub new { - my $class = shift; - my $params = shift || {}; - - checkParams($params, { - 'attrs' => '!', - 'debug-level' => '?', - 'export-name' => '!', - 'export-uri' => '!', - 'initramfs' => '!', - 'kernel-params' => '!', - 'kernel-version' => '!', - 'plugins' => '!', - 'root-path' => '!', - 'slx-version' => '!', - 'system-name' => '!', - } ); - - my $self = $params; - - $self->{'system-name'} =~ m{^([^\-]+)-([^:\-]+)} - or die "unable to extract distro-info from $self->{'system-name'}!"; - - $self->{'distro-name'} = $1; - $self->{'distro-ver'} = $2; - - my %distroMap = ( - 'debian' => 'Debian', - 'suse' => 'SUSE', - 'ubuntu' => 'Ubuntu', - ); - my $distroModule = $distroMap{$self->{'distro-name'}} || 'Base'; - $self->{distro} = instantiateClass( - "OpenSLX::MakeInitRamFS::Distro::$distroModule" - ); - - $self->{'lib-scanner'} - = OpenSLX::LibScanner->new({ 'root-path' => $self->{'root-path'} }); - - $self->{'required-libs'} = {}; - $self->{'suggested-kernel-modules'} = []; - $self->{'filtered-kernel-modules'} = []; - - return bless $self, $class; + my $class = shift; + my $params = shift || {}; + + checkParams($params, { + 'attrs' => '!', + 'debug-level' => '?', + 'export-name' => '!', + 'export-uri' => '!', + 'initramfs' => '!', + 'kernel-params' => '!', + 'kernel-version' => '!', + 'plugins' => '!', + 'root-path' => '!', + 'slx-version' => '!', + 'system-name' => '!', + } ); + + my $self = $params; + + $self->{'system-name'} =~ m{^([^\-]+)-([^:\-]+)} + or die "unable to extract distro-info from $self->{'system-name'}!"; + + $self->{'distro-name'} = $1; + $self->{'distro-ver'} = $2; + + my %distroMap = ( + 'debian' => 'Debian', + 'suse' => 'SUSE', + 'ubuntu' => 'Ubuntu', + ); + my $distroModule = $distroMap{$self->{'distro-name'}} || 'Base'; + $self->{distro} = instantiateClass( + "OpenSLX::MakeInitRamFS::Distro::$distroModule" + ); + + $self->{'lib-scanner'} + = OpenSLX::LibScanner->new({ 'root-path' => $self->{'root-path'} }); + + $self->{'required-libs'} = {}; + $self->{'suggested-kernel-modules'} = []; + $self->{'filtered-kernel-modules'} = []; + + return bless $self, $class; } sub execute { - my $self = shift; - my $dryRun = shift; + my $self = shift; + my $dryRun = shift; - $self->_collectCMDs(); + $self->_collectCMDs(); - $self->_executeCMDs() unless $dryRun; + $self->_executeCMDs() unless $dryRun; - return; + return; } sub haveKernelParam { - my $self = shift; - my $param = shift; - - return ref $param eq 'Regexp' - ? grep { $_ =~ $param } @{ $self->{'kernel-params'} } - : grep { $_ eq $param } @{ $self->{'kernel-params'} }; + my $self = shift; + my $param = shift; + + return ref $param eq 'Regexp' + ? grep { $_ =~ $param } @{ $self->{'kernel-params'} } + : grep { $_ eq $param } @{ $self->{'kernel-params'} }; } sub addKernelParams { - my $self = shift; - - push @{ $self->{'kernel-params'} }, @_; - - return; + my $self = shift; + + push @{ $self->{'kernel-params'} }, @_; + + return; } sub kernelParams { - my $self = shift; - - return @{ $self->{'kernel-params'} }; + my $self = shift; + + return @{ $self->{'kernel-params'} }; } sub addKernelModules { - my $self = shift; - - push @{ $self->{'suggested-kernel-modules'} }, @_; - - return; + my $self = shift; + + push @{ $self->{'suggested-kernel-modules'} }, @_; + + return; } ################################################################################ @@ -133,641 +133,641 @@ sub addKernelModules ################################################################################ sub _collectCMDs { - my $self = shift; - - $self->{CMDs} = []; + my $self = shift; + + $self->{CMDs} = []; - $self->_setupBuildPath(); + $self->_setupBuildPath(); - $self->_addRequiredFSModsAndTools(); - - $self->_writeInitramfsSetup(); - $self->_writeSlxSystemConf(); + $self->_addRequiredFSModsAndTools(); + + $self->_writeInitramfsSetup(); + $self->_writeSlxSystemConf(); - $self->_copyDistroSpecificFiles(); - $self->_copyInitramfsFiles(); - - $self->_copyBusybox(); - - $self->_copyDhcpClient(); + $self->_copyDistroSpecificFiles(); + $self->_copyInitramfsFiles(); + + $self->_copyBusybox(); + + $self->_copyDhcpClient(); - $self->_copyRamfsTools(); - - $self->_copyRequiredFSTools(); + $self->_copyRamfsTools(); + + $self->_copyRequiredFSTools(); - $self->_copyRequiredLayeredFSTools(); + $self->_copyRequiredLayeredFSTools(); - $self->_copyPreAndPostinitFiles(); + $self->_copyPreAndPostinitFiles(); - if ($self->{'debug-level'}) { - $self->_copyDebugTools(); - } + if ($self->{'debug-level'}) { + $self->_copyDebugTools(); + } - $self->_calloutToPlugins(); + $self->_calloutToPlugins(); - $self->{distro}->applyChanges($self); + $self->{distro}->applyChanges($self); - $self->_copyKernelModules(); - - $self->_copyRequiredLibs(); - - $self->_createInitRamFS(); + $self->_copyKernelModules(); + + $self->_copyRequiredLibs(); + + $self->_createInitRamFS(); - return; + return; } sub _executeCMDs { - my $self = shift; - - foreach my $cmd (@{$self->{CMDs}}) { - if (ref($cmd) eq 'HASH') { - vlog(3, "writing $cmd->{file}"); - my $flags = defined $cmd->{mode} ? { mode => $cmd->{mode} } : undef; - spitFile($cmd->{file}, $cmd->{content}, $flags); - } - else { - vlog(3, "executing: $cmd"); - if (slxsystem($cmd)) { - die _tr( - "unable to execute shell-cmd\n\t%s", $cmd - ); - } - } - } - - return; + my $self = shift; + + foreach my $cmd (@{$self->{CMDs}}) { + if (ref($cmd) eq 'HASH') { + vlog(3, "writing $cmd->{file}"); + my $flags = defined $cmd->{mode} ? { mode => $cmd->{mode} } : undef; + spitFile($cmd->{file}, $cmd->{content}, $flags); + } + else { + vlog(3, "executing: $cmd"); + if (slxsystem($cmd)) { + die _tr( + "unable to execute shell-cmd\n\t%s", $cmd + ); + } + } + } + + return; } sub addCMD { - my $self = shift; - my $cmd = shift; - - push @{$self->{CMDs}}, $cmd; + my $self = shift; + my $cmd = shift; + + push @{$self->{CMDs}}, $cmd; - return; + return; } - + sub _setupBuildPath { - my $self = shift; - - my $buildPath = "$openslxConfig{'temp-path'}/slx-initramfs"; - $self->addCMD("rm -rf $buildPath"); - - my @stdFolders = qw( - bin - dev - etc - etc/init-hooks - etc/sysconfig - lib - mnt - proc - root - sys - tmp - usr/share - var/lib - var/lib/nfs/state - var/run - ); - $self->addCMD( - 'mkdir -p ' . join(' ', map { "$buildPath/$_"; } @stdFolders) - ); - $self->addCMD("ln -sfn /bin $buildPath/sbin"); - - $self->{'build-path'} = $buildPath; - - return; -} - + my $self = shift; + + my $buildPath = "$openslxConfig{'temp-path'}/slx-initramfs"; + $self->addCMD("rm -rf $buildPath"); + + my @stdFolders = qw( + bin + dev + etc + etc/init-hooks + etc/sysconfig + lib + mnt + proc + root + sys + tmp + usr/share + var/lib + var/lib/nfs/state + var/run + ); + $self->addCMD( + 'mkdir -p ' . join(' ', map { "$buildPath/$_"; } @stdFolders) + ); + $self->addCMD("ln -sfn /bin $buildPath/sbin"); + + $self->{'build-path'} = $buildPath; + + return; +} + sub _copyDistroSpecificFiles { - my $self = shift; - - my $distroSpecsPath = "$openslxConfig{'base-path'}/share/distro-specs"; - - my $distroName = $self->{'distro-name'}; - my $distroVer = $self->{'distro-ver'}; - - # concatenate default- and distro-specific configuration into one file - my $config = slurpFile("$distroSpecsPath/$distroName/config-default"); - $config .= "\n"; - $config .= slurpFile("$distroSpecsPath/$distroName/config-$distroVer"); - $self->addCMD( { - file => "$self->{'build-path'}/etc/sysconfig/config", - content => $config, - } ); - - # concatenate default- and distro-specific functions into one file - my $functions = slurpFile("$distroSpecsPath/$distroName/functions-default"); - $functions .= "\n"; - $functions - .= slurpFile("$distroSpecsPath/$distroName/functions-$distroVer"); - $self->addCMD( { - file => "$self->{'build-path'}/etc/distro-functions", - content => $functions, - } ); - - my $defaultsPath = "$distroSpecsPath/$distroName/files-default"; - if (-e $defaultsPath) { - $self->addCMD( - "cp -a $defaultsPath $self->{'build-path'}/etc/sysconfig/files" - ); - } - - return 1; + my $self = shift; + + my $distroSpecsPath = "$openslxConfig{'base-path'}/share/distro-specs"; + + my $distroName = $self->{'distro-name'}; + my $distroVer = $self->{'distro-ver'}; + + # concatenate default- and distro-specific configuration into one file + my $config = slurpFile("$distroSpecsPath/$distroName/config-default"); + $config .= "\n"; + $config .= slurpFile("$distroSpecsPath/$distroName/config-$distroVer"); + $self->addCMD( { + file => "$self->{'build-path'}/etc/sysconfig/config", + content => $config, + } ); + + # concatenate default- and distro-specific functions into one file + my $functions = slurpFile("$distroSpecsPath/$distroName/functions-default"); + $functions .= "\n"; + $functions + .= slurpFile("$distroSpecsPath/$distroName/functions-$distroVer"); + $self->addCMD( { + file => "$self->{'build-path'}/etc/distro-functions", + content => $functions, + } ); + + my $defaultsPath = "$distroSpecsPath/$distroName/files-default"; + if (-e $defaultsPath) { + $self->addCMD( + "cp -a $defaultsPath $self->{'build-path'}/etc/sysconfig/files" + ); + } + + return 1; } sub _copyInitramfsFiles { - my $self = shift; - - my $initramfsPath = "$openslxConfig{'base-path'}/share/initramfs"; - - find( - { - wanted => sub { - my $len = length($initramfsPath); - my $file = $File::Find::name; - my $relName = length($file) > $len ? substr($file, $len+1) : ''; - if (-d) { - $self->addCMD("mkdir -p $self->{'build-path'}/$relName"); - } elsif (-l $file) { - my $target = readlink $file; - $self->addCMD( - "ln -sf $target $self->{'build-path'}/$relName" - ); - } elsif (qx{file $file} =~ m{ELF}) { - $self->addCMD( - "cp -p $file $self->{'build-path'}/$relName" - ); - } else { - my $text = slurpFile($file, { 'io-layer' => 'bytes' } ); - - # replace macros - # TODO: find out what these mean and maybe find a - # different, better solution - my %macro = ( - 'COMDIRINDXS' => '/tmp/scratch /var/lib/nobody', - 'COMETCEXCL' => "XF86Config*\nissue*\nmtab*\nfstab*\n", - 'KERNVER' => $self->{'kernel-version'}, - # keep serverip as it is (it is handled by init itself) - 'serverip' => '@@@serverip@@@', - ); - $text =~ s{\@\@\@([^\@]+)\@\@\@}{ - if (!exists $macro{$1}) { - warn _tr( - 'unknown macro @@@%s@@@ found in %s', - $1, $File::Find::name - ); - ''; - } else { - $macro{$1}; - } - }eogms; - - # force shebang with ash - $text =~ s{\A#!\s*/bin/.+?$}{#!/bin/ash}ms; - - $self->addCMD( { - file => "$self->{'build-path'}/$relName", - content => $text, - mode => (-x $file ? 0755 : undef), - } ); - } - }, - no_chdir => 1, - }, - $initramfsPath - ); - - return; + my $self = shift; + + my $initramfsPath = "$openslxConfig{'base-path'}/share/initramfs"; + + find( + { + wanted => sub { + my $len = length($initramfsPath); + my $file = $File::Find::name; + my $relName = length($file) > $len ? substr($file, $len+1) : ''; + if (-d) { + $self->addCMD("mkdir -p $self->{'build-path'}/$relName"); + } elsif (-l $file) { + my $target = readlink $file; + $self->addCMD( + "ln -sf $target $self->{'build-path'}/$relName" + ); + } elsif (qx{file $file} =~ m{ELF}) { + $self->addCMD( + "cp -p $file $self->{'build-path'}/$relName" + ); + } else { + my $text = slurpFile($file, { 'io-layer' => 'bytes' } ); + + # replace macros + # TODO: find out what these mean and maybe find a + # different, better solution + my %macro = ( + 'COMDIRINDXS' => '/tmp/scratch /var/lib/nobody', + 'COMETCEXCL' => "XF86Config*\nissue*\nmtab*\nfstab*\n", + 'KERNVER' => $self->{'kernel-version'}, + # keep serverip as it is (it is handled by init itself) + 'serverip' => '@@@serverip@@@', + ); + $text =~ s{\@\@\@([^\@]+)\@\@\@}{ + if (!exists $macro{$1}) { + warn _tr( + 'unknown macro @@@%s@@@ found in %s', + $1, $File::Find::name + ); + ''; + } else { + $macro{$1}; + } + }eogms; + + # force shebang with ash + $text =~ s{\A#!\s*/bin/.+?$}{#!/bin/ash}ms; + + $self->addCMD( { + file => "$self->{'build-path'}/$relName", + content => $text, + mode => (-x $file ? 0755 : undef), + } ); + } + }, + no_chdir => 1, + }, + $initramfsPath + ); + + return; } sub _copyBusybox { - my $self = shift; - - $self->_copyPlatformSpecificBinary( - "$openslxConfig{'base-path'}/share/busybox/busybox", '/bin/busybox' - ); - - my $busyboxForHost - = "$openslxConfig{'base-path'}/share/busybox/busybox" - . ( hostIs64Bit() ? '.x86_64' : '.i586' ); - - my $busyboxHelp = qx{$busyboxForHost --help}; - if ($busyboxHelp !~ m{defined functions:(.+)\z}ims) { - die "unable to parse busybox --help output:\n$busyboxHelp"; - } - my $rawAppletList = $1; - my @busyboxApplets - = map { - $_ =~ s{\s+}{}igms; - $_; - } - split m{,}, $rawAppletList; - foreach my $applet (@busyboxApplets) { - $self->addCMD("ln -sf /bin/busybox $self->{'build-path'}/bin/$applet"); - } - - # fake the sh link in busybox environment - my $shFake = "#!/bin/ash\n/bin/ash \$\@"; - $self->addCMD( { - file => "$self->{'build-path'}/bin/sh", - content => $shFake, - mode => 0755 - } ); - - return; + my $self = shift; + + $self->_copyPlatformSpecificBinary( + "$openslxConfig{'base-path'}/share/busybox/busybox", '/bin/busybox' + ); + + my $busyboxForHost + = "$openslxConfig{'base-path'}/share/busybox/busybox" + . ( hostIs64Bit() ? '.x86_64' : '.i586' ); + + my $busyboxHelp = qx{$busyboxForHost --help}; + if ($busyboxHelp !~ m{defined functions:(.+)\z}ims) { + die "unable to parse busybox --help output:\n$busyboxHelp"; + } + my $rawAppletList = $1; + my @busyboxApplets + = map { + $_ =~ s{\s+}{}igms; + $_; + } + split m{,}, $rawAppletList; + foreach my $applet (@busyboxApplets) { + $self->addCMD("ln -sf /bin/busybox $self->{'build-path'}/bin/$applet"); + } + + # fake the sh link in busybox environment + my $shFake = "#!/bin/ash\n/bin/ash \$\@"; + $self->addCMD( { + file => "$self->{'build-path'}/bin/sh", + content => $shFake, + mode => 0755 + } ); + + return; } sub _copyRamfsTools { - my $self = shift; - - my @ramfsTools = qw(ddcprobe 915resolution); - foreach my $tool (@ramfsTools) { - $self->_copyPlatformSpecificBinary( - "$openslxConfig{'base-path'}/share/ramfstools/$tool", - "/bin/$tool" - ); - } - - return; -} - + my $self = shift; + + my @ramfsTools = qw(ddcprobe 915resolution); + foreach my $tool (@ramfsTools) { + $self->_copyPlatformSpecificBinary( + "$openslxConfig{'base-path'}/share/ramfstools/$tool", + "/bin/$tool" + ); + } + + return; +} + sub _copyDebugTools { - my $self = shift; - - my @debugTools = qw(strace); - foreach my $tool (@debugTools) { - my $toolPath = $self->_findBinary($tool); - if (!$toolPath) { - warn _tr('debug-tool "%s" is not available', $tool); - next; - } - $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); - $self->_addRequiredLibsFor($toolPath); - } - - return; -} - + my $self = shift; + + my @debugTools = qw(strace); + foreach my $tool (@debugTools) { + my $toolPath = $self->_findBinary($tool); + if (!$toolPath) { + warn _tr('debug-tool "%s" is not available', $tool); + next; + } + $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); + $self->_addRequiredLibsFor($toolPath); + } + + return; +} + sub _copyDhcpClient { - my $self = shift; - - # TODO: instead of using dhclient, we should check if the client - # provided by busybox still does not support fetching NIS stuff - # (and implement that if it doesn't) - - my $toolPath = $self->_findBinary('dhclient'); - if (!$toolPath) { - warn _tr('tool "dhclient" is not available, using "udhcpc" instead'); - return; - } - $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); - $self->_addRequiredLibsFor($toolPath); - - return; -} - + my $self = shift; + + # TODO: instead of using dhclient, we should check if the client + # provided by busybox still does not support fetching NIS stuff + # (and implement that if it doesn't) + + my $toolPath = $self->_findBinary('dhclient'); + if (!$toolPath) { + warn _tr('tool "dhclient" is not available, using "udhcpc" instead'); + return; + } + $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); + $self->_addRequiredLibsFor($toolPath); + + return; +} + sub _findBinary { - my $self = shift; - my $binary = shift; - - my @binDirs = qw( - bin sbin usr/bin usr/sbin usr/local/bin usr/local/sbin usr/bin/X11 - ); - foreach my $binDir (@binDirs) { - my $binPath = "$self->{'root-path'}/$binDir/$binary"; - return $binPath if -f $binPath && -x $binPath; - } - - return; -} - + my $self = shift; + my $binary = shift; + + my @binDirs = qw( + bin sbin usr/bin usr/sbin usr/local/bin usr/local/sbin usr/bin/X11 + ); + foreach my $binDir (@binDirs) { + my $binPath = "$self->{'root-path'}/$binDir/$binary"; + return $binPath if -f $binPath && -x $binPath; + } + + return; +} + sub _copyPlatformSpecificBinary { - my $self = shift; - my $binaryPath = shift; - my $targetPath = shift; + my $self = shift; + my $binaryPath = shift; + my $targetPath = shift; - my $binary = $self->_platformSpecificFileFor($binaryPath); - - $self->addCMD("cp -p $binary $self->{'build-path'}$targetPath"); - $self->_addRequiredLibsFor($binary); + my $binary = $self->_platformSpecificFileFor($binaryPath); + + $self->addCMD("cp -p $binary $self->{'build-path'}$targetPath"); + $self->_addRequiredLibsFor($binary); - return; + return; } sub _copyRequiredFSTools { - my $self = shift; + my $self = shift; - foreach my $tool (@{$self->{'fs-tools'}}) { - my $toolPath = $self->_findBinary($tool); - if (!$toolPath) { - die _tr('filesystem-tool "%s" is not available, giving up!', $tool); - } - $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); - $self->_addRequiredLibsFor($toolPath); - } + foreach my $tool (@{$self->{'fs-tools'}}) { + my $toolPath = $self->_findBinary($tool); + if (!$toolPath) { + die _tr('filesystem-tool "%s" is not available, giving up!', $tool); + } + $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); + $self->_addRequiredLibsFor($toolPath); + } - return; + return; } sub _copyRequiredLayeredFSTools { - my $self = shift; - - my @tools; - if ($self->haveKernelParam('unionfs')) { - push @tools, 'unionctl'; - } - if ($self->haveKernelParam('cowloop')) { - push @tools, 'cowdev'; - } - foreach my $tool (@tools) { - my $toolPath = $self->_findBinary($tool); - if (!$toolPath) { - die _tr( - 'layered-fs-tool "%s" is not available, giving up!', $tool - ); - } - $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); - $self->_addRequiredLibsFor($toolPath); - } - - return; + my $self = shift; + + my @tools; + if ($self->haveKernelParam('unionfs')) { + push @tools, 'unionctl'; + } + if ($self->haveKernelParam('cowloop')) { + push @tools, 'cowdev'; + } + foreach my $tool (@tools) { + my $toolPath = $self->_findBinary($tool); + if (!$toolPath) { + die _tr( + 'layered-fs-tool "%s" is not available, giving up!', $tool + ); + } + $self->addCMD("cp -p $toolPath $self->{'build-path'}/bin"); + $self->_addRequiredLibsFor($toolPath); + } + + return; } sub _copyRequiredLibs { - my $self = shift; + my $self = shift; - # separate 64-bit libs from 32-bit libs and copy them into different - # destination folders - my @libs64 = grep { $_ =~ m{/lib64/} } keys %{$self->{'required-libs'}}; - my @libs32 = grep { $_ !~ m{/lib64/} } keys %{$self->{'required-libs'}}; - if (@libs64) { - $self->addCMD("mkdir -p $self->{'build-path'}/lib64"); - foreach my $lib (@libs64) { - $self->addCMD("cp -p $lib $self->{'build-path'}/lib64/"); - } - } - foreach my $lib (@libs32) { - $self->addCMD("cp -p $lib $self->{'build-path'}/lib/"); - } + # separate 64-bit libs from 32-bit libs and copy them into different + # destination folders + my @libs64 = grep { $_ =~ m{/lib64/} } keys %{$self->{'required-libs'}}; + my @libs32 = grep { $_ !~ m{/lib64/} } keys %{$self->{'required-libs'}}; + if (@libs64) { + $self->addCMD("mkdir -p $self->{'build-path'}/lib64"); + foreach my $lib (@libs64) { + $self->addCMD("cp -p $lib $self->{'build-path'}/lib64/"); + } + } + foreach my $lib (@libs32) { + $self->addCMD("cp -p $lib $self->{'build-path'}/lib/"); + } - return; + return; } sub _addRequiredLibsFor { - my $self = shift; - my $binary = shift; + my $self = shift; + my $binary = shift; - my @libs = $self->{'lib-scanner'}->determineRequiredLibs($binary); - foreach my $lib (@libs) { - $self->_addRequiredLib($lib); - } + my @libs = $self->{'lib-scanner'}->determineRequiredLibs($binary); + foreach my $lib (@libs) { + $self->_addRequiredLib($lib); + } - return; + return; } sub _addRequiredLib { - my $self = shift; - my $lib = shift; + my $self = shift; + my $lib = shift; - $self->{'required-libs'}->{$lib} = 1; + $self->{'required-libs'}->{$lib} = 1; - return; + return; } sub _addFilteredKernelModules { - my $self = shift; + my $self = shift; - push @{ $self->{'filtered-kernel-modules'} }, @_; + push @{ $self->{'filtered-kernel-modules'} }, @_; - return; + return; } sub _copyKernelModules { - my $self = shift; - - # read modules.dep and use it to determine module dependencies - my $sourcePath = "$self->{'root-path'}/lib/modules/$self->{'kernel-version'}"; - my @modulesDep = slurpFile("$sourcePath/modules.dep") - or die _tr('unable to open %s!', "$sourcePath/modules.dep"); - my (%dependentModules, %modulePath, %modulesToBeCopied); - foreach my $modulesDep (@modulesDep) { - next if $modulesDep !~ m{^(.+?)/([^/]+)\.ko:\s*(.*?)\s*$}; - my $path = $1; - my $module = $2; - my $dependentsList = $3; - my $fullModulePath = "$path/$module.ko"; - $modulePath{$module} = [] if !exists $modulePath{$module}; - push @{$modulePath{$module}}, $fullModulePath; - $dependentModules{$fullModulePath} = [ split ' ', $dependentsList ]; - } - - my $targetPath - = "$self->{'build-path'}/lib/modules/$self->{'kernel-version'}"; - $self->addCMD("mkdir -p $targetPath"); - $self->addCMD("cp -p $sourcePath/modules.* $targetPath/"); - - # TODO: find out what's the story behing the supposedly required - # modules 'af_packet', 'unix' and 'hid' (which seem to be - # missing at least on some systems - my @kernelModules = qw( - af_packet unix hid usbhid uhci-hcd ohci-hcd - ); - push @kernelModules, @{ $self->{'suggested-kernel-modules'} }; - - push @kernelModules, split ' ', $self->{attrs}->{ramfs_fsmods}; - push @kernelModules, split ' ', $self->{attrs}->{ramfs_miscmods}; - push @kernelModules, split ' ', $self->{attrs}->{ramfs_nicmods}; - - # a function that determines dependent modules recursively - my $addDependentsSub; - $addDependentsSub = sub { - my $modulePath = shift; - foreach my $dependentModule (@{$dependentModules{$modulePath}}) { - next if $modulesToBeCopied{$dependentModule}; - $modulesToBeCopied{$dependentModule} = 1; - $addDependentsSub->($dependentModule); - } - }; - - # start with the given kernel modules (names) and build a list of all - # required modules - foreach my $kernelModule (@kernelModules) { - if (!$modulePath{$kernelModule}) { - if (! grep { $_ eq $kernelModule } - @{ $self->{'filtered-kernel-modules'} } - ) { - warn _tr( - 'kernel module "%s" not found (in modules.dep)', - $kernelModule - ); - } - } - foreach my $modulePath (@{$modulePath{$kernelModule}}) { - next if $modulesToBeCopied{$modulePath}; - $modulesToBeCopied{$modulePath} = 1; - $addDependentsSub->($modulePath); - } - } - - # copy all the modules that we think are required - foreach my $moduleToBeCopied (sort keys %modulesToBeCopied) { - my $targetDir = "$self->{'build-path'}" . dirname($moduleToBeCopied); - $self->addCMD("mkdir -p $targetDir"); - my $source = followLink( - "$self->{'root-path'}$moduleToBeCopied", $self->{'root-path'} - ); - my $target = "$self->{'build-path'}$moduleToBeCopied"; - $self->addCMD("cp -p --dereference $source $target"); - } - - return; + my $self = shift; + + # read modules.dep and use it to determine module dependencies + my $sourcePath = "$self->{'root-path'}/lib/modules/$self->{'kernel-version'}"; + my @modulesDep = slurpFile("$sourcePath/modules.dep") + or die _tr('unable to open %s!', "$sourcePath/modules.dep"); + my (%dependentModules, %modulePath, %modulesToBeCopied); + foreach my $modulesDep (@modulesDep) { + next if $modulesDep !~ m{^(.+?)/([^/]+)\.ko:\s*(.*?)\s*$}; + my $path = $1; + my $module = $2; + my $dependentsList = $3; + my $fullModulePath = "$path/$module.ko"; + $modulePath{$module} = [] if !exists $modulePath{$module}; + push @{$modulePath{$module}}, $fullModulePath; + $dependentModules{$fullModulePath} = [ split ' ', $dependentsList ]; + } + + my $targetPath + = "$self->{'build-path'}/lib/modules/$self->{'kernel-version'}"; + $self->addCMD("mkdir -p $targetPath"); + $self->addCMD("cp -p $sourcePath/modules.* $targetPath/"); + + # TODO: find out what's the story behing the supposedly required + # modules 'af_packet', 'unix' and 'hid' (which seem to be + # missing at least on some systems + my @kernelModules = qw( + af_packet unix hid usbhid uhci-hcd ohci-hcd + ); + push @kernelModules, @{ $self->{'suggested-kernel-modules'} }; + + push @kernelModules, split ' ', $self->{attrs}->{ramfs_fsmods}; + push @kernelModules, split ' ', $self->{attrs}->{ramfs_miscmods}; + push @kernelModules, split ' ', $self->{attrs}->{ramfs_nicmods}; + + # a function that determines dependent modules recursively + my $addDependentsSub; + $addDependentsSub = sub { + my $modulePath = shift; + foreach my $dependentModule (@{$dependentModules{$modulePath}}) { + next if $modulesToBeCopied{$dependentModule}; + $modulesToBeCopied{$dependentModule} = 1; + $addDependentsSub->($dependentModule); + } + }; + + # start with the given kernel modules (names) and build a list of all + # required modules + foreach my $kernelModule (@kernelModules) { + if (!$modulePath{$kernelModule}) { + if (! grep { $_ eq $kernelModule } + @{ $self->{'filtered-kernel-modules'} } + ) { + warn _tr( + 'kernel module "%s" not found (in modules.dep)', + $kernelModule + ); + } + } + foreach my $modulePath (@{$modulePath{$kernelModule}}) { + next if $modulesToBeCopied{$modulePath}; + $modulesToBeCopied{$modulePath} = 1; + $addDependentsSub->($modulePath); + } + } + + # copy all the modules that we think are required + foreach my $moduleToBeCopied (sort keys %modulesToBeCopied) { + my $targetDir = "$self->{'build-path'}" . dirname($moduleToBeCopied); + $self->addCMD("mkdir -p $targetDir"); + my $source = followLink( + "$self->{'root-path'}$moduleToBeCopied", $self->{'root-path'} + ); + my $target = "$self->{'build-path'}$moduleToBeCopied"; + $self->addCMD("cp -p --dereference $source $target"); + } + + return; } sub _copyPreAndPostinitFiles { - my $self = shift; + my $self = shift; - foreach my $cfg ( - 'default/initramfs/preinit.local', - "$self->{'system-name'}/initramfs/preinit.local", - 'default/initramfs/postinit.local', + foreach my $cfg ( + 'default/initramfs/preinit.local', + "$self->{'system-name'}/initramfs/preinit.local", + 'default/initramfs/postinit.local', "$self->{'system-name'}/initramfs/postinit.local" - ) { - my $cfgPath = "$openslxConfig{'private-path'}/config/$cfg"; - next if !-f $cfgPath; - $self->addCMD("cp -p $cfgPath $self->{'build-path'}/bin/"); - } - return; + ) { + my $cfgPath = "$openslxConfig{'private-path'}/config/$cfg"; + next if !-f $cfgPath; + $self->addCMD("cp -p $cfgPath $self->{'build-path'}/bin/"); + } + return; } sub _platformSpecificFileFor { - my $self = shift; - my $binary = shift; + my $self = shift; + my $binary = shift; - if ($self->{'system-name'} =~ m{64}) { - return $binary . '.x86_64'; - } - return $binary . '.i586'; + if ($self->{'system-name'} =~ m{64}) { + return $binary . '.x86_64'; + } + return $binary . '.i586'; } sub _addRequiredFSModsAndTools { - my $self = shift; - - my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); - $osExportEngine->initializeFromExisting($self->{'export-name'}); - my $fsMods = $self->{attrs}->{ramfs_fsmods} || ''; - foreach my $fsMod ($osExportEngine->requiredFSMods()) { - $fsMods .= " $fsMod" if $fsMods !~ m{$fsMod}; - } - $self->{attrs}->{ramfs_fsmods} = $fsMods; - - my @fsTools = $osExportEngine->requiredFSTools(); - $self->{'fs-tools'} = \@fsTools; + my $self = shift; + + my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); + $osExportEngine->initializeFromExisting($self->{'export-name'}); + my $fsMods = $self->{attrs}->{ramfs_fsmods} || ''; + foreach my $fsMod ($osExportEngine->requiredFSMods()) { + $fsMods .= " $fsMod" if $fsMods !~ m{$fsMod}; + } + $self->{attrs}->{ramfs_fsmods} = $fsMods; + + my @fsTools = $osExportEngine->requiredFSTools(); + $self->{'fs-tools'} = \@fsTools; - return; + return; } sub _writeInitramfsSetup { - my $self = shift; - - # generate initramfs-setup file containing attributes that are - # relevant for the initramfs only (before there's a root-FS): - my $initramfsAttrs = { - 'host_name' => 'slx-client', # just to have something at all - 'ramfs_fsmods' => $self->{attrs}->{ramfs_fsmods} || '', - 'ramfs_miscmods' => $self->{attrs}->{ramfs_miscmods} || '', - 'ramfs_nicmods' => $self->{attrs}->{ramfs_nicmods} || '', - 'rootfs' => $self->{'export-uri'} || '', - }; - my $content = "# attributes set by slxconfig-demuxer:\n"; - foreach my $attr (keys %$initramfsAttrs) { - $content .= qq[$attr="$initramfsAttrs->{$attr}"\n]; - } - $self->addCMD( { - file => "$self->{'build-path'}/etc/initramfs-setup", - content => $content - } ); - - return; + my $self = shift; + + # generate initramfs-setup file containing attributes that are + # relevant for the initramfs only (before there's a root-FS): + my $initramfsAttrs = { + 'host_name' => 'slx-client', # just to have something at all + 'ramfs_fsmods' => $self->{attrs}->{ramfs_fsmods} || '', + 'ramfs_miscmods' => $self->{attrs}->{ramfs_miscmods} || '', + 'ramfs_nicmods' => $self->{attrs}->{ramfs_nicmods} || '', + 'rootfs' => $self->{'export-uri'} || '', + }; + my $content = "# attributes set by slxconfig-demuxer:\n"; + foreach my $attr (keys %$initramfsAttrs) { + $content .= qq[$attr="$initramfsAttrs->{$attr}"\n]; + } + $self->addCMD( { + file => "$self->{'build-path'}/etc/initramfs-setup", + content => $content + } ); + + return; } sub _writeSlxSystemConf { - my $self = shift; - - # generate slxsystem.conf file with variables that are needed - # in stage3 init. - # TODO: either put this stuff into initramfs-setup or find another solution - my $date = strftime("%d.%m.%Y", localtime); - my $slxConf = unshiftHereDoc(<<" End-of-Here"); - slxconf_date=$date - slxconf_kernver=$self->{'kernel-version'} - slxconf_listnwmod="$self->{attrs}->{ramfs_nicmods}" - slxconf_distro_name=$self->{'distro-name'} - slxconf_distro_ver=$self->{'distro-ver'} - slxconf_system_name=$self->{'system-name'} - slxconf_slxver="$self->{'slx-version'}" - End-of-Here - $self->addCMD( { - file => "$self->{'build-path'}/etc/sysconfig/slxsystem.conf", - content => $slxConf - } ); - - return; + my $self = shift; + + # generate slxsystem.conf file with variables that are needed + # in stage3 init. + # TODO: either put this stuff into initramfs-setup or find another solution + my $date = strftime("%d.%m.%Y", localtime); + my $slxConf = unshiftHereDoc(<<" End-of-Here"); + slxconf_date=$date + slxconf_kernver=$self->{'kernel-version'} + slxconf_listnwmod="$self->{attrs}->{ramfs_nicmods}" + slxconf_distro_name=$self->{'distro-name'} + slxconf_distro_ver=$self->{'distro-ver'} + slxconf_system_name=$self->{'system-name'} + slxconf_slxver="$self->{'slx-version'}" + End-of-Here + $self->addCMD( { + file => "$self->{'build-path'}/etc/sysconfig/slxsystem.conf", + content => $slxConf + } ); + + return; } sub _calloutToPlugins { - my $self = shift; + my $self = shift; - my $pluginInitdPath = "$self->{'build-path'}/etc/plugin-init.d"; - my $initHooksPath = "$self->{'build-path'}/etc/init-hooks"; - $self->addCMD("mkdir -p $pluginInitdPath $initHooksPath"); + my $pluginInitdPath = "$self->{'build-path'}/etc/plugin-init.d"; + my $initHooksPath = "$self->{'build-path'}/etc/init-hooks"; + $self->addCMD("mkdir -p $pluginInitdPath $initHooksPath"); - foreach my $pluginName (@{$self->{'plugins'}}) { - my $plugin = OpenSLX::OSPlugin::Roster->getPlugin($pluginName); - next if !$plugin; - $plugin->setupPluginInInitramfs($self->{attrs}, $self); - } - return; + foreach my $pluginName (@{$self->{'plugins'}}) { + my $plugin = OpenSLX::OSPlugin::Roster->getPlugin($pluginName); + next if !$plugin; + $plugin->setupPluginInInitramfs($self->{attrs}, $self); + } + return; } sub _createInitRamFS { - my $self = shift; + my $self = shift; - my $buildPath = $self->{'build-path'}; - $self->addCMD( - "cd $buildPath " - . "&& find . " - . "| cpio -H newc --quiet --create " - . "| gzip -9 >$self->{initramfs}" - ); + my $buildPath = $self->{'build-path'}; + $self->addCMD( + "cd $buildPath " + . "&& find . " + . "| cpio -H newc --quiet --create " + . "| gzip -9 >$self->{initramfs}" + ); - return; + return; } 1; diff --git a/installer/OpenSLX/OSExport/BlockDevice/AoE.pm b/installer/OpenSLX/OSExport/BlockDevice/AoE.pm index 9a7450f5..d3916d6a 100644 --- a/installer/OpenSLX/OSExport/BlockDevice/AoE.pm +++ b/installer/OpenSLX/OSExport/BlockDevice/AoE.pm @@ -9,8 +9,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # AoE.pm -# - provides ATA-over-Ethernet specific overrides of the -# OpenSLX::OSExport::BlockDevice API. +# - provides ATA-over-Ethernet specific overrides of the +# OpenSLX::OSExport::BlockDevice API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::BlockDevice::AoE; @@ -36,71 +36,71 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {'name' => 'aoe',}; - return bless $self, $class; + my $class = shift; + my $self = {'name' => 'aoe',}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; - my $fs = shift; + my $self = shift; + my $engine = shift; + my $fs = shift; - $self->{'engine'} = $engine; - $self->{'fs'} = $fs; - return; + $self->{'engine'} = $engine; + $self->{'fs'} = $fs; + return; } sub getExportPort { - my $self = shift; - my $openslxDB = shift; + my $self = shift; + my $openslxDB = shift; - return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); + return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); } sub generateExportURI { - my $self = shift; - my $export = shift; + my $self = shift; + my $export = shift; - my $serverIP = $export->{server_ip} || ''; - my $server - = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); - $server .= ":$export->{port}" if length($export->{port}); + my $serverIP = $export->{server_ip} || ''; + my $server + = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); + $server .= ":$export->{port}" if length($export->{port}); - return "aoe://$server"; + return "aoe://$server"; } sub requiredBlockDeviceModules { - my $self = shift; + my $self = shift; - return qw( aoe ); + return qw( aoe ); } sub requiredBlockDeviceTools { - my $self = shift; + my $self = shift; - # TODO: is there any such tool? + # TODO: is there any such tool? - return; + return; } sub showExportConfigInfo { - my $self = shift; - my $export = shift; - - print(('#' x 80) . "\n"); - print _tr( - "Please make sure you start a corresponding aoe-server:\n\t%s\n", - "... (don't know how this is done yet)" - ); - print(('#' x 80) . "\n"); - return; + my $self = shift; + my $export = shift; + + print(('#' x 80) . "\n"); + print _tr( + "Please make sure you start a corresponding aoe-server:\n\t%s\n", + "... (don't know how this is done yet)" + ); + print(('#' x 80) . "\n"); + return; } 1; diff --git a/installer/OpenSLX/OSExport/BlockDevice/Base.pm b/installer/OpenSLX/OSExport/BlockDevice/Base.pm index 80868a80..d2395e30 100644 --- a/installer/OpenSLX/OSExport/BlockDevice/Base.pm +++ b/installer/OpenSLX/OSExport/BlockDevice/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSExport::BlockDevice API. +# - provides empty base of the OpenSLX OSExport::BlockDevice API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::BlockDevice::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -25,7 +25,7 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Creating OpenSLX::OSExport::BlockDevice::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSExport::BlockDevice::Base-objects directly makes no sense!"; } sub initialize diff --git a/installer/OpenSLX/OSExport/BlockDevice/DNBD2.pm b/installer/OpenSLX/OSExport/BlockDevice/DNBD2.pm index 8cd20904..8dcc340b 100644 --- a/installer/OpenSLX/OSExport/BlockDevice/DNBD2.pm +++ b/installer/OpenSLX/OSExport/BlockDevice/DNBD2.pm @@ -9,8 +9,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # DNBD2.pm -# - provides DNBD2+Squashfs-specific overrides of the -# OpenSLX::OSExport::BlockDevice API. +# - provides DNBD2+Squashfs-specific overrides of the +# OpenSLX::OSExport::BlockDevice API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::BlockDevice::DNBD2; @@ -30,73 +30,73 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {'name' => 'dnbd2',}; - return bless $self, $class; + my $class = shift; + my $self = {'name' => 'dnbd2',}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; - my $fs = shift; + my $self = shift; + my $engine = shift; + my $fs = shift; - $self->{'engine'} = $engine; - $self->{'fs'} = $fs; - return; + $self->{'engine'} = $engine; + $self->{'fs'} = $fs; + return; } sub getExportPort { - my $self = shift; - my $openslxDB = shift; + my $self = shift; + my $openslxDB = shift; - return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); + return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); } sub generateExportURI { - my $self = shift; - my $export = shift; + my $self = shift; + my $export = shift; - my $serverIP = $export->{server_ip} || ''; - my $server - = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); - $server .= ":$export->{port}" if length($export->{port}); + my $serverIP = $export->{server_ip} || ''; + my $server + = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); + $server .= ":$export->{port}" if length($export->{port}); - return "dnbd2://$server"; + return "dnbd2://$server"; } sub requiredBlockDeviceModules { - my $self = shift; + my $self = shift; - return qw( dnbd2 ); + return qw( dnbd2 ); } sub requiredBlockDeviceTools { - my $self = shift; + my $self = shift; - return qw( ); + return qw( ); } sub showExportConfigInfo { - my $self = shift; - my $export = shift; - - print '#' x 80 , "\n", - _tr( - "Please make sure you start a corresponding dnbd2-server:\n\t%s\n", - "dnbd2-server /etc/dnbd2/server.conf\n" - ), - "Create or modify a config file like /etc/dnbd2/server.conf, looking like:", - "\n", - "$export->{port}\n", - "$self->{fs}->{'export-path'}\n", - '#' x 80, "\n"; - return; + my $self = shift; + my $export = shift; + + print '#' x 80 , "\n", + _tr( + "Please make sure you start a corresponding dnbd2-server:\n\t%s\n", + "dnbd2-server /etc/dnbd2/server.conf\n" + ), + "Create or modify a config file like /etc/dnbd2/server.conf, looking like:", + "\n", + "$export->{port}\n", + "$self->{fs}->{'export-path'}\n", + '#' x 80, "\n"; + return; } 1; diff --git a/installer/OpenSLX/OSExport/BlockDevice/NBD.pm b/installer/OpenSLX/OSExport/BlockDevice/NBD.pm index fff4b024..73694fbc 100644 --- a/installer/OpenSLX/OSExport/BlockDevice/NBD.pm +++ b/installer/OpenSLX/OSExport/BlockDevice/NBD.pm @@ -9,8 +9,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # NBD.pm -# - provides NBD+Squashfs-specific overrides of the -# OpenSLX::OSExport::BlockDevice API. +# - provides NBD+Squashfs-specific overrides of the +# OpenSLX::OSExport::BlockDevice API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::BlockDevice::NBD; @@ -30,69 +30,69 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {'name' => 'nbd',}; - return bless $self, $class; + my $class = shift; + my $self = {'name' => 'nbd',}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; - my $fs = shift; + my $self = shift; + my $engine = shift; + my $fs = shift; - $self->{'engine'} = $engine; - $self->{'fs'} = $fs; - return; + $self->{'engine'} = $engine; + $self->{'fs'} = $fs; + return; } sub getExportPort { - my $self = shift; - my $openslxDB = shift; + my $self = shift; + my $openslxDB = shift; - return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); + return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); } sub generateExportURI { - my $self = shift; - my $export = shift; + my $self = shift; + my $export = shift; - my $serverIP = $export->{server_ip} || ''; - my $server - = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); - $server .= ":$export->{port}" if length($export->{port}); + my $serverIP = $export->{server_ip} || ''; + my $server + = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); + $server .= ":$export->{port}" if length($export->{port}); - return "nbd://$server"; + return "nbd://$server"; } sub requiredBlockDeviceModules { - my $self = shift; + my $self = shift; - return qw( nbd ); + return qw( nbd ); } sub requiredBlockDeviceTools { - my $self = shift; + my $self = shift; - return qw( nbd-client ); + return qw( nbd-client ); } sub showExportConfigInfo { - my $self = shift; - my $export = shift; - - print(('#' x 80) . "\n"); - print _tr( - "Please make sure you start a corresponding nbd-server:\n\t%s\n", - "nbd-server $export->{port} $self->{fs}->{'export-path'} -r" - ); - print(('#' x 80) . "\n"); - return; + my $self = shift; + my $export = shift; + + print(('#' x 80) . "\n"); + print _tr( + "Please make sure you start a corresponding nbd-server:\n\t%s\n", + "nbd-server $export->{port} $self->{fs}->{'export-path'} -r" + ); + print(('#' x 80) . "\n"); + return; } 1; diff --git a/installer/OpenSLX/OSExport/Distro/Any.pm b/installer/OpenSLX/OSExport/Distro/Any.pm index bf780bb9..59de2f32 100644 --- a/installer/OpenSLX/OSExport/Distro/Any.pm +++ b/installer/OpenSLX/OSExport/Distro/Any.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Any.pm -# - provides generic overrides of the OpenSLX OSExport API. +# - provides generic overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Any; @@ -25,41 +25,41 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'any', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'any', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/lock/* - - /var/log/* - - /var/lib/xdm - - /var/lib/smart - - /var/cache/yum - - /var/cache/man/* - - /usr/share/vmware/* - - /tmp/* - - /sys/* - - /proc/* - - /mnt/* - - /media/* + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/lock/* + - /var/log/* + - /var/lib/xdm + - /var/lib/smart + - /var/cache/yum + - /var/cache/man/* + - /usr/share/vmware/* + - /tmp/* + - /sys/* + - /proc/* + - /mnt/* + - /media/* + /lib/modules/*/misc/vmblock.o + /lib/modules/*/misc/vmnet.o + /lib/modules/*/misc/vmmon.o - - /lib/klibc/events/* - - /boot/initrd* - - /boot/grub - "; - return; + - /lib/klibc/events/* + - /boot/initrd* + - /boot/grub + "; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSExport/Distro/Base.pm b/installer/OpenSLX/OSExport/Distro/Base.pm index 29659f09..b6fc1fae 100644 --- a/installer/OpenSLX/OSExport/Distro/Base.pm +++ b/installer/OpenSLX/OSExport/Distro/Base.pm @@ -9,15 +9,15 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the distro-specific part of the OpenSLX -# OSExport API. +# - provides empty base of the distro-specific part of the OpenSLX +# OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -26,18 +26,18 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Creating OpenSLX::OSExport::Distro::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSExport::Distro::Base-objects directly makes no sense!"; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->{'engine'} = $engine; + $self->{'engine'} = $engine; - $self->initDistroInfo(); - return; + $self->initDistroInfo(); + return; } sub initDistroInfo diff --git a/installer/OpenSLX/OSExport/Distro/Debian.pm b/installer/OpenSLX/OSExport/Distro/Debian.pm index 4da68ffb..d1ae7d88 100644 --- a/installer/OpenSLX/OSExport/Distro/Debian.pm +++ b/installer/OpenSLX/OSExport/Distro/Debian.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Debian.pm -# - provides Debian-specific overrides of the OpenSLX OSExport API. +# - provides Debian-specific overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Debian; @@ -25,35 +25,35 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'debian', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'debian', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/log/* - - /var/lib/xdm - - /var/cache/man/* - - /usr/share/vmware/* - - /tmp/* - - /sys/* - - /proc/* - - /mnt/* - - /media/* - - /lib/klibc/events/* - - /boot/initrd* - - /boot/grub - "; - return; + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/log/* + - /var/lib/xdm + - /var/cache/man/* + - /usr/share/vmware/* + - /tmp/* + - /sys/* + - /proc/* + - /mnt/* + - /media/* + - /lib/klibc/events/* + - /boot/initrd* + - /boot/grub + "; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSExport/Distro/Fedora.pm b/installer/OpenSLX/OSExport/Distro/Fedora.pm index a643c91a..4e8c0bf0 100644 --- a/installer/OpenSLX/OSExport/Distro/Fedora.pm +++ b/installer/OpenSLX/OSExport/Distro/Fedora.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Fedora.pm -# - provides Fedora-specific overrides of the OpenSLX OSExport API. +# - provides Fedora-specific overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Fedora; @@ -25,41 +25,41 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'fedora', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'fedora', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - # TODO: check and refine this! - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/lock/* - - /var/log/* - - /var/lib/xdm - - /var/lib/smart - - /var/cache/yum - - /var/cache/man/* - - /usr/share/vmware/* - - /tmp/* - - /sys/* - - /proc/* - - /mnt/* - - /media/* - - /lib/klibc/events/* - - /boot/initrd* - - /boot/grub - - *.rpmsave - - *.rpmnew - "; - return; + # TODO: check and refine this! + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/lock/* + - /var/log/* + - /var/lib/xdm + - /var/lib/smart + - /var/cache/yum + - /var/cache/man/* + - /usr/share/vmware/* + - /tmp/* + - /sys/* + - /proc/* + - /mnt/* + - /media/* + - /lib/klibc/events/* + - /boot/initrd* + - /boot/grub + - *.rpmsave + - *.rpmnew + "; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSExport/Distro/Gentoo.pm b/installer/OpenSLX/OSExport/Distro/Gentoo.pm index d46b6037..1df759dd 100644 --- a/installer/OpenSLX/OSExport/Distro/Gentoo.pm +++ b/installer/OpenSLX/OSExport/Distro/Gentoo.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Gentoo.pm -# - provides Gentoo-specific overrides of the OpenSLX OSExport API. +# - provides Gentoo-specific overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Gentoo; @@ -25,35 +25,35 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'gentoo', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'gentoo', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/log/* - - /var/lib/xdm - - /var/lib/init.d/* - - /var/cache/man/* - - /usr/share/vmware/* - - /tmp/* - - /sys/* - - /proc/* - - /mnt/* - - /media/* - - /boot/initrd* - - /boot/grub - "; - return; + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/log/* + - /var/lib/xdm + - /var/lib/init.d/* + - /var/cache/man/* + - /usr/share/vmware/* + - /tmp/* + - /sys/* + - /proc/* + - /mnt/* + - /media/* + - /boot/initrd* + - /boot/grub + "; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSExport/Distro/SUSE.pm b/installer/OpenSLX/OSExport/Distro/SUSE.pm index 5d7ed615..7f5d5548 100644 --- a/installer/OpenSLX/OSExport/Distro/SUSE.pm +++ b/installer/OpenSLX/OSExport/Distro/SUSE.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SUSE.pm -# - provides SUSE-specific overrides of the OpenSLX OSExport API. +# - provides SUSE-specific overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::SUSE; @@ -25,89 +25,89 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'suse', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'suse', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/mail - - /var/log/* - - /var/lock/* - - /var/lib/zypp/* - - /var/lib/zmd - - /var/lib/xdm - - /var/lib/vm* - - /var/lib/suspend* - - /var/lib/smart - - /var/lib/sax - - /var/lib/hardware/* - - /var/lib/gdm/* - - /var/lib/dhcp* - - /var/lib/bluetooth/ - - /var/lib/YaST2/you/mnt/* - - /var/lib/YaST2/backup_boot_sectors - - /var/cache/sax - - /var/cache/libx11/compose/* - - /var/cache/beagle - - /var/cache/yum - - /var/cache/man/* - - /var/adm/backup/rpmdb/* - - /var/adm/mount/AP* - - /var/adm/SuSEconfig - - /usr/share/vmware/* - - /usr/lib/zen-updater - + /usr/lib/python*/*/*.o - + /usr/lib/perl5/*/*/*/*.o - + /usr/lib/gcc/*/*/*.o - + /usr/lib/*.o - + /usr/X11R6/lib/modules/drivers/*.o - + /usr/X11R6/lib/modules/drivers/linux/*.o - - /usr/bin/zen-* - - /usr/bin/nw-manager - - /usr/X11R6/bin/BackGround - - /usr/bin/BackGround - - /tmp/* - - /sys/* - - /proc/* - - /opt/kde3/share/autostart/suseplugger.desktop - - /opt/kde3/share/autostart/susewatcher.desktop - - /opt/kde3/share/autostart/runupdater.desktop - - /opt/kde3/share/autostart/profile_chooser-autostart.desktop - - /opt/kde3/share/autostart/opensuseupdater.desktop - - /opt/kde3/share/autostart/knetworkmanager-autostart.desktop - - /opt/kde3/share/autostart/kerry.autostart.desktop - - /opt/kde3/share/autostart/kinternet.desktop - - /opt/kde3/share/autostart/beagled.desktop - - /opt/kde3/share/autostart/SUSEgreeter.desktop - - /opt/kde3/share/autostart/zen-updater-auto.desktop - - /opt/gnome/share/autostart/beagle*.desktop - - /mnt/* - - /media/* - + /media - + /lib/modules/*/misc/vmblock.o - + /lib/modules/*/misc/vmnet.o - + /lib/modules/*/misc/vmmon.o - - /etc/dhcpd.conf* - - /etc/cron.*/* - - /etc/sysconfig/network/ifcfg-* - - /etc/X11/xdm/SuSEconfig.xdm - - /boot/initrd* - - /boot/grub - - *.rpmsave - - *.rpmnew - - *.YaST2save - "; - return; + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/mail + - /var/log/* + - /var/lock/* + - /var/lib/zypp/* + - /var/lib/zmd + - /var/lib/xdm + - /var/lib/vm* + - /var/lib/suspend* + - /var/lib/smart + - /var/lib/sax + - /var/lib/hardware/* + - /var/lib/gdm/* + - /var/lib/dhcp* + - /var/lib/bluetooth/ + - /var/lib/YaST2/you/mnt/* + - /var/lib/YaST2/backup_boot_sectors + - /var/cache/sax + - /var/cache/libx11/compose/* + - /var/cache/beagle + - /var/cache/yum + - /var/cache/man/* + - /var/adm/backup/rpmdb/* + - /var/adm/mount/AP* + - /var/adm/SuSEconfig + - /usr/share/vmware/* + - /usr/lib/zen-updater + + /usr/lib/python*/*/*.o + + /usr/lib/perl5/*/*/*/*.o + + /usr/lib/gcc/*/*/*.o + + /usr/lib/*.o + + /usr/X11R6/lib/modules/drivers/*.o + + /usr/X11R6/lib/modules/drivers/linux/*.o + - /usr/bin/zen-* + - /usr/bin/nw-manager + - /usr/X11R6/bin/BackGround + - /usr/bin/BackGround + - /tmp/* + - /sys/* + - /proc/* + - /opt/kde3/share/autostart/suseplugger.desktop + - /opt/kde3/share/autostart/susewatcher.desktop + - /opt/kde3/share/autostart/runupdater.desktop + - /opt/kde3/share/autostart/profile_chooser-autostart.desktop + - /opt/kde3/share/autostart/opensuseupdater.desktop + - /opt/kde3/share/autostart/knetworkmanager-autostart.desktop + - /opt/kde3/share/autostart/kerry.autostart.desktop + - /opt/kde3/share/autostart/kinternet.desktop + - /opt/kde3/share/autostart/beagled.desktop + - /opt/kde3/share/autostart/SUSEgreeter.desktop + - /opt/kde3/share/autostart/zen-updater-auto.desktop + - /opt/gnome/share/autostart/beagle*.desktop + - /mnt/* + - /media/* + + /media + + /lib/modules/*/misc/vmblock.o + + /lib/modules/*/misc/vmnet.o + + /lib/modules/*/misc/vmmon.o + - /etc/dhcpd.conf* + - /etc/cron.*/* + - /etc/sysconfig/network/ifcfg-* + - /etc/X11/xdm/SuSEconfig.xdm + - /boot/initrd* + - /boot/grub + - *.rpmsave + - *.rpmnew + - *.YaST2save + "; + return; } 1; diff --git a/installer/OpenSLX/OSExport/Distro/Ubuntu.pm b/installer/OpenSLX/OSExport/Distro/Ubuntu.pm index c26aa706..0f60b63f 100644 --- a/installer/OpenSLX/OSExport/Distro/Ubuntu.pm +++ b/installer/OpenSLX/OSExport/Distro/Ubuntu.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Ubuntu.pm -# - provides Ubuntu-specific overrides of the OpenSLX OSExport API. +# - provides Ubuntu-specific overrides of the OpenSLX OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Distro::Ubuntu; @@ -25,37 +25,37 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'base-name' => 'ubuntu', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'base-name' => 'ubuntu', + }; + return bless $self, $class; } sub initDistroInfo { - my $self = shift; + my $self = shift; - $self->{'export-filter'} = " - - /var/tmp/* - - /var/spool/* - - /var/run/* - - /var/log/* - - /var/lib/xdm - - /var/cache/man/* - - /usr/share/vmware/* - - /tmp/* - - /sys/* - - /proc/* - - /mnt/* - - /media/* - - /lib/klibc/events/* - - /initrd* - - /etc/cron.*/* - - /boot/initrd* - - /boot/grub - "; - return; + $self->{'export-filter'} = " + - /var/tmp/* + - /var/spool/* + - /var/run/* + - /var/log/* + - /var/lib/xdm + - /var/cache/man/* + - /usr/share/vmware/* + - /tmp/* + - /sys/* + - /proc/* + - /mnt/* + - /media/* + - /lib/klibc/events/* + - /initrd* + - /etc/cron.*/* + - /boot/initrd* + - /boot/grub + "; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSExport/Engine.pm b/installer/OpenSLX/OSExport/Engine.pm index 743a46b9..7aba36da 100644 --- a/installer/OpenSLX/OSExport/Engine.pm +++ b/installer/OpenSLX/OSExport/Engine.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Engine.pm -# - provides driver engine for the OSExport API. +# - provides driver engine for the OSExport API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::Engine; @@ -38,30 +38,30 @@ our ( ); %supportedExportFileSystems = ( - 'nfs' => 'NFS', - 'sqfs' => 'SquashFS', + 'nfs' => 'NFS', + 'sqfs' => 'SquashFS', ); %supportedExportBlockDevices = ( - 'dnbd2' => 'DNBD2', - 'nbd' => 'NBD', - 'aoe' => 'AoE', + 'dnbd2' => 'DNBD2', + 'nbd' => 'NBD', + 'aoe' => 'AoE', ); @supportedExportTypes = ( - 'nfs', - 'sqfs-aoe', - 'sqfs-dnbd2', - 'sqfs-nbd', + 'nfs', + 'sqfs-aoe', + 'sqfs-dnbd2', + 'sqfs-nbd', ); %supportedDistros = ( - '' => {module => 'Any'}, - 'debian' => {module => 'Debian'}, - 'fedora' => {module => 'Fedora'}, - 'gentoo' => {module => 'Gentoo'}, - 'suse' => {module => 'SUSE'}, - 'ubuntu' => {module => 'Ubuntu'}, + '' => {module => 'Any'}, + 'debian' => {module => 'Debian'}, + 'fedora' => {module => 'Fedora'}, + 'gentoo' => {module => 'Gentoo'}, + 'suse' => {module => 'SUSE'}, + 'ubuntu' => {module => 'Ubuntu'}, ); ################################################################################ @@ -69,117 +69,117 @@ our ( ################################################################################ sub new { - my $class = shift; + my $class = shift; - my $self = {}; + my $self = {}; - return bless $self, $class; + return bless $self, $class; } sub initializeFromExisting { - my $self = shift; - my $exportName = shift; + my $self = shift; + my $exportName = shift; - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); - if (!defined $export) { - die _tr("Export '%s' not found in DB, giving up!", $exportName); - } - my $vendorOS = - $openslxDB->fetchVendorOSByFilter({'id' => $export->{vendor_os_id}}); + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("Export '%s' not found in DB, giving up!", $exportName); + } + my $vendorOS = + $openslxDB->fetchVendorOSByFilter({'id' => $export->{vendor_os_id}}); - $openslxDB->disconnect(); + $openslxDB->disconnect(); - $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $export->{name}, - $export->{type}); - return; + $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $export->{name}, + $export->{type}); + return; } sub initializeForNew { - my $self = shift; - my $vendorOSName = shift; - my $exportType = lc(shift); + my $self = shift; + my $vendorOSName = shift; + my $exportType = lc(shift); - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); - my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); - if (!defined $vendorOS) { - die _tr("vendor-OS '%s' not found in DB, giving up!", $vendorOSName); - } + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (!defined $vendorOS) { + die _tr("vendor-OS '%s' not found in DB, giving up!", $vendorOSName); + } - my $exportName = "${vendorOSName}::${exportType}"; + my $exportName = "${vendorOSName}::${exportType}"; - $openslxDB->disconnect(); + $openslxDB->disconnect(); - $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $exportName, - $exportType); - return; + $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $exportName, + $exportType); + return; } sub exportVendorOS { - my $self = shift; - - if (!$self->{'exporter'}->checkRequirements($self->{'vendor-os-path'})) { - die _tr( - "clients wouldn't be able to access the exported root-fs!\nplease " - . "install the missing module(s) or use another export-type."); - } - - $self->{'exporter'}->exportVendorOS($self->{'vendor-os-path'},); - vlog( - 0, - _tr( - "vendor-OS '%s' successfully exported to '%s'!", - $self->{'vendor-os-path'}, - $self->{exporter}->{'export-path'} - ) - ); - $self->_addExportToConfigDB(); - return; + my $self = shift; + + if (!$self->{'exporter'}->checkRequirements($self->{'vendor-os-path'})) { + die _tr( + "clients wouldn't be able to access the exported root-fs!\nplease " + . "install the missing module(s) or use another export-type."); + } + + $self->{'exporter'}->exportVendorOS($self->{'vendor-os-path'},); + vlog( + 0, + _tr( + "vendor-OS '%s' successfully exported to '%s'!", + $self->{'vendor-os-path'}, + $self->{exporter}->{'export-path'} + ) + ); + $self->_addExportToConfigDB(); + return; } sub purgeExport { - my $self = shift; - - if ($self->{'exporter'}->purgeExport()) { - vlog( - 0, - _tr( - "export '%s' successfully removed!", - $self->{exporter}->{'export-path'} - ) - ); - } - $self->_removeExportFromConfigDB(); - return; + my $self = shift; + + if ($self->{'exporter'}->purgeExport()) { + vlog( + 0, + _tr( + "export '%s' successfully removed!", + $self->{exporter}->{'export-path'} + ) + ); + } + $self->_removeExportFromConfigDB(); + return; } sub generateExportURI { - my $self = shift; + my $self = shift; - return $self->{exporter}->generateExportURI(@_); + return $self->{exporter}->generateExportURI(@_); } sub requiredFSMods { - my $self = shift; + my $self = shift; - return $self->{exporter}->requiredFSMods(); + return $self->{exporter}->requiredFSMods(); } sub requiredFSTools { - my $self = shift; + my $self = shift; - return $self->{exporter}->requiredFSTools(); + return $self->{exporter}->requiredFSTools(); } ################################################################################ @@ -187,175 +187,175 @@ sub requiredFSTools ################################################################################ sub _initialize { - my $self = shift; - my $vendorOSName = shift; - my $vendorOSId = shift; - my $exportName = shift; - my $exportType = lc(shift); - - if ($vendorOSName eq '<<>>') { - die _tr("you can't do that with the default vendor-OS!\n"); - } - if (!grep { $_ eq $exportType } @supportedExportTypes) { - vlog(0, - _tr("Sorry, export type '%s' is unsupported.\n", $exportType) - . _tr("List of supported export types:\n\t") - . join("\n\t", sort @supportedExportTypes)); - exit 1; - } - $exportType =~ m[^(\w+)(?:-(\w+))?$]; - my $exportFS = lc($1); - my $exportBD = lc($2); - vlog(2, "export-filesys='$exportFS' export-blockdev='$exportBD'"); - - $self->{'vendor-os-name'} = $vendorOSName; - $self->{'vendor-os-id'} = $vendorOSId; - $self->{'export-name'} = $exportName; - $self->{'export-type'} = $exportType; - $vendorOSName =~ m[^(.+?\-[^-]+)]; - my $distroName = $1; - $self->{'distro-name'} = $distroName; - - # load module for the requested distro: - if (!exists $supportedDistros{lc($distroName)}) { - # try without _x86_64: - $distroName =~ s[_x86_64$][]; - if (!exists $supportedDistros{lc($distroName)}) { - # try basic distro-type (e.g. debian or suse): - $distroName =~ s[-.+$][]; - if (!exists $supportedDistros{lc($distroName)}) { - # fallback to generic implementation: - $distroName = ''; - } - } - } - my $distroModuleName = $supportedDistros{lc($distroName)}->{module}; - my $distro = - instantiateClass("OpenSLX::OSExport::Distro::$distroModuleName"); - $distro->initialize($self); - $self->{distro} = $distro; - - # load module for the requested export type: - my $fsModuleName = $supportedExportFileSystems{$exportFS}; - my $exporter = - instantiateClass("OpenSLX::OSExport::FileSystem::$fsModuleName"); - if (length($exportBD)) { - my $blockModuleName = $supportedExportBlockDevices{$exportBD}; - my $blockDevice = - instantiateClass("OpenSLX::OSExport::BlockDevice::$blockModuleName"); - $blockDevice->initialize($self, $exporter); - $exporter->initialize($self, $blockDevice); - } else { - $exporter->initialize($self); - } - $self->{'exporter'} = $exporter; - - # setup source and target paths: - $self->{'vendor-os-path'} = - "$openslxConfig{'private-path'}/stage1/$vendorOSName"; - vlog( - 1, - _tr( - "vendor-OS from '%s' will be exported to '%s'", - $self->{'vendor-os-path'}, - $exporter->{'export-path'} - ) - ); - return; + my $self = shift; + my $vendorOSName = shift; + my $vendorOSId = shift; + my $exportName = shift; + my $exportType = lc(shift); + + if ($vendorOSName eq '<<>>') { + die _tr("you can't do that with the default vendor-OS!\n"); + } + if (!grep { $_ eq $exportType } @supportedExportTypes) { + vlog(0, + _tr("Sorry, export type '%s' is unsupported.\n", $exportType) + . _tr("List of supported export types:\n\t") + . join("\n\t", sort @supportedExportTypes)); + exit 1; + } + $exportType =~ m[^(\w+)(?:-(\w+))?$]; + my $exportFS = lc($1); + my $exportBD = lc($2); + vlog(2, "export-filesys='$exportFS' export-blockdev='$exportBD'"); + + $self->{'vendor-os-name'} = $vendorOSName; + $self->{'vendor-os-id'} = $vendorOSId; + $self->{'export-name'} = $exportName; + $self->{'export-type'} = $exportType; + $vendorOSName =~ m[^(.+?\-[^-]+)]; + my $distroName = $1; + $self->{'distro-name'} = $distroName; + + # load module for the requested distro: + if (!exists $supportedDistros{lc($distroName)}) { + # try without _x86_64: + $distroName =~ s[_x86_64$][]; + if (!exists $supportedDistros{lc($distroName)}) { + # try basic distro-type (e.g. debian or suse): + $distroName =~ s[-.+$][]; + if (!exists $supportedDistros{lc($distroName)}) { + # fallback to generic implementation: + $distroName = ''; + } + } + } + my $distroModuleName = $supportedDistros{lc($distroName)}->{module}; + my $distro = + instantiateClass("OpenSLX::OSExport::Distro::$distroModuleName"); + $distro->initialize($self); + $self->{distro} = $distro; + + # load module for the requested export type: + my $fsModuleName = $supportedExportFileSystems{$exportFS}; + my $exporter = + instantiateClass("OpenSLX::OSExport::FileSystem::$fsModuleName"); + if (length($exportBD)) { + my $blockModuleName = $supportedExportBlockDevices{$exportBD}; + my $blockDevice = + instantiateClass("OpenSLX::OSExport::BlockDevice::$blockModuleName"); + $blockDevice->initialize($self, $exporter); + $exporter->initialize($self, $blockDevice); + } else { + $exporter->initialize($self); + } + $self->{'exporter'} = $exporter; + + # setup source and target paths: + $self->{'vendor-os-path'} = + "$openslxConfig{'private-path'}/stage1/$vendorOSName"; + vlog( + 1, + _tr( + "vendor-OS from '%s' will be exported to '%s'", + $self->{'vendor-os-path'}, + $exporter->{'export-path'} + ) + ); + return; } sub _addExportToConfigDB { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - - my $export = $openslxDB->fetchExportByFilter( - { - 'name' => $self->{'export-name'}, - 'vendor_os_id' => $self->{'vendor-os-id'}, - } - ); - if (defined $export) { - vlog( - 0, - _tr( - "No need to change export '%s' in OpenSLX-database.\n", - $self->{'export-name'} - ) - ); - $self->{exporter}->showExportConfigInfo($export); - } else { - $export = { - 'vendor_os_id' => $self->{'vendor-os-id'}, - 'name' => $self->{'export-name'}, - 'type' => $self->{'export-type'}, - }; - - my $id = $self->{exporter}->addExportToConfigDB($export, $openslxDB); - vlog( - 0, - _tr( - "Export '%s' has been added to DB (ID=%s)...\n", - $self->{'export-name'}, $id - ) - ); - - $self->{exporter}->showExportConfigInfo($export) if $id; - } - - my $system = $openslxDB->fetchSystemByFilter({ - 'name' => $self->{'export-name'}, - }); - if (!defined $system) { - # now create a default system for that export, using the standard kernel: - system("slxconfig add-system $self->{'export-name'}"); - } - - $openslxDB->disconnect(); - return; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + + my $export = $openslxDB->fetchExportByFilter( + { + 'name' => $self->{'export-name'}, + 'vendor_os_id' => $self->{'vendor-os-id'}, + } + ); + if (defined $export) { + vlog( + 0, + _tr( + "No need to change export '%s' in OpenSLX-database.\n", + $self->{'export-name'} + ) + ); + $self->{exporter}->showExportConfigInfo($export); + } else { + $export = { + 'vendor_os_id' => $self->{'vendor-os-id'}, + 'name' => $self->{'export-name'}, + 'type' => $self->{'export-type'}, + }; + + my $id = $self->{exporter}->addExportToConfigDB($export, $openslxDB); + vlog( + 0, + _tr( + "Export '%s' has been added to DB (ID=%s)...\n", + $self->{'export-name'}, $id + ) + ); + + $self->{exporter}->showExportConfigInfo($export) if $id; + } + + my $system = $openslxDB->fetchSystemByFilter({ + 'name' => $self->{'export-name'}, + }); + if (!defined $system) { + # now create a default system for that export, using the standard kernel: + system("slxconfig add-system $self->{'export-name'}"); + } + + $openslxDB->disconnect(); + return; } sub _removeExportFromConfigDB { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - - # remove export from DB: - my $exportName = $self->{'export-name'}; - my $export = $openslxDB->fetchExportByFilter({'name' => $exportName,}); - if (!defined $export) { - vlog( - 0, - _tr( - "Export '%s' doesn't exist in OpenSLX-database.\n", $exportName - ) - ); - } else { - # remove all systems using this export and then remove the - # export itself: - my @systemIDs = - map { $_->{id} } - $openslxDB->fetchSystemByFilter({'export_id' => $export->{id}}, 'id'); - vlog( - 1, - _tr( - "removing systems '%s' from DB, since they belong to the export" - . " being deleted.\n", - join ',', - @systemIDs - ) - ); - $openslxDB->removeSystem(\@systemIDs); - $openslxDB->removeExport($export->{id}); - vlog(0, _tr("Export '%s' has been removed from DB.\n", $exportName)); - } - - $openslxDB->disconnect(); - return; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + + # remove export from DB: + my $exportName = $self->{'export-name'}; + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName,}); + if (!defined $export) { + vlog( + 0, + _tr( + "Export '%s' doesn't exist in OpenSLX-database.\n", $exportName + ) + ); + } else { + # remove all systems using this export and then remove the + # export itself: + my @systemIDs = + map { $_->{id} } + $openslxDB->fetchSystemByFilter({'export_id' => $export->{id}}, 'id'); + vlog( + 1, + _tr( + "removing systems '%s' from DB, since they belong to the export" + . " being deleted.\n", + join ',', + @systemIDs + ) + ); + $openslxDB->removeSystem(\@systemIDs); + $openslxDB->removeExport($export->{id}); + vlog(0, _tr("Export '%s' has been removed from DB.\n", $exportName)); + } + + $openslxDB->disconnect(); + return; } 1; diff --git a/installer/OpenSLX/OSExport/FileSystem/Base.pm b/installer/OpenSLX/OSExport/FileSystem/Base.pm index a59cc944..1014d596 100644 --- a/installer/OpenSLX/OSExport/FileSystem/Base.pm +++ b/installer/OpenSLX/OSExport/FileSystem/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSExport::FileSystem API. +# - provides empty base of the OpenSLX OSExport::FileSystem API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::FileSystem::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use File::Basename; @@ -28,7 +28,7 @@ use OpenSLX::Utils; ################################################################################ sub new { - confess "Creating OpenSLX::OSExport::FileSystem::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSExport::FileSystem::Base-objects directly makes no sense!"; } sub initialize @@ -45,16 +45,16 @@ sub purgeExport sub checkRequirements { - return 1; + return 1; } sub addExportToConfigDB { - my $self = shift; - my $export = shift; - my $openslxDB = shift; + my $self = shift; + my $export = shift; + my $openslxDB = shift; - return $openslxDB->addExport($export); + return $openslxDB->addExport($export); } sub generateExportURI @@ -78,54 +78,54 @@ sub showExportConfigInfo ################################################################################ sub _pickKernelVersion { - my $self = shift; - my $vendorOSPath = shift; - - my $kernel = followLink("$vendorOSPath/boot/vmlinuz"); - if (!-e $kernel) { - # 'vmlinuz'-link doesn't exist, so we have to pick the kernel manually - my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); - $osSetupEngine->initialize($self->{engine}->{'vendor-os-name'}, 'none'); - $kernel = $osSetupEngine->pickKernelFile("$vendorOSPath/boot"); - } - my $kernelName = basename($kernel); - if ($kernelName !~ m[-(.+)$]) { - die _tr("unable to determine version of kernel '%s'!", $kernelName); - } - return $1; + my $self = shift; + my $vendorOSPath = shift; + + my $kernel = followLink("$vendorOSPath/boot/vmlinuz"); + if (!-e $kernel) { + # 'vmlinuz'-link doesn't exist, so we have to pick the kernel manually + my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); + $osSetupEngine->initialize($self->{engine}->{'vendor-os-name'}, 'none'); + $kernel = $osSetupEngine->pickKernelFile("$vendorOSPath/boot"); + } + my $kernelName = basename($kernel); + if ($kernelName !~ m[-(.+)$]) { + die _tr("unable to determine version of kernel '%s'!", $kernelName); + } + return $1; } sub _locateKernelModule { - my $self = shift; - my $vendorOSPath = shift; - my $moduleName = shift; - my $defaultPaths = shift; - - vlog(1, _tr("locating kernel-module '%s'", $moduleName)); - # check default paths first: - foreach my $defPath (@$defaultPaths) { - vlog(2, "trying $defPath/$moduleName"); - my $target = followLink("$defPath/$moduleName", $vendorOSPath); - return $target unless !-e $target; - } - # use brute force to search for the newest incarnation of the module: - use File::Find; - my $location; - my $locationAge = 9999999; - vlog(2, "searching in $vendorOSPath/lib/modules"); - find sub { - return unless $_ eq $moduleName; - if (-M _ < $locationAge) { - $locationAge = -M _; - $location = $File::Find::name; - vlog(2, "located at $location (age=$locationAge days)"); - } - }, "$vendorOSPath/lib/modules"; - if (defined $location) { - return followLink($location, $vendorOSPath); - } - return; + my $self = shift; + my $vendorOSPath = shift; + my $moduleName = shift; + my $defaultPaths = shift; + + vlog(1, _tr("locating kernel-module '%s'", $moduleName)); + # check default paths first: + foreach my $defPath (@$defaultPaths) { + vlog(2, "trying $defPath/$moduleName"); + my $target = followLink("$defPath/$moduleName", $vendorOSPath); + return $target unless !-e $target; + } + # use brute force to search for the newest incarnation of the module: + use File::Find; + my $location; + my $locationAge = 9999999; + vlog(2, "searching in $vendorOSPath/lib/modules"); + find sub { + return unless $_ eq $moduleName; + if (-M _ < $locationAge) { + $locationAge = -M _; + $location = $File::Find::name; + vlog(2, "located at $location (age=$locationAge days)"); + } + }, "$vendorOSPath/lib/modules"; + if (defined $location) { + return followLink($location, $vendorOSPath); + } + return; } 1; diff --git a/installer/OpenSLX/OSExport/FileSystem/NFS.pm b/installer/OpenSLX/OSExport/FileSystem/NFS.pm index 9ab1ddfe..f14bc497 100644 --- a/installer/OpenSLX/OSExport/FileSystem/NFS.pm +++ b/installer/OpenSLX/OSExport/FileSystem/NFS.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # NFS.pm -# - provides NFS-specific overrides of the OpenSLX::OSExport::FileSystem API. +# - provides NFS-specific overrides of the OpenSLX::OSExport::FileSystem API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::FileSystem::NFS; @@ -28,107 +28,107 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'nfs', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'nfs', + }; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->{'engine'} = $engine; - my $exportBasePath = "$openslxConfig{'public-path'}/export"; - $self->{'export-path'} = "$exportBasePath/nfs/$engine->{'vendor-os-name'}"; - return; + $self->{'engine'} = $engine; + my $exportBasePath = "$openslxConfig{'public-path'}/export"; + $self->{'export-path'} = "$exportBasePath/nfs/$engine->{'vendor-os-name'}"; + return; } sub exportVendorOS { - my $self = shift; - my $source = shift; + my $self = shift; + my $source = shift; - my $target = $self->{'export-path'}; - $self->_copyViaRsync($source, $target); - return; + my $target = $self->{'export-path'}; + $self->_copyViaRsync($source, $target); + return; } sub purgeExport { - my $self = shift; - - my $target = $self->{'export-path'}; - if (system("rm -r $target")) { - vlog(0, _tr("unable to remove export '%s'!", $target)); - return 0; - } - return 1; + my $self = shift; + + my $target = $self->{'export-path'}; + if (system("rm -r $target")) { + vlog(0, _tr("unable to remove export '%s'!", $target)); + return 0; + } + return 1; } sub checkRequirements { - my $self = shift; - my $vendorOSPath = shift; - - # determine most appropriate kernel version ... - my $kernelVer = $self->_pickKernelVersion($vendorOSPath); - - # ... and check if that kernel-version provides all the required modules - my $nfsMod = $self->_locateKernelModule( - $vendorOSPath, - 'nfs.ko', - [ - "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/nfs", - "$vendorOSPath/lib/modules/$kernelVer/kernel/fs" - ] - ); - if (!defined $nfsMod) { - warn _tr("unable to find nfs-module for kernel version '%s'.", - $kernelVer); - return; - } - return 1; + my $self = shift; + my $vendorOSPath = shift; + + # determine most appropriate kernel version ... + my $kernelVer = $self->_pickKernelVersion($vendorOSPath); + + # ... and check if that kernel-version provides all the required modules + my $nfsMod = $self->_locateKernelModule( + $vendorOSPath, + 'nfs.ko', + [ + "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/nfs", + "$vendorOSPath/lib/modules/$kernelVer/kernel/fs" + ] + ); + if (!defined $nfsMod) { + warn _tr("unable to find nfs-module for kernel version '%s'.", + $kernelVer); + return; + } + return 1; } sub generateExportURI { - my $self = shift; - my $export = shift; - my $vendorOS = shift; - - my $serverIP = $export->{server_ip} || ''; - my $server - = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); - my $port = $export->{port} || ''; - $server .= ":$port" if length($port); - - my $exportPath = "$openslxConfig{'public-path'}/export"; - return "nfs://$server$exportPath/nfs/$vendorOS->{name}"; + my $self = shift; + my $export = shift; + my $vendorOS = shift; + + my $serverIP = $export->{server_ip} || ''; + my $server + = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip'); + my $port = $export->{port} || ''; + $server .= ":$port" if length($port); + + my $exportPath = "$openslxConfig{'public-path'}/export"; + return "nfs://$server$exportPath/nfs/$vendorOS->{name}"; } sub requiredFSMods { - my $self = shift; + my $self = shift; - return qw( nfs ); + return qw( nfs ); } sub showExportConfigInfo { - my $self = shift; - my $export = shift; + my $self = shift; + my $export = shift; - print (('#' x 80)."\n"); - print _tr("Please make sure the following line is contained in /etc/exports\nin order to activate the NFS-export of this vendor-OS:\n\t%s\n", - "$self->{'export-path'}\t*(ro,no_root_squash,async,no_subtree_check)"); - print (('#' x 80)."\n"); + print (('#' x 80)."\n"); + print _tr("Please make sure the following line is contained in /etc/exports\nin order to activate the NFS-export of this vendor-OS:\n\t%s\n", + "$self->{'export-path'}\t*(ro,no_root_squash,async,no_subtree_check)"); + print (('#' x 80)."\n"); # TODO : add something a bit more clever here... -# my $exports = slurpFile("/etc/exports"); - return; +# my $exports = slurpFile("/etc/exports"); + return; } ################################################################################ @@ -136,48 +136,48 @@ sub showExportConfigInfo ################################################################################ sub _copyViaRsync { - my $self = shift; - my $source = shift; - my $target = shift; - - if (system("mkdir -p $target")) { - die _tr("unable to create directory '%s', giving up! (%s)\n", - $target, $!); - } - my $includeExcludeList = $self->_determineIncludeExcludeList(); - vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); - my $rsyncFH; - my $additionalRsyncOptions = $ENV{SLX_RSYNC_OPTIONS} || ''; - my $rsyncCmd - = "rsync -av --delete-excluded --exclude-from=- $additionalRsyncOptions" - . " $source/ $target"; - vlog(2, "executing: $rsyncCmd\n"); - open($rsyncFH, '|-', $rsyncCmd) - or die _tr("unable to start rsync for source '%s', giving up! (%s)", - $source, $!); - print $rsyncFH $includeExcludeList; - close($rsyncFH) - or die _tr("unable to export to target '%s', giving up! (%s)", - $target, $!); - return; + my $self = shift; + my $source = shift; + my $target = shift; + + if (system("mkdir -p $target")) { + die _tr("unable to create directory '%s', giving up! (%s)\n", + $target, $!); + } + my $includeExcludeList = $self->_determineIncludeExcludeList(); + vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); + my $rsyncFH; + my $additionalRsyncOptions = $ENV{SLX_RSYNC_OPTIONS} || ''; + my $rsyncCmd + = "rsync -av --delete-excluded --exclude-from=- $additionalRsyncOptions" + . " $source/ $target"; + vlog(2, "executing: $rsyncCmd\n"); + open($rsyncFH, '|-', $rsyncCmd) + or die _tr("unable to start rsync for source '%s', giving up! (%s)", + $source, $!); + print $rsyncFH $includeExcludeList; + close($rsyncFH) + or die _tr("unable to export to target '%s', giving up! (%s)", + $target, $!); + return; } sub _determineIncludeExcludeList { - my $self = shift; - - # Rsync uses a first match strategy, so we mix the local specifications - # in front of the filterset given by the package (as the local filters - # should always overrule the vendor filters): - my $distroName = $self->{engine}->{'distro-name'}; - my $localFilterFile - = "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter"; - my $includeExcludeList - = slurpFile($localFilterFile, { failIfMissing => 0 }); - $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'}; - $includeExcludeList =~ s[^\s+][]igms; - # remove any leading whitespace, as rsync doesn't like it - return $includeExcludeList; + my $self = shift; + + # Rsync uses a first match strategy, so we mix the local specifications + # in front of the filterset given by the package (as the local filters + # should always overrule the vendor filters): + my $distroName = $self->{engine}->{'distro-name'}; + my $localFilterFile + = "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter"; + my $includeExcludeList + = slurpFile($localFilterFile, { failIfMissing => 0 }); + $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'}; + $includeExcludeList =~ s[^\s+][]igms; + # remove any leading whitespace, as rsync doesn't like it + return $includeExcludeList; } 1; diff --git a/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm b/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm index 87407ca3..d9760642 100644 --- a/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm +++ b/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm @@ -9,8 +9,8 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SquashFS.pm -# - provides SquashFS-specific overrides of the OpenSLX::OSExport::ExportType -# API. +# - provides SquashFS-specific overrides of the OpenSLX::OSExport::ExportType +# API. # ----------------------------------------------------------------------------- package OpenSLX::OSExport::FileSystem::SquashFS; @@ -30,153 +30,153 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {'name' => 'sqfs',}; - return bless $self, $class; + my $class = shift; + my $self = {'name' => 'sqfs',}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; - my $blockDevice = shift || confess('need to pass in block-device!'); - - $self->{'engine'} = $engine; - $self->{'block-device'} = $blockDevice; - my $exportBasePath = "$openslxConfig{'public-path'}/export"; - $self->{'export-path'} = "$exportBasePath/sqfs/$engine->{'vendor-os-name'}"; - return; + my $self = shift; + my $engine = shift; + my $blockDevice = shift || confess('need to pass in block-device!'); + + $self->{'engine'} = $engine; + $self->{'block-device'} = $blockDevice; + my $exportBasePath = "$openslxConfig{'public-path'}/export"; + $self->{'export-path'} = "$exportBasePath/sqfs/$engine->{'vendor-os-name'}"; + return; } sub exportVendorOS { - my $self = shift; - my $source = shift; - - my $includeExcludeList = $self->_determineIncludeExcludeList(); - # in order to do the filtering as part of mksquashfs, we need to map - # our internal (rsync-)filter format to regexes: - $includeExcludeList = - $self->_mapRsyncFilter2Regex($source, $includeExcludeList); - vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); - my $target = $self->{'export-path'}; - - my $sourceTime = (stat($source))[9] || 0; - my $targetTime = (stat($target))[9] || 0; - vlog(2, "source-time=$sourceTime target-time=$targetTime"); - - if ($targetTime && $sourceTime < $targetTime) { - vlog( - 0, - "!!! creation of squashfs skipped, as vendor-OS hasn't changed since last export!\n" - . "!!! Use 'touch $source' to force an export." - ); - } else { - $self->_createSquashFS($source, $target, $includeExcludeList); - } - $self->_addBlockDeviceTagToExport($target); - return; + my $self = shift; + my $source = shift; + + my $includeExcludeList = $self->_determineIncludeExcludeList(); + # in order to do the filtering as part of mksquashfs, we need to map + # our internal (rsync-)filter format to regexes: + $includeExcludeList = + $self->_mapRsyncFilter2Regex($source, $includeExcludeList); + vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); + my $target = $self->{'export-path'}; + + my $sourceTime = (stat($source))[9] || 0; + my $targetTime = (stat($target))[9] || 0; + vlog(2, "source-time=$sourceTime target-time=$targetTime"); + + if ($targetTime && $sourceTime < $targetTime) { + vlog( + 0, + "!!! creation of squashfs skipped, as vendor-OS hasn't changed since last export!\n" + . "!!! Use 'touch $source' to force an export." + ); + } else { + $self->_createSquashFS($source, $target, $includeExcludeList); + } + $self->_addBlockDeviceTagToExport($target); + return; } sub purgeExport { - my $self = shift; - - my $target = $self->{'export-path'}; - if ($self->_removeBlockDeviceTagFromExport($target)) { - # no more tags, we can remove the image: - if (slxsystem("rm $target")) { - vlog(0, _tr("unable to remove export '%s'!", $target)); - return 0; - } - } - return 1; + my $self = shift; + + my $target = $self->{'export-path'}; + if ($self->_removeBlockDeviceTagFromExport($target)) { + # no more tags, we can remove the image: + if (slxsystem("rm $target")) { + vlog(0, _tr("unable to remove export '%s'!", $target)); + return 0; + } + } + return 1; } sub checkRequirements { - my $self = shift; - my $vendorOSPath = shift; - - # determine most appropriate kernel version ... - my $kernelVer = $self->_pickKernelVersion($vendorOSPath); - - # ... and check if that kernel-version provides all the required modules - my @blockModNames = $self->{'block-device'}->requiredBlockDeviceModules(); - foreach my $blockModName (@blockModNames) { - my $blockMod = - $self->_locateKernelModule($vendorOSPath, "$blockModName.ko", - ["$vendorOSPath/lib/modules/$kernelVer/kernel/drivers/block"]); - if (!defined $blockMod) { - warn _tr( - "unable to find blockdevice-module '%s' for kernel version '%s'.", - $blockModName, $kernelVer - ); - return; - } - } - my $squashfsMod = $self->_locateKernelModule( - $vendorOSPath, - 'squashfs.ko', - [ - "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/squashfs", - "$vendorOSPath/lib/modules/$kernelVer/kernel/fs" - ] - ); - if (!defined $squashfsMod) { - warn _tr("unable to find squashfs-module for kernel version '%s'.", - $kernelVer); - return; - } - return 1; + my $self = shift; + my $vendorOSPath = shift; + + # determine most appropriate kernel version ... + my $kernelVer = $self->_pickKernelVersion($vendorOSPath); + + # ... and check if that kernel-version provides all the required modules + my @blockModNames = $self->{'block-device'}->requiredBlockDeviceModules(); + foreach my $blockModName (@blockModNames) { + my $blockMod = + $self->_locateKernelModule($vendorOSPath, "$blockModName.ko", + ["$vendorOSPath/lib/modules/$kernelVer/kernel/drivers/block"]); + if (!defined $blockMod) { + warn _tr( + "unable to find blockdevice-module '%s' for kernel version '%s'.", + $blockModName, $kernelVer + ); + return; + } + } + my $squashfsMod = $self->_locateKernelModule( + $vendorOSPath, + 'squashfs.ko', + [ + "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/squashfs", + "$vendorOSPath/lib/modules/$kernelVer/kernel/fs" + ] + ); + if (!defined $squashfsMod) { + warn _tr("unable to find squashfs-module for kernel version '%s'.", + $kernelVer); + return; + } + return 1; } sub addExportToConfigDB { - my $self = shift; - my $export = shift; - my $openslxDB = shift; + my $self = shift; + my $export = shift; + my $openslxDB = shift; - $export->{port} = $self->{'block-device'}->getExportPort($openslxDB); + $export->{port} = $self->{'block-device'}->getExportPort($openslxDB); - my $res = $openslxDB->addExport($export); - return $res; + my $res = $openslxDB->addExport($export); + return $res; } sub generateExportURI { - my $self = shift; - my $export = shift; - my $vendorOS = shift; + my $self = shift; + my $export = shift; + my $vendorOS = shift; - my $URI = $self->{'block-device'}->generateExportURI($export); - $URI .= '/squashfs'; - return $URI; + my $URI = $self->{'block-device'}->generateExportURI($export); + $URI .= '/squashfs'; + return $URI; } sub requiredFSMods { - my $self = shift; + my $self = shift; - my @mods = $self->{'block-device'}->requiredBlockDeviceModules(); - push @mods, 'squashfs '; - return @mods; + my @mods = $self->{'block-device'}->requiredBlockDeviceModules(); + push @mods, 'squashfs '; + return @mods; } sub requiredFSTools { - my $self = shift; + my $self = shift; - return $self->{'block-device'}->requiredBlockDeviceTools(); + return $self->{'block-device'}->requiredBlockDeviceTools(); } sub showExportConfigInfo { - my $self = shift; - my $export = shift; + my $self = shift; + my $export = shift; - $self->{'block-device'}->showExportConfigInfo($export); - return; + $self->{'block-device'}->showExportConfigInfo($export); + return; } ################################################################################ @@ -185,122 +185,122 @@ sub showExportConfigInfo sub _createSquashFS { - my $self = shift; - my $source = shift; - my $target = shift; - my $includeExcludeList = shift; - - system("rm -f $target"); - # mksquasfs isn't significantly faster if fs already exists, but it - # causes the filesystem to grow somewhat, so we remove it in order to - # get the smallest FS-file possible. - - my $baseDir = dirname($target); - if (!-e $baseDir) { - if (system("mkdir -p $baseDir")) { - die _tr("unable to create directory '%s', giving up! (%s)\n", - $baseDir, $!); - } - } - - # dump filter to a file ... - my $filterFile = "/tmp/slx-nbdsquash-filter-$$"; - spitFile($filterFile, $includeExcludeList); - - # ... invoke mksquashfs ... - vlog(0, _tr("invoking mksquashfs...")); - my $mksquashfsBinary = - "$openslxConfig{'base-path'}/share/squashfs/mksquashfs"; - my $res = system("$mksquashfsBinary $source $target -ff $filterFile"); - unlink($filterFile); - # ... remove filter file if done - if ($res) { - die _tr( - "unable to create squashfs for source '%s' as target '%s', giving up! (%s)", - $source, $target, $!); - } + my $self = shift; + my $source = shift; + my $target = shift; + my $includeExcludeList = shift; + + system("rm -f $target"); + # mksquasfs isn't significantly faster if fs already exists, but it + # causes the filesystem to grow somewhat, so we remove it in order to + # get the smallest FS-file possible. + + my $baseDir = dirname($target); + if (!-e $baseDir) { + if (system("mkdir -p $baseDir")) { + die _tr("unable to create directory '%s', giving up! (%s)\n", + $baseDir, $!); + } + } + + # dump filter to a file ... + my $filterFile = "/tmp/slx-nbdsquash-filter-$$"; + spitFile($filterFile, $includeExcludeList); + + # ... invoke mksquashfs ... + vlog(0, _tr("invoking mksquashfs...")); + my $mksquashfsBinary = + "$openslxConfig{'base-path'}/share/squashfs/mksquashfs"; + my $res = system("$mksquashfsBinary $source $target -ff $filterFile"); + unlink($filterFile); + # ... remove filter file if done + if ($res) { + die _tr( + "unable to create squashfs for source '%s' as target '%s', giving up! (%s)", + $source, $target, $!); + } } sub _determineIncludeExcludeList { - my $self = shift; - - # Rsync uses a first match strategy, so we mix the local specifications - # in front of the filterset given by the package (as the local filters - # should always overrule the vendor filters): - my $distroName = $self->{engine}->{'distro-name'}; - my $localFilterFile = - "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter"; - my $includeExcludeList - = slurpFile($localFilterFile, { failIfMissing => 0 }); - $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'}; - $includeExcludeList =~ s[^\s+][]igms; - # remove any leading whitespace, as rsync doesn't like it - return $includeExcludeList; + my $self = shift; + + # Rsync uses a first match strategy, so we mix the local specifications + # in front of the filterset given by the package (as the local filters + # should always overrule the vendor filters): + my $distroName = $self->{engine}->{'distro-name'}; + my $localFilterFile = + "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter"; + my $includeExcludeList + = slurpFile($localFilterFile, { failIfMissing => 0 }); + $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'}; + $includeExcludeList =~ s[^\s+][]igms; + # remove any leading whitespace, as rsync doesn't like it + return $includeExcludeList; } sub _mapRsyncFilter2Regex { - my $self = shift; - my $sourcePath = shift; - my $rsyncFilter = shift; - - return join( - "\n", - map { - if ($_ =~ m[^([-+]\s*)(.+?)\s*$]) - { - my $action = $1; - my $regex = $2; - $regex =~ s[\*\*][.+]g; - # '**' matches everything - $regex =~ s[\*][[^/]+]g; - # '*' matches anything except slashes - $regex =~ s[\?][[^/]?]g; - # '*' matches any single char except slash - $regex =~ s[\?][[^/]?]g; - # '*' matches any single char except slash - $regex =~ s[\.][\\.]g; - # escape any dots - if (substr($regex, 0, 1) eq '/') { - # absolute path given, need to extend by source-path: - "$action^$sourcePath$regex\$"; - } else { - # filename pattern given, need to anchor to the end only: - "$action$regex\$"; - } - } else { - $_; - } - } - split "\n", - $rsyncFilter - ); + my $self = shift; + my $sourcePath = shift; + my $rsyncFilter = shift; + + return join( + "\n", + map { + if ($_ =~ m[^([-+]\s*)(.+?)\s*$]) + { + my $action = $1; + my $regex = $2; + $regex =~ s[\*\*][.+]g; + # '**' matches everything + $regex =~ s[\*][[^/]+]g; + # '*' matches anything except slashes + $regex =~ s[\?][[^/]?]g; + # '*' matches any single char except slash + $regex =~ s[\?][[^/]?]g; + # '*' matches any single char except slash + $regex =~ s[\.][\\.]g; + # escape any dots + if (substr($regex, 0, 1) eq '/') { + # absolute path given, need to extend by source-path: + "$action^$sourcePath$regex\$"; + } else { + # filename pattern given, need to anchor to the end only: + "$action$regex\$"; + } + } else { + $_; + } + } + split "\n", + $rsyncFilter + ); } sub _addBlockDeviceTagToExport { - my $self = shift; - my $target = shift; + my $self = shift; + my $target = shift; - my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name}); - linkFile(basename($target), $tagName); - return; + my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name}); + linkFile(basename($target), $tagName); + return; } sub _removeBlockDeviceTagFromExport { - my $self = shift; - my $target = shift; - - my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name}); - slxsystem("rm $tagName"); - # now find out whether or not there are any other tags left: - my $vendorOSName = basename($target); - opendir(DIR, dirname($target)); - my @tags = grep { /^$vendorOSName\@/ } readdir(DIR); - return @tags ? 0 : 1; - # return 1 if no more tags (i.e. it is safe to remove the image) + my $self = shift; + my $target = shift; + + my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name}); + slxsystem("rm $tagName"); + # now find out whether or not there are any other tags left: + my $vendorOSName = basename($target); + opendir(DIR, dirname($target)); + my @tags = grep { /^$vendorOSName\@/ } readdir(DIR); + return @tags ? 0 : 1; + # return 1 if no more tags (i.e. it is safe to remove the image) } 1; diff --git a/installer/OpenSLX/OSSetup/Distro/Any_Clone.pm b/installer/OpenSLX/OSSetup/Distro/Any_Clone.pm index 9f3f54cc..005c0355 100644 --- a/installer/OpenSLX/OSSetup/Distro/Any_Clone.pm +++ b/installer/OpenSLX/OSSetup/Distro/Any_Clone.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Any_Clone.pm -# - provides generic clone-only overrides of the OpenSLX OSSetup API. +# - provides generic clone-only overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Any_Clone; @@ -23,9 +23,9 @@ use base qw(OpenSLX::OSSetup::Distro::Base); ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Distro/Base.pm b/installer/OpenSLX/OSSetup/Distro/Base.pm index 64d8d43b..d2931046 100644 --- a/installer/OpenSLX/OSSetup/Distro/Base.pm +++ b/installer/OpenSLX/OSSetup/Distro/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSSetup API. +# - provides empty base of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use Fcntl qw(:DEFAULT :flock); use File::Basename; @@ -28,88 +28,88 @@ use OpenSLX::Utils; ################################################################################ sub new { - confess "Creating OpenSLX::OSSetup::System::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSSetup::System::Base-objects directly makes no sense!"; } sub initialize { - my $self = shift; - my $engine = shift; - - $self->{'engine'} = $engine; - - if ($engine->{'distro-name'} =~ m[x86_64]) { - # be careful to only try installing 64-bit systems if actually - # running on a 64-bit host, as otherwise we are going to fail later, - # anyway: - my $arch = `uname -m`; - if ($?) { - die _tr("unable to determine architecture of host system (%s)\n", $!); - } - if ($arch !~ m[x86_64]) { - die _tr("you can't install a 64-bit system on a 32-bit host, sorry!\n"); - } - } - - $self->{'stage1a-binaries'} = { - "$openslxConfig{'base-path'}/share/busybox/busybox" => 'bin', - }; - - $self->{'stage1b-faked-files'} = [ - '/etc/mtab', - ]; - - $self->{'stage1c-faked-files'} = [ - ]; - - $self->{'clone-filter'} = " - - /var/tmp/* - - /var/opt/openslx - - /var/lib/vmware - + /var - - /usr/lib/vmware/modules/* - + /usr - - /tmp/* - + /tmp - - /sys/* - + /sys - + /sbin - - /root/* - + /root - - /proc/* - + /proc - - /opt/openslx - + /opt - - /media/* - + /media - - /mnt/* - + /mnt - + /lib64 - + /lib - - /home/* - + /home - - /etc/vmware/installer.sh - - /etc/shadow* - - /etc/samba/secrets.tdb - - /etc/resolv.conf.* - - /etc/opt/openslx - - /etc/exports* - - /etc/dxs - + /etc - - /dev/* - + /dev - + /boot - + /bin - - /* - - .svn - - .*.cmd - - *~ - - *lost+found* - - *.old - - *.bak - "; - - return; + my $self = shift; + my $engine = shift; + + $self->{'engine'} = $engine; + + if ($engine->{'distro-name'} =~ m[x86_64]) { + # be careful to only try installing 64-bit systems if actually + # running on a 64-bit host, as otherwise we are going to fail later, + # anyway: + my $arch = `uname -m`; + if ($?) { + die _tr("unable to determine architecture of host system (%s)\n", $!); + } + if ($arch !~ m[x86_64]) { + die _tr("you can't install a 64-bit system on a 32-bit host, sorry!\n"); + } + } + + $self->{'stage1a-binaries'} = { + "$openslxConfig{'base-path'}/share/busybox/busybox" => 'bin', + }; + + $self->{'stage1b-faked-files'} = [ + '/etc/mtab', + ]; + + $self->{'stage1c-faked-files'} = [ + ]; + + $self->{'clone-filter'} = " + - /var/tmp/* + - /var/opt/openslx + - /var/lib/vmware + + /var + - /usr/lib/vmware/modules/* + + /usr + - /tmp/* + + /tmp + - /sys/* + + /sys + + /sbin + - /root/* + + /root + - /proc/* + + /proc + - /opt/openslx + + /opt + - /media/* + + /media + - /mnt/* + + /mnt + + /lib64 + + /lib + - /home/* + + /home + - /etc/vmware/installer.sh + - /etc/shadow* + - /etc/samba/secrets.tdb + - /etc/resolv.conf.* + - /etc/opt/openslx + - /etc/exports* + - /etc/dxs + + /etc + - /dev/* + + /dev + + /boot + + /bin + - /* + - .svn + - .*.cmd + - *~ + - *lost+found* + - *.old + - *.bak + "; + + return; } sub fixPrerequiredFiles @@ -118,118 +118,118 @@ sub fixPrerequiredFiles sub startSession { - my $self = shift; - my $osDir = shift; - - # ensure that the session will be finished even if the script crashes: - addCleanupFunction( - "slxos-setup::distro::chroot", sub { $self->finishSession(); } - ); - - # make sure there's a /dev/zero, /dev/null and /dev/urandom + my $self = shift; + my $osDir = shift; + + # ensure that the session will be finished even if the script crashes: + addCleanupFunction( + "slxos-setup::distro::chroot", sub { $self->finishSession(); } + ); + + # make sure there's a /dev/zero, /dev/null and /dev/urandom # /dev/urandom for passwd chroot - if (!-e "$osDir/dev" && !mkdir("$osDir/dev")) { - die _tr("unable to create folder '%s' (%s)\n", "$osDir/dev", $!); - } - if (!-e "$osDir/dev/zero" && slxsystem("mknod $osDir/dev/zero c 1 5")) { - die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/zero", $!); - } - if (!-e "$osDir/dev/null" && slxsystem("mknod $osDir/dev/null c 1 3")) { - die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/null", $!); - } - if (!-e "$osDir/dev/urandom" && slxsystem("mknod $osDir/dev/urandom c 1 9")) { - die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/urandom", $!); + if (!-e "$osDir/dev" && !mkdir("$osDir/dev")) { + die _tr("unable to create folder '%s' (%s)\n", "$osDir/dev", $!); + } + if (!-e "$osDir/dev/zero" && slxsystem("mknod $osDir/dev/zero c 1 5")) { + die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/zero", $!); + } + if (!-e "$osDir/dev/null" && slxsystem("mknod $osDir/dev/null c 1 3")) { + die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/null", $!); + } + if (!-e "$osDir/dev/urandom" && slxsystem("mknod $osDir/dev/urandom c 1 9")) { + die _tr("unable to create node '%s' (%s)\n", "$osDir/dev/urandom", $!); } - # fake proc, depending on what is needed ... - if (!-e "$osDir/proc" && !mkdir("$osDir/proc")) { - die _tr("unable to create folder '%s' (%s)\n", "$osDir/proc", $!); - } - if (!-e "$osDir/proc/cpuinfo" && slxsystem("cp /proc/cpuinfo $osDir/proc/")) { - die _tr("unable to copy file '%s' (%s)\n", "/proc/cpuinfo", $!); - } - # TODO: alternatively, we could mount proc, but that causes problems - # when we are not able to umount it properly (which may happen - # if 'umount' is not available in the chroot!) - # - # mount /proc -# if (!-e "$osDir/proc") { -# slxsystem("mkdir -p $osDir/proc"); -# } -# if (slxsystem("mount -t proc proc $osDir/proc 2>/dev/null")) { -# die _tr("unable to mount '%s' (%s)\n", "$osDir/proc", $!); -# } - - # enter chroot jail - chrootInto($osDir); - $ENV{PATH} = join(':', @{$self->getDefaultPathList()}); - - return; + # fake proc, depending on what is needed ... + if (!-e "$osDir/proc" && !mkdir("$osDir/proc")) { + die _tr("unable to create folder '%s' (%s)\n", "$osDir/proc", $!); + } + if (!-e "$osDir/proc/cpuinfo" && slxsystem("cp /proc/cpuinfo $osDir/proc/")) { + die _tr("unable to copy file '%s' (%s)\n", "/proc/cpuinfo", $!); + } + # TODO: alternatively, we could mount proc, but that causes problems + # when we are not able to umount it properly (which may happen + # if 'umount' is not available in the chroot!) + # + # mount /proc +# if (!-e "$osDir/proc") { +# slxsystem("mkdir -p $osDir/proc"); +# } +# if (slxsystem("mount -t proc proc $osDir/proc 2>/dev/null")) { +# die _tr("unable to mount '%s' (%s)\n", "$osDir/proc", $!); +# } + + # enter chroot jail + chrootInto($osDir); + $ENV{PATH} = join(':', @{$self->getDefaultPathList()}); + + return; } sub getDefaultPathList { - my $self = shift; - - return [ qw( - /sbin - /usr/sbin - /usr/local/sbin - /usr/local/bin - /usr/bin - /bin - /usr/bin/X11 - /usr/X11R6/bin - /opt/kde3/bin - /opt/gnome/bin - ) ]; + my $self = shift; + + return [ qw( + /sbin + /usr/sbin + /usr/local/sbin + /usr/local/bin + /usr/bin + /bin + /usr/bin/X11 + /usr/X11R6/bin + /opt/kde3/bin + /opt/gnome/bin + ) ]; } sub finishSession { - my $self = shift; - - removeCleanupFunction('slxos-setup::distro::chroot'); + my $self = shift; + + removeCleanupFunction('slxos-setup::distro::chroot'); - # unmount /proc -# if (slxsystem('ash', '-c', 'umount /proc 2>/dev/null')) { -# die _tr("unable to unmount '%s' (%s)\n", "/proc", $!); -# } + # unmount /proc +# if (slxsystem('ash', '-c', 'umount /proc 2>/dev/null')) { +# die _tr("unable to unmount '%s' (%s)\n", "/proc", $!); +# } - return; + return; } sub updateDistroConfig { - if (slxsystem("ldconfig")) { - die _tr("unable to run ldconfig (%s)", $!); - } + if (slxsystem("ldconfig")) { + die _tr("unable to run ldconfig (%s)", $!); + } } sub pickKernelFile { - my $self = shift; - my $kernelPath = shift; - - my $newestKernelFile; - my $newestKernelFileSortKey = ''; - foreach my $kernelFile (glob("$kernelPath/vmlinuz-*")) { - next unless $kernelFile =~ m{ - vmlinuz-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) - }x; - my $sortKey - = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); - if ($newestKernelFileSortKey lt $sortKey) { - $newestKernelFile = $kernelFile; - $newestKernelFileSortKey = $sortKey; - } - } - - if (!defined $newestKernelFile) { - die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); - } - return $newestKernelFile; + my $self = shift; + my $kernelPath = shift; + + my $newestKernelFile; + my $newestKernelFileSortKey = ''; + foreach my $kernelFile (glob("$kernelPath/vmlinuz-*")) { + next unless $kernelFile =~ m{ + vmlinuz-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) + }x; + my $sortKey + = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); + if ($newestKernelFileSortKey lt $sortKey) { + $newestKernelFile = $kernelFile; + $newestKernelFileSortKey = $sortKey; + } + } + + if (!defined $newestKernelFile) { + die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); + } + return $newestKernelFile; } sub preSystemInstallationHook @@ -242,54 +242,54 @@ sub postSystemInstallationHook sub setPasswordForUser { - my $self = shift; - my $username = shift; - my $password = shift; - - my $hashedPassword = $self->hashPassword($password); - - my $writePasswordFunction = sub { - # now read, change and write shadow-file in atomic manner: - my $shadowFile = '/etc/shadow'; - if (!-e $shadowFile) { - spitFile( $shadowFile, ''); - } - slxsystem("cp -r $shadowFile $shadowFile~"); - my $shadowFH; - open($shadowFH, '+<', $shadowFile) - or croak _tr("could not open file '%s'! (%s)", $shadowFile, $!); - flock($shadowFH, LOCK_EX) - or croak _tr("could not lock file '%s'! (%s)", $shadowFile, $!); - my $lastChanged = int(time()/24/60/60); - my $newEntry - = "$username:$hashedPassword:$lastChanged:0:99999:7:::"; - my $content = do { local $/; <$shadowFH> }; - if ($content =~ m{^$username:}ims) { - $content =~ s{^$username:.+?$}{$newEntry}ms; - } else { - $content .= "$newEntry\n"; - } - seek($shadowFH, 0, 0) - or croak _tr("could not seek file '%s'! (%s)", $shadowFile, $!); - print $shadowFH $content - or croak _tr("could not write to file '%s'! (%s)", $shadowFile, $!); - close($shadowFH) - or croak _tr("could not close file '%s'! (%s)", $shadowFile, $!); - unlink "$shadowFile~"; - }; - $self->{engine}->callChrootedFunctionForVendorOS($writePasswordFunction); + my $self = shift; + my $username = shift; + my $password = shift; + + my $hashedPassword = $self->hashPassword($password); + + my $writePasswordFunction = sub { + # now read, change and write shadow-file in atomic manner: + my $shadowFile = '/etc/shadow'; + if (!-e $shadowFile) { + spitFile( $shadowFile, ''); + } + slxsystem("cp -r $shadowFile $shadowFile~"); + my $shadowFH; + open($shadowFH, '+<', $shadowFile) + or croak _tr("could not open file '%s'! (%s)", $shadowFile, $!); + flock($shadowFH, LOCK_EX) + or croak _tr("could not lock file '%s'! (%s)", $shadowFile, $!); + my $lastChanged = int(time()/24/60/60); + my $newEntry + = "$username:$hashedPassword:$lastChanged:0:99999:7:::"; + my $content = do { local $/; <$shadowFH> }; + if ($content =~ m{^$username:}ims) { + $content =~ s{^$username:.+?$}{$newEntry}ms; + } else { + $content .= "$newEntry\n"; + } + seek($shadowFH, 0, 0) + or croak _tr("could not seek file '%s'! (%s)", $shadowFile, $!); + print $shadowFH $content + or croak _tr("could not write to file '%s'! (%s)", $shadowFile, $!); + close($shadowFH) + or croak _tr("could not close file '%s'! (%s)", $shadowFile, $!); + unlink "$shadowFile~"; + }; + $self->{engine}->callChrootedFunctionForVendorOS($writePasswordFunction); } sub hashPassword { - my $self = shift; - my $password = shift; - - my $busyboxBin = $self->{engine}->{'busybox-binary'}; - my $hashedPassword = qx{$busyboxBin cryptpw -a md5 $password}; - chomp $hashedPassword; - - return $hashedPassword; + my $self = shift; + my $password = shift; + + my $busyboxBin = $self->{engine}->{'busybox-binary'}; + my $hashedPassword = qx{$busyboxBin cryptpw -a md5 $password}; + chomp $hashedPassword; + + return $hashedPassword; } 1; diff --git a/installer/OpenSLX/OSSetup/Distro/Debian.pm b/installer/OpenSLX/OSSetup/Distro/Debian.pm index a514f10f..a9ba8281 100644 --- a/installer/OpenSLX/OSSetup/Distro/Debian.pm +++ b/installer/OpenSLX/OSSetup/Distro/Debian.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Debian.pm -# - provides Debian-specific overrides of the OpenSLX OSSetup API. +# - provides Debian-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Debian; @@ -26,91 +26,91 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->SUPER::initialize($engine); - $self->{'packager-type'} = 'dpkg'; - $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'apt'; - $self->{'stage1c-faked-files'} = []; - return; + $self->SUPER::initialize($engine); + $self->{'packager-type'} = 'dpkg'; + $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'apt'; + $self->{'stage1c-faked-files'} = []; + return; } sub preSystemInstallationHook { - my $self = shift; - - $self->SUPER::preSystemInstallationHook(); + my $self = shift; + + $self->SUPER::preSystemInstallationHook(); - # fake required /dev-entries - my %devInfo = ( - mem => { type => 'c', major => '1', minor => '1' }, - null => { type => 'c', major => '1', minor => '3' }, - zero => { type => 'c', major => '1', minor => '5' }, - random => { type => 'c', major => '1', minor => '8' }, - urandom => { type => 'c', major => '1', minor => '9' }, - kmsg => { type => 'c', major => '1', minor => '11' }, - console => { type => 'c', major => '5', minor => '1' }, - ptmx => { type => 'c', major => '5', minor => '2' }, - ); - foreach my $dev (keys %devInfo) { - my $info = $devInfo{$dev}; - if (!-e "/dev/$dev") { - if (slxsystem( - "mknod /dev/$dev $info->{type} $info->{major} $info->{minor}" - )) { - croak(_tr("unable to create dev-node '%s'! (%s)", $dev, $!)); - } - } - } - foreach my $devDir ('pts', 'shm', '.udevdb', '.udev') { - if (!-e "/dev/$devDir") { - if (slxsystem("mkdir -p /dev/$devDir")) { - croak(_tr("unable to create dev-dir '%s'! (%s)", $devDir, $!)); - } - } - } + # fake required /dev-entries + my %devInfo = ( + mem => { type => 'c', major => '1', minor => '1' }, + null => { type => 'c', major => '1', minor => '3' }, + zero => { type => 'c', major => '1', minor => '5' }, + random => { type => 'c', major => '1', minor => '8' }, + urandom => { type => 'c', major => '1', minor => '9' }, + kmsg => { type => 'c', major => '1', minor => '11' }, + console => { type => 'c', major => '5', minor => '1' }, + ptmx => { type => 'c', major => '5', minor => '2' }, + ); + foreach my $dev (keys %devInfo) { + my $info = $devInfo{$dev}; + if (!-e "/dev/$dev") { + if (slxsystem( + "mknod /dev/$dev $info->{type} $info->{major} $info->{minor}" + )) { + croak(_tr("unable to create dev-node '%s'! (%s)", $dev, $!)); + } + } + } + foreach my $devDir ('pts', 'shm', '.udevdb', '.udev') { + if (!-e "/dev/$devDir") { + if (slxsystem("mkdir -p /dev/$devDir")) { + croak(_tr("unable to create dev-dir '%s'! (%s)", $devDir, $!)); + } + } + } - # replace /usr/sbin/invoke-rc.d by a dummy, in order to avoid a whole lot - # of initscripts being started. Wishful thinking: there should be another - # way to stop Debian from doing this, as this is not really very supportive - # of folder-based installations (then again: I may simply be too stupid - # to find out how it is supposed to work ...) - rename('/usr/sbin/invoke-rc.d', '/usr/sbin/_invoke-rc.d'); - spitFile('/usr/sbin/invoke-rc.d', "#! /bin/sh\nexit 0\n"); - chmod 0755, '/usr/sbin/invoke-rc.d'; + # replace /usr/sbin/invoke-rc.d by a dummy, in order to avoid a whole lot + # of initscripts being started. Wishful thinking: there should be another + # way to stop Debian from doing this, as this is not really very supportive + # of folder-based installations (then again: I may simply be too stupid + # to find out how it is supposed to work ...) + rename('/usr/sbin/invoke-rc.d', '/usr/sbin/_invoke-rc.d'); + spitFile('/usr/sbin/invoke-rc.d', "#! /bin/sh\nexit 0\n"); + chmod 0755, '/usr/sbin/invoke-rc.d'; } sub postSystemInstallationHook { - my $self = shift; + my $self = shift; - # restore /usr/sbin/invoke-rc.d - rename('/usr/sbin/_invoke-rc.d', '/usr/sbin/invoke-rc.d'); - $self->SUPER::postSystemInstallationHook(); + # restore /usr/sbin/invoke-rc.d + rename('/usr/sbin/_invoke-rc.d', '/usr/sbin/invoke-rc.d'); + $self->SUPER::postSystemInstallationHook(); } sub setPasswordForUser { - my $self = shift; - my $username = shift; - my $password = shift; - - # activate shadow passwords - my $activateShadowFunction = sub { - slxsystem('/sbin/shadowconfig', 'on'); - }; - $self->{engine}->callChrootedFunctionForVendorOS($activateShadowFunction); - - # invoke default behaviour - $self->SUPER::setPasswordForUser($username, $password); + my $self = shift; + my $username = shift; + my $password = shift; + + # activate shadow passwords + my $activateShadowFunction = sub { + slxsystem('/sbin/shadowconfig', 'on'); + }; + $self->{engine}->callChrootedFunctionForVendorOS($activateShadowFunction); + + # invoke default behaviour + $self->SUPER::setPasswordForUser($username, $password); } - + 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Distro/Debian_3_1.pm b/installer/OpenSLX/OSSetup/Distro/Debian_3_1.pm index 87c14534..7f390bc1 100644 --- a/installer/OpenSLX/OSSetup/Distro/Debian_3_1.pm +++ b/installer/OpenSLX/OSSetup/Distro/Debian_3_1.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Debian_3_1.pm -# - provides Debian-3.1-specific overrides of the OpenSLX OSSetup API. +# - provides Debian-3.1-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Debian_3_1; @@ -26,30 +26,30 @@ use OpenSLX::Utils; ################################################################################ sub preSystemInstallationHook { - my $self = shift; - - $self->SUPER::preSystemInstallationHook(); - - # when the kernel package is being configured, it insists on trying to - # create an initrd, which neither works nor makes sense in our environment. - # - # in order to circumvent this problem, we manually install initrd-tools - # (which contains mkinitrd) ... - $self->{engine}->{'meta-packager'}->installPackages('initrd-tools'); - # ... and replace /usr/sbin/mkinitrd with a dummy, in order to skip the - # initrd-creation. - rename('/usr/sbin/mkinitrd', '/usr/sbin/_mkinitrd'); - spitFile('/usr/sbin/mkinitrd', "#! /bin/sh\ntouch \$2\n"); - chmod 0755, '/usr/sbin/mkinitrd'; + my $self = shift; + + $self->SUPER::preSystemInstallationHook(); + + # when the kernel package is being configured, it insists on trying to + # create an initrd, which neither works nor makes sense in our environment. + # + # in order to circumvent this problem, we manually install initrd-tools + # (which contains mkinitrd) ... + $self->{engine}->{'meta-packager'}->installPackages('initrd-tools'); + # ... and replace /usr/sbin/mkinitrd with a dummy, in order to skip the + # initrd-creation. + rename('/usr/sbin/mkinitrd', '/usr/sbin/_mkinitrd'); + spitFile('/usr/sbin/mkinitrd', "#! /bin/sh\ntouch \$2\n"); + chmod 0755, '/usr/sbin/mkinitrd'; } sub postSystemInstallationHook { - my $self = shift; + my $self = shift; - # restore /usr/sbin/mkinitrd - rename('/usr/sbin/_mkinitrd', '/usr/sbin/mkinitrd'); - $self->SUPER::postSystemInstallationHook(); + # restore /usr/sbin/mkinitrd + rename('/usr/sbin/_mkinitrd', '/usr/sbin/mkinitrd'); + $self->SUPER::postSystemInstallationHook(); } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Distro/Fedora.pm b/installer/OpenSLX/OSSetup/Distro/Fedora.pm index 7fe4973c..0bc9ebdc 100644 --- a/installer/OpenSLX/OSSetup/Distro/Fedora.pm +++ b/installer/OpenSLX/OSSetup/Distro/Fedora.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Fedora.pm -# - provides Fedora-specific overrides of the OpenSLX OSSetup API. +# - provides Fedora-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Fedora; @@ -25,24 +25,24 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->SUPER::initialize($engine); - $self->{'packager-type'} = 'rpm'; - $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'yum'; - $self->{'stage1c-faked-files'} = [ - '/etc/fstab', - '/etc/mtab', - ]; - return; + $self->SUPER::initialize($engine); + $self->{'packager-type'} = 'rpm'; + $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'yum'; + $self->{'stage1c-faked-files'} = [ + '/etc/fstab', + '/etc/mtab', + ]; + return; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Distro/Gentoo.pm b/installer/OpenSLX/OSSetup/Distro/Gentoo.pm index 4d1032f7..c49ba5d6 100644 --- a/installer/OpenSLX/OSSetup/Distro/Gentoo.pm +++ b/installer/OpenSLX/OSSetup/Distro/Gentoo.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SUSE.pm -# - provides SUSE-specific overrides of the OpenSLX OSSetup API. +# - provides SUSE-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Gentoo; @@ -25,34 +25,34 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub pickKernelFile { - my $self = shift; - my $kernelPath = shift; - - my $newestKernelFile; - my $newestKernelFileSortKey = ''; - foreach my $kernelFile (glob("$kernelPath/kernel-genkernel-x86-*")) { - next unless $kernelFile =~ m{ - x86-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) - }x; - my $sortKey - = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); - if ($newestKernelFileSortKey lt $sortKey) { - $newestKernelFile = $kernelFile; - $newestKernelFileSortKey = $sortKey; - } - } - - if (!defined $newestKernelFile) { - die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); - } - return $newestKernelFile; + my $self = shift; + my $kernelPath = shift; + + my $newestKernelFile; + my $newestKernelFileSortKey = ''; + foreach my $kernelFile (glob("$kernelPath/kernel-genkernel-x86-*")) { + next unless $kernelFile =~ m{ + x86-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) + }x; + my $sortKey + = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); + if ($newestKernelFileSortKey lt $sortKey) { + $newestKernelFile = $kernelFile; + $newestKernelFileSortKey = $sortKey; + } + } + + if (!defined $newestKernelFile) { + die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); + } + return $newestKernelFile; } 1; diff --git a/installer/OpenSLX/OSSetup/Distro/SUSE.pm b/installer/OpenSLX/OSSetup/Distro/SUSE.pm index c6d81747..192ea3aa 100644 --- a/installer/OpenSLX/OSSetup/Distro/SUSE.pm +++ b/installer/OpenSLX/OSSetup/Distro/SUSE.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SUSE.pm -# - provides SUSE-specific overrides of the OpenSLX OSSetup API. +# - provides SUSE-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::SUSE; @@ -25,61 +25,61 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->SUPER::initialize($engine); - $self->{'packager-type'} = 'rpm'; - $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'smart'; + $self->SUPER::initialize($engine); + $self->{'packager-type'} = 'rpm'; + $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'smart'; - if ($engine->{'action-type'} eq 'install') { - # Inform SUSE RPMs that we're performing an installation - this is - # only important for installations taking place in stage 1c: - $ENV{YAST_IS_RUNNING} = "instsys"; - } + if ($engine->{'action-type'} eq 'install') { + # Inform SUSE RPMs that we're performing an installation - this is + # only important for installations taking place in stage 1c: + $ENV{YAST_IS_RUNNING} = "instsys"; + } - return; + return; } sub fixPrerequiredFiles { - my $self = shift; - my $stage1cDir = shift; + my $self = shift; + my $stage1cDir = shift; - chown(0, 0, "$stage1cDir/etc/group", "$stage1cDir/etc/passwd", - "$stage1cDir/etc/shadow"); - return; + chown(0, 0, "$stage1cDir/etc/group", "$stage1cDir/etc/passwd", + "$stage1cDir/etc/shadow"); + return; } sub updateDistroConfig { - my $self = shift; + my $self = shift; - # invoke SuSEconfig in order to allow it to update the configuration: - if (slxsystem('SuSEconfig')) { - die _tr("unable to run SuSEconfig (%s)", $!); - } - $self->SUPER::updateDistroConfig(); - return; + # invoke SuSEconfig in order to allow it to update the configuration: + if (slxsystem('SuSEconfig')) { + die _tr("unable to run SuSEconfig (%s)", $!); + } + $self->SUPER::updateDistroConfig(); + return; } sub hashPassword { - my $self = shift; - my $password = shift; - - my $busyboxBin = $self->{engine}->{'busybox-binary'}; - my $hashedPassword = qx{$busyboxBin cryptpw -a blowfish '$password'}; - chomp $hashedPassword; + my $self = shift; + my $password = shift; + + my $busyboxBin = $self->{engine}->{'busybox-binary'}; + my $hashedPassword = qx{$busyboxBin cryptpw -a blowfish '$password'}; + chomp $hashedPassword; - return $hashedPassword; + return $hashedPassword; } 1; diff --git a/installer/OpenSLX/OSSetup/Distro/Ubuntu.pm b/installer/OpenSLX/OSSetup/Distro/Ubuntu.pm index 4ab5abbc..5e7e41ea 100644 --- a/installer/OpenSLX/OSSetup/Distro/Ubuntu.pm +++ b/installer/OpenSLX/OSSetup/Distro/Ubuntu.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Ubuntu.pm -# - provides Ubuntu-specific overrides of the OpenSLX OSSetup API. +# - provides Ubuntu-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Ubuntu; @@ -26,75 +26,75 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->SUPER::initialize($engine); - $self->{'packager-type'} = 'dpkg'; - $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'apt'; - $self->{'stage1c-faked-files'} = []; - return; + $self->SUPER::initialize($engine); + $self->{'packager-type'} = 'dpkg'; + $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'apt'; + $self->{'stage1c-faked-files'} = []; + return; } sub preSystemInstallationHook { - my $self = shift; - - $self->SUPER::preSystemInstallationHook(); + my $self = shift; + + $self->SUPER::preSystemInstallationHook(); - # fake required /dev-entries - my %devInfo = ( - mem => { type => 'c', major => '1', minor => '1' }, - null => { type => 'c', major => '1', minor => '3' }, - zero => { type => 'c', major => '1', minor => '5' }, - random => { type => 'c', major => '1', minor => '8' }, - urandom => { type => 'c', major => '1', minor => '9' }, - kmsg => { type => 'c', major => '1', minor => '11' }, - console => { type => 'c', major => '5', minor => '1' }, - ptmx => { type => 'c', major => '5', minor => '2' }, - ); - foreach my $dev (keys %devInfo) { - my $info = $devInfo{$dev}; - if (!-e "/dev/$dev") { - if (slxsystem( - "mknod /dev/$dev $info->{type} $info->{major} $info->{minor}" - )) { - croak(_tr("unable to create dev-node '%s'! (%s)", $dev, $!)); - } - } - } - foreach my $devDir ('pts', 'shm', '.udevdb', '.udev') { - if (!-e "/dev/$devDir") { - if (slxsystem("mkdir -p /dev/$devDir")) { - croak(_tr("unable to create dev-dir '%s'! (%s)", $devDir, $!)); - } - } - } + # fake required /dev-entries + my %devInfo = ( + mem => { type => 'c', major => '1', minor => '1' }, + null => { type => 'c', major => '1', minor => '3' }, + zero => { type => 'c', major => '1', minor => '5' }, + random => { type => 'c', major => '1', minor => '8' }, + urandom => { type => 'c', major => '1', minor => '9' }, + kmsg => { type => 'c', major => '1', minor => '11' }, + console => { type => 'c', major => '5', minor => '1' }, + ptmx => { type => 'c', major => '5', minor => '2' }, + ); + foreach my $dev (keys %devInfo) { + my $info = $devInfo{$dev}; + if (!-e "/dev/$dev") { + if (slxsystem( + "mknod /dev/$dev $info->{type} $info->{major} $info->{minor}" + )) { + croak(_tr("unable to create dev-node '%s'! (%s)", $dev, $!)); + } + } + } + foreach my $devDir ('pts', 'shm', '.udevdb', '.udev') { + if (!-e "/dev/$devDir") { + if (slxsystem("mkdir -p /dev/$devDir")) { + croak(_tr("unable to create dev-dir '%s'! (%s)", $devDir, $!)); + } + } + } - # replace /usr/sbin/invoke-rc.d by a dummy, in order to avoid a whole lot - # of initscripts being started. Wishful thinking: there should be another - # way to stop Ubuntu from doing this, as this is not really very supportive - # of folder-based installations (then again: I may simply be too stupid - # to find out how it is supposed to work ...) - rename('/usr/sbin/invoke-rc.d', '/usr/sbin/_invoke-rc.d'); - spitFile('/usr/sbin/invoke-rc.d', "#! /bin/sh\nexit 0\n"); - chmod 0755, '/usr/sbin/invoke-rc.d'; + # replace /usr/sbin/invoke-rc.d by a dummy, in order to avoid a whole lot + # of initscripts being started. Wishful thinking: there should be another + # way to stop Ubuntu from doing this, as this is not really very supportive + # of folder-based installations (then again: I may simply be too stupid + # to find out how it is supposed to work ...) + rename('/usr/sbin/invoke-rc.d', '/usr/sbin/_invoke-rc.d'); + spitFile('/usr/sbin/invoke-rc.d', "#! /bin/sh\nexit 0\n"); + chmod 0755, '/usr/sbin/invoke-rc.d'; } sub postSystemInstallationHook { - my $self = shift; + my $self = shift; - # restore /usr/sbin/invoke-rc.d - rename('/usr/sbin/_invoke-rc.d', '/usr/sbin/invoke-rc.d'); - $self->SUPER::postSystemInstallationHook(); + # restore /usr/sbin/invoke-rc.d + rename('/usr/sbin/_invoke-rc.d', '/usr/sbin/invoke-rc.d'); + $self->SUPER::postSystemInstallationHook(); } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Engine.pm b/installer/OpenSLX/OSSetup/Engine.pm index 59057336..9030beaa 100644 --- a/installer/OpenSLX/OSSetup/Engine.pm +++ b/installer/OpenSLX/OSSetup/Engine.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Engine.pm -# - provides driver engine for the OSSetup API. +# - provides driver engine for the OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Engine; @@ -23,7 +23,7 @@ use Exporter; @ISA = qw(Exporter); @EXPORT = qw( - %supportedDistros + %supportedDistros ); use Config::General; @@ -36,84 +36,84 @@ use OpenSLX::Utils; use vars qw(%supportedDistros); %supportedDistros = ( - 'debian-3.1' => { - module => 'Debian_3_1', support => 'clone,install' - }, - 'debian-4.0' => { - module => 'Debian', support => 'clone,install' - }, - 'debian-4.0_amd64' => { - module => 'Debian', support => 'clone,install' - }, - 'fedora-6' => { - module => 'Fedora', support => 'clone,install' - }, - 'fedora-6_x86_64' => { - module => 'Fedora', support => 'clone,install' - }, - 'gentoo-2006.X' => { - module => 'Gentoo', support => 'clone' - }, - 'gentoo-2007.X' => { - module => 'Gentoo', support => 'clone' - }, - 'mandriva-2007.0' => { - module => 'Mandriva_2007_0', support => 'clone' - }, - 'suse-9.3' => { - module => 'SUSE', support => 'clone' - }, - 'suse-10.0' => { - module => 'SUSE', support => 'clone' - }, - 'suse-10.0_x86_64' => { - module => 'SUSE', support => 'clone' - }, - 'suse-10.1' => { - module => 'SUSE', support => 'clone,install' - }, - 'suse-10.1_x86_64' => { - module => 'SUSE', support => 'clone,install' - }, - 'suse-10.2' => { - module => 'SUSE', support => 'clone,install' - }, - 'suse-10.2_x86_64' => { - module => 'SUSE', support => 'clone,install' - }, - 'suse-10.3' => { - module => 'SUSE', support => 'clone' - }, - 'suse-10.3_x86_64' => { - module => 'SUSE', support => 'clone' - }, - 'ubuntu-6.06' => { - module => 'Ubuntu', support => 'clone' - }, - 'ubuntu-6.10' => { - module => 'Ubuntu', support => 'clone,install' - }, - 'ubuntu-6.10_amd64' => { - module => 'Ubuntu', support => 'clone,install' - }, - 'ubuntu-7.04' => { - module => 'Ubuntu', support => 'clone,install' - }, - 'ubuntu-7.04_amd64' => { - module => 'Ubuntu', support => 'clone,install' - }, - 'ubuntu-7.10' => { - module => 'Ubuntu', support => 'clone' - }, - 'ubuntu-7.10_amd64' => { - module => 'Ubuntu', support => 'clone' - }, - 'ubuntu-8.04' => { - module => 'Ubuntu', support => 'clone' - }, - 'ubuntu-8.04_amd64' => { - module => 'Ubuntu', support => 'clone' - }, + 'debian-3.1' => { + module => 'Debian_3_1', support => 'clone,install' + }, + 'debian-4.0' => { + module => 'Debian', support => 'clone,install' + }, + 'debian-4.0_amd64' => { + module => 'Debian', support => 'clone,install' + }, + 'fedora-6' => { + module => 'Fedora', support => 'clone,install' + }, + 'fedora-6_x86_64' => { + module => 'Fedora', support => 'clone,install' + }, + 'gentoo-2006.X' => { + module => 'Gentoo', support => 'clone' + }, + 'gentoo-2007.X' => { + module => 'Gentoo', support => 'clone' + }, + 'mandriva-2007.0' => { + module => 'Mandriva_2007_0', support => 'clone' + }, + 'suse-9.3' => { + module => 'SUSE', support => 'clone' + }, + 'suse-10.0' => { + module => 'SUSE', support => 'clone' + }, + 'suse-10.0_x86_64' => { + module => 'SUSE', support => 'clone' + }, + 'suse-10.1' => { + module => 'SUSE', support => 'clone,install' + }, + 'suse-10.1_x86_64' => { + module => 'SUSE', support => 'clone,install' + }, + 'suse-10.2' => { + module => 'SUSE', support => 'clone,install' + }, + 'suse-10.2_x86_64' => { + module => 'SUSE', support => 'clone,install' + }, + 'suse-10.3' => { + module => 'SUSE', support => 'clone' + }, + 'suse-10.3_x86_64' => { + module => 'SUSE', support => 'clone' + }, + 'ubuntu-6.06' => { + module => 'Ubuntu', support => 'clone' + }, + 'ubuntu-6.10' => { + module => 'Ubuntu', support => 'clone,install' + }, + 'ubuntu-6.10_amd64' => { + module => 'Ubuntu', support => 'clone,install' + }, + 'ubuntu-7.04' => { + module => 'Ubuntu', support => 'clone,install' + }, + 'ubuntu-7.04_amd64' => { + module => 'Ubuntu', support => 'clone,install' + }, + 'ubuntu-7.10' => { + module => 'Ubuntu', support => 'clone' + }, + 'ubuntu-7.10_amd64' => { + module => 'Ubuntu', support => 'clone' + }, + 'ubuntu-8.04' => { + module => 'Ubuntu', support => 'clone' + }, + 'ubuntu-8.04_amd64' => { + module => 'Ubuntu', support => 'clone' + }, ); our $localHttpServerMasterPID; @@ -124,594 +124,594 @@ our %localHttpServers; ################################################################################ sub new { - my $class = shift; + my $class = shift; - my $self = {}; + my $self = {}; - return bless $self, $class; + return bless $self, $class; } sub DESTROY { - my $self = shift; - - my $httpServerPID = $localHttpServerMasterPID || '0'; - if ($httpServerPID == $$) { - # we are the master process, so we clean up all the servers that we - # have started: - while (my ($localURL, $serverInfo) = each %localHttpServers) { - vlog(1, _tr("stopping local HTTP-server for URL '%s'.", $localURL)); - kill TERM => $serverInfo->{pid}; - } - } - return; + my $self = shift; + + my $httpServerPID = $localHttpServerMasterPID || '0'; + if ($httpServerPID == $$) { + # we are the master process, so we clean up all the servers that we + # have started: + while (my ($localURL, $serverInfo) = each %localHttpServers) { + vlog(1, _tr("stopping local HTTP-server for URL '%s'.", $localURL)); + kill TERM => $serverInfo->{pid}; + } + } + return; } sub initialize { - my $self = shift; - my $vendorOSName = shift; - my $actionType = shift; - - if ($vendorOSName eq '<<>>') { - die _tr("you can't do that with the default vendor-OS!\n"); - } - if ($vendorOSName !~ m[^([^\-]+\-[^\-]+)(?:\-(.+))?]) { - die _tr( - "Given vendor-OS has unknown format, expected '-[-]'\n" - ); - } - my $distroName = $1; - my $selectionName = $2 || 'default'; - $self->{'vendor-os-name'} = $vendorOSName; - $self->{'action-type'} = $actionType; - $self->{'distro-name'} = lc($distroName); - $self->{'selection-name'} = $selectionName; - $self->{'clone-source'} = ''; - if (!exists $supportedDistros{lc($distroName)}) { - print _tr("Sorry, distro '%s' is unsupported.\n", $distroName); - print _tr("List of supported distros:\n\t"); - print join("\n\t", sort keys %supportedDistros) . "\n"; - exit 1; - } - my $support = $supportedDistros{lc($distroName)}->{support}; - if ($support !~ m[install]i) { - if ($actionType eq 'install') { - print _tr( - "Sorry, distro '%s' can not be installed, only cloned!\n", - $distroName - ); - exit 1; - } - elsif ($actionType eq 'update') { - print _tr( - "Sorry, vendor-OS '%s' has been cloned, don't know how to update it!\n", - $distroName - ); - exit 1; - } - elsif ($actionType eq 'shell') { - print _tr( - "Sorry, vendor-OS '%s' has been cloned, no support for chrooted shell available!\n", - $distroName - ); - exit 1; - } - } - - # load module for the requested distro: - my $distro; - my $distroClass = $supportedDistros{lc($distroName)}->{module}; - if ($actionType =~ m{^(install|update|shell)}) { - $distro = instantiateClass("OpenSLX::OSSetup::Distro::$distroClass"); - } - else { - if (!eval { - $distro = instantiateClass("OpenSLX::OSSetup::Distro::$distroClass") - }) { - vlog(2, "could not load distro module '$distroClass' ($@) ..."); - vlog(2, "falling back to module 'Any_Clone'"); - # allow fallback to generic clone module, such that we can clone - # distro's for which there is no specific distro-module yet - # (like for example for Gentoo): - $distro = instantiateClass("OpenSLX::OSSetup::Distro::Any_Clone") - } - } - - $distro->initialize($self); - $self->{distro} = $distro; - - if ($actionType =~ m{^(install|update|shell|plugin)}) { - # setup path to distribution-specific info: - my $sharedDistroInfoDir - = "$openslxConfig{'base-path'}/share/distro-info/$self->{'distro-name'}"; - if (!-d $sharedDistroInfoDir) { - die _tr( - "unable to find shared distro-info in '%s'\n", - $sharedDistroInfoDir - ); - } - $self->{'shared-distro-info-dir'} = $sharedDistroInfoDir; - my $configDistroInfoDir = - "$openslxConfig{'config-path'}/distro-info/$self->{'distro-name'}"; - if (!-d $configDistroInfoDir) { - die _tr( - "unable to find configurable distro-info in '%s'\n", - $configDistroInfoDir - ); - } - $self->{'config-distro-info-dir'} = $configDistroInfoDir; - - my $busyboxName = - $self->_hostIs64Bit() - ? 'busybox.x86_64' - : 'busybox.i586'; - $self->{'busybox-binary'} - = "$openslxConfig{'base-path'}/share/busybox/$busyboxName"; - - $self->_readDistroInfo(); - } - - if ($self->{'action-type'} eq 'install' - && !exists $self->{'distro-info'}->{'selection'}->{$selectionName}) - { - die( - _tr( - "selection '%s' is unknown to distro '%s'\n", - $selectionName, $self->{'distro-name'} - ) - . _tr("These selections are available:\n\t") - . join("\n\t", sort keys %{$self->{'distro-info'}->{'selection'}}) - . "\n" - ); - } - - $self->{'vendor-os-path'} - = "$openslxConfig{'private-path'}/stage1/$self->{'vendor-os-name'}"; - vlog(1, "vendor-OS path is '$self->{'vendor-os-path'}'"); - - if ($actionType =~ m{^(install|update|shell|plugin)}) { - $self->_createPackager(); - $self->_createMetaPackager(); - } - - return; + my $self = shift; + my $vendorOSName = shift; + my $actionType = shift; + + if ($vendorOSName eq '<<>>') { + die _tr("you can't do that with the default vendor-OS!\n"); + } + if ($vendorOSName !~ m[^([^\-]+\-[^\-]+)(?:\-(.+))?]) { + die _tr( + "Given vendor-OS has unknown format, expected '-[-]'\n" + ); + } + my $distroName = $1; + my $selectionName = $2 || 'default'; + $self->{'vendor-os-name'} = $vendorOSName; + $self->{'action-type'} = $actionType; + $self->{'distro-name'} = lc($distroName); + $self->{'selection-name'} = $selectionName; + $self->{'clone-source'} = ''; + if (!exists $supportedDistros{lc($distroName)}) { + print _tr("Sorry, distro '%s' is unsupported.\n", $distroName); + print _tr("List of supported distros:\n\t"); + print join("\n\t", sort keys %supportedDistros) . "\n"; + exit 1; + } + my $support = $supportedDistros{lc($distroName)}->{support}; + if ($support !~ m[install]i) { + if ($actionType eq 'install') { + print _tr( + "Sorry, distro '%s' can not be installed, only cloned!\n", + $distroName + ); + exit 1; + } + elsif ($actionType eq 'update') { + print _tr( + "Sorry, vendor-OS '%s' has been cloned, don't know how to update it!\n", + $distroName + ); + exit 1; + } + elsif ($actionType eq 'shell') { + print _tr( + "Sorry, vendor-OS '%s' has been cloned, no support for chrooted shell available!\n", + $distroName + ); + exit 1; + } + } + + # load module for the requested distro: + my $distro; + my $distroClass = $supportedDistros{lc($distroName)}->{module}; + if ($actionType =~ m{^(install|update|shell)}) { + $distro = instantiateClass("OpenSLX::OSSetup::Distro::$distroClass"); + } + else { + if (!eval { + $distro = instantiateClass("OpenSLX::OSSetup::Distro::$distroClass") + }) { + vlog(2, "could not load distro module '$distroClass' ($@) ..."); + vlog(2, "falling back to module 'Any_Clone'"); + # allow fallback to generic clone module, such that we can clone + # distro's for which there is no specific distro-module yet + # (like for example for Gentoo): + $distro = instantiateClass("OpenSLX::OSSetup::Distro::Any_Clone") + } + } + + $distro->initialize($self); + $self->{distro} = $distro; + + if ($actionType =~ m{^(install|update|shell|plugin)}) { + # setup path to distribution-specific info: + my $sharedDistroInfoDir + = "$openslxConfig{'base-path'}/share/distro-info/$self->{'distro-name'}"; + if (!-d $sharedDistroInfoDir) { + die _tr( + "unable to find shared distro-info in '%s'\n", + $sharedDistroInfoDir + ); + } + $self->{'shared-distro-info-dir'} = $sharedDistroInfoDir; + my $configDistroInfoDir = + "$openslxConfig{'config-path'}/distro-info/$self->{'distro-name'}"; + if (!-d $configDistroInfoDir) { + die _tr( + "unable to find configurable distro-info in '%s'\n", + $configDistroInfoDir + ); + } + $self->{'config-distro-info-dir'} = $configDistroInfoDir; + + my $busyboxName = + $self->_hostIs64Bit() + ? 'busybox.x86_64' + : 'busybox.i586'; + $self->{'busybox-binary'} + = "$openslxConfig{'base-path'}/share/busybox/$busyboxName"; + + $self->_readDistroInfo(); + } + + if ($self->{'action-type'} eq 'install' + && !exists $self->{'distro-info'}->{'selection'}->{$selectionName}) + { + die( + _tr( + "selection '%s' is unknown to distro '%s'\n", + $selectionName, $self->{'distro-name'} + ) + . _tr("These selections are available:\n\t") + . join("\n\t", sort keys %{$self->{'distro-info'}->{'selection'}}) + . "\n" + ); + } + + $self->{'vendor-os-path'} + = "$openslxConfig{'private-path'}/stage1/$self->{'vendor-os-name'}"; + vlog(1, "vendor-OS path is '$self->{'vendor-os-path'}'"); + + if ($actionType =~ m{^(install|update|shell|plugin)}) { + $self->_createPackager(); + $self->_createMetaPackager(); + } + + return; } sub installVendorOS { - my $self = shift; - my $vendorOSSettings = shift; - - my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; - if (-e $installInfoFile) { - die _tr("vendor-OS '%s' already exists, giving up!\n", - $self->{'vendor-os-path'}); - } - $self->_createVendorOSPath(); - - $self->_startLocalURLServersAsNeeded(); - - my $baseSystemFile = "$self->{'vendor-os-path'}/.openslx-base-system"; - if (-e $baseSystemFile) { - vlog(0, _tr("found existing base system, continuing...\n")); - } - else { - # basic setup, stage1a-c: - $self->_setupStage1A(); - callInSubprocess( - sub { - # some tasks that involve a chrooted environment: - $self->_changePersonalityIfNeeded(); - $self->_setupStage1B(); - $self->_setupStage1C(); - } - ); - $self->_stage1C_cleanupBasicVendorOS(); - # just touch the file, in order to indicate a basic system: - slxsystem("touch $baseSystemFile"); - } - callInSubprocess( - sub { - # another task that involves a chrooted environment: - $self->_changePersonalityIfNeeded(); - $self->_setupStage1D(); - } - ); - - # create the install-info file, in order to indicate a proper installation: - spitFile( - $installInfoFile, - "SLX_META_PACKAGER=$self->{distro}->{'meta-packager-type'}\n" - ); - - # base system info file is no longer needed, we have a full system now - slxsystem("rm $baseSystemFile"); - - $self->_applyVendorOSSettings($vendorOSSettings) unless !$vendorOSSettings; - - vlog( - 0, - _tr( - "Vendor-OS '%s' installed succesfully.\n", - $self->{'vendor-os-name'} - ) - ); - - $self->_touchVendorOS(); - $self->addInstalledVendorOSToConfigDB(); - return; + my $self = shift; + my $vendorOSSettings = shift; + + my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; + if (-e $installInfoFile) { + die _tr("vendor-OS '%s' already exists, giving up!\n", + $self->{'vendor-os-path'}); + } + $self->_createVendorOSPath(); + + $self->_startLocalURLServersAsNeeded(); + + my $baseSystemFile = "$self->{'vendor-os-path'}/.openslx-base-system"; + if (-e $baseSystemFile) { + vlog(0, _tr("found existing base system, continuing...\n")); + } + else { + # basic setup, stage1a-c: + $self->_setupStage1A(); + callInSubprocess( + sub { + # some tasks that involve a chrooted environment: + $self->_changePersonalityIfNeeded(); + $self->_setupStage1B(); + $self->_setupStage1C(); + } + ); + $self->_stage1C_cleanupBasicVendorOS(); + # just touch the file, in order to indicate a basic system: + slxsystem("touch $baseSystemFile"); + } + callInSubprocess( + sub { + # another task that involves a chrooted environment: + $self->_changePersonalityIfNeeded(); + $self->_setupStage1D(); + } + ); + + # create the install-info file, in order to indicate a proper installation: + spitFile( + $installInfoFile, + "SLX_META_PACKAGER=$self->{distro}->{'meta-packager-type'}\n" + ); + + # base system info file is no longer needed, we have a full system now + slxsystem("rm $baseSystemFile"); + + $self->_applyVendorOSSettings($vendorOSSettings) unless !$vendorOSSettings; + + vlog( + 0, + _tr( + "Vendor-OS '%s' installed succesfully.\n", + $self->{'vendor-os-name'} + ) + ); + + $self->_touchVendorOS(); + $self->addInstalledVendorOSToConfigDB(); + return; } sub cloneVendorOS { - my $self = shift; - my $source = shift; - - if (substr($source, -1, 1) ne '/') { - # make sure source path ends with a slash, as otherwise, the - # last folder would be copied (but we only want its contents). - $source .= '/'; - } - - $self->{'clone-source'} = $source; - my $lastCloneSource = ''; - my $cloneInfoFile = "$self->{'vendor-os-path'}/.openslx-clone-info"; - my $isReClone; - if (-e $self->{'vendor-os-path'}) { - my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; - if (-e $installInfoFile) { - # oops, given vendor-os has been installed, not cloned, we complain: - croak( - _tr( - "The vendor-OS '%s' exists but it is no clone, refusing to clobber!\nPlease delete the folder manually, if that's really what you want...\n", - $self->{'vendor-os-path'} - ) - ); - } - elsif (-e $cloneInfoFile) { - # check if last and current source match: - my $cloneInfo = slurpFile($cloneInfoFile); - if ($cloneInfo =~ m[^source\s*=\s*(.+?)\s*$]ims) { - $lastCloneSource = $1; - } - if ($source ne $lastCloneSource) { - # protect user from confusing sources (still allowed, though): - my $yes = _tr('yes'); - my $no = _tr('no'); - print _tr( - "Last time this vendor-OS was cloned, it has been cloned from '%s', now you specified a different source: '%s'\nWould you still like to proceed (%s/%s)? ", - $lastCloneSource, $source, $yes, $no - ); - my $answer = ; - exit 5 unless $answer =~ m[^\s*$yes]i; - } - $isReClone = 1; - } - else { - # Neither the install-info nor the clone-info file exists. This - # probably means that the folder has been created by an older - # version of the tools. There's not much we can do, we simply - # trust our user and assume that he knows what he's doing. - } - } - - $self->_createVendorOSPath(); - - $self->_clone_fetchSource($source); - if ($source ne $lastCloneSource) { - spitFile($cloneInfoFile, "source=$source\n"); - } - if ($isReClone) { - vlog( - 0, - _tr( - "Vendor-OS '%s' has been re-cloned succesfully.\n", - $self->{'vendor-os-name'} - ) - ); - } - else { - vlog( - 0, - _tr( - "Vendor-OS '%s' has been cloned succesfully.\n", - $self->{'vendor-os-name'} - ) - ); - } - - $self->_touchVendorOS(); - $self->addInstalledVendorOSToConfigDB(); - return; + my $self = shift; + my $source = shift; + + if (substr($source, -1, 1) ne '/') { + # make sure source path ends with a slash, as otherwise, the + # last folder would be copied (but we only want its contents). + $source .= '/'; + } + + $self->{'clone-source'} = $source; + my $lastCloneSource = ''; + my $cloneInfoFile = "$self->{'vendor-os-path'}/.openslx-clone-info"; + my $isReClone; + if (-e $self->{'vendor-os-path'}) { + my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; + if (-e $installInfoFile) { + # oops, given vendor-os has been installed, not cloned, we complain: + croak( + _tr( + "The vendor-OS '%s' exists but it is no clone, refusing to clobber!\nPlease delete the folder manually, if that's really what you want...\n", + $self->{'vendor-os-path'} + ) + ); + } + elsif (-e $cloneInfoFile) { + # check if last and current source match: + my $cloneInfo = slurpFile($cloneInfoFile); + if ($cloneInfo =~ m[^source\s*=\s*(.+?)\s*$]ims) { + $lastCloneSource = $1; + } + if ($source ne $lastCloneSource) { + # protect user from confusing sources (still allowed, though): + my $yes = _tr('yes'); + my $no = _tr('no'); + print _tr( + "Last time this vendor-OS was cloned, it has been cloned from '%s', now you specified a different source: '%s'\nWould you still like to proceed (%s/%s)? ", + $lastCloneSource, $source, $yes, $no + ); + my $answer = ; + exit 5 unless $answer =~ m[^\s*$yes]i; + } + $isReClone = 1; + } + else { + # Neither the install-info nor the clone-info file exists. This + # probably means that the folder has been created by an older + # version of the tools. There's not much we can do, we simply + # trust our user and assume that he knows what he's doing. + } + } + + $self->_createVendorOSPath(); + + $self->_clone_fetchSource($source); + if ($source ne $lastCloneSource) { + spitFile($cloneInfoFile, "source=$source\n"); + } + if ($isReClone) { + vlog( + 0, + _tr( + "Vendor-OS '%s' has been re-cloned succesfully.\n", + $self->{'vendor-os-name'} + ) + ); + } + else { + vlog( + 0, + _tr( + "Vendor-OS '%s' has been cloned succesfully.\n", + $self->{'vendor-os-name'} + ) + ); + } + + $self->_touchVendorOS(); + $self->addInstalledVendorOSToConfigDB(); + return; } sub updateVendorOS { - my $self = shift; + my $self = shift; - if (!-e $self->{'vendor-os-path'}) { - die _tr("can't update vendor-OS '%s', since it doesn't exist!\n", - $self->{'vendor-os-path'}); - } + if (!-e $self->{'vendor-os-path'}) { + die _tr("can't update vendor-OS '%s', since it doesn't exist!\n", + $self->{'vendor-os-path'}); + } - $self->_startLocalURLServersAsNeeded(); + $self->_startLocalURLServersAsNeeded(); - callInSubprocess( - sub { - $self->_changePersonalityIfNeeded(); - $self->_updateStage1D(); - } - ); + callInSubprocess( + sub { + $self->_changePersonalityIfNeeded(); + $self->_updateStage1D(); + } + ); - $self->_touchVendorOS(); - vlog( - 0, - _tr("Vendor-OS '%s' updated succesfully.\n", $self->{'vendor-os-name'}) - ); + $self->_touchVendorOS(); + vlog( + 0, + _tr("Vendor-OS '%s' updated succesfully.\n", $self->{'vendor-os-name'}) + ); - $self->_installPlugins(); + $self->_installPlugins(); - return; + return; } sub startChrootedShellForVendorOS { - my $self = shift; - - if (!-e $self->{'vendor-os-path'}) { - die _tr( - "can't start chrooted shell for vendor-OS '%s', since it doesn't exist!\n", - $self->{'vendor-os-path'} - ); - } - - $self->_startLocalURLServersAsNeeded(); - - callInSubprocess( - sub { - $self->_changePersonalityIfNeeded(); - $self->_startChrootedShellInStage1D(); - } - ); - - $self->_touchVendorOS(); - vlog( - 0, - _tr( - "Chrooted shell for vendor-OS '%s' has been closed.\n", - $self->{'vendor-os-name'} - ) - ); - return; + my $self = shift; + + if (!-e $self->{'vendor-os-path'}) { + die _tr( + "can't start chrooted shell for vendor-OS '%s', since it doesn't exist!\n", + $self->{'vendor-os-path'} + ); + } + + $self->_startLocalURLServersAsNeeded(); + + callInSubprocess( + sub { + $self->_changePersonalityIfNeeded(); + $self->_startChrootedShellInStage1D(); + } + ); + + $self->_touchVendorOS(); + vlog( + 0, + _tr( + "Chrooted shell for vendor-OS '%s' has been closed.\n", + $self->{'vendor-os-name'} + ) + ); + return; } sub callChrootedFunctionForVendorOS { - my $self = shift; - my $function = shift; - my $updateConfig = shift || 0; - - if (!-e $self->{'vendor-os-path'}) { - die _tr( - "can't call chrooted function for vendor-OS '%s', since it doesn't exist!\n", - $self->{'vendor-os-path'} - ); - } - - $self->_startLocalURLServersAsNeeded(); - - callInSubprocess( - sub { - $self->_changePersonalityIfNeeded(); - $self->_callChrootedFunction({ - chrootDir => $self->{'vendor-os-path'}, - function => $function, - updateConfig => $updateConfig, - }); - } - ); - - $self->_touchVendorOS(); - vlog( - 1, - _tr( - "Chrooted function for vendor-OS '%s' has finished.\n", - $self->{'vendor-os-name'} - ) - ); - return 1; + my $self = shift; + my $function = shift; + my $updateConfig = shift || 0; + + if (!-e $self->{'vendor-os-path'}) { + die _tr( + "can't call chrooted function for vendor-OS '%s', since it doesn't exist!\n", + $self->{'vendor-os-path'} + ); + } + + $self->_startLocalURLServersAsNeeded(); + + callInSubprocess( + sub { + $self->_changePersonalityIfNeeded(); + $self->_callChrootedFunction({ + chrootDir => $self->{'vendor-os-path'}, + function => $function, + updateConfig => $updateConfig, + }); + } + ); + + $self->_touchVendorOS(); + vlog( + 1, + _tr( + "Chrooted function for vendor-OS '%s' has finished.\n", + $self->{'vendor-os-name'} + ) + ); + return 1; } sub removeVendorOS { - my $self = shift; - - vlog( - 0, - _tr("removing vendor-OS folder '%s'...", $self->{'vendor-os-path'}) - ); - if (system("rm -r $self->{'vendor-os-path'}")) { - vlog( - 0, - _tr("* unable to remove vendor-OS '%s'!", $self->{'vendor-os-path'}) - ); - } - else { - vlog( - 0, - _tr( - "Vendor-OS '%s' removed succesfully.\n", - $self->{'vendor-os-name'} - ) - ); - } - $self->removeVendorOSFromConfigDB(); - return; + my $self = shift; + + vlog( + 0, + _tr("removing vendor-OS folder '%s'...", $self->{'vendor-os-path'}) + ); + if (system("rm -r $self->{'vendor-os-path'}")) { + vlog( + 0, + _tr("* unable to remove vendor-OS '%s'!", $self->{'vendor-os-path'}) + ); + } + else { + vlog( + 0, + _tr( + "Vendor-OS '%s' removed succesfully.\n", + $self->{'vendor-os-name'} + ) + ); + } + $self->removeVendorOSFromConfigDB(); + return; } sub addInstalledVendorOSToConfigDB { - my $self = shift; - - if (!-e $self->{'vendor-os-path'}) { - die _tr( - "can't import vendor-OS '%s', since it doesn't exist!\n", - $self->{'vendor-os-path'} - ); - } - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - - my @plugins; - - # insert new vendor-os if it doesn't already exist in DB: - my $vendorOSName = $self->{'vendor-os-name'}; - my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); - if (defined $vendorOS) { - if ($vendorOS->{'clone_source'} - && $self->{'clone-source'} ne $vendorOS->{'clone_source'}) { - $openslxDB->changeVendorOS( - $vendorOS->{id}, - { 'clone_source' => $self->{'clone-source'} } - ); - vlog( - 0, - _tr( - "Vendor-OS '%s' has been updated in OpenSLX-database.\n", - $vendorOSName - ) - ); - } - else { - vlog( - 0, - _tr( - "No need to change vendor-OS '%s' in OpenSLX-database.\n", - $vendorOSName - ) - ); - } - # re-install plugins of this vendor-OS - @plugins = $openslxDB->fetchInstalledPlugins($vendorOS->{id}); - } - else { - my $data = { 'name' => $vendorOSName }; - if (length($self->{'clone-source'})) { - $data->{'clone_source'} = $self->{'clone-source'}; - } - my $id = $openslxDB->addVendorOS($data); - - vlog( - 0, - _tr( - "Vendor-OS '%s' has been added to DB (ID=%s).\n", - $vendorOSName, $id - ) - ); - # install plugins from default vendor-OS into this new one - @plugins = $openslxDB->fetchInstalledPlugins(0); - } - - $openslxDB->disconnect(); - - # now that we have the list of plugins, we (re-)install all of them: - $self->_installPlugins(\@plugins); - - return; + my $self = shift; + + if (!-e $self->{'vendor-os-path'}) { + die _tr( + "can't import vendor-OS '%s', since it doesn't exist!\n", + $self->{'vendor-os-path'} + ); + } + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + + my @plugins; + + # insert new vendor-os if it doesn't already exist in DB: + my $vendorOSName = $self->{'vendor-os-name'}; + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (defined $vendorOS) { + if ($vendorOS->{'clone_source'} + && $self->{'clone-source'} ne $vendorOS->{'clone_source'}) { + $openslxDB->changeVendorOS( + $vendorOS->{id}, + { 'clone_source' => $self->{'clone-source'} } + ); + vlog( + 0, + _tr( + "Vendor-OS '%s' has been updated in OpenSLX-database.\n", + $vendorOSName + ) + ); + } + else { + vlog( + 0, + _tr( + "No need to change vendor-OS '%s' in OpenSLX-database.\n", + $vendorOSName + ) + ); + } + # re-install plugins of this vendor-OS + @plugins = $openslxDB->fetchInstalledPlugins($vendorOS->{id}); + } + else { + my $data = { 'name' => $vendorOSName }; + if (length($self->{'clone-source'})) { + $data->{'clone_source'} = $self->{'clone-source'}; + } + my $id = $openslxDB->addVendorOS($data); + + vlog( + 0, + _tr( + "Vendor-OS '%s' has been added to DB (ID=%s).\n", + $vendorOSName, $id + ) + ); + # install plugins from default vendor-OS into this new one + @plugins = $openslxDB->fetchInstalledPlugins(0); + } + + $openslxDB->disconnect(); + + # now that we have the list of plugins, we (re-)install all of them: + $self->_installPlugins(\@plugins); + + return; } sub removeVendorOSFromConfigDB { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - - my $vendorOSName = $self->{'vendor-os-name'}; - my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); - if (!defined $vendorOS) { - vlog( - 0, - _tr( - "Vendor-OS '%s' didn't exist in OpenSLX-database.\n", - $vendorOSName - ) - ); - } - else { - # remove all exports (and systems) using this vendor-OS and then - # remove the vendor-OS itself: - my @exports = $openslxDB->fetchExportByFilter( - {'vendor_os_id' => $vendorOS->{id}}); - foreach my $export (@exports) { - my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); - $osExportEngine->initializeFromExisting($export->{name}); - vlog( - 0, - _tr( - "purging export '%s', since it belongs to the vendor-OS being deleted...", - $export->{name} - ) - ); - $osExportEngine->purgeExport(); - } - - $openslxDB->removeVendorOS($vendorOS->{id}); - vlog( - 0, - _tr("Vendor-OS '%s' has been removed from DB!\n", $vendorOSName) - ); - } - - $openslxDB->disconnect(); - return; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + + my $vendorOSName = $self->{'vendor-os-name'}; + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (!defined $vendorOS) { + vlog( + 0, + _tr( + "Vendor-OS '%s' didn't exist in OpenSLX-database.\n", + $vendorOSName + ) + ); + } + else { + # remove all exports (and systems) using this vendor-OS and then + # remove the vendor-OS itself: + my @exports = $openslxDB->fetchExportByFilter( + {'vendor_os_id' => $vendorOS->{id}}); + foreach my $export (@exports) { + my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); + $osExportEngine->initializeFromExisting($export->{name}); + vlog( + 0, + _tr( + "purging export '%s', since it belongs to the vendor-OS being deleted...", + $export->{name} + ) + ); + $osExportEngine->purgeExport(); + } + + $openslxDB->removeVendorOS($vendorOS->{id}); + vlog( + 0, + _tr("Vendor-OS '%s' has been removed from DB!\n", $vendorOSName) + ); + } + + $openslxDB->disconnect(); + return; } sub pickKernelFile { - my $self = shift; + my $self = shift; - return $self->{distro}->pickKernelFile(@_); + return $self->{distro}->pickKernelFile(@_); } sub distroName { - my $self = shift; + my $self = shift; - return $self->{'distro-name'}; + return $self->{'distro-name'}; } sub metaPackager { - my $self = shift; + my $self = shift; - return $self->{'meta-packager'}; + return $self->{'meta-packager'}; } sub getInstallablePackagesForSelection { - my $self = shift; - my $selKey = shift; + my $self = shift; + my $selKey = shift; - return if !$selKey; + return if !$selKey; - my $selection = $self->{'distro-info'}->{selection}->{$selKey}; - return if !$selection; - - my @pkgs = split m{\s+}, $selection->{packages}; - my %installedPkgs; - @installedPkgs{ $self->{'packager'}->getInstalledPackages() } = (); - @pkgs = grep { !exists $installedPkgs{$_} } @pkgs; + my $selection = $self->{'distro-info'}->{selection}->{$selKey}; + return if !$selection; + + my @pkgs = split m{\s+}, $selection->{packages}; + my %installedPkgs; + @installedPkgs{ $self->{'packager'}->getInstalledPackages() } = (); + @pkgs = grep { !exists $installedPkgs{$_} } @pkgs; - return join ' ', @pkgs; + return join ' ', @pkgs; } sub busyboxBinary { - my $self = shift; + my $self = shift; - return $self->{'busybox-binary'}; + return $self->{'busybox-binary'}; } ################################################################################ @@ -719,1080 +719,1080 @@ sub busyboxBinary ################################################################################ sub _readDistroInfo { - my $self = shift; - - vlog(1, "reading configuration info for $self->{'vendor-os-name'}..."); - - $self->{'distro-info'} = { - 'package-subdir' => '', - 'prereq-packages' => '', - 'bootstrap-packages' => '', - 'metapackager' => {}, - 'repository' => {}, - 'selection' => {}, - 'excludes' => {}, - }; - - # merge user-provided configuration with distro defaults - foreach my $file ( - "$self->{'shared-distro-info-dir'}/settings.default", - "$self->{'config-distro-info-dir'}/settings" - ) { - if (-e $file) { - vlog(2, "reading configuration file $file..."); - my $configObject = Config::General->new( - -AllowMultiOptions => 0, - -AutoTrue => 1, - -ConfigFile => $file, - -LowerCaseNames => 1, - -SplitPolicy => 'equalsign', - ); - my %config = $configObject->getall(); - mergeHash($self->{'distro-info'}, \%config); - } - } - - # fetch mirrors for all repositories: - foreach my $repoKey (keys %{$self->{'distro-info'}->{repository}}) { - my $repo = $self->{'distro-info'}->{repository}->{$repoKey}; - $repo->{key} = $repoKey; - # if there is local URL, only that is used, otherwise we fetch the - # configured mirrors: - if (!$repo->{'local-url'}) { - $repo->{urls} = $self->_fetchConfiguredMirrorsForRepository($repo); - } - } - - # expand all selections: - my $seen = {}; - foreach my $selKey (keys %{$self->{'distro-info'}->{selection}}) { - $self->_expandSelection($selKey, $seen); - } - - # dump distro-info, if asked for: - if ($openslxConfig{'verbose-level'} >= 2) { - my $repository = $self->{'distro-info'}->{repository}; - foreach my $r (sort keys %$repository) { - vlog(2, "repository '$r':"); - foreach my $k (sort keys %{$repository->{$r}}) { - vlog(3, "\t$k = '$repository->{$r}->{$k}'"); - } - } - my $selection = $self->{'distro-info'}->{selection}; - foreach my $s (sort keys %$selection) { - vlog(2, "selection '$s':"); - foreach my $k (sort keys %{$selection->{$s}}) { - vlog(3, "\t$k = '$selection->{$s}->{$k}'"); - } - } - my $excludes = $self->{'distro-info'}->{excludes}; - foreach my $e (sort keys %$excludes) { - vlog(2, "excludes for '$e':"); - foreach my $k (sort keys %{$excludes->{$e}}) { - vlog(3, "\t$k = '$excludes->{$e}->{$k}'"); - } - } - } - return; + my $self = shift; + + vlog(1, "reading configuration info for $self->{'vendor-os-name'}..."); + + $self->{'distro-info'} = { + 'package-subdir' => '', + 'prereq-packages' => '', + 'bootstrap-packages' => '', + 'metapackager' => {}, + 'repository' => {}, + 'selection' => {}, + 'excludes' => {}, + }; + + # merge user-provided configuration with distro defaults + foreach my $file ( + "$self->{'shared-distro-info-dir'}/settings.default", + "$self->{'config-distro-info-dir'}/settings" + ) { + if (-e $file) { + vlog(2, "reading configuration file $file..."); + my $configObject = Config::General->new( + -AllowMultiOptions => 0, + -AutoTrue => 1, + -ConfigFile => $file, + -LowerCaseNames => 1, + -SplitPolicy => 'equalsign', + ); + my %config = $configObject->getall(); + mergeHash($self->{'distro-info'}, \%config); + } + } + + # fetch mirrors for all repositories: + foreach my $repoKey (keys %{$self->{'distro-info'}->{repository}}) { + my $repo = $self->{'distro-info'}->{repository}->{$repoKey}; + $repo->{key} = $repoKey; + # if there is local URL, only that is used, otherwise we fetch the + # configured mirrors: + if (!$repo->{'local-url'}) { + $repo->{urls} = $self->_fetchConfiguredMirrorsForRepository($repo); + } + } + + # expand all selections: + my $seen = {}; + foreach my $selKey (keys %{$self->{'distro-info'}->{selection}}) { + $self->_expandSelection($selKey, $seen); + } + + # dump distro-info, if asked for: + if ($openslxConfig{'verbose-level'} >= 2) { + my $repository = $self->{'distro-info'}->{repository}; + foreach my $r (sort keys %$repository) { + vlog(2, "repository '$r':"); + foreach my $k (sort keys %{$repository->{$r}}) { + vlog(3, "\t$k = '$repository->{$r}->{$k}'"); + } + } + my $selection = $self->{'distro-info'}->{selection}; + foreach my $s (sort keys %$selection) { + vlog(2, "selection '$s':"); + foreach my $k (sort keys %{$selection->{$s}}) { + vlog(3, "\t$k = '$selection->{$s}->{$k}'"); + } + } + my $excludes = $self->{'distro-info'}->{excludes}; + foreach my $e (sort keys %$excludes) { + vlog(2, "excludes for '$e':"); + foreach my $k (sort keys %{$excludes->{$e}}) { + vlog(3, "\t$k = '$excludes->{$e}->{$k}'"); + } + } + } + return; } sub _fetchConfiguredMirrorsForRepository { - my $self = shift; - my $repoInfo = shift; - - my $configuredMirrorsFile - = "$self->{'config-distro-info-dir'}/mirrors/$repoInfo->{key}"; - if (!-e $configuredMirrorsFile) { - vlog(0, - _tr( - "repo '%s' has no configured mirrors, let's pick some ...", - $repoInfo->{name} - ) - ); - $self->_configureBestMirrorsForRepository($repoInfo); - } - vlog(2, "reading configured mirrors file '$configuredMirrorsFile'."); - my $configObject = Config::General->new( - -AllowMultiOptions => 0, - -AutoTrue => 1, - -ConfigFile => $configuredMirrorsFile, - -LowerCaseNames => 1, - -SplitPolicy => 'equalsign', - ); - my %config = $configObject->getall(); - - return $config{urls}; + my $self = shift; + my $repoInfo = shift; + + my $configuredMirrorsFile + = "$self->{'config-distro-info-dir'}/mirrors/$repoInfo->{key}"; + if (!-e $configuredMirrorsFile) { + vlog(0, + _tr( + "repo '%s' has no configured mirrors, let's pick some ...", + $repoInfo->{name} + ) + ); + $self->_configureBestMirrorsForRepository($repoInfo); + } + vlog(2, "reading configured mirrors file '$configuredMirrorsFile'."); + my $configObject = Config::General->new( + -AllowMultiOptions => 0, + -AutoTrue => 1, + -ConfigFile => $configuredMirrorsFile, + -LowerCaseNames => 1, + -SplitPolicy => 'equalsign', + ); + my %config = $configObject->getall(); + + return $config{urls}; } sub _configureBestMirrorsForRepository { - my $self = shift; - my $repoInfo = shift; - - my $configuredMirrorsFile - = "$self->{'config-distro-info-dir'}/mirrors/$repoInfo->{key}"; - - if (!-e "$self->{'config-distro-info-dir'}/mirrors") { - mkdir "$self->{'config-distro-info-dir'}/mirrors"; - } - - my $allMirrorsFile - = "$self->{'shared-distro-info-dir'}/mirrors/$repoInfo->{key}"; - my @allMirrors = string2Array(scalar slurpFile($allMirrorsFile)); - - my $mirrorsToTryCount = $openslxConfig{'mirrors-to-try-count'} || 20; - my $mirrorsToUseCount = $openslxConfig{'mirrors-to-use-count'} || 5; - vlog(1, - _tr( - "selecting the '%s' best mirrors (from a set of '%s') for repo '%s' ...", - $mirrorsToUseCount, $mirrorsToTryCount, $repoInfo->{key} - ) - ); - - # determine own top-level domain: - my $topLevelDomain; - if (defined $openslxConfig{'mirrors-preferred-top-level-domain'}) { - $topLevelDomain - = lc($openslxConfig{'mirrors-preferred-top-level-domain'}); - } - else { - my $FQDN = getFQDN(); - $FQDN =~ m{\.(\w+)$}; - $topLevelDomain = lc($1); - } - - # select up to $mirrorsToTryCount "close" mirrors from the array ... - my @tryMirrors - = grep { - my $uri = URI->new($_); - my $host = $uri->host(); - $host =~ m{\.(\w+)$} && lc($1) eq $topLevelDomain; - } - @allMirrors; - - my $tryList = join("\n\t", @tryMirrors); - vlog(1, - _tr( - "mirrors matching the preferred top level domain ('%s'):\n\t%s\n", - $topLevelDomain, $tryList - ) - ); - - if (@tryMirrors > $mirrorsToTryCount) { - # shrink array to $mirrorsToTryCount elements - vlog(1, _tr("shrinking list to %s mirrors\n", $mirrorsToTryCount)); - $#tryMirrors = $mirrorsToTryCount; - } - elsif (@tryMirrors < $mirrorsToTryCount) { - # we need more mirrors, try adding some others randomly: - vlog(1, - _tr( - "filling list with %s more random mirrors:\n", - $mirrorsToTryCount - @tryMirrors - ) - ); - - # fill @untriedMirrors with the mirrors not already contained - # in @tryMirrors ... - my @untriedMirrors - = grep { - my $mirror = $_; - !grep { $mirror eq $_ } @tryMirrors; - } @allMirrors; - - # ... and pick randomly until we have reached the limit or there are - # no more unused mirrors left - foreach my $count (@tryMirrors..$mirrorsToTryCount-1) { - last if !@untriedMirrors; - my $index = int(rand(scalar @untriedMirrors)); - my $randomMirror = splice(@untriedMirrors, $index, 1); - push @tryMirrors, $randomMirror; - vlog(1, "\t$randomMirror\n"); - } - } - - # just make sure we are not going to try/use more mirros than we have - # available - if ($mirrorsToTryCount > @tryMirrors) { - $mirrorsToTryCount = @tryMirrors; - } - if ($mirrorsToUseCount > $mirrorsToTryCount) { - $mirrorsToUseCount = $mirrorsToTryCount; - } - - # ... fetch a file from all of these mirrors and measure the time taken ... - vlog(0, - _tr( - "testing %s mirrors to determine the fastest %s ...\n", - $mirrorsToTryCount, $mirrorsToUseCount - ) - ); - my %mirrorSpeed; - my $veryGoodSpeedCount = 0; - foreach my $mirror (@tryMirrors) { - if ($veryGoodSpeedCount >= $mirrorsToUseCount) { - # we already have enough mirrors with very good speed, - # it makes no sense to test any others. We simply set the - # time of the remaining mirrors to some large value, so they - # won't get picked: - $mirrorSpeed{$mirror} = 10000; - next; - } - - # test the current mirror and record the result - my $time = $self->_speedTestMirror( - $mirror, $repoInfo->{'file-for-speedtest'} - ); - $mirrorSpeed{$mirror} = $time; - if ($time <= 1) { - $veryGoodSpeedCount++; - } - } - - # ... now select the best (fastest) $mirrorsToUseCount mirrors ... - my @bestMirrors - = ( - sort { - $mirrorSpeed{$a} <=> $mirrorSpeed{$b}; - } - @tryMirrors - )[0..$mirrorsToUseCount-1]; - - vlog(0, - _tr( - "picked these '%s' mirrors for repo '%s':\n\t%s\n", - $mirrorsToUseCount, $repoInfo->{name}, join("\n\t", @bestMirrors) - ) - ); - - # ... and write them into the configuration file: - my $configObject = Config::General->new( - -AllowMultiOptions => 0, - -AutoTrue => 1, - -LowerCaseNames => 1, - -SplitPolicy => 'equalsign', - ); - $configObject->save_file($configuredMirrorsFile, { - 'urls' => join("\n", @bestMirrors), - }); - return; + my $self = shift; + my $repoInfo = shift; + + my $configuredMirrorsFile + = "$self->{'config-distro-info-dir'}/mirrors/$repoInfo->{key}"; + + if (!-e "$self->{'config-distro-info-dir'}/mirrors") { + mkdir "$self->{'config-distro-info-dir'}/mirrors"; + } + + my $allMirrorsFile + = "$self->{'shared-distro-info-dir'}/mirrors/$repoInfo->{key}"; + my @allMirrors = string2Array(scalar slurpFile($allMirrorsFile)); + + my $mirrorsToTryCount = $openslxConfig{'mirrors-to-try-count'} || 20; + my $mirrorsToUseCount = $openslxConfig{'mirrors-to-use-count'} || 5; + vlog(1, + _tr( + "selecting the '%s' best mirrors (from a set of '%s') for repo '%s' ...", + $mirrorsToUseCount, $mirrorsToTryCount, $repoInfo->{key} + ) + ); + + # determine own top-level domain: + my $topLevelDomain; + if (defined $openslxConfig{'mirrors-preferred-top-level-domain'}) { + $topLevelDomain + = lc($openslxConfig{'mirrors-preferred-top-level-domain'}); + } + else { + my $FQDN = getFQDN(); + $FQDN =~ m{\.(\w+)$}; + $topLevelDomain = lc($1); + } + + # select up to $mirrorsToTryCount "close" mirrors from the array ... + my @tryMirrors + = grep { + my $uri = URI->new($_); + my $host = $uri->host(); + $host =~ m{\.(\w+)$} && lc($1) eq $topLevelDomain; + } + @allMirrors; + + my $tryList = join("\n\t", @tryMirrors); + vlog(1, + _tr( + "mirrors matching the preferred top level domain ('%s'):\n\t%s\n", + $topLevelDomain, $tryList + ) + ); + + if (@tryMirrors > $mirrorsToTryCount) { + # shrink array to $mirrorsToTryCount elements + vlog(1, _tr("shrinking list to %s mirrors\n", $mirrorsToTryCount)); + $#tryMirrors = $mirrorsToTryCount; + } + elsif (@tryMirrors < $mirrorsToTryCount) { + # we need more mirrors, try adding some others randomly: + vlog(1, + _tr( + "filling list with %s more random mirrors:\n", + $mirrorsToTryCount - @tryMirrors + ) + ); + + # fill @untriedMirrors with the mirrors not already contained + # in @tryMirrors ... + my @untriedMirrors + = grep { + my $mirror = $_; + !grep { $mirror eq $_ } @tryMirrors; + } @allMirrors; + + # ... and pick randomly until we have reached the limit or there are + # no more unused mirrors left + foreach my $count (@tryMirrors..$mirrorsToTryCount-1) { + last if !@untriedMirrors; + my $index = int(rand(scalar @untriedMirrors)); + my $randomMirror = splice(@untriedMirrors, $index, 1); + push @tryMirrors, $randomMirror; + vlog(1, "\t$randomMirror\n"); + } + } + + # just make sure we are not going to try/use more mirros than we have + # available + if ($mirrorsToTryCount > @tryMirrors) { + $mirrorsToTryCount = @tryMirrors; + } + if ($mirrorsToUseCount > $mirrorsToTryCount) { + $mirrorsToUseCount = $mirrorsToTryCount; + } + + # ... fetch a file from all of these mirrors and measure the time taken ... + vlog(0, + _tr( + "testing %s mirrors to determine the fastest %s ...\n", + $mirrorsToTryCount, $mirrorsToUseCount + ) + ); + my %mirrorSpeed; + my $veryGoodSpeedCount = 0; + foreach my $mirror (@tryMirrors) { + if ($veryGoodSpeedCount >= $mirrorsToUseCount) { + # we already have enough mirrors with very good speed, + # it makes no sense to test any others. We simply set the + # time of the remaining mirrors to some large value, so they + # won't get picked: + $mirrorSpeed{$mirror} = 10000; + next; + } + + # test the current mirror and record the result + my $time = $self->_speedTestMirror( + $mirror, $repoInfo->{'file-for-speedtest'} + ); + $mirrorSpeed{$mirror} = $time; + if ($time <= 1) { + $veryGoodSpeedCount++; + } + } + + # ... now select the best (fastest) $mirrorsToUseCount mirrors ... + my @bestMirrors + = ( + sort { + $mirrorSpeed{$a} <=> $mirrorSpeed{$b}; + } + @tryMirrors + )[0..$mirrorsToUseCount-1]; + + vlog(0, + _tr( + "picked these '%s' mirrors for repo '%s':\n\t%s\n", + $mirrorsToUseCount, $repoInfo->{name}, join("\n\t", @bestMirrors) + ) + ); + + # ... and write them into the configuration file: + my $configObject = Config::General->new( + -AllowMultiOptions => 0, + -AutoTrue => 1, + -LowerCaseNames => 1, + -SplitPolicy => 'equalsign', + ); + $configObject->save_file($configuredMirrorsFile, { + 'urls' => join("\n", @bestMirrors), + }); + return; } sub _speedTestMirror { - my $self = shift; - my $mirror = shift; - my $file = shift; - - vlog(0, _tr("\ttesting mirror '%s' ...\n", $mirror)); - - # do an explicit DNS-lookup as we do not want to include the time that takes - # in the speedtest - my $uri = URI->new($mirror); - my $hostName = $uri->host(); - if (!gethostbyname($hostName)) { - # unable to resolve host, we pretend it took really long - return 10000; - } - - # now measure the time it takes to download the file - my $wgetCmd - = "$self->{'busybox-binary'} wget -q -O - $mirror/$file >/dev/null"; - my $start = time(); - if (slxsystem($wgetCmd)) { - # just return any large number that is unlikely to be selected - return 10000; - } - my $time = time() - $start; - vlog(0, "\tfetched '$file' in $time seconds\n"); - return $time; + my $self = shift; + my $mirror = shift; + my $file = shift; + + vlog(0, _tr("\ttesting mirror '%s' ...\n", $mirror)); + + # do an explicit DNS-lookup as we do not want to include the time that takes + # in the speedtest + my $uri = URI->new($mirror); + my $hostName = $uri->host(); + if (!gethostbyname($hostName)) { + # unable to resolve host, we pretend it took really long + return 10000; + } + + # now measure the time it takes to download the file + my $wgetCmd + = "$self->{'busybox-binary'} wget -q -O - $mirror/$file >/dev/null"; + my $start = time(); + if (slxsystem($wgetCmd)) { + # just return any large number that is unlikely to be selected + return 10000; + } + my $time = time() - $start; + vlog(0, "\tfetched '$file' in $time seconds\n"); + return $time; } - + sub _expandSelection { - my $self = shift; - my $selKey = shift; - my $seen = shift; - - return if $seen->{$selKey}; - $seen->{$selKey} = 1; - - return if !exists $self->{'distro-info'}->{selection}->{$selKey}; - my $selection = $self->{'distro-info'}->{selection}->{$selKey}; - - if ($selection->{base}) { - # add all packages from base selection(s) to the current one: - my $basePackages = ''; - for my $base (split ',', $selection->{base}) { - my $baseSelection = $self->{'distro-info'}->{selection}->{$base} - or die _tr( - 'base-selection "%s" is unknown (referenced in "%s")!', - $base, $selKey - ); - $self->_expandSelection($base, $seen); - $basePackages .= $baseSelection->{packages} || ''; - } - my $packages = $selection->{packages} || ''; - $selection->{packages} = $basePackages . "\n" . $packages; - } - return; + my $self = shift; + my $selKey = shift; + my $seen = shift; + + return if $seen->{$selKey}; + $seen->{$selKey} = 1; + + return if !exists $self->{'distro-info'}->{selection}->{$selKey}; + my $selection = $self->{'distro-info'}->{selection}->{$selKey}; + + if ($selection->{base}) { + # add all packages from base selection(s) to the current one: + my $basePackages = ''; + for my $base (split ',', $selection->{base}) { + my $baseSelection = $self->{'distro-info'}->{selection}->{$base} + or die _tr( + 'base-selection "%s" is unknown (referenced in "%s")!', + $base, $selKey + ); + $self->_expandSelection($base, $seen); + $basePackages .= $baseSelection->{packages} || ''; + } + my $packages = $selection->{packages} || ''; + $selection->{packages} = $basePackages . "\n" . $packages; + } + return; } sub _applyVendorOSSettings { - my $self = shift; - my $vendorOSSettings = shift; - - if (exists $vendorOSSettings->{'root-password'}) { - # hashes password according to requirements of current distro and - # writes it to /etc/shadow - $self->{distro}->setPasswordForUser( - 'root', $vendorOSSettings->{'root-password'} - ); - } - - return; + my $self = shift; + my $vendorOSSettings = shift; + + if (exists $vendorOSSettings->{'root-password'}) { + # hashes password according to requirements of current distro and + # writes it to /etc/shadow + $self->{distro}->setPasswordForUser( + 'root', $vendorOSSettings->{'root-password'} + ); + } + + return; } sub _createVendorOSPath { - my $self = shift; + my $self = shift; - if (slxsystem("mkdir -p $self->{'vendor-os-path'}")) { - die _tr("unable to create directory '%s', giving up! (%s)\n", - $self->{'vendor-os-path'}, $!); - } - return; + if (slxsystem("mkdir -p $self->{'vendor-os-path'}")) { + die _tr("unable to create directory '%s', giving up! (%s)\n", + $self->{'vendor-os-path'}, $!); + } + return; } sub _touchVendorOS { - my $self = shift; + my $self = shift; - # touch root folder, as we are using this folder to determine the - # 'age' of the vendor-OS when trying to determine whether or not we - # need to re-export this vendor-OS: - slxsystem("touch $self->{'vendor-os-path'}"); - return; + # touch root folder, as we are using this folder to determine the + # 'age' of the vendor-OS when trying to determine whether or not we + # need to re-export this vendor-OS: + slxsystem("touch $self->{'vendor-os-path'}"); + return; } sub _createPackager { - my $self = shift; - - my $packagerClass - = "OpenSLX::OSSetup::Packager::$self->{distro}->{'packager-type'}"; - my $packager = instantiateClass($packagerClass); - $packager->initialize($self); - $self->{'packager'} = $packager; - return; + my $self = shift; + + my $packagerClass + = "OpenSLX::OSSetup::Packager::$self->{distro}->{'packager-type'}"; + my $packager = instantiateClass($packagerClass); + $packager->initialize($self); + $self->{'packager'} = $packager; + return; } sub _createMetaPackager { - my $self = shift; - - my $metaPackagerType = $self->{distro}->{'meta-packager-type'}; - - my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; - if (-e $installInfoFile) { - # activate the meta-packager that was used when installing the os: - my $installInfo = slurpFile($installInfoFile); - if ($installInfo =~ m[SLX_META_PACKAGER=(\w+)]) { - $metaPackagerType = $1; - } - } - - my $metaPackagerClass = "OpenSLX::OSSetup::MetaPackager::$metaPackagerType"; - my $metaPackager = instantiateClass($metaPackagerClass); - $metaPackager->initialize($self); - $self->{'meta-packager'} = $metaPackager; - return; + my $self = shift; + + my $metaPackagerType = $self->{distro}->{'meta-packager-type'}; + + my $installInfoFile = "$self->{'vendor-os-path'}/.openslx-install-info"; + if (-e $installInfoFile) { + # activate the meta-packager that was used when installing the os: + my $installInfo = slurpFile($installInfoFile); + if ($installInfo =~ m[SLX_META_PACKAGER=(\w+)]) { + $metaPackagerType = $1; + } + } + + my $metaPackagerClass = "OpenSLX::OSSetup::MetaPackager::$metaPackagerType"; + my $metaPackager = instantiateClass($metaPackagerClass); + $metaPackager->initialize($self); + $self->{'meta-packager'} = $metaPackager; + return; } sub _sortRepositoryURLs { - my $self = shift; - my $repoInfo = shift; - - my @URLs - = defined $repoInfo->{'local-url'} - ? $repoInfo->{'local-url'} - : string2Array($repoInfo->{urls}); - if (!@URLs) { - die( - _tr( - "repository '%s' has no URLs defined, unable to fetch anything!", - $repoInfo->{name}, - ) - ); - } - - return \@URLs; + my $self = shift; + my $repoInfo = shift; + + my @URLs + = defined $repoInfo->{'local-url'} + ? $repoInfo->{'local-url'} + : string2Array($repoInfo->{urls}); + if (!@URLs) { + die( + _tr( + "repository '%s' has no URLs defined, unable to fetch anything!", + $repoInfo->{name}, + ) + ); + } + + return \@URLs; } sub _downloadBaseFiles { - my $self = shift; - my $files = shift; - - my $pkgSubdir = $self->{'distro-info'}->{'package-subdir'}; - my @URLs = @{$self->{'baseURLs'}}; - my $maxTryCount = $openslxConfig{'ossetup-max-try-count'}; - - my @foundFiles; - foreach my $fileVariantStr (@$files) { - my $tryCount = 0; - next unless $fileVariantStr =~ m[\S]; - my $foundFile; + my $self = shift; + my $files = shift; + + my $pkgSubdir = $self->{'distro-info'}->{'package-subdir'}; + my @URLs = @{$self->{'baseURLs'}}; + my $maxTryCount = $openslxConfig{'ossetup-max-try-count'}; + + my @foundFiles; + foreach my $fileVariantStr (@$files) { + my $tryCount = 0; + next unless $fileVariantStr =~ m[\S]; + my $foundFile; try_next_url: - my $url = $URLs[$self->{'baseURL-index'}]; - $url .= "/$pkgSubdir" if length($pkgSubdir); - - foreach my $file (split '\s+', $fileVariantStr) { - my $basefile = basename($file); - vlog(2, "fetching <$file>..."); - if (slxsystem("wget", "-c", "-O", "$basefile", "$url/$file") == 0) { - $foundFile = $basefile; - last; - } - elsif (-e $basefile) { - vlog(0, "removing left-over '$basefile' and trying again..."); - unlink $basefile; - redo; - } - } - if (!defined $foundFile) { - if ($tryCount < $maxTryCount) { - $tryCount++; - $self->{'baseURL-index'} - = ($self->{'baseURL-index'} + 1) % scalar(@URLs); - vlog( - 0, - _tr( - "switching to mirror '%s'.", - $URLs[$self->{'baseURL-index'}] - ) - ); - goto try_next_url; - } - die _tr("unable to fetch '%s' from any source!\n", $fileVariantStr); - } - push @foundFiles, $foundFile; - } - return @foundFiles; + my $url = $URLs[$self->{'baseURL-index'}]; + $url .= "/$pkgSubdir" if length($pkgSubdir); + + foreach my $file (split '\s+', $fileVariantStr) { + my $basefile = basename($file); + vlog(2, "fetching <$file>..."); + if (slxsystem("wget", "-c", "-O", "$basefile", "$url/$file") == 0) { + $foundFile = $basefile; + last; + } + elsif (-e $basefile) { + vlog(0, "removing left-over '$basefile' and trying again..."); + unlink $basefile; + redo; + } + } + if (!defined $foundFile) { + if ($tryCount < $maxTryCount) { + $tryCount++; + $self->{'baseURL-index'} + = ($self->{'baseURL-index'} + 1) % scalar(@URLs); + vlog( + 0, + _tr( + "switching to mirror '%s'.", + $URLs[$self->{'baseURL-index'}] + ) + ); + goto try_next_url; + } + die _tr("unable to fetch '%s' from any source!\n", $fileVariantStr); + } + push @foundFiles, $foundFile; + } + return @foundFiles; } sub _startLocalURLServersAsNeeded { - my $self = shift; - - $localHttpServerMasterPID ||= $$; - - my $port = 5080; - my %portForURL; - foreach my $repoInfo (values %{$self->{'distro-info'}->{repository}}) { - my $localURL = $repoInfo->{'local-url'} || ''; - next if !$localURL; - next if $localURL =~ m[^\w+:]; # anything with a protcol-spec is non-local - if (!exists $localHttpServers{$localURL}) { - my $pid - = executeInSubprocess( - $self->{'busybox-binary'}, "httpd", '-p', $port, '-h', '/', '-f' - ); - vlog(1, - _tr( - "started local HTTP-server for URL '%s' on port '%s'.", - $localURL, $port - ) - ); - $repoInfo->{'local-url'} = "http://localhost:$port$localURL"; - $localHttpServers{$localURL}->{pid} = $pid; - $localHttpServers{$localURL}->{url} = $repoInfo->{'local-url'}; - $port++; - } - else { - $repoInfo->{'local-url'} = $localHttpServers{$localURL}->{url}; - } - } - return; + my $self = shift; + + $localHttpServerMasterPID ||= $$; + + my $port = 5080; + my %portForURL; + foreach my $repoInfo (values %{$self->{'distro-info'}->{repository}}) { + my $localURL = $repoInfo->{'local-url'} || ''; + next if !$localURL; + next if $localURL =~ m[^\w+:]; # anything with a protcol-spec is non-local + if (!exists $localHttpServers{$localURL}) { + my $pid + = executeInSubprocess( + $self->{'busybox-binary'}, "httpd", '-p', $port, '-h', '/', '-f' + ); + vlog(1, + _tr( + "started local HTTP-server for URL '%s' on port '%s'.", + $localURL, $port + ) + ); + $repoInfo->{'local-url'} = "http://localhost:$port$localURL"; + $localHttpServers{$localURL}->{pid} = $pid; + $localHttpServers{$localURL}->{url} = $repoInfo->{'local-url'}; + $port++; + } + else { + $repoInfo->{'local-url'} = $localHttpServers{$localURL}->{url}; + } + } + return; } sub _setupStage1A { - my $self = shift; - - vlog(1, "setting up stage1a for $self->{'vendor-os-name'}..."); - - # specify individual paths for the respective substages: - $self->{stage1aDir} = "$self->{'vendor-os-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 (slxsystem("mkdir -p $stage1cDir")) { - die _tr("unable to create directory '%s', giving up! (%s)\n", - $stage1cDir, $!); - } - - $self->_stage1A_createBusyboxEnvironment(); - $self->_stage1A_copyPrerequiredFiles(); - $self->_stage1A_copyTrustedPackageKeys(); - $self->_stage1A_createRequiredFiles(); - return; + my $self = shift; + + vlog(1, "setting up stage1a for $self->{'vendor-os-name'}..."); + + # specify individual paths for the respective substages: + $self->{stage1aDir} = "$self->{'vendor-os-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 (slxsystem("mkdir -p $stage1cDir")) { + die _tr("unable to create directory '%s', giving up! (%s)\n", + $stage1cDir, $!); + } + + $self->_stage1A_createBusyboxEnvironment(); + $self->_stage1A_copyPrerequiredFiles(); + $self->_stage1A_copyTrustedPackageKeys(); + $self->_stage1A_createRequiredFiles(); + return; } sub _stage1A_createBusyboxEnvironment { - my $self = shift; - - # copy busybox and all required binaries into stage1a-dir: - vlog(1, "creating busybox-environment..."); - my $requiredLibs = copyBinaryWithRequiredLibs({ - 'binary' => $self->{'busybox-binary'}, - 'targetFolder' => "$self->{stage1aDir}/bin", - 'libTargetFolder' => $self->{stage1aDir}, - 'targetName' => 'busybox', - }); - my $libcFolder; - foreach my $lib (split "\n", $requiredLibs) { - if ($lib =~ m[/libc.so.\d\s*$]) { - # note target folder of libc, as we need to copy the resolver libs - # into the same place: - $libcFolder = dirname($lib); - } - } - - # create all needed links to busybox: - my $links - = slurpFile("$openslxConfig{'base-path'}/share/busybox/busybox.links"); - foreach my $linkTarget (split "\n", $links) { - linkFile('/bin/busybox', "$self->{stage1aDir}/$linkTarget"); - } - if ($self->_hostIs64Bit()) { - if (!-e "$self->{stage1aDir}/lib64") { - linkFile('/lib', "$self->{stage1aDir}/lib64"); - } - if (!-e "$self->{stage1aDir}/usr/lib64") { - linkFile('/usr/lib', "$self->{stage1aDir}/usr/lib64"); - } - } - - $self->_stage1A_setupResolver($libcFolder); - return; + my $self = shift; + + # copy busybox and all required binaries into stage1a-dir: + vlog(1, "creating busybox-environment..."); + my $requiredLibs = copyBinaryWithRequiredLibs({ + 'binary' => $self->{'busybox-binary'}, + 'targetFolder' => "$self->{stage1aDir}/bin", + 'libTargetFolder' => $self->{stage1aDir}, + 'targetName' => 'busybox', + }); + my $libcFolder; + foreach my $lib (split "\n", $requiredLibs) { + if ($lib =~ m[/libc.so.\d\s*$]) { + # note target folder of libc, as we need to copy the resolver libs + # into the same place: + $libcFolder = dirname($lib); + } + } + + # create all needed links to busybox: + my $links + = slurpFile("$openslxConfig{'base-path'}/share/busybox/busybox.links"); + foreach my $linkTarget (split "\n", $links) { + linkFile('/bin/busybox', "$self->{stage1aDir}/$linkTarget"); + } + if ($self->_hostIs64Bit()) { + if (!-e "$self->{stage1aDir}/lib64") { + linkFile('/lib', "$self->{stage1aDir}/lib64"); + } + if (!-e "$self->{stage1aDir}/usr/lib64") { + linkFile('/usr/lib', "$self->{stage1aDir}/usr/lib64"); + } + } + + $self->_stage1A_setupResolver($libcFolder); + return; } sub _stage1A_setupResolver { - my $self = shift; - my $libcFolder = shift; - - if (!defined $libcFolder) { - warn _tr("unable to determine libc-target-folder, will use /lib!"); - $libcFolder = '/lib'; - } - - copyFile('/etc/resolv.conf', "$self->{stage1aDir}/etc"); - copyFile('/etc/nsswitch.conf', "$self->{stage1aDir}/etc"); - spitFile("$self->{stage1aDir}/etc/hosts", "127.0.0.1 localhost\n"); - copyFile("$libcFolder/libresolv*", "$self->{stage1aDir}$libcFolder"); - copyFile("$libcFolder/libnss_dns*", "$self->{stage1aDir}$libcFolder"); - copyFile("$libcFolder/libnss_files*", "$self->{stage1aDir}$libcFolder"); - - my $stage1cDir - = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; - copyFile('/etc/resolv.conf', "$stage1cDir/etc"); - return; + my $self = shift; + my $libcFolder = shift; + + if (!defined $libcFolder) { + warn _tr("unable to determine libc-target-folder, will use /lib!"); + $libcFolder = '/lib'; + } + + copyFile('/etc/resolv.conf', "$self->{stage1aDir}/etc"); + copyFile('/etc/nsswitch.conf', "$self->{stage1aDir}/etc"); + spitFile("$self->{stage1aDir}/etc/hosts", "127.0.0.1 localhost\n"); + copyFile("$libcFolder/libresolv*", "$self->{stage1aDir}$libcFolder"); + copyFile("$libcFolder/libnss_dns*", "$self->{stage1aDir}$libcFolder"); + copyFile("$libcFolder/libnss_files*", "$self->{stage1aDir}$libcFolder"); + + my $stage1cDir + = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; + copyFile('/etc/resolv.conf', "$stage1cDir/etc"); + return; } sub _stage1A_copyPrerequiredFiles { - my $self = shift; - - return unless -d "$self->{'shared-distro-info-dir'}/prereqfiles"; - - vlog(2, "copying folder with pre-required files..."); - my $stage1cDir - = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; - my $cmd = qq[ - tar -cp -C $self->{'shared-distro-info-dir'}/prereqfiles . \\ - | tar -xp -C $stage1cDir - ]; - if (slxsystem($cmd)) { - die _tr( - "unable to copy folder with pre-required files to folder '%s' (%s)\n", - $stage1cDir, $! - ); - } - $self->{distro}->fixPrerequiredFiles($stage1cDir); - return; + my $self = shift; + + return unless -d "$self->{'shared-distro-info-dir'}/prereqfiles"; + + vlog(2, "copying folder with pre-required files..."); + my $stage1cDir + = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; + my $cmd = qq[ + tar -cp -C $self->{'shared-distro-info-dir'}/prereqfiles . \\ + | tar -xp -C $stage1cDir + ]; + if (slxsystem($cmd)) { + die _tr( + "unable to copy folder with pre-required files to folder '%s' (%s)\n", + $stage1cDir, $! + ); + } + $self->{distro}->fixPrerequiredFiles($stage1cDir); + return; } sub _stage1A_copyTrustedPackageKeys { - my $self = shift; - - vlog(2, "copying folder with trusted package keys..."); - my $stage1bDir = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}"; - foreach my $folder ( - $self->{'shared-distro-info-dir'}, $self->{'config-distro-info-dir'} - ) { - next unless -d "$folder/trusted-package-keys"; - my $cmd = qq[ - tar -cp -C $folder trusted-package-keys \\ - | tar -xp -C $stage1bDir - ]; - if (slxsystem($cmd)) { - die _tr( - "unable to copy folder with trusted package keys to folder '%s' (%s)\n", - "$stage1bDir/trusted-package-keys", $! - ); - } - slxsystem("chmod 444 $stage1bDir/trusted-package-keys/*"); - - # install ultimately trusted keys (from distributor): - my $stage1cDir = "$stage1bDir/$self->{'stage1cSubdir'}"; - my $keyDir = "$self->{'shared-distro-info-dir'}/trusted-package-keys"; - if (-e "$keyDir/pubring.gpg") { - copyFile("$keyDir/pubring.gpg", "$stage1cDir/usr/lib/rpm/gnupg"); - } - } - return; + my $self = shift; + + vlog(2, "copying folder with trusted package keys..."); + my $stage1bDir = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}"; + foreach my $folder ( + $self->{'shared-distro-info-dir'}, $self->{'config-distro-info-dir'} + ) { + next unless -d "$folder/trusted-package-keys"; + my $cmd = qq[ + tar -cp -C $folder trusted-package-keys \\ + | tar -xp -C $stage1bDir + ]; + if (slxsystem($cmd)) { + die _tr( + "unable to copy folder with trusted package keys to folder '%s' (%s)\n", + "$stage1bDir/trusted-package-keys", $! + ); + } + slxsystem("chmod 444 $stage1bDir/trusted-package-keys/*"); + + # install ultimately trusted keys (from distributor): + my $stage1cDir = "$stage1bDir/$self->{'stage1cSubdir'}"; + my $keyDir = "$self->{'shared-distro-info-dir'}/trusted-package-keys"; + if (-e "$keyDir/pubring.gpg") { + copyFile("$keyDir/pubring.gpg", "$stage1cDir/usr/lib/rpm/gnupg"); + } + } + return; } 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 (!-e "$stage1cDir/dev/null" - && slxsystem("mknod $stage1cDir/dev/null c 1 3")) - { - die _tr( - "unable to create node '%s' (%s)\n", "$stage1cDir/dev/null", $! - ); - } - return; + 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 (!-e "$stage1cDir/dev/null" + && slxsystem("mknod $stage1cDir/dev/null c 1 3")) + { + die _tr( + "unable to create node '%s' (%s)\n", "$stage1cDir/dev/null", $! + ); + } + return; } sub _setupStage1B { - my $self = shift; + my $self = shift; - vlog(1, "setting up stage1b for $self->{'vendor-os-name'}..."); - $self->_stage1B_chrootAndBootstrap(); - return; + vlog(1, "setting up stage1b for $self->{'vendor-os-name'}..."); + $self->_stage1B_chrootAndBootstrap(); + return; } sub _stage1B_chrootAndBootstrap { - my $self = shift; - - # give packager a chance to copy required files into stage1a-folder: - $self->{packager}->prepareBootstrap($self->{stage1aDir}); - - $self->_callChrootedFunction({ - chrootDir => $self->{stage1aDir}, - function => sub { - # chdir into slxbootstrap, as we want to drop packages into there: - chdir "/$self->{stage1bSubdir}" - or die _tr( - "unable to chdir into '%s' (%s)\n", - "/$self->{stage1bSubdir}", $! - ); - - # fetch prerequired packages and use them to bootstrap the packager: - $self->{'baseURLs'} = $self->_sortRepositoryURLs( - $self->{'distro-info'}->{repository}->{base} - ); - $self->{'baseURL-index'} = 0; - my @pkgs = string2Array($self->{'distro-info'}->{'prereq-packages'}); - vlog( - 2, - "downloading these prereq packages:\n\t" . join("\n\t", @pkgs) - ); - my @prereqPkgs = $self->_downloadBaseFiles(\@pkgs); - $self->{'prereq-packages'} = \@prereqPkgs; - $self->{packager}->bootstrap(\@prereqPkgs); - - @pkgs = string2Array($self->{'distro-info'}->{'bootstrap-packages'}); - push( - @pkgs, - string2Array( - $self->{'distro-info'}->{'metapackager'} - ->{$self->{distro}->{'meta-packager-type'}}->{packages} - ) - ); - vlog( - 2, - "downloading bootstrap packages:\n\t" . join("\n\t", @pkgs) - ); - my @bootstrapPkgs = $self->_downloadBaseFiles(\@pkgs); - $self->{'bootstrap-packages'} = \@bootstrapPkgs; - }, - }); - return; + my $self = shift; + + # give packager a chance to copy required files into stage1a-folder: + $self->{packager}->prepareBootstrap($self->{stage1aDir}); + + $self->_callChrootedFunction({ + chrootDir => $self->{stage1aDir}, + function => sub { + # chdir into slxbootstrap, as we want to drop packages into there: + chdir "/$self->{stage1bSubdir}" + or die _tr( + "unable to chdir into '%s' (%s)\n", + "/$self->{stage1bSubdir}", $! + ); + + # fetch prerequired packages and use them to bootstrap the packager: + $self->{'baseURLs'} = $self->_sortRepositoryURLs( + $self->{'distro-info'}->{repository}->{base} + ); + $self->{'baseURL-index'} = 0; + my @pkgs = string2Array($self->{'distro-info'}->{'prereq-packages'}); + vlog( + 2, + "downloading these prereq packages:\n\t" . join("\n\t", @pkgs) + ); + my @prereqPkgs = $self->_downloadBaseFiles(\@pkgs); + $self->{'prereq-packages'} = \@prereqPkgs; + $self->{packager}->bootstrap(\@prereqPkgs); + + @pkgs = string2Array($self->{'distro-info'}->{'bootstrap-packages'}); + push( + @pkgs, + string2Array( + $self->{'distro-info'}->{'metapackager'} + ->{$self->{distro}->{'meta-packager-type'}}->{packages} + ) + ); + vlog( + 2, + "downloading bootstrap packages:\n\t" . join("\n\t", @pkgs) + ); + my @bootstrapPkgs = $self->_downloadBaseFiles(\@pkgs); + $self->{'bootstrap-packages'} = \@bootstrapPkgs; + }, + }); + return; } sub _setupStage1C { - my $self = shift; + my $self = shift; - vlog(1, "setting up stage1c for $self->{'vendor-os-name'}..."); - $self->_stage1C_chrootAndInstallBasicVendorOS(); - return; + vlog(1, "setting up stage1c for $self->{'vendor-os-name'}..."); + $self->_stage1C_chrootAndInstallBasicVendorOS(); + return; } sub _stage1C_chrootAndInstallBasicVendorOS { - my $self = shift; - - my $stage1bDir = "/$self->{stage1bSubdir}"; - chrootInto($stage1bDir); - - my $stage1cDir = "/$self->{stage1cSubdir}"; - - # import any additional trusted package keys to rpm-DB: - my $keyDir = "/trusted-package-keys"; - my $keyDirDH; - if (opendir($keyDirDH, $keyDir)) { - my @keyFiles - = map { "$keyDir/$_" } - grep { $_ !~ m[^(\.\.?|pubring.gpg)$] } - readdir($keyDirDH); - closedir($keyDirDH); - $self->{packager}->importTrustedPackageKeys(\@keyFiles, $stage1cDir); - } - - # install bootstrap packages - $self->{packager}->installPackages( - $self->{'bootstrap-packages'}, $stage1cDir - ); - return; + my $self = shift; + + my $stage1bDir = "/$self->{stage1bSubdir}"; + chrootInto($stage1bDir); + + my $stage1cDir = "/$self->{stage1cSubdir}"; + + # import any additional trusted package keys to rpm-DB: + my $keyDir = "/trusted-package-keys"; + my $keyDirDH; + if (opendir($keyDirDH, $keyDir)) { + my @keyFiles + = map { "$keyDir/$_" } + grep { $_ !~ m[^(\.\.?|pubring.gpg)$] } + readdir($keyDirDH); + closedir($keyDirDH); + $self->{packager}->importTrustedPackageKeys(\@keyFiles, $stage1cDir); + } + + # install bootstrap packages + $self->{packager}->installPackages( + $self->{'bootstrap-packages'}, $stage1cDir + ); + return; } sub _stage1C_cleanupBasicVendorOS { - my $self = shift; - - my $stage1cDir - = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; - if (slxsystem("mv $stage1cDir/* $self->{'vendor-os-path'}/")) { - die _tr( - "unable to move final setup to '%s' (%s)\n", - $self->{'vendor-os-path'}, $! - ); - } - if (slxsystem("rm -rf $self->{stage1aDir}")) { - die _tr( - "unable to remove temporary folder '%s' (%s)\n", - $self->{stage1aDir}, $! - ); - } - return; + my $self = shift; + + my $stage1cDir + = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; + if (slxsystem("mv $stage1cDir/* $self->{'vendor-os-path'}/")) { + die _tr( + "unable to move final setup to '%s' (%s)\n", + $self->{'vendor-os-path'}, $! + ); + } + if (slxsystem("rm -rf $self->{stage1aDir}")) { + die _tr( + "unable to remove temporary folder '%s' (%s)\n", + $self->{stage1aDir}, $! + ); + } + return; } sub _setupStage1D { - my $self = shift; - - vlog(1, "setting up stage1d for $self->{'vendor-os-name'}..."); - - $self->_callChrootedFunction({ - chrootDir => $self->{'vendor-os-path'}, - function => sub { - $self->_stage1D_setupPackageSources(); - $self->_stage1D_updateBasicVendorOS(); - $self->{distro}->preSystemInstallationHook(); - $self->_stage1D_installPackageSelection(); - $self->{distro}->postSystemInstallationHook(); - }, - updateConfig => 1, - }); - return; + my $self = shift; + + vlog(1, "setting up stage1d for $self->{'vendor-os-name'}..."); + + $self->_callChrootedFunction({ + chrootDir => $self->{'vendor-os-path'}, + function => sub { + $self->_stage1D_setupPackageSources(); + $self->_stage1D_updateBasicVendorOS(); + $self->{distro}->preSystemInstallationHook(); + $self->_stage1D_installPackageSelection(); + $self->{distro}->postSystemInstallationHook(); + }, + updateConfig => 1, + }); + return; } sub _updateStage1D { - my $self = shift; - - vlog(1, "updating $self->{'vendor-os-name'}..."); - - $self->_callChrootedFunction({ - chrootDir => $self->{'vendor-os-path'}, - function => sub { - $self->_stage1D_updateBasicVendorOS(); - }, - updateConfig => 1, - }); - return; + my $self = shift; + + vlog(1, "updating $self->{'vendor-os-name'}..."); + + $self->_callChrootedFunction({ + chrootDir => $self->{'vendor-os-path'}, + function => sub { + $self->_stage1D_updateBasicVendorOS(); + }, + updateConfig => 1, + }); + return; } sub _startChrootedShellInStage1D { - my $self = shift; - - vlog(0, "starting chrooted shell for $self->{'vendor-os-name'}"); - vlog(0, "---------------------------------------"); - vlog(0, "- please type 'exit' if you are done! -"); - vlog(0, "---------------------------------------"); - - $self->_callChrootedFunction({ - chrootDir => $self->{'vendor-os-path'}, - function => sub { - # will hang until user exits manually: - slxsystem($openslxConfig{'default-shell'}); - }, - updateConfig => 1, - }); - return; + my $self = shift; + + vlog(0, "starting chrooted shell for $self->{'vendor-os-name'}"); + vlog(0, "---------------------------------------"); + vlog(0, "- please type 'exit' if you are done! -"); + vlog(0, "---------------------------------------"); + + $self->_callChrootedFunction({ + chrootDir => $self->{'vendor-os-path'}, + function => sub { + # will hang until user exits manually: + slxsystem($openslxConfig{'default-shell'}); + }, + updateConfig => 1, + }); + return; } sub _callChrootedFunction { - my $self = shift; - my $params = shift; - - checkParams($params, { - 'chrootDir' => '!', - 'function' => '!', - 'updateConfig' => '?', - }); - - $self->{'distro'}->startSession($params->{chrootDir}); - - # invoke given function: - $params->{function}->(); - - if ($params->{updateConfig}) { - $self->{'distro'}->updateDistroConfig(); - } - $self->{'distro'}->finishSession(); - return; + my $self = shift; + my $params = shift; + + checkParams($params, { + 'chrootDir' => '!', + 'function' => '!', + 'updateConfig' => '?', + }); + + $self->{'distro'}->startSession($params->{chrootDir}); + + # invoke given function: + $params->{function}->(); + + if ($params->{updateConfig}) { + $self->{'distro'}->updateDistroConfig(); + } + $self->{'distro'}->finishSession(); + return; } sub _stage1D_setupPackageSources { - my $self = shift; - - vlog(1, "setting up package sources for meta packager..."); - my $selectionName = $self->{'selection-name'}; - my $pkgExcludes - = $self->{'distro-info'}->{excludes}->{$selectionName}->{packages}; - my $excludeList = join ' ', string2Array($pkgExcludes); - $self->{'meta-packager'}->initPackageSources(); - my ($rk, $repo); - while (($rk, $repo) = each %{$self->{'distro-info'}->{repository}}) { - vlog(2, "setting up package source $rk..."); - $self->{'meta-packager'}->setupPackageSource( - $rk, $repo, $excludeList, $self->_sortRepositoryURLs($repo) - ); - } - return; + my $self = shift; + + vlog(1, "setting up package sources for meta packager..."); + my $selectionName = $self->{'selection-name'}; + my $pkgExcludes + = $self->{'distro-info'}->{excludes}->{$selectionName}->{packages}; + my $excludeList = join ' ', string2Array($pkgExcludes); + $self->{'meta-packager'}->initPackageSources(); + my ($rk, $repo); + while (($rk, $repo) = each %{$self->{'distro-info'}->{repository}}) { + vlog(2, "setting up package source $rk..."); + $self->{'meta-packager'}->setupPackageSource( + $rk, $repo, $excludeList, $self->_sortRepositoryURLs($repo) + ); + } + return; } sub _stage1D_updateBasicVendorOS { - my $self = shift; + my $self = shift; - vlog(1, "updating basic vendor-os..."); - $self->{'meta-packager'}->updateBasicVendorOS(); - return; + vlog(1, "updating basic vendor-os..."); + $self->{'meta-packager'}->updateBasicVendorOS(); + return; } sub _stage1D_installPackageSelection { - my $self = shift; - - my $selectionName = $self->{'selection-name'}; - - vlog(1, "installing package selection <$selectionName>..."); - my $selection = $self->{'distro-info'}->{selection}->{$selectionName}; - my @pkgs = string2Array($selection->{packages}); - my @installedPkgs = $self->{'packager'}->getInstalledPackages(); - @pkgs = grep { - my $pkg = $_; - if (grep { $_ eq $pkg; } @installedPkgs) { - vlog(1, "package '$pkg' filtered, it is already installed."); - 0; - } - else { - 1; - } - } @pkgs; - if (!@pkgs) { - vlog( - 0, - _tr( - "No packages listed for selection '%s', nothing to do.", - $selectionName - ) - ); - } - else { - vlog(1, "installing these packages:\n" . join("\n\t", @pkgs)); - $self->{'meta-packager'}->installPackages(join(' ', @pkgs), 1); - } - return; + my $self = shift; + + my $selectionName = $self->{'selection-name'}; + + vlog(1, "installing package selection <$selectionName>..."); + my $selection = $self->{'distro-info'}->{selection}->{$selectionName}; + my @pkgs = string2Array($selection->{packages}); + my @installedPkgs = $self->{'packager'}->getInstalledPackages(); + @pkgs = grep { + my $pkg = $_; + if (grep { $_ eq $pkg; } @installedPkgs) { + vlog(1, "package '$pkg' filtered, it is already installed."); + 0; + } + else { + 1; + } + } @pkgs; + if (!@pkgs) { + vlog( + 0, + _tr( + "No packages listed for selection '%s', nothing to do.", + $selectionName + ) + ); + } + else { + vlog(1, "installing these packages:\n" . join("\n\t", @pkgs)); + $self->{'meta-packager'}->installPackages(join(' ', @pkgs), 1); + } + return; } sub _clone_fetchSource { - my $self = shift; - my $source = shift; - - vlog( - 0, - _tr( - "Cloning vendor-OS from '%s' to '%s'...\n", $source, - $self->{'vendor-os-path'} - ) - ); - my $excludeIncludeList = $self->_clone_determineIncludeExcludeList(); - vlog(1, "using exclude-include-filter:\n$excludeIncludeList\n"); - my $additionalRsyncOptions = $ENV{SLX_RSYNC_OPTIONS} || ''; - my $rsyncCmd - = "rsync -av --delete --exclude-from=- $additionalRsyncOptions" - . " $source $self->{'vendor-os-path'}"; - vlog(2, "executing: $rsyncCmd\n"); - my $rsyncFH; - open($rsyncFH, '|-', $rsyncCmd) - or croak( - _tr( - "unable to start rsync for source '%s', giving up! (%s)\n", - $source, $! - ) - ); - print $rsyncFH $excludeIncludeList; - close($rsyncFH) - or croak _tr( - "unable to clone from source '%s', giving up! (%s)\n", $source, $! - ); - return; + my $self = shift; + my $source = shift; + + vlog( + 0, + _tr( + "Cloning vendor-OS from '%s' to '%s'...\n", $source, + $self->{'vendor-os-path'} + ) + ); + my $excludeIncludeList = $self->_clone_determineIncludeExcludeList(); + vlog(1, "using exclude-include-filter:\n$excludeIncludeList\n"); + my $additionalRsyncOptions = $ENV{SLX_RSYNC_OPTIONS} || ''; + my $rsyncCmd + = "rsync -av --delete --exclude-from=- $additionalRsyncOptions" + . " $source $self->{'vendor-os-path'}"; + vlog(2, "executing: $rsyncCmd\n"); + my $rsyncFH; + open($rsyncFH, '|-', $rsyncCmd) + or croak( + _tr( + "unable to start rsync for source '%s', giving up! (%s)\n", + $source, $! + ) + ); + print $rsyncFH $excludeIncludeList; + close($rsyncFH) + or croak _tr( + "unable to clone from source '%s', giving up! (%s)\n", $source, $! + ); + return; } sub _clone_determineIncludeExcludeList { - my $self = shift; + my $self = shift; - my $localFilterFile - = "$openslxConfig{'config-path'}/distro-info/clone-filter"; - my $includeExcludeList - = slurpFile($localFilterFile, { failIfMissing => 0 }); - $includeExcludeList .= $self->{distro}->{'clone-filter'}; - $includeExcludeList =~ s[^\s+][]igms; + my $localFilterFile + = "$openslxConfig{'config-path'}/distro-info/clone-filter"; + my $includeExcludeList + = slurpFile($localFilterFile, { failIfMissing => 0 }); + $includeExcludeList .= $self->{distro}->{'clone-filter'}; + $includeExcludeList =~ s[^\s+][]igms; - # remove any leading whitespace, as rsync doesn't like it - return $includeExcludeList; + # remove any leading whitespace, as rsync doesn't like it + return $includeExcludeList; } sub _installPlugins { - my $self = shift; - my $plugins = shift; - - my $isReInstall = 0; - - if (!$plugins) { - $plugins = []; - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - # fetch plugins from existing vendor-OS - my $vendorOS = $openslxDB->fetchVendorOSByFilter({ - 'name' => $self->{'vendor-os-name'} - }); - if ($vendorOS) { - push @$plugins, $openslxDB->fetchInstalledPlugins($vendorOS->{id}); - $isReInstall = 1; - } - $openslxDB->disconnect(); - } - - return if ! @$plugins; - - require OpenSLX::OSPlugin::Engine; - vlog( - 0, - $isReInstall - ? _tr("reinstalling plugins...\n") - : _tr("installing default plugins...\n") - ); - for my $pluginInfo (@$plugins) { - my $pluginName = $pluginInfo->{plugin_name}; - my $pluginEngine = OpenSLX::OSPlugin::Engine->new(); - vlog(0, _tr("\t%s\n", $pluginName)); - $pluginEngine->initialize( - $pluginName, $self->{'vendor-os-name'}, $pluginInfo->{attrs} - ); - $pluginEngine->installPlugin(); - } - vlog(0, _tr("done with plugins.\n")); - - return; + my $self = shift; + my $plugins = shift; + + my $isReInstall = 0; + + if (!$plugins) { + $plugins = []; + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + # fetch plugins from existing vendor-OS + my $vendorOS = $openslxDB->fetchVendorOSByFilter({ + 'name' => $self->{'vendor-os-name'} + }); + if ($vendorOS) { + push @$plugins, $openslxDB->fetchInstalledPlugins($vendorOS->{id}); + $isReInstall = 1; + } + $openslxDB->disconnect(); + } + + return if ! @$plugins; + + require OpenSLX::OSPlugin::Engine; + vlog( + 0, + $isReInstall + ? _tr("reinstalling plugins...\n") + : _tr("installing default plugins...\n") + ); + for my $pluginInfo (@$plugins) { + my $pluginName = $pluginInfo->{plugin_name}; + my $pluginEngine = OpenSLX::OSPlugin::Engine->new(); + vlog(0, _tr("\t%s\n", $pluginName)); + $pluginEngine->initialize( + $pluginName, $self->{'vendor-os-name'}, $pluginInfo->{attrs} + ); + $pluginEngine->installPlugin(); + } + vlog(0, _tr("done with plugins.\n")); + + return; } - + ################################################################################ ### utility methods ################################################################################ sub _changePersonalityIfNeeded { - my $self = shift; - - my $distroName = $self->{'distro-name'}; - if ($self->_hostIs64Bit() && $distroName !~ m[_64]) { - # trying to handle a 32-bit vendor-OS on a 64-bit machine, so we change - # the personality accordingly (from 64-bit to 32-bit): - $self->_loadPerlHeader('syscall.ph') - or die _tr("unable to load perl header '%s'\n", 'syscall.ph'); - $self->_loadPerlHeader('linux/personality.ph') - || $self->_loadPerlHeader('sys/personality.ph') - or die _tr("unable to load perl header '%s'\n", 'personality.ph'); - - syscall &SYS_personality, PER_LINUX32(); - } - return; + my $self = shift; + + my $distroName = $self->{'distro-name'}; + if ($self->_hostIs64Bit() && $distroName !~ m[_64]) { + # trying to handle a 32-bit vendor-OS on a 64-bit machine, so we change + # the personality accordingly (from 64-bit to 32-bit): + $self->_loadPerlHeader('syscall.ph') + or die _tr("unable to load perl header '%s'\n", 'syscall.ph'); + $self->_loadPerlHeader('linux/personality.ph') + || $self->_loadPerlHeader('sys/personality.ph') + or die _tr("unable to load perl header '%s'\n", 'personality.ph'); + + syscall &SYS_personality, PER_LINUX32(); + } + return; } sub _loadPerlHeader { - my $self = shift; - my $phFile = shift; - - if (!eval { require $phFile }) { - # perl-header has not been provided by host-OS, so we create it - # manually from C-header (via h2ph): - (my $hFile = $phFile) =~ s{\.ph$}{.h}; - return if !-e "/usr/include/$hFile"; - my $libDir = "$openslxConfig{'base-path'}/lib"; - slxsystem("cd /usr/include && h2ph -d $libDir $hFile") == 0 - or die _tr("unable to create %s! (%s)", $phFile, $!); - } - return eval { require $phFile; 1 }; + my $self = shift; + my $phFile = shift; + + if (!eval { require $phFile }) { + # perl-header has not been provided by host-OS, so we create it + # manually from C-header (via h2ph): + (my $hFile = $phFile) =~ s{\.ph$}{.h}; + return if !-e "/usr/include/$hFile"; + my $libDir = "$openslxConfig{'base-path'}/lib"; + slxsystem("cd /usr/include && h2ph -d $libDir $hFile") == 0 + or die _tr("unable to create %s! (%s)", $phFile, $!); + } + return eval { require $phFile; 1 }; } sub _hostIs64Bit { - my $self = shift; + my $self = shift; - $self->{arch} = `uname -m` unless defined $self->{arch}; - return ($self->{arch} =~ m[64]); + $self->{arch} = `uname -m` unless defined $self->{arch}; + return ($self->{arch} =~ m[64]); } 1; diff --git a/installer/OpenSLX/OSSetup/MetaPackager/Base.pm b/installer/OpenSLX/OSSetup/MetaPackager/Base.pm index 517e9f9a..af789888 100644 --- a/installer/OpenSLX/OSSetup/MetaPackager/Base.pm +++ b/installer/OpenSLX/OSSetup/MetaPackager/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSSetup::MetaPackager API. +# - provides empty base of the OpenSLX OSSetup::MetaPackager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::MetaPackager::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -25,16 +25,16 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Creating OpenSLX::OSSetup::MetaPackager::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSSetup::MetaPackager::Base-objects directly makes no sense!"; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->{'engine'} = $engine; - return; + $self->{'engine'} = $engine; + return; } sub initPackageSources diff --git a/installer/OpenSLX/OSSetup/MetaPackager/apt.pm b/installer/OpenSLX/OSSetup/MetaPackager/apt.pm index a8a4f91e..ecb87a35 100644 --- a/installer/OpenSLX/OSSetup/MetaPackager/apt.pm +++ b/installer/OpenSLX/OSSetup/MetaPackager/apt.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # apt.pm -# - provides apt-get-specific overrides of the OpenSLX::OSSetup::MetaPackager API. +# - provides apt-get-specific overrides of the OpenSLX::OSSetup::MetaPackager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::MetaPackager::apt; @@ -26,117 +26,117 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'apt', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'apt', + }; + return bless $self, $class; } sub initPackageSources { - my $self = shift; - - $ENV{LC_ALL} = 'POSIX'; - - # remove any existing sources - slxsystem('rm -f /etc/apt/sources.list'); - - # create default timezone if there isn't any - if (!-e '/etc/timezone') { - spitFile('/etc/timezone', "$openslxConfig{'default-timezone'}\n"); - } - - # create kernel config if there isn't any - if (!-e '/etc/kernel-img.conf') { - my $kernelConfig = unshiftHereDoc(<<" END-OF-HERE"); - # Kernel image management overrides - # See kernel-img.conf(5) for details - do_symlinks = yes - relative_links = yes - do_bootloader = no - do_bootfloppy = no - do_initrd = yes - link_in_boot = yes - END-OF-HERE - spitFile('/etc/kernel-img.conf', $kernelConfig); - } - - return 1; + my $self = shift; + + $ENV{LC_ALL} = 'POSIX'; + + # remove any existing sources + slxsystem('rm -f /etc/apt/sources.list'); + + # create default timezone if there isn't any + if (!-e '/etc/timezone') { + spitFile('/etc/timezone', "$openslxConfig{'default-timezone'}\n"); + } + + # create kernel config if there isn't any + if (!-e '/etc/kernel-img.conf') { + my $kernelConfig = unshiftHereDoc(<<" END-OF-HERE"); + # Kernel image management overrides + # See kernel-img.conf(5) for details + do_symlinks = yes + relative_links = yes + do_bootloader = no + do_bootfloppy = no + do_initrd = yes + link_in_boot = yes + END-OF-HERE + spitFile('/etc/kernel-img.conf', $kernelConfig); + } + + return 1; } sub setupPackageSource { - my $self = shift; - my $repoName = shift; - my $repoInfo = shift; - my $excludeList = shift; - my $repoURLs = shift; + my $self = shift; + my $repoName = shift; + my $repoInfo = shift; + my $excludeList = shift; + my $repoURLs = shift; - my $baseURL = shift @$repoURLs; - my $distribution = $repoInfo->{'distribution'}; - my $components = $repoInfo->{'components'}; + my $baseURL = shift @$repoURLs; + my $distribution = $repoInfo->{'distribution'}; + my $components = $repoInfo->{'components'}; - my $sourcesList = "deb $baseURL $distribution $components\n"; + my $sourcesList = "deb $baseURL $distribution $components\n"; - foreach my $mirrorURL (@$repoURLs) { - $sourcesList .= "deb $mirrorURL $distribution $components\n"; - } + foreach my $mirrorURL (@$repoURLs) { + $sourcesList .= "deb $mirrorURL $distribution $components\n"; + } - appendFile('/etc/apt/sources.list', $sourcesList); + appendFile('/etc/apt/sources.list', $sourcesList); - return; + return; } sub installPackages { - my $self = shift; - my $packages = shift; - my $doRefresh = shift || 0; - - $packages =~ tr{\n}{ }; - - if ($doRefresh && slxsystem("apt-get -y update")) { - die _tr("unable to update repository info (%s)\n", $!); - } - if ('/var/cache/debconf/slx-defaults.dat') { - $ENV{DEBCONF_DB_FALLBACK} - = "'File{/var/cache/debconf/slx-defaults.dat}'"; - } - $ENV{DEBIAN_FRONTEND} = 'noninteractive'; - if (slxsystem("apt-get -y install $packages")) { - die _tr("unable to install selection (%s)\n", $!); - } - delete $ENV{DEBCONF_DB_FALLBACK}; - delete $ENV{DEBIAN_FRONTEND}; - - return 1; + my $self = shift; + my $packages = shift; + my $doRefresh = shift || 0; + + $packages =~ tr{\n}{ }; + + if ($doRefresh && slxsystem("apt-get -y update")) { + die _tr("unable to update repository info (%s)\n", $!); + } + if ('/var/cache/debconf/slx-defaults.dat') { + $ENV{DEBCONF_DB_FALLBACK} + = "'File{/var/cache/debconf/slx-defaults.dat}'"; + } + $ENV{DEBIAN_FRONTEND} = 'noninteractive'; + if (slxsystem("apt-get -y install $packages")) { + die _tr("unable to install selection (%s)\n", $!); + } + delete $ENV{DEBCONF_DB_FALLBACK}; + delete $ENV{DEBIAN_FRONTEND}; + + return 1; } sub removePackages { - my $self = shift; - my $pkgSelection = shift; + my $self = shift; + my $pkgSelection = shift; - if (slxsystem("apt-get -y remove $pkgSelection")) { - die _tr("unable to remove selection (%s)\n", $!); - } + if (slxsystem("apt-get -y remove $pkgSelection")) { + die _tr("unable to remove selection (%s)\n", $!); + } - return 1; + return 1; } sub updateBasicVendorOS { - my $self = shift; + my $self = shift; - if (slxsystem("apt-get -y update")) { - die _tr("unable to update repository info (%s)\n", $!); - } - if (slxsystem("apt-get -y upgrade")) { - die _tr("unable to update this vendor-os (%s)\n", $!); - } + if (slxsystem("apt-get -y update")) { + die _tr("unable to update repository info (%s)\n", $!); + } + if (slxsystem("apt-get -y upgrade")) { + die _tr("unable to update this vendor-os (%s)\n", $!); + } - return 1; + return 1; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/MetaPackager/smart.pm b/installer/OpenSLX/OSSetup/MetaPackager/smart.pm index 27995e01..fc178cb7 100644 --- a/installer/OpenSLX/OSSetup/MetaPackager/smart.pm +++ b/installer/OpenSLX/OSSetup/MetaPackager/smart.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # smart.pm -# - provides smart-specific overrides of the OpenSLX::OSSetup::MetaPackager API. +# - provides smart-specific overrides of the OpenSLX::OSSetup::MetaPackager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::MetaPackager::smart; @@ -26,102 +26,102 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'smart', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'smart', + }; + return bless $self, $class; } sub initPackageSources { - my $self = shift; + my $self = shift; - $ENV{LC_ALL} = 'POSIX'; + $ENV{LC_ALL} = 'POSIX'; - # remove any existing channels - slxsystem("rm -f /etc/smart/channels/*"); - if (slxsystem("smart channel -y --remove-all")) { - die _tr("unable to remove existing channels (%s)\n", $!); - } - return 1; + # remove any existing channels + slxsystem("rm -f /etc/smart/channels/*"); + if (slxsystem("smart channel -y --remove-all")) { + die _tr("unable to remove existing channels (%s)\n", $!); + } + return 1; } sub setupPackageSource { - my $self = shift; - my $repoName = shift; - my $repoInfo = shift; - my $excludeList = shift; - my $repoURLs = shift; - - my $repoSubdir = ''; - if ($repoInfo->{'repo-subdir'}) { - $repoSubdir = "/$repoInfo->{'repo-subdir'}"; - } - my $baseURL = shift @$repoURLs; - my $repoDescr - = qq[$repoName name="$repoInfo->{name}" baseurl=$baseURL$repoSubdir]; - $repoDescr .= " type=rpm-md"; - if (slxsystem("smart channel -y --add $repoDescr")) { - die _tr("unable to add channel '%s' (%s)\n", $repoName, $!); - } - - my $mirrorDescr; - foreach my $mirrorURL (@$repoURLs) { - $mirrorDescr .= " --add $baseURL$repoSubdir $mirrorURL$repoSubdir"; - } - if (defined $mirrorDescr) { - if (slxsystem("smart mirror $mirrorDescr")) { - die _tr( - "unable to add mirrors for channel '%s' (%s)\n", - $repoName, $! - ); - } - } - return 1; + my $self = shift; + my $repoName = shift; + my $repoInfo = shift; + my $excludeList = shift; + my $repoURLs = shift; + + my $repoSubdir = ''; + if ($repoInfo->{'repo-subdir'}) { + $repoSubdir = "/$repoInfo->{'repo-subdir'}"; + } + my $baseURL = shift @$repoURLs; + my $repoDescr + = qq[$repoName name="$repoInfo->{name}" baseurl=$baseURL$repoSubdir]; + $repoDescr .= " type=rpm-md"; + if (slxsystem("smart channel -y --add $repoDescr")) { + die _tr("unable to add channel '%s' (%s)\n", $repoName, $!); + } + + my $mirrorDescr; + foreach my $mirrorURL (@$repoURLs) { + $mirrorDescr .= " --add $baseURL$repoSubdir $mirrorURL$repoSubdir"; + } + if (defined $mirrorDescr) { + if (slxsystem("smart mirror $mirrorDescr")) { + die _tr( + "unable to add mirrors for channel '%s' (%s)\n", + $repoName, $! + ); + } + } + return 1; } sub installPackages { - my $self = shift; - my $packages = shift; - my $doRefresh = shift || 0; - - $packages =~ tr{\n}{ }; - - if ($doRefresh && slxsystem("smart update")) { - die _tr("unable to update channel info (%s)\n", $!); - } - if (slxsystem("smart install -y $packages")) { - die _tr("unable to install selection (%s)\n", $!); - } - return 1; + my $self = shift; + my $packages = shift; + my $doRefresh = shift || 0; + + $packages =~ tr{\n}{ }; + + if ($doRefresh && slxsystem("smart update")) { + die _tr("unable to update channel info (%s)\n", $!); + } + if (slxsystem("smart install -y $packages")) { + die _tr("unable to install selection (%s)\n", $!); + } + return 1; } sub removePackages { - my $self = shift; - my $pkgSelection = shift; + my $self = shift; + my $pkgSelection = shift; - if (slxsystem("smart remove -y $pkgSelection")) { - die _tr("unable to remove selection (%s)\n", $!); - } - return 1; + if (slxsystem("smart remove -y $pkgSelection")) { + die _tr("unable to remove selection (%s)\n", $!); + } + return 1; } sub updateBasicVendorOS { - my $self = shift; - - if (slxsystem("smart upgrade -y --update")) { - if ($! == 2) { - # file not found => smart isn't installed - die _tr("unable to update this vendor-os, as it seems to lack an installation of smart!\n"); - } - die _tr("unable to update this vendor-os (%s)\n", $!); - } - return 1; + my $self = shift; + + if (slxsystem("smart upgrade -y --update")) { + if ($! == 2) { + # file not found => smart isn't installed + die _tr("unable to update this vendor-os, as it seems to lack an installation of smart!\n"); + } + die _tr("unable to update this vendor-os (%s)\n", $!); + } + return 1; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/MetaPackager/yum.pm b/installer/OpenSLX/OSSetup/MetaPackager/yum.pm index eef310fe..a48f6c36 100644 --- a/installer/OpenSLX/OSSetup/MetaPackager/yum.pm +++ b/installer/OpenSLX/OSSetup/MetaPackager/yum.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # yum.pm -# - provides yum-specific overrides of the OpenSLX::OSSetup::MetaPackager API. +# - provides yum-specific overrides of the OpenSLX::OSSetup::MetaPackager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::MetaPackager::yum; @@ -26,90 +26,90 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'yum', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'yum', + }; + return bless $self, $class; } sub initPackageSources { - my $self = shift; + my $self = shift; - $ENV{LC_ALL} = 'POSIX'; + $ENV{LC_ALL} = 'POSIX'; - slxsystem("rm -f /etc/yum.repos.d/*"); - slxsystem("mkdir -p /etc/yum.repos.d"); + slxsystem("rm -f /etc/yum.repos.d/*"); + slxsystem("mkdir -p /etc/yum.repos.d"); - return 1; + return 1; } sub setupPackageSource { - my $self = shift; - my $repoName = shift; - my $repoInfo = shift; - my $excludeList = shift; - my $repoURLs = shift; - - my $repoSubdir; - if (length($repoInfo->{'repo-subdir'})) { - $repoSubdir = "/$repoInfo->{'repo-subdir'}"; - } - my $baseURL = shift @$repoURLs; - - my $repoDescr - = "[$repoName]\nname=$repoInfo->{name}\nbaseurl=$baseURL$repoSubdir\n"; - - foreach my $mirrorURL (@$repoURLs) { - $repoDescr .= " $mirrorURL$repoSubdir\n"; - } - my $repoFile = "/etc/yum.repos.d/$repoName.repo"; - spitFile($repoFile, "$repoDescr\nexclude=$excludeList\n"); - - return 1; + my $self = shift; + my $repoName = shift; + my $repoInfo = shift; + my $excludeList = shift; + my $repoURLs = shift; + + my $repoSubdir; + if (length($repoInfo->{'repo-subdir'})) { + $repoSubdir = "/$repoInfo->{'repo-subdir'}"; + } + my $baseURL = shift @$repoURLs; + + my $repoDescr + = "[$repoName]\nname=$repoInfo->{name}\nbaseurl=$baseURL$repoSubdir\n"; + + foreach my $mirrorURL (@$repoURLs) { + $repoDescr .= " $mirrorURL$repoSubdir\n"; + } + my $repoFile = "/etc/yum.repos.d/$repoName.repo"; + spitFile($repoFile, "$repoDescr\nexclude=$excludeList\n"); + + return 1; } sub installPackages { - my $self = shift; - my $packages = shift; + my $self = shift; + my $packages = shift; - $packages =~ tr{\n}{ }; + $packages =~ tr{\n}{ }; - if (slxsystem("yum -y install $packages")) { - die _tr("unable to install selection (%s)\n", $!); - } + if (slxsystem("yum -y install $packages")) { + die _tr("unable to install selection (%s)\n", $!); + } - return 1; + return 1; } sub removePackages { - my $self = shift; - my $pkgSelection = shift; + my $self = shift; + my $pkgSelection = shift; - if (slxsystem("yum -y remove $pkgSelection")) { - die _tr("unable to remove selection (%s)\n", $!); - } + if (slxsystem("yum -y remove $pkgSelection")) { + die _tr("unable to remove selection (%s)\n", $!); + } - return 1; + return 1; } sub updateBasicVendorOS { - my $self = shift; + my $self = shift; - if (slxsystem("yum -y update")) { - if ($! == 2) { - # file not found => yum isn't installed - die _tr("unable to update this vendor-os, as it seems to lack an installation of yum!\n"); - } - die _tr("unable to update this vendor-os (%s)\n", $!); - } + if (slxsystem("yum -y update")) { + if ($! == 2) { + # file not found => yum isn't installed + die _tr("unable to update this vendor-os, as it seems to lack an installation of yum!\n"); + } + die _tr("unable to update this vendor-os (%s)\n", $!); + } - return 1; + return 1; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/MetaPackager/zypper.pm b/installer/OpenSLX/OSSetup/MetaPackager/zypper.pm index 9a732af0..04d16bad 100644 --- a/installer/OpenSLX/OSSetup/MetaPackager/zypper.pm +++ b/installer/OpenSLX/OSSetup/MetaPackager/zypper.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # zypper.pm -# - provides zypper-specific overrides of the OpenSLX::OSSetup::MetaPackager API. +# - provides zypper-specific overrides of the OpenSLX::OSSetup::MetaPackager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::MetaPackager::zypper; @@ -26,88 +26,88 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'zypper', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'zypper', + }; + return bless $self, $class; } sub initPackageSources { - my $self = shift; + my $self = shift; - $ENV{LC_ALL} = 'POSIX'; + $ENV{LC_ALL} = 'POSIX'; - # remove any existing channels - slxsystem("rm -f /etc/zypp/repos.d/*"); + # remove any existing channels + slxsystem("rm -f /etc/zypp/repos.d/*"); - return 1; + return 1; } sub setupPackageSource { - my $self = shift; - my $repoName = shift; - my $repoInfo = shift; - my $excludeList = shift; - my $repoURLs = shift; - - my $repoSubdir = ''; - if (length($repoInfo->{'repo-subdir'})) { - $repoSubdir = "/$repoInfo->{'repo-subdir'}"; - } - my $baseURL = shift @$repoURLs; - if (slxsystem("zypper addrepo -n $baseURL$repoSubdir $repoName")) { - die _tr("unable to add repo '%s' (%s)\n", $repoName, $!); - } - - return 1; + my $self = shift; + my $repoName = shift; + my $repoInfo = shift; + my $excludeList = shift; + my $repoURLs = shift; + + my $repoSubdir = ''; + if (length($repoInfo->{'repo-subdir'})) { + $repoSubdir = "/$repoInfo->{'repo-subdir'}"; + } + my $baseURL = shift @$repoURLs; + if (slxsystem("zypper addrepo -n $baseURL$repoSubdir $repoName")) { + die _tr("unable to add repo '%s' (%s)\n", $repoName, $!); + } + + return 1; } sub installPackages { - my $self = shift; - my $packages = shift; - my $doRefresh = shift || 0; + my $self = shift; + my $packages = shift; + my $doRefresh = shift || 0; - $packages =~ tr{\n}{ }; + $packages =~ tr{\n}{ }; - if ($doRefresh && slxsystem("zypper --non-interactive refresh")) { - die _tr("unable to update repo info (%s)\n", $!); - } - if (slxsystem("zypper --non-interactive install $packages")) { - die _tr("unable to install selection (%s)\n", $!); - } + if ($doRefresh && slxsystem("zypper --non-interactive refresh")) { + die _tr("unable to update repo info (%s)\n", $!); + } + if (slxsystem("zypper --non-interactive install $packages")) { + die _tr("unable to install selection (%s)\n", $!); + } - return 1; + return 1; } sub removePackages { - my $self = shift; - my $pkgSelection = shift; + my $self = shift; + my $pkgSelection = shift; - if (slxsystem("zypper --non-interactive remove $pkgSelection")) { - die _tr("unable to remove selection (%s)\n", $!); - } + if (slxsystem("zypper --non-interactive remove $pkgSelection")) { + die _tr("unable to remove selection (%s)\n", $!); + } - return 1; + return 1; } sub updateBasicVendorOS { - my $self = shift; + my $self = shift; - if (slxsystem("zypper --non-interactive update")) { - if ($! == 2) { - # file not found => zypper isn't installed - die _tr("unable to update this vendor-os, as it seems to lack an installation of zypper!\n"); - } - die _tr("unable to update this vendor-os (%s)\n", $!); - } + if (slxsystem("zypper --non-interactive update")) { + if ($! == 2) { + # file not found => zypper isn't installed + die _tr("unable to update this vendor-os, as it seems to lack an installation of zypper!\n"); + } + die _tr("unable to update this vendor-os (%s)\n", $!); + } - return 1; + return 1; } 1; \ No newline at end of file diff --git a/installer/OpenSLX/OSSetup/Packager/Base.pm b/installer/OpenSLX/OSSetup/Packager/Base.pm index 55211183..747ba7e4 100644 --- a/installer/OpenSLX/OSSetup/Packager/Base.pm +++ b/installer/OpenSLX/OSSetup/Packager/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSSetup::Packager API. +# - provides empty base of the OpenSLX OSSetup::Packager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Packager::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; @@ -25,16 +25,16 @@ use OpenSLX::Basics; ################################################################################ sub new { - confess "Creating OpenSLX::OSSetup::Packager::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSSetup::Packager::Base-objects directly makes no sense!"; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->{'engine'} = $engine; - return; + $self->{'engine'} = $engine; + return; } sub prepareBootstrap diff --git a/installer/OpenSLX/OSSetup/Packager/dpkg.pm b/installer/OpenSLX/OSSetup/Packager/dpkg.pm index 573c2054..94aff9c6 100644 --- a/installer/OpenSLX/OSSetup/Packager/dpkg.pm +++ b/installer/OpenSLX/OSSetup/Packager/dpkg.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # rpm.pm -# - provides rpm-specific overrides of the OpenSLX::OSSetup::Packager API. +# - provides rpm-specific overrides of the OpenSLX::OSSetup::Packager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Packager::dpkg; @@ -26,77 +26,77 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'dpkg', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'dpkg', + }; + return bless $self, $class; } sub prepareBootstrap { - my $self = shift; - my $stage1aDir = shift; - - copyBinaryWithRequiredLibs({ - 'binary' => '/usr/bin/perl', - 'targetFolder' => "$stage1aDir/usr/bin", - 'libTargetFolder' => $stage1aDir, - }); + my $self = shift; + my $stage1aDir = shift; + + copyBinaryWithRequiredLibs({ + 'binary' => '/usr/bin/perl', + 'targetFolder' => "$stage1aDir/usr/bin", + 'libTargetFolder' => $stage1aDir, + }); } sub bootstrap { - my $self = shift; - my $pkgs = shift; + my $self = shift; + my $pkgs = shift; - my $debootstrapPkg = $pkgs->[0]; - chdir '..'; - vlog(2, "unpacking debootstrap ..."); - if (slxsystem("ash", "-c", "ar x slxbootstrap/$debootstrapPkg")) { - die _tr("unable to unarchive package '%s' (%s)", $debootstrapPkg, $!); - } - if (slxsystem("ash", "-c", "tar xzf data.tar.gz")) { - die _tr("unable to untar 'data.tar.gz (%s)", $!); - } - if (slxsystem("ash", "-c", "rm -f debian-binary *.tar.gz")) { - die _tr("unable to cleanup package '%s' (%s)", $debootstrapPkg, $!); - } - my $arch = $self->{engine}->{'distro-info'}->{arch}; - my $releaseName = $self->{engine}->{'distro-info'}->{'release-name'}; - my $baseURL = $self->{engine}->{baseURLs}->[0]; - my $debootstrapCmd = unshiftHereDoc(<<" END-OF-HERE"); - /usr/sbin/debootstrap --arch $arch $releaseName \\ - /slxbootstrap/slxfinal $baseURL - END-OF-HERE - if (slxsystem("ash", "-c", ". $debootstrapCmd")) { - die _tr("unable to run debootstrap (%s)", $!); - } - return; + my $debootstrapPkg = $pkgs->[0]; + chdir '..'; + vlog(2, "unpacking debootstrap ..."); + if (slxsystem("ash", "-c", "ar x slxbootstrap/$debootstrapPkg")) { + die _tr("unable to unarchive package '%s' (%s)", $debootstrapPkg, $!); + } + if (slxsystem("ash", "-c", "tar xzf data.tar.gz")) { + die _tr("unable to untar 'data.tar.gz (%s)", $!); + } + if (slxsystem("ash", "-c", "rm -f debian-binary *.tar.gz")) { + die _tr("unable to cleanup package '%s' (%s)", $debootstrapPkg, $!); + } + my $arch = $self->{engine}->{'distro-info'}->{arch}; + my $releaseName = $self->{engine}->{'distro-info'}->{'release-name'}; + my $baseURL = $self->{engine}->{baseURLs}->[0]; + my $debootstrapCmd = unshiftHereDoc(<<" END-OF-HERE"); + /usr/sbin/debootstrap --arch $arch $releaseName \\ + /slxbootstrap/slxfinal $baseURL + END-OF-HERE + if (slxsystem("ash", "-c", ". $debootstrapCmd")) { + die _tr("unable to run debootstrap (%s)", $!); + } + return; } sub installPackages { - my $self = shift; - my $pkgs = shift; - my $finalPath = shift; + my $self = shift; + my $pkgs = shift; + my $finalPath = shift; - return unless defined $pkgs && @$pkgs; + return unless defined $pkgs && @$pkgs; - if (slxsystem("dpkg", "--root=$finalPath", "--install", @$pkgs)) { - die _tr("error during package-installation (%s)\n", $!); - } - return; + if (slxsystem("dpkg", "--root=$finalPath", "--install", @$pkgs)) { + die _tr("error during package-installation (%s)\n", $!); + } + return; } sub getInstalledPackages { - my $self = shift; + my $self = shift; - my $rpmCmd = 'dpkg-query --showformat "\${package}\n" --show'; - my $pkgList = qx{$rpmCmd}; - return split "\n", $pkgList; + my $rpmCmd = 'dpkg-query --showformat "\${package}\n" --show'; + my $pkgList = qx{$rpmCmd}; + return split "\n", $pkgList; } 1; diff --git a/installer/OpenSLX/OSSetup/Packager/rpm.pm b/installer/OpenSLX/OSSetup/Packager/rpm.pm index db1e7e1f..8a86a3d2 100644 --- a/installer/OpenSLX/OSSetup/Packager/rpm.pm +++ b/installer/OpenSLX/OSSetup/Packager/rpm.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # rpm.pm -# - provides rpm-specific overrides of the OpenSLX::OSSetup::Packager API. +# - provides rpm-specific overrides of the OpenSLX::OSSetup::Packager API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Packager::rpm; @@ -25,65 +25,65 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = { - 'name' => 'rpm', - }; - return bless $self, $class; + my $class = shift; + my $self = { + 'name' => 'rpm', + }; + return bless $self, $class; } sub bootstrap { - my $self = shift; - my $pkgs = shift; + my $self = shift; + my $pkgs = shift; - foreach my $pkg (@$pkgs) { - vlog(2, "unpacking package $pkg..."); - if (slxsystem("ash", "-c", "rpm2cpio $pkg | cpio -i -d -u")) { - die _tr("unable to unpack package <%s> (%s)", $pkg, $!); - } - } - return; + foreach my $pkg (@$pkgs) { + vlog(2, "unpacking package $pkg..."); + if (slxsystem("ash", "-c", "rpm2cpio $pkg | cpio -i -d -u")) { + die _tr("unable to unpack package <%s> (%s)", $pkg, $!); + } + } + return; } sub importTrustedPackageKeys { - my $self = shift; - my $keyFiles = shift; - my $finalPath = shift; + my $self = shift; + my $keyFiles = shift; + my $finalPath = shift; - return unless defined $keyFiles; + return unless defined $keyFiles; - foreach my $keyFile (@$keyFiles) { - vlog(2, "importing package key $keyFile..."); - if (slxsystem("rpm", "--root=$finalPath", "--import", "$keyFile")) { - die _tr("unable to import package key <%s> (%s)\n", $keyFile, $!); - } - } - return; + foreach my $keyFile (@$keyFiles) { + vlog(2, "importing package key $keyFile..."); + if (slxsystem("rpm", "--root=$finalPath", "--import", "$keyFile")) { + die _tr("unable to import package key <%s> (%s)\n", $keyFile, $!); + } + } + return; } sub installPackages { - my $self = shift; - my $pkgs = shift; - my $finalPath = shift; + my $self = shift; + my $pkgs = shift; + my $finalPath = shift; - return unless defined $pkgs && scalar(@$pkgs); + return unless defined $pkgs && scalar(@$pkgs); - if (slxsystem("rpm", "--root=$finalPath", "-ivh", @$pkgs)) { - die _tr("error during package-installation (%s)\n", $!); - } - return; + if (slxsystem("rpm", "--root=$finalPath", "-ivh", @$pkgs)) { + die _tr("error during package-installation (%s)\n", $!); + } + return; } sub getInstalledPackages { - my $self = shift; + my $self = shift; - my $rpmCmd = 'rpm -qa --queryformat="%{NAME}\n"'; - my $pkgList = `$rpmCmd`; - return split "\n", $pkgList; + my $rpmCmd = 'rpm -qa --queryformat="%{NAME}\n"'; + my $pkgList = `$rpmCmd`; + return split "\n", $pkgList; } 1; diff --git a/installer/slxos-export b/installer/slxos-export index a801077d..3d14a383 100755 --- a/installer/slxos-export +++ b/installer/slxos-export @@ -38,21 +38,21 @@ use OpenSLX::Utils; my %option; GetOptions( - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'version' => \$option{versionReq}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } openslxInit(); @@ -60,109 +60,109 @@ openslxInit(); my $action = shift @ARGV || ''; if ($action =~ m[^list-ex]i) { - print _tr("List of exported vendor-OSes (exports):\n"); - foreach my $type (sort keys %supportedExportFileSystems) { - # list all image files, followed by the block devices using it: - my @files = map { - my $image = decode('utf8', $_); - $image =~ s[^.+/][]; - $image; - } - sort glob("$openslxConfig{'public-path'}/export/$type/*"); - my %imageFiles; - foreach my $file (@files) { - if ($file =~ m[^(.+)@(.+)$]) { - # it's a link referring to a block device using this image, - # we collect the name of the block device: - push @{$imageFiles{$1}}, $2; - } else { - # it's an image file, we setup an empty array of block devices: - $imageFiles{$file} = []; - } - } - print join( - '', - map { - my $devices = join(',', @{$imageFiles{$_}}); - my $name = "${_}::$type"; - if (length($devices)) { - "\t$name".substr(' ' x 30, length($name))."($devices)\n"; - } else { - "\t$name\n"; - } - } - grep { - # filter out RSYNC_TMP folders: - $_ !~ m[###]; - } - sort keys %imageFiles - ); - } + print _tr("List of exported vendor-OSes (exports):\n"); + foreach my $type (sort keys %supportedExportFileSystems) { + # list all image files, followed by the block devices using it: + my @files = map { + my $image = decode('utf8', $_); + $image =~ s[^.+/][]; + $image; + } + sort glob("$openslxConfig{'public-path'}/export/$type/*"); + my %imageFiles; + foreach my $file (@files) { + if ($file =~ m[^(.+)@(.+)$]) { + # it's a link referring to a block device using this image, + # we collect the name of the block device: + push @{$imageFiles{$1}}, $2; + } else { + # it's an image file, we setup an empty array of block devices: + $imageFiles{$file} = []; + } + } + print join( + '', + map { + my $devices = join(',', @{$imageFiles{$_}}); + my $name = "${_}::$type"; + if (length($devices)) { + "\t$name".substr(' ' x 30, length($name))."($devices)\n"; + } else { + "\t$name\n"; + } + } + grep { + # filter out RSYNC_TMP folders: + $_ !~ m[###]; + } + sort keys %imageFiles + ); + } } elsif ($action =~ m[^list-in]i) { - my @vendorOSDirs - = grep { -d $_ } glob("$openslxConfig{'private-path'}/stage1/*"); - print _tr("List of installed vendor-OSes:\n"); - print join( - '', - map { - my $vendorOS = decode('utf8', $_); - $vendorOS =~ s[^.+/][]; - "\t$vendorOS\n"; - } - sort @vendorOSDirs - ); + my @vendorOSDirs + = grep { -d $_ } glob("$openslxConfig{'private-path'}/stage1/*"); + print _tr("List of installed vendor-OSes:\n"); + print join( + '', + map { + my $vendorOS = decode('utf8', $_); + $vendorOS =~ s[^.+/][]; + "\t$vendorOS\n"; + } + sort @vendorOSDirs + ); } elsif ($action =~ m[^list-ty]i) { - print _tr("List of supported export types:\n\t"); - print join("\n\t", sort @supportedExportTypes) . "\n"; + print _tr("List of supported export types:\n\t"); + print join("\n\t", sort @supportedExportTypes) . "\n"; } elsif ($action =~ m[^export]i) { - if (scalar(@ARGV) != 2) { - print STDERR _tr( - "You need to specify exactly one vendor-os-name and one export-type!\n" - ); - pod2usage(2); - } - my $vendorOSName = shift @ARGV; - my $exportType = shift @ARGV; - - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - - # create OSExport-engine for given export type and start it: - my $engine = OpenSLX::OSExport::Engine->new; - $engine->initializeForNew($vendorOSName, $exportType); - if (!-e $engine->{'vendor-os-path'}) { - die _tr("vendor-OS '%s' doesn't exist, giving up!\n", - $engine->{'vendor-os-path'}); - } - $engine->exportVendorOS(); + if (scalar(@ARGV) != 2) { + print STDERR _tr( + "You need to specify exactly one vendor-os-name and one export-type!\n" + ); + pod2usage(2); + } + my $vendorOSName = shift @ARGV; + my $exportType = shift @ARGV; + + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + + # create OSExport-engine for given export type and start it: + my $engine = OpenSLX::OSExport::Engine->new; + $engine->initializeForNew($vendorOSName, $exportType); + if (!-e $engine->{'vendor-os-path'}) { + die _tr("vendor-OS '%s' doesn't exist, giving up!\n", + $engine->{'vendor-os-path'}); + } + $engine->exportVendorOS(); } elsif ($action =~ m[^remove]i) { - if (scalar(@ARGV) != 1) { - print STDERR _tr("You need to specify exactly one export-name!\n"); - pod2usage(2); - } - my $exportName = shift @ARGV; - - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - - # create OSExport-engine for given export type and start it: - my $engine = OpenSLX::OSExport::Engine->new; - $engine->initializeFromExisting($exportName); - $engine->purgeExport(); + if (scalar(@ARGV) != 1) { + print STDERR _tr("You need to specify exactly one export-name!\n"); + pod2usage(2); + } + my $exportName = shift @ARGV; + + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + + # create OSExport-engine for given export type and start it: + my $engine = OpenSLX::OSExport::Engine->new; + $engine->initializeFromExisting($exportName); + $engine->purgeExport(); } else { - vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); - You need to specify exactly one action: - export - list-exported - list-installed - list-types - remove - Try '%s --help' for more info. - END-OF-HERE + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one action: + export + list-exported + list-installed + list-types + remove + Try '%s --help' for more info. + END-OF-HERE } =head1 NAME diff --git a/installer/slxos-setup b/installer/slxos-setup index 1d17048d..d46030a7 100755 --- a/installer/slxos-setup +++ b/installer/slxos-setup @@ -30,7 +30,7 @@ use lib "$FindBin::RealBin"; use lib "$FindBin::RealBin/../lib"; use lib "$FindBin::RealBin/../config-db"; - # development path to config-db + # development path to config-db use OpenSLX::Basics; use OpenSLX::OSSetup::Engine; @@ -39,24 +39,24 @@ use OpenSLX::Utils; my %option; GetOptions( - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'version' => \$option{versionReq}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, ) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2) + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2) } if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } if ($> != 0) { - die _tr("Sorry, this script can only be executed by the superuser!\n"); + die _tr("Sorry, this script can only be executed by the superuser!\n"); } openslxInit(); @@ -66,130 +66,130 @@ my $action = shift @ARGV || ''; # create ossetup-engine for given distro and start it: my $engine = OpenSLX::OSSetup::Engine->new; if ($action =~ m[^import]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to give the name of the vendor-os you'd like to import!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'import'); - if (!-e $engine->{'vendor-os-path'}) { - die _tr("'%s' doesn't exist, giving up!\n", $engine->{'vendor-os-path'}); - } - $engine->addInstalledVendorOSToConfigDB(); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to give the name of the vendor-os you'd like to import!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'import'); + if (!-e $engine->{'vendor-os-path'}) { + die _tr("'%s' doesn't exist, giving up!\n", $engine->{'vendor-os-path'}); + } + $engine->addInstalledVendorOSToConfigDB(); } elsif ($action =~ m[^update]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to give the name of the vendor-os you'd like to update!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'update'); - $engine->updateVendorOS(); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to give the name of the vendor-os you'd like to update!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'update'); + $engine->updateVendorOS(); } elsif ($action =~ m[^shell]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to give the name of the vendor-os you'd like to start of shell for!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'shell'); - $engine->startChrootedShellForVendorOS(); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to give the name of the vendor-os you'd like to start of shell for!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'shell'); + $engine->startChrootedShellForVendorOS(); } elsif ($action =~ m[^install]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to give the name of the vendor-os you'd like to install!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'install'); - my $rootPassword = readPassword("root-password for new system> "); - $engine->installVendorOS({ 'root-password' => $rootPassword }); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to give the name of the vendor-os you'd like to install!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'install'); + my $rootPassword = readPassword("root-password for new system> "); + $engine->installVendorOS({ 'root-password' => $rootPassword }); } elsif ($action =~ m[^clone]i) { - my $source = shift @ARGV; - my $vendorOSName = shift @ARGV; - if (!defined $source || !defined $vendorOSName) { - print STDERR _tr("You need to specify exactly one source and one vendor-OS-name!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'clone'); - $engine->cloneVendorOS($source); + my $source = shift @ARGV; + my $vendorOSName = shift @ARGV; + if (!defined $source || !defined $vendorOSName) { + print STDERR _tr("You need to specify exactly one source and one vendor-OS-name!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'clone'); + $engine->cloneVendorOS($source); } elsif ($action =~ m[^remove]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to specify exactly one vendor-OS-name!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'remove'); - $engine->removeVendorOS(); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to specify exactly one vendor-OS-name!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'remove'); + $engine->removeVendorOS(); } elsif ($action =~ m[^list-se]i) { - my $vendorOSName = shift @ARGV; - if (!defined $vendorOSName) { - print STDERR _tr("You need to specify exactly one vendor-OS-name!\n"); - pod2usage(2); - } - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - $engine->initialize($vendorOSName, 'install'); - print _tr("List of supported selections for '%s':\n", $vendorOSName); - print join('', map { "\t$_\n" } - sort keys %{$engine->{'distro-info'}->{selection}}); + my $vendorOSName = shift @ARGV; + if (!defined $vendorOSName) { + print STDERR _tr("You need to specify exactly one vendor-OS-name!\n"); + pod2usage(2); + } + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + $engine->initialize($vendorOSName, 'install'); + print _tr("List of supported selections for '%s':\n", $vendorOSName); + print join('', map { "\t$_\n" } + sort keys %{$engine->{'distro-info'}->{selection}}); } elsif ($action =~ m[^list-su]i) { - print _tr("List of supported distros:\n"); - print join('', map { - "\t$_" - .(' 'x(20-length($_))) - ."\t($supportedDistros{$_}->{support})\n" - } - sort keys %supportedDistros); + print _tr("List of supported distros:\n"); + print join('', map { + "\t$_" + .(' 'x(20-length($_))) + ."\t($supportedDistros{$_}->{support})\n" + } + sort keys %supportedDistros); } elsif ($action =~ m[^list-in]i) { - print _tr("List of installed vendor-OSes:\n"); - print join( - '', - map { - my $vendorOS = decode('utf8', $_); - $vendorOS =~ s[^.+/][]; - "\t$vendorOS\n"; - } - grep { -d $_ } - sort glob("$openslxConfig{'private-path'}/stage1/*") - ); + print _tr("List of installed vendor-OSes:\n"); + print join( + '', + map { + my $vendorOS = decode('utf8', $_); + $vendorOS =~ s[^.+/][]; + "\t$vendorOS\n"; + } + grep { -d $_ } + sort glob("$openslxConfig{'private-path'}/stage1/*") + ); } else { - vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); - You need to specify exactly one action: - clone - import-into-db - install - list-installed - list-selections - list-supported - remove - shell - update - Try '%s --help' for more info. - END-OF-HERE + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one action: + clone + import-into-db + install + list-installed + list-selections + list-supported + remove + shell + update + Try '%s --help' for more info. + END-OF-HERE } @@ -289,9 +289,9 @@ cloned, imported or updated. It corresponds to a folder in the OpenSLX- stage1-path (usually /var/opt/openslx/stage1). The general format of a vendor-os-name is: - - + - or - -- + -- The distro-name is something like 'suse' or 'fedora', and the release-version is a numerical version, e.g. '10.1' or '6'. diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm index e5a57b15..a9e017d2 100644 --- a/lib/OpenSLX/Basics.pm +++ b/lib/OpenSLX/Basics.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Basics.pm -# - provides basic functionality of the OpenSLX config-db. +# - provides basic functionality of the OpenSLX config-db. # ----------------------------------------------------------------------------- package OpenSLX::Basics; @@ -23,14 +23,14 @@ $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = qw( - &openslxInit %openslxConfig %cmdlineConfig - &_tr &trInit - &warn &die &croak &carp &confess &cluck - &callInSubprocess &executeInSubprocess &slxsystem - &vlog - &checkParams - &instantiateClass - &addCleanupFunction &removeCleanupFunction + &openslxInit %openslxConfig %cmdlineConfig + &_tr &trInit + &warn &die &croak &carp &confess &cluck + &callInSubprocess &executeInSubprocess &slxsystem + &vlog + &checkParams + &instantiateClass + &addCleanupFunction &removeCleanupFunction ); our (%openslxConfig, %cmdlineConfig, %openslxPath); @@ -42,8 +42,8 @@ use open ':utf8'; ################################################################################ ### Module implementation ################################################################################ -require Carp; # do not import anything as we are going to overload carp - # and croak! +require Carp; # do not import anything as we are going to overload carp + # and croak! use Carp::Heavy; # use it here to have it loaded immediately, not at # the time when carp() is being invoked (which might # be at a point in time where the script executes in @@ -62,80 +62,80 @@ my $translations; # the initial content is based on environment variables or default values. # Each value may be overridden from config files and/or cmdline arguments. %openslxConfig = ( - 'db-name' => $ENV{SLX_DB_NAME} || 'openslx', - 'db-spec' => $ENV{SLX_DB_SPEC}, - 'db-type' => $ENV{SLX_DB_TYPE} || 'SQLite', - 'locale' => setlocale(LC_MESSAGES), - 'locale-charmap' => `locale charmap`, - 'base-path' => $ENV{SLX_BASE_PATH} || '/opt/openslx', - 'config-path' => $ENV{SLX_CONFIG_PATH} || '/etc/opt/openslx', - 'private-path' => $ENV{SLX_PRIVATE_PATH} || '/var/opt/openslx', - 'public-path' => $ENV{SLX_PUBLIC_PATH} || '/srv/openslx', - 'temp-path' => $ENV{SLX_TEMP_PATH} || '/tmp', - 'verbose-level' => $ENV{SLX_VERBOSE_LEVEL} || '0', - - # - # options useful during development only: - # - 'debug-confess' => '0', - - # - # extended settings follow, which are only supported by slxsettings, - # but not by any other script: - # - 'db-user' => undef, - 'db-passwd' => undef, - 'default-shell' => 'bash', - 'default-timezone' => 'Europe/Berlin', - 'mirrors-preferred-top-level-domain' => undef, - 'mirrors-to-try-count' => '20', - 'mirrors-to-use-count' => '5', - 'ossetup-max-try-count' => '5', - 'pxe-theme' => undef, - 'pxe-theme-menu-margin' => '9', + 'db-name' => $ENV{SLX_DB_NAME} || 'openslx', + 'db-spec' => $ENV{SLX_DB_SPEC}, + 'db-type' => $ENV{SLX_DB_TYPE} || 'SQLite', + 'locale' => setlocale(LC_MESSAGES), + 'locale-charmap' => `locale charmap`, + 'base-path' => $ENV{SLX_BASE_PATH} || '/opt/openslx', + 'config-path' => $ENV{SLX_CONFIG_PATH} || '/etc/opt/openslx', + 'private-path' => $ENV{SLX_PRIVATE_PATH} || '/var/opt/openslx', + 'public-path' => $ENV{SLX_PUBLIC_PATH} || '/srv/openslx', + 'temp-path' => $ENV{SLX_TEMP_PATH} || '/tmp', + 'verbose-level' => $ENV{SLX_VERBOSE_LEVEL} || '0', + + # + # options useful during development only: + # + 'debug-confess' => '0', + + # + # extended settings follow, which are only supported by slxsettings, + # but not by any other script: + # + 'db-user' => undef, + 'db-passwd' => undef, + 'default-shell' => 'bash', + 'default-timezone' => 'Europe/Berlin', + 'mirrors-preferred-top-level-domain' => undef, + 'mirrors-to-try-count' => '20', + 'mirrors-to-use-count' => '5', + 'ossetup-max-try-count' => '5', + 'pxe-theme' => undef, + 'pxe-theme-menu-margin' => '9', ); chomp($openslxConfig{'locale-charmap'}); # specification of cmdline arguments that are shared by all openslx-scripts: my %openslxCmdlineArgs = ( - # name of database, defaults to 'openslx' - 'db-name=s' => \$cmdlineConfig{'db-name'}, + # name of database, defaults to 'openslx' + 'db-name=s' => \$cmdlineConfig{'db-name'}, - # full specification of database, a special string defining the - # precise database to connect to (the contents of this string - # depend on db-type) - 'db-spec=s' => \$cmdlineConfig{'db-spec'}, + # full specification of database, a special string defining the + # precise database to connect to (the contents of this string + # depend on db-type) + 'db-spec=s' => \$cmdlineConfig{'db-spec'}, - # type of database to connect to (SQLite, mysql, ...), defaults to 'SQLite' - 'db-type=s' => \$cmdlineConfig{'db-type'}, + # type of database to connect to (SQLite, mysql, ...), defaults to 'SQLite' + 'db-type=s' => \$cmdlineConfig{'db-type'}, - # activates debug mode, this will show the lines where any error occured - # (followed by a stacktrace): - 'debug-confess' => \$cmdlineConfig{'debug-confess'}, + # activates debug mode, this will show the lines where any error occured + # (followed by a stacktrace): + 'debug-confess' => \$cmdlineConfig{'debug-confess'}, - # locale to use for translations - 'locale=s' => \$cmdlineConfig{'locale'}, + # locale to use for translations + 'locale=s' => \$cmdlineConfig{'locale'}, - # locale-charmap to use for I/O (iso-8859-1, utf-8, etc.) - 'locale-charmap=s' => \$cmdlineConfig{'locale-charmap'}, + # locale-charmap to use for I/O (iso-8859-1, utf-8, etc.) + 'locale-charmap=s' => \$cmdlineConfig{'locale-charmap'}, - # file to write logging output to, defaults to STDERR - 'logfile=s' => \$cmdlineConfig{'locale'}, + # file to write logging output to, defaults to STDERR + 'logfile=s' => \$cmdlineConfig{'locale'}, - # path to private data (which is *not* accesible by clients and contains - # database, vendorOSes and all local extensions [system specific scripts]) - 'private-path=s' => \$cmdlineConfig{'private-path'}, + # path to private data (which is *not* accesible by clients and contains + # database, vendorOSes and all local extensions [system specific scripts]) + 'private-path=s' => \$cmdlineConfig{'private-path'}, - # path to public data (which is accesible by clients and contains - # PXE-configurations, kernels, initramfs and client configurations) - 'public-path=s' => \$cmdlineConfig{'public-path'}, + # path to public data (which is accesible by clients and contains + # PXE-configurations, kernels, initramfs and client configurations) + 'public-path=s' => \$cmdlineConfig{'public-path'}, - # path to temporary data (used during demuxing) - 'temp-path=s' => \$cmdlineConfig{'temp-path'}, + # path to temporary data (used during demuxing) + 'temp-path=s' => \$cmdlineConfig{'temp-path'}, - # level of logging verbosity (0-3) - 'verbose-level=i' => \$cmdlineConfig{'verbose-level'}, + # level of logging verbosity (0-3) + 'verbose-level=i' => \$cmdlineConfig{'verbose-level'}, ); my %cleanupFunctions; @@ -148,344 +148,344 @@ $Carp::CarpLevel = 1; # ------------------------------------------------------------------------------ sub vlog { - my $minLevel = shift; - return if $minLevel > $openslxConfig{'verbose-level'}; - my $str = join("", '-' x $minLevel, @_); - if (substr($str, -1, 1) ne "\n") { - $str .= "\n"; - } - print $openslxLog $str; - return; + my $minLevel = shift; + return if $minLevel > $openslxConfig{'verbose-level'}; + my $str = join("", '-' x $minLevel, @_); + if (substr($str, -1, 1) ne "\n") { + $str .= "\n"; + } + print $openslxLog $str; + return; } # ------------------------------------------------------------------------------ sub openslxInit { - # evaluate cmdline arguments: - Getopt::Long::Configure('no_pass_through'); - GetOptions(%openslxCmdlineArgs); - - # try to read and evaluate config files: - my $configPath = $cmdlineConfig{'config-path'} - || $openslxConfig{'config-path'}; - my $sharePath = "$openslxConfig{'base-path'}/share"; - my $verboseLevel = $cmdlineConfig{'verbose-level'} || 0; - foreach my $f ("$sharePath/settings.default", "$configPath/settings", - "$ENV{HOME}/.openslx/settings") - { - next unless -e $f; - if ($verboseLevel >= 2) { - vlog(0, "reading config-file $f..."); - } - my $configObject = Config::General->new( - -AutoTrue => 1, - -ConfigFile => $f, - -LowerCaseNames => 1, - -SplitPolicy => 'equalsign', - ); - my %config = $configObject->getall(); - foreach my $key (keys %config) { - # N.B.: these config files are used by shell-scripts, too, so in - # order to comply with shell-style, the config files use shell - # syntax and an uppercase, underline-as-separator format. - # Internally, we use lowercase, minus-as-separator format, so we - # need to convert the environment variable names to our own - # internal style here (e.g. 'SLX_BASE_PATH' to 'base-path'): - my $ourKey = $key; - $ourKey =~ s[^slx_][]; - $ourKey =~ tr/_/-/; - $openslxConfig{$ourKey} = $config{$key}; - } - } - - # push any cmdline argument into our config hash, possibly overriding any - # setting from the config files: - while (my ($key, $val) = each(%cmdlineConfig)) { - next unless defined $val; - $openslxConfig{$key} = $val; - } - - if (defined $openslxConfig{'logfile'}) { - open($openslxLog, '>>', $openslxConfig{'logfile'}) - or croak( - _tr( - "unable to append to logfile '%s'! (%s)", - $openslxConfig{'logfile'}, $! - ) - ); - } - if ($openslxConfig{'verbose-level'} >= 2) { - foreach my $key (sort keys %openslxConfig) { - my $val = $openslxConfig{$key} || ''; - vlog(2, "config-dump: $key = $val"); - } - } - - # setup translation "engine": - trInit(); - - return 1; + # evaluate cmdline arguments: + Getopt::Long::Configure('no_pass_through'); + GetOptions(%openslxCmdlineArgs); + + # try to read and evaluate config files: + my $configPath = $cmdlineConfig{'config-path'} + || $openslxConfig{'config-path'}; + my $sharePath = "$openslxConfig{'base-path'}/share"; + my $verboseLevel = $cmdlineConfig{'verbose-level'} || 0; + foreach my $f ("$sharePath/settings.default", "$configPath/settings", + "$ENV{HOME}/.openslx/settings") + { + next unless -e $f; + if ($verboseLevel >= 2) { + vlog(0, "reading config-file $f..."); + } + my $configObject = Config::General->new( + -AutoTrue => 1, + -ConfigFile => $f, + -LowerCaseNames => 1, + -SplitPolicy => 'equalsign', + ); + my %config = $configObject->getall(); + foreach my $key (keys %config) { + # N.B.: these config files are used by shell-scripts, too, so in + # order to comply with shell-style, the config files use shell + # syntax and an uppercase, underline-as-separator format. + # Internally, we use lowercase, minus-as-separator format, so we + # need to convert the environment variable names to our own + # internal style here (e.g. 'SLX_BASE_PATH' to 'base-path'): + my $ourKey = $key; + $ourKey =~ s[^slx_][]; + $ourKey =~ tr/_/-/; + $openslxConfig{$ourKey} = $config{$key}; + } + } + + # push any cmdline argument into our config hash, possibly overriding any + # setting from the config files: + while (my ($key, $val) = each(%cmdlineConfig)) { + next unless defined $val; + $openslxConfig{$key} = $val; + } + + if (defined $openslxConfig{'logfile'}) { + open($openslxLog, '>>', $openslxConfig{'logfile'}) + or croak( + _tr( + "unable to append to logfile '%s'! (%s)", + $openslxConfig{'logfile'}, $! + ) + ); + } + if ($openslxConfig{'verbose-level'} >= 2) { + foreach my $key (sort keys %openslxConfig) { + my $val = $openslxConfig{$key} || ''; + vlog(2, "config-dump: $key = $val"); + } + } + + # setup translation "engine": + trInit(); + + return 1; } # ------------------------------------------------------------------------------ sub trInit { - # activate automatic charset conversion on all the standard I/O streams, - # just to give *some* support to shells in other charsets: - binmode(STDIN, ":encoding($openslxConfig{'locale-charmap'})"); - binmode(STDOUT, ":encoding($openslxConfig{'locale-charmap'})"); - binmode(STDERR, ":encoding($openslxConfig{'locale-charmap'})"); - - my $locale = $openslxConfig{'locale'}; - if (lc($locale) eq 'c') { - # treat locale 'c' as equivalent for 'posix': - $locale = 'posix'; - } - - if (lc($locale) ne 'posix') { - # parse locale and canonicalize it (e.g. to 'de_DE') and generate - # two filenames from it (language+country and language only): - if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) { - die "locale $locale has unknown format!?!"; - } - my @locales; - if (defined $2) { - push @locales, lc($1) . '_' . uc($2); - } - push @locales, lc($1); - - # try to load any of the Translation modules (starting with the more - # specific one [language+country]): - my $loadedTranslationModule; - foreach my $trName (@locales) { - vlog(2, "trying to load translation module $trName..."); - my $trModule = "OpenSLX/Translations/$trName.pm"; - my $trModuleSpec = "OpenSLX::Translations::$trName"; - if (eval { require $trModule } ) { - # copy the translations available in the given locale into our - # hash: - $translations = $trModuleSpec->getAllTranslations(); - $loadedTranslationModule = $trModule; - vlog( - 1, - _tr( - "translations module %s loaded successfully", $trModule - ) - ); - last; - } - } - if (!defined $loadedTranslationModule) { - vlog(1, - "unable to load any translations module for locale '$locale' ($!)." - ); - } - } - return; + # activate automatic charset conversion on all the standard I/O streams, + # just to give *some* support to shells in other charsets: + binmode(STDIN, ":encoding($openslxConfig{'locale-charmap'})"); + binmode(STDOUT, ":encoding($openslxConfig{'locale-charmap'})"); + binmode(STDERR, ":encoding($openslxConfig{'locale-charmap'})"); + + my $locale = $openslxConfig{'locale'}; + if (lc($locale) eq 'c') { + # treat locale 'c' as equivalent for 'posix': + $locale = 'posix'; + } + + if (lc($locale) ne 'posix') { + # parse locale and canonicalize it (e.g. to 'de_DE') and generate + # two filenames from it (language+country and language only): + if ($locale !~ m{^\s*([^_]+)(?:_(\w+))?}) { + die "locale $locale has unknown format!?!"; + } + my @locales; + if (defined $2) { + push @locales, lc($1) . '_' . uc($2); + } + push @locales, lc($1); + + # try to load any of the Translation modules (starting with the more + # specific one [language+country]): + my $loadedTranslationModule; + foreach my $trName (@locales) { + vlog(2, "trying to load translation module $trName..."); + my $trModule = "OpenSLX/Translations/$trName.pm"; + my $trModuleSpec = "OpenSLX::Translations::$trName"; + if (eval { require $trModule } ) { + # copy the translations available in the given locale into our + # hash: + $translations = $trModuleSpec->getAllTranslations(); + $loadedTranslationModule = $trModule; + vlog( + 1, + _tr( + "translations module %s loaded successfully", $trModule + ) + ); + last; + } + } + if (!defined $loadedTranslationModule) { + vlog(1, + "unable to load any translations module for locale '$locale' ($!)." + ); + } + } + return; } # ------------------------------------------------------------------------------ sub _tr { - my $trOrig = shift; - - my $trKey = $trOrig; - $trKey =~ s[\n][\\n]g; - $trKey =~ s[\t][\\t]g; - - my $formatStr; - if (defined $translations) { - $formatStr = $translations->{$trKey}; - } - if (!defined $formatStr) { - $formatStr = $trOrig; - } - return sprintf($formatStr, @_); + my $trOrig = shift; + + my $trKey = $trOrig; + $trKey =~ s[\n][\\n]g; + $trKey =~ s[\t][\\t]g; + + my $formatStr; + if (defined $translations) { + $formatStr = $translations->{$trKey}; + } + if (!defined $formatStr) { + $formatStr = $trOrig; + } + return sprintf($formatStr, @_); } # ------------------------------------------------------------------------------ sub callInSubprocess { - my $childFunc = shift; - - my $pid = fork(); - if (!$pid) { - - # child... - # ...execute the given function and exit: - my $ok = eval { $childFunc->(); 1 }; - if (!$ok) { - print STDERR "*** $@"; - exit 5; - } - exit 0; - } - - # parent... - # ...pass on interrupt- and terminate-signals to child... - local $SIG{INT} = sub { kill 'INT', $pid; waitpid($pid, 0); exit $? }; - local $SIG{TERM} = sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? }; - - # ...and wait for child to do its work: - waitpid($pid, 0); - if ($?) { - exit $?; - } - return; + my $childFunc = shift; + + my $pid = fork(); + if (!$pid) { + + # child... + # ...execute the given function and exit: + my $ok = eval { $childFunc->(); 1 }; + if (!$ok) { + print STDERR "*** $@"; + exit 5; + } + exit 0; + } + + # parent... + # ...pass on interrupt- and terminate-signals to child... + local $SIG{INT} = sub { kill 'INT', $pid; waitpid($pid, 0); exit $? }; + local $SIG{TERM} = sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? }; + + # ...and wait for child to do its work: + waitpid($pid, 0); + if ($?) { + exit $?; + } + return; } # ------------------------------------------------------------------------------ sub executeInSubprocess { - my @cmdlineArgs = @_; + my @cmdlineArgs = @_; - my $pid = fork(); - if (!$pid) { + my $pid = fork(); + if (!$pid) { - # child... - # ...exec the given cmdline: - exec(@cmdlineArgs); - } + # child... + # ...exec the given cmdline: + exec(@cmdlineArgs); + } - # parent... - return $pid; + # parent... + return $pid; } # ------------------------------------------------------------------------------ sub addCleanupFunction { - my $name = shift; - my $func = shift; + my $name = shift; + my $func = shift; - $cleanupFunctions{$name} = $func; - return; + $cleanupFunctions{$name} = $func; + return; } # ------------------------------------------------------------------------------ sub removeCleanupFunction { - my $name = shift; + my $name = shift; - delete $cleanupFunctions{$name}; - return; + delete $cleanupFunctions{$name}; + return; } # ------------------------------------------------------------------------------ sub invokeCleanupFunctions { - my @funcNames = keys %cleanupFunctions; - foreach my $name (@funcNames) { - vlog(2, "invoking cleanup function '$name'..."); - $cleanupFunctions{$name}->(); - } - return; + my @funcNames = keys %cleanupFunctions; + foreach my $name (@funcNames) { + vlog(2, "invoking cleanup function '$name'..."); + $cleanupFunctions{$name}->(); + } + return; } # ------------------------------------------------------------------------------ sub slxsystem { - vlog(2, _tr("executing: %s", join ' ', @_)); - my $res = system(@_); - if ($res > 0) { - # check if child got killed, if so we stop, too (unless the signal is - # SIGPIPE, which we ignore in order to loop over failed FTP connections - # and the like): - my $signalNo = $res & 127; - if ($signalNo > 0 && $signalNo != 13) { - die _tr("child-process reveived signal '%s', parent stops!", - $signalNo); - } - } - return $res; + vlog(2, _tr("executing: %s", join ' ', @_)); + my $res = system(@_); + if ($res > 0) { + # check if child got killed, if so we stop, too (unless the signal is + # SIGPIPE, which we ignore in order to loop over failed FTP connections + # and the like): + my $signalNo = $res & 127; + if ($signalNo > 0 && $signalNo != 13) { + die _tr("child-process reveived signal '%s', parent stops!", + $signalNo); + } + } + return $res; } # ------------------------------------------------------------------------------ sub cluck { - _doThrowOrWarn('cluck', @_); - return; + _doThrowOrWarn('cluck', @_); + return; } # ------------------------------------------------------------------------------ sub carp { - _doThrowOrWarn('carp', @_); - return; + _doThrowOrWarn('carp', @_); + return; } # ------------------------------------------------------------------------------ sub warn { - _doThrowOrWarn('warn', @_); - return; + _doThrowOrWarn('warn', @_); + return; } # ------------------------------------------------------------------------------ sub confess { - invokeCleanupFunctions(); - _doThrowOrWarn('confess', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('confess', @_); + return; } # ------------------------------------------------------------------------------ sub croak { - invokeCleanupFunctions(); - _doThrowOrWarn('croak', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('croak', @_); + return; } # ------------------------------------------------------------------------------ sub die { - invokeCleanupFunctions(); - _doThrowOrWarn('die', @_); - return; + invokeCleanupFunctions(); + _doThrowOrWarn('die', @_); + return; } # ------------------------------------------------------------------------------ sub _doThrowOrWarn { - my $type = shift; - my $msg = shift; - - # use '°°°' for warnings and '***' for errors - if ($type eq 'carp' || $type eq 'warn' || $type eq 'cluck') { - $msg =~ s[^°°° ][]igms; - $msg =~ s[^][°°° ]igms; - } - else { - $msg =~ s[^\*\*\* ][]igms; - $msg =~ s[^][*** ]igms; - } - - if ($openslxConfig{'debug-confess'}) { - my %functionFor = ( - 'carp' => sub { Carp::cluck @_ }, - 'cluck' => sub { Carp::cluck @_ }, - 'confess' => sub { Carp::confess @_ }, - 'croak' => sub { Carp::confess @_ }, - 'die' => sub { Carp::confess @_ }, - 'warn' => sub { Carp::cluck @_ }, - ); - my $func = $functionFor{$type}; - $func->($msg); - } - else { - chomp $msg; - my %functionFor = ( - 'carp' => sub { Carp::carp @_ }, - 'cluck' => sub { Carp::cluck @_ }, - 'confess' => sub { Carp::confess @_ }, - 'croak' => sub { Carp::croak @_ }, - 'die' => sub { CORE::die @_}, - 'warn' => sub { CORE::warn @_ }, - ); - my $func = $functionFor{$type}; - $func->("$msg\n"); - } - return; + my $type = shift; + my $msg = shift; + + # use '°°°' for warnings and '***' for errors + if ($type eq 'carp' || $type eq 'warn' || $type eq 'cluck') { + $msg =~ s[^°°° ][]igms; + $msg =~ s[^][°°° ]igms; + } + else { + $msg =~ s[^\*\*\* ][]igms; + $msg =~ s[^][*** ]igms; + } + + if ($openslxConfig{'debug-confess'}) { + my %functionFor = ( + 'carp' => sub { Carp::cluck @_ }, + 'cluck' => sub { Carp::cluck @_ }, + 'confess' => sub { Carp::confess @_ }, + 'croak' => sub { Carp::confess @_ }, + 'die' => sub { Carp::confess @_ }, + 'warn' => sub { Carp::cluck @_ }, + ); + my $func = $functionFor{$type}; + $func->($msg); + } + else { + chomp $msg; + my %functionFor = ( + 'carp' => sub { Carp::carp @_ }, + 'cluck' => sub { Carp::cluck @_ }, + 'confess' => sub { Carp::confess @_ }, + 'croak' => sub { Carp::croak @_ }, + 'die' => sub { CORE::die @_}, + 'warn' => sub { CORE::warn @_ }, + ); + my $func = $functionFor{$type}; + $func->("$msg\n"); + } + return; } =item checkParams() @@ -598,36 +598,36 @@ sub checkParams # ------------------------------------------------------------------------------ sub instantiateClass { - my $class = shift; - my $flags = shift || {}; - - checkParams($flags, { - 'pathToClass' => '?', - 'version' => '?' - }); - my $pathToClass = $flags->{pathToClass}; - my $requestedVersion = $flags->{version}; - - my $moduleName = defined $pathToClass ? "$pathToClass/$class" : $class; - $moduleName =~ s[::][/]g; - $moduleName .= '.pm'; - unless (eval { require $moduleName } ) { - if ($! == 2) { - die _tr("Module '%s' not found!\n", $moduleName); - } - else { - die _tr("Unable to load module '%s' (%s)\n", $moduleName, $@); - } - } - if (defined $requestedVersion) { - my $classVersion = $class->VERSION; - if ($classVersion < $requestedVersion) { - die _tr( - 'Could not load class <%s> (Version <%s> required, but <%s> found)', - $class, $requestedVersion, $classVersion); - } - } - return $class->new; + my $class = shift; + my $flags = shift || {}; + + checkParams($flags, { + 'pathToClass' => '?', + 'version' => '?' + }); + my $pathToClass = $flags->{pathToClass}; + my $requestedVersion = $flags->{version}; + + my $moduleName = defined $pathToClass ? "$pathToClass/$class" : $class; + $moduleName =~ s[::][/]g; + $moduleName .= '.pm'; + unless (eval { require $moduleName } ) { + if ($! == 2) { + die _tr("Module '%s' not found!\n", $moduleName); + } + else { + die _tr("Unable to load module '%s' (%s)\n", $moduleName, $@); + } + } + if (defined $requestedVersion) { + my $classVersion = $class->VERSION; + if ($classVersion < $requestedVersion) { + die _tr( + 'Could not load class <%s> (Version <%s> required, but <%s> found)', + $class, $requestedVersion, $classVersion); + } + } + return $class->new; } 1; diff --git a/lib/OpenSLX/ConfigFolder.pm b/lib/OpenSLX/ConfigFolder.pm index 99289881..e8c3ee8f 100644 --- a/lib/OpenSLX/ConfigFolder.pm +++ b/lib/OpenSLX/ConfigFolder.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # ConfigFolder.pm -# - provides utility functions for generation of configuration folders +# - provides utility functions for generation of configuration folders # ----------------------------------------------------------------------------- package OpenSLX::ConfigFolder; @@ -23,8 +23,8 @@ $VERSION = 1.01; @ISA = qw(Exporter); @EXPORT = qw( - &createConfigFolderForDefaultSystem - &createConfigFolderForSystem + &createConfigFolderForDefaultSystem + &createConfigFolderForSystem ); ################################################################################ @@ -35,68 +35,68 @@ use OpenSLX::Utils; sub createConfigFolderForDefaultSystem { - my $result = 0; - my $defaultConfigPath = "$openslxConfig{'private-path'}/config/default"; - if (!-e "$defaultConfigPath/initramfs") { - slxsystem("mkdir -p $defaultConfigPath/initramfs"); - $result = 1; - } - if (!-e "$defaultConfigPath/rootfs") { - slxsystem("mkdir -p $defaultConfigPath/rootfs"); - $result = 1; - } + my $result = 0; + my $defaultConfigPath = "$openslxConfig{'private-path'}/config/default"; + if (!-e "$defaultConfigPath/initramfs") { + slxsystem("mkdir -p $defaultConfigPath/initramfs"); + $result = 1; + } + if (!-e "$defaultConfigPath/rootfs") { + slxsystem("mkdir -p $defaultConfigPath/rootfs"); + $result = 1; + } - # create default pre-/postinit scripts for us in initramfs: - my $preInitFile = "$defaultConfigPath/initramfs/preinit.local"; - if (!-e $preInitFile) { - my $preInit = unshiftHereDoc(<<' END-of-HERE'); - #!/bin/sh - # - # This script allows the local admin to extend the - # capabilities at the beginning of the initramfs (stage3). - # The toolset is rather limited and you have to keep in mind - # that stage4 rootfs has the prefix '/mnt'. - END-of-HERE - spitFile($preInitFile, $preInit); - slxsystem("chmod u+x $preInitFile"); - $result = 1; - } + # create default pre-/postinit scripts for us in initramfs: + my $preInitFile = "$defaultConfigPath/initramfs/preinit.local"; + if (!-e $preInitFile) { + my $preInit = unshiftHereDoc(<<' END-of-HERE'); + #!/bin/sh + # + # This script allows the local admin to extend the + # capabilities at the beginning of the initramfs (stage3). + # The toolset is rather limited and you have to keep in mind + # that stage4 rootfs has the prefix '/mnt'. + END-of-HERE + spitFile($preInitFile, $preInit); + slxsystem("chmod u+x $preInitFile"); + $result = 1; + } - my $postInitFile = "$defaultConfigPath/initramfs/postinit.local"; - if (!-e $postInitFile) { - my $postInit = unshiftHereDoc(<<' END-of-HERE'); - #!/bin/sh - # - # This script allows the local admin to extend the - # capabilities at the end of the initramfs (stage3). - # The toolset is rather limited and you have to keep in mind - # that stage4 rootfs has the prefix '/mnt'. - # But you may use some special slx-functions available via - # inclusion: '. /etc/functions' ... - END-of-HERE - spitFile($postInitFile, $postInit); - slxsystem("chmod u+x $postInitFile"); - $result = 1; - } - return $result; + my $postInitFile = "$defaultConfigPath/initramfs/postinit.local"; + if (!-e $postInitFile) { + my $postInit = unshiftHereDoc(<<' END-of-HERE'); + #!/bin/sh + # + # This script allows the local admin to extend the + # capabilities at the end of the initramfs (stage3). + # The toolset is rather limited and you have to keep in mind + # that stage4 rootfs has the prefix '/mnt'. + # But you may use some special slx-functions available via + # inclusion: '. /etc/functions' ... + END-of-HERE + spitFile($postInitFile, $postInit); + slxsystem("chmod u+x $postInitFile"); + $result = 1; + } + return $result; } sub createConfigFolderForSystem { - my $systemName = shift || confess "need to pass in system-name!"; + my $systemName = shift || confess "need to pass in system-name!"; - my $result = 0; - my $systemConfigPath - = "$openslxConfig{'private-path'}/config/$systemName/default"; - if (!-e "$systemConfigPath/initramfs") { - slxsystem("mkdir -p $systemConfigPath/initramfs"); - $result = 1; - } - if (!-e "$systemConfigPath/rootfs") { - slxsystem("mkdir -p $systemConfigPath/rootfs"); - $result = 1; - } - return $result; + my $result = 0; + my $systemConfigPath + = "$openslxConfig{'private-path'}/config/$systemName/default"; + if (!-e "$systemConfigPath/initramfs") { + slxsystem("mkdir -p $systemConfigPath/initramfs"); + $result = 1; + } + if (!-e "$systemConfigPath/rootfs") { + slxsystem("mkdir -p $systemConfigPath/rootfs"); + $result = 1; + } + return $result; } 1; diff --git a/lib/OpenSLX/Translations/de.pm b/lib/OpenSLX/Translations/de.pm index e98edd03..b0783b81 100644 --- a/lib/OpenSLX/Translations/de.pm +++ b/lib/OpenSLX/Translations/de.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # de.pm -# - OpenSLX-translations for the German language. +# - OpenSLX-translations for the German language. # ----------------------------------------------------------------------------- package OpenSLX::Translations::de; @@ -25,8 +25,8 @@ my %translations; ################################################################################ sub getAllTranslations { - my $class = shift; - return \%translations; + my $class = shift; + return \%translations; } ################################################################################ @@ -34,325 +34,325 @@ sub getAllTranslations ################################################################################ %translations = ( - q{NEW:%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} - => - qq{}, + q{NEW:%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} + => + qq{}, - q{NEW:%s has wrong bitwidth (%s instead of %s)} - => - qq{}, + q{NEW:%s has wrong bitwidth (%s instead of %s)} + => + qq{}, - q{NEW:%s: ignored, as it isn't an executable or a shared library\n} - => - qq{}, + q{NEW:%s: ignored, as it isn't an executable or a shared library\n} + => + qq{}, - q{NEW:'%s' already exists!\n} - => - qq{}, + q{NEW:'%s' already exists!\n} + => + qq{}, - q{NEW:'%s' not found, maybe wrong root-path?\n} - => - qq{}, + q{NEW:'%s' not found, maybe wrong root-path?\n} + => + qq{}, - q{NEW:\trpath='%s'\n} - => - qq{}, + q{NEW:\trpath='%s'\n} + => + qq{}, - q{NEW:\ttrying objdump...\n} - => - qq{}, + q{NEW:\ttrying objdump...\n} + => + qq{}, - q{NEW:\ttrying readelf...\n} - => - qq{}, + q{NEW:\ttrying readelf...\n} + => + qq{}, - q{NEW:analyzing '%s'...\n} - => - qq{}, + q{NEW:analyzing '%s'...\n} + => + qq{}, - q{NEW:Can't add column to table <%s> (%s)} - => - qq{}, + q{NEW:Can't add column to table <%s> (%s)} + => + qq{}, - q{NEW:Can't add columns to table <%s> (%s)} - => - qq{}, + q{NEW:Can't add columns to table <%s> (%s)} + => + qq{}, - q{NEW:Can't change columns in table <%s> (%s)} - => - qq{}, + q{NEW:Can't change columns in table <%s> (%s)} + => + qq{}, - q{NEW:Can't create table <%s> (%s)} - => - qq{}, + q{NEW:Can't create table <%s> (%s)} + => + qq{}, - q{NEW:Can't delete from table <%s> (%s)} - => - qq{}, + q{NEW:Can't delete from table <%s> (%s)} + => + qq{}, - q{NEW:Can't drop columns from table <%s> (%s)} - => - qq{}, + q{NEW:Can't drop columns from table <%s> (%s)} + => + qq{}, - q{NEW:Can't drop table <%s> (%s)} - => - qq{}, + q{NEW:Can't drop table <%s> (%s)} + => + qq{}, - q{NEW:Can't execute SQL-statement <%s> (%s)} - => - qq{}, + q{NEW:Can't execute SQL-statement <%s> (%s)} + => + qq{}, - q{NEW:Can't insert into table <%s> (%s)} - => - qq{}, + q{NEW:Can't insert into table <%s> (%s)} + => + qq{}, - q{NEW:Can't lock ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't lock ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't open ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't open ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't prepare SQL-statement <%s> (%s)} - => - qq{}, + q{NEW:Can't prepare SQL-statement <%s> (%s)} + => + qq{}, - q{NEW:Can't rename table <%s> (%s)} - => - qq{}, + q{NEW:Can't rename table <%s> (%s)} + => + qq{}, - q{NEW:Can't to seek ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't to seek ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't truncate ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't truncate ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't update ID-file <%s> (%s)} - => - qq{}, + q{NEW:Can't update ID-file <%s> (%s)} + => + qq{}, - q{NEW:Can't update table <%s> (%s)} - => - qq{}, + q{NEW:Can't update table <%s> (%s)} + => + qq{}, - q{NEW:Cannot connect to database <%s> (%s)} - => - qq{}, + q{NEW:Cannot connect to database <%s> (%s)} + => + qq{}, - q{NEW:config-file <%s> has incorrect syntax here:\n\t%s\n} - => - qq{}, + q{NEW:config-file <%s> has incorrect syntax here:\n\t%s\n} + => + qq{}, - q{NEW:copying kernel %s to %s/kernel} - => - qq{}, + q{NEW:copying kernel %s to %s/kernel} + => + qq{}, - q{Could not determine schema version of database} - => - qq{Die Version des Datenbank-Schemas konnte nicht bestimmt werden}, + q{Could not determine schema version of database} + => + qq{Die Version des Datenbank-Schemas konnte nicht bestimmt werden}, - q{NEW:Could not load module <%s> (Version <%s> required, but <%s> found)} - => - qq{}, + q{NEW:Could not load module <%s> (Version <%s> required, but <%s> found)} + => + qq{}, - q{NEW:creating tar %s} - => - qq{}, + q{NEW:creating tar %s} + => + qq{}, - q{NEW:DB matches current schema version %s} - => - qq{}, + q{NEW:DB matches current schema version %s} + => + qq{}, - q{NEW:executing %s} - => - qq{}, + q{NEW:executing %s} + => + qq{}, - q{NEW:exporting client %d:%s} - => - qq{}, + q{NEW:exporting client %d:%s} + => + qq{}, - q{NEW:exporting system %d:%s} - => - qq{}, + q{NEW:exporting system %d:%s} + => + qq{}, - q{NEW:generating initialramfs %s/initramfs} - => - qq{}, + q{NEW:generating initialramfs %s/initramfs} + => + qq{}, - q{NEW:ignoring unknown key <%s>} - => - qq{}, + q{NEW:ignoring unknown key <%s>} + => + qq{}, - q{NEW:List of supported systems:\n\t} - => - qq{}, + q{NEW:List of supported systems:\n\t} + => + qq{}, - q{NEW:Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} - => - qq{}, + q{NEW:Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} + => + qq{}, - q{NEW:merging %s (val=%s)} - => - qq{}, + q{NEW:merging %s (val=%s)} + => + qq{}, - q{NEW:merging from default client...} - => - qq{}, + q{NEW:merging from default client...} + => + qq{}, - q{NEW:merging from group %d:%s...} - => - qq{}, + q{NEW:merging from group %d:%s...} + => + qq{}, - q{NEW:neither objdump nor readelf seems to be installed, giving up!\n} - => - qq{}, + q{NEW:neither objdump nor readelf seems to be installed, giving up!\n} + => + qq{}, - q{no} - => - qq{nein}, + q{no} + => + qq{nein}, - q{NEW:Our schema-version is %s, DB is %s, upgrading DB...} - => - qq{}, + q{NEW:Our schema-version is %s, DB is %s, upgrading DB...} + => + qq{}, - q{NEW:PXE-system %s already exists!} - => - qq{}, + q{NEW:PXE-system %s already exists!} + => + qq{}, - q{NEW:removing %s} - => - qq{}, + q{NEW:removing %s} + => + qq{}, - q{NEW:setting %s to <%s>} - => - qq{}, + q{NEW:setting %s to <%s>} + => + qq{}, - q{NEW:slxldd: unable to find file '%s', skipping it\n} - => - qq{}, + q{NEW:slxldd: unable to find file '%s', skipping it\n} + => + qq{}, - q{NEW:Sorry, system '%s' is unsupported.\n} - => - qq{}, + q{NEW:Sorry, system '%s' is unsupported.\n} + => + qq{}, - q{NEW:system-error: illegal target-path <%s>!} - => - qq{}, + q{NEW:system-error: illegal target-path <%s>!} + => + qq{}, - q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } - => - qq{Die aktuelle OpenSLX-Datenbank wird mit einem Beispiel-Datensatz überschrieben.\nAlle Daten (%s Systeme und %s Clients) werden gelöscht!\nMöchten Sie den Vorgang fortsetzen(%s/%s)? }, + q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } + => + qq{Die aktuelle OpenSLX-Datenbank wird mit einem Beispiel-Datensatz überschrieben.\nAlle Daten (%s Systeme und %s Clients) werden gelöscht!\nMöchten Sie den Vorgang fortsetzen(%s/%s)? }, - q{NEW:translations module %s loaded successfully} - => - qq{}, + q{NEW:translations module %s loaded successfully} + => + qq{}, - q{NEW:Unable to access client-config-path '%s'!} - => - qq{}, + q{NEW:Unable to access client-config-path '%s'!} + => + qq{}, - q{NEW:unable to create db-datadir %s! (%s)\n} - => - qq{}, + q{NEW:unable to create db-datadir %s! (%s)\n} + => + qq{}, - q{NEW:Unable to create lock-file <%s>, exiting!\n} - => - qq{}, + q{NEW:Unable to create lock-file <%s>, exiting!\n} + => + qq{}, - q{NEW:Unable to create or access temp-path '%s'!} - => - qq{}, + q{NEW:Unable to create or access temp-path '%s'!} + => + qq{}, - q{NEW:Unable to create or access tftpboot-path '%s'!} - => - qq{}, + q{NEW:Unable to create or access tftpboot-path '%s'!} + => + qq{}, - q{NEW:unable to execute shell-command:\n\t%s \n\t(%s)} - => - qq{}, + q{NEW:unable to execute shell-command:\n\t%s \n\t(%s)} + => + qq{}, - q{NEW:unable to fetch file info for '%s', giving up!\n} - => - qq{}, + q{NEW:unable to fetch file info for '%s', giving up!\n} + => + qq{}, - q{NEW:Unable to load DB-module <%s> (%s)\n} - => - qq{}, + q{NEW:Unable to load DB-module <%s> (%s)\n} + => + qq{}, - q{NEW:Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} - => - qq{}, + q{NEW:Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} + => + qq{}, - q{NEW:unable to load DHCP-Export backend '%s'! (%s)\n} - => - qq{}, + q{NEW:unable to load DHCP-Export backend '%s'! (%s)\n} + => + qq{}, - q{NEW:Unable to load module <%s> (Version <%s> required)} - => - qq{}, + q{NEW:Unable to load module <%s> (Version <%s> required)} + => + qq{}, - q{NEW:Unable to load module <%s> (Version <%s> required, but <%s> found)} - => - qq{}, + q{NEW:Unable to load module <%s> (Version <%s> required, but <%s> found)} + => + qq{}, - q{NEW:Unable to load system-module <%s> (%s)\n} - => - qq{}, + q{NEW:Unable to load system-module <%s> (%s)\n} + => + qq{}, - q{NEW:Unable to load system-module <%s>!\n} - => - qq{}, + q{NEW:Unable to load system-module <%s>!\n} + => + qq{}, - q{NEW:Unable to write local settings file <%s> (%s)} - => - qq{}, + q{NEW:Unable to write local settings file <%s> (%s)} + => + qq{}, - q{NEW:unknown settings key <%s>!\n} - => - qq{}, + q{NEW:unknown settings key <%s>!\n} + => + qq{}, - q{NEW:UnknownDbSchemaColumnDescr} - => - qq{}, + q{NEW:UnknownDbSchemaColumnDescr} + => + qq{}, - q{UnknownDbSchemaCommand} - => - qq{Unbekannter DbSchema-Befehl <%s> wird übergangen}, + q{UnknownDbSchemaCommand} + => + qq{Unbekannter DbSchema-Befehl <%s> wird übergangen}, - q{NEW:UnknownDbSchemaTypeDescr} - => - qq{}, + q{NEW:UnknownDbSchemaTypeDescr} + => + qq{}, - q{NEW:upgrade done} - => - qq{}, + q{NEW:upgrade done} + => + qq{}, - q{NEW:writing dhcp-config for %s clients} - => - qq{}, + q{NEW:writing dhcp-config for %s clients} + => + qq{}, - q{NEW:writing PXE-file %s} - => - qq{}, + q{NEW:writing PXE-file %s} + => + qq{}, - q{yes} - => - qq{ja}, + q{yes} + => + qq{ja}, - q{NEW:You need to specify at least one file!\n} - => - qq{}, + q{NEW:You need to specify at least one file!\n} + => + qq{}, - q{NEW:You need to specify exactly one system name!\n} - => - qq{}, + q{NEW:You need to specify exactly one system name!\n} + => + qq{}, - q{NEW:You need to specify the root-path!\n} - => - qq{}, + q{NEW:You need to specify the root-path!\n} + => + qq{}, ); diff --git a/lib/OpenSLX/Translations/posix.pm b/lib/OpenSLX/Translations/posix.pm index 05e16ed5..61a94c93 100644 --- a/lib/OpenSLX/Translations/posix.pm +++ b/lib/OpenSLX/Translations/posix.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # posix.pm -# - OpenSLX-translations for the posix locale (English language). +# - OpenSLX-translations for the posix locale (English language). # ----------------------------------------------------------------------------- package OpenSLX::Translations::posix; @@ -25,8 +25,8 @@ my %translations; ################################################################################ sub getAllTranslations { - my $class = shift; - return \%translations; + my $class = shift; + return \%translations; } ################################################################################ @@ -34,325 +34,325 @@ sub getAllTranslations ################################################################################ %translations = ( - q{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} - => - qq{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n}, + q{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n} + => + qq{%s doesn't seem to be installed,\nso there is no support for %s available, sorry!\n}, - q{%s has wrong bitwidth (%s instead of %s)} - => - qq{%s has wrong bitwidth (%s instead of %s)}, + q{%s has wrong bitwidth (%s instead of %s)} + => + qq{%s has wrong bitwidth (%s instead of %s)}, - q{%s: ignored, as it isn't an executable or a shared library\n} - => - qq{%s: ignored, as it isn't an executable or a shared library\n}, + q{%s: ignored, as it isn't an executable or a shared library\n} + => + qq{%s: ignored, as it isn't an executable or a shared library\n}, - q{'%s' already exists!\n} - => - qq{'%s' already exists!\n}, + q{'%s' already exists!\n} + => + qq{'%s' already exists!\n}, - q{'%s' not found, maybe wrong root-path?\n} - => - qq{'%s' not found, maybe wrong root-path?\n}, + q{'%s' not found, maybe wrong root-path?\n} + => + qq{'%s' not found, maybe wrong root-path?\n}, - q{\trpath='%s'\n} - => - qq{\trpath='%s'\n}, + q{\trpath='%s'\n} + => + qq{\trpath='%s'\n}, - q{\ttrying objdump...\n} - => - qq{\ttrying objdump...\n}, + q{\ttrying objdump...\n} + => + qq{\ttrying objdump...\n}, - q{\ttrying readelf...\n} - => - qq{\ttrying readelf...\n}, + q{\ttrying readelf...\n} + => + qq{\ttrying readelf...\n}, - q{analyzing '%s'...\n} - => - qq{analyzing '%s'...\n}, + q{analyzing '%s'...\n} + => + qq{analyzing '%s'...\n}, - q{Can't add column to table <%s> (%s)} - => - qq{Can't add column to table <%s> (%s)}, + q{Can't add column to table <%s> (%s)} + => + qq{Can't add column to table <%s> (%s)}, - q{Can't add columns to table <%s> (%s)} - => - qq{Can't add columns to table <%s> (%s)}, + q{Can't add columns to table <%s> (%s)} + => + qq{Can't add columns to table <%s> (%s)}, - q{Can't change columns in table <%s> (%s)} - => - qq{Can't change columns in table <%s> (%s)}, + q{Can't change columns in table <%s> (%s)} + => + qq{Can't change columns in table <%s> (%s)}, - q{Can't create table <%s> (%s)} - => - qq{Can't create table <%s> (%s)}, + q{Can't create table <%s> (%s)} + => + qq{Can't create table <%s> (%s)}, - q{Can't delete from table <%s> (%s)} - => - qq{Can't delete from table <%s> (%s)}, + q{Can't delete from table <%s> (%s)} + => + qq{Can't delete from table <%s> (%s)}, - q{Can't drop columns from table <%s> (%s)} - => - qq{Can't drop columns from table <%s> (%s)}, + q{Can't drop columns from table <%s> (%s)} + => + qq{Can't drop columns from table <%s> (%s)}, - q{Can't drop table <%s> (%s)} - => - qq{Can't drop table <%s> (%s)}, + q{Can't drop table <%s> (%s)} + => + qq{Can't drop table <%s> (%s)}, - q{Can't execute SQL-statement <%s> (%s)} - => - qq{Can't execute SQL-statement <%s> (%s)}, + q{Can't execute SQL-statement <%s> (%s)} + => + qq{Can't execute SQL-statement <%s> (%s)}, - q{Can't insert into table <%s> (%s)} - => - qq{Can't insert into table <%s> (%s)}, + q{Can't insert into table <%s> (%s)} + => + qq{Can't insert into table <%s> (%s)}, - q{Can't lock ID-file <%s> (%s)} - => - qq{Can't lock ID-file <%s> (%s)}, + q{Can't lock ID-file <%s> (%s)} + => + qq{Can't lock ID-file <%s> (%s)}, - q{Can't open ID-file <%s> (%s)} - => - qq{Can't open ID-file <%s> (%s)}, + q{Can't open ID-file <%s> (%s)} + => + qq{Can't open ID-file <%s> (%s)}, - q{Can't prepare SQL-statement <%s> (%s)} - => - qq{Can't prepare SQL-statement <%s> (%s)}, + q{Can't prepare SQL-statement <%s> (%s)} + => + qq{Can't prepare SQL-statement <%s> (%s)}, - q{Can't rename table <%s> (%s)} - => - qq{Can't rename table <%s> (%s)}, + q{Can't rename table <%s> (%s)} + => + qq{Can't rename table <%s> (%s)}, - q{Can't to seek ID-file <%s> (%s)} - => - qq{Can't to seek ID-file <%s> (%s)}, + q{Can't to seek ID-file <%s> (%s)} + => + qq{Can't to seek ID-file <%s> (%s)}, - q{Can't truncate ID-file <%s> (%s)} - => - qq{Can't truncate ID-file <%s> (%s)}, + q{Can't truncate ID-file <%s> (%s)} + => + qq{Can't truncate ID-file <%s> (%s)}, - q{Can't update ID-file <%s> (%s)} - => - qq{Can't update ID-file <%s> (%s)}, + q{Can't update ID-file <%s> (%s)} + => + qq{Can't update ID-file <%s> (%s)}, - q{Can't update table <%s> (%s)} - => - qq{Can't update table <%s> (%s)}, + q{Can't update table <%s> (%s)} + => + qq{Can't update table <%s> (%s)}, - q{Cannot connect to database <%s> (%s)} - => - qq{Cannot connect to database <%s> (%s)}, + q{Cannot connect to database <%s> (%s)} + => + qq{Cannot connect to database <%s> (%s)}, - q{config-file <%s> has incorrect syntax here:\n\t%s\n} - => - qq{config-file <%s> has incorrect syntax here:\n\t%s\n}, + q{config-file <%s> has incorrect syntax here:\n\t%s\n} + => + qq{config-file <%s> has incorrect syntax here:\n\t%s\n}, - q{copying kernel %s to %s/kernel} - => - qq{copying kernel %s to %s/kernel}, + q{copying kernel %s to %s/kernel} + => + qq{copying kernel %s to %s/kernel}, - q{Could not determine schema version of database} - => - qq{Could not determine schema version of database}, + q{Could not determine schema version of database} + => + qq{Could not determine schema version of database}, - q{Could not load module <%s> (Version <%s> required, but <%s> found)} - => - qq{Could not load module <%s> (Version <%s> required, but <%s> found)}, + q{Could not load module <%s> (Version <%s> required, but <%s> found)} + => + qq{Could not load module <%s> (Version <%s> required, but <%s> found)}, - q{creating tar %s} - => - qq{creating tar %s}, + q{creating tar %s} + => + qq{creating tar %s}, - q{DB matches current schema version %s} - => - qq{DB matches current schema version %s}, + q{DB matches current schema version %s} + => + qq{DB matches current schema version %s}, - q{executing %s} - => - qq{executing %s}, + q{executing %s} + => + qq{executing %s}, - q{exporting client %d:%s} - => - qq{exporting client %d:%s}, + q{exporting client %d:%s} + => + qq{exporting client %d:%s}, - q{exporting system %d:%s} - => - qq{exporting system %d:%s}, + q{exporting system %d:%s} + => + qq{exporting system %d:%s}, - q{generating initialramfs %s/initramfs} - => - qq{generating initialramfs %s/initramfs}, + q{generating initialramfs %s/initramfs} + => + qq{generating initialramfs %s/initramfs}, - q{ignoring unknown key <%s>} - => - qq{ignoring unknown key <%s>}, + q{ignoring unknown key <%s>} + => + qq{ignoring unknown key <%s>}, - q{List of supported systems:\n\t} - => - qq{List of supported systems:\n\t}, + q{List of supported systems:\n\t} + => + qq{List of supported systems:\n\t}, - q{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} - => - qq{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n}, + q{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n} + => + qq{Lock-file <%s> exists, script is already running.\nPlease remove the logfile and try again if you are sure that no one else\nis executing this script.\n}, - q{merging %s (val=%s)} - => - qq{merging %s (val=%s)}, + q{merging %s (val=%s)} + => + qq{merging %s (val=%s)}, - q{merging from default client...} - => - qq{merging from default client...}, + q{merging from default client...} + => + qq{merging from default client...}, - q{merging from group %d:%s...} - => - qq{merging from group %d:%s...}, + q{merging from group %d:%s...} + => + qq{merging from group %d:%s...}, - q{neither objdump nor readelf seems to be installed, giving up!\n} - => - qq{neither objdump nor readelf seems to be installed, giving up!\n}, + q{neither objdump nor readelf seems to be installed, giving up!\n} + => + qq{neither objdump nor readelf seems to be installed, giving up!\n}, - q{no} - => - qq{no}, + q{no} + => + qq{no}, - q{Our schema-version is %s, DB is %s, upgrading DB...} - => - qq{Our schema-version is %s, DB is %s, upgrading DB...}, + q{Our schema-version is %s, DB is %s, upgrading DB...} + => + qq{Our schema-version is %s, DB is %s, upgrading DB...}, - q{PXE-system %s already exists!} - => - qq{PXE-system %s already exists!}, + q{PXE-system %s already exists!} + => + qq{PXE-system %s already exists!}, - q{removing %s} - => - qq{removing %s}, + q{removing %s} + => + qq{removing %s}, - q{setting %s to <%s>} - => - qq{setting %s to <%s>}, + q{setting %s to <%s>} + => + qq{setting %s to <%s>}, - q{slxldd: unable to find file '%s', skipping it\n} - => - qq{slxldd: unable to find file '%s', skipping it\n}, + q{slxldd: unable to find file '%s', skipping it\n} + => + qq{slxldd: unable to find file '%s', skipping it\n}, - q{Sorry, system '%s' is unsupported.\n} - => - qq{Sorry, system '%s' is unsupported.\n}, + q{Sorry, system '%s' is unsupported.\n} + => + qq{Sorry, system '%s' is unsupported.\n}, - q{system-error: illegal target-path <%s>!} - => - qq{system-error: illegal target-path <%s>!}, + q{system-error: illegal target-path <%s>!} + => + qq{system-error: illegal target-path <%s>!}, - q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } - => - qq{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? }, + q{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? } + => + qq{This will overwrite the current OpenSLX-database with an example dataset.\nAll your data (%s systems and %s clients) will be lost!\nDo you want to continue(%s/%s)? }, - q{translations module %s loaded successfully} - => - qq{translations module %s loaded successfully}, + q{translations module %s loaded successfully} + => + qq{translations module %s loaded successfully}, - q{Unable to access client-config-path '%s'!} - => - qq{Unable to access client-config-path '%s'!}, + q{Unable to access client-config-path '%s'!} + => + qq{Unable to access client-config-path '%s'!}, - q{unable to create db-datadir %s! (%s)\n} - => - qq{unable to create db-datadir %s! (%s)\n}, + q{unable to create db-datadir %s! (%s)\n} + => + qq{unable to create db-datadir %s! (%s)\n}, - q{Unable to create lock-file <%s>, exiting!\n} - => - qq{Unable to create lock-file <%s>, exiting!\n}, + q{Unable to create lock-file <%s>, exiting!\n} + => + qq{Unable to create lock-file <%s>, exiting!\n}, - q{Unable to create or access temp-path '%s'!} - => - qq{Unable to create or access temp-path '%s'!}, + q{Unable to create or access temp-path '%s'!} + => + qq{Unable to create or access temp-path '%s'!}, - q{Unable to create or access tftpboot-path '%s'!} - => - qq{Unable to create or access tftpboot-path '%s'!}, + q{Unable to create or access tftpboot-path '%s'!} + => + qq{Unable to create or access tftpboot-path '%s'!}, - q{unable to execute shell-command:\n\t%s \n\t(%s)} - => - qq{unable to execute shell-command:\n\t%s \n\t(%s)}, + q{unable to execute shell-command:\n\t%s \n\t(%s)} + => + qq{unable to execute shell-command:\n\t%s \n\t(%s)}, - q{unable to fetch file info for '%s', giving up!\n} - => - qq{unable to fetch file info for '%s', giving up!\n}, + q{unable to fetch file info for '%s', giving up!\n} + => + qq{unable to fetch file info for '%s', giving up!\n}, - q{Unable to load DB-module <%s> (%s)\n} - => - qq{Unable to load DB-module <%s> (%s)\n}, + q{Unable to load DB-module <%s> (%s)\n} + => + qq{Unable to load DB-module <%s> (%s)\n}, - q{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} - => - qq{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n}, + q{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n} + => + qq{Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n}, - q{unable to load DHCP-Export backend '%s'! (%s)\n} - => - qq{unable to load DHCP-Export backend '%s'! (%s)\n}, + q{unable to load DHCP-Export backend '%s'! (%s)\n} + => + qq{unable to load DHCP-Export backend '%s'! (%s)\n}, - q{Unable to load module <%s> (Version <%s> required)} - => - qq{Unable to load module <%s> (Version <%s> required)}, + q{Unable to load module <%s> (Version <%s> required)} + => + qq{Unable to load module <%s> (Version <%s> required)}, - q{Unable to load module <%s> (Version <%s> required, but <%s> found)} - => - qq{Unable to load module <%s> (Version <%s> required, but <%s> found)}, + q{Unable to load module <%s> (Version <%s> required, but <%s> found)} + => + qq{Unable to load module <%s> (Version <%s> required, but <%s> found)}, - q{Unable to load system-module <%s> (%s)\n} - => - qq{Unable to load system-module <%s> (%s)\n}, + q{Unable to load system-module <%s> (%s)\n} + => + qq{Unable to load system-module <%s> (%s)\n}, - q{Unable to load system-module <%s>!\n} - => - qq{Unable to load system-module <%s>!\n}, + q{Unable to load system-module <%s>!\n} + => + qq{Unable to load system-module <%s>!\n}, - q{Unable to write local settings file <%s> (%s)} - => - qq{Unable to write local settings file <%s> (%s)}, + q{Unable to write local settings file <%s> (%s)} + => + qq{Unable to write local settings file <%s> (%s)}, - q{unknown settings key <%s>!\n} - => - qq{unknown settings key <%s>!\n}, + q{unknown settings key <%s>!\n} + => + qq{unknown settings key <%s>!\n}, - q{UnknownDbSchemaColumnDescr} - => - qq{UnknownDbSchemaColumnDescr}, + q{UnknownDbSchemaColumnDescr} + => + qq{UnknownDbSchemaColumnDescr}, - q{UnknownDbSchemaCommand} - => - qq{UnknownDbSchemaCommand}, + q{UnknownDbSchemaCommand} + => + qq{UnknownDbSchemaCommand}, - q{UnknownDbSchemaTypeDescr} - => - qq{UnknownDbSchemaTypeDescr}, + q{UnknownDbSchemaTypeDescr} + => + qq{UnknownDbSchemaTypeDescr}, - q{upgrade done} - => - qq{upgrade done}, + q{upgrade done} + => + qq{upgrade done}, - q{writing dhcp-config for %s clients} - => - qq{writing dhcp-config for %s clients}, + q{writing dhcp-config for %s clients} + => + qq{writing dhcp-config for %s clients}, - q{writing PXE-file %s} - => - qq{writing PXE-file %s}, + q{writing PXE-file %s} + => + qq{writing PXE-file %s}, - q{yes} - => - qq{yes}, + q{yes} + => + qq{yes}, - q{You need to specify at least one file!\n} - => - qq{You need to specify at least one file!\n}, + q{You need to specify at least one file!\n} + => + qq{You need to specify at least one file!\n}, - q{You need to specify exactly one system name!\n} - => - qq{You need to specify exactly one system name!\n}, + q{You need to specify exactly one system name!\n} + => + qq{You need to specify exactly one system name!\n}, - q{You need to specify the root-path!\n} - => - qq{You need to specify the root-path!\n}, + q{You need to specify the root-path!\n} + => + qq{You need to specify the root-path!\n}, ); diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm index 9d8b4599..130a3a01 100644 --- a/lib/OpenSLX/Utils.pm +++ b/lib/OpenSLX/Utils.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Utils.pm -# - provides utility functions for OpenSLX +# - provides utility functions for OpenSLX # ----------------------------------------------------------------------------- package OpenSLX::Utils; @@ -49,280 +49,280 @@ use OpenSLX::Basics; sub copyFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $targetDir = shift || croak 'need to pass in target dir!'; - my $targetFileName = shift || ''; - - mkpath($targetDir) unless -d $targetDir; - my $target = "$targetDir/$targetFileName"; - vlog(2, _tr("copying '%s' to '%s'", $fileName, $target)); - if (system("cp -p $fileName $target")) { - croak( - _tr( - "unable to copy file '%s' to dir '%s' (%s)", - $fileName, $target, $! - ) - ); - } - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $targetDir = shift || croak 'need to pass in target dir!'; + my $targetFileName = shift || ''; + + mkpath($targetDir) unless -d $targetDir; + my $target = "$targetDir/$targetFileName"; + vlog(2, _tr("copying '%s' to '%s'", $fileName, $target)); + if (system("cp -p $fileName $target")) { + croak( + _tr( + "unable to copy file '%s' to dir '%s' (%s)", + $fileName, $target, $! + ) + ); + } + return; } sub fakeFile { - my $fullPath = shift || croak 'need to pass in full path!'; - - my $targetDir = dirname($fullPath); - mkpath($targetDir) unless -d $targetDir; - if (system("touch", $fullPath)) { - croak(_tr("unable to create file '%s' (%s)", $fullPath, $!)); - } - return; + my $fullPath = shift || croak 'need to pass in full path!'; + + my $targetDir = dirname($fullPath); + mkpath($targetDir) unless -d $targetDir; + if (system("touch", $fullPath)) { + croak(_tr("unable to create file '%s' (%s)", $fullPath, $!)); + } + return; } sub linkFile { - my $linkTarget = shift || croak 'need to pass in link target!'; - my $linkName = shift || croak 'need to pass in link name!'; - - my $targetDir = dirname($linkName); - mkpath($targetDir) unless -d $targetDir; - if (system("ln -sfn $linkTarget $linkName")) { - croak( - _tr( - "unable to create link '%s' to '%s' (%s)", - $linkName, $linkTarget, $! - ) - ); - } - return; + my $linkTarget = shift || croak 'need to pass in link target!'; + my $linkName = shift || croak 'need to pass in link name!'; + + my $targetDir = dirname($linkName); + mkpath($targetDir) unless -d $targetDir; + if (system("ln -sfn $linkTarget $linkName")) { + croak( + _tr( + "unable to create link '%s' to '%s' (%s)", + $linkName, $linkTarget, $! + ) + ); + } + return; } sub slurpFile { - my $fileName = shift || confess 'need to pass in fileName!'; - my $flags = shift || {}; - - checkParams($flags, { - 'failIfMissing' => '?', - 'io-layer' => '?', - }); - my $failIfMissing - = exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1; - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - if (!open($fh, "<:$ioLayer", $fileName)) { - return '' unless $failIfMissing; - croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!); - } - if (wantarray()) { - my @content = <$fh>; - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return @content; - } - else { - local $/; - my $content = <$fh>; - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return $content; - } + my $fileName = shift || confess 'need to pass in fileName!'; + my $flags = shift || {}; + + checkParams($flags, { + 'failIfMissing' => '?', + 'io-layer' => '?', + }); + my $failIfMissing + = exists $flags->{failIfMissing} ? $flags->{failIfMissing} : 1; + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + if (!open($fh, "<:$ioLayer", $fileName)) { + return '' unless $failIfMissing; + croak _tr("could not open file '%s' for reading! (%s)", $fileName, $!); + } + if (wantarray()) { + my @content = <$fh>; + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return @content; + } + else { + local $/; + my $content = <$fh>; + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return $content; + } } sub spitFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $content = shift || ''; - my $flags = shift || {}; - - checkParams($flags, { - 'io-layer' => '?', - 'mode' => '?', - }); - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - open($fh, ">:$ioLayer", $fileName) - or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); - print $fh $content - or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - if (defined $flags->{mode}) { - chmod $flags->{mode}, $fileName; - } - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $content = shift || ''; + my $flags = shift || {}; + + checkParams($flags, { + 'io-layer' => '?', + 'mode' => '?', + }); + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + open($fh, ">:$ioLayer", $fileName) + or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); + print $fh $content + or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + if (defined $flags->{mode}) { + chmod $flags->{mode}, $fileName; + } + return; } sub appendFile { - my $fileName = shift || croak 'need to pass in a fileName!'; - my $content = shift; - my $flags = shift || {}; - - checkParams($flags, { - 'io-layer' => '?', - }); - my $ioLayer = $flags->{'io-layer'} || 'utf8'; - - my $fh; - open($fh, ">>:$ioLayer", $fileName) - or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); - print $fh $content - or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); - close($fh) - or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); - return; + my $fileName = shift || croak 'need to pass in a fileName!'; + my $content = shift; + my $flags = shift || {}; + + checkParams($flags, { + 'io-layer' => '?', + }); + my $ioLayer = $flags->{'io-layer'} || 'utf8'; + + my $fh; + open($fh, ">>:$ioLayer", $fileName) + or croak _tr("unable to create file '%s' (%s)\n", $fileName, $!); + print $fh $content + or croak _tr("unable to print to file '%s' (%s)\n", $fileName, $!); + close($fh) + or croak _tr("unable to close file '%s' (%s)\n", $fileName, $!); + return; } sub followLink { - my $path = shift || croak 'need to pass in a path!'; - my $prefixedPath = shift || ''; - - my $target; - while (-l "$path") { - $target = readlink "$path"; - if (substr($target, 0, 1) eq '/') { - $path = "$prefixedPath$target"; - } - else { - $path = $prefixedPath . dirname($path) . '/' . $target; - } - } - return $path; + my $path = shift || croak 'need to pass in a path!'; + my $prefixedPath = shift || ''; + + my $target; + while (-l "$path") { + $target = readlink "$path"; + if (substr($target, 0, 1) eq '/') { + $path = "$prefixedPath$target"; + } + else { + $path = $prefixedPath . dirname($path) . '/' . $target; + } + } + return $path; } sub copyBinaryWithRequiredLibs { - my $params = shift; - - checkParams($params, { - 'binary' => '!', # file to copy - 'targetFolder' => '!', # where file shall be copied to - 'libTargetFolder' => '!', # base target folder for libs - 'targetName' => '?', # name of binary in target folder - }); - copyFile($params->{binary}, $params->{targetFolder}, $params->{targetName}); - - # determine all required libraries and copy those, too: - vlog(1, _tr("calling slxldd for $params->{binary}")); - my $slxlddCmd = "slxldd $params->{binary}"; - vlog(2, "executing: $slxlddCmd"); - my $requiredLibsStr = qx{$slxlddCmd}; - if ($?) { - die _tr( - "slxldd couldn't determine the libs required by '%s'! (%s)", - $params->{binary}, $? - ); - } - chomp $requiredLibsStr; - vlog(2, "slxldd results:\n$requiredLibsStr"); - - foreach my $lib (split "\n", $requiredLibsStr) { - my $libDir = dirname($lib); - my $targetLib = "$params->{libTargetFolder}$libDir"; - next if -e "$targetLib/$lib"; - vlog(3, "copying lib '$lib'"); - copyFile($lib, $targetLib); - } - return $requiredLibsStr; + my $params = shift; + + checkParams($params, { + 'binary' => '!', # file to copy + 'targetFolder' => '!', # where file shall be copied to + 'libTargetFolder' => '!', # base target folder for libs + 'targetName' => '?', # name of binary in target folder + }); + copyFile($params->{binary}, $params->{targetFolder}, $params->{targetName}); + + # determine all required libraries and copy those, too: + vlog(1, _tr("calling slxldd for $params->{binary}")); + my $slxlddCmd = "slxldd $params->{binary}"; + vlog(2, "executing: $slxlddCmd"); + my $requiredLibsStr = qx{$slxlddCmd}; + if ($?) { + die _tr( + "slxldd couldn't determine the libs required by '%s'! (%s)", + $params->{binary}, $? + ); + } + chomp $requiredLibsStr; + vlog(2, "slxldd results:\n$requiredLibsStr"); + + foreach my $lib (split "\n", $requiredLibsStr) { + my $libDir = dirname($lib); + my $targetLib = "$params->{libTargetFolder}$libDir"; + next if -e "$targetLib/$lib"; + vlog(3, "copying lib '$lib'"); + copyFile($lib, $targetLib); + } + return $requiredLibsStr; } sub unshiftHereDoc { - my $content = shift; - return $content unless $content =~ m{^(\s+)}; - my $shiftStr = $1; - $content =~ s[^$shiftStr][]gms; - return $content; + my $content = shift; + return $content unless $content =~ m{^(\s+)}; + my $shiftStr = $1; + $content =~ s[^$shiftStr][]gms; + return $content; } sub string2Array { - my $string = shift || ''; + my $string = shift || ''; - my @lines = split m[\n], $string; - for my $line (@lines) { - # remove leading and trailing whitespace: - $line =~ s{^\s*(.*?)\s*$}{$1}; - } + my @lines = split m[\n], $string; + for my $line (@lines) { + # remove leading and trailing whitespace: + $line =~ s{^\s*(.*?)\s*$}{$1}; + } - # drop empty lines and comments: - return grep { length($_) > 0 && $_ !~ m[^\s*#]; } @lines; + # drop empty lines and comments: + return grep { length($_) > 0 && $_ !~ m[^\s*#]; } @lines; } sub chrootInto { - my $osDir = shift; + my $osDir = shift; - vlog(2, "chrooting into $osDir..."); - chdir $osDir - or die _tr("unable to chdir into '%s' (%s)\n", $osDir, $!); + vlog(2, "chrooting into $osDir..."); + chdir $osDir + or die _tr("unable to chdir into '%s' (%s)\n", $osDir, $!); - # ...do chroot - chroot "." - or die _tr("unable to chroot into '%s' (%s)\n", $osDir, $!); - return; + # ...do chroot + chroot "." + or die _tr("unable to chroot into '%s' (%s)\n", $osDir, $!); + return; } sub mergeHash { - my $targetHash = shift; - my $sourceHash = shift; - my $fillOnly = shift || 0; - - foreach my $key (keys %{$sourceHash}) { - my $sourceVal = $sourceHash->{$key}; - if (ref($sourceVal) eq 'HASH') { - if (!exists $targetHash->{$key}) { - $targetHash->{$key} = {}; - } - mergeHash($targetHash->{$key}, $sourceVal); - } - elsif (ref($sourceVal) eq 'ARRAY') { - if (!exists $targetHash->{$key}) { - $targetHash->{$key} = []; - } - foreach my $val (@{$sourceHash->{$key}}) { - my $targetVal = {}; - push @{$targetHash->{$key}}, $targetVal; - mergeHash($targetVal, $sourceVal); - } - } - else { - next if $fillOnly && exists $targetHash->{$key}; - $targetHash->{$key} = $sourceVal; - } - } + my $targetHash = shift; + my $sourceHash = shift; + my $fillOnly = shift || 0; + + foreach my $key (keys %{$sourceHash}) { + my $sourceVal = $sourceHash->{$key}; + if (ref($sourceVal) eq 'HASH') { + if (!exists $targetHash->{$key}) { + $targetHash->{$key} = {}; + } + mergeHash($targetHash->{$key}, $sourceVal); + } + elsif (ref($sourceVal) eq 'ARRAY') { + if (!exists $targetHash->{$key}) { + $targetHash->{$key} = []; + } + foreach my $val (@{$sourceHash->{$key}}) { + my $targetVal = {}; + push @{$targetHash->{$key}}, $targetVal; + mergeHash($targetVal, $sourceVal); + } + } + else { + next if $fillOnly && exists $targetHash->{$key}; + $targetHash->{$key} = $sourceVal; + } + } } sub getFQDN { - my $hostName = hostname(); - - my $hostAddr = gethostbyname($hostName) - or die(_tr("unable to get address of host '%s'", $hostName)); - my $FQDN = gethostbyaddr($hostAddr, AF_INET) - or die(_tr("unable to get dns-name of address '%s'", $hostAddr)); - return $FQDN; + my $hostName = hostname(); + + my $hostAddr = gethostbyname($hostName) + or die(_tr("unable to get address of host '%s'", $hostName)); + my $FQDN = gethostbyaddr($hostAddr, AF_INET) + or die(_tr("unable to get dns-name of address '%s'", $hostAddr)); + return $FQDN; } sub readPassword { - my $prompt = shift; - - my $term = Term::ReadLine->new('slx'); - my $attribs = $term->Attribs; - $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; + my $prompt = shift; + + my $term = Term::ReadLine->new('slx'); + my $attribs = $term->Attribs; + $attribs->{redisplay_function} = $attribs->{shadow_redisplay}; return $term->readline($prompt); } sub hostIs64Bit { - my $arch = qx{uname -m}; - return $arch =~ m[64]; + my $arch = qx{uname -m}; + return $arch =~ m[64]; } 1; diff --git a/lib/distro-info/debian-3.1/settings.default b/lib/distro-info/debian-3.1/settings.default index 9af7d3ef..50b12768 100644 --- a/lib/distro-info/debian-3.1/settings.default +++ b/lib/distro-info/debian-3.1/settings.default @@ -3,39 +3,39 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2_all.deb release-name = sarge - components = main - distribution = sarge - name = Debian 3.1 - repo-subdir = dists - file-for-speedtest = dists/sarge/main/binary-i386/Packages.gz + components = main + distribution = sarge + name = Debian 3.1 + repo-subdir = dists + file-for-speedtest = dists/sarge/main/binary-i386/Packages.gz - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal - base = minimal - packages = < diff --git a/lib/distro-info/debian-3.1/settings.example b/lib/distro-info/debian-3.1/settings.example index d09a8710..ac54855d 100644 --- a/lib/distro-info/debian-3.1/settings.example +++ b/lib/distro-info/debian-3.1/settings.example @@ -10,8 +10,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/debian-4.0/settings.default b/lib/distro-info/debian-4.0/settings.default index 9ec54e23..075754e3 100644 --- a/lib/distro-info/debian-4.0/settings.default +++ b/lib/distro-info/debian-4.0/settings.default @@ -3,30 +3,30 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2etch1_all.deb release-name = etch - components = main - distribution = etch - name = Debian 4.0 - repo-subdir = dists - file-for-speedtest = dists/etch/main/binary-i386/Packages.bz2 + components = main + distribution = etch + name = Debian 4.0 + repo-subdir = dists + file-for-speedtest = dists/etch/main/binary-i386/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/debian-4.0/settings.example b/lib/distro-info/debian-4.0/settings.example index d09a8710..ac54855d 100644 --- a/lib/distro-info/debian-4.0/settings.example +++ b/lib/distro-info/debian-4.0/settings.example @@ -10,8 +10,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/debian-4.0_amd64/settings.default b/lib/distro-info/debian-4.0_amd64/settings.default index be46fe14..22126f66 100644 --- a/lib/distro-info/debian-4.0_amd64/settings.default +++ b/lib/distro-info/debian-4.0_amd64/settings.default @@ -3,39 +3,39 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2etch1_all.deb release-name = etch - components = main - distribution = etch - name = Debian 4.0 - repo-subdir = dists - file-for-speedtest = dists/etch/main/binary-amd64/Packages.bz2 + components = main + distribution = etch + name = Debian 4.0 + repo-subdir = dists + file-for-speedtest = dists/etch/main/binary-amd64/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal - base = minimal - packages = < diff --git a/lib/distro-info/debian-4.0_amd64/settings.example b/lib/distro-info/debian-4.0_amd64/settings.example index d09a8710..ac54855d 100644 --- a/lib/distro-info/debian-4.0_amd64/settings.example +++ b/lib/distro-info/debian-4.0_amd64/settings.example @@ -10,8 +10,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/fedora-6/settings.default b/lib/distro-info/fedora-6/settings.default index f49856e9..53dfbe74 100644 --- a/lib/distro-info/fedora-6/settings.default +++ b/lib/distro-info/fedora-6/settings.default @@ -1,125 +1,125 @@ bootstrap-packages = < - packages = < package-subdir = Fedora/RPMS prereq-packages = < - name = Fedora Core 6 + name = Fedora Core 6 - name = Fedora Core 6 updates + name = Fedora Core 6 updates - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/fedora-6/settings.example b/lib/distro-info/fedora-6/settings.example index 12845311..22883d4b 100644 --- a/lib/distro-info/fedora-6/settings.example +++ b/lib/distro-info/fedora-6/settings.example @@ -13,8 +13,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/fedora-6_x86_64/settings.default b/lib/distro-info/fedora-6_x86_64/settings.default index bf97820a..3e940b94 100644 --- a/lib/distro-info/fedora-6_x86_64/settings.default +++ b/lib/distro-info/fedora-6_x86_64/settings.default @@ -1,125 +1,125 @@ bootstrap-packages = < - packages = < package-subdir = Fedora/RPMS prereq-packages = < - name = Fedora Core 6 + name = Fedora Core 6 - name = Fedora Core 6 updates + name = Fedora Core 6 updates - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/fedora-6_x86_64/settings.example b/lib/distro-info/fedora-6_x86_64/settings.example index 06642225..c41e6d33 100644 --- a/lib/distro-info/fedora-6_x86_64/settings.example +++ b/lib/distro-info/fedora-6_x86_64/settings.example @@ -13,8 +13,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.1/settings.default b/lib/distro-info/suse-10.1/settings.default index 2a4fdea9..e371142d 100644 --- a/lib/distro-info/suse-10.1/settings.default +++ b/lib/distro-info/suse-10.1/settings.default @@ -1,974 +1,974 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = SUSE Linux 10.1 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = SUSE Linux 10.1 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.1 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.1 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = SUSE Linux 10.1 updates - file-for-speedtest = repodata/primary.xml.gz + name = SUSE Linux 10.1 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/suse-10.1/settings.example b/lib/distro-info/suse-10.1/settings.example index 2c360086..726b979f 100644 --- a/lib/distro-info/suse-10.1/settings.example +++ b/lib/distro-info/suse-10.1/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.1_x86_64/settings.default b/lib/distro-info/suse-10.1_x86_64/settings.default index f40ad5ea..27edf02d 100644 --- a/lib/distro-info/suse-10.1_x86_64/settings.default +++ b/lib/distro-info/suse-10.1_x86_64/settings.default @@ -1,975 +1,975 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = SUSE Linux 10.1 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = SUSE Linux 10.1 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = SUSE Linux 10.1 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = SUSE Linux 10.1 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = SUSE Linux 10.1 updates - file-for-speedtest = repodata/primary.xml.gz + name = SUSE Linux 10.1 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/suse-10.1_x86_64/settings.example b/lib/distro-info/suse-10.1_x86_64/settings.example index 2c360086..726b979f 100644 --- a/lib/distro-info/suse-10.1_x86_64/settings.example +++ b/lib/distro-info/suse-10.1_x86_64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.2/settings.default b/lib/distro-info/suse-10.2/settings.default index 6f230c76..5b00c1e8 100644 --- a/lib/distro-info/suse-10.2/settings.default +++ b/lib/distro-info/suse-10.2/settings.default @@ -1,1062 +1,1062 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = openSUSE 10.2 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.2 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.2 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.2 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - - name = openSUSE 10.2 updates - file-for-speedtest = repodata/primary.xml.gz + + name = openSUSE 10.2 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = textmode - packages = < - base = textmode - packages = < - base = minimal + base = minimal - \ No newline at end of file + \ No newline at end of file diff --git a/lib/distro-info/suse-10.2/settings.example b/lib/distro-info/suse-10.2/settings.example index c32b0514..2905cef4 100644 --- a/lib/distro-info/suse-10.2/settings.example +++ b/lib/distro-info/suse-10.2/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.2_x86_64/settings.default b/lib/distro-info/suse-10.2_x86_64/settings.default index de494bc6..190a0a4a 100644 --- a/lib/distro-info/suse-10.2_x86_64/settings.default +++ b/lib/distro-info/suse-10.2_x86_64/settings.default @@ -1,1062 +1,1062 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = openSUSE 10.2 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.2 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.2 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.2 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.2 updates - file-for-speedtest = repodata/primary.xml.gz + name = openSUSE 10.2 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = textmode - packages = < - base = textmode - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/suse-10.2_x86_64/settings.example b/lib/distro-info/suse-10.2_x86_64/settings.example index c32b0514..2905cef4 100644 --- a/lib/distro-info/suse-10.2_x86_64/settings.example +++ b/lib/distro-info/suse-10.2_x86_64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.3/settings.default b/lib/distro-info/suse-10.3/settings.default index 789b33c7..ab167235 100644 --- a/lib/distro-info/suse-10.3/settings.default +++ b/lib/distro-info/suse-10.3/settings.default @@ -1,974 +1,974 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = openSUSE 10.3 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.3 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.3 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.3 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - - name = openSUSE 10.3 updates - file-for-speedtest = repodata/primary.xml.gz + + name = openSUSE 10.3 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = textmode - packages = < - base = textmode - packages = < - base = minimal + base = minimal - \ No newline at end of file + \ No newline at end of file diff --git a/lib/distro-info/suse-10.3/settings.example b/lib/distro-info/suse-10.3/settings.example index ea5469f6..97d663ed 100644 --- a/lib/distro-info/suse-10.3/settings.example +++ b/lib/distro-info/suse-10.3/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/suse-10.3__x86_64/settings.default b/lib/distro-info/suse-10.3__x86_64/settings.default index 7fa9e073..8752f736 100644 --- a/lib/distro-info/suse-10.3__x86_64/settings.default +++ b/lib/distro-info/suse-10.3__x86_64/settings.default @@ -1,973 +1,973 @@ bootstrap-packages = < - packages = < - packages = < package-subdir = suse prereq-packages = < - name = openSUSE 10.3 - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.3 + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.3 non-OSS - repo-subdir = suse - file-for-speedtest = suse/setup/descr/packages.en + name = openSUSE 10.3 non-OSS + repo-subdir = suse + file-for-speedtest = suse/setup/descr/packages.en - name = openSUSE 10.3 updates - file-for-speedtest = repodata/primary.xml.gz + name = openSUSE 10.3 updates + file-for-speedtest = repodata/primary.xml.gz - packages = < - base = minimal - packages = < - base = textmode - packages = < - base = textmode - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/suse-10.3__x86_64/settings.example b/lib/distro-info/suse-10.3__x86_64/settings.example index c32b0514..2905cef4 100644 --- a/lib/distro-info/suse-10.3__x86_64/settings.example +++ b/lib/distro-info/suse-10.3__x86_64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-6.10/settings.default b/lib/distro-info/ubuntu-6.10/settings.default index 0b183976..7a23c243 100644 --- a/lib/distro-info/ubuntu-6.10/settings.default +++ b/lib/distro-info/ubuntu-6.10/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = edgy - components = main restricted - distribution = edgy - name = Ubuntu 6.10 - repo-subdir = dists - file-for-speedtest = dists/edgy/main/binary-i386/Packages.bz2 + components = main restricted + distribution = edgy + name = Ubuntu 6.10 + repo-subdir = dists + file-for-speedtest = dists/edgy/main/binary-i386/Packages.bz2 - components = main restricted - distribution = edgy-security - name = Ubuntu 6.10 Security - repo-subdir = dists - file-for-speedtest = dists/edgy-security/main/binary-i386/Packages.bz2 + components = main restricted + distribution = edgy-security + name = Ubuntu 6.10 Security + repo-subdir = dists + file-for-speedtest = dists/edgy-security/main/binary-i386/Packages.bz2 - components = main restricted - distribution = edgy-updates - name = Ubuntu 6.10 Updates - repo-subdir = dists - file-for-speedtest = dists/edgy-updates/main/binary-i386/Packages.bz2 + components = main restricted + distribution = edgy-updates + name = Ubuntu 6.10 Updates + repo-subdir = dists + file-for-speedtest = dists/edgy-updates/main/binary-i386/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-6.10/settings.example b/lib/distro-info/ubuntu-6.10/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-6.10/settings.example +++ b/lib/distro-info/ubuntu-6.10/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-6.10_amd64/settings.default b/lib/distro-info/ubuntu-6.10_amd64/settings.default index 9b91cf56..0c68826b 100644 --- a/lib/distro-info/ubuntu-6.10_amd64/settings.default +++ b/lib/distro-info/ubuntu-6.10_amd64/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = edgy - components = main restricted - distribution = edgy - name = Ubuntu 6.10 - repo-subdir = dists - file-for-speedtest = dists/edgy/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = edgy + name = Ubuntu 6.10 + repo-subdir = dists + file-for-speedtest = dists/edgy/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = edgy-security - name = Ubuntu 6.10 Security - repo-subdir = dists - file-for-speedtest = dists/edgy-security/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = edgy-security + name = Ubuntu 6.10 Security + repo-subdir = dists + file-for-speedtest = dists/edgy-security/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = edgy-updates - name = Ubuntu 6.10 Updates - repo-subdir = dists - file-for-speedtest = dists/edgy-updates/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = edgy-updates + name = Ubuntu 6.10 Updates + repo-subdir = dists + file-for-speedtest = dists/edgy-updates/main/binary-amd64/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-6.10_amd64/settings.example b/lib/distro-info/ubuntu-6.10_amd64/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-6.10_amd64/settings.example +++ b/lib/distro-info/ubuntu-6.10_amd64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-7.04/settings.default b/lib/distro-info/ubuntu-7.04/settings.default index 4e83d0da..771c8802 100644 --- a/lib/distro-info/ubuntu-7.04/settings.default +++ b/lib/distro-info/ubuntu-7.04/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = feisty - components = main restricted - distribution = feisty - name = Ubuntu 7.04 - repo-subdir = dists - file-for-speedtest = dists/feisty/main/binary-i386/Packages.bz2 + components = main restricted + distribution = feisty + name = Ubuntu 7.04 + repo-subdir = dists + file-for-speedtest = dists/feisty/main/binary-i386/Packages.bz2 - components = main restricted - distribution = feisty-security - name = Ubuntu 7.04 Security - repo-subdir = dists - file-for-speedtest = dists/feisty-security/main/binary-i386/Packages.bz2 + components = main restricted + distribution = feisty-security + name = Ubuntu 7.04 Security + repo-subdir = dists + file-for-speedtest = dists/feisty-security/main/binary-i386/Packages.bz2 - components = main restricted - distribution = feisty-updates - name = Ubuntu 7.04 Updates - repo-subdir = dists - file-for-speedtest = dists/feisty-updates/main/binary-i386/Packages.bz2 + components = main restricted + distribution = feisty-updates + name = Ubuntu 7.04 Updates + repo-subdir = dists + file-for-speedtest = dists/feisty-updates/main/binary-i386/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-7.04/settings.example b/lib/distro-info/ubuntu-7.04/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-7.04/settings.example +++ b/lib/distro-info/ubuntu-7.04/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-7.04_amd64/settings.default b/lib/distro-info/ubuntu-7.04_amd64/settings.default index 461c8e3d..24567542 100644 --- a/lib/distro-info/ubuntu-7.04_amd64/settings.default +++ b/lib/distro-info/ubuntu-7.04_amd64/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = feisty - components = main restricted - distribution = feisty - name = Ubuntu 7.04 - repo-subdir = dists - file-for-speedtest = dists/feisty/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = feisty + name = Ubuntu 7.04 + repo-subdir = dists + file-for-speedtest = dists/feisty/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = feisty-security - name = Ubuntu 7.04 Security - repo-subdir = dists - file-for-speedtest = dists/feisty-security/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = feisty-security + name = Ubuntu 7.04 Security + repo-subdir = dists + file-for-speedtest = dists/feisty-security/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = feisty-updates - name = Ubuntu 7.04 Updates - repo-subdir = dists - file-for-speedtest = dists/feisty-updates/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = feisty-updates + name = Ubuntu 7.04 Updates + repo-subdir = dists + file-for-speedtest = dists/feisty-updates/main/binary-amd64/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-7.04_amd64/settings.example b/lib/distro-info/ubuntu-7.04_amd64/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-7.04_amd64/settings.example +++ b/lib/distro-info/ubuntu-7.04_amd64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-7.10/settings.default b/lib/distro-info/ubuntu-7.10/settings.default index 4e5757f7..de7fa076 100644 --- a/lib/distro-info/ubuntu-7.10/settings.default +++ b/lib/distro-info/ubuntu-7.10/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = gutsy - components = main restricted - distribution = gutsy - name = Ubuntu 7.10 - repo-subdir = dists - file-for-speedtest = dists/gutsy/main/binary-i386/Packages.bz2 + components = main restricted + distribution = gutsy + name = Ubuntu 7.10 + repo-subdir = dists + file-for-speedtest = dists/gutsy/main/binary-i386/Packages.bz2 - components = main restricted - distribution = gutsy-security - name = Ubuntu 7.10 Security - repo-subdir = dists - file-for-speedtest = dists/gutsy-security/main/binary-i386/Packages.bz2 + components = main restricted + distribution = gutsy-security + name = Ubuntu 7.10 Security + repo-subdir = dists + file-for-speedtest = dists/gutsy-security/main/binary-i386/Packages.bz2 - components = main restricted - distribution = gutsy-updates - name = Ubuntu 7.10 Updates - repo-subdir = dists - file-for-speedtest = dists/gutsy-updates/main/binary-i386/Packages.bz2 + components = main restricted + distribution = gutsy-updates + name = Ubuntu 7.10 Updates + repo-subdir = dists + file-for-speedtest = dists/gutsy-updates/main/binary-i386/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-7.10/settings.example b/lib/distro-info/ubuntu-7.10/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-7.10/settings.example +++ b/lib/distro-info/ubuntu-7.10/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-7.10_amd64/settings.default b/lib/distro-info/ubuntu-7.10_amd64/settings.default index 9b01f01d..289a4ae5 100644 --- a/lib/distro-info/ubuntu-7.10_amd64/settings.default +++ b/lib/distro-info/ubuntu-7.10_amd64/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = gutsy - components = main restricted - distribution = gutsy - name = Ubuntu 7.10 - repo-subdir = dists - file-for-speedtest = dists/gutsy/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = gutsy + name = Ubuntu 7.10 + repo-subdir = dists + file-for-speedtest = dists/gutsy/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = gutsy-security - name = Ubuntu 7.10 Security - repo-subdir = dists - file-for-speedtest = dists/gutsy-security/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = gutsy-security + name = Ubuntu 7.10 Security + repo-subdir = dists + file-for-speedtest = dists/gutsy-security/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = gutsy-updates - name = Ubuntu 7.10 Updates - repo-subdir = dists - file-for-speedtest = dists/gutsy-updates/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = gutsy-updates + name = Ubuntu 7.10 Updates + repo-subdir = dists + file-for-speedtest = dists/gutsy-updates/main/binary-amd64/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-7.10_amd64/settings.example b/lib/distro-info/ubuntu-7.10_amd64/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-7.10_amd64/settings.example +++ b/lib/distro-info/ubuntu-7.10_amd64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-8.04/settings.default b/lib/distro-info/ubuntu-8.04/settings.default index 217a46e7..a6c606c5 100644 --- a/lib/distro-info/ubuntu-8.04/settings.default +++ b/lib/distro-info/ubuntu-8.04/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = hardy - components = main restricted - distribution = hardy - name = Ubuntu 8.04 - repo-subdir = dists - file-for-speedtest = dists/hardy/main/binary-i386/Packages.bz2 + components = main restricted + distribution = hardy + name = Ubuntu 8.04 + repo-subdir = dists + file-for-speedtest = dists/hardy/main/binary-i386/Packages.bz2 - components = main restricted - distribution = hardy-security - name = Ubuntu 8.04 Security - repo-subdir = dists - file-for-speedtest = dists/hardy-security/main/binary-i386/Packages.bz2 + components = main restricted + distribution = hardy-security + name = Ubuntu 8.04 Security + repo-subdir = dists + file-for-speedtest = dists/hardy-security/main/binary-i386/Packages.bz2 - components = main restricted - distribution = hardy-updates - name = Ubuntu 8.04 Updates - repo-subdir = dists - file-for-speedtest = dists/hardy-updates/main/binary-i386/Packages.bz2 + components = main restricted + distribution = hardy-updates + name = Ubuntu 8.04 Updates + repo-subdir = dists + file-for-speedtest = dists/hardy-updates/main/binary-i386/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-8.04/settings.example b/lib/distro-info/ubuntu-8.04/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-8.04/settings.example +++ b/lib/distro-info/ubuntu-8.04/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/lib/distro-info/ubuntu-8.04_amd64/settings.default b/lib/distro-info/ubuntu-8.04_amd64/settings.default index ce329008..338a4514 100644 --- a/lib/distro-info/ubuntu-8.04_amd64/settings.default +++ b/lib/distro-info/ubuntu-8.04_amd64/settings.default @@ -3,50 +3,50 @@ package-subdir = pool prereq-packages = main/d/debootstrap/debootstrap_0.3.3.2ubuntu3_all.deb release-name = hardy - components = main restricted - distribution = hardy - name = Ubuntu 8.04 - repo-subdir = dists - file-for-speedtest = dists/hardy/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = hardy + name = Ubuntu 8.04 + repo-subdir = dists + file-for-speedtest = dists/hardy/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = hardy-security - name = Ubuntu 8.04 Security - repo-subdir = dists - file-for-speedtest = dists/hardy-security/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = hardy-security + name = Ubuntu 8.04 Security + repo-subdir = dists + file-for-speedtest = dists/hardy-security/main/binary-amd64/Packages.bz2 - components = main restricted - distribution = hardy-updates - name = Ubuntu 8.04 Updates - repo-subdir = dists - file-for-speedtest = dists/hardy-updates/main/binary-amd64/Packages.bz2 + components = main restricted + distribution = hardy-updates + name = Ubuntu 8.04 Updates + repo-subdir = dists + file-for-speedtest = dists/hardy-updates/main/binary-amd64/Packages.bz2 - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal - packages = < - base = minimal + base = minimal diff --git a/lib/distro-info/ubuntu-8.04_amd64/settings.example b/lib/distro-info/ubuntu-8.04_amd64/settings.example index ac02e5b4..31881c4c 100644 --- a/lib/distro-info/ubuntu-8.04_amd64/settings.example +++ b/lib/distro-info/ubuntu-8.04_amd64/settings.example @@ -16,8 +16,8 @@ # add a new selection: # -# base = kde -# packages = < diff --git a/os-plugins/OpenSLX/OSPlugin/Base.pm b/os-plugins/OpenSLX/OSPlugin/Base.pm index 5da72f2a..cede0bce 100644 --- a/os-plugins/OpenSLX/OSPlugin/Base.pm +++ b/os-plugins/OpenSLX/OSPlugin/Base.pm @@ -9,14 +9,14 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Base.pm -# - provides empty base of the OpenSLX OSPlugin API. +# - provides empty base of the OpenSLX OSPlugin API. # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version =head1 NAME @@ -79,7 +79,7 @@ Please note that by convention, plugin names are all lowercase! sub new { - confess "Creating OpenSLX::OSPlugin::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSPlugin::Base-objects directly makes no sense!"; } =item initialize() @@ -91,12 +91,12 @@ engine that drives this plugin. sub initialize { - my $self = shift; + my $self = shift; - $self->{'os-plugin-engine'} = shift; - $self->{'distro'} = shift; - - return; + $self->{'os-plugin-engine'} = shift; + $self->{'distro'} = shift; + + return; } =item getInfo() @@ -109,12 +109,12 @@ this method and return the information about itself. sub getInfo { - my $self = shift; + my $self = shift; - return { - # a short (one-liner) description of this plugin - description => '', - }; + return { + # a short (one-liner) description of this plugin + description => '', + }; } =item getAttrInfo() @@ -143,20 +143,20 @@ Valid values range from 0-99. If your plugin does not have any requirements in this context, just specify the default value '50'. =back - + =cut sub getAttrInfo { - my $self = shift; - - # This default configuration will be added as attributes to the default - # system, such that it can be overruled for any specific system by means - # of slxconfig. - return { - # attribute 'active' is mandatory for all plugins - # attribute 'precedence' is mandatory for all plugins - }; + my $self = shift; + + # This default configuration will be added as attributes to the default + # system, such that it can be overruled for any specific system by means + # of slxconfig. + return { + # attribute 'active' is mandatory for all plugins + # attribute 'precedence' is mandatory for all plugins + }; } =item getDefaultAttrsForVendorOS() @@ -169,10 +169,10 @@ Returns a hash-ref with the default attribute values for the given vendor-OS. sub getDefaultAttrsForVendorOS { - my $self = shift; + my $self = shift; - # the default implementation does not change the default values at all: - return $self->getAttrInfo(); + # the default implementation does not change the default values at all: + return $self->getAttrInfo(); } =back @@ -199,15 +199,15 @@ any files from the host, fetch them from there. sub installationPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - # the repository folder, relative to the vendor-OS root - my $pluginTempPath = shift; - # the temporary folder, relative to the vendor-OS root - my $openslxPath = shift; - # the openslx base path bind-mounted into the chroot (/mnt/openslx) - - return; + my $self = shift; + my $pluginRepositoryPath = shift; + # the repository folder, relative to the vendor-OS root + my $pluginTempPath = shift; + # the temporary folder, relative to the vendor-OS root + my $openslxPath = shift; + # the openslx base path bind-mounted into the chroot (/mnt/openslx) + + return; } =item removalPhase() @@ -224,15 +224,15 @@ N.B.: This method is invoked while chrooted into the vendor-OS root. sub removalPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - # the repository folder, relative to the vendor-OS root - my $pluginTempPath = shift; - # the temporary folder, relative to the vendor-OS root - my $openslxPath = shift; - # the openslx base path bind-mounted into the chroot (/mnt/openslx) - - return; + my $self = shift; + my $pluginRepositoryPath = shift; + # the repository folder, relative to the vendor-OS root + my $pluginTempPath = shift; + # the temporary folder, relative to the vendor-OS root + my $openslxPath = shift; + # the openslx base path bind-mounted into the chroot (/mnt/openslx) + + return; } =back @@ -257,10 +257,10 @@ that it would like to see added. sub suggestAdditionalKernelParams { - my $self = shift; - my $makeInitRamFSEngine = shift; - - return; + my $self = shift; + my $makeInitRamFSEngine = shift; + + return; } =item suggestAdditionalKernelModules() @@ -270,15 +270,15 @@ requires. In order to do so, the plugin should return the names of additional kernel modules that it would like to see added. - + =cut sub suggestAdditionalKernelModules { - my $self = shift; - my $makeInitRamFSEngine = shift; - - return; + my $self = shift; + my $makeInitRamFSEngine = shift; + + return; } =item copyRequiredFilesIntoInitramfs() @@ -294,12 +294,12 @@ All other files should be taken from the root-fs instead! sub copyRequiredFilesIntoInitramfs { - my $self = shift; - my $targetPath = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - return; + my $self = shift; + my $targetPath = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + return; } =item setupPluginInInitramfs() @@ -315,59 +315,59 @@ suggestAdditionalKernelModules() and maybe copyRequiredFilesIntoInitramfs(). sub setupPluginInInitramfs { - my $self = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - my $pluginName = $self->{name}; - my $pluginSrcPath = "$openslxConfig{'base-path'}/lib/plugins"; - my $buildPath = $makeInitRamFSEngine->{'build-path'}; - my $pluginInitdPath = "$buildPath/etc/plugin-init.d"; - my $initHooksPath = "$buildPath/etc/init-hooks"; - - # copy runlevel script - my $precedence - = sprintf('%02d', $attrs->{"${pluginName}::precedence"}); - my $scriptName = "$pluginSrcPath/$pluginName/XX_${pluginName}.sh"; - my $targetName = "$pluginInitdPath/${precedence}_${pluginName}.sh"; - if (-e $scriptName) { - $makeInitRamFSEngine->addCMD("cp $scriptName $targetName"); - $makeInitRamFSEngine->addCMD("chmod a+x $targetName"); - } - - # copy init hook scripts, if any - if (-d "$pluginSrcPath/$pluginName/init-hooks") { - my $hookSrcPath = "$pluginSrcPath/$pluginName/init-hooks"; - $makeInitRamFSEngine->addCMD( - "cp -r $hookSrcPath/* $buildPath/etc/init-hooks/" - ); - } - - # invoke hook methods to suggest additional kernel params ... - my @suggestedParams - = $self->suggestAdditionalKernelParams($makeInitRamFSEngine); - if (@suggestedParams) { - my $params = join ' ', @suggestedParams; - vlog(1, "plugin $pluginName suggests these kernel params: $params"); - $makeInitRamFSEngine->addKernelParams(@suggestedParams); - } - - # ... and kernel modules - my @suggestedModules - = $self->suggestAdditionalKernelModules($makeInitRamFSEngine); - if (@suggestedModules) { - my $modules = join(',', @suggestedModules); - vlog(1, "plugin $pluginName suggests these kernel modules: $modules"); - $makeInitRamFSEngine->addKernelModules(@suggestedModules); - } - - # invoke hook method to copy any further files that are required in stage3 - # before the root-fs has been mounted - $self->copyRequiredFilesIntoInitramfs( - $buildPath, $attrs, $makeInitRamFSEngine - ); - - return 1; + my $self = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + my $pluginName = $self->{name}; + my $pluginSrcPath = "$openslxConfig{'base-path'}/lib/plugins"; + my $buildPath = $makeInitRamFSEngine->{'build-path'}; + my $pluginInitdPath = "$buildPath/etc/plugin-init.d"; + my $initHooksPath = "$buildPath/etc/init-hooks"; + + # copy runlevel script + my $precedence + = sprintf('%02d', $attrs->{"${pluginName}::precedence"}); + my $scriptName = "$pluginSrcPath/$pluginName/XX_${pluginName}.sh"; + my $targetName = "$pluginInitdPath/${precedence}_${pluginName}.sh"; + if (-e $scriptName) { + $makeInitRamFSEngine->addCMD("cp $scriptName $targetName"); + $makeInitRamFSEngine->addCMD("chmod a+x $targetName"); + } + + # copy init hook scripts, if any + if (-d "$pluginSrcPath/$pluginName/init-hooks") { + my $hookSrcPath = "$pluginSrcPath/$pluginName/init-hooks"; + $makeInitRamFSEngine->addCMD( + "cp -r $hookSrcPath/* $buildPath/etc/init-hooks/" + ); + } + + # invoke hook methods to suggest additional kernel params ... + my @suggestedParams + = $self->suggestAdditionalKernelParams($makeInitRamFSEngine); + if (@suggestedParams) { + my $params = join ' ', @suggestedParams; + vlog(1, "plugin $pluginName suggests these kernel params: $params"); + $makeInitRamFSEngine->addKernelParams(@suggestedParams); + } + + # ... and kernel modules + my @suggestedModules + = $self->suggestAdditionalKernelModules($makeInitRamFSEngine); + if (@suggestedModules) { + my $modules = join(',', @suggestedModules); + vlog(1, "plugin $pluginName suggests these kernel modules: $modules"); + $makeInitRamFSEngine->addKernelModules(@suggestedModules); + } + + # invoke hook method to copy any further files that are required in stage3 + # before the root-fs has been mounted + $self->copyRequiredFilesIntoInitramfs( + $buildPath, $attrs, $makeInitRamFSEngine + ); + + return 1; } =back diff --git a/os-plugins/OpenSLX/OSPlugin/Engine.pm b/os-plugins/OpenSLX/OSPlugin/Engine.pm index 344bfdb9..5469a98d 100644 --- a/os-plugins/OpenSLX/OSPlugin/Engine.pm +++ b/os-plugins/OpenSLX/OSPlugin/Engine.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Engine.pm -# - provides driver engine for the OSPlugin API. +# - provides driver engine for the OSPlugin API. # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::Engine; @@ -49,11 +49,11 @@ Trivial constructor sub new { - my $class = shift; + my $class = shift; - my $self = {}; + my $self = {}; - return bless $self, $class; + return bless $self, $class; } =item initialize($pluginName, $vendorOSName ) @@ -65,69 +65,69 @@ loads plugin. sub initialize { - my $self = shift; - my $pluginName = shift; - my $vendorOSName = shift; - my $givenAttrs = shift || {}; - - $self->{'vendor-os-name'} = $vendorOSName; - - $self->{'vendor-os-path'} - = "$openslxConfig{'private-path'}/stage1/$vendorOSName"; - vlog(1, "vendor-OS path is '$self->{'vendor-os-path'}'"); - - if ($pluginName) { - $self->{'plugin-name'} = $pluginName; - $self->{'plugin-path'} - = "$openslxConfig{'base-path'}/lib/plugins/$pluginName"; - vlog(1, "plugin path is '$self->{'plugin-path'}'"); - - # create ossetup-engine for given vendor-OS: - my $osSetupEngine = OpenSLX::OSSetup::Engine->new; - $osSetupEngine->initialize($self->{'vendor-os-name'}, 'plugin'); - $self->{'ossetup-engine'} = $osSetupEngine; - - $self->{'plugin'} = $self->_loadPlugin(); - return if !$self->{'plugin'}; - - $self->{'chrooted-plugin-repo-path'} - = "$openslxConfig{'base-path'}/plugin-repo/$self->{'plugin-name'}"; - $self->{'plugin-repo-path'} - = "$self->{'vendor-os-path'}/$self->{'chrooted-plugin-repo-path'}"; - $self->{'chrooted-plugin-temp-path'} - = "/tmp/slx-plugin/$self->{'plugin-name'}"; - $self->{'plugin-temp-path'} - = "$self->{'vendor-os-path'}/$self->{'chrooted-plugin-temp-path'}"; - $self->{'chrooted-openslx-base-path'} = '/mnt/openslx'; - - # check and store given attribute set - my $knownAttrs = $self->{plugin}->getAttrInfo(); - my @unknownAttrs - = grep { !exists $knownAttrs->{$_} } keys %$givenAttrs; - if (@unknownAttrs) { - die _tr( - "The plugin '%s' does not support these attributes:\n\t%s", - $pluginName, join(',', @unknownAttrs) - ); - } - - # merge attributes that were given on cmdline with the ones that - # already exist in the DB and finally with the default values - $self->{'plugin-attrs'} = { %$givenAttrs }; - my $defaultAttrs = $self->{plugin}->getDefaultAttrsForVendorOS( - $vendorOSName - ); - my $dbAttrs = $self->_fetchInstalledPluginAttrs($vendorOSName); - for my $attrName (keys %$defaultAttrs) { - next if exists $givenAttrs->{$attrName}; - $self->{'plugin-attrs'}->{$attrName} - = exists $dbAttrs->{$attrName} - ? $dbAttrs->{$attrName} - : $defaultAttrs->{$attrName}->{default}; - } - } - - return 1; + my $self = shift; + my $pluginName = shift; + my $vendorOSName = shift; + my $givenAttrs = shift || {}; + + $self->{'vendor-os-name'} = $vendorOSName; + + $self->{'vendor-os-path'} + = "$openslxConfig{'private-path'}/stage1/$vendorOSName"; + vlog(1, "vendor-OS path is '$self->{'vendor-os-path'}'"); + + if ($pluginName) { + $self->{'plugin-name'} = $pluginName; + $self->{'plugin-path'} + = "$openslxConfig{'base-path'}/lib/plugins/$pluginName"; + vlog(1, "plugin path is '$self->{'plugin-path'}'"); + + # create ossetup-engine for given vendor-OS: + my $osSetupEngine = OpenSLX::OSSetup::Engine->new; + $osSetupEngine->initialize($self->{'vendor-os-name'}, 'plugin'); + $self->{'ossetup-engine'} = $osSetupEngine; + + $self->{'plugin'} = $self->_loadPlugin(); + return if !$self->{'plugin'}; + + $self->{'chrooted-plugin-repo-path'} + = "$openslxConfig{'base-path'}/plugin-repo/$self->{'plugin-name'}"; + $self->{'plugin-repo-path'} + = "$self->{'vendor-os-path'}/$self->{'chrooted-plugin-repo-path'}"; + $self->{'chrooted-plugin-temp-path'} + = "/tmp/slx-plugin/$self->{'plugin-name'}"; + $self->{'plugin-temp-path'} + = "$self->{'vendor-os-path'}/$self->{'chrooted-plugin-temp-path'}"; + $self->{'chrooted-openslx-base-path'} = '/mnt/openslx'; + + # check and store given attribute set + my $knownAttrs = $self->{plugin}->getAttrInfo(); + my @unknownAttrs + = grep { !exists $knownAttrs->{$_} } keys %$givenAttrs; + if (@unknownAttrs) { + die _tr( + "The plugin '%s' does not support these attributes:\n\t%s", + $pluginName, join(',', @unknownAttrs) + ); + } + + # merge attributes that were given on cmdline with the ones that + # already exist in the DB and finally with the default values + $self->{'plugin-attrs'} = { %$givenAttrs }; + my $defaultAttrs = $self->{plugin}->getDefaultAttrsForVendorOS( + $vendorOSName + ); + my $dbAttrs = $self->_fetchInstalledPluginAttrs($vendorOSName); + for my $attrName (keys %$defaultAttrs) { + next if exists $givenAttrs->{$attrName}; + $self->{'plugin-attrs'}->{$attrName} + = exists $dbAttrs->{$attrName} + ? $dbAttrs->{$attrName} + : $defaultAttrs->{$attrName}->{default}; + } + } + + return 1; } =back @@ -148,51 +148,51 @@ the plugin's installer method while chrooted into that vendor-OS. sub installPlugin { - my $self = shift; - - if ($self->{'vendor-os-name'} ne '<<>>') { - - # as the attrs may be changed by the plugin during installation, we - # have to find a way to pass them back to this process (remember; - # installation takes place in a forked process in order to do a chroot). - # We simply serialize the attributes into a temp and deserialize it - # in the calling process. - my $serializedAttrsFile - = "$self->{'plugin-temp-path'}/serialized-attrs"; - my $chrootedSerializedAttrsFile - = "$self->{'chrooted-plugin-temp-path'}/serialized-attrs"; - - mkpath([ $self->{'plugin-repo-path'}, $self->{'plugin-temp-path'} ]); - - # HACK: do a dummy serialization here in order to get Storable - # completely loaded (otherwise it will complain in the chroot about - # missing modules). - store $self->{'plugin-attrs'}, $serializedAttrsFile; - - $self->_callChrootedFunctionForPlugin( - sub { - # invoke plugin and let it install itself into vendor-OS - $self->{plugin}->installationPhase( - $self->{'chrooted-plugin-repo-path'}, - $self->{'chrooted-plugin-temp-path'}, - $self->{'chrooted-openslx-base-path'}, - $self->{'plugin-attrs'}, - ); - - # serialize possibly changed attributes (executed inside chroot) - store $self->{'plugin-attrs'}, $chrootedSerializedAttrsFile; - } - ); - - # now retrieve (deserialize) the current attributes and store them - $self->{'plugin-attrs'} = retrieve $serializedAttrsFile; - $self->_addInstalledPluginToDB(); - - # cleanup temp path - rmtree([ $self->{'plugin-temp-path'} ]); - } - - return 1; + my $self = shift; + + if ($self->{'vendor-os-name'} ne '<<>>') { + + # as the attrs may be changed by the plugin during installation, we + # have to find a way to pass them back to this process (remember; + # installation takes place in a forked process in order to do a chroot). + # We simply serialize the attributes into a temp and deserialize it + # in the calling process. + my $serializedAttrsFile + = "$self->{'plugin-temp-path'}/serialized-attrs"; + my $chrootedSerializedAttrsFile + = "$self->{'chrooted-plugin-temp-path'}/serialized-attrs"; + + mkpath([ $self->{'plugin-repo-path'}, $self->{'plugin-temp-path'} ]); + + # HACK: do a dummy serialization here in order to get Storable + # completely loaded (otherwise it will complain in the chroot about + # missing modules). + store $self->{'plugin-attrs'}, $serializedAttrsFile; + + $self->_callChrootedFunctionForPlugin( + sub { + # invoke plugin and let it install itself into vendor-OS + $self->{plugin}->installationPhase( + $self->{'chrooted-plugin-repo-path'}, + $self->{'chrooted-plugin-temp-path'}, + $self->{'chrooted-openslx-base-path'}, + $self->{'plugin-attrs'}, + ); + + # serialize possibly changed attributes (executed inside chroot) + store $self->{'plugin-attrs'}, $chrootedSerializedAttrsFile; + } + ); + + # now retrieve (deserialize) the current attributes and store them + $self->{'plugin-attrs'} = retrieve $serializedAttrsFile; + $self->_addInstalledPluginToDB(); + + # cleanup temp path + rmtree([ $self->{'plugin-temp-path'} ]); + } + + return 1; } =item removePlugin() @@ -204,28 +204,28 @@ the plugin's removal method while chrooted into that vendor-OS. sub removePlugin { - my $self = shift; + my $self = shift; - if ($self->{'vendor-os-name'} ne '<<>>') { + if ($self->{'vendor-os-name'} ne '<<>>') { - mkpath([ $self->{'plugin-repo-path'}, $self->{'plugin-temp-path'} ]); + mkpath([ $self->{'plugin-repo-path'}, $self->{'plugin-temp-path'} ]); - $self->_callChrootedFunctionForPlugin( - sub { - $self->{plugin}->removalPhase( - $self->{'chrooted-plugin-repo-path'}, - $self->{'chrooted-plugin-temp-path'}, - $self->{'chrooted-openslx-base-path'}, - ); - } - ); + $self->_callChrootedFunctionForPlugin( + sub { + $self->{plugin}->removalPhase( + $self->{'chrooted-plugin-repo-path'}, + $self->{'chrooted-plugin-temp-path'}, + $self->{'chrooted-openslx-base-path'}, + ); + } + ); - rmtree([ $self->{'plugin-temp-path'} ]); - } - - $self->_removeInstalledPluginFromDB(); + rmtree([ $self->{'plugin-temp-path'} ]); + } + + $self->_removeInstalledPluginFromDB(); - return 1; + return 1; } =item getInstalledPlugins() @@ -237,22 +237,22 @@ vendor-OS. sub getInstalledPlugins { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - my $vendorOS = $openslxDB->fetchVendorOSByFilter( { - name => $self->{'vendor-os-name'}, - } ); - if (!$vendorOS) { - die _tr( - 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} - ); - } - my @installedPlugins = $openslxDB->fetchInstalledPlugins($vendorOS->{id}); - $openslxDB->disconnect(); - - return @installedPlugins; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + my $vendorOS = $openslxDB->fetchVendorOSByFilter( { + name => $self->{'vendor-os-name'}, + } ); + if (!$vendorOS) { + die _tr( + 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} + ); + } + my @installedPlugins = $openslxDB->fetchInstalledPlugins($vendorOS->{id}); + $openslxDB->disconnect(); + + return @installedPlugins; } =back @@ -275,9 +275,9 @@ Returns the name of the current vendor-OS. sub vendorOSName { - my $self = shift; + my $self = shift; - return $self->{'vendor-os-name'}; + return $self->{'vendor-os-name'}; } =item distroName() @@ -291,9 +291,9 @@ distro version, like 'suse-10.2' or 'ubuntu-7.04'. sub distroName { - my $self = shift; + my $self = shift; - return $self->{'ossetup-engine'}->distroName(); + return $self->{'ossetup-engine'}->distroName(); } =item downloadFile($fileURL, $targetPath, $wgetOptions) @@ -325,18 +325,18 @@ If the downloaded was successful this method returns C<1>, otherwise it dies. sub downloadFile { - my $self = shift; - my $fileURL = shift || return; - my $targetPath = shift || $self->{'chrooted-plugin-temp-path'}; - my $wgetOptions = shift || ''; - - my $busybox = $self->{'ossetup-engine'}->busyboxBinary(); - - if (slxsystem("$busybox wget -P $targetPath $wgetOptions $fileURL")) { - die _tr('unable to download file "%s"! (%s)', $fileURL, $!); - } - - return 1; + my $self = shift; + my $fileURL = shift || return; + my $targetPath = shift || $self->{'chrooted-plugin-temp-path'}; + my $wgetOptions = shift || ''; + + my $busybox = $self->{'ossetup-engine'}->busyboxBinary(); + + if (slxsystem("$busybox wget -P $targetPath $wgetOptions $fileURL")) { + die _tr('unable to download file "%s"! (%s)', $fileURL, $!); + } + + return 1; } =item getInstalledPackages() @@ -350,12 +350,12 @@ install additional packages. sub getInstalledPackages { - my $self = shift; + my $self = shift; - my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); - return if !$metaPackager; + my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); + return if !$metaPackager; - return $metaPackager->getInstalledPackages(); + return $metaPackager->getInstalledPackages(); } =item getInstallablePackagesForSelection() @@ -368,12 +368,12 @@ to complete the selection. sub getInstallablePackagesForSelection { - my $self = shift; - my $selection = shift; + my $self = shift; + my $selection = shift; - return $self->{'ossetup-engine'}->getInstallablePackagesForSelection( - $selection - ); + return $self->{'ossetup-engine'}->getInstallablePackagesForSelection( + $selection + ); } @@ -401,15 +401,15 @@ otherwise it dies. sub installPackages { - my $self = shift; - my $packages = shift; + my $self = shift; + my $packages = shift; - return if !$packages; + return if !$packages; - my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); - return if !$metaPackager; + my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); + return if !$metaPackager; - return $metaPackager->installPackages($packages); + return $metaPackager->installPackages($packages); } =item removePackages($packages) @@ -433,15 +433,15 @@ otherwise it dies. sub removePackages { - my $self = shift; - my $packages = shift; + my $self = shift; + my $packages = shift; - return if !$packages; + return if !$packages; - my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); - return if !$metaPackager; + my $metaPackager = $self->{'ossetup-engine'}->metaPackager(); + return if !$metaPackager; - return $metaPackager->removePackages($packages); + return $metaPackager->removePackages($packages); } =back @@ -450,148 +450,148 @@ sub removePackages sub _loadPlugin { - my $self = shift; - - my $pluginModule = "OpenSLX::OSPlugin::$self->{'plugin-name'}"; - my $plugin = instantiateClass( - $pluginModule, { pathToClass => $self->{'plugin-path'} } - ); - return if !$plugin; - - # if there's a distro folder, instantiate the most appropriate distro class - my $distro; - if (-d "$self->{'plugin-path'}/OpenSLX/Distro") { - unshift @INC, $self->{'plugin-path'}; - my $distroName = $self->distroName(); - $distroName =~ tr{.-}{__}; - my @distroModules; - while($distroName =~ m{^(.+)_[^_]*$}) { - push @distroModules, $distroName; - $distroName = $1; - } - push @distroModules, $distroName; - push @distroModules, 'Base'; - for my $distroModule (@distroModules) { - last if eval { - $distro = instantiateClass( - 'OpenSLX::Distro::' . $distroModule, - { pathToClass => $self->{'plugin-path'} } - ); - 1; - }; - } - shift @INC; - if (!$distro) { - die _tr( - 'unable to load any distro module for vendor-OS %s', - $self->{'vendor-os-name'} - ); - } - $distro->initialize($self); - } - - $plugin->initialize($self, $distro); - - return $plugin; + my $self = shift; + + my $pluginModule = "OpenSLX::OSPlugin::$self->{'plugin-name'}"; + my $plugin = instantiateClass( + $pluginModule, { pathToClass => $self->{'plugin-path'} } + ); + return if !$plugin; + + # if there's a distro folder, instantiate the most appropriate distro class + my $distro; + if (-d "$self->{'plugin-path'}/OpenSLX/Distro") { + unshift @INC, $self->{'plugin-path'}; + my $distroName = $self->distroName(); + $distroName =~ tr{.-}{__}; + my @distroModules; + while($distroName =~ m{^(.+)_[^_]*$}) { + push @distroModules, $distroName; + $distroName = $1; + } + push @distroModules, $distroName; + push @distroModules, 'Base'; + for my $distroModule (@distroModules) { + last if eval { + $distro = instantiateClass( + 'OpenSLX::Distro::' . $distroModule, + { pathToClass => $self->{'plugin-path'} } + ); + 1; + }; + } + shift @INC; + if (!$distro) { + die _tr( + 'unable to load any distro module for vendor-OS %s', + $self->{'vendor-os-name'} + ); + } + $distro->initialize($self); + } + + $plugin->initialize($self, $distro); + + return $plugin; } sub _callChrootedFunctionForPlugin { - my $self = shift; - my $function = shift; - - # bind-mount openslx basepath to /mnt/openslx of vendor-OS: - my $basePath = $openslxConfig{'base-path'}; - my $openslxPathInChroot = "$self->{'vendor-os-path'}/mnt/openslx"; - mkpath( [ $openslxPathInChroot ] ); - if (slxsystem("mount -o bind $basePath $openslxPathInChroot")) { - croak( - _tr( - "unable to bind mount '%s' to '%s'! (%s)", - $basePath, $openslxPathInChroot, $! - ) - ); - } - - # now let plugin install itself into vendor-OS - my $ok = eval { - $self->{'ossetup-engine'}->callChrootedFunctionForVendorOS($function); - }; - - if (slxsystem("umount $openslxPathInChroot")) { - croak(_tr("unable to umount '%s'! (%s)", $openslxPathInChroot, $!)); - } - - if (!$ok) { - die $@; - } - - return; + my $self = shift; + my $function = shift; + + # bind-mount openslx basepath to /mnt/openslx of vendor-OS: + my $basePath = $openslxConfig{'base-path'}; + my $openslxPathInChroot = "$self->{'vendor-os-path'}/mnt/openslx"; + mkpath( [ $openslxPathInChroot ] ); + if (slxsystem("mount -o bind $basePath $openslxPathInChroot")) { + croak( + _tr( + "unable to bind mount '%s' to '%s'! (%s)", + $basePath, $openslxPathInChroot, $! + ) + ); + } + + # now let plugin install itself into vendor-OS + my $ok = eval { + $self->{'ossetup-engine'}->callChrootedFunctionForVendorOS($function); + }; + + if (slxsystem("umount $openslxPathInChroot")) { + croak(_tr("unable to umount '%s'! (%s)", $openslxPathInChroot, $!)); + } + + if (!$ok) { + die $@; + } + + return; } sub _addInstalledPluginToDB { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - my $vendorOS = $openslxDB->fetchVendorOSByFilter( { - name => $self->{'vendor-os-name'}, - } ); - if (!$vendorOS) { - die _tr( - 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} - ); - } - $openslxDB->addInstalledPlugin( - $vendorOS->{id}, $self->{'plugin-name'}, $self->{'plugin-attrs'} - ); - $openslxDB->disconnect(); - - return 1; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + my $vendorOS = $openslxDB->fetchVendorOSByFilter( { + name => $self->{'vendor-os-name'}, + } ); + if (!$vendorOS) { + die _tr( + 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} + ); + } + $openslxDB->addInstalledPlugin( + $vendorOS->{id}, $self->{'plugin-name'}, $self->{'plugin-attrs'} + ); + $openslxDB->disconnect(); + + return 1; } sub _fetchInstalledPluginAttrs { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - my $vendorOS = $openslxDB->fetchVendorOSByFilter( { - name => $self->{'vendor-os-name'}, - } ); - if (!$vendorOS) { - die _tr( - 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} - ); - } - my $installedPlugin = $openslxDB->fetchInstalledPlugins( - $vendorOS->{id}, $self->{'plugin-name'} - ); - $openslxDB->disconnect(); - - return {} if !$installedPlugin; - return $installedPlugin->{attrs}; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + my $vendorOS = $openslxDB->fetchVendorOSByFilter( { + name => $self->{'vendor-os-name'}, + } ); + if (!$vendorOS) { + die _tr( + 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} + ); + } + my $installedPlugin = $openslxDB->fetchInstalledPlugins( + $vendorOS->{id}, $self->{'plugin-name'} + ); + $openslxDB->disconnect(); + + return {} if !$installedPlugin; + return $installedPlugin->{attrs}; } sub _removeInstalledPluginFromDB { - my $self = shift; - - my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); - $openslxDB->connect(); - my $vendorOS = $openslxDB->fetchVendorOSByFilter( { - name => $self->{'vendor-os-name'}, - } ); - if (!$vendorOS) { - die _tr( - 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} - ); - } - $openslxDB->removeInstalledPlugin($vendorOS->{id}, $self->{'plugin-name'}); - $openslxDB->disconnect(); - - return 1; + my $self = shift; + + my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); + $openslxDB->connect(); + my $vendorOS = $openslxDB->fetchVendorOSByFilter( { + name => $self->{'vendor-os-name'}, + } ); + if (!$vendorOS) { + die _tr( + 'unable to find vendor-OS "%s" in DB!', $self->{'vendor-os-name'} + ); + } + $openslxDB->removeInstalledPlugin($vendorOS->{id}, $self->{'plugin-name'}); + $openslxDB->disconnect(); + + return 1; } 1; diff --git a/os-plugins/OpenSLX/OSPlugin/Roster.pm b/os-plugins/OpenSLX/OSPlugin/Roster.pm index a8df3b38..023abb4c 100644 --- a/os-plugins/OpenSLX/OSPlugin/Roster.pm +++ b/os-plugins/OpenSLX/OSPlugin/Roster.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # OSPlugin::Roster.pm -# - provides information about all available plugins +# - provides information about all available plugins # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::Roster; @@ -29,15 +29,15 @@ Returns a hash that keys the names of available plugins to their info hash. sub getAvailablePlugins { - my $class = shift; + my $class = shift; - $class->_init() if !%plugins; + $class->_init() if !%plugins; - my %pluginInfo; - foreach my $pluginName (keys %plugins) { - $pluginInfo{$pluginName} = $plugins{$pluginName}->getInfo(); - } - return \%pluginInfo; + my %pluginInfo; + foreach my $pluginName (keys %plugins) { + $pluginInfo{$pluginName} = $plugins{$pluginName}->getInfo(); + } + return \%pluginInfo; } =item C @@ -48,15 +48,15 @@ Returns an instance of the plugin with the given name sub getPlugin { - my $class = shift; - my $pluginName = shift; + my $class = shift; + my $pluginName = shift; - $class->_init() if !%plugins; + $class->_init() if !%plugins; - my $plugin = $plugins{$pluginName}; - return if !$plugin; + my $plugin = $plugins{$pluginName}; + return if !$plugin; - return dclone($plugin); + return dclone($plugin); } =item C @@ -68,14 +68,14 @@ given plugin sub getPluginAttrInfo { - my $class = shift; - my $pluginName = shift; + my $class = shift; + my $pluginName = shift; - $class->_init() if !%plugins; + $class->_init() if !%plugins; - return if !$plugins{$pluginName}; + return if !$plugins{$pluginName}; - return $plugins{$pluginName}->getAttrInfo(); + return $plugins{$pluginName}->getAttrInfo(); } =item C @@ -98,11 +98,11 @@ added. sub addAllAttributesToHash { - my $class = shift; - my $attrInfo = shift; - my $pluginName = shift; + my $class = shift; + my $attrInfo = shift; + my $pluginName = shift; - return $class->_addAttributesToHash($attrInfo, $pluginName, sub { 1 } ); + return $class->_addAttributesToHash($attrInfo, $pluginName, sub { 1 } ); } =item C @@ -125,14 +125,14 @@ added. sub addAllStage1AttributesToHash { - my $class = shift; - my $attrInfo = shift; - my $pluginName = shift; - - return $class->_addAttributesToHash($attrInfo, $pluginName, sub { - my $attr = shift; - return $attr->{applies_to_vendor_os}; - } ); + my $class = shift; + my $attrInfo = shift; + my $pluginName = shift; + + return $class->_addAttributesToHash($attrInfo, $pluginName, sub { + my $attr = shift; + return $attr->{applies_to_vendor_os}; + } ); } =item C @@ -155,59 +155,59 @@ added. sub addAllStage3AttributesToHash { - my $class = shift; - my $attrInfo = shift; - my $pluginName = shift; - - return $class->_addAttributesToHash($attrInfo, $pluginName, sub { - my $attr = shift; - return $attr->{applies_to_systems} || $attr->{applies_to_clients}; - } ); + my $class = shift; + my $attrInfo = shift; + my $pluginName = shift; + + return $class->_addAttributesToHash($attrInfo, $pluginName, sub { + my $attr = shift; + return $attr->{applies_to_systems} || $attr->{applies_to_clients}; + } ); } sub _addAttributesToHash { - my $class = shift; - my $attrInfo = shift; - my $pluginName = shift; - my $testFunc = shift; - - $class->_init() if !%plugins; - - foreach my $plugin (values %plugins) { - next if $pluginName && $plugin->{name} ne $pluginName; - my $pluginAttrInfo = $plugin->getAttrInfo(); - foreach my $attr (keys %$pluginAttrInfo) { - next if !$testFunc->($pluginAttrInfo->{$attr}); - $attrInfo->{$attr} = dclone($pluginAttrInfo->{$attr}); - } - } - return 1; + my $class = shift; + my $attrInfo = shift; + my $pluginName = shift; + my $testFunc = shift; + + $class->_init() if !%plugins; + + foreach my $plugin (values %plugins) { + next if $pluginName && $plugin->{name} ne $pluginName; + my $pluginAttrInfo = $plugin->getAttrInfo(); + foreach my $attr (keys %$pluginAttrInfo) { + next if !$testFunc->($pluginAttrInfo->{$attr}); + $attrInfo->{$attr} = dclone($pluginAttrInfo->{$attr}); + } + } + return 1; } sub _init { - my $class = shift; - - %plugins = (); - my $pluginPath = "$openslxConfig{'base-path'}/lib/plugins"; - foreach my $modulePath (glob("$pluginPath/*")) { - next if $modulePath !~ m{/([^/]+)$}; - my $pluginName = $1; - if (!-e "$modulePath/OpenSLX/OSPlugin/$pluginName.pm") { - vlog( - 1, - "skipped plugin-folder $modulePath as no corresponding perl " - . "module could be found." - ); - next; - } - my $class = "OpenSLX::OSPlugin::$pluginName"; - vlog(2, "loading plugin $class from path '$modulePath'"); - my $plugin = instantiateClass($class, { pathToClass => $modulePath }); - $plugins{$pluginName} = $plugin; - } - return; + my $class = shift; + + %plugins = (); + my $pluginPath = "$openslxConfig{'base-path'}/lib/plugins"; + foreach my $modulePath (glob("$pluginPath/*")) { + next if $modulePath !~ m{/([^/]+)$}; + my $pluginName = $1; + if (!-e "$modulePath/OpenSLX/OSPlugin/$pluginName.pm") { + vlog( + 1, + "skipped plugin-folder $modulePath as no corresponding perl " + . "module could be found." + ); + next; + } + my $class = "OpenSLX::OSPlugin::$pluginName"; + vlog(2, "loading plugin $class from path '$modulePath'"); + my $plugin = instantiateClass($class, { pathToClass => $modulePath }); + $plugins{$pluginName} = $plugin; + } + return; } 1; diff --git a/os-plugins/plugins/bootsplash/OpenSLX/OSPlugin/bootsplash.pm b/os-plugins/plugins/bootsplash/OpenSLX/OSPlugin/bootsplash.pm index 16345136..55e557f3 100644 --- a/os-plugins/plugins/bootsplash/OpenSLX/OSPlugin/bootsplash.pm +++ b/os-plugins/plugins/bootsplash/OpenSLX/OSPlugin/bootsplash.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # bootsplash.pm -# - implementation of the 'bootsplash' plugin, which installs splashy +# - implementation of the 'bootsplash' plugin, which installs splashy # into the ramfs, including changeing theme # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::bootsplash; @@ -24,138 +24,138 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'bootsplash', - }; + my $self = { + name => 'bootsplash', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - Installs Splashy as bootsplash into ramfs and sets a Theme. - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + Installs Splashy as bootsplash into ramfs and sets a Theme. + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo { - my $self = shift; - - return { - 'bootsplash::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'bootsplash'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - 'bootsplash::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'bootsplash' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 30, - }, - - 'bootsplash::theme' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to bootsplash (unset for no theme) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'openslx', - }, - }; + my $self = shift; + + return { + 'bootsplash::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'bootsplash'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + 'bootsplash::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'bootsplash' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 30, + }, + + 'bootsplash::theme' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to bootsplash (unset for no theme) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'openslx', + }, + }; } sub suggestAdditionalKernelParams { - my $self = shift; - my $makeInitRamFSEngine = shift; - - my @suggestedParams; - - # add vga=0x317 unless explicit vga-mode is already set - if (!$makeInitRamFSEngine->haveKernelParam(qr{\bvga=})) { - push @suggestedParams, 'vga=0x317'; - } - - # add quiet, if not already set - if (!$makeInitRamFSEngine->haveKernelParam('quiet')) { - push @suggestedParams, 'quiet'; - } - - return @suggestedParams; + my $self = shift; + my $makeInitRamFSEngine = shift; + + my @suggestedParams; + + # add vga=0x317 unless explicit vga-mode is already set + if (!$makeInitRamFSEngine->haveKernelParam(qr{\bvga=})) { + push @suggestedParams, 'vga=0x317'; + } + + # add quiet, if not already set + if (!$makeInitRamFSEngine->haveKernelParam('quiet')) { + push @suggestedParams, 'quiet'; + } + + return @suggestedParams; } sub suggestAdditionalKernelModules { - my $self = shift; - my $makeInitRamFSEngine = shift; - - my @suggestedModules; - - # Ubuntu needs vesafb and fbcon (which drags along some others) - if ($makeInitRamFSEngine->{'distro-name'} =~ m{^ubuntu}i) { - push @suggestedModules, qw( vesafb fbcon ) - } - - return @suggestedModules; + my $self = shift; + my $makeInitRamFSEngine = shift; + + my @suggestedModules; + + # Ubuntu needs vesafb and fbcon (which drags along some others) + if ($makeInitRamFSEngine->{'distro-name'} =~ m{^ubuntu}i) { + push @suggestedModules, qw( vesafb fbcon ) + } + + return @suggestedModules; } sub copyRequiredFilesIntoInitramfs { - my $self = shift; - my $targetPath = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - my $themeDir = "$openslxConfig{'base-path'}/share/themes"; - my $bootsplashTheme = $attrs->{'bootsplash::theme'} || ''; - if ($bootsplashTheme) { - my $bootsplashThemeDir = "$themeDir/$bootsplashTheme/bootsplash"; - if (-d $bootsplashThemeDir) { - my $splashyPath = "$openslxConfig{'base-path'}/share/splashy"; - $makeInitRamFSEngine->addCMD( - "cp -p $splashyPath/* $targetPath/bin/" - ); - $makeInitRamFSEngine->addCMD( - "mkdir -p $targetPath/etc/splashy" - ); - $makeInitRamFSEngine->addCMD( - "cp -a $bootsplashThemeDir/* $targetPath/etc/splashy/" - ); - } - } - else { - $bootsplashTheme = ''; - } - - vlog( - 1, - _tr( - "bootsplash-plugin: bootsplash=%s", - $bootsplashTheme - ) - ); - - return; + my $self = shift; + my $targetPath = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + my $themeDir = "$openslxConfig{'base-path'}/share/themes"; + my $bootsplashTheme = $attrs->{'bootsplash::theme'} || ''; + if ($bootsplashTheme) { + my $bootsplashThemeDir = "$themeDir/$bootsplashTheme/bootsplash"; + if (-d $bootsplashThemeDir) { + my $splashyPath = "$openslxConfig{'base-path'}/share/splashy"; + $makeInitRamFSEngine->addCMD( + "cp -p $splashyPath/* $targetPath/bin/" + ); + $makeInitRamFSEngine->addCMD( + "mkdir -p $targetPath/etc/splashy" + ); + $makeInitRamFSEngine->addCMD( + "cp -a $bootsplashThemeDir/* $targetPath/etc/splashy/" + ); + } + } + else { + $bootsplashTheme = ''; + } + + vlog( + 1, + _tr( + "bootsplash-plugin: bootsplash=%s", + $bootsplashTheme + ) + ); + + return; } 1; diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/Base.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/Base.pm index 37cfff46..3764de39 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/Base.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/Base.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # base.pm -# - provides empty base of the OpenSLX OSPlugin Distro API for the desktop +# - provides empty base of the OpenSLX OSPlugin Distro API for the desktop # plugin. # ----------------------------------------------------------------------------- package OpenSLX::Distro::Base; @@ -17,7 +17,7 @@ package OpenSLX::Distro::Base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; use OpenSLX::Utils; @@ -27,204 +27,204 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - $self->{engine} = shift; - - return 1; + my $self = shift; + $self->{engine} = shift; + + return 1; } sub isInPath { - my $self = shift; - my $binary = shift; - - my $path = qx{which $binary 2>/dev/null}; + my $self = shift; + my $binary = shift; + + my $path = qx{which $binary 2>/dev/null}; - return $path ? 1 : 0; + return $path ? 1 : 0; } sub isGNOMEInstalled { - my $self = shift; + my $self = shift; - return $self->isInPath('gnome-session'); + return $self->isInPath('gnome-session'); } sub isGDMInstalled { - my $self = shift; + my $self = shift; - return $self->isInPath('gdm'); + return $self->isInPath('gdm'); } sub installGNOME { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages( - $self->{engine}->getInstallablePackagesForSelection('gnome') - ); + $self->{engine}->installPackages( + $self->{engine}->getInstallablePackagesForSelection('gnome') + ); - return 1; + return 1; } sub installGDM { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages('gdm'); + $self->{engine}->installPackages('gdm'); - return 1; + return 1; } sub GDMPathInfo { - my $self = shift; - - my $pathInfo = { - config => '/etc/gdm/gdm.conf', - paths => [ - '/var/lib/gdm', - '/var/log/gdm', - ], - }; + my $self = shift; + + my $pathInfo = { + config => '/etc/gdm/gdm.conf', + paths => [ + '/var/lib/gdm', + '/var/log/gdm', + ], + }; - return $pathInfo; + return $pathInfo; } sub GDMConfigHashForWorkstation { - my $self = shift; - - return { - 'chooser' => { - }, - 'daemon' => { - AutomaticLoginEnable => 'false', - BaseXsession => '/etc/X11/Xsession', - Group => 'gdm', - User => 'gdm', - }, - 'debug' => { - Enable => 'false', - }, - 'greeter' => { - AllowShutdown => 'true', - Browser => 'false', - MinimalUID => '500', - SecureShutdown => 'false', - ShowDomain => 'false', - }, - 'gui' => { - }, - 'security' => { - AllowRemoteRoot => 'false', - DisallowTCP => 'true', - SupportAutomount => 'true', - }, - 'server' => { - }, - 'xdmcp' => { - Enable => 'false', - }, - }; + my $self = shift; + + return { + 'chooser' => { + }, + 'daemon' => { + AutomaticLoginEnable => 'false', + BaseXsession => '/etc/X11/Xsession', + Group => 'gdm', + User => 'gdm', + }, + 'debug' => { + Enable => 'false', + }, + 'greeter' => { + AllowShutdown => 'true', + Browser => 'false', + MinimalUID => '500', + SecureShutdown => 'false', + ShowDomain => 'false', + }, + 'gui' => { + }, + 'security' => { + AllowRemoteRoot => 'false', + DisallowTCP => 'true', + SupportAutomount => 'true', + }, + 'server' => { + }, + 'xdmcp' => { + Enable => 'false', + }, + }; } sub GDMConfigHashForKiosk { - my $self = shift; - - my $configHash = $self->GDMConfigHashForWorkstation(); + my $self = shift; + + my $configHash = $self->GDMConfigHashForWorkstation(); - $configHash->{daemon}->{AutomaticLoginEnable} = 'true'; - $configHash->{daemon}->{AutomaticLogin} = 'nobody'; + $configHash->{daemon}->{AutomaticLoginEnable} = 'true'; + $configHash->{daemon}->{AutomaticLogin} = 'nobody'; - return $configHash; + return $configHash; } sub GDMConfigHashForChooser { - my $self = shift; - - my $configHash = $self->GDMConfigHashForWorkstation(); - $configHash->{xdmcp}->{Enable} = 'true'; + my $self = shift; + + my $configHash = $self->GDMConfigHashForWorkstation(); + $configHash->{xdmcp}->{Enable} = 'true'; - return $configHash; + return $configHash; } sub isKDEInstalled { - my $self = shift; - - return $self->isInPath('startkde'); + my $self = shift; + + return $self->isInPath('startkde'); } sub isKDMInstalled { - my $self = shift; + my $self = shift; - return $self->isInPath('kdm'); + return $self->isInPath('kdm'); } sub installKDE { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages( - $self->{engine}->getInstallablePackagesForSelection('kde') - ); + $self->{engine}->installPackages( + $self->{engine}->getInstallablePackagesForSelection('kde') + ); - return 1; + return 1; } sub installKDM { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages('kdm'); + $self->{engine}->installPackages('kdm'); - return 1; + return 1; } sub isXFCEInstalled { - my $self = shift; + my $self = shift; - return $self->isInPath('startxfce4'); + return $self->isInPath('startxfce4'); } sub isXDMInstalled { - my $self = shift; + my $self = shift; - return $self->isInPath('xdm'); + return $self->isInPath('xdm'); } sub installXFCE { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages( - $self->{engine}->getInstallablePackagesForSelection('xfce') - ); + $self->{engine}->installPackages( + $self->{engine}->getInstallablePackagesForSelection('xfce') + ); - return 1; + return 1; } sub installXDM { - my $self = shift; + my $self = shift; - $self->{engine}->installPackages('xdm'); + $self->{engine}->installPackages('xdm'); - return 1; + return 1; } 1; diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/debian.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/debian.pm index c5e6c5cd..2d837629 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/debian.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/debian.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # debian.pm -# - provides Debian-specific overrides of the OpenSLX Distro API for the +# - provides Debian-specific overrides of the OpenSLX Distro API for the # desktop plugin. # ----------------------------------------------------------------------------- package OpenSLX::Distro::debian; diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/fedora.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/fedora.pm index 7fe4973c..0bc9ebdc 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/fedora.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/fedora.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Fedora.pm -# - provides Fedora-specific overrides of the OpenSLX OSSetup API. +# - provides Fedora-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Fedora; @@ -25,24 +25,24 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub initialize { - my $self = shift; - my $engine = shift; + my $self = shift; + my $engine = shift; - $self->SUPER::initialize($engine); - $self->{'packager-type'} = 'rpm'; - $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'yum'; - $self->{'stage1c-faked-files'} = [ - '/etc/fstab', - '/etc/mtab', - ]; - return; + $self->SUPER::initialize($engine); + $self->{'packager-type'} = 'rpm'; + $self->{'meta-packager-type'} = $ENV{SLX_META_PACKAGER} || 'yum'; + $self->{'stage1c-faked-files'} = [ + '/etc/fstab', + '/etc/mtab', + ]; + return; } 1; \ No newline at end of file diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/gentoo.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/gentoo.pm index 4d1032f7..c49ba5d6 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/gentoo.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/gentoo.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SUSE.pm -# - provides SUSE-specific overrides of the OpenSLX OSSetup API. +# - provides SUSE-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::OSSetup::Distro::Gentoo; @@ -25,34 +25,34 @@ use OpenSLX::Basics; ################################################################################ sub new { - my $class = shift; - my $self = {}; - return bless $self, $class; + my $class = shift; + my $self = {}; + return bless $self, $class; } sub pickKernelFile { - my $self = shift; - my $kernelPath = shift; - - my $newestKernelFile; - my $newestKernelFileSortKey = ''; - foreach my $kernelFile (glob("$kernelPath/kernel-genkernel-x86-*")) { - next unless $kernelFile =~ m{ - x86-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) - }x; - my $sortKey - = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); - if ($newestKernelFileSortKey lt $sortKey) { - $newestKernelFile = $kernelFile; - $newestKernelFileSortKey = $sortKey; - } - } - - if (!defined $newestKernelFile) { - die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); - } - return $newestKernelFile; + my $self = shift; + my $kernelPath = shift; + + my $newestKernelFile; + my $newestKernelFileSortKey = ''; + foreach my $kernelFile (glob("$kernelPath/kernel-genkernel-x86-*")) { + next unless $kernelFile =~ m{ + x86-(\d+)\.(\d+)\.(\d+)(?:\.(\d+))?-(\d+(?:\.\d+)?) + }x; + my $sortKey + = sprintf("%02d.%02d.%02d.%02d-%2.1f", $1, $2, $3, $4||0, $5); + if ($newestKernelFileSortKey lt $sortKey) { + $newestKernelFile = $kernelFile; + $newestKernelFileSortKey = $sortKey; + } + } + + if (!defined $newestKernelFile) { + die _tr("unable to pick a kernel-file from path '%s'!", $kernelPath); + } + return $newestKernelFile; } 1; diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/suse.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/suse.pm index 761a3705..e360e1b5 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/suse.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/suse.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # SUSE.pm -# - provides SUSE-specific overrides of the OpenSLX Distro API for the desktop +# - provides SUSE-specific overrides of the OpenSLX Distro API for the desktop # plugin. # ----------------------------------------------------------------------------- package OpenSLX::Distro::suse; diff --git a/os-plugins/plugins/desktop/OpenSLX/Distro/ubuntu.pm b/os-plugins/plugins/desktop/OpenSLX/Distro/ubuntu.pm index 9982d363..c932f87f 100644 --- a/os-plugins/plugins/desktop/OpenSLX/Distro/ubuntu.pm +++ b/os-plugins/plugins/desktop/OpenSLX/Distro/ubuntu.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # Ubuntu.pm -# - provides Ubuntu-specific overrides of the OpenSLX OSSetup API. +# - provides Ubuntu-specific overrides of the OpenSLX OSSetup API. # ----------------------------------------------------------------------------- package OpenSLX::Distro::ubuntu; diff --git a/os-plugins/plugins/desktop/OpenSLX/OSPlugin/desktop.pm b/os-plugins/plugins/desktop/OpenSLX/OSPlugin/desktop.pm index bef21fa9..9aa78d49 100644 --- a/os-plugins/plugins/desktop/OpenSLX/OSPlugin/desktop.pm +++ b/os-plugins/plugins/desktop/OpenSLX/OSPlugin/desktop.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # desktop.pm -# - implementation of the 'desktop' plugin, which installs +# - implementation of the 'desktop' plugin, which installs # all needed information for a displaymanager and for the desktop. # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::desktop; @@ -27,449 +27,449 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'desktop', - }; + my $self = { + name => 'desktop', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - Sets a desktop and creates needed configs, theme can be set as well. - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + Sets a desktop and creates needed configs, theme can be set as well. + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo { - my $self = shift; - - return { - 'desktop::active' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'desktop'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - 'desktop::precedence' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'desktop' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 40, - }, - 'desktop::manager' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - which display manager to start: gdm, kdm or xdm? - End-of-Here - content_regex => qr{^(g|k|x)dm$}, - content_descr => 'allowed: gdm, kdm, xdm', - default => undef, - }, - 'desktop::kind' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - which desktop environment shall be used: gnome, kde, or xfce? - End-of-Here - content_regex => qr{^(gnome,kde,xfce)$}, - content_descr => 'allowed: gnome, kde, xfce', - default => undef, - }, - 'desktop::mode' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - which type of operation mode shall be activated: - workstattion, kiosk or chooser? - End-of-Here - content_regex => qr{^(workstation|kiosk|chooser)$}, - content_descr => 'allowed: workstation,kiosk,chooser', - default => 'workstation', - }, - 'desktop::theme' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to the desktop (unset for no theme) - End-of-Here - content_descr => 'one of the entries in "supported_themes"', - default => 'openslx', - }, - 'desktop::supported_themes' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - name of all themes that shall be installed in vendor-OS (such - that they can be selected via 'desktop::theme' in stage 3). - End-of-Here - content_descr => 'a comma-separated list of theme names', - default => 'openslx,blue,circles', - }, - 'desktop::gdm' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should gdm be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - 'desktop::kdm' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should kdm be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - 'desktop::xdm' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should xdm be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - 'desktop::gnome' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should gnome be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - 'desktop::kde' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should kde be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - 'desktop::xfce' => { - applies_to_vendor_os => 1, - description => unshiftHereDoc(<<' End-of-Here'), - should xfce be available (installed in vendor-OS)? - End-of-Here - content_regex => qr{^0|1$}, - content_descr => '"0", "1" or "-" (for unset)', - default => undef, - }, - }; + my $self = shift; + + return { + 'desktop::active' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'desktop'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + 'desktop::precedence' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'desktop' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 40, + }, + 'desktop::manager' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + which display manager to start: gdm, kdm or xdm? + End-of-Here + content_regex => qr{^(g|k|x)dm$}, + content_descr => 'allowed: gdm, kdm, xdm', + default => undef, + }, + 'desktop::kind' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + which desktop environment shall be used: gnome, kde, or xfce? + End-of-Here + content_regex => qr{^(gnome,kde,xfce)$}, + content_descr => 'allowed: gnome, kde, xfce', + default => undef, + }, + 'desktop::mode' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + which type of operation mode shall be activated: + workstattion, kiosk or chooser? + End-of-Here + content_regex => qr{^(workstation|kiosk|chooser)$}, + content_descr => 'allowed: workstation,kiosk,chooser', + default => 'workstation', + }, + 'desktop::theme' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to the desktop (unset for no theme) + End-of-Here + content_descr => 'one of the entries in "supported_themes"', + default => 'openslx', + }, + 'desktop::supported_themes' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + name of all themes that shall be installed in vendor-OS (such + that they can be selected via 'desktop::theme' in stage 3). + End-of-Here + content_descr => 'a comma-separated list of theme names', + default => 'openslx,blue,circles', + }, + 'desktop::gdm' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should gdm be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + 'desktop::kdm' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should kdm be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + 'desktop::xdm' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should xdm be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + 'desktop::gnome' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should gnome be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + 'desktop::kde' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should kde be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + 'desktop::xfce' => { + applies_to_vendor_os => 1, + description => unshiftHereDoc(<<' End-of-Here'), + should xfce be available (installed in vendor-OS)? + End-of-Here + content_regex => qr{^0|1$}, + content_descr => '"0", "1" or "-" (for unset)', + default => undef, + }, + }; } sub getDefaultAttrsForVendorOS { - my $self = shift; - my $vendorOSName = shift; - - my $attrs = $self->getAttrInfo(); - - if ($vendorOSName =~ m{kde}) { - $attrs->{'desktop::manager'}->{default} = 'kdm'; - $attrs->{'desktop::kind'}->{default} = 'kde'; - } - elsif ($vendorOSName =~ m{gnome}) { - $attrs->{'desktop::manager'}->{default} = 'gdm'; - $attrs->{'desktop::kind'}->{default} = 'gnome'; - } - elsif ($vendorOSName =~ m{xfce}) { - $attrs->{'desktop::manager'}->{default} = 'xdm'; - $attrs->{'desktop::kind'}->{default} = 'xcfe'; - } - else { - # TODO: chroot into vendor-OS and determine the available desktop - } - return $attrs; + my $self = shift; + my $vendorOSName = shift; + + my $attrs = $self->getAttrInfo(); + + if ($vendorOSName =~ m{kde}) { + $attrs->{'desktop::manager'}->{default} = 'kdm'; + $attrs->{'desktop::kind'}->{default} = 'kde'; + } + elsif ($vendorOSName =~ m{gnome}) { + $attrs->{'desktop::manager'}->{default} = 'gdm'; + $attrs->{'desktop::kind'}->{default} = 'gnome'; + } + elsif ($vendorOSName =~ m{xfce}) { + $attrs->{'desktop::manager'}->{default} = 'xdm'; + $attrs->{'desktop::kind'}->{default} = 'xcfe'; + } + else { + # TODO: chroot into vendor-OS and determine the available desktop + } + return $attrs; } sub installationPhase { - my $self = shift; - - $self->{pluginRepositoryPath} = shift; - $self->{pluginTempPath} = shift; - $self->{openslxPath} = shift; - $self->{attrs} = shift; - - # We are going to change some of the stage1 attributes during installation - # (basically we are filling the ones that are not defined). Since the result - # of these changes might change between invocations, we do not want to store - # the resulting values, but we want to store the original (undef). - # In order to do so, we copy all stage1 attributes directly into the - # object hash and change them there. - $self->{gdm} = $self->{attrs}->{'desktop::gdm'}; - $self->{kdm} = $self->{attrs}->{'desktop::kdm'}; - $self->{xdm} = $self->{attrs}->{'desktop::xdm'}; - $self->{gnome} = $self->{attrs}->{'desktop::gnome'}; - $self->{kde} = $self->{attrs}->{'desktop::kde'}; - $self->{xcfe} = $self->{attrs}->{'desktop::xfce'}; - + my $self = shift; + + $self->{pluginRepositoryPath} = shift; + $self->{pluginTempPath} = shift; + $self->{openslxPath} = shift; + $self->{attrs} = shift; + + # We are going to change some of the stage1 attributes during installation + # (basically we are filling the ones that are not defined). Since the result + # of these changes might change between invocations, we do not want to store + # the resulting values, but we want to store the original (undef). + # In order to do so, we copy all stage1 attributes directly into the + # object hash and change them there. + $self->{gdm} = $self->{attrs}->{'desktop::gdm'}; + $self->{kdm} = $self->{attrs}->{'desktop::kdm'}; + $self->{xdm} = $self->{attrs}->{'desktop::xdm'}; + $self->{gnome} = $self->{attrs}->{'desktop::gnome'}; + $self->{kde} = $self->{attrs}->{'desktop::kde'}; + $self->{xcfe} = $self->{attrs}->{'desktop::xfce'}; + use Data::Dumper; print Dumper $self->{attrs}; - $self->_installRequiredPackages(); - $self->_fillUnsetStage1Attrs(); - $self->_ensureSensibleStage3Attrs(); + $self->_installRequiredPackages(); + $self->_fillUnsetStage1Attrs(); + $self->_ensureSensibleStage3Attrs(); use Data::Dumper; print Dumper $self->{attrs}; - # start to actually do something - according to current stage1 attributes - if ($self->{gdm}) { - $self->_setupGDM(); - } - if ($self->{kdm}) { - $self->_setupKDM(); - } - if ($self->{xdm}) { - $self->_setupXDM(); - } - - return; + # start to actually do something - according to current stage1 attributes + if ($self->{gdm}) { + $self->_setupGDM(); + } + if ($self->{kdm}) { + $self->_setupKDM(); + } + if ($self->{xdm}) { + $self->_setupXDM(); + } + + return; } sub removalPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - my $pluginTempPath = shift; + my $self = shift; + my $pluginRepositoryPath = shift; + my $pluginTempPath = shift; - return; + return; } sub copyRequiredFilesIntoInitramfs { - my $self = shift; - my $targetPath = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - my $themeDir = "$openslxConfig{'base-path'}/share/themes"; + my $self = shift; + my $targetPath = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + my $themeDir = "$openslxConfig{'base-path'}/share/themes"; my $desktopXdmcp = $attrs->{'desktop::xdmcp'} || ''; - my $xdmcpConfigDir = "$openslxConfig{'base-path'}/lib/plugins/desktop/files/$desktopXdmcp"; - my $desktopTheme = $attrs->{'desktop::theme'} || ''; - if ($desktopTheme) { - my $desktopThemeDir - = "$themeDir/$desktopTheme/desktop/$desktopXdmcp"; - if (-d $desktopThemeDir) { + my $xdmcpConfigDir = "$openslxConfig{'base-path'}/lib/plugins/desktop/files/$desktopXdmcp"; + my $desktopTheme = $attrs->{'desktop::theme'} || ''; + if ($desktopTheme) { + my $desktopThemeDir + = "$themeDir/$desktopTheme/desktop/$desktopXdmcp"; + if (-d $desktopThemeDir) { $makeInitRamFSEngine->addCMD( "mkdir -p $targetPath/usr/share/files" ); - $makeInitRamFSEngine->addCMD( - "mkdir -p $targetPath/usr/share/themes" - ); - $makeInitRamFSEngine->addCMD( - "cp -a $desktopThemeDir $targetPath/usr/share/themes/" - ); + $makeInitRamFSEngine->addCMD( + "mkdir -p $targetPath/usr/share/themes" + ); + $makeInitRamFSEngine->addCMD( + "cp -a $desktopThemeDir $targetPath/usr/share/themes/" + ); $makeInitRamFSEngine->addCMD( "cp -a $xdmcpConfigDir $targetPath/usr/share/files" ); - } - } - else { - $desktopTheme = ''; - } - - vlog( - 1, - _tr( - "desktop-plugin: desktop=%s", - $desktopTheme - ) - ); - - return; + } + } + else { + $desktopTheme = ''; + } + + vlog( + 1, + _tr( + "desktop-plugin: desktop=%s", + $desktopTheme + ) + ); + + return; } sub _installRequiredPackages { - my $self = shift; - - my $engine = $self->{'os-plugin-engine'}; - - if ($self->{'gnome'} && !$self->{distro}->isGNOMEInstalled()) { - $self->{distro}->installGNOME(); - } - if ($self->{'gdm'} && !$self->{distro}->isGDMInstalled()) { - $self->{distro}->installGDM(); - } - if ($self->{'kde'} && !$self->{distro}->isKDEInstalled()) { - $self->{distro}->installKDE(); - } - if ($self->{'kdm'} && !$self->{distro}->isKDMInstalled()) { - $self->{distro}->installKDM(); - } - if ($self->{'xfce'} && !$self->{distro}->isXFCEInstalled()) { - $self->{distro}->installXFCE(); - } - if ($self->{'xdm'} && !$self->{distro}->isXDMInstalled()) { - $self->{distro}->installXDM(); - } - - return 1; + my $self = shift; + + my $engine = $self->{'os-plugin-engine'}; + + if ($self->{'gnome'} && !$self->{distro}->isGNOMEInstalled()) { + $self->{distro}->installGNOME(); + } + if ($self->{'gdm'} && !$self->{distro}->isGDMInstalled()) { + $self->{distro}->installGDM(); + } + if ($self->{'kde'} && !$self->{distro}->isKDEInstalled()) { + $self->{distro}->installKDE(); + } + if ($self->{'kdm'} && !$self->{distro}->isKDMInstalled()) { + $self->{distro}->installKDM(); + } + if ($self->{'xfce'} && !$self->{distro}->isXFCEInstalled()) { + $self->{distro}->installXFCE(); + } + if ($self->{'xdm'} && !$self->{distro}->isXDMInstalled()) { + $self->{distro}->installXDM(); + } + + return 1; } sub _fillUnsetStage1Attrs { - my $self = shift; - - if (!defined $self->{'gnome'}) { - $self->{'gnome'} = $self->{distro}->isGNOMEInstalled(); - } - if (!defined $self->{'gdm'}) { - $self->{'gdm'} = $self->{distro}->isGDMInstalled(); - } - if (!defined $self->{'kde'}) { - $self->{'kde'} = $self->{distro}->isKDEInstalled(); - } - if (!defined $self->{'kdm'}) { - $self->{'kdm'} = $self->{distro}->isKDMInstalled(); - } - if (!defined $self->{'xfce'}) { - $self->{'xfce'} = $self->{distro}->isXFCEInstalled(); - } - if (!defined $self->{'xdm'}) { - $self->{'xdm'} = $self->{distro}->isXDMInstalled(); - } - - return 1; + my $self = shift; + + if (!defined $self->{'gnome'}) { + $self->{'gnome'} = $self->{distro}->isGNOMEInstalled(); + } + if (!defined $self->{'gdm'}) { + $self->{'gdm'} = $self->{distro}->isGDMInstalled(); + } + if (!defined $self->{'kde'}) { + $self->{'kde'} = $self->{distro}->isKDEInstalled(); + } + if (!defined $self->{'kdm'}) { + $self->{'kdm'} = $self->{distro}->isKDMInstalled(); + } + if (!defined $self->{'xfce'}) { + $self->{'xfce'} = $self->{distro}->isXFCEInstalled(); + } + if (!defined $self->{'xdm'}) { + $self->{'xdm'} = $self->{distro}->isXDMInstalled(); + } + + return 1; } sub _ensureSensibleStage3Attrs { - my $self = shift; - - # check if current desktop kind is enabled at all and select another - # one, if it isn't - my $kind = $self->{attrs}->{'desktop::kind'} || ''; - if (!$self->{$kind}) { - my @desktops = map { $self->{$_} ? $_ : () } qw( gnome kde xfce ); - if (!@desktops) { - die _tr( - "no desktop kind is possible, plugin 'desktop' wouldn't work!" - ); - } - $self->{attrs}->{'desktop::kind'} = $desktops[0]; - } - - # check if current desktop manager is enabled at all and select another - # one, if it isn't - my $manager = $self->{attrs}->{'desktop::manager'} || ''; - if (!$self->{$manager}) { - my @managers = map { $self->{$_} ? $_ : () } qw( gdm kdm xdm ); - if (!@managers) { - die _tr( - "no desktop manager is possible, plugin 'desktop' wouldn't work!" - ); - } - $self->{attrs}->{'desktop::manager'} = $managers[0]; - } - - return 1; + my $self = shift; + + # check if current desktop kind is enabled at all and select another + # one, if it isn't + my $kind = $self->{attrs}->{'desktop::kind'} || ''; + if (!$self->{$kind}) { + my @desktops = map { $self->{$_} ? $_ : () } qw( gnome kde xfce ); + if (!@desktops) { + die _tr( + "no desktop kind is possible, plugin 'desktop' wouldn't work!" + ); + } + $self->{attrs}->{'desktop::kind'} = $desktops[0]; + } + + # check if current desktop manager is enabled at all and select another + # one, if it isn't + my $manager = $self->{attrs}->{'desktop::manager'} || ''; + if (!$self->{$manager}) { + my @managers = map { $self->{$_} ? $_ : () } qw( gdm kdm xdm ); + if (!@managers) { + die _tr( + "no desktop manager is possible, plugin 'desktop' wouldn't work!" + ); + } + $self->{attrs}->{'desktop::manager'} = $managers[0]; + } + + return 1; } sub _setupGDM { - my $self = shift; - my $attrs = shift; - - my $repoPath = $self->{pluginRepositoryPath}; - mkpath([ - "$repoPath/gdm/workstation", - "$repoPath/gdm/kiosk", - "$repoPath/gdm/chooser", - ]); - - my $pathInfo = $self->{distro}->GDMPathInfo(); - $self->_setupGDMScript($pathInfo); - - my $configHash = $self->{distro}->GDMConfigHashForWorkstation(); - $self->_writeConfigHash($configHash, "$repoPath/gdm/workstation/gdm.conf"); - - $configHash = $self->{distro}->GDMConfigHashForKiosk(); - $self->_writeConfigHash($configHash, "$repoPath/gdm/kiosk/gdm.conf"); - - $configHash = $self->{distro}->GDMConfigHashForChooser(); - $self->_writeConfigHash($configHash, "$repoPath/gdm/chooser/gdm.conf"); - - return; + my $self = shift; + my $attrs = shift; + + my $repoPath = $self->{pluginRepositoryPath}; + mkpath([ + "$repoPath/gdm/workstation", + "$repoPath/gdm/kiosk", + "$repoPath/gdm/chooser", + ]); + + my $pathInfo = $self->{distro}->GDMPathInfo(); + $self->_setupGDMScript($pathInfo); + + my $configHash = $self->{distro}->GDMConfigHashForWorkstation(); + $self->_writeConfigHash($configHash, "$repoPath/gdm/workstation/gdm.conf"); + + $configHash = $self->{distro}->GDMConfigHashForKiosk(); + $self->_writeConfigHash($configHash, "$repoPath/gdm/kiosk/gdm.conf"); + + $configHash = $self->{distro}->GDMConfigHashForChooser(); + $self->_writeConfigHash($configHash, "$repoPath/gdm/chooser/gdm.conf"); + + return; } sub _setupGDMScript { - my $self = shift; - my $pathInfo = shift; - - my $repoPath = $self->{pluginRepositoryPath}; - my $configFile = $pathInfo->{config}; - my $paths - = join( - ' ', - map { '/mnt' . $_ } ( dirname($configFile), @{$pathInfo->{paths}} ) - ); - my $script = unshiftHereDoc(<<" End-of-Here"); - #!/bin/ash - # written by OpenSLX-plugin 'desktop' - mkdir -p $paths 2>/dev/null - ln -sf $repoPath/gdm/\$desktop_mode/gdm.conf /mnt$configFile - rllinker gdm 1 15 - End-of-Here - spitFile("$repoPath/gdm/desktop.sh", $script); - return; + my $self = shift; + my $pathInfo = shift; + + my $repoPath = $self->{pluginRepositoryPath}; + my $configFile = $pathInfo->{config}; + my $paths + = join( + ' ', + map { '/mnt' . $_ } ( dirname($configFile), @{$pathInfo->{paths}} ) + ); + my $script = unshiftHereDoc(<<" End-of-Here"); + #!/bin/ash + # written by OpenSLX-plugin 'desktop' + mkdir -p $paths 2>/dev/null + ln -sf $repoPath/gdm/\$desktop_mode/gdm.conf /mnt$configFile + rllinker gdm 1 15 + End-of-Here + spitFile("$repoPath/gdm/desktop.sh", $script); + return; } sub _setupKDM { - my $self = shift; - my $attrs = shift; - + my $self = shift; + my $attrs = shift; + } sub _setupXDM { - my $self = shift; - my $attrs = shift; + my $self = shift; + my $attrs = shift; } sub _writeConfigHash { - my $self = shift; - my $hash = shift || {}; - my $file = shift; - - my $content = ''; - for my $domain (sort keys %$hash) { - $content .= "[$domain]\n"; - for my $key (sort keys %{$hash->{$domain}}) { - my $value - = defined $hash->{$domain}->{$key} - ? $hash->{$domain}->{$key} - : ''; - $content .= "$key=$value\n"; - } - $content .= "\n"; - } - spitFile($file, $content); + my $self = shift; + my $hash = shift || {}; + my $file = shift; + + my $content = ''; + for my $domain (sort keys %$hash) { + $content .= "[$domain]\n"; + for my $key (sort keys %{$hash->{$domain}}) { + my $value + = defined $hash->{$domain}->{$key} + ? $hash->{$domain}->{$key} + : ''; + $content .= "$key=$value\n"; + } + $content .= "\n"; + } + spitFile($file, $content); } 1; diff --git a/os-plugins/plugins/displaymanager/OpenSLX/OSPlugin/displaymanager.pm b/os-plugins/plugins/displaymanager/OpenSLX/OSPlugin/displaymanager.pm index 5660d91b..ee1b503b 100644 --- a/os-plugins/plugins/displaymanager/OpenSLX/OSPlugin/displaymanager.pm +++ b/os-plugins/plugins/displaymanager/OpenSLX/OSPlugin/displaymanager.pm @@ -9,10 +9,10 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # displaymanager.pm -# - implementation of the 'displaymanager' plugin, which installs +# - implementation of the 'displaymanager' plugin, which installs # all needed information for a displaymanager. Further possibilities: -# change xdmcp to (gdm, kdm, ...) -# change theme for this xdmcp +# change xdmcp to (gdm, kdm, ...) +# change theme for this xdmcp # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::displaymanager; @@ -26,117 +26,117 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'displaymanager', - }; + my $self = { + name => 'displaymanager', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; + my $self = shift; - return { - description => unshiftHereDoc(<<' End-of-Here'), - Sets a displaymanager and creates needed configs, theme can be set as well. - End-of-Here - mustRunAfter => [], - }; + return { + description => unshiftHereDoc(<<' End-of-Here'), + Sets a displaymanager and creates needed configs, theme can be set as well. + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo { - my $self = shift; + my $self = shift; - return { - 'displaymanager::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'displaymanager'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - 'displaymanager::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'displaymanager' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 40, - }, - 'displaymanager::xdmcp' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - which xdmcp to configure, gdm, kdm, xdm?) - End-of-Here - content_regex => qr{^(g|k|x)dm$}, - content_descr => 'allowed: gdm, kdm, xdm', - default => 'xdm', - }, - 'displaymanager::theme' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to the displaymanager (unset for no theme) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'openslx', - }, - }; + return { + 'displaymanager::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'displaymanager'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + 'displaymanager::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'displaymanager' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 40, + }, + 'displaymanager::xdmcp' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + which xdmcp to configure, gdm, kdm, xdm?) + End-of-Here + content_regex => qr{^(g|k|x)dm$}, + content_descr => 'allowed: gdm, kdm, xdm', + default => 'xdm', + }, + 'displaymanager::theme' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to the displaymanager (unset for no theme) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'openslx', + }, + }; } sub copyRequiredFilesIntoInitramfs { - my $self = shift; - my $targetPath = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - my $themeDir = "$openslxConfig{'base-path'}/share/themes"; + my $self = shift; + my $targetPath = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + my $themeDir = "$openslxConfig{'base-path'}/share/themes"; my $displaymanagerXdmcp = $attrs->{'displaymanager::xdmcp'} || ''; - my $xdmcpConfigDir = "$openslxConfig{'base-path'}/lib/plugins/displaymanager/files/$displaymanagerXdmcp"; - my $displaymanagerTheme = $attrs->{'displaymanager::theme'} || ''; - if ($displaymanagerTheme) { - my $displaymanagerThemeDir - = "$themeDir/$displaymanagerTheme/displaymanager/$displaymanagerXdmcp"; - if (-d $displaymanagerThemeDir) { + my $xdmcpConfigDir = "$openslxConfig{'base-path'}/lib/plugins/displaymanager/files/$displaymanagerXdmcp"; + my $displaymanagerTheme = $attrs->{'displaymanager::theme'} || ''; + if ($displaymanagerTheme) { + my $displaymanagerThemeDir + = "$themeDir/$displaymanagerTheme/displaymanager/$displaymanagerXdmcp"; + if (-d $displaymanagerThemeDir) { $makeInitRamFSEngine->addCMD( "mkdir -p $targetPath/usr/share/files" ); - $makeInitRamFSEngine->addCMD( - "mkdir -p $targetPath/usr/share/themes" - ); - $makeInitRamFSEngine->addCMD( - "cp -a $displaymanagerThemeDir $targetPath/usr/share/themes/" - ); + $makeInitRamFSEngine->addCMD( + "mkdir -p $targetPath/usr/share/themes" + ); + $makeInitRamFSEngine->addCMD( + "cp -a $displaymanagerThemeDir $targetPath/usr/share/themes/" + ); $makeInitRamFSEngine->addCMD( "cp -a $xdmcpConfigDir $targetPath/usr/share/files" ); - } - } - else { - $displaymanagerTheme = ''; - } + } + } + else { + $displaymanagerTheme = ''; + } - vlog( - 1, - _tr( - "displaymanager-plugin: displaymanager=%s", - $displaymanagerTheme - ) - ); + vlog( + 1, + _tr( + "displaymanager-plugin: displaymanager=%s", + $displaymanagerTheme + ) + ); - return; + return; } 1; diff --git a/os-plugins/plugins/example/OpenSLX/OSPlugin/example.pm b/os-plugins/plugins/example/OpenSLX/OSPlugin/example.pm index 69c5c2c7..dad6756c 100644 --- a/os-plugins/plugins/example/OpenSLX/OSPlugin/example.pm +++ b/os-plugins/plugins/example/OpenSLX/OSPlugin/example.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # example.pm -# - an example implementation of the OSPlugin API (i.e. an os-plugin) +# - an example implementation of the OSPlugin API (i.e. an os-plugin) # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::example; @@ -28,127 +28,127 @@ use OpenSLX::Utils; ################################################################################ sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'example', - }; + my $self = { + name => 'example', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - just an exemplary plugin that prints a smiley when the client boots - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + just an exemplary plugin that prints a smiley when the client boots + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo -{ # returns a hash-ref with information about all attributes supported - # by this specific plugin - my $self = shift; - - # This default configuration will be added as attributes to the default - # system, such that it can be overruled for any specific system by means - # of slxconfig. - return { - # attribute 'active' is mandatory for all plugins - 'example::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'example'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - # attribute 'precedence' is mandatory for all plugins - 'example::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'example' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 50, - }, - - # plugin specific attributes start here ... - 'example::preferred_side' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - determines to which side you have to tilt your head in order - to read the smiley - End-of-Here - content_regex => qr{^(left|right)$}, - content_descr => q{'left' will print ';-)' - 'right' will print '(-;'}, - default => 'left', - }, - }; +{ # returns a hash-ref with information about all attributes supported + # by this specific plugin + my $self = shift; + + # This default configuration will be added as attributes to the default + # system, such that it can be overruled for any specific system by means + # of slxconfig. + return { + # attribute 'active' is mandatory for all plugins + 'example::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'example'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + # attribute 'precedence' is mandatory for all plugins + 'example::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'example' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 50, + }, + + # plugin specific attributes start here ... + 'example::preferred_side' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + determines to which side you have to tilt your head in order + to read the smiley + End-of-Here + content_regex => qr{^(left|right)$}, + content_descr => q{'left' will print ';-)' - 'right' will print '(-;'}, + default => 'left', + }, + }; } sub installationPhase -{ # called while chrooted to the vendor-OS root in order to give the plugin - # a chance to install required files into the vendor-OS. - my $self = shift; - - my $pluginRepositoryPath = shift; - # The folder where the stage1-plugin should store all files - # required by the corresponding stage3 runlevel script. - # As this method is being executed while chrooted into the vendor-OS, - # this path is relative to that root (i.e. directly usable). - my $pluginTempPath = shift; - # A temporary playground that will be cleaned up automatically. - # As this method is being executed while chrooted into the vendor-OS, - # this path is relative to that root (i.e. directly usable). - my $openslxPath = shift; - # the openslx base path bind-mounted into the chroot (/mnt/openslx) - - # for this example plugin, we simply create two files: - spitFile("$pluginRepositoryPath/right", "(-;\n"); - spitFile("$pluginRepositoryPath/left", ";-)\n"); - - # Some plugins have to copy files from their plugin folder into the - # vendor-OS. In order to make this possible while chrooted, the host's - # /opt/openslx folder will be mounted to /mnt/openslx in the vendor-OS. - # So each plugin could copy some files like this: - # - # # get our own name: - # my $pluginName = $self->{'name'}; - # - # # get our own base path: - # my $pluginBasePath = "/mnt/openslx/lib/plugins/$pluginName"; - # - # # copy all needed files now: - # foreach my $file ( qw( file1, file2 ) ) { - # copyFile("$pluginBasePath/$file", "$pluginRepositoryPath/"); - # } - - # name of current os - # $self->{'os-plugin-engine'}->{'vendor-os-name'} - - return; +{ # called while chrooted to the vendor-OS root in order to give the plugin + # a chance to install required files into the vendor-OS. + my $self = shift; + + my $pluginRepositoryPath = shift; + # The folder where the stage1-plugin should store all files + # required by the corresponding stage3 runlevel script. + # As this method is being executed while chrooted into the vendor-OS, + # this path is relative to that root (i.e. directly usable). + my $pluginTempPath = shift; + # A temporary playground that will be cleaned up automatically. + # As this method is being executed while chrooted into the vendor-OS, + # this path is relative to that root (i.e. directly usable). + my $openslxPath = shift; + # the openslx base path bind-mounted into the chroot (/mnt/openslx) + + # for this example plugin, we simply create two files: + spitFile("$pluginRepositoryPath/right", "(-;\n"); + spitFile("$pluginRepositoryPath/left", ";-)\n"); + + # Some plugins have to copy files from their plugin folder into the + # vendor-OS. In order to make this possible while chrooted, the host's + # /opt/openslx folder will be mounted to /mnt/openslx in the vendor-OS. + # So each plugin could copy some files like this: + # + # # get our own name: + # my $pluginName = $self->{'name'}; + # + # # get our own base path: + # my $pluginBasePath = "/mnt/openslx/lib/plugins/$pluginName"; + # + # # copy all needed files now: + # foreach my $file ( qw( file1, file2 ) ) { + # copyFile("$pluginBasePath/$file", "$pluginRepositoryPath/"); + # } + + # name of current os + # $self->{'os-plugin-engine'}->{'vendor-os-name'} + + return; } sub removalPhase -{ # called while chrooted to the vendor-OS root in order to give the plugin - # a chance to uninstall no longer required files from the vendor-OS. - my $self = shift; - my $pluginRepositoryPath = shift; - # the repository folder, relative to the vendor-OS root - my $pluginTempPath = shift; - # the temporary folder, relative to the vendor-OS root - - return; +{ # called while chrooted to the vendor-OS root in order to give the plugin + # a chance to uninstall no longer required files from the vendor-OS. + my $self = shift; + my $pluginRepositoryPath = shift; + # the repository folder, relative to the vendor-OS root + my $pluginTempPath = shift; + # the temporary folder, relative to the vendor-OS root + + return; } 1; diff --git a/os-plugins/plugins/theme/OpenSLX/OSPlugin/theme.pm b/os-plugins/plugins/theme/OpenSLX/OSPlugin/theme.pm index 11bef626..d4610a4c 100644 --- a/os-plugins/plugins/theme/OpenSLX/OSPlugin/theme.pm +++ b/os-plugins/plugins/theme/OpenSLX/OSPlugin/theme.pm @@ -9,11 +9,11 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # theme.pm -# - implementation of the 'theme' plugin, which applies theming to the +# - implementation of the 'theme' plugin, which applies theming to the # following places: -# + bootsplash (via splashy) -# + displaymanager (gdm, kdm, ...) -# + desktop (to be done) +# + bootsplash (via splashy) +# + displaymanager (gdm, kdm, ...) +# + desktop (to be done) # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::theme; @@ -27,175 +27,175 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'theme', - }; + my $self = { + name => 'theme', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - Applies a graphical theme to the bootsplash and the displaymanager. - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + Applies a graphical theme to the bootsplash and the displaymanager. + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo { - my $self = shift; - - return { - 'theme::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'theme'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - 'theme::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'theme' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 30, - }, - - 'theme::splash' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to bootsplash (unset for no theme) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'openslx', - }, - 'theme::displaymanager' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to displaymanager (unset for no theme) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'openslx', - }, - 'theme::desktop' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - name of the theme to apply to desktop (unset for no theme) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'openslx', - }, - }; + my $self = shift; + + return { + 'theme::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'theme'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + 'theme::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'theme' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 30, + }, + + 'theme::splash' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to bootsplash (unset for no theme) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'openslx', + }, + 'theme::displaymanager' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to displaymanager (unset for no theme) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'openslx', + }, + 'theme::desktop' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + name of the theme to apply to desktop (unset for no theme) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'openslx', + }, + }; } sub suggestAdditionalKernelParams { - my $self = shift; - my $makeInitRamFSEngine = shift; - - my @suggestedParams; - - # add vga=0x317 unless explicit vga-mode is already set - if (!$makeInitRamFSEngine->haveKernelParam(qr{\bvga=})) { - push @suggestedParams, 'vga=0x317'; - } - - # add quiet, if not already set - if (!$makeInitRamFSEngine->haveKernelParam('quiet')) { - push @suggestedParams, 'quiet'; - } - - return @suggestedParams; + my $self = shift; + my $makeInitRamFSEngine = shift; + + my @suggestedParams; + + # add vga=0x317 unless explicit vga-mode is already set + if (!$makeInitRamFSEngine->haveKernelParam(qr{\bvga=})) { + push @suggestedParams, 'vga=0x317'; + } + + # add quiet, if not already set + if (!$makeInitRamFSEngine->haveKernelParam('quiet')) { + push @suggestedParams, 'quiet'; + } + + return @suggestedParams; } sub suggestAdditionalKernelModules { - my $self = shift; - my $makeInitRamFSEngine = shift; - - my @suggestedModules; - - # Ubuntu needs vesafb and fbcon (which drags along some others) - if ($makeInitRamFSEngine->{'distro-name'} =~ m{^ubuntu}i) { - push @suggestedModules, qw( vesafb fbcon ) - } - - return @suggestedModules; + my $self = shift; + my $makeInitRamFSEngine = shift; + + my @suggestedModules; + + # Ubuntu needs vesafb and fbcon (which drags along some others) + if ($makeInitRamFSEngine->{'distro-name'} =~ m{^ubuntu}i) { + push @suggestedModules, qw( vesafb fbcon ) + } + + return @suggestedModules; } sub copyRequiredFilesIntoInitramfs { - my $self = shift; - my $targetPath = shift; - my $attrs = shift; - my $makeInitRamFSEngine = shift; - - my $themeDir = "$openslxConfig{'base-path'}/share/themes"; - my $splashTheme = $attrs->{'theme::splash'} || ''; - if ($splashTheme) { - my $splashThemeDir = "$themeDir/$splashTheme/bootsplash"; - if (-d $splashThemeDir) { - my $splashyPath = "$openslxConfig{'base-path'}/share/splashy"; - $makeInitRamFSEngine->addCMD( - "cp -p $splashyPath/* $targetPath/bin/" - ); - $makeInitRamFSEngine->addCMD( - "mkdir -p $targetPath/etc/splashy" - ); - $makeInitRamFSEngine->addCMD( - "cp -a $splashThemeDir/* $targetPath/etc/splashy/" - ); - } - } - else { - $splashTheme = ''; - } - - my $displayManagerTheme = $attrs->{'theme::displaymanager'} || ''; - if ($displayManagerTheme) { - my $displayManagerThemeDir - = "$themeDir/$displayManagerTheme/displaymanager"; - if (-d $displayManagerThemeDir) { - $makeInitRamFSEngine->addCMD( - "mkdir -p $targetPath/usr/share/themes" - ); - $makeInitRamFSEngine->addCMD( - "cp -a $displayManagerThemeDir $targetPath/usr/share/themes/" - ); - } - } - else { - $displayManagerTheme = ''; - } - - vlog( - 1, - _tr( - "theme-plugin: bootsplash=%s displaymanager=%s", - $splashTheme, $displayManagerTheme - ) - ); - - return; + my $self = shift; + my $targetPath = shift; + my $attrs = shift; + my $makeInitRamFSEngine = shift; + + my $themeDir = "$openslxConfig{'base-path'}/share/themes"; + my $splashTheme = $attrs->{'theme::splash'} || ''; + if ($splashTheme) { + my $splashThemeDir = "$themeDir/$splashTheme/bootsplash"; + if (-d $splashThemeDir) { + my $splashyPath = "$openslxConfig{'base-path'}/share/splashy"; + $makeInitRamFSEngine->addCMD( + "cp -p $splashyPath/* $targetPath/bin/" + ); + $makeInitRamFSEngine->addCMD( + "mkdir -p $targetPath/etc/splashy" + ); + $makeInitRamFSEngine->addCMD( + "cp -a $splashThemeDir/* $targetPath/etc/splashy/" + ); + } + } + else { + $splashTheme = ''; + } + + my $displayManagerTheme = $attrs->{'theme::displaymanager'} || ''; + if ($displayManagerTheme) { + my $displayManagerThemeDir + = "$themeDir/$displayManagerTheme/displaymanager"; + if (-d $displayManagerThemeDir) { + $makeInitRamFSEngine->addCMD( + "mkdir -p $targetPath/usr/share/themes" + ); + $makeInitRamFSEngine->addCMD( + "cp -a $displayManagerThemeDir $targetPath/usr/share/themes/" + ); + } + } + else { + $displayManagerTheme = ''; + } + + vlog( + 1, + _tr( + "theme-plugin: bootsplash=%s displaymanager=%s", + $splashTheme, $displayManagerTheme + ) + ); + + return; } 1; diff --git a/os-plugins/plugins/vmchooser/OpenSLX/OSPlugin/vmchooser.pm b/os-plugins/plugins/vmchooser/OpenSLX/OSPlugin/vmchooser.pm index adbc5557..b18aaa02 100644 --- a/os-plugins/plugins/vmchooser/OpenSLX/OSPlugin/vmchooser.pm +++ b/os-plugins/plugins/vmchooser/OpenSLX/OSPlugin/vmchooser.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # vmchooser.pm -# - allows user to pick from a list of virtual machin images +# - allows user to pick from a list of virtual machin images # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::vmchooser; @@ -23,112 +23,112 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'vmchooser', - }; + my $self = { + name => 'vmchooser', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - allows user to pick from a list of different virtual machine images - based on xml-files, which tell about available images. - End-of-Here - mustRunAfter => [] - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + allows user to pick from a list of different virtual machine images + based on xml-files, which tell about available images. + End-of-Here + mustRunAfter => [] + }; } sub getAttrInfo { - my $self = shift; - - return { - 'vmchooser::active' => { - applies_to_systems => 0, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'vmchooser'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - 'vmchooser::precedence' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'vmchooser' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 50, - }, - }; + my $self = shift; + + return { + 'vmchooser::active' => { + applies_to_systems => 0, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'vmchooser'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + 'vmchooser::precedence' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'vmchooser' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 50, + }, + }; } sub installationPhase -{ # called while chrooted to the vendor-OS root in order to give the plugin - # a chance to install required files into the vendor-OS. - my $self = shift; - - my $pluginRepositoryPath = shift; - # The folder where the stage1-plugin should store all files - # required by the corresponding stage3 runlevel script. - # As this method is being executed while chrooted into the vendor-OS, - # this path is relative to that root (i.e. directly usable). - my $pluginTempPath = shift; - # A temporary playground that will be cleaned up automatically. - # As this method is being executed while chrooted into the vendor-OS, - # this path is relative to that root (i.e. directly usable). - my $openslxPath = shift; - # the openslx base path bind-mounted into the chroot (/mnt/openslx) - - # for this example plugin, we simply create two files: - spitFile("$pluginRepositoryPath/right", "(-;\n"); - spitFile("$pluginRepositoryPath/left", ";-)\n"); - - # Some plugins have to copy files from their plugin folder into the - # vendor-OS. In order to make this possible while chrooted, the host's - # /opt/openslx folder will be mounted to /mnt/openslx in the vendor-OS. - # So each plugin could copy some files like this: - # - - # get our own name: - my $pluginName = $self->{'name'}; - - - # get our own base path: - my $pluginBasePath = "/mnt/openslx/lib/plugins/$pluginName"; - - # copy all needed files now: - foreach my $file ( qw( vmchooser ) ) { - copyFile("$pluginBasePath/$file", "$pluginRepositoryPath/"); - } - - # name of current os - # $self->{'os-plugin-engine'}->{'vendor-os-name'} - - return; +{ # called while chrooted to the vendor-OS root in order to give the plugin + # a chance to install required files into the vendor-OS. + my $self = shift; + + my $pluginRepositoryPath = shift; + # The folder where the stage1-plugin should store all files + # required by the corresponding stage3 runlevel script. + # As this method is being executed while chrooted into the vendor-OS, + # this path is relative to that root (i.e. directly usable). + my $pluginTempPath = shift; + # A temporary playground that will be cleaned up automatically. + # As this method is being executed while chrooted into the vendor-OS, + # this path is relative to that root (i.e. directly usable). + my $openslxPath = shift; + # the openslx base path bind-mounted into the chroot (/mnt/openslx) + + # for this example plugin, we simply create two files: + spitFile("$pluginRepositoryPath/right", "(-;\n"); + spitFile("$pluginRepositoryPath/left", ";-)\n"); + + # Some plugins have to copy files from their plugin folder into the + # vendor-OS. In order to make this possible while chrooted, the host's + # /opt/openslx folder will be mounted to /mnt/openslx in the vendor-OS. + # So each plugin could copy some files like this: + # + + # get our own name: + my $pluginName = $self->{'name'}; + + + # get our own base path: + my $pluginBasePath = "/mnt/openslx/lib/plugins/$pluginName"; + + # copy all needed files now: + foreach my $file ( qw( vmchooser ) ) { + copyFile("$pluginBasePath/$file", "$pluginRepositoryPath/"); + } + + # name of current os + # $self->{'os-plugin-engine'}->{'vendor-os-name'} + + return; } sub removalPhase -{ # called while chrooted to the vendor-OS root in order to give the plugin - # a chance to uninstall no longer required files from the vendor-OS. - my $self = shift; - my $pluginRepositoryPath = shift; - # the repository folder, relative to the vendor-OS root - my $pluginTempPath = shift; - # the temporary folder, relative to the vendor-OS root - - return; +{ # called while chrooted to the vendor-OS root in order to give the plugin + # a chance to uninstall no longer required files from the vendor-OS. + my $self = shift; + my $pluginRepositoryPath = shift; + # the repository folder, relative to the vendor-OS root + my $pluginTempPath = shift; + # the temporary folder, relative to the vendor-OS root + + return; } 1; diff --git a/os-plugins/plugins/vmware/OpenSLX/Distro/base.pm b/os-plugins/plugins/vmware/OpenSLX/Distro/base.pm index 7bcdc1f0..2888c007 100644 --- a/os-plugins/plugins/vmware/OpenSLX/Distro/base.pm +++ b/os-plugins/plugins/vmware/OpenSLX/Distro/base.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # base.pm -# - provides empty base of the OpenSLX OSPlugin Distro API for the vmware +# - provides empty base of the OpenSLX OSPlugin Distro API for the vmware # plugin. # ----------------------------------------------------------------------------- package OpenSLX::Distro::base; @@ -17,7 +17,7 @@ package OpenSLX::Distro::base; use strict; use warnings; -our $VERSION = 1.01; # API-version . implementation-version +our $VERSION = 1.01; # API-version . implementation-version use OpenSLX::Basics; use OpenSLX::Utils; @@ -27,15 +27,15 @@ use OpenSLX::Utils; ################################################################################ sub new { - confess "Creating OpenSLX::OSPlugin::Distro::Base-objects directly makes no sense!"; + confess "Creating OpenSLX::OSPlugin::Distro::Base-objects directly makes no sense!"; } sub initialize { - my $self = shift; - my $engine = shift; - - return 1; + my $self = shift; + my $engine = shift; + + return 1; } diff --git a/os-plugins/plugins/vmwarebinary/OpenSLX/OSPlugin/vmwarebinary.pm b/os-plugins/plugins/vmwarebinary/OpenSLX/OSPlugin/vmwarebinary.pm index bf6a9252..5773b1ce 100644 --- a/os-plugins/plugins/vmwarebinary/OpenSLX/OSPlugin/vmwarebinary.pm +++ b/os-plugins/plugins/vmwarebinary/OpenSLX/OSPlugin/vmwarebinary.pm @@ -9,7 +9,7 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # vmwarebinary.pm -# - declares necessary information for the vmware plugin +# - declares necessary information for the vmware plugin # ----------------------------------------------------------------------------- package OpenSLX::OSPlugin::vmwarebinary; @@ -25,106 +25,106 @@ use OpenSLX::Utils; sub new { - my $class = shift; + my $class = shift; - my $self = { - name => 'vmwarebinary', - }; + my $self = { + name => 'vmwarebinary', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - - return { - description => unshiftHereDoc(<<' End-of-Here'), - !!! descriptive text missing here !!! - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + + return { + description => unshiftHereDoc(<<' End-of-Here'), + !!! descriptive text missing here !!! + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo -{ # returns a hash-ref with information about all attributes supported - # by this specific plugin - my $self = shift; - - # This default configuration will be added as attributes to the default - # system, such that it can be overruled for any specific system by means - # of slxconfig. - return { - # attribute 'active' is mandatory for all plugins - 'vmwarebinary::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'vmwarebinary'-plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - # attribute 'precedence' is mandatory for all plugins - 'vmwarebinary::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'vmwarebinary' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 70, - }, - # attribute 'imagesrc' defines where we can find vmware images - 'vmwarebinary::imagessrc' => { - applies_to_systems => 1, - applies_to_clients => 1, - description => unshiftHereDoc(<<' End-of-Here'), - Where do we store our vmware images? NFS? Filesystem? - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'Allowed values: path or URI', - default => "", - }, - - }; +{ # returns a hash-ref with information about all attributes supported + # by this specific plugin + my $self = shift; + + # This default configuration will be added as attributes to the default + # system, such that it can be overruled for any specific system by means + # of slxconfig. + return { + # attribute 'active' is mandatory for all plugins + 'vmwarebinary::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'vmwarebinary'-plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + # attribute 'precedence' is mandatory for all plugins + 'vmwarebinary::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'vmwarebinary' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 70, + }, + # attribute 'imagesrc' defines where we can find vmware images + 'vmwarebinary::imagessrc' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + Where do we store our vmware images? NFS? Filesystem? + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'Allowed values: path or URI', + default => "", + }, + + }; } sub installationPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - my $pluginTempPath = shift; - my $openslxPath = shift; + my $self = shift; + my $pluginRepositoryPath = shift; + my $pluginTempPath = shift; + my $openslxPath = shift; - # get path of files we need to install - my $pluginFilesPath = "$openslxPath/lib/plugins/$self->{'name'}/files"; + # get path of files we need to install + my $pluginFilesPath = "$openslxPath/lib/plugins/$self->{'name'}/files"; - # copy all needed files now - my @files = qw( installbinary.sh locations - VMware-player-2.0.2-59824.i386.tar.gz depmod.sh uname.sh - nvram.5.0 insmod.sh runvmware-v2 ); - foreach my $file (@files) { - copyFile("$pluginFilesPath/$file", $pluginRepositoryPath); - } + # copy all needed files now + my @files = qw( installbinary.sh locations + VMware-player-2.0.2-59824.i386.tar.gz depmod.sh uname.sh + nvram.5.0 insmod.sh runvmware-v2 ); + foreach my $file (@files) { + copyFile("$pluginFilesPath/$file", $pluginRepositoryPath); + } - system("/bin/sh /opt/openslx/plugin-repo/$self->{'name'}/installbinary.sh"); + system("/bin/sh /opt/openslx/plugin-repo/$self->{'name'}/installbinary.sh"); - return; + return; } sub removalPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - my $pluginTempPath = shift; - my $openslxPath = shift; - - rmtree ( [ $pluginRepositoryPath ] ); - - return; + my $self = shift; + my $pluginRepositoryPath = shift; + my $pluginTempPath = shift; + my $openslxPath = shift; + + rmtree ( [ $pluginRepositoryPath ] ); + + return; } 1; diff --git a/os-plugins/plugins/x11vnc/OpenSLX/OSPlugin/x11vnc.pm b/os-plugins/plugins/x11vnc/OpenSLX/OSPlugin/x11vnc.pm index 8accd45d..7d34934f 100644 --- a/os-plugins/plugins/x11vnc/OpenSLX/OSPlugin/x11vnc.pm +++ b/os-plugins/plugins/x11vnc/OpenSLX/OSPlugin/x11vnc.pm @@ -22,214 +22,214 @@ use OpenSLX::Utils; sub new { - my $class = shift; - my $self = { - name => 'x11vnc', - }; + my $class = shift; + my $self = { + name => 'x11vnc', + }; - return bless $self, $class; + return bless $self, $class; } sub getInfo { - my $self = shift; - return { - description => unshiftHereDoc(<<' End-of-Here'), - enables x11vnc server - End-of-Here - mustRunAfter => [], - }; + my $self = shift; + return { + description => unshiftHereDoc(<<' End-of-Here'), + enables x11vnc server + End-of-Here + mustRunAfter => [], + }; } sub getAttrInfo { - my $self = shift; - - return { - 'x11vnc::active' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - should the 'x11vnc' plugin be executed during boot? - End-of-Here - content_regex => qr{^(0|1)$}, - content_descr => '1 means active - 0 means inactive', - default => '1', - }, - - 'x11vnc::precedence' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - the execution precedence of the 'x11vnc' plugin - End-of-Here - content_regex => qr{^\d\d$}, - content_descr => 'allowed range is from 01-99', - default => 50, - }, - - 'x11vnc::mode' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - set x11vnc to listen on X11(default) or console fb - End-of-Here - content_regex => qr{^(x11|fb)$}, - content_descr => 'x11 means listen current X session - fb means listen to tty1 console', - default => 'x11', - }, - - 'x11vnc::scale' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - scale screen size (e.g. as fraction 2/3 or as decimal 0.5) - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - - 'x11vnc::shared' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - by default x11vnc is always called with the -shared option - End-of-Here - content_regex => qr{^(yes|no|1|0)$}, - content_descr => 'use 1 or yes to enable - 0 or no to disable', - default => 'yes', - }, - - 'x11vnc::force_viewonly' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - disable user interaction with vnc - End-of-Here - content_regex => qr{^(yes|no|1|0)$}, - content_descr => 'use 1 or yes to enable - 0 or no to disable', - default => 'no', - }, - - 'x11vnc::auth_type' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - set authentication type of the vnc connection - End-of-Here - content_regex => qr{^(passwd|rfbauth|none)$}, - content_descr => 'choose: passwd, rfbauth, none', - default => 'passwd', - }, - - 'x11vnc::allowed_hosts' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - set allowed hosts (multiple hosts are seperated by semicolons, (simple) subnets are possible too - e.g. "192.168.") - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - - 'x11vnc::force_localhost' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - force x11vnc to only accept local connections and only listen on the loopback device - End-of-Here - content_regex => qr{^(1|0|yes|no)$}, - content_descr => 'use 1 or yes to enable - 0 or no to disable', - default => 'no', - }, - - 'x11vnc::pass' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - viewonly password (you can add multiple passwords seperated by semicolons) - (if you're using rfb-auth only the first one is used) - End-of-Here - content_regex => undef, - content_descr => undef, - default => '', - }, - - 'x11vnc::viewonlypass' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - viewonly password (you can add multiple passwords seperated by semicolons) - (disabled with rfb-auth) - End-of-Here - content_regex => undef, - content_descr => undef, - default => 'viewonly', - }, - - 'x11vnc::logging' => { - applies_to_systems => 1, - applies_to_clients => 0, - description => unshiftHereDoc(<<' End-of-Here'), - enable logging - End-of-Here - content_regex => qr{^(1|0|yes|no)$}, - content_descr => 'use 1 or yes to enable - 0 or no to disable', - default => 'yes', - }, - - }; + my $self = shift; + + return { + 'x11vnc::active' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + should the 'x11vnc' plugin be executed during boot? + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '1 means active - 0 means inactive', + default => '1', + }, + + 'x11vnc::precedence' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + the execution precedence of the 'x11vnc' plugin + End-of-Here + content_regex => qr{^\d\d$}, + content_descr => 'allowed range is from 01-99', + default => 50, + }, + + 'x11vnc::mode' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + set x11vnc to listen on X11(default) or console fb + End-of-Here + content_regex => qr{^(x11|fb)$}, + content_descr => 'x11 means listen current X session - fb means listen to tty1 console', + default => 'x11', + }, + + 'x11vnc::scale' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + scale screen size (e.g. as fraction 2/3 or as decimal 0.5) + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + + 'x11vnc::shared' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + by default x11vnc is always called with the -shared option + End-of-Here + content_regex => qr{^(yes|no|1|0)$}, + content_descr => 'use 1 or yes to enable - 0 or no to disable', + default => 'yes', + }, + + 'x11vnc::force_viewonly' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + disable user interaction with vnc + End-of-Here + content_regex => qr{^(yes|no|1|0)$}, + content_descr => 'use 1 or yes to enable - 0 or no to disable', + default => 'no', + }, + + 'x11vnc::auth_type' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + set authentication type of the vnc connection + End-of-Here + content_regex => qr{^(passwd|rfbauth|none)$}, + content_descr => 'choose: passwd, rfbauth, none', + default => 'passwd', + }, + + 'x11vnc::allowed_hosts' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + set allowed hosts (multiple hosts are seperated by semicolons, (simple) subnets are possible too + e.g. "192.168.") + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + + 'x11vnc::force_localhost' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + force x11vnc to only accept local connections and only listen on the loopback device + End-of-Here + content_regex => qr{^(1|0|yes|no)$}, + content_descr => 'use 1 or yes to enable - 0 or no to disable', + default => 'no', + }, + + 'x11vnc::pass' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + viewonly password (you can add multiple passwords seperated by semicolons) + (if you're using rfb-auth only the first one is used) + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + + 'x11vnc::viewonlypass' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + viewonly password (you can add multiple passwords seperated by semicolons) + (disabled with rfb-auth) + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'viewonly', + }, + + 'x11vnc::logging' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + enable logging + End-of-Here + content_regex => qr{^(1|0|yes|no)$}, + content_descr => 'use 1 or yes to enable - 0 or no to disable', + default => 'yes', + }, + + }; } sub installationPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - my $pluginTempPath = shift; - my $openslxPath = shift; - - # get path of files we need to install - my $pluginFilesPath = "$openslxPath/lib/plugins/$self->{'name'}/files"; - - # copy all needed files now - copyFile("$pluginFilesPath/x11vnc", "/etc/init.d"); - vlog(3, "install init file"); - - if ( !-x "/usr/bin/x11vnc" ) { - # let's install x11vnc - if ( $self->{'os-plugin-engine'}->{'vendor-os-name'} =~ m/(debian|ubuntu)/i ) { - my $cmd = "aptitude -y install x11vnc"; - vlog(3, "executing: $cmd"); - if (slxsystem($cmd)) { - die _tr( - "unable to execute shell-cmd\n\t%s", $cmd - ); - } - } - if ( $self->{'os-plugin-engine'}->{'vendor-os-name'} =~ m/suse/i ) { - # PLEASE TEST THIS!!! - my $cmd = "zypper -n in x11vnc"; - vlog(3, "executing: $cmd"); - if (slxsystem($cmd)) { - die _tr( - "unable to execute shell-cmd\n\t%s", $cmd - ); - } - } - } else { - vlog(3, "x11vnc is already installed"); - } + my $self = shift; + my $pluginRepositoryPath = shift; + my $pluginTempPath = shift; + my $openslxPath = shift; + + # get path of files we need to install + my $pluginFilesPath = "$openslxPath/lib/plugins/$self->{'name'}/files"; + + # copy all needed files now + copyFile("$pluginFilesPath/x11vnc", "/etc/init.d"); + vlog(3, "install init file"); + + if ( !-x "/usr/bin/x11vnc" ) { + # let's install x11vnc + if ( $self->{'os-plugin-engine'}->{'vendor-os-name'} =~ m/(debian|ubuntu)/i ) { + my $cmd = "aptitude -y install x11vnc"; + vlog(3, "executing: $cmd"); + if (slxsystem($cmd)) { + die _tr( + "unable to execute shell-cmd\n\t%s", $cmd + ); + } + } + if ( $self->{'os-plugin-engine'}->{'vendor-os-name'} =~ m/suse/i ) { + # PLEASE TEST THIS!!! + my $cmd = "zypper -n in x11vnc"; + vlog(3, "executing: $cmd"); + if (slxsystem($cmd)) { + die _tr( + "unable to execute shell-cmd\n\t%s", $cmd + ); + } + } + } else { + vlog(3, "x11vnc is already installed"); + } } sub removalPhase { - my $self = shift; - my $pluginRepositoryPath = shift; - my $pluginTempPath = shift; + my $self = shift; + my $pluginRepositoryPath = shift; + my $pluginTempPath = shift; } 1; diff --git a/os-plugins/slxos-plugin b/os-plugins/slxos-plugin index 4f242ad1..e94be5d4 100755 --- a/os-plugins/slxos-plugin +++ b/os-plugins/slxos-plugin @@ -37,22 +37,22 @@ use OpenSLX::Utils; my %option; GetOptions( - 'help|?' => \$option{helpReq}, - 'man' => \$option{manReq}, - 'verbose' => \$option{verbose}, - 'version' => \$option{versionReq}, - ) + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'verbose' => \$option{verbose}, + 'version' => \$option{versionReq}, +) or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; if ($option{manReq}) { - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - $ENV{LC_ALL} = 'POSIX'; - pod2usage(-verbose => 2); + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); } if ($option{versionReq}) { - system('slxversion'); - exit 1; + system('slxversion'); + exit 1; } openslxInit(); @@ -60,239 +60,239 @@ openslxInit(); my $action = shift @ARGV || ''; if ($action =~ m[^list-at]i) { - my $plugin = shift @ARGV; - print - $plugin - ? _tr("List of attributes supported by '%s' plugin:\n", $plugin) - : _tr("List of plugin attributes:\n"); - my $attrs = {}; - require OpenSLX::OSPlugin::Roster; - OpenSLX::OSPlugin::Roster->addAllAttributesToHash($attrs, $plugin); - print join( - '', - map { - my $attr = $attrs->{$_}; - my $stage - = $attr->{applies_to_vendor_os} ? '[stage 1]' : '[stage 3]'; - - if ($option{verbose}) { - my $output; - my $fill = ' ' x 28; - for my $key (qw( description content_descr content_regex )) { - $output .= "\n\t $key:" . ( ' ' x (15 - length($key)) ); - chomp(my $value = $attr->{$key} || ''); - $value =~ s{\n}{\n$fill}igms; - $output .= $value; - } - "\n\t$stage: $_$output\n"; - } - else { - "\t$stage: $_\n"; - } - } - sort { - my $stageDiff - = ($attrs->{$b}->{applies_to_vendor_os} || '') - cmp ($attrs->{$a}->{applies_to_vendor_os} || ''); - return $stageDiff ? $stageDiff : $a cmp $b; - } - keys %$attrs - ); + my $plugin = shift @ARGV; + print + $plugin + ? _tr("List of attributes supported by '%s' plugin:\n", $plugin) + : _tr("List of plugin attributes:\n"); + my $attrs = {}; + require OpenSLX::OSPlugin::Roster; + OpenSLX::OSPlugin::Roster->addAllAttributesToHash($attrs, $plugin); + print join( + '', + map { + my $attr = $attrs->{$_}; + my $stage + = $attr->{applies_to_vendor_os} ? '[stage 1]' : '[stage 3]'; + + if ($option{verbose}) { + my $output; + my $fill = ' ' x 28; + for my $key (qw( description content_descr content_regex )) { + $output .= "\n\t $key:" . ( ' ' x (15 - length($key)) ); + chomp(my $value = $attr->{$key} || ''); + $value =~ s{\n}{\n$fill}igms; + $output .= $value; + } + "\n\t$stage: $_$output\n"; + } + else { + "\t$stage: $_\n"; + } + } + sort { + my $stageDiff + = ($attrs->{$b}->{applies_to_vendor_os} || '') + cmp ($attrs->{$a}->{applies_to_vendor_os} || ''); + return $stageDiff ? $stageDiff : $a cmp $b; + } + keys %$attrs + ); } elsif ($action =~ m[^list-av]i) { - print _tr("List of available plugins:\n"); - require OpenSLX::OSPlugin::Roster; - my $pluginInfo = OpenSLX::OSPlugin::Roster->getAvailablePlugins(); - print join( - '', - map { - if ($option{verbose}) { - my $fill = ' ' x 12; - chomp(my $descr = $pluginInfo->{$_}->{description} || ''); - $descr =~ s{\n}{\n$fill}igms; - "\n\t$_\n\t $descr\n"; - } - else { - "\t$_\n"; - } - } - sort keys %$pluginInfo - ); + print _tr("List of available plugins:\n"); + require OpenSLX::OSPlugin::Roster; + my $pluginInfo = OpenSLX::OSPlugin::Roster->getAvailablePlugins(); + print join( + '', + map { + if ($option{verbose}) { + my $fill = ' ' x 12; + chomp(my $descr = $pluginInfo->{$_}->{description} || ''); + $descr =~ s{\n}{\n$fill}igms; + "\n\t$_\n\t $descr\n"; + } + else { + "\t$_\n"; + } + } + sort keys %$pluginInfo + ); } elsif ($action =~ m[^list-i]i) { - if (scalar(@ARGV) != 1) { - print STDERR _tr( - "You need to specify exactly one vendor-OS!\n" - ); - pod2usage(2); - } - my $vendorOSName = shift @ARGV; - - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - - # create OSPlugin-engine for given vendor-OS and ask it for the installed - # plugins: - my $engine = OpenSLX::OSPlugin::Engine->new; - $engine->initialize(undef, $vendorOSName); - my @installedPlugins = $engine->getInstalledPlugins(); - - if (!@installedPlugins) { - push @installedPlugins, { plugin_name => '' }; - } - print _tr("List of plugins installed in vendor-OS '$vendorOSName':\n"); - print join( - '', - map { - if ($option{verbose}) { - my $attributes - = _tr("The following attributes were applied:") - . "\n\t "; - my $attrs = $_->{attrs}; - my $attrInfo = {}; - OpenSLX::OSPlugin::Roster->addAllStage1AttributesToHash( - $attrInfo, $_->{plugin_name} - ); - $attributes .= join( - "\n\t ", - map { - my $stage - = $attrInfo->{$_}->{applies_to_vendor_os} - ? '[stage 1]' - : '[stage 3]'; - "$stage $_=" - . (defined $attrs->{$_} ? $attrs->{$_} : '-') - } - sort { - (($attrInfo->{$b}->{applies_to_vendor_os} || '') - cmp ($attrInfo->{$a}->{applies_to_vendor_os} || '')) - || ($a cmp $b); - } - keys %$attrs - ); - "\n\t$_->{plugin_name}\n\t $attributes\n"; - } - else { - "\t$_->{plugin_name}\n"; - } - } - sort @installedPlugins - ); + if (scalar(@ARGV) != 1) { + print STDERR _tr( + "You need to specify exactly one vendor-OS!\n" + ); + pod2usage(2); + } + my $vendorOSName = shift @ARGV; + + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + + # create OSPlugin-engine for given vendor-OS and ask it for the installed + # plugins: + my $engine = OpenSLX::OSPlugin::Engine->new; + $engine->initialize(undef, $vendorOSName); + my @installedPlugins = $engine->getInstalledPlugins(); + + if (!@installedPlugins) { + push @installedPlugins, { plugin_name => '' }; + } + print _tr("List of plugins installed in vendor-OS '$vendorOSName':\n"); + print join( + '', + map { + if ($option{verbose}) { + my $attributes + = _tr("The following attributes were applied:") + . "\n\t "; + my $attrs = $_->{attrs}; + my $attrInfo = {}; + OpenSLX::OSPlugin::Roster->addAllStage1AttributesToHash( + $attrInfo, $_->{plugin_name} + ); + $attributes .= join( + "\n\t ", + map { + my $stage + = $attrInfo->{$_}->{applies_to_vendor_os} + ? '[stage 1]' + : '[stage 3]'; + "$stage $_=" + . (defined $attrs->{$_} ? $attrs->{$_} : '-') + } + sort { + (($attrInfo->{$b}->{applies_to_vendor_os} || '') + cmp ($attrInfo->{$a}->{applies_to_vendor_os} || '')) + || ($a cmp $b); + } + keys %$attrs + ); + "\n\t$_->{plugin_name}\n\t $attributes\n"; + } + else { + "\t$_->{plugin_name}\n"; + } + } + sort @installedPlugins + ); } elsif ($action =~ m[^install]i) { - if (scalar(@ARGV) < 2) { - print STDERR _tr( - "You need to specify a vendor-OS and at least one plugin-name!\n" - ); - pod2usage(2); - } - my $vendorOSName = shift @ARGV; - my $pluginAttrs = parsePluginAttrs(1); - - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - - for my $pluginName (keys %$pluginAttrs) { - # create & start OSPlugin-engine for vendor-OS and current plugin: - my $engine = OpenSLX::OSPlugin::Engine->new; - $engine->initialize( - $pluginName, $vendorOSName, $pluginAttrs->{$pluginName} - ); - if (!-e $engine->{'plugin-path'}) { - die _tr("plugin '%s' doesn't exist, giving up!\n", - $engine->{'plugin-path'}); - } - if ($vendorOSName ne '<<>>' - && !-e $engine->{'vendor-os-path'}) { - die _tr( - "vendor-OS '%s' doesn't exist, giving up!\n", - $engine->{'vendor-os-path'} - ); - } - if ($engine->installPlugin()) { - print _tr( - "Plugin $pluginName has been installed into vendor-OS '$vendorOSName'.\n" - ); - } - } + if (scalar(@ARGV) < 2) { + print STDERR _tr( + "You need to specify a vendor-OS and at least one plugin-name!\n" + ); + pod2usage(2); + } + my $vendorOSName = shift @ARGV; + my $pluginAttrs = parsePluginAttrs(1); + + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + + for my $pluginName (keys %$pluginAttrs) { + # create & start OSPlugin-engine for vendor-OS and current plugin: + my $engine = OpenSLX::OSPlugin::Engine->new; + $engine->initialize( + $pluginName, $vendorOSName, $pluginAttrs->{$pluginName} + ); + if (!-e $engine->{'plugin-path'}) { + die _tr("plugin '%s' doesn't exist, giving up!\n", + $engine->{'plugin-path'}); + } + if ($vendorOSName ne '<<>>' + && !-e $engine->{'vendor-os-path'}) { + die _tr( + "vendor-OS '%s' doesn't exist, giving up!\n", + $engine->{'vendor-os-path'} + ); + } + if ($engine->installPlugin()) { + print _tr( + "Plugin $pluginName has been installed into vendor-OS '$vendorOSName'.\n" + ); + } + } } elsif ($action =~ m[^remove]i) { - if (scalar(@ARGV) < 2) { - print STDERR _tr( - "You need to specify a vendor-OS and at least one plugin-name!\n" - ); - pod2usage(2); - } - my $vendorOSName = shift @ARGV; - my $pluginAttrs = parsePluginAttrs(0); - - # we chdir into the script's folder such that all relative paths have - # a known starting point: - chdir($FindBin::RealBin) - or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); - - for my $pluginName (keys %$pluginAttrs) { - # create & start OSPlugin-engine for vendor-OS and current plugin: - my $engine = OpenSLX::OSPlugin::Engine->new; - $engine->initialize( - $pluginName, $vendorOSName, $pluginAttrs->{$pluginName} - ); - if (!-e $engine->{'plugin-path'}) { - die _tr("plugin '%s' doesn't exist, giving up!\n", - $engine->{'plugin-path'}); - } - if ($vendorOSName ne '<<>>' && !-e $engine->{'vendor-os-path'}) { - die _tr("vendor-OS '%s' doesn't exist, giving up!\n", - $engine->{'vendor-os-path'}); - } - if ($engine->removePlugin()) { - print _tr( - "Plugin $pluginName has been removed from vendor-OS '$vendorOSName'.\n" - ); - } - } + if (scalar(@ARGV) < 2) { + print STDERR _tr( + "You need to specify a vendor-OS and at least one plugin-name!\n" + ); + pod2usage(2); + } + my $vendorOSName = shift @ARGV; + my $pluginAttrs = parsePluginAttrs(0); + + # we chdir into the script's folder such that all relative paths have + # a known starting point: + chdir($FindBin::RealBin) + or die _tr("can't chdir to script-path <%> (%s)", $FindBin::RealBin, $!); + + for my $pluginName (keys %$pluginAttrs) { + # create & start OSPlugin-engine for vendor-OS and current plugin: + my $engine = OpenSLX::OSPlugin::Engine->new; + $engine->initialize( + $pluginName, $vendorOSName, $pluginAttrs->{$pluginName} + ); + if (!-e $engine->{'plugin-path'}) { + die _tr("plugin '%s' doesn't exist, giving up!\n", + $engine->{'plugin-path'}); + } + if ($vendorOSName ne '<<>>' && !-e $engine->{'vendor-os-path'}) { + die _tr("vendor-OS '%s' doesn't exist, giving up!\n", + $engine->{'vendor-os-path'}); + } + if ($engine->removePlugin()) { + print _tr( + "Plugin $pluginName has been removed from vendor-OS '$vendorOSName'.\n" + ); + } + } } else { - vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); - You need to specify exactly one action: - install [= ...] - list-attributes [] - list-available - list-installed - remove - Try '%s --help' for more info. - END-OF-HERE + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one action: + install [= ...] + list-attributes [] + list-available + list-installed + remove + Try '%s --help' for more info. + END-OF-HERE } sub parsePluginAttrs { - my $acceptAttributes = shift; - - my (%pluginAttrs, $pluginName, @attrSpecs); - for my $arg (@ARGV) { - if ($arg =~ m{^(.+)=(.*)$}) { - next if !$acceptAttributes; - my $attr = $1; - my $value = $2; - if ($value =~ m{^(-|undef)$}) { - $value = undef; - } - if ($attr =~ m{^(.+)::}) { - $pluginName = $1; - } - else { - if (!defined $pluginName) { - die _tr('You have to give a plugin-name before you can specify unscoped attributes!'); - } - $attr = $pluginName . '::' . $attr; - } - $pluginAttrs{$pluginName}->{$attr} = $value; - } - else { - $pluginName = $arg; - $pluginAttrs{$pluginName} = {}; - } - } - return \%pluginAttrs; + my $acceptAttributes = shift; + + my (%pluginAttrs, $pluginName, @attrSpecs); + for my $arg (@ARGV) { + if ($arg =~ m{^(.+)=(.*)$}) { + next if !$acceptAttributes; + my $attr = $1; + my $value = $2; + if ($value =~ m{^(-|undef)$}) { + $value = undef; + } + if ($attr =~ m{^(.+)::}) { + $pluginName = $1; + } + else { + if (!defined $pluginName) { + die _tr('You have to give a plugin-name before you can specify unscoped attributes!'); + } + $attr = $pluginName . '::' . $attr; + } + $pluginAttrs{$pluginName}->{$attr} = $value; + } + else { + $pluginName = $arg; + $pluginAttrs{$pluginName} = {}; + } + } + return \%pluginAttrs; } =head1 NAME -- cgit v1.2.3-55-g7522