diff options
24 files changed, 1156 insertions, 796 deletions
@@ -52,12 +52,13 @@ my ( $rootPath = '/'; GetOptions( - 'help|?' => \$helpReq, - 'man' => \$manReq, + 'help|?' => \$helpReq, + 'man' => \$manReq, 'root-path=s' => \$rootPath, - 'verbose' => \$verbose, - 'version' => \$versionReq, -) or pod2usage(2); + 'verbose' => \$verbose, + 'version' => \$versionReq, + ) + or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; pod2usage(-verbose => 2) if $manReq; if ($versionReq) { @@ -73,7 +74,7 @@ if (!$rootPath) { } $rootPath =~ s[/+$][]; - # remove trailing slashes +# remove trailing slashes if (!@ARGV) { print STDERR _tr("You need to specify at least one file!\n"); @@ -83,12 +84,13 @@ if (!@ARGV) { fetchLoaderConfig(); foreach my $file (@ARGV) { - if (substr($file,0,1) ne '/') { + if (substr($file, 0, 1) ne '/') { # force relative paths relative to $rootPath: $file = "$rootPath/$file"; } if (!-e $file) { - print STDERR _tr("slxldd: unable to find file '%s', skipping it\n", $file); + print STDERR _tr("slxldd: unable to find file '%s', skipping it\n", + $file); next; } push @filesToDo, $file; @@ -103,7 +105,7 @@ sub fetchLoaderConfigFile my $ldConfFile = shift; open(LDCONF, "< $ldConfFile"); - while(<LDCONF>) { + while (<LDCONF>) { chomp; if (/^\s*include\s+(.+?)\s*$/i) { foreach my $incFile (<$rootPath$1>) { @@ -113,7 +115,7 @@ sub fetchLoaderConfigFile } if (/\S+/i) { s[=.+][]; - # remove any lib-type specifications (e.g. '=libc5') + # remove any lib-type specifications (e.g. '=libc5') push @libFolders, "$rootPath$_"; } } @@ -123,12 +125,13 @@ sub fetchLoaderConfigFile sub fetchLoaderConfig { if (!-e "$rootPath/etc") { - die _tr("'%s'-folder not found, maybe wrong root-path?\n", "$rootPath/etc"); + die _tr("'%s'-folder not found, maybe wrong root-path?\n", + "$rootPath/etc"); } fetchLoaderConfigFile("$rootPath/etc/ld.so.conf"); # add "trusted" folders /lib and /usr/lib if not already in place: - if (!grep { m[^$rootPath/lib$]} @libFolders) { + if (!grep { m[^$rootPath/lib$] } @libFolders) { push @libFolders, "$rootPath/lib"; } if (!grep { m[^$rootPath/usr/lib$] } @libFolders) { @@ -137,20 +140,21 @@ sub fetchLoaderConfig # 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[^$rootPath/lib32$]} @libFolders) { + if (-e '/lib32' && !grep { m[^$rootPath/lib32$] } @libFolders) { push @libFolders, "$rootPath/lib32"; } if (-e '/usr/lib32' - && !grep { m[^$rootPath/usr/lib32$] } @libFolders) { + && !grep { m[^$rootPath/usr/lib32$] } @libFolders) + { push @libFolders, "$rootPath/usr/lib32"; } } sub addLib { - my $lib = shift; + my $lib = shift; my $bitwidth = shift; - my $rpath = shift; + my $rpath = shift; if (!exists $libInfo{$lib}) { push @libs, $lib; @@ -163,15 +167,22 @@ sub addLib 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`; + 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); + $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 $verbose; + vlog( + 0, + _tr( + '%s has wrong bitwidth (%s instead of %s)', + "$folder/$lib", $libBitwidth, $bitwidth + ) + ) + if $verbose; next; } $libPath = "$folder/$lib"; @@ -201,7 +212,9 @@ sub addLibsForBinary print STDERR _tr("\tinfo is: '%s'...\n", $fileInfo) if $verbose; if ($fileInfo !~ m[^application/(x-executable|x-shared)]i) { # ignore anything that's not an executable or a shared library - print STDERR _tr("%s: ignored, as it isn't an executable or a shared library\n", $binary); + print STDERR _tr( + "%s: ignored, as it isn't an executable or a shared library\n", + $binary); next; } @@ -214,7 +227,7 @@ sub addLibsForBinary chomp $fileInfo; print STDERR _tr("\tinfo is: '%s'...\n", $fileInfo) if $verbose; my $bitwidth = ($fileInfo =~ m[64-bit]i) ? 64 : 32; - # determine whether binary is 32- or 64-bit platform + # determine whether binary is 32- or 64-bit platform # now find out about needed libs, we first try objdump... if ($verbose) { @@ -230,7 +243,7 @@ sub addLibsForBinary print STDERR _tr("\trpath='%s'\n", $rpath); } } - while($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) { + while ($res =~ m[^\s*NEEDED\s*(.+?)\s*$]gm) { addLib($1, $bitwidth, $rpath); } } else { @@ -240,7 +253,9 @@ sub addLibsForBinary } $res = `readelf -d $binary 2>/dev/null`; if ($?) { - die _tr("neither objdump nor readelf seems to be installed, giving up!\n"); + die _tr( + "neither objdump nor readelf seems to be installed, giving up!\n" + ); } # find out if rpath is set for binary: my $rpath; @@ -250,15 +265,12 @@ sub addLibsForBinary print STDERR _tr("\trpath='%s'\n", $rpath); } } - while($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) { + while ($res =~ m{\(NEEDED\)[^\[]+\[(.+?)\]\s*$}gm) { addLib($1, $bitwidth, $rpath); } } } - -__END__ - =head1 NAME slxldd - OpenSLX-script to determine the libraries required by any given @@ -306,3 +318,4 @@ Prints the version and exits. =back =cut + diff --git a/bin/slxsettings b/bin/slxsettings index 1d4afcb5..e753ad99 100755 --- a/bin/slxsettings +++ b/bin/slxsettings @@ -36,27 +36,21 @@ use Pod::Usage; use FindBin; use lib "$FindBin::RealBin/../lib"; use lib "$FindBin::RealBin"; - # development path to config-db stuff +# development path to config-db stuff use OpenSLX::Basics; use OpenSLX::Utils; -my ( - $quiet, - @reset, - $helpReq, - $manReq, - $versionReq, -); +my ($quiet, @reset, $helpReq, $manReq, $versionReq,); GetOptions( 'quiet' => \$quiet, - # will avoid printing anything + # will avoid printing anything 'reset=s' => \@reset, - # resets given option to its default + # resets given option to its default - 'help|?' => \$helpReq, - 'man' => \$manReq, + 'help|?' => \$helpReq, + 'man' => \$manReq, 'version' => \$versionReq, ); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; @@ -75,8 +69,10 @@ my %givenSettings = %cmdlineConfig; while (scalar @ARGV) { my $extSetting = shift; if ($extSetting !~ m[^([-\w]+)=(.+)$]) { - die _tr("extended setting '%s' has unknown format, expected '<key>=<value>!'", - $extSetting); + die _tr( + "extended setting '%s' has unknown format, expected '<key>=<value>!'", + $extSetting + ); } $givenSettings{$1} = $2; } @@ -90,7 +86,7 @@ my %changed; foreach my $key (keys %givenSettings) { my $value = $givenSettings{$key}; next if !defined $value; - vlog 0, _tr("setting %s to '%s'", $key, $value) unless $quiet; + vlog(0, _tr("setting %s to '%s'", $key, $value)) unless $quiet; my $externalKey = externalKeyFor($key); if (!($settings =~ s[^\s*$externalKey=.*?$][$externalKey=$value]ms)) { $settings .= "$externalKey=$value\n"; @@ -102,9 +98,13 @@ foreach my $key (keys %givenSettings) { foreach my $key (@reset) { my $externalKey = externalKeyFor($key); if ($settings =~ s[^\s*?$externalKey=.*?\n][]ms) { - vlog 0, _tr("removing option '%s' from local settings", $key) unless $quiet; + vlog(0, + _tr("removing option '%s' from local settings", $key)) + unless $quiet; } else { - vlog 0, _tr("option '%s' didn't exist in local settings!", $key) unless $quiet; + vlog(0, + _tr("option '%s' didn't exist in local settings!", $key)) + unless $quiet; } $changed{$key}++; } @@ -113,7 +113,7 @@ foreach my $key (@reset) { if (keys %changed) { my $f = "$openslxConfig{'config-path'}/settings"; open(SETTINGS, "> $f") - or die _tr("Unable to write local settings file '%s' (%s)", $f, $!); + or die _tr("Unable to write local settings file '%s' (%s)", $f, $!); print SETTINGS $settings; close(SETTINGS); @@ -128,10 +128,10 @@ if (!keys %changed) { print _tr("paths fixed at installation time:\n"); print qq[\t--base-path='$openslxConfig{'base-path'}'\n]; print qq[\t--config-path='$openslxConfig{'config-path'}'\n]; - my $text - = keys %changed - ? "resulting base settings (cmdline options):\n" - : "current base settings (cmdline options):\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) { @@ -150,12 +150,12 @@ sub externalKeyFor my $key = shift; $key =~ tr[-][_]; - return "SLX_".uc($key); + return "SLX_" . uc($key); } sub changedHandler { - my $key = shift; + my $key = shift; my $value = shift; # invoke a key-specific change handler if it exists: @@ -323,4 +323,5 @@ Prints the version and exits. slxos-setup, slxos-export, slxconfig, slxconfig-demuxer -=cut
\ No newline at end of file +=cut + diff --git a/config-db/OpenSLX/ConfigDB.pm b/config-db/OpenSLX/ConfigDB.pm index 3926fb9f..f121c9be 100644 --- a/config-db/OpenSLX/ConfigDB.pm +++ b/config-db/OpenSLX/ConfigDB.pm @@ -12,7 +12,7 @@ package OpenSLX::ConfigDB; use strict; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION); -$VERSION = 1; # API-version +$VERSION = 1; # API-version ################################################################################ ### This module defines the data abstraction layer for the OpenSLX configuration @@ -32,16 +32,14 @@ use Exporter; @ISA = qw(Exporter); my @supportExports = qw( - isAttribute mergeAttributes pushAttributes - externalIDForSystem externalIDForClient externalConfigNameForClient - externalAttrName generatePlaceholderFor + isAttribute mergeAttributes pushAttributes + externalIDForSystem externalIDForClient externalConfigNameForClient + externalAttrName generatePlaceholderFor ); -@EXPORT = (); -@EXPORT_OK = (@supportExports); -%EXPORT_TAGS = ( - 'support' => [ @supportExports ], -); +@EXPORT = (); +@EXPORT_OK = (@supportExports); +%EXPORT_TAGS = ('support' => [@supportExports],); ################################################################################ ### private stuff @@ -54,7 +52,7 @@ sub _checkAndUpgradeDBSchemaIfNecessary { my $metaDB = shift; - vlog 2, "trying to determine schema version..."; + vlog(2, "trying to determine schema version..."); my $currVersion = $metaDB->schemaFetchDBVersion(); if (!defined $currVersion) { # that's bad, someone has messed with our DB, as there is a @@ -65,58 +63,69 @@ sub _checkAndUpgradeDBSchemaIfNecessary } if ($currVersion < $DbSchema->{version}) { - vlog 1, _tr('Our schema-version is %s, DB is %s, upgrading DB...', - $DbSchema->{version}, $currVersion); + vlog(1, + _tr('Our schema-version is %s, DB is %s, upgrading DB...', + $DbSchema->{version}, $currVersion)); foreach my $v (sort { $a <=> $b } keys %DbSchemaHistory) { next if $v <= $currVersion; my $changeSet = $DbSchemaHistory{$v}; - foreach my $c (0..scalar(@$changeSet)-1) { + foreach my $c (0 .. scalar(@$changeSet) - 1) { my $changeDescr = @{$changeSet}[$c]; - my $cmd = $changeDescr->{cmd}; + my $cmd = $changeDescr->{cmd}; if ($cmd eq 'add-table') { - $metaDB->schemaAddTable($changeDescr->{'table'}, - $changeDescr->{'cols'}, - $changeDescr->{'vals'}); + $metaDB->schemaAddTable( + $changeDescr->{'table'}, + $changeDescr->{'cols'}, + $changeDescr->{'vals'} + ); } elsif ($cmd eq 'drop-table') { $metaDB->schemaDropTable($changeDescr->{'table'}); } elsif ($cmd eq 'rename-table') { - $metaDB->schemaRenameTable($changeDescr->{'old-table'}, - $changeDescr->{'new-table'}, - $changeDescr->{'cols'}); + $metaDB->schemaRenameTable( + $changeDescr->{'old-table'}, + $changeDescr->{'new-table'}, + $changeDescr->{'cols'} + ); } elsif ($cmd eq 'add-columns') { - $metaDB->schemaAddColumns($changeDescr->{'table'}, - $changeDescr->{'new-cols'}, - $changeDescr->{'new-default-vals'}, - $changeDescr->{'cols'}); + $metaDB->schemaAddColumns( + $changeDescr->{'table'}, + $changeDescr->{'new-cols'}, + $changeDescr->{'new-default-vals'}, + $changeDescr->{'cols'} + ); } elsif ($cmd eq 'drop-columns') { - $metaDB->schemaDropColumns($changeDescr->{'table'}, - $changeDescr->{'drop-cols'}, - $changeDescr->{'cols'}); + $metaDB->schemaDropColumns( + $changeDescr->{'table'}, + $changeDescr->{'drop-cols'}, + $changeDescr->{'cols'} + ); } elsif ($cmd eq 'rename-columns') { - $metaDB->schemaRenameColumns($changeDescr->{'table'}, - $changeDescr->{'col-renames'}, - $changeDescr->{'cols'}); + $metaDB->schemaRenameColumns( + $changeDescr->{'table'}, + $changeDescr->{'col-renames'}, + $changeDescr->{'cols'} + ); } else { confess _tr('UnknownDbSchemaCommand', $cmd); } } } - vlog 1, _tr('upgrade done'); + vlog(1, _tr('upgrade done')); } else { - vlog 1, _tr('DB matches current schema version %s', $currVersion); + vlog(1, _tr('DB matches current schema version %s', $currVersion)); } } sub _aref -{ # transparently converts the given reference to an array-ref +{ # transparently converts the given reference to an array-ref my $ref = shift; return [] unless defined $ref; - $ref = [ $ref ] unless ref($ref) eq 'ARRAY'; + $ref = [$ref] unless ref($ref) eq 'ARRAY'; return $ref; } sub _unique -{ # return given array filtered to unique elements +{ # return given array filtered to unique elements my %seenIDs; return grep { !$seenIDs{$_}++; } @_; } @@ -127,25 +136,25 @@ sub _unique sub new { my $class = shift; - my $self = {}; + my $self = {}; return bless $self, $class; } sub connect { - my $self = shift; + my $self = shift; my $dbParams = shift; - # hash-ref with any additional info that might be required by - # specific metadb-module (not used yet) + # 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... + # name of underlying database module... # map db-type to name of module, such that the user doesn't have # to type the correct case: my %dbTypeMap = ( - 'csv' => 'CSV', - 'mysql' => 'mysql', + 'csv' => 'CSV', + 'mysql' => 'mysql', 'sqlite' => 'SQLite', ); my $lcType = lc($dbType); @@ -156,16 +165,19 @@ sub connect my $dbModule = "OpenSLX::MetaDB::$dbType"; unless (eval "require $dbModule") { if ($! == 2) { - die _tr("Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", - $dbModule); + die _tr( + "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", + $dbModule + ); } else { die _tr("Unable to load DB-module <%s> (%s)\n", $dbModule, $@); } } my $modVersion = $dbModule->VERSION; if ($modVersion < $VERSION) { - confess _tr('Could not load module <%s> (Version <%s> required, but <%s> found)', - $dbModule, $VERSION, $modVersion); + confess _tr( + 'Could not load module <%s> (Version <%s> required, but <%s> found)', + $dbModule, $VERSION, $modVersion); } my $metaDB = $dbModule->new(); if (!eval '$metaDB->connect($dbParams);1') { @@ -173,10 +185,11 @@ sub connect warn _tr("These DB-modules seem to work ok:"); foreach my $dbMod ('CSV', 'mysql', 'SQLite') { if (eval "require DBD::$dbMod;") { - vlog 0, "\t$dbMod\n"; + vlog(0, "\t$dbMod\n"); } } - die _tr('Please use slxsettings if you want to switch to another db-type.'); + die _tr( + 'Please use slxsettings if you want to switch to another db-type.'); } $self->{'db-type'} = $dbType; @@ -218,51 +231,48 @@ sub rollback_transaction sub fetchVendorOSByFilter { - my $self = shift; - my $filter = 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; } sub fetchVendorOSByID { - my $self = shift; - my $ids = _aref(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; } sub fetchExportByFilter { - my $self = shift; - my $filter = 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; } sub fetchExportByID { - my $self = shift; - my $ids = _aref(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; } sub fetchExportIDsOfVendorOS { - my $self = shift; + my $self = shift; my $vendorOSID = shift; return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); @@ -271,26 +281,25 @@ sub fetchExportIDsOfVendorOS sub fetchGlobalInfo { my $self = shift; - my $id = shift; + my $id = shift; return $self->{'meta-db'}->fetchGlobalInfo($id); } sub fetchSystemByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - my @systems - = $self->{'meta-db'}->fetchSystemByFilter($filter, $resultCols); + my @systems = $self->{'meta-db'}->fetchSystemByFilter($filter, $resultCols); return wantarray() ? @systems : shift @systems; } sub fetchSystemByID { - my $self = shift; - my $ids = _aref(shift); + my $self = shift; + my $ids = _aref(shift); my $resultCols = shift; my @systems = $self->{'meta-db'}->fetchSystemByID($ids, $resultCols); @@ -299,7 +308,7 @@ sub fetchSystemByID sub fetchSystemIDsOfExport { - my $self = shift; + my $self = shift; my $exportID = shift; return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); @@ -307,7 +316,7 @@ sub fetchSystemIDsOfExport sub fetchSystemIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); @@ -315,7 +324,7 @@ sub fetchSystemIDsOfClient sub fetchSystemIDsOfGroup { - my $self = shift; + my $self = shift; my $groupID = shift; return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); @@ -323,7 +332,7 @@ sub fetchSystemIDsOfGroup sub fetchClientByFilter { - my $self = shift; + my $self = shift; my $filter = shift; my @clients = $self->{'meta-db'}->fetchClientByFilter($filter); @@ -332,8 +341,8 @@ sub fetchClientByFilter sub fetchClientByID { - my $self = shift; - my $ids = _aref(shift); + my $self = shift; + my $ids = _aref(shift); my $resultCols = shift; my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); @@ -342,7 +351,7 @@ sub fetchClientByID sub fetchClientIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); @@ -350,7 +359,7 @@ sub fetchClientIDsOfSystem sub fetchClientIDsOfGroup { - my $self = shift; + my $self = shift; my $groupID = shift; return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); @@ -358,19 +367,18 @@ sub fetchClientIDsOfGroup sub fetchGroupByFilter { - my $self = shift; - my $filter = shift; + my $self = shift; + my $filter = shift; my $resultCols = shift; - my @groups - = $self->{'meta-db'}->fetchGroupByFilter($filter, $resultCols); + my @groups = $self->{'meta-db'}->fetchGroupByFilter($filter, $resultCols); return wantarray() ? @groups : shift @groups; } sub fetchGroupByID { - my $self = shift; - my $ids = _aref(shift); + my $self = shift; + my $ids = _aref(shift); my $resultCols = shift; my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); @@ -379,7 +387,7 @@ sub fetchGroupByID sub fetchGroupIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); @@ -387,7 +395,7 @@ sub fetchGroupIDsOfSystem sub fetchGroupIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); @@ -398,7 +406,7 @@ sub fetchGroupIDsOfClient ################################################################################ sub addVendorOS { - my $self = shift; + my $self = shift; my $valRows = _aref(shift); return $self->{'meta-db'}->addVendorOS($valRows); @@ -406,7 +414,7 @@ sub addVendorOS sub removeVendorOS { - my $self = shift; + my $self = shift; my $vendorOSIDs = _aref(shift); return $self->{'meta-db'}->removeVendorOS($vendorOSIDs); @@ -414,9 +422,9 @@ sub removeVendorOS sub changeVendorOS { - my $self = shift; + my $self = shift; my $vendorOSIDs = _aref(shift); - my $valRows = _aref(shift); + my $valRows = _aref(shift); return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); } @@ -424,14 +432,13 @@ sub changeVendorOS sub incrementExportCounterForVendorOS { my $self = shift; - my $id = shift; + my $id = shift; $self->start_transaction(); - my $vendorOS - = $self->fetchVendorOSByID($id); + my $vendorOS = $self->fetchVendorOSByID($id); return undef unless defined $vendorOS; - my $exportCounter = $vendorOS->{export_counter}+1; - $self->changeVendorOS($id, { 'export_counter' => $exportCounter }); + my $exportCounter = $vendorOS->{export_counter} + 1; + $self->changeVendorOS($id, {'export_counter' => $exportCounter}); $self->commit_transaction(); return $exportCounter; @@ -439,13 +446,13 @@ sub incrementExportCounterForVendorOS sub incrementGlobalCounter { - my $self = shift; + my $self = shift; my $counterName = shift; $self->start_transaction(); my $value = $self->fetchGlobalInfo($counterName); return undef unless defined $value; - my $newValue = $value+1; + my $newValue = $value + 1; $self->changeGlobalInfo($counterName, $newValue); $self->commit_transaction(); @@ -454,7 +461,7 @@ sub incrementGlobalCounter sub addExport { - my $self = shift; + my $self = shift; my $valRows = _aref(shift); return $self->{'meta-db'}->addExport($valRows); @@ -462,7 +469,7 @@ sub addExport sub removeExport { - my $self = shift; + my $self = shift; my $exportIDs = _aref(shift); return $self->{'meta-db'}->removeExport($exportIDs); @@ -470,17 +477,17 @@ sub removeExport sub changeExport { - my $self = shift; + my $self = shift; my $exportIDs = _aref(shift); - my $valRows = _aref(shift); + my $valRows = _aref(shift); return $self->{'meta-db'}->changeExport($exportIDs, $valRows); } sub changeGlobalInfo { - my $self = shift; - my $id = shift; + my $self = shift; + my $id = shift; my $value = shift; return $self->{'meta-db'}->changeGlobalInfo($id, $value); @@ -488,7 +495,7 @@ sub changeGlobalInfo sub addSystem { - my $self = shift; + my $self = shift; my $valRows = _aref(shift); foreach my $valRow (@$valRows) { @@ -505,7 +512,7 @@ sub addSystem sub removeSystem { - my $self = shift; + my $self = shift; my $systemIDs = _aref(shift); foreach my $system (@$systemIDs) { @@ -518,28 +525,28 @@ sub removeSystem sub changeSystem { - my $self = shift; + my $self = shift; my $systemIDs = _aref(shift); - my $valRows = _aref(shift); + my $valRows = _aref(shift); return $self->{'meta-db'}->changeSystem($systemIDs, $valRows); } sub setClientIDsOfSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; my $clientIDs = _aref(shift); my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfSystem($systemID, - \@uniqueClientIDs); + return $self->{'meta-db'} + ->setClientIDsOfSystem($systemID, \@uniqueClientIDs); } sub addClientIDsToSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; my $newClientIDs = _aref(shift); my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); @@ -549,33 +556,32 @@ sub addClientIDsToSystem sub removeClientIDsFromSystem { - my $self = shift; - my $systemID = 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 @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); return $self->setClientIDsOfSystem($systemID, \@clientIDs); } sub setGroupIDsOfSystem { - my $self = shift; + my $self = shift; my $systemID = shift; my $groupIDs = _aref(shift); my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, - \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); } sub addGroupIDsToSystem { - my $self = shift; - my $systemID = shift; + my $self = shift; + my $systemID = shift; my $newGroupIDs = _aref(shift); my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); @@ -585,21 +591,21 @@ sub addGroupIDsToSystem sub removeGroupIDsFromSystem { - my $self = shift; - my $systemID = 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 @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); return $self->setGroupIDsOfSystem($systemID, \@groupIDs); } sub addClient { - my $self = shift; + my $self = shift; my $valRows = _aref(shift); foreach my $valRow (@$valRows) { @@ -613,7 +619,7 @@ sub addClient sub removeClient { - my $self = shift; + my $self = shift; my $clientIDs = _aref(shift); foreach my $client (@$clientIDs) { @@ -626,28 +632,28 @@ sub removeClient sub changeClient { - my $self = shift; + my $self = shift; my $clientIDs = _aref(shift); - my $valRows = _aref(shift); + my $valRows = _aref(shift); return $self->{'meta-db'}->changeClient($clientIDs, $valRows); } sub setSystemIDsOfClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; my $systemIDs = _aref(shift); my @uniqueSystemIDs = _unique(@$systemIDs); - return $self->{'meta-db'}->setSystemIDsOfClient($clientID, - \@uniqueSystemIDs); + return $self->{'meta-db'} + ->setSystemIDsOfClient($clientID, \@uniqueSystemIDs); } sub addSystemIDsToClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; my $newSystemIDs = _aref(shift); my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); @@ -657,33 +663,32 @@ sub addSystemIDsToClient sub removeSystemIDsFromClient { - my $self = shift; - my $clientID = 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 @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); return $self->setSystemIDsOfClient($clientID, \@systemIDs); } sub setGroupIDsOfClient { - my $self = shift; + my $self = shift; my $clientID = shift; my $groupIDs = _aref(shift); my @uniqueGroupIDs = _unique(@$groupIDs); - return $self->{'meta-db'}->setGroupIDsOfClient($clientID, - \@uniqueGroupIDs); + return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); } sub addGroupIDsToClient { - my $self = shift; - my $clientID = shift; + my $self = shift; + my $clientID = shift; my $newGroupIDs = _aref(shift); my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); @@ -693,21 +698,21 @@ sub addGroupIDsToClient sub removeGroupIDsFromClient { - my $self = shift; - my $clientID = 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 @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); return $self->setGroupIDsOfClient($clientID, \@groupIDs); } sub addGroup { - my $self = shift; + my $self = shift; my $valRows = _aref(shift); return $self->{'meta-db'}->addGroup($valRows); @@ -715,7 +720,7 @@ sub addGroup sub removeGroup { - my $self = shift; + my $self = shift; my $groupIDs = _aref(shift); foreach my $group (@$groupIDs) { @@ -728,28 +733,27 @@ sub removeGroup sub changeGroup { - my $self = shift; + my $self = shift; my $groupIDs = _aref(shift); - my $valRows = _aref(shift); + my $valRows = _aref(shift); return $self->{'meta-db'}->changeGroup($groupIDs, $valRows); } sub setClientIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $clientIDs = _aref(shift); my @uniqueClientIDs = _unique(@$clientIDs); - return $self->{'meta-db'}->setClientIDsOfGroup($groupID, - \@uniqueClientIDs); + return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); } sub addClientIDsToGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $newClientIDs = _aref(shift); my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); @@ -759,33 +763,32 @@ sub addClientIDsToGroup sub removeClientIDsFromGroup { - my $self = shift; - my $groupID = 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 @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); return $self->setClientIDsOfGroup($groupID, \@clientIDs); } sub setSystemIDsOfGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $systemIDs = _aref(shift); my @uniqueSystemIDs = _unique(@$systemIDs); - return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, - \@uniqueSystemIDs); + return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); } sub addSystemIDsToGroup { - my $self = shift; - my $groupID = shift; + my $self = shift; + my $groupID = shift; my $newSystemIDs = _aref(shift); my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); @@ -795,49 +798,39 @@ sub addSystemIDsToGroup sub removeSystemIDsFromGroup { - my $self = shift; - my $groupID = 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 @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); return $self->setSystemIDsOfGroup($groupID, \@systemIDs); } sub emptyDatabase -{ # clears all user-data from the database +{ # clears all user-data from the database my $self = shift; - my @groupIDs - = map { $_->{id} } - $self->fetchGroupByFilter(); + my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); $self->removeGroup(\@groupIDs); - my @clientIDs - = map { $_->{id} } - grep { $_->{id} > 0 } - $self->fetchClientByFilter(); + my @clientIDs = map { $_->{id} } + grep { $_->{id} > 0 } $self->fetchClientByFilter(); $self->removeClient(\@clientIDs); - my @sysIDs - = map { $_->{id} } - grep { $_->{id} > 0 } - $self->fetchSystemByFilter(); + my @sysIDs = map { $_->{id} } + grep { $_->{id} > 0 } $self->fetchSystemByFilter(); $self->removeSystem(\@sysIDs); - my @exportIDs - = map { $_->{id} } - grep { $_->{id} > 0 } - $self->fetchExportByFilter(); + my @exportIDs = map { $_->{id} } + grep { $_->{id} > 0 } $self->fetchExportByFilter(); $self->removeExport(\@exportIDs); - my @vendorOSIDs - = map { $_->{id} } - grep { $_->{id} > 0 } - $self->fetchVendorOSByFilter(); + my @vendorOSIDs = map { $_->{id} } + grep { $_->{id} > 0 } $self->fetchVendorOSByFilter(); $self->removeVendorOS(\@vendorOSIDs); } @@ -845,9 +838,9 @@ sub emptyDatabase ### data aggregation interface ################################################################################ sub mergeDefaultAttributesIntoSystem -{ # merge default system attributes into given system - # and push the default client attributes on top of that - my $self = shift; +{ # merge default system attributes into given system + # and push the default client attributes on top of that + my $self = shift; my $system = shift; my $defaultSystem = $self->fetchSystemByID(0); @@ -858,31 +851,33 @@ sub mergeDefaultAttributesIntoSystem } sub mergeDefaultAndGroupAttributesIntoClient -{ # merge default and group configurations into given client - my $self = shift; +{ # merge default and group configurations into given client + my $self = shift; my $client = shift; # step over all groups this client belongs to # (ordered by priority from highest to lowest): my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); - my @groups = sort { $b->{priority} <=> $a->{priority} } - $self->fetchGroupByID(\@groupIDs); + my @groups = + sort { $b->{priority} <=> $a->{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}); + vlog(3, + _tr('merging from group %d:%s...', $group->{id}, $group->{name})); mergeAttributes($client, $group); } # merge configuration from default client: - vlog 3, _tr('merging from default client...'); + vlog(3, _tr('merging from default client...')); my $defaultClient = $self->fetchClientByID(0); mergeAttributes($client, $defaultClient); } sub aggregatedSystemIDsOfClient -{ # return aggregated list of system-IDs this client should offer - # (as indicated by itself, the default client and the client's groups) - my $self = shift; +{ # return aggregated list of system-IDs this client should offer + # (as indicated by itself, the default client and the client's groups) + my $self = shift; my $client = shift; # add all systems directly linked to client: @@ -890,7 +885,7 @@ sub aggregatedSystemIDsOfClient # step over all groups this client belongs to: my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); - my @groups = $self->fetchGroupByID(\@groupIDs); + 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}); @@ -903,9 +898,9 @@ sub aggregatedSystemIDsOfClient } sub aggregatedClientIDsOfSystem -{ # return aggregated list of client-IDs this system is linked to - # (as indicated by itself, the default system and the system's groups). - my $self = shift; +{ # return aggregated list of client-IDs this system is linked to + # (as indicated by itself, the default system and the system's groups). + my $self = shift; my $system = shift; # add all clients directly linked to system: @@ -916,13 +911,12 @@ sub aggregatedClientIDsOfSystem # the default client, as that means that all clients should offer #this system for booting: push @clientIDs, - map { $_->{id} } $self->fetchClientByFilter(undef, 'id'); + 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); + 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}); @@ -935,35 +929,39 @@ sub aggregatedClientIDsOfSystem } sub aggregatedSystemFileInfoFor -{ # return aggregated information about the kernel and initialramfs - # this system is using - my $self = shift; +{ # return aggregated information about the kernel and initialramfs + # this system is using + my $self = shift; my $system = shift; - my $info = { %$system }; + my $info = {%$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}); + 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}); + 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 $kernelPath - = "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; + my $kernelPath = + "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; $info->{'kernel-file'} = "$kernelPath/$system->{kernel}"; my $exportURI = $export->{'uri'}; if ($exportURI !~ m[\w]) { # auto-generate export_uri if none has been given: - my $type = $export->{'type'}; + my $type = $export->{'type'}; my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); $osExportEngine->initializeFromExisting($export->{name}); $exportURI = $osExportEngine->generateExportURI($export, $vendorOS); @@ -977,41 +975,41 @@ sub aggregatedSystemFileInfoFor ### support interface ################################################################################ sub isAttribute -{ # returns whether or not the given key is an exportable attribute +{ # returns whether or not the given key is an exportable attribute my $key = shift; return $key =~ m[^attr_]; } sub mergeAttributes -{ # copies all attributes of source that are unset in target over +{ # copies all attributes of source that are unset in target over my $target = shift; my $source = shift; foreach my $key (grep { isAttribute($_) } keys %$source) { if (length($source->{$key}) > 0 && length($target->{$key}) == 0) { - vlog 3, _tr("merging %s (val=%s)", $key, $source->{$key}); + vlog(3, _tr("merging %s (val=%s)", $key, $source->{$key})); $target->{$key} = $source->{$key}; } } } sub pushAttributes -{ # copies all attributes that are set in source into the target +{ # copies all attributes that are set in source into the target my $target = shift; my $source = shift; foreach my $key (grep { isAttribute($_) } keys %$source) { if (length($source->{$key}) > 0) { - vlog 3, _tr("pushing %s (val=%s)", $key, $source->{$key}); + vlog(3, _tr("pushing %s (val=%s)", $key, $source->{$key})); $target->{$key} = $source->{$key}; } } } sub externalIDForSystem -{ # returns given system's name as the external ID, worked into a - # state that is usable as a filename: +{ # returns given system's name as the external ID, worked into a + # state that is usable as a filename: my $system = shift; return "default" if $system->{id} == 0; @@ -1021,23 +1019,22 @@ sub externalIDForSystem return $name; } - sub externalIDForClient -{ # returns given client's MAC as the external ID, worked into a - # state that is usable as a filename: +{ # returns given client's MAC as the external ID, worked into a + # state that is usable as a filename: my $client = shift; return "default" if $client->{id} == 0; my $mac = lc($client->{mac}); - # PXE seems to expect MACs being all lowercase + # PXE seems to expect MACs being all lowercase $mac =~ tr[:][-]; return "01-$mac"; } sub externalConfigNameForClient -{ # returns given client's name as the external ID, worked into a - # state that is usable as a filename: +{ # returns given client's name as the external ID, worked into a + # state that is usable as a filename: my $client = shift; return "default" if $client->{id} == 0; @@ -1056,7 +1053,7 @@ sub externalAttrName sub generatePlaceholderFor { my $varName = shift; - return '@@@'.$varName.'@@@'; + return '@@@' . $varName . '@@@'; } 1; diff --git a/config-db/OpenSLX/Export/DHCP/ISC.pm b/config-db/OpenSLX/Export/DHCP/ISC.pm index fcc24b16..194876fa 100644 --- a/config-db/OpenSLX/Export/DHCP/ISC.pm +++ b/config-db/OpenSLX/Export/DHCP/ISC.pm @@ -38,7 +38,7 @@ sub execute my $self = shift; my $clients = shift; - vlog 1, _tr("writing dhcp-config for %s clients", scalar(@$clients)); + vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); foreach my $client (@$clients) { print "ISC-DHCP: $client->{name}\n"; } diff --git a/config-db/OpenSLX/MetaDB/Base.pm b/config-db/OpenSLX/MetaDB/Base.pm index 74daf5f1..2738cb16 100644 --- a/config-db/OpenSLX/MetaDB/Base.pm +++ b/config-db/OpenSLX/MetaDB/Base.pm @@ -287,7 +287,7 @@ OpenSLX::MetaDB::Base - the base class for all MetaDB drivers my $self = shift; my $dbName = $openslxConfig{'db-name'}; - vlog 1, "trying to connect to coolnewDB-database <$dbName>"; + vlog(1, "trying to connect to coolnewDB-database <$dbName>"); $self->{'dbh'} = ... # get connection handle from coolnewDB } diff --git a/config-db/OpenSLX/MetaDB/CSV.pm b/config-db/OpenSLX/MetaDB/CSV.pm index cd2a7da4..bee5ca80 100644 --- a/config-db/OpenSLX/MetaDB/CSV.pm +++ b/config-db/OpenSLX/MetaDB/CSV.pm @@ -54,7 +54,7 @@ sub connect system("mkdir -p $dbPath") unless -e $dbPath; $dbSpec = "f_dir=$dbPath;csv_eol=\n;"; } - vlog 1, "trying to connect to CSV-database <$dbSpec>"; + vlog(1, "trying to connect to CSV-database <$dbSpec>"); $self->{'dbh'} = DBI->connect("dbi:CSV:$dbSpec", undef, undef, {PrintError => 0}) or die _tr("Cannot connect to database '%s' (%s)", diff --git a/config-db/OpenSLX/MetaDB/DBI.pm b/config-db/OpenSLX/MetaDB/DBI.pm index e59c9996..54d567cf 100644 --- a/config-db/OpenSLX/MetaDB/DBI.pm +++ b/config-db/OpenSLX/MetaDB/DBI.pm @@ -85,7 +85,7 @@ sub _doSelect my $dbh = $self->{'dbh'}; - vlog 3, _trim($sql); + vlog(3, _trim($sql)); my $sth = $dbh->prepare($sql) or confess _tr(q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr); @@ -377,12 +377,12 @@ sub _doInsert 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}>"; + 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; + vlog(3, $sql); my $sth = $dbh->prepare($sql) or confess _tr(q[Can't insert into table <%s> (%s)], $table, $dbh->errstr); @@ -392,7 +392,7 @@ sub _doInsert 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}>"; + vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); } push @ids, $valRow->{'id'}; } @@ -419,7 +419,7 @@ sub _doDelete $sql .= $additionalWhereClause; } } - vlog 3, $sql; + vlog(3, $sql); my $sth = $dbh->prepare($sql) or confess _tr(q[Can't delete from table <%s> (%s)], $table, $dbh->errstr); @@ -457,7 +457,7 @@ sub _doUpdate if (defined $id) { $sql .= " WHERE id = ".$self->quote($id); } - vlog 3, $sql; + vlog(3, $sql); my $sth = $dbh->prepare($sql) or confess _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); $sth->execute() @@ -823,10 +823,10 @@ sub schemaAddTable my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog 1, "adding table <$table> to schema..." unless $isSubCmd; + vlog(1, "adding table <$table> to schema..." unless $isSubCmd); my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); my $sql = "CREATE TABLE $table ($colDescrString)"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); if (defined $initialVals) { @@ -843,9 +843,9 @@ sub schemaDropTable my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog 1, "dropping table <$table> from schema..." unless $isSubCmd; + vlog(1, "dropping table <$table> from schema..." unless $isSubCmd); my $sql = "DROP TABLE $table"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); } @@ -866,17 +866,17 @@ sub schemaRenameTable my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog 1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd; + vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); my $sql = "CREATE TABLE $newTable ($colDescrString)"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _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; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); } @@ -902,7 +902,7 @@ sub schemaAddColumns my $tempTable = "${table}_temp"; my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); my $newColStr = join ', ', @newColNames; - vlog 1, "adding columns <$newColStr> to table <$table>..." unless $isSubCmd; + 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: @@ -940,8 +940,8 @@ sub schemaDropColumns my $dbh = $self->{'dbh'}; my $tempTable = "${table}_temp"; my $dropColStr = join ', ', @$dropColNames; - vlog 1, "dropping columns <$dropColStr> from table <$table>..." - unless $isSubCmd; + 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: @@ -972,8 +972,8 @@ sub schemaChangeColumns my $dbh = $self->{'dbh'}; my $tempTable = "${table}_temp"; my $changeColStr = join ', ', keys %$colChanges; - vlog 1, "changing columns <$changeColStr> of table <$table>..." - unless $isSubCmd; + 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: diff --git a/config-db/OpenSLX/MetaDB/SQLite.pm b/config-db/OpenSLX/MetaDB/SQLite.pm index d2b91a03..d073f305 100644 --- a/config-db/OpenSLX/MetaDB/SQLite.pm +++ b/config-db/OpenSLX/MetaDB/SQLite.pm @@ -51,7 +51,7 @@ sub connect system("mkdir -p $dbPath") unless -e $dbPath; $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; } - vlog 1, "trying to connect to SQLite-database <$dbSpec>"; + vlog(1, "trying to connect to SQLite-database <$dbSpec>"); eval ('require DBD::SQLite; 1;') or die _tr(qq[%s doesn't seem to be installed, so there is no support for %s available, sorry!\n%s], 'DBD::SQLite', 'SQLite', $@); @@ -70,9 +70,9 @@ sub schemaRenameTable my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog 1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd; + vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); } @@ -88,12 +88,12 @@ sub schemaAddColumns my $dbh = $self->{'dbh'}; my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog 1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd; + 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; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't add column to table <%s> (%s)], $table, $dbh->errstr); diff --git a/config-db/OpenSLX/MetaDB/mysql.pm b/config-db/OpenSLX/MetaDB/mysql.pm index 25cc93a8..eb6f9551 100644 --- a/config-db/OpenSLX/MetaDB/mysql.pm +++ b/config-db/OpenSLX/MetaDB/mysql.pm @@ -48,7 +48,7 @@ sub connect $dbSpec = "database=$openslxConfig{'db-name'}"; } my $user = (getpwuid($>))[0]; - vlog 1, "trying to connect user <$user> to mysql-database <$dbSpec>"; + vlog(1, "trying to connect user <$user> to mysql-database <$dbSpec>"); $self->{'dbh'} = DBI->connect("dbi:mysql:$dbSpec", $user, '', {PrintError => 0}) or die _tr("Cannot connect to database <%s> (%s)", @@ -84,9 +84,9 @@ sub schemaRenameTable my $isSubCmd = shift; my $dbh = $self->{'dbh'}; - vlog 1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd; + vlog(1, "renaming table <$oldTable> to <$newTable>..." unless $isSubCmd); my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); } @@ -102,7 +102,7 @@ sub schemaAddColumns my $dbh = $self->{'dbh'}; my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); - vlog 1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd; + vlog(1, "adding columns <$newColNames> to table <$table>" unless $isSubCmd); my $addClause = join ', ', map { @@ -111,7 +111,7 @@ sub schemaAddColumns } @$newColDescrs; my $sql = "ALTER TABLE $table $addClause"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't add columns to table <%s> (%s)], $table, $dbh->errstr); @@ -131,11 +131,11 @@ sub schemaDropColumns my $dbh = $self->{'dbh'}; my $dropColStr = join ', ', @$dropColNames; - vlog 1, "dropping columns <$dropColStr> from table <$table>..." - unless $isSubCmd; + 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; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't drop columns from table <%s> (%s)], $table, $dbh->errstr); @@ -151,8 +151,8 @@ sub schemaChangeColumns my $dbh = $self->{'dbh'}; my $changeColStr = join ', ', keys %$colChanges; - vlog 1, "changing columns <$changeColStr> in table <$table>..." - unless $isSubCmd; + vlog(1, "changing columns <$changeColStr> in table <$table>..." + unless $isSubCmd); my $changeClause = join ', ', map { @@ -161,7 +161,7 @@ sub schemaChangeColumns } keys %$colChanges; my $sql = "ALTER TABLE $table $changeClause"; - vlog 3, $sql; + vlog(3, $sql); $dbh->do($sql) or confess _tr(q[Can't change columns in table <%s> (%s)], $table, $dbh->errstr); diff --git a/config-db/slxconfig b/config-db/slxconfig index f64b1fcd..cb6c912e 100755 --- a/config-db/slxconfig +++ b/config-db/slxconfig @@ -294,8 +294,8 @@ sub addClientToConfigDB $clientData->{mac}); } my $clientID = $openslxDB->addClient([$clientData]); - vlog 0, _tr("client '%s' has been successfully added to DB (ID=%s)\n", - $clientName, $clientID); + vlog(0, _tr("client '%s' has been successfully added to DB (ID=%s)\n", + $clientName, $clientID)); if (@systemIDs) { $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); } @@ -380,8 +380,8 @@ sub addSystemToConfigDB } my $systemID = $openslxDB->addSystem([$systemData]); - vlog 0, _tr("system '%s' has been successfully added to DB (ID=%s)\n", - $systemName, $systemID); + vlog(0, _tr("system '%s' has been successfully added to DB (ID=%s)\n", + $systemName, $systemID)); if (@clientIDs) { $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); } @@ -457,7 +457,7 @@ sub changeClientInConfigDB } $openslxDB->changeClient($client->{id}, [$clientData]); - vlog 0, _tr("client '%s' has been successfully changed\n", $clientName); + vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); if (@systemIDs) { $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); } @@ -527,7 +527,7 @@ sub changeSystemInConfigDB delete $systemData->{'remove-clients'}; } $openslxDB->changeSystem($system->{id}, [$systemData]); - vlog 0, _tr("system '%s' has been successfully changed\n", $systemName); + vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); if (@clientIDs) { $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); } @@ -555,8 +555,8 @@ sub removeClientFromConfigDB 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); + vlog(0, _tr("client '%s' has been successfully removed from DB\n", + $clientName)); } sub removeSystemFromConfigDB @@ -578,8 +578,8 @@ sub removeSystemFromConfigDB die _tr("you can't remove the default-client!\n"); } $openslxDB->removeSystem($system->{id}); - vlog 0, _tr("system '%s' has been successfully removed from DB\n", - $systemName); + vlog(0, _tr("system '%s' has been successfully removed from DB\n", + $systemName)); } diff --git a/config-db/slxconfig-demuxer b/config-db/slxconfig-demuxer index 5d3804c7..ff1dc18d 100755 --- a/config-db/slxconfig-demuxer +++ b/config-db/slxconfig-demuxer @@ -199,7 +199,7 @@ sub folderContainsFiles $result = 1 if -f; }; find({ wanted => $wanted, follow_fast => 1 }, $folder); - vlog 2, "result for folderContainsFiles($folder): $result\n"; + vlog(2, "result for folderContainsFiles($folder): $result\n"); return $result; } @@ -214,7 +214,7 @@ sub digestAttributes sort { $a cmp $b } grep { isAttribute($_) } keys %$attrs; - vlog 3, "Attribute-string: $attrsAsString"; + vlog(3, "Attribute-string: $attrsAsString"); use Digest::MD5 qw(md5_hex); return md5_hex($attrsAsString); } @@ -279,14 +279,14 @@ sub copyExternalSystemConfig # first copy default files ... my $defaultConfigPath = "$clientConfigPath/default"; - vlog 2, "checking $defaultConfigPath for default config..."; + 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..."; + vlog(2, "checking $systemSpecConfigPath for system config..."); if (folderContainsFiles($systemSpecConfigPath)) { slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); } @@ -295,7 +295,7 @@ sub copyExternalSystemConfig # configuration on top (if any): my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; - vlog 2, "checking $clientSpecConfigPath for client config..."; + vlog(2, "checking $clientSpecConfigPath for client config..."); if (folderContainsFiles($clientSpecConfigPath)) { slxsystem("cp -a $clientSpecConfigPath/* $targetPath") } @@ -309,7 +309,7 @@ sub createTarOfPath my $destinationPath = shift; my $tarFile = "$destinationPath/$tarName"; - vlog 1, _tr('creating tar %s', $tarFile); + vlog(1, _tr('creating tar %s', $tarFile)); return if $dryRun; mkdir $destinationPath; @@ -363,7 +363,7 @@ sub writePXEMenus my $externalClientID = externalIDForClient($client); my $pxeFile = "$pxeConfigPath/$externalClientID"; my $clientAppend = $client->{kernel_params}; - vlog 1, _tr("writing PXE-file %s", $pxeFile); + vlog(1, _tr("writing PXE-file %s", $pxeFile)); next if $dryRun; open(PXE, ">$pxeFile") or die "unable to write to $pxeFile"; print PXE $pxeTemplate; @@ -399,7 +399,7 @@ sub generateInitalRamFS my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); $osExportEngine->initializeFromExisting($info->{export}->{name}); - vlog 1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath); + vlog(1, _tr('generating initialramfs %s/initramfs', $pxeVendorOSPath)); my $cmd = "$openslxConfig{'base-path'}/bin/mkdxsinitrd "; if (length($info->{attr_ramfs_nicmods}) > 0) { $cmd .= qq[-n "$info->{attr_ramfs_nicmods}" ]; @@ -449,7 +449,7 @@ sub writeSystemPXEFiles my $targetKernel = "$pxeVendorOSPath/$kernelName"; if (!-e $targetKernel) { - vlog 1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel); + vlog(1, _tr('copying kernel %s to %s', $kernelFile, $targetKernel)); slxsystem(qq[cp -p "$kernelFile" "$targetKernel"]) unless $dryRun; } $vendorOSInitramfsMap{$info->{'vendor-os'}->{id}}++; @@ -461,7 +461,7 @@ sub writeSystemPXEFiles sub writeDhcpConfig { -vlog 0, _tr("sorry, exporting dhcp data is not implemented yet!"); +vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); my $dhcpModule = "OpenSLX::Export::DHCP::$dhcpType"; if (!eval "require $dhcpModule") { die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", $dhcpModule, $@); @@ -493,15 +493,15 @@ sub writeClientConfigurationsForSystem mergeAttributes($client, $info); my $clientAttrDigest = digestAttributes($client); - vlog 2, _tr("attribute-digest for client '%s' is '%s'", $client->{name}, - $clientAttrDigest); + 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}); + vlog(1, _tr("creating config-tgz for client %d:%s", $client->{id}, + $client->{name})); $clientSystemConfCount++; # merge default, system and client configuration files into @@ -532,8 +532,8 @@ sub writeSystemConfiguration $openslxDB->mergeDefaultAttributesIntoSystem($info); $info->{'attr-digest'} = digestAttributes($info); - vlog 2, _tr("attribute-digest for system '%s' is '%s'", $info->{name}, - $info->{'attr-digest'}); + vlog(2, _tr("attribute-digest for system '%s' is '%s'", $info->{name}, + $info->{'attr-digest'})); my $attrFile = "$buildPath/initramfs/machine-setup"; writeAttributesToFile($info, $attrFile); @@ -555,7 +555,7 @@ sub writeConfigurations foreach my $system (@systems) { next unless $system->{id} > 0; - vlog 0, _tr('exporting system %d:%s', $system->{id}, $system->{name}); + vlog(0, _tr('exporting system %d:%s', $system->{id}, $system->{name})); $systemConfCount++; my $info = $openslxDB->aggregatedSystemFileInfoFor($system); diff --git a/installer/OpenSLX/OSExport/BlockDevice/AoE.pm b/installer/OpenSLX/OSExport/BlockDevice/AoE.pm new file mode 100644 index 00000000..c8aad4ec --- /dev/null +++ b/installer/OpenSLX/OSExport/BlockDevice/AoE.pm @@ -0,0 +1,98 @@ +# Copyright (c) 2006, 2007 - OpenSLX GmbH +# +# This program is free software distributed under the GPL version 2. +# See http://openslx.org/COPYING +# +# If you have any feedback please consult http://openslx.org/feedback and +# send your suggestions, praise, or complaints to feedback@openslx.org +# +# 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. +# ----------------------------------------------------------------------------- +package OpenSLX::OSExport::BlockDevice::AoE; + +use vars qw($VERSION); +use base qw(OpenSLX::OSExport::BlockDevice::Base); +$VERSION = 1.01; # API-version . implementation-version + +use strict; +use Carp; +use File::Basename; +use OpenSLX::Basics; +use OpenSLX::ConfigDB qw(:support); +use OpenSLX::OSExport::BlockDevice::Base 1; +use OpenSLX::Utils; + +# +# +# N.B.: currently this is just a stub +# +# + + +################################################################################ +### interface methods +################################################################################ +sub new +{ + my $class = shift; + my $self = {'name' => 'aoe',}; + return bless $self, $class; +} + +sub initialize +{ + my $self = shift; + my $engine = shift; + my $fs = shift; + + $self->{'engine'} = $engine; + $self->{'fs'} = $fs; +} + +sub getExportPort +{ + my $self = shift; + my $openslxDB = shift; + + return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); +} + +sub generateExportURI +{ + my $self = shift; + my $export = shift; + + my $server = + length($export->{server_ip}) + ? $export->{server_ip} + : generatePlaceholderFor('serverip'); + $server .= ":$export->{port}" if length($export->{port}); + + return "aoe://$server"; +} + +sub requiredBlockDeviceModules +{ + my $self = shift; + + return 'aoe'; +} + +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"); +} + +1; diff --git a/installer/OpenSLX/OSExport/BlockDevice/Base.pm b/installer/OpenSLX/OSExport/BlockDevice/Base.pm new file mode 100644 index 00000000..938dc6db --- /dev/null +++ b/installer/OpenSLX/OSExport/BlockDevice/Base.pm @@ -0,0 +1,62 @@ +# Copyright (c) 2006, 2007 - OpenSLX GmbH +# +# This program is free software distributed under the GPL version 2. +# See http://openslx.org/COPYING +# +# If you have any feedback please consult http://openslx.org/feedback and +# send your suggestions, praise, or complaints to feedback@openslx.org +# +# General information about OpenSLX can be found at http://openslx.org/ +# ----------------------------------------------------------------------------- +# Base.pm +# - provides empty base of the OpenSLX OSExport::BlockDevice API. +# ----------------------------------------------------------------------------- +package OpenSLX::OSExport::BlockDevice::Base; + +use vars qw($VERSION); +$VERSION = 1.01; # API-version . implementation-version + +use strict; +use Carp; + +use OpenSLX::Basics; +use OpenSLX::Utils; + +################################################################################ +### interface methods +################################################################################ +sub new +{ + confess "Creating OpenSLX::OSExport::BlockDevice::Base-objects directly makes no sense!"; +} + +sub initialize +{ +} + +sub getExportPort +{ +} + +sub generateExportURI +{ +} + +sub requiredBlockDeviceModules +{ +} + +sub showExportConfigInfo +{ +} + +1; +################################################################################ + +=pod + +=head1 NAME + +OpenSLX::OSExport::BlockDevice::Base - the base class for all OSExport::BlockDevices + +=cut diff --git a/installer/OpenSLX/OSExport/BlockDevice/NBD.pm b/installer/OpenSLX/OSExport/BlockDevice/NBD.pm new file mode 100644 index 00000000..8afaa97f --- /dev/null +++ b/installer/OpenSLX/OSExport/BlockDevice/NBD.pm @@ -0,0 +1,91 @@ +# Copyright (c) 2006, 2007 - OpenSLX GmbH +# +# This program is free software distributed under the GPL version 2. +# See http://openslx.org/COPYING +# +# If you have any feedback please consult http://openslx.org/feedback and +# send your suggestions, praise, or complaints to feedback@openslx.org +# +# General information about OpenSLX can be found at http://openslx.org/ +# ----------------------------------------------------------------------------- +# NBD.pm +# - provides NBD+Squashfs-specific overrides of the +# OpenSLX::OSExport::BlockDevice API. +# ----------------------------------------------------------------------------- +package OpenSLX::OSExport::BlockDevice::NBD; + +use vars qw($VERSION); +use base qw(OpenSLX::OSExport::BlockDevice::Base); +$VERSION = 1.01; # API-version . implementation-version + +use strict; +use Carp; +use File::Basename; +use OpenSLX::Basics; +use OpenSLX::ConfigDB qw(:support); +use OpenSLX::OSExport::BlockDevice::Base 1; +use OpenSLX::Utils; + +################################################################################ +### interface methods +################################################################################ +sub new +{ + my $class = shift; + my $self = {'name' => 'nbd',}; + return bless $self, $class; +} + +sub initialize +{ + my $self = shift; + my $engine = shift; + my $fs = shift; + + $self->{'engine'} = $engine; + $self->{'fs'} = $fs; +} + +sub getExportPort +{ + my $self = shift; + my $openslxDB = shift; + + return $openslxDB->incrementGlobalCounter('next-nbd-server-port'); +} + +sub generateExportURI +{ + my $self = shift; + my $export = shift; + + my $server = + length($export->{server_ip}) + ? $export->{server_ip} + : generatePlaceholderFor('serverip'); + $server .= ":$export->{port}" if length($export->{port}); + + return "nbd://$server"; +} + +sub requiredBlockDeviceModules +{ + my $self = shift; + + return 'nbd'; +} + +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"); +} + +1; diff --git a/installer/OpenSLX/OSExport/Engine.pm b/installer/OpenSLX/OSExport/Engine.pm index 6668416a..5d08c177 100644 --- a/installer/OpenSLX/OSExport/Engine.pm +++ b/installer/OpenSLX/OSExport/Engine.pm @@ -14,13 +14,14 @@ package OpenSLX::OSExport::Engine; use vars qw(@ISA @EXPORT $VERSION); -$VERSION = 1.01; # API-version . implementation-version +$VERSION = 1.01; # API-version . implementation-version use Exporter; @ISA = qw(Exporter); @EXPORT = qw( - %supportedExportTypes %supportedDistros + %supportedExportFileSystems %supportedExportBlockDevices + @supportedExportTypes %supportedDistros ); use strict; @@ -30,28 +31,27 @@ use File::Basename; use OpenSLX::Basics; use OpenSLX::Utils; -use vars qw(%supportedExportTypes %supportedDistros); +use vars qw( + %supportedExportFileSystems %supportedExportBlockDevices + @supportedExportTypes %supportedDistros +); -%supportedExportTypes = ( - 'nfs' - => { module => 'NFS' }, - 'nbd' - => { module => 'NBD_Squash' }, +%supportedExportFileSystems = ( + 'nfs' => 'NFS', + 'sqfs' => 'SquashFS', ); +%supportedExportBlockDevices = ('nbd' => 'NBD', 'aoe' => 'AoE'); + +@supportedExportTypes = ('nfs', 'sqfs-aoe', 'sqfs-nbd'); + %supportedDistros = ( - '<any>' - => { module => 'Any' }, - 'debian' - => { module => 'Debian' }, - 'fedora' - => { module => 'Fedora' }, - 'gentoo' - => { module => 'Gentoo' }, - 'suse' - => { module => 'SUSE' }, - 'ubuntu' - => { module => 'Ubuntu' }, + '<any>' => {module => 'Any'}, + 'debian' => {module => 'Debian'}, + 'fedora' => {module => 'Fedora'}, + 'gentoo' => {module => 'Gentoo'}, + 'suse' => {module => 'SUSE'}, + 'ubuntu' => {module => 'Ubuntu'}, ); ################################################################################ @@ -61,55 +61,52 @@ sub new { my $class = shift; - my $self = { - }; + my $self = {}; return bless $self, $class; } sub initializeFromExisting { - my $self = shift; + my $self = shift; my $exportName = shift; my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); $openslxDB->connect(); - my $export - = $openslxDB->fetchExportByFilter({'name' => $exportName}); + 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 $vendorOS = + $openslxDB->fetchVendorOSByFilter({'id' => $export->{vendor_os_id}}); $openslxDB->disconnect(); - $self->_initialize($vendorOS->{name}, $vendorOS->{id}, - $export->{name}, $export->{type}); + $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $export->{name}, + $export->{type}); } sub initializeForNew { - my $self = shift; + my $self = shift; my $vendorOSName = shift; - my $exportType = lc(shift); + my $exportType = lc(shift); my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); $openslxDB->connect(); - my $vendorOS - = $openslxDB->fetchVendorOSByFilter({ 'name' => $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(); - $self->_initialize($vendorOS->{name}, $vendorOS->{id}, - $exportName, $exportType); + $self->_initialize($vendorOS->{name}, $vendorOS->{id}, $exportName, + $exportType); } sub exportVendorOS @@ -117,27 +114,37 @@ 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."); + 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'}, - $self->{'export-path'} + $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'} + ) ); - vlog 0, _tr("vendor-OS '%s' successfully exported to '%s'!", - $self->{'vendor-os-path'}, $self->{'export-path'}); - $self->addExportToConfigDB(); + $self->_addExportToConfigDB(); } sub purgeExport { my $self = shift; - if ($self->{'exporter'}->purgeExport($self->{'export-path'})) { - vlog 0, _tr("export '%s' successfully removed!", - $self->{'export-path'}); - } - $self->removeExportFromConfigDB(); + if ($self->{'exporter'}->purgeExport()) { + vlog( + 0, + _tr( + "export '%s' successfully removed!", + $self->{exporter}->{'export-path'} + ) + ); + } + $self->_removeExportFromConfigDB(); } sub generateExportURI @@ -159,23 +166,28 @@ sub requiredFSMods ################################################################################ sub _initialize { - my $self = shift; + my $self = shift; my $vendorOSName = shift; - my $vendorOSId = shift; - my $exportName = shift; - my $exportType = lc(shift); - - if (!exists $supportedExportTypes{lc($exportType)}) { - print _tr("Sorry, export type '%s' is unsupported.\n", $exportType); - print _tr("List of supported export types:\n\t"); - print join("\n\t", sort keys %supportedExportTypes)."\n"; + my $vendorOSId = shift; + my $exportName = shift; + my $exportType = lc(shift); + + 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-fs='$exportFS' export-bd='$exportBD'"); $self->{'vendor-os-name'} = $vendorOSName; - $self->{'vendor-os-id'} = $vendorOSId; - $self->{'export-name'} = $exportName; - $self->{'export-type'} = $exportType; + $self->{'vendor-os-id'} = $vendorOSId; + $self->{'export-name'} = $exportName; + $self->{'export-type'} = $exportType; $vendorOSName =~ m[^(.+?\-[^-]+)]; my $distroName = $1; $self->{'distro-name'} = $distroName; @@ -194,55 +206,78 @@ sub _initialize } } my $distroModuleName = $supportedDistros{lc($distroName)}->{module}; - my $distro - = instantiateClass("OpenSLX::OSExport::Distro::$distroModuleName"); + my $distro = + instantiateClass("OpenSLX::OSExport::Distro::$distroModuleName"); $distro->initialize($self); $self->{distro} = $distro; # load module for the requested export type: - my $typeModuleName = $supportedExportTypes{lc($exportType)}->{module}; - my $exporter - = instantiateClass("OpenSLX::OSExport::ExportType::$typeModuleName"); - $exporter->initialize($self); + 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"; - my $exportBasePath = "$openslxConfig{'public-path'}/export"; - $self->{'export-path'} = "$exportBasePath/$exportType/$vendorOSName"; - vlog 1, _tr("vendor-OS from '%s' will be exported to '%s'", - $self->{'vendor-os-path'}, $self->{'export-path'}); + $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'} + ) + ); } -sub addExportToConfigDB +sub _addExportToConfigDB { my $self = shift; my $openslxDB = instantiateClass("OpenSLX::ConfigDB"); $openslxDB->connect(); - my $export - = $openslxDB->fetchExportByFilter({ - 'name' => $self->{'export-name'}, + 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'}); + 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'}, + '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); + vlog( + 0, + _tr( + "Export '%s' has been added to DB (ID=%s)...\n", + $self->{'export-name'}, $id + ) + ); - $self->{exporter}->showExportConfigInfo($export) if $id; + $self->{exporter}->showExportConfigInfo($export) if $id; # now create a default system for that export, using the standard kernel: system("slxconfig add-system $self->{'export-name'}"); @@ -251,7 +286,7 @@ sub addExportToConfigDB $openslxDB->disconnect(); } -sub removeExportFromConfigDB +sub _removeExportFromConfigDB { my $self = shift; @@ -260,26 +295,32 @@ sub removeExportFromConfigDB # remove export from DB: my $exportName = $self->{'export-name'}; - my $export - = $openslxDB->fetchExportByFilter({ - 'name' => $exportName, - }); + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName,}); if (!defined $export) { - vlog 0, _tr("Export '%s' doesn't exist in OpenSLX-database.\n", - $exportName); + 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); + 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); + vlog(0, _tr("Export '%s' has been removed from DB.\n", $exportName)); } $openslxDB->disconnect(); @@ -301,3 +342,4 @@ OpenSLX::OSExport::Engine - ... =cut + diff --git a/installer/OpenSLX/OSExport/ExportType/Base.pm b/installer/OpenSLX/OSExport/ExportType/Base.pm deleted file mode 100644 index 7e0aa464..00000000 --- a/installer/OpenSLX/OSExport/ExportType/Base.pm +++ /dev/null @@ -1,128 +0,0 @@ -# Copyright (c) 2006, 2007 - OpenSLX GmbH -# -# This program is free software distributed under the GPL version 2. -# See http://openslx.org/COPYING -# -# If you have any feedback please consult http://openslx.org/feedback and -# send your suggestions, praise, or complaints to feedback@openslx.org -# -# General information about OpenSLX can be found at http://openslx.org/ -# ----------------------------------------------------------------------------- -# Base.pm -# - provides empty base of the OpenSLX OSExport::ExportType API. -# ----------------------------------------------------------------------------- -package OpenSLX::OSExport::ExportType::Base; - -use vars qw($VERSION); -$VERSION = 1.01; # API-version . implementation-version - -use strict; -use Carp; - -use OpenSLX::Basics; -use OpenSLX::Utils; - -################################################################################ -### interface methods -################################################################################ -sub new -{ - confess "Creating OpenSLX::OSExport::ExportType::Base-objects directly makes no sense!"; -} - -sub initialize -{ - my $self = shift; - my $engine = shift; - - $self->{'engine'} = $engine; -} - -sub exportVendorOS -{ -} - -sub purgeExport -{ -} - -sub checkRequirements -{ - return 1; -} - -sub addExportToConfigDB -{ - my $self = shift; - my $export = shift; - my $openslxDB = shift; - - return $openslxDB->addExport($export); -} - -sub generateExportURI -{ -} - -sub requiredFSMods -{ -} - -sub showExportConfigInfo -{ -} - -################################################################################ -### implementation methods -################################################################################ -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, 1); - $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'}; - $includeExcludeList =~ s[^\s+][]igms; - # remove any leading whitespace, as rsync doesn't like it - return $includeExcludeList; -} - -1; -################################################################################ - -=pod - -=head1 NAME - -OpenSLX::OSExport::ExportType::Base - the base class for all OSExport::ExportTypes - -=head1 SYNOPSIS - - package OpenSLX::OSExport::ExportType::coolnewexporter; - - use vars qw(@ISA $VERSION); - @ISA = ('OpenSLX::OSExport::ExportType::Base'); - $VERSION = 1.01; - - use coolnewexporter; - - sub new - { - my $class = shift; - my $self = {}; - return bless $self, $class; - } - - # override all methods of OpenSLX::OSExport::ExportType::Base in order to - # implement the support for a new export-type - ... - -I<The synopsis above outlines a class that implements a -OSExport::ExportType for the (imaginary) export-type B<coolnewexporter>> - -=cut diff --git a/installer/OpenSLX/OSExport/FileSystem/Base.pm b/installer/OpenSLX/OSExport/FileSystem/Base.pm new file mode 100644 index 00000000..bb6f42d3 --- /dev/null +++ b/installer/OpenSLX/OSExport/FileSystem/Base.pm @@ -0,0 +1,81 @@ +# Copyright (c) 2006, 2007 - OpenSLX GmbH +# +# This program is free software distributed under the GPL version 2. +# See http://openslx.org/COPYING +# +# If you have any feedback please consult http://openslx.org/feedback and +# send your suggestions, praise, or complaints to feedback@openslx.org +# +# General information about OpenSLX can be found at http://openslx.org/ +# ----------------------------------------------------------------------------- +# Base.pm +# - provides empty base of the OpenSLX OSExport::FileSystem API. +# ----------------------------------------------------------------------------- +package OpenSLX::OSExport::FileSystem::Base; + +use vars qw($VERSION); +$VERSION = 1.01; # API-version . implementation-version + +use strict; +use Carp; + +use OpenSLX::Basics; +use OpenSLX::Utils; + +################################################################################ +### interface methods +################################################################################ +sub new +{ + confess "Creating OpenSLX::OSExport::FileSystem::Base-objects directly makes no sense!"; +} + +sub initialize +{ +} + +sub exportVendorOS +{ +} + +sub purgeExport +{ +} + +sub checkRequirements +{ + return 1; +} + +sub addExportToConfigDB +{ + my $self = shift; + my $export = shift; + my $openslxDB = shift; + + return $openslxDB->addExport($export); +} + +sub generateExportURI +{ +} + +sub requiredFSMods +{ +} + +sub showExportConfigInfo +{ +} + +1; + +################################################################################ + +=pod + +=head1 NAME + +OpenSLX::OSExport::FileSystem::Base - the base class for all OSExport::FileSystems + +=cut diff --git a/installer/OpenSLX/OSExport/ExportType/NFS.pm b/installer/OpenSLX/OSExport/FileSystem/NFS.pm index 12fa4bfc..36926d61 100644 --- a/installer/OpenSLX/OSExport/ExportType/NFS.pm +++ b/installer/OpenSLX/OSExport/FileSystem/NFS.pm @@ -9,12 +9,12 @@ # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- # NFS.pm -# - provides NFS-specific overrides of the OpenSLX::OSExport::ExportType API. +# - provides NFS-specific overrides of the OpenSLX::OSExport::FileSystem API. # ----------------------------------------------------------------------------- -package OpenSLX::OSExport::ExportType::NFS; +package OpenSLX::OSExport::FileSystem::NFS; use vars qw($VERSION); -use base qw(OpenSLX::OSExport::ExportType::Base); +use base qw(OpenSLX::OSExport::FileSystem::Base); $VERSION = 1.01; # API-version . implementation-version use strict; @@ -23,7 +23,7 @@ use File::Basename; use OpenSLX::Basics; use OpenSLX::ConfigDB qw(:support); use OpenSLX::Utils; -use OpenSLX::OSExport::ExportType::Base 1; +use OpenSLX::OSExport::FileSystem::Base 1; ################################################################################ ### interface methods @@ -32,30 +32,40 @@ sub new { my $class = shift; my $self = { - 'name' => 'NFS', + 'name' => 'nfs', }; return bless $self, $class; } +sub initialize +{ + my $self = shift; + my $engine = shift; + + $self->{'engine'} = $engine; + my $exportBasePath = "$openslxConfig{'public-path'}/export"; + $self->{'export-path'} = "$exportBasePath/nfs/$engine->{'vendor-os-name'}"; +} + sub exportVendorOS { my $self = shift; my $source = shift; - my $target = shift; - $self->copyViaRsync($source, $target); + my $target = $self->{'export-path'}; + $self->_copyViaRsync($source, $target); } sub purgeExport { my $self = shift; - my $target = shift; + my $target = $self->{'export-path'}; if (system("rm -r $target")) { - vlog 0, _tr("unable to remove export '%s'!", $target); + vlog(0, _tr("unable to remove export '%s'!", $target)); return 0; } - 1; + return 1; } sub generateExportURI @@ -98,7 +108,7 @@ sub showExportConfigInfo ################################################################################ ### implementation methods ################################################################################ -sub copyViaRsync +sub _copyViaRsync { my $self = shift; my $source = shift; @@ -108,8 +118,8 @@ sub copyViaRsync 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 $includeExcludeList = $self->_determineIncludeExcludeList(); + vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); open(RSYNC, "| rsync -av --delete --exclude-from=- $source/ $target") or die _tr("unable to start rsync for source '%s', giving up! (%s)", $source, $!); @@ -120,4 +130,21 @@ sub copyViaRsync } } +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, 1); + $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/ExportType/NBD_Squash.pm b/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm index a1ec0c26..5983e2c2 100644 --- a/installer/OpenSLX/OSExport/ExportType/NBD_Squash.pm +++ b/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm @@ -8,13 +8,14 @@ # # General information about OpenSLX can be found at http://openslx.org/ # ----------------------------------------------------------------------------- -# NBD_Squash.pm -# - provides NBD+Squashfs-specific overrides of the OpenSLX::OSExport::ExportType API. +# SquashFS.pm +# - provides SquashFS-specific overrides of the OpenSLX::OSExport::ExportType +# API. # ----------------------------------------------------------------------------- -package OpenSLX::OSExport::ExportType::NBD_Squash; +package OpenSLX::OSExport::FileSystem::SquashFS; use vars qw($VERSION); -use base qw(OpenSLX::OSExport::ExportType::Base); +use base qw(OpenSLX::OSExport::FileSystem::Base); $VERSION = 1.01; # API-version . implementation-version use strict; @@ -22,7 +23,7 @@ use Carp; use File::Basename; use OpenSLX::Basics; use OpenSLX::ConfigDB qw(:support); -use OpenSLX::OSExport::ExportType::Base 1; +use OpenSLX::OSExport::FileSystem::Base 1; use OpenSLX::Utils; ################################################################################ @@ -32,36 +33,53 @@ sub new { my $class = shift; my $self = { - 'name' => 'NBD_Squash', + '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'}"; +} + sub exportVendorOS { my $self = shift; my $source = shift; - my $target = shift; - my $includeExcludeList = $self->determineIncludeExcludeList(); + 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 - = mapRsyncFilter2Regex($source, $includeExcludeList); - vlog 1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList); - $self->createSquashFS($source, $target, $includeExcludeList); + = $self->_mapRsyncFilter2Regex($source, $includeExcludeList); + vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList)); + my $target = $self->{'export-path'}; +# $self->_createSquashFS($source, $target, $includeExcludeList); + $self->_addBlockDeviceTagToExport($target); } sub purgeExport { my $self = shift; - my $target = shift; - if (system("rm $target")) { - vlog 0, _tr("unable to remove export '%s'!", $target); - return 0; + 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; + } } - 1; + return 1; } sub checkRequirements @@ -76,17 +94,22 @@ sub checkRequirements die _tr("unable to determine version of kernel '%s'!", $kernel); } my $kernelVer = $1; - my $nbdMod = locateKernelModule( - $vendorOSPath, - 'nbd.ko', - ["$vendorOSPath/lib/modules/$kernelVer/kernel/drivers/block"] - ); - if (!defined $nbdMod) { - warn _tr("unable to find nbd-module for kernel version '%s'.", - $kernelVer); - return undef; + my @blockMods; + 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 undef; + } + push @blockMods, $blockMod; } - my $squashfsMod = locateKernelModule( + my $squashfsMod = $self->_locateKernelModule( $vendorOSPath, 'squashfs.ko', ["$vendorOSPath/lib/modules/$kernelVer/kernel/fs/squashfs", @@ -97,8 +120,9 @@ sub checkRequirements $kernelVer); return undef; } + push @blockMods, $squashfsMod; if (defined $info) { - $info->{'kernel-mods'} = [ $nbdMod, $squashfsMod ]; + $info->{'kernel-mods'} = \@blockMods; }; return 1; } @@ -109,8 +133,7 @@ sub addExportToConfigDB my $export = shift; my $openslxDB = shift; - $export->{port} - = $openslxDB->incrementGlobalCounter('next-nbd-server-port'); + $export->{port} = $self->{'block-device'}->getExportPort($openslxDB); my $res = $openslxDB->addExport($export); return $res; @@ -122,20 +145,18 @@ sub generateExportURI my $export = shift; my $vendorOS = shift; - my $server - = length($export->{server_ip}) - ? $export->{server_ip} - : generatePlaceholderFor('serverip'); - $server .= ":$export->{port}" if length($export->{port}); - - return "nbd://$server/squashfs"; + my $URI = $self->{'block-device'}->generateExportURI($export); + $URI .= '/squashfs'; + return $URI; } sub requiredFSMods { my $self = shift; - return 'nbd squashfs'; + my @mods = $self->{'block-device'}->requiredBlockDeviceModules(); + push @mods, 'squashfs '; + return join ' ', @mods; } sub showExportConfigInfo @@ -143,17 +164,14 @@ 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->{engine}->{'export-path'} -r"); - print (('#' x 80)."\n"); + $self->{'block-device'}->showExportConfigInfo($export); } ################################################################################ ### implementation methods ################################################################################ -sub createSquashFS +sub _createSquashFS { my $self = shift; my $source = shift; @@ -181,7 +199,7 @@ sub createSquashFS close(FILTERFILE); # ... invoke mksquashfs ... - vlog 0, _tr("invoking mksquashfs..."); + vlog(0, _tr("invoking mksquashfs...")); my $mksquashfsBinary = "$openslxConfig{'base-path'}/share/squashfs/mksquashfs"; my $res = system("$mksquashfsBinary $source $target -ff $filterFile"); @@ -193,8 +211,26 @@ sub createSquashFS } } -sub mapRsyncFilter2Regex +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, 1); + $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; return @@ -227,16 +263,17 @@ sub mapRsyncFilter2Regex split "\n", shift; } -sub locateKernelModule +sub _locateKernelModule { + my $self = shift; my $vendorOSPath = shift; my $moduleName = shift; my $defaultPaths = shift; - vlog 1, _tr("locating kernel-module '%s'", $moduleName); + vlog(1, _tr("locating kernel-module '%s'", $moduleName)); # check default paths first: foreach my $defPath (@$defaultPaths) { - vlog 2, "trying $defPath/$moduleName"; + vlog(2, "trying $defPath/$moduleName"); my $target = followLink("$defPath/$moduleName", $vendorOSPath); return $target unless !-e $target; } @@ -244,13 +281,13 @@ sub locateKernelModule use File::Find; my $location; my $locationAge = 9999999; - vlog 2, "searching in $vendorOSPath/lib/modules"; + 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)"; + vlog(2, "located at $location (age=$locationAge days)"); } }, "$vendorOSPath/lib/modules"; if (defined $location) { @@ -259,4 +296,28 @@ sub locateKernelModule return undef; } +sub _addBlockDeviceTagToExport +{ + my $self = shift; + my $target = shift; + + my $tagName = "$target".'@'.lc($self->{'block-device'}->{name}); + linkFile(basename($target), $tagName); +} + +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) +} + 1; diff --git a/installer/OpenSLX/OSSetup/Engine.pm b/installer/OpenSLX/OSSetup/Engine.pm index 6064ce6f..1bfdcbaf 100644 --- a/installer/OpenSLX/OSSetup/Engine.pm +++ b/installer/OpenSLX/OSSetup/Engine.pm @@ -87,7 +87,7 @@ sub DESTROY # we are the master process, so we clean up all the servers that we # have started: while(my ($localURL, $pid) = each %{$self->{'local-http-servers'}}) { - vlog 1, _tr("stopping local HTTP-server for URL '%s'.", $localURL); + vlog(1, _tr("stopping local HTTP-server for URL '%s'.", $localURL)); kill TERM => $pid; } } @@ -165,7 +165,7 @@ sub initialize $self->{'vendor-os-path'} = "$openslxConfig{'private-path'}/stage1/$self->{'vendor-os-name'}"; - vlog 1, "vendor-OS path is '$self->{'vendor-os-path'}'"; + vlog(1, "vendor-OS path is '$self->{'vendor-os-path'}'"); if ($actionType ne 'clone') { $self->createPackager(); @@ -187,7 +187,7 @@ sub installVendorOS my $baseSystemFile = "$self->{'vendor-os-path'}/.openslx-base-system"; if (-e $baseSystemFile) { - vlog 0, _tr("found existing base system, continuing...\n"); + vlog(0, _tr("found existing base system, continuing...\n")); } else { # basic setup, stage1a-c: $self->setupStage1A(); @@ -213,8 +213,8 @@ sub installVendorOS close(INFO); slxsystem("rm $baseSystemFile"); # no longer needed, we have a full system now - vlog 0, _tr("Vendor-OS '%s' installed succesfully.\n", - $self->{'vendor-os-name'}); + vlog(0, _tr("Vendor-OS '%s' installed succesfully.\n", + $self->{'vendor-os-name'})); $self->addInstalledVendorOSToConfigDB(); } @@ -275,11 +275,11 @@ sub cloneVendorOS close CLONE_INFO; } if ($isReClone) { - vlog 0, _tr("Vendor-OS '%s' has been re-cloned succesfully.\n", - $self->{'vendor-os-name'}); + 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'}); + vlog(0, _tr("Vendor-OS '%s' has been cloned succesfully.\n", + $self->{'vendor-os-name'})); } $self->addInstalledVendorOSToConfigDB(); @@ -300,8 +300,8 @@ sub updateVendorOS $self->changePersonalityIfNeeded(); $self->updateStage1D(); }); - vlog 0, _tr("Vendor-OS '%s' updated succesfully.\n", - $self->{'vendor-os-name'}); + vlog(0, _tr("Vendor-OS '%s' updated succesfully.\n", + $self->{'vendor-os-name'})); } sub startChrootedShellForVendorOS @@ -319,20 +319,20 @@ sub startChrootedShellForVendorOS $self->changePersonalityIfNeeded(); $self->startChrootedShellInStage1D(); }); - vlog 0, _tr("Chrooted shell for vendor-OS '%s' has been closed.\n", - $self->{'vendor-os-name'}); + vlog(0, _tr("Chrooted shell for vendor-OS '%s' has been closed.\n", + $self->{'vendor-os-name'})); } sub removeVendorOS { my $self = shift; - vlog 0, _tr("removing vendor-OS folder '%s'...", $self->{'vendor-os-path'}); + 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'}); + 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'}); + vlog(0, _tr("Vendor-OS '%s' removed succesfully.\n", + $self->{'vendor-os-name'})); } $self->removeVendorOSFromConfigDB(); } @@ -356,11 +356,11 @@ sub addInstalledVendorOSToConfigDB $openslxDB->changeVendorOS($vendorOS->{id}, { 'clone_source' => $self->{'clone-source'}, }); - vlog 0, _tr("Vendor-OS '%s' has been updated in OpenSLX-database.\n", - $vendorOSName); + 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); + vlog(0, _tr("No need to change vendor-OS '%s' in OpenSLX-database.\n", + $vendorOSName)); } } else { my $data = { @@ -371,8 +371,8 @@ sub addInstalledVendorOSToConfigDB } my $id = $openslxDB->addVendorOS($data); - vlog 0, _tr("Vendor-OS '%s' has been added to DB (ID=%s).\n", - $vendorOSName, $id); + vlog(0, _tr("Vendor-OS '%s' has been added to DB (ID=%s).\n", + $vendorOSName, $id)); } $openslxDB->disconnect(); @@ -389,8 +389,8 @@ sub removeVendorOSFromConfigDB my $vendorOS = $openslxDB->fetchVendorOSByFilter({ 'name' => $vendorOSName }); if (!defined $vendorOS) { - vlog 0, _tr("Vendor-OS '%s' didn't exist in OpenSLX-database.\n", - $vendorOSName); + 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: @@ -400,14 +400,14 @@ sub removeVendorOSFromConfigDB 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}); + 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); + vlog(0, _tr("Vendor-OS '%s' has been removed from DB!\n", + $vendorOSName)); } $openslxDB->disconnect(); @@ -420,7 +420,7 @@ sub readDistroInfo { my $self = shift; - vlog 1, "reading configuration info for $self->{'vendor-os-name'}..."; + vlog(1, "reading configuration info for $self->{'vendor-os-name'}..."); # merge user-provided configuration distro defaults... my %repository = %{$self->{distro}->{config}->{repository}}; my %selection = %{$self->{distro}->{config}->{selection}}; @@ -437,7 +437,7 @@ sub readDistroInfo = $self->{distro}->{config}->{'metapackager-packages'}; my $file = "$self->{'config-distro-info-dir'}/settings"; if (-e $file) { - vlog 2, "reading configuration file $file..."; + vlog(2, "reading configuration file $file..."); my $config = slurpFile($file); if (!eval $config && length($@)) { die _tr("error in config-file '%s' (%s)", $file, $@)."\n"; @@ -466,23 +466,23 @@ sub readDistroInfo if ($openslxConfig{'verbose-level'} >= 2) { # dump distro-info, if asked for: foreach my $r (sort keys %repository) { - vlog 2, "repository '$r':"; + vlog(2, "repository '$r':"); foreach my $k (sort keys %{$repository{$r}}) { - vlog 3, "\t$k = '$repository{$r}->{$k}'"; + vlog(3, "\t$k = '$repository{$r}->{$k}'"); } } foreach my $s (sort keys %selection) { my @selLines = split "\n", $selection{$s}; - vlog 2, "selection '$s':"; + vlog(2, "selection '$s':"); foreach my $sl (@selLines) { - vlog 3, "\t$sl"; + vlog(3, "\t$sl"); } } foreach my $e (sort keys %excludes) { my @exclLines = split "\n", $excludes{$e}; - vlog 2, "excludes for '$e':"; + vlog(2, "excludes for '$e':"); foreach my $excl (@exclLines) { - vlog 3, "\t$excl"; + vlog(3, "\t$excl"); } } } @@ -578,13 +578,13 @@ try_next_url: push @contFlags, '-c' if ($url =~ m[^ftp]); # continuing is only supported with FTP, but not with HTTP foreach my $file (split '\s+', $fileVariantStr) { - vlog 2, "fetching <$file>..."; + vlog(2, "fetching <$file>..."); if (slxsystem("wget", @contFlags, "$url/$file") == 0) { $foundFile = basename($file); last; } elsif ($! == 17) { my $basefile = basename($file); - vlog 2, "removing left-over '$basefile' and trying again..."; + vlog(2, "removing left-over '$basefile' and trying again..."); unlink $basefile; } } @@ -593,8 +593,8 @@ try_next_url: $tryCount++; $self->{'baseURL-index'} = ($self->{'baseURL-index'}+1) % scalar(@URLs); - vlog 0, _tr("switching to mirror '%s'.", - $URLs[$self->{'baseURL-index'}]); + 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", @@ -631,7 +631,7 @@ sub startLocalURLServersAsNeeded '-h', '/', '-f' ); - vlog 1, _tr("started local HTTP-server for URL '%s'.", $localURL); + vlog(1, _tr("started local HTTP-server for URL '%s'.", $localURL)); $self->{'local-http-servers'}->{$localURL} = $pid; } } @@ -641,7 +641,7 @@ sub setupStage1A { my $self = shift; - vlog 1, "setting up stage1a for $self->{'vendor-os-name'}..."; + vlog(1, "setting up stage1a for $self->{'vendor-os-name'}..."); # specify individual paths for the respective substages: $self->{stage1aDir} = "$self->{'vendor-os-path'}/stage1a"; @@ -667,7 +667,7 @@ sub stage1A_createBusyboxEnvironment my $self = shift; # copy busybox and all required binaries into stage1a-dir: - vlog 1, "creating busybox-environment..."; + vlog(1, "creating busybox-environment..."); my $busyboxName = $self->hostIs64Bit() ? 'busybox.x86_64' @@ -676,20 +676,20 @@ sub stage1A_createBusyboxEnvironment "$self->{stage1aDir}/bin", 'busybox'); # determine all required libraries and copy those, too: - vlog 1, _tr("calling slxldd for $busyboxName"); + vlog(1, _tr("calling slxldd for $busyboxName")); my $slxlddCmd = "slxldd $openslxConfig{'base-path'}/share/busybox/$busyboxName"; - vlog 2, "executing: $slxlddCmd"; + vlog(2, "executing: $slxlddCmd"); my $requiredLibsStr = `$slxlddCmd`; if ($?) { die _tr("slxldd couldn't determine the libs required by busybox! (%s)", $?); } chomp $requiredLibsStr; - vlog 2, "slxldd results:\n$requiredLibsStr"; + vlog(2, "slxldd results:\n$requiredLibsStr"); my $libcFolder; foreach my $lib (split "\n", $requiredLibsStr) { - vlog 3, "copying lib '$lib'"; + vlog(3, "copying lib '$lib'"); my $libDir = dirname($lib); copyFile($lib, "$self->{stage1aDir}$libDir"); if ($lib =~ m[/libc.so.\d\s*$]) { @@ -740,7 +740,7 @@ sub stage1A_copyPrerequiredFiles return unless -d "$self->{'shared-distro-info-dir'}/prereqfiles"; - vlog 2, "copying folder with pre-required files..."; + vlog(2, "copying folder with pre-required files..."); my $stage1cDir = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}/$self->{'stage1cSubdir'}"; my $cmd = qq[ @@ -758,7 +758,7 @@ sub stage1A_copyTrustedPackageKeys { my $self = shift; - vlog 2, "copying folder with trusted package keys..."; + vlog(2, "copying folder with trusted package keys..."); my $stage1bDir = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}"; foreach my $folder ( @@ -789,7 +789,7 @@ sub stage1A_createRequiredFiles { my $self = shift; - vlog 2, "creating required files..."; + vlog(2, "creating required files..."); # fake all files required by stage1b (by creating them empty): my $stage1bDir = "$self->{'stage1aDir'}/$self->{'stage1bSubdir'}"; @@ -814,7 +814,7 @@ sub setupStage1B { my $self = shift; - vlog 1, "setting up stage1b for $self->{'vendor-os-name'}..."; + vlog(1, "setting up stage1b for $self->{'vendor-os-name'}..."); $self->stage1B_chrootAndBootstrap(); } @@ -855,7 +855,7 @@ sub setupStage1C { my $self = shift; - vlog 1, "setting up stage1c for $self->{'vendor-os-name'}..."; + vlog(1, "setting up stage1c for $self->{'vendor-os-name'}..."); $self->stage1C_chrootAndInstallBasicVendorOS(); } @@ -909,7 +909,7 @@ sub setupStage1D { my $self = shift; - vlog 1, "setting up stage1d for $self->{'vendor-os-name'}..."; + vlog(1, "setting up stage1d for $self->{'vendor-os-name'}..."); chrootInto($self->{'vendor-os-path'}); @@ -922,7 +922,7 @@ sub updateStage1D { my $self = shift; - vlog 1, "updating $self->{'vendor-os-name'}..."; + vlog(1, "updating $self->{'vendor-os-name'}..."); chrootInto($self->{'vendor-os-path'}); @@ -933,10 +933,10 @@ 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, "---------------------------------------"; + vlog(0, "starting chrooted shell for $self->{'vendor-os-name'}"); + vlog(0, "---------------------------------------"); + vlog(0, "- please type 'exit' if you are done! -"); + vlog(0, "---------------------------------------"); chrootInto($self->{'vendor-os-path'}); @@ -951,14 +951,14 @@ sub stage1D_setupPackageSources() { my $self = shift; - vlog 1, "setting up package sources for meta packager..."; + vlog(1, "setting up package sources for meta packager..."); my $selectionName = $self->{'selection-name'}; my $pkgExcludes = $self->{'distro-info'}->{excludes}->{$selectionName}; 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..."; + vlog(2, "setting up package source $rk..."); $self->{'meta-packager'}->setupPackageSource($rk, $repo, $excludeList); } } @@ -967,7 +967,7 @@ sub stage1D_updateBasicVendorOS() { my $self = shift; - vlog 1, "updating basic vendor-os..."; + vlog(1, "updating basic vendor-os..."); $self->{'meta-packager'}->startSession(); $self->{'meta-packager'}->updateBasicVendorOS(); $self->{'distro'}->updateDistroConfig(); @@ -980,7 +980,7 @@ sub stage1D_installPackageSelection my $selectionName = $self->{'selection-name'}; - vlog 1, "installing package selection <$selectionName>..."; + vlog(1, "installing package selection <$selectionName>..."); my $pkgSelection = $self->{'distro-info'}->{selection}->{$selectionName}; my @pkgs = string2Array($pkgSelection); my @installedPkgs = $self->{'packager'}->getInstalledPackages(); @@ -988,15 +988,15 @@ sub stage1D_installPackageSelection = grep { my $pkg = $_; if (grep { $_ eq $pkg; } @installedPkgs) { - vlog 1, "package '$pkg' filtered, it is already installed."; + vlog(1, "package '$pkg' filtered, it is already installed."); 0; } else { 1; } } @pkgs; - vlog 0, _tr("No packages listed for selection '%s', nothing to do.", - $selectionName); - vlog 1, "installing these packages:\n".join("\n\t", @pkgs); + vlog(0, _tr("No packages listed for selection '%s', nothing to do.", + $selectionName)); + vlog(1, "installing these packages:\n".join("\n\t", @pkgs)); $self->{'meta-packager'}->startSession(); if (scalar(@pkgs) > 0) { $self->{'meta-packager'}->installSelection(join " ", @pkgs); @@ -1010,13 +1010,13 @@ 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'}); + 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"; + vlog(1, "using exclude-include-filter:\n$excludeIncludeList\n"); my $rsyncCmd = "rsync -av --delete --exclude-from=- $source $self->{'vendor-os-path'}"; - vlog 2, "executing: $rsyncCmd\n"; + vlog(2, "executing: $rsyncCmd\n"); open(RSYNC, "| $rsyncCmd") or die _tr("unable to start rsync for source '%s', giving up! (%s)\n", $source, $!); @@ -1085,7 +1085,7 @@ sub chrootInto { my $osDir = shift; - vlog 2, "chrooting into $osDir..."; + vlog(2, "chrooting into $osDir..."); chdir $osDir or die _tr("unable to chdir into '%s' (%s)\n", $osDir, $!); # ...do chroot diff --git a/installer/OpenSLX/OSSetup/Packager/rpm.pm b/installer/OpenSLX/OSSetup/Packager/rpm.pm index 12093501..a792cffe 100644 --- a/installer/OpenSLX/OSSetup/Packager/rpm.pm +++ b/installer/OpenSLX/OSSetup/Packager/rpm.pm @@ -40,7 +40,7 @@ sub unpackPackages my $pkgs = shift; foreach my $pkg (@$pkgs) { - vlog 2, "unpacking package $pkg..."; + vlog(2, "unpacking package $pkg..."); if (slxsystem("ash", "-c", "rpm2cpio $pkg | cpio -i -d -u")) { warn _tr("unable to unpack package <%s> (%s)", $pkg, $!); # TODO: change this back to die() if cpio-ing fedora6-glibc @@ -58,7 +58,7 @@ sub importTrustedPackageKeys return unless defined $keyFiles; foreach my $keyFile (@$keyFiles) { - vlog 2, "importing package key $keyFile..."; + vlog(2, "importing package key $keyFile..."); if (slxsystem("rpm", "--root=$finalPath", "--import", "$keyFile")) { die _tr("unable to import package key <%s> (%s)\n", $keyFile, $!); } diff --git a/installer/slxos-export b/installer/slxos-export index a29f2b4e..cdf37672 100755 --- a/installer/slxos-export +++ b/installer/slxos-export @@ -27,30 +27,26 @@ 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::OSExport::Engine; -my ( - $helpReq, - $manReq, - $verbose, - $versionReq, -); +my ($helpReq, $manReq, $verbose, $versionReq,); GetOptions( - 'help|?' => \$helpReq, - 'man' => \$manReq, + 'help|?' => \$helpReq, + 'man' => \$manReq, 'verbose' => \$verbose, 'version' => \$versionReq, -) or pod2usage(2); + ) + or pod2usage(2); pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $helpReq; if ($manReq) { $ENV{LANG} = 'en_EN'; - # avoid dubious problem with perldoc in combination with UTF-8 that - # leads to strange dashes and single-quotes being used - pod2usage(-verbose => 2) + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + pod2usage(-verbose => 2); } if ($versionReq) { system('slxversion'); @@ -63,46 +59,56 @@ my $action = shift @ARGV; if ($action =~ m[^list-ex]i) { print _tr("List of exported vendor-OSes:\n"); - foreach my $type (sort keys %supportedExportTypes) { - print join('', map { - s[^.+/][]; - "\t$type/$_\n"; - } - grep { - # filter out RSYNC_TMP folders: - $_ !~ m[###]; - } - sort <$openslxConfig{'public-path'}/export/$type/*>); + foreach my $type (sort keys %supportedExportFileSystems) { + my @files = <$openslxConfig{'public-path'}/export/$type/*>; + print join( + '', + map { + s[^.+/][]; + "\t$type/$_\n"; + } + grep { + # filter out RSYNC_TMP folders: + $_ !~ m[###]; + } + sort @files + ); } } elsif ($action =~ m[^list-in]i) { + my @files = <$openslxConfig{'private-path'}/stage1/*>; print _tr("List of installed vendor-OSes:\n"); - print join('', map { - s[^.+/][]; - "\t$_\n"; - } - sort <$openslxConfig{'private-path'}/stage1/*>); + print join( + '', + map { + s[^.+/][]; + "\t$_\n"; + } + sort @files + ); } elsif ($action =~ m[^list-ty]i) { print _tr("List of supported export types:\n\t"); - print join("\n\t", sort keys %supportedExportTypes)."\n"; + 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"); + 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; + 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, $!); + 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->{'vendor-os-path'}); } $engine->exportVendorOS(); } elsif ($action =~ m[^remove]i) { @@ -115,24 +121,24 @@ if ($action =~ m[^list-ex]i) { # 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, $!); + 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 { - print STDERR _tr("You need to specify exactly one action: + print STDERR _tr( + "You need to specify exactly one action: export list-exported list-installed list-types remove -Try '%s --help' for more info.\n", $0); +Try '%s --help' for more info.\n", $0 + ); } - - =head1 NAME slxos-export - OpenSLX-script to generate an export from a vendor-OS. @@ -192,13 +198,16 @@ in different flavors: NFS (network file system) is a well established networking file system, which is supported by LINUX since long. -=item B< Export Type 'nbd'> +=item B< Export Type 'sqfs-nbd'> -A rather modern concept is the network block device, which basically "transports" -a block device over the network (from server to client), making it possible to -use more or less any file system over the network. In this particular case, -a squash-FS is being used, which is a filesystem providing very good compression, +Squash-FS is a rather modern filesystem providing very good compression, resulting in considerably reduced network traffic during boot (and execution). +However, in order to mount a squash-fs that resides on the server, the client +has to get access to it first. This can be established via a network block +device, which basically "transports" a block device over the network (from +server to client), making it possible to use more or less any file system over +the network. +So, this example translates to 'use a squashfs on a network block device'. =back @@ -247,7 +256,7 @@ resulting NFS-export will live in C</srv/openslx/export/nfs/suse-10.2>. =over 8 -=item B<< slxos-export export ubuntu-6.10 nbd >> +=item B<< slxos-export export ubuntu-6.10 sqfs-nbd >> Exports the installed vendor-OS ubuntu-6.10 via nbd, the resulting Squash-FS will live in C</srv/openslx/export/nbd/ubuntu-6.10>. @@ -288,4 +297,5 @@ which can be used to overrule the OpenSLX settings: Please refer to the C<slxsettings>-manpage for a more detailed description of these options. -=cut
\ No newline at end of file +=cut + diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm index 38da67d2..e675ee52 100644 --- a/lib/OpenSLX/Basics.pm +++ b/lib/OpenSLX/Basics.pm @@ -37,11 +37,12 @@ use subs qw(die); ### Module implementation ################################################################################ use Carp; -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 a chrooted environment, such that the module - # can't be loaded anymore). +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 + # a chrooted environment, such that the module can't + # be loaded anymore). use FindBin; use Getopt::Long; use POSIX qw(locale_h); @@ -52,9 +53,9 @@ 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', + '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', @@ -67,7 +68,7 @@ my %translations; # # options useful during development only: # - 'debug-confess' => '0', + 'debug-confess' => '0', # # extended settings follow, which are only supported by slxsettings, @@ -151,7 +152,7 @@ sub openslxInit { next unless open(CONFIG, "<$f"); if ($cmdlineConfig{'verbose-level'} >= 2) { - vlog 0, "reading config-file $f..."; + vlog(0, "reading config-file $f..."); } while (<CONFIG>) { chomp; @@ -192,7 +193,7 @@ sub openslxInit } if ($openslxConfig{'verbose-level'} >= 2) { foreach my $k (sort keys %openslxConfig) { - vlog 2, "config-dump: $k = $openslxConfig{$k}"; + vlog(2, "config-dump: $k = $openslxConfig{$k}"); } } @@ -205,7 +206,6 @@ sub openslxInit # ------------------------------------------------------------------------------ sub trInit { - # set the specified locale... setlocale('LC_ALL', $openslxConfig{'locale'}); @@ -250,12 +250,19 @@ sub trInit $translations{$k} = $translationsRef->{$k}; } $loadedTranslationModule = $trModule; - vlog 1, _tr("translations module %s loaded successfully", $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' ($!)."; + vlog(1, + "unable to load any translations module for locale '$locale' ($!)." + ); } } } @@ -339,7 +346,7 @@ sub invokeCleanupFunctions { my @funcNames = keys %cleanupFunctions; foreach my $name (@funcNames) { - vlog 2, "invoking cleanup function '$name'..."; + vlog(2, "invoking cleanup function '$name'..."); $cleanupFunctions{$name}->(); } } @@ -347,7 +354,7 @@ sub invokeCleanupFunctions # ------------------------------------------------------------------------------ sub slxsystem { - vlog 2, _tr("executing: %s", join ' ', @_); + 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 @@ -371,8 +378,7 @@ sub warn $msg =~ s[^][*** ]igms; if ($openslxConfig{'debug-confess'}) { Carp::cluck $msg; - } - else { + } else { chomp $msg; CORE::warn "$msg\n"; } @@ -388,8 +394,7 @@ sub die $msg =~ s[^][*** ]igms; if ($openslxConfig{'debug-confess'}) { confess $msg; - } - else { + } else { chomp $msg; CORE::die "$msg\n"; } @@ -404,16 +409,16 @@ sub instantiateClass unless (eval "require $class") { if ($! == 2) { die _tr("Class <%s> not found!\n", $class); - } - else { + } else { die _tr("Unable to load class <%s> (%s)\n", $class, $@); } } 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); + die _tr( + 'Could not load class <%s> (Version <%s> required, but <%s> found)', + $class, $requestedVersion, $classVersion); } } return $class->new; diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm index 779640d5..6dbd0e7c 100644 --- a/lib/OpenSLX/Utils.pm +++ b/lib/OpenSLX/Utils.pm @@ -40,7 +40,7 @@ sub copyFile system("mkdir -p $targetDir") unless -d $targetDir; my $target = "$targetDir/$targetFileName"; - vlog 2, _tr("copying '%s' to '%s'", $fileName, $target); + vlog(2, _tr("copying '%s' to '%s'", $fileName, $target)); if (system("cp -p $fileName $target")) { die _tr("unable to copy file '%s' to dir '%s' (%s)", $fileName, $target, $!); |