From 416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5 Mon Sep 17 00:00:00 2001 From: Sebastian Schmelzer Date: Thu, 2 Sep 2010 17:50:49 +0200 Subject: change dir structure --- src/config-db/OpenSLX/AttributeRoster.pm | 537 ++++ src/config-db/OpenSLX/ConfigDB.pm | 3190 ++++++++++++++++++++++++ src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm | 45 + src/config-db/OpenSLX/DBSchema.pm | 832 ++++++ src/config-db/OpenSLX/MetaDB/Base.pm | 1220 +++++++++ src/config-db/OpenSLX/MetaDB/DBI.pm | 1540 ++++++++++++ src/config-db/OpenSLX/MetaDB/SQLite.pm | 130 + src/config-db/OpenSLX/MetaDB/mysql.pm | 179 ++ src/config-db/slxconfig | 1785 +++++++++++++ src/config-db/slxconfig-demuxer | 918 +++++++ src/config-db/t/01-basics.t | 23 + src/config-db/t/10-vendor-os.t | 258 ++ src/config-db/t/11-export.t | 247 ++ src/config-db/t/12-system.t | 360 +++ src/config-db/t/13-client.t | 320 +++ src/config-db/t/14-group.t | 384 +++ src/config-db/t/15-global_info.t | 43 + src/config-db/t/20-client_system_ref.t | 208 ++ src/config-db/t/21-group_system_ref.t | 195 ++ src/config-db/t/22-group_client_ref.t | 186 ++ src/config-db/t/25-attributes.t | 677 +++++ src/config-db/t/29-transaction.t | 58 + src/config-db/t/run-all-tests.pl | 36 + 23 files changed, 13371 insertions(+) create mode 100644 src/config-db/OpenSLX/AttributeRoster.pm create mode 100644 src/config-db/OpenSLX/ConfigDB.pm create mode 100644 src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm create mode 100644 src/config-db/OpenSLX/DBSchema.pm create mode 100644 src/config-db/OpenSLX/MetaDB/Base.pm create mode 100644 src/config-db/OpenSLX/MetaDB/DBI.pm create mode 100644 src/config-db/OpenSLX/MetaDB/SQLite.pm create mode 100644 src/config-db/OpenSLX/MetaDB/mysql.pm create mode 100755 src/config-db/slxconfig create mode 100755 src/config-db/slxconfig-demuxer create mode 100644 src/config-db/t/01-basics.t create mode 100644 src/config-db/t/10-vendor-os.t create mode 100644 src/config-db/t/11-export.t create mode 100644 src/config-db/t/12-system.t create mode 100644 src/config-db/t/13-client.t create mode 100644 src/config-db/t/14-group.t create mode 100644 src/config-db/t/15-global_info.t create mode 100644 src/config-db/t/20-client_system_ref.t create mode 100644 src/config-db/t/21-group_system_ref.t create mode 100644 src/config-db/t/22-group_client_ref.t create mode 100644 src/config-db/t/25-attributes.t create mode 100644 src/config-db/t/29-transaction.t create mode 100755 src/config-db/t/run-all-tests.pl (limited to 'src/config-db') diff --git a/src/config-db/OpenSLX/AttributeRoster.pm b/src/config-db/OpenSLX/AttributeRoster.pm new file mode 100644 index 00000000..88d6295f --- /dev/null +++ b/src/config-db/OpenSLX/AttributeRoster.pm @@ -0,0 +1,537 @@ +# 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/ +# ----------------------------------------------------------------------------- +# AttributeRoster.pm +# - provides information about all available attributes +# ----------------------------------------------------------------------------- +package OpenSLX::AttributeRoster; + +use strict; +use warnings; + +use Digest::MD5 qw(md5_hex); + +use OpenSLX::Basics; +use OpenSLX::OSPlugin::Engine; +use OpenSLX::OSPlugin::Roster; +use OpenSLX::Utils; + +my %AttributeInfo; + +#=item C<_init()> +# +#Integrates info about all known attributes (from core and from the plugins) +#into one big hash. +#Returns info about all attributes. +# +#=cut +# +sub _init +{ + my $class = shift; + + # set core attributes + %AttributeInfo = ( + 'automnt_dir' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'automnt_src' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'boot_type' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + Selects the boot technology for this client. + Currently the following boot types are supported: + pxe (is the default) + uses PXE to boot client over LAN + preboot + generates a set of images (see preboot_media) that can + be used to remotely boot the systems referred to by + this client + pbs + preboot server (experimental) + End-of-Here + content_regex => qr{^(pxe|preboot|pbs)$}, + content_descr => '"pxe" or "preboot"', + default => 'pxe', + }, + 'boot_uri' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + specifies the wget(able) address of the remote bootloader + archive that shall be loaded from the preboot environment + End-of-Here + content_regex => undef, + content_descr => 'an uri supported by wget', + default => '', + }, + 'country' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'de', + }, + 'hidden' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + specifies whether or not this system is offered for booting + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '0: system is bootable - 1: system is hidden', + default => '0', + }, + 'kernel_params' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + params to build kernel cmdline for this system + End-of-Here + content_regex => undef, + content_descr => 'kernel cmdline fragment', + default => 'quiet', + }, + 'kernel_params_client' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + client-specific params for kernel cmdline + End-of-Here + content_regex => undef, + content_descr => 'kernel cmdline fragment', + default => '', + }, + 'preboot_media' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + List of preboot media supported by this client. + Currently the following preboot media are supported: + cd + generates a bootable CD-image that can be used to + remotely boot the systems referred to by this client + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'preboot_server' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!experimental!! specifies location of openslx-preboot-server + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_fsmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of filesystem kernel modules to load + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_miscmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of miscellaneous kernel modules to load + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'ramfs_nicmods' => { + applies_to_systems => 1, + applies_to_clients => 0, + description => unshiftHereDoc(<<' End-of-Here'), + list of network card modules to load + End-of-Here + content_regex => qr{^\s*([-\w]+\s*)*$}, + content_descr => 'a space-separated list of NIC modules', + default => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + }, + 'hw_local_disk' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + how to handle local disk deploament - no/slxonly/all + End-of-Here + content_regex => undef, + content_descr => 'how to handle local disk (no/slxonly/all)', + default => 'all', + }, + 'scratch' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => '', + }, + 'start_atd' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_cron' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_dreshal' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'start_ntp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'initial', + }, + 'start_nfsv4' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_snmp' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'no', + }, + 'start_sshd' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + !!!descriptive text missing here!!! + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'yes', + }, + 'timezone' => { + applies_to_systems => 1, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + textual timezone (e.g. 'Europe/Berlin') + End-of-Here + content_regex => undef, + content_descr => undef, + default => 'Europe/Berlin', + }, + 'unbootable' => { + applies_to_systems => 0, + applies_to_clients => 1, + description => unshiftHereDoc(<<' End-of-Here'), + specifies whether or not this client is allowed to boot + End-of-Here + content_regex => qr{^(0|1)$}, + content_descr => '0: client can boot - 1: client is blocked', + default => '0', + }, + ); + + # and add all plugin attributes, too + OpenSLX::OSPlugin::Roster->addAllStage3AttributesToHash(\%AttributeInfo); + + return 1; +} + +=item C + +Returns info about all attributes. + +=over + +=item Return Value + +An hash-ref with info about all known attributes. + +=back + +=cut + +sub getAttrInfo +{ + my $class = shift; + my $params = shift || {}; + + $class->_init() if !%AttributeInfo; + + if (defined $params->{name}) { + my $attrInfo = $AttributeInfo{$params->{name}}; + return if !defined $attrInfo; + return { $params->{name} => $AttributeInfo{$params->{name}} }; + } + elsif (defined $params->{scope}) { + my %MatchingAttributeInfo; + my $selectedScope = lc($params->{scope}); + foreach my $attr (keys %AttributeInfo) { + my $attrScope = ''; + if ($attr =~ m{^(.+?)::}) { + $attrScope = lc($1); + } + if ((!$attrScope && $selectedScope eq 'core') + || $attrScope eq $selectedScope) { + $MatchingAttributeInfo{$attr} = $AttributeInfo{$attr}; + } + } + return \%MatchingAttributeInfo; + } + + return \%AttributeInfo; +} + +=item C + +Returns the stage3 attribute names (which apply to systems or clients). + +=over + +=item Return Value + +An array of attribute names. + +=back + +=cut + +sub getStage3Attrs +{ + my $class = shift; + + $class->_init() if !%AttributeInfo; + + return + grep { + $AttributeInfo{$_}->{applies_to_systems} + || $AttributeInfo{$_}->{applies_to_client} + } + keys %AttributeInfo +} + +=item C + +Returns the attribute names that apply to systems. + +=over + +=item Return Value + +An array of attribute names. + +=back + +=cut + +sub getSystemAttrs +{ + my $class = shift; + + $class->_init() if !%AttributeInfo; + + return + grep { $AttributeInfo{$_}->{"applies_to_systems"} } + keys %AttributeInfo +} + +=item C + +Returns the attribute names that apply to clients. + +=over + +=item Return Value + +An array of attribute names. + +=back + +=cut + +sub getClientAttrs +{ + my $class = shift; + + $class->_init() if !%AttributeInfo; + + return + grep { $AttributeInfo{$_}->{"applies_to_clients"} } + keys %AttributeInfo +} + +=item C + +Checks if the given stage3 attribute values are allowed (and make sense). + +This method returns an array-ref of problems found. If there were no problems, +this methods returns undef. + +=cut + +sub findProblematicValues +{ + my $class = shift; + my $stage3Attrs = shift || {}; + my $vendorOSName = shift; + my $installedPlugins = shift; + + $class->_init() if !%AttributeInfo; + + my @problems; + + my %attrsByPlugin; + foreach my $key (sort keys %{$stage3Attrs}) { + my $value = $stage3Attrs->{$key}; + if ($key =~ m{^(.+)::.+?$}) { + my $pluginName = $1; + if ($installedPlugins + && !grep { $_->{plugin_name} eq $pluginName } @$installedPlugins) { + # avoid checking attributes of plugins that are not installed + next; + } + $attrsByPlugin{$pluginName} ||= {}; + $attrsByPlugin{$pluginName}->{$key} = $value; + } + + # undefined values are always allowed + next if !defined $value; + + # check the value against the regex of the attribute (if any) + my $attrInfo = $AttributeInfo{$key}; + if (!$attrInfo) { + push @problems, _tr('attribute "%s" is unknown!', $key); + next; + } + my $regex = $attrInfo->{content_regex}; + if ($regex && $value !~ $regex) { + push @problems, _tr( + "the value '%s' for attribute %s is not allowed.\nAllowed values are: %s", + $value, $key, $attrInfo->{content_descr} + ); + } + } + + # if no vendorOS-name has been provided or there are no plugins installed, + # we can't do any further checks + if ($vendorOSName && $installedPlugins) { + # now give each installed plugin a chance to check it's own attributes + # by itself + foreach my $pluginInfo ( + sort { $a->{plugin_name} cmp $b->{plugin_name} } @$installedPlugins + ) { + my $pluginName = $pluginInfo->{plugin_name}; + vlog 2, "checking attrs of plugin: $pluginName\n"; + # create & start OSPlugin-engine for vendor-OS and current plugin + my $engine = OpenSLX::OSPlugin::Engine->new; + if (!$engine->initialize($pluginName, $vendorOSName)) { + warn _tr( + 'unable to create engine for plugin "%s"!', $pluginName + ); + next; + } + $engine->checkStage3AttrValues( + $attrsByPlugin{$pluginName}, \@problems + ); + } + } + + return if !@problems; + + return \@problems; +} + +=item C + +Returns a MD5 hash representing the list of all attributes (including plugins). + +=cut + +sub computeMD5HashOverAllAttrs +{ + my $class = shift; + + $class->_init() if !%AttributeInfo; + + my %attrNames; + @attrNames{keys %AttributeInfo} = (); + + my $pluginInfo = OpenSLX::OSPlugin::Roster->getAvailablePlugins(); + if ($pluginInfo) { + foreach my $pluginName (sort keys %$pluginInfo) { + my $attrInfo + = OpenSLX::OSPlugin::Roster->getPluginAttrInfo($pluginName); + @attrNames{keys %$attrInfo} = (); + } + } + + my $attrNamesAsString = join ',', sort keys %attrNames; + + return md5_hex($attrNamesAsString); +} + +1; diff --git a/src/config-db/OpenSLX/ConfigDB.pm b/src/config-db/OpenSLX/ConfigDB.pm new file mode 100644 index 00000000..89011246 --- /dev/null +++ b/src/config-db/OpenSLX/ConfigDB.pm @@ -0,0 +1,3190 @@ +# 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/ +# ----------------------------------------------------------------------------- +package OpenSLX::ConfigDB; + +use strict; +use warnings; + +our (@ISA, @EXPORT_OK, %EXPORT_TAGS, $VERSION); +$VERSION = 1; # API-version + +use Clone qw(clone); +use File::Basename; + +use Exporter; +@ISA = qw(Exporter); + +=pod + +=head1 NAME + +OpenSLX::ConfigDB - the configuration database API class for OpenSLX + +=head1 SYNOPSIS + + use OpenSLX::ConfigDB; + + openslxInit(); + + my $openslxDB = OpenSLX::ConfigDB->new(); + $openslxDB->connect(); + + # fetch a client by name: + my $defaultClient = $openslxDB->fetchClientByFilter({'name' => '<<>>'}) + + # fetch all systems: + my @systems = $openslxDB->fetchSystemByFilter(); + +=head1 DESCRIPTION + +This class defines the OpenSLX API to the config database (the data layer to +the outside world). + +The ConfigDB interface contains of five different parts: + +=over + +=item - L (connection handling) + +=item - L (getting data) + +=item - L (adding, removing and changing data) + +=item - L (getting info about the resulting +configurations after mixing individual client-, group- and system- +configurations). + +=item - L (useful helpers) + +=back + +=head1 Special Concepts + +=over + +=item C + +A filter is a hash-ref defining the filter criteria to be applied to a database +query. Each key of the filter corresponds to a DB column and the (hash-)value +contains the respective column value. + +[At a later stage, this will be improved to support a more structured approach +to filtering (with boolean operators and hierarchical expressions)]. + +=back + +=cut + +my @supportExports = qw( + mergeAttributes pushAttributes + externalIDForSystem externalIDForClient externalConfigNameForClient + generatePlaceholderFor +); + +@EXPORT_OK = (@supportExports); +%EXPORT_TAGS = ('support' => [@supportExports],); + +use OpenSLX::AttributeRoster; +use OpenSLX::Basics; +use OpenSLX::DBSchema; +use OpenSLX::OSPlugin::Roster; +use OpenSLX::Utils; + +=head1 Methods + +=head2 Basic Methods + +=over + +=cut + +=item C + +Returns an object representing a database handle to the config database. + +=cut + +sub new +{ + my $class = shift; + + my $self = { + 'db-schema' => OpenSLX::DBSchema->new, + }; + + return bless $self, $class; +} + +=item C + +Tries to establish a connection to the database specified via the db-... +settings. +The global configuration hash C<%openslxConfig> contains further info about the +requested connection. When implementing this method, you may have to look at +the following entries in order to find out which database to connect to: + +=over + +=item C<$openslxConfig{'db-spec'}> + +Full specification of database, a special string defining the +precise database to connect to (this allows connecting to a database +that requires specifications which aren't cared for by the existing +C<%config>-entries). + +=item C<$openslxConfig{'db-name'}> + +The precise name of the database that should be connected (defaults to 'openslx'). + +=back + +=cut + +sub connect ## no critic (ProhibitBuiltinHomonyms) +{ + my $self = shift; + my $dbParams = shift; # hash-ref with any additional info that might be + # required by specific metadb-module (not used yet) + + my $dbType = $openslxConfig{'db-type'}; + # name of underlying database module... + + my $dbModuleName = "OpenSLX/MetaDB/$dbType.pm"; + my $dbModule = "OpenSLX::MetaDB::$dbType"; + unless (eval { require $dbModuleName } ) { + if ($! == 2) { + die _tr( + "Unable to load DB-module <%s>\nthat database type is not supported (yet?)\n", + $dbModuleName + ); + } else { + die _tr("Unable to load DB-module <%s> (%s)\n", $dbModuleName, $@); + } + } + my $metaDB = $dbModule->new(); + if (!$metaDB->connect($dbParams)) { + warn _tr("Unable to connect to DB-module <%s>\n%s", $dbModuleName, $@); + warn _tr("These DB-modules seem to work ok:"); + foreach my $dbMod ('mysql', 'SQLite') { + my $fullDbModName = "DBD/$dbMod.pm"; + if (eval { require $fullDbModName }) { + vlog(0, "\t$dbMod\n"); + } + } + die _tr( + 'Please use slxsettings if you want to switch to another db-type.' + ); + } + + $self->{'db-type'} = $dbType; + $self->{'meta-db'} = $metaDB; + + $self->{'db-schema'}->checkAndUpgradeDBSchemaIfNecessary($self) + or die _tr('unable to check/update DB schema!'); + + # check if any attributes or plugins have been added/removed since + # last DB-session and bring the DB up-to-date, if so + my $pluginInfoHashVal + = OpenSLX::AttributeRoster->computeMD5HashOverAllAttrs(); + my $pluginInfoHashValInDB = $metaDB->schemaFetchPluginInfoHashVal() || ''; + vlog(1, "plugin-info-hashes: $pluginInfoHashVal <=> $pluginInfoHashValInDB"); + if ($pluginInfoHashValInDB ne $pluginInfoHashVal) { + $self->cleanupAnyInconsistencies(); + return if !$metaDB->schemaSetPluginInfoHashVal($pluginInfoHashVal); + } + + return 1; +} + +=item C + +Tears down the connection to the database and cleans up. + +=cut + +sub disconnect +{ + my $self = shift; + + $self->{'meta-db'}->disconnect(); + + return 1; +} + +=item C + +Opens a database transaction - most useful if you want to make sure a couple of +changes apply as a whole or not at all. + +=cut + +sub startTransaction +{ + my $self = shift; + + $self->{'meta-db'}->startTransaction(); + + return 1; +} + +=item C + +Commits a database transaction - so all changes done inside of this transaction +will be applied to the database. + +=cut + +sub commitTransaction +{ + my $self = shift; + + $self->{'meta-db'}->commitTransaction(); + + return 1; +} + +=item C + +Revokes a database transaction - so all changes done inside of this transaction +will be undone. + +=cut + +sub rollbackTransaction +{ + my $self = shift; + + $self->{'meta-db'}->rollbackTransaction(); + + return 1; +} + +=item C + +Looks for any inconsistencies (stale references, references to non-existing +plugins, ...) and removes them from the DB. + +=cut + +sub cleanupAnyInconsistencies +{ + my $self = shift; + + $self->synchronizeAttributesWithDB(); + + return if !$self->_removeStaleSystemAttributes(); + return if !$self->_removeStaleGroupAttributes(); + return if !$self->_removeStaleClientAttributes(); + return if !$self->_removeStaleVendorOSAttributes(); + + return 1; +} + +=item C + +Makes sure that all known attributes are referenced by the default system +(and no unknown ones). + +Additionally, all systems, groups and clients can be checked and get their +stale attributes removed, too. + +=cut + +sub synchronizeAttributesWithDB +{ + my $self = shift; + + my $defaultSystem = $self->fetchSystemByID(0); + return if !$defaultSystem; + + # fetch all known attributes from attribute roster and merge these + # into the existing attributes of the default system and client + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + + # add new system attributes to default system + my @newSystemAttrs + = grep { + $attrInfo->{$_}->{applies_to_systems} + && !exists $defaultSystem->{attrs}->{$_} + } keys %{$attrInfo}; + foreach my $attr (@newSystemAttrs) { + $defaultSystem->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; + } + + # remove unknown system attributes from default system + my @unknownSystemAttrs + = grep { + !exists $attrInfo->{$_} + || !$attrInfo->{$_}->{applies_to_systems} + } keys %{$defaultSystem->{attrs}}; + foreach my $unknownAttr (@unknownSystemAttrs) { + delete $defaultSystem->{attrs}->{$unknownAttr}; + } + + # now write back the updated default system if necessary + if (@newSystemAttrs || @unknownSystemAttrs) { + return if !$self->changeSystem(0, $defaultSystem); + } + + my $defaultClient = $self->fetchClientByID(0); + return if !$defaultClient; + + # add new client attributes to default client (deal only with + # attributes that are client-only) + my @newClientAttrs + = grep { + $attrInfo->{$_}->{applies_to_clients} + && !$attrInfo->{$_}->{applies_to_systems} + && !exists $defaultClient->{attrs}->{$_} + } keys %{$attrInfo}; + foreach my $attr (@newClientAttrs) { + $defaultClient->{attrs}->{$attr} = $attrInfo->{$attr}->{default}; + } + + # remove unknown client attributes from default client (deal only with + # attributes that are client-only) + my @unknownClientAttrs + = grep { + !exists $attrInfo->{$_} + || !$attrInfo->{$_}->{applies_to_clients} + || $attrInfo->{$_}->{applies_to_systems} + } keys %{$defaultClient->{attrs}}; + foreach my $unknownAttr (@unknownClientAttrs) { + delete $defaultClient->{attrs}->{$unknownAttr}; + } + + # now write back the updated default client if necessary + if (@newClientAttrs || @unknownClientAttrs) { + return if !$self->changeClient(0, $defaultClient); + } + + return 1; +} + +=item C<_removeStaleSystemAttributes()> + +Removes any stale attributes from every system. + +=cut + +sub _removeStaleSystemAttributes +{ + my $self = shift; + + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + + my @systems = $self->fetchSystemByFilter(); + foreach my $system (@systems) { + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$system->{attrs}}; + if (@unknownAttrs) { + foreach my $unknownAttr (@unknownAttrs) { + delete $system->{attrs}->{$unknownAttr}; + } + return if !$self->changeSystem($system->{id}, $system); + } + } + + return 1; +} + +=item C<_removeStaleGroupAttributes()> + +Removes any stale attributes from every group. + +=cut + +sub _removeStaleGroupAttributes +{ + my $self = shift; + + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + + my @groups = $self->fetchGroupByFilter(); + foreach my $group (@groups) { + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$group->{attrs}}; + if (@unknownAttrs) { + foreach my $unknownAttr (@unknownAttrs) { + delete $group->{attrs}->{$unknownAttr}; + } + return if !$self->changeGroup($group->{id}, $group); + } + } + + return 1; +} + +=item C<_removeStaleClientAttributes()> + +Removes any stale attributes from every client. + +=cut + +sub _removeStaleClientAttributes +{ + my $self = shift; + + my $attrInfo = OpenSLX::AttributeRoster->getAttrInfo(); + + my @clients = $self->fetchClientByFilter(); + foreach my $client (@clients) { + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$client->{attrs}}; + if (@unknownAttrs) { + foreach my $unknownAttr (@unknownAttrs) { + delete $client->{attrs}->{$unknownAttr}; + } + return if !$self->changeClient($client->{id}, $client); + } + } + + return 1; +} + +=item C<_removeStaleVendorOSAttributes()> + +Removes any stale attributes from every vendor-OS. + +=cut + +sub _removeStaleVendorOSAttributes +{ + my $self = shift; + + my @vendorOSes = $self->fetchVendorOSByFilter(); + foreach my $vendorOS (@vendorOSes) { + my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); + foreach my $plugin (@installedPlugins) { + my $pluginName = $plugin->{plugin_name}; + my $attrInfo + = OpenSLX::OSPlugin::Roster->getPluginAttrInfo($pluginName); + if ($attrInfo) { + my @unknownAttrs + = grep { !exists $attrInfo->{$_} } keys %{$plugin->{attrs}}; + if (@unknownAttrs) { + foreach my $unknownAttr (@unknownAttrs) { + delete $plugin->{attrs}->{$unknownAttr}; + } + return if !$self->addInstalledPlugin( + $vendorOS->{id}, $pluginName, $plugin->{attrs} + ); + } + } + else { + $self->removeInstalledPlugin($vendorOS->{id}, $pluginName); + } + } + } + + return 1; +} + +=back + +=head2 Data Access Methods + +=over + +=cut + +=item C + +Returns the names of the columns of the given table. + +=over + +=item Param C + +The name of the DB-table whose columns you'd like to retrieve. + +=item Return Value + +An array of column names. + +=back + +=cut + +sub getColumnsOfTable +{ + my $self = shift; + my $tableName = shift; + + return $self->{'db-schema'}->getColumnsOfTable($tableName); +} + +=item C + +Fetches and returns information about all vendor-OSes that match the given +filter. + +=over + +=item Param C + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchVendorOSByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + my @vendorOS + = $self->{'meta-db'}->fetchVendorOSByFilter($filter, $resultCols); + + return wantarray() ? @vendorOS : shift @vendorOS; +} + +=item C + +Fetches and returns information the vendor-OSes with the given IDs. + +=over + +=item Param C + +An array of the vendor-OS-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchVendorOSByID +{ + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; + + my @vendorOS = $self->{'meta-db'}->fetchVendorOSByID($ids, $resultCols); + + return wantarray() ? @vendorOS : shift @vendorOS; +} + +=item C + +Returns the names of all plugins that have been installed into the given +vendor-OS. + +=over + +=item Param C + +The id of the vendor-OS whose plugins you are interested in + +=item Param C [Optional] + +The name of a specific plugin you are interested in + +=item Return Value + +An array with the plugin names. + +=back + +=cut + +sub fetchInstalledPlugins +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + + $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID, $pluginName); +} + +=item C + +Fetches and returns information about all exports that match the given +filter. + +=over + +=item Param C + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchExportByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + my @exports = $self->{'meta-db'}->fetchExportByFilter($filter, $resultCols); + + return wantarray() ? @exports : shift @exports; +} + +=item C + +Fetches and returns information the exports with the given IDs. + +=over + +=item Param C + +An array of the export-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchExportByID +{ + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; + + my @exports = $self->{'meta-db'}->fetchExportByID($ids, $resultCols); + + return wantarray() ? @exports : shift @exports; +} + +=item C + +Fetches the IDs of all exports that make use of the vendor-OS with the given ID. + +=over + +=item Param C + +ID of the vendor-OS whose exports shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=cut + +sub fetchExportIDsOfVendorOS +{ + my $self = shift; + my $vendorOSID = shift; + + return $self->{'meta-db'}->fetchExportIDsOfVendorOS($vendorOSID); +} + +=item C + +Fetches the global info element specified by the given ID. + +=over + +=item Param C + +The name of the global info value you are interested in. + +=item Return Value + +The value of the requested global info. + +=back + +=cut + +sub fetchGlobalInfo +{ + my $self = shift; + my $id = shift; + + return $self->{'meta-db'}->fetchGlobalInfo($id); +} + +=item C + +Fetches and returns information about all systems that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Param C<$attrFilter> [Optional] + +A hash-ref containing the filter criteria that shall be applied against +attributes. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchSystemByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + my @systems = $self->{'meta-db'}->fetchSystemByFilter( + $filter, $resultCols, $attrFilter + ); + + # unless specific result cols have been given, we mix in the attributes + # of each system, too: + if (!defined $resultCols) { + foreach my $system (@systems) { + $system->{attrs} + = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); + } + } + + return wantarray() ? @systems : shift @systems; +} + +=item C + +Fetches and returns information the systems with the given IDs. + +=over + +=item Param C + +An array of the system-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchSystemByID +{ + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; + + my @systems = $self->{'meta-db'}->fetchSystemByID($ids, $resultCols); + + # unless specific result cols have been given, we mix in the attributes + # of each system, too: + if (!defined $resultCols) { + foreach my $system (@systems) { + $system->{attrs} + = $self->{'meta-db'}->fetchSystemAttrs($system->{id}); + } + } + + return wantarray() ? @systems : shift @systems; +} + +=item C + +Fetches the IDs of all systems that make use of the export with the given ID. + +=over + +=item Param C + +ID of the export whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=cut + +sub fetchSystemIDsOfExport +{ + my $self = shift; + my $exportID = shift; + + return $self->{'meta-db'}->fetchSystemIDsOfExport($exportID); +} + +=item C + +Fetches the IDs of all systems that are used by the client with the given +ID. + +=over + +=item Param C + +ID of the client whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=cut + +sub fetchSystemIDsOfClient +{ + my $self = shift; + my $clientID = shift; + + return $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); +} + +=item C + +Fetches the IDs of all systems that are part of the group with the given +ID. + +=over + +=item Param C + +ID of the group whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=cut + +sub fetchSystemIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + + return $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); +} + +=item C + +Fetches and returns information about all clients that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchClientByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + my @clients = $self->{'meta-db'}->fetchClientByFilter( + $filter, $resultCols, $attrFilter + ); + + # unless specific result cols have been given, we mix in the attributes + # of each client, too: + if (!defined $resultCols) { + foreach my $client (@clients) { + $client->{attrs} + = $self->{'meta-db'}->fetchClientAttrs($client->{id}); + } + } + + return wantarray() ? @clients : shift @clients; +} + +=item C + +Fetches and returns information the clients with the given IDs. + +=over + +=item Param C + +An array of the client-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchClientByID +{ + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; + + my @clients = $self->{'meta-db'}->fetchClientByID($ids, $resultCols); + + # unless specific result cols have been given, we mix in the attributes + # of each client, too: + if (!defined $resultCols) { + foreach my $client (@clients) { + $client->{attrs} + = $self->{'meta-db'}->fetchClientAttrs($client->{id}); + } + } + + return wantarray() ? @clients : shift @clients; +} + +=item C + +Fetches the IDs of all clients that make use of the system with the given +ID. + +=over + +=item Param C + +ID of the system whose clients shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + +=cut + +sub fetchClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + + return $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); +} + +=item C + +Fetches the IDs of all clients that are part of the group with the given +ID. + +=over + +=item Param C + +ID of the group whose clients shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + +=cut + +sub fetchClientIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + + return $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); +} + +=item C + +Fetches and returns information about all groups that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchGroupByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + my @groups = $self->{'meta-db'}->fetchGroupByFilter( + $filter, $resultCols, $attrFilter + ); + + # unless specific result cols have been given, we mix in the attributes + # of each group, too: + if (!defined $resultCols) { + foreach my $group (@groups) { + $group->{attrs} + = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); + } + } + + return wantarray() ? @groups : shift @groups; +} + +=item C + +Fetches and returns information the groups with the given IDs. + +=over + +=item Param C + +An array of the group-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=cut + +sub fetchGroupByID +{ + my $self = shift; + my $ids = _aref(shift); + my $resultCols = shift; + + my @groups = $self->{'meta-db'}->fetchGroupByID($ids, $resultCols); + + # unless specific result cols have been given, we mix in the attributes + # of each group, too: + if (!defined $resultCols) { + foreach my $group (@groups) { + $group->{attrs} + = $self->{'meta-db'}->fetchGroupAttrs($group->{id}); + } + } + + return wantarray() ? @groups : shift @groups; +} + +=item C + +Fetches the IDs of all groups that contain the system with the given +ID. + +=over + +=item Param C + +ID of the system whose groups shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + +=cut + +sub fetchGroupIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + + return $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); +} + +=item C + +Fetches the IDs of all groups that contain the client with the given +ID. + +=over + +=item Param C + +ID of the client whose groups shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + +=cut + +sub fetchGroupIDsOfClient +{ + my $self = shift; + my $clientID = shift; + + return $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); +} + +=back + +=head2 Data Manipulation Methods + +=over + +=item C + +Adds one or more vendor-OS to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new vendor-OS(es). + +=item Return Value + +The IDs of the new vendor-OS(es), C if the creation failed. + +=back + +=cut + +sub addVendorOS +{ + my $self = shift; + my $valRows = _aref(shift); + + _checkCols($valRows, 'vendor_os', 'name'); + + my @IDs = $self->{'meta-db'}->addVendorOS($valRows); + return wantarray() ? @IDs : $IDs[0]; +} + +=item C + +Removes one or more vendor-OS from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the vendor-OSes that shall be removed. + +=item Return Value + +C<1> if the vendorOS(es) could be removed, C if not. + +=back + +=cut + +sub removeVendorOS +{ + my $self = shift; + my $vendorOSIDs = _aref(shift); + + # drop all installed plugins before removing the vendor-OS + foreach my $vendorOSID (@$vendorOSIDs) { + my @installedPlugins + = $self->{'meta-db'}->fetchInstalledPlugins($vendorOSID); + foreach my $plugin (@installedPlugins) { + my $pluginName = $plugin->{plugin_name}; + $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); + } + } + return $self->{'meta-db'}->removeVendorOS($vendorOSIDs); +} + +=item C + +Changes the data of one or more vendor-OS. + +=over + +=item Param C + +An array-ref containing the IDs of the vendor-OSes that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the vendor-OS(es). + +=item Return Value + +C<1> if the vendorOS(es) could be changed, C if not. + +=back + +=cut + +sub changeVendorOS +{ + my $self = shift; + my $vendorOSIDs = _aref(shift); + my $valRows = _aref(shift); + + return $self->{'meta-db'}->changeVendorOS($vendorOSIDs, $valRows); +} + +=item C + +Adds a freshly installed plugin to a vendor-OS. + +=over + +=item Param C + +The id of the vendor-OS the given plugin has been installed into + +=item Param C + +The name of the plugin that has been installed + +=item Return Value + +The ID of the new reference entry, C if the creation failed. + +=back + +=cut + +sub addInstalledPlugin +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $pluginAttrs = shift || {}; + + return $self->{'meta-db'}->addInstalledPlugin( + $vendorOSID, $pluginName, $pluginAttrs + ); +} + +=item C + +Removes a uninstalled plugin for a vendor-OS. + +=over + +=item Param C + +The id of the vendor-OS the given plugin has been uninstalled from + +=item Param C + +The name of the plugin that has been uninstalled + +=item Return Value + +1 if it worked, C if it didn't. + +=back + +=cut + +sub removeInstalledPlugin +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + + return $self->{'meta-db'}->removeInstalledPlugin($vendorOSID, $pluginName); +} + +=item C + +Adds one or more export to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new export(s). + +=item Return Value + +The IDs of the new export(s), C if the creation failed. + +=back + +=cut + +sub addExport +{ + my $self = shift; + my $valRows = _aref(shift); + + _checkCols($valRows, 'export', qw(name vendor_os_id type)); + + my @IDs = $self->{'meta-db'}->addExport($valRows); + return wantarray() ? @IDs : $IDs[0]; +} + +=item C + +Removes one or more export from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the exports that shall be removed. + +=item Return Value + +C<1> if the export(s) could be removed, C if not. + +=back + +=cut + +sub removeExport +{ + my $self = shift; + my $exportIDs = _aref(shift); + + return $self->{'meta-db'}->removeExport($exportIDs); +} + +=item C + +Changes the data of one or more export. + +=over + +=item Param C + +An array-ref containing the IDs of the exports that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the export(s). + +=item Return Value + +C<1> if the export(s) could be changed, C if not. + +=back + +=cut + +sub changeExport +{ + my $self = shift; + my $exportIDs = _aref(shift); + my $valRows = _aref(shift); + + return $self->{'meta-db'}->changeExport($exportIDs, $valRows); +} + +=item C + +Increments the global counter of the given name and returns the *old* value. + +=over + +=item Param C + +The name of the global counter that shall be bumped. + +=item Return Value + +The value the global counter had before it was incremented. + +=back + +=cut + +sub incrementGlobalCounter +{ + my $self = shift; + my $counterName = shift; + + $self->startTransaction(); + my $value = $self->fetchGlobalInfo($counterName); + return unless defined $value; + my $newValue = $value + 1; + $self->changeGlobalInfo($counterName, $newValue); + $self->commitTransaction(); + + return $value; +} + +=item C + +Sets the global info element specified by the given ID to the given value. + +=over + +=item Param C + +The ID specifying the global info you'd like to change. + +=item Param C + +The new value for the global info element. + +=item Return Value + +The value the global counter had before it was incremented. + +=back + +=cut + +sub changeGlobalInfo +{ + my $self = shift; + my $id = shift; + my $value = shift; + + return if !defined $self->{'meta-db'}->fetchGlobalInfo($id); + + return $self->{'meta-db'}->changeGlobalInfo($id, $value); +} + +=item C + +Adds one or more systems to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new system(s). + +=item Return Value + +The IDs of the new system(s), C if the creation failed. + +=back + +=cut + +sub addSystem +{ + my $self = shift; + my $inValRows = _aref(shift); + + _checkCols($inValRows, 'system', qw(name export_id)); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + foreach my $valRow (@$valRows) { + if (!$valRow->{kernel}) { + $valRow->{kernel} = 'vmlinuz'; + vlog( + 1, + _tr( + "setting kernel of system '%s' to 'vmlinuz'!", + $valRow->{name} + ) + ); + } + if (!$valRow->{label}) { + $valRow->{label} = $valRow->{name}; + } + } + + my @IDs = $self->{'meta-db'}->addSystem($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; +} + +=item C + +Removes one or more systems from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the systems that shall be removed. + +=item Return Value + +C<1> if the system(s) could be removed, C if not. + +=back + +=cut + +sub removeSystem +{ + my $self = shift; + my $systemIDs = _aref(shift); + + foreach my $system (@$systemIDs) { + $self->setGroupIDsOfSystem($system); + $self->setClientIDsOfSystem($system); + } + + return $self->{'meta-db'}->removeSystem($systemIDs); +} + +=item C + +Changes the data of one or more systems. + +=over + +=item Param C + +An array-ref containing the IDs of the systems that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the system(s). + +=item Return Value + +C<1> if the system(s) could be changed, C if not. + +=back + +=cut + +sub changeSystem +{ + my $self = shift; + my $systemIDs = _aref(shift); + my $inValRows = _aref(shift); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + return $self->{'meta-db'}->changeSystem($systemIDs, $valRows, $attrValRows); +} + +#=item C +# +#Sets a value for an attribute of the given system. If the system already +#has a value for this attribute, it will be overwritten. +# +#=over +# +#=item Param C +# +#The ID of the system whose attribute shall be changed. +# +#=item Param C +# +#The name of the attribute to change. +# +#=item Param C +# +#The new value for the attribute. +# +#=item Return Value +# +#C<1> if the attribute could be set, C if not. +# +#=back +# +#=cut +# +#sub setSystemAttr +#{ +# my $self = shift; +# my $systemID = shift; +# my $attrName = shift; +# my $attrValue = shift; +# +# return $self->{'meta-db'}->setSystemAttr($systemID, $attrName, $attrValue); +#} + +=item C + +Specifies all clients that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system whose clients you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the clients that shall be connected to the +system. + +=item Return Value + +C<1> if the system/client references could be set, C if not. + +=back + +=cut + +sub setClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $clientIDs = _aref(shift); + + # associating a client to the default system makes no sense + return 0 if $systemID == 0; + + my @uniqueClientIDs = _unique(@$clientIDs); + + return $self->{'meta-db'}->setClientIDsOfSystem( + $systemID, \@uniqueClientIDs + ); +} + +=item C + +Add one or more clients to the set that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system that you wish to add the clients to. + +=item Param C + +An array-ref containing the IDs of the new clients that shall be added to the +system. + +=item Return Value + +C<1> if the system/client references could be set, C if not. + +=back + +=cut + +sub addClientIDsToSystem +{ + my $self = shift; + my $systemID = shift; + my $newClientIDs = _aref(shift); + + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + push @clientIDs, @$newClientIDs; + + return $self->setClientIDsOfSystem($systemID, \@clientIDs); +} + +=item C + +Removes the connection between the given clients and the given system. + +=over + +=item Param C + +The ID of the system you'd like to remove groups from. + +=item Param C + +An array-ref containing the IDs of the clients that shall be removed from the +system. + +=item Return Value + +C<1> if the system/client references could be set, C if not. + +=back + +=cut + +sub removeClientIDsFromSystem +{ + my $self = shift; + my $systemID = shift; + my $removedClientIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfSystem($systemID); + + return $self->setClientIDsOfSystem($systemID, \@clientIDs); +} + +=item C + +Specifies all groups that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system whose groups you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the groups that shall be connected to the +system. + +=item Return Value + +C<1> if the system/group references could be set, C if not. + +=back + +=cut + +sub setGroupIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $groupIDs = _aref(shift); + + # associating a group to the default system makes no sense + return 0 if $systemID == 0; + + my @uniqueGroupIDs = _unique(@$groupIDs); + + return $self->{'meta-db'}->setGroupIDsOfSystem($systemID, \@uniqueGroupIDs); +} + +=item C + +Add one or more groups to the set that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system that you wish to add the groups to. + +=item Param C + +An array-ref containing the IDs of the new groups that shall be added to the +system. + +=item Return Value + +C<1> if the system/group references could be set, C if not. + +=back + +=cut + +sub addGroupIDsToSystem +{ + my $self = shift; + my $systemID = shift; + my $newGroupIDs = _aref(shift); + + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + push @groupIDs, @$newGroupIDs; + + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); +} + +=item C + +Removes the connection between the given groups and the given system. + +=over + +=item Param C + +The ID of the system you'd like to remove groups from. + +=item Param C + +An array-ref containing the IDs of the groups that shall be removed from the +system. + +=item Return Value + +C<1> if the system/group references could be set, C if not. + +=back + +=cut + +sub removeGroupIDsFromSystem +{ + my $self = shift; + my $systemID = shift; + my $toBeRemovedGroupIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfSystem($systemID); + + return $self->setGroupIDsOfSystem($systemID, \@groupIDs); +} + +=item C + +Adds one or more clients to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new client(s). + +=item Return Value + +The IDs of the new client(s), C if the creation failed. + +=back + +=cut + +sub addClient +{ + my $self = shift; + my $inValRows = _aref(shift); + + _checkCols($inValRows, 'client', qw(name mac)); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + my @IDs = $self->{'meta-db'}->addClient($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; +} + +=item C + +Removes one or more clients from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the clients that shall be removed. + +=item Return Value + +C<1> if the client(s) could be removed, C if not. + +=back + +=cut + +sub removeClient +{ + my $self = shift; + my $clientIDs = _aref(shift); + + foreach my $client (@$clientIDs) { + $self->setGroupIDsOfClient($client); + $self->setSystemIDsOfClient($client); + } + + return $self->{'meta-db'}->removeClient($clientIDs); +} + +=item C + +Changes the data of one or more clients. + +=over + +=item Param C + +An array-ref containing the IDs of the clients that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the client(s). + +=item Return Value + +C<1> if the client(s) could be changed, C if not. + +=back + +=cut + +sub changeClient +{ + my $self = shift; + my $clientIDs = _aref(shift); + my $inValRows = _aref(shift); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + return $self->{'meta-db'}->changeClient($clientIDs, $valRows, $attrValRows); +} + +#=item C +# +#Sets a value for an attribute of the given client. If the client already +#has a value for this attribute, it will be overwritten. +# +#=over +# +#=item Param C +# +#The ID of the client whose attribute shall be changed. +# +#=item Param C +# +#The name of the attribute to change. +# +#=item Param C +# +#The new value for the attribute. +# +#=item Return Value +# +#C<1> if the attribute could be set, C if not. +# +#=back +# +#=cut +# +#sub setClientAttr +#{ +# my $self = shift; +# my $clientID = shift; +# my $attrName = shift; +# my $attrValue = shift; +# +# return $self->{'meta-db'}->setClientAttr($clientID, $attrName, $attrValue); +#} + +=item C + +Specifies all systems that should be offered for booting by the given client. + +=over + +=item Param C + +The ID of the client whose systems you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the systems that shall be connected to the +client. + +=item Return Value + +C<1> if the client/system references could be set, C if not. + +=back + +=cut + +sub setSystemIDsOfClient +{ + my $self = shift; + my $clientID = shift; + my $systemIDs = _aref(shift); + + # filter out the default system, as no client should be associated to it + my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); + + return $self->{'meta-db'}->setSystemIDsOfClient( + $clientID, \@uniqueSystemIDs + ); +} + +=item C + +Adds some systems to the set that should be offered for booting by the given client. + +=over + +=item Param C + +The ID of the client to which you'd like to add systems to. + +=item Param C + +An array-ref containing the IDs of the new systems that shall be added to the +client. + +=item Return Value + +C<1> if the client/system references could be set, C if not. + +=back + +=cut + +sub addSystemIDsToClient +{ + my $self = shift; + my $clientID = shift; + my $newSystemIDs = _aref(shift); + + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + push @systemIDs, @$newSystemIDs; + + return $self->setSystemIDsOfClient($clientID, \@systemIDs); +} + +=item C + +Removes some systems from the set that should be offered for booting by the given client. + +=over + +=item Param C + +The ID of the client to which you'd like to remove systems from. + +=item Param C + +An array-ref containing the IDs of the systems that shall be removed from the +client. + +=item Return Value + +C<1> if the client/system references could be set, C if not. + +=back + +=cut + +sub removeSystemIDsFromClient +{ + my $self = shift; + my $clientID = shift; + my $removedSystemIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfClient($clientID); + + return $self->setSystemIDsOfClient($clientID, \@systemIDs); +} + +=item C + +Specifies all groups that the given client shall be part of. + +=over + +=item Param C + +The ID of the client whose groups you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the groups that the client should be part of. + +=item Return Value + +C<1> if the client/group references could be set, C if not. + +=back + +=cut + +sub setGroupIDsOfClient +{ + my $self = shift; + my $clientID = shift; + my $groupIDs = _aref(shift); + + my @uniqueGroupIDs = _unique(@$groupIDs); + + return $self->{'meta-db'}->setGroupIDsOfClient($clientID, \@uniqueGroupIDs); +} + +=item C + +Adds the given client to the given groups. + +=over + +=item Param C + +The ID of the client that you'd like to add to the given groups. + +=item Param C + +An array-ref containing the IDs of the groups that shall be added to the +client. + +=item Return Value + +C<1> if the client/group references could be set, C if not. + +=back + +=cut + +sub addGroupIDsToClient +{ + my $self = shift; + my $clientID = shift; + my $newGroupIDs = _aref(shift); + + my @groupIDs = $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + push @groupIDs, @$newGroupIDs; + + return $self->setGroupIDsOfClient($clientID, \@groupIDs); +} + +=item C + +Removes the given client from the given groups. + +=over + +=item Param C + +The ID of the client that you'd like to remove from the given groups. + +=item Param C + +An array-ref containing the IDs of the groups that shall be removed from the +client. + +=item Return Value + +C<1> if the client/group references could be set, C if not. + +=back + +=cut + +sub removeGroupIDsFromClient +{ + my $self = shift; + my $clientID = shift; + my $toBeRemovedGroupIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$toBeRemovedGroupIDs} = (); + my @groupIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchGroupIDsOfClient($clientID); + + return $self->setGroupIDsOfClient($clientID, \@groupIDs); +} + +=item C + +Adds one or more groups to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new group(s). + +=item Return Value + +The IDs of the new group(s), C if the creation failed. + +=back + +=cut + +sub addGroup +{ + my $self = shift; + my $inValRows = _aref(shift); + + _checkCols($inValRows, 'group', qw(name)); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + foreach my $valRow (@$valRows) { + if (!defined $valRow->{priority}) { + $valRow->{priority} = '50'; + } + } + my @IDs = $self->{'meta-db'}->addGroup($valRows, $attrValRows); + return wantarray() ? @IDs : $IDs[0]; +} + +=item C + +Removes one or more groups from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the groups that shall be removed. + +=item Return Value + +C<1> if the group(s) could be removed, C if not. + +=back + +=cut + +sub removeGroup +{ + my $self = shift; + my $groupIDs = _aref(shift); + + foreach my $group (@$groupIDs) { + $self->setSystemIDsOfGroup($group, []); + $self->setClientIDsOfGroup($group, []); + } + + return $self->{'meta-db'}->removeGroup($groupIDs); +} + +#=item C +# +#Sets a value for an attribute of the given group. If the group already +#has a value for this attribute, it will be overwritten. +# +#=over +# +#=item Param C +# +#The ID of the group whose attribute shall be changed. +# +#=item Param C +# +#The name of the attribute to change. +# +#=item Param C +# +#The new value for the attribute. +# +#=item Return Value +# +#C<1> if the attribute could be set, C if not. +# +#=back +# +#=cut +# +#sub setGroupAttr +#{ +# my $self = shift; +# my $groupID = shift; +# my $attrName = shift; +# my $attrValue = shift; +# +# return $self->{'meta-db'}->setGroupAttr($groupID, $attrName, $attrValue); +#} + +=item C + +Changes the data of one or more groups. + +=over + +=item Param C + +An array-ref containing the IDs of the groups that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the group(s). + +=item Return Value + +C<1> if the group(s) could be changed, C if not. + +=back + +=cut + +sub changeGroup +{ + my $self = shift; + my $groupIDs = _aref(shift); + my $inValRows = _aref(shift); + + my ($valRows, $attrValRows) = _cloneAndUnhingeAttrs($inValRows); + + return $self->{'meta-db'}->changeGroup($groupIDs, $valRows, $attrValRows); +} + +=item C + +Specifies all clients that should be part of the given group. + +=over + +=item Param C + +The ID of the group whose clients you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the clients that shall be part of the group. + +=item Return Value + +C<1> if the group/client references could be set, C if not. + +=back + +=cut + +sub setClientIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + my $clientIDs = _aref(shift); + + my @uniqueClientIDs = _unique(@$clientIDs); + + return $self->{'meta-db'}->setClientIDsOfGroup($groupID, \@uniqueClientIDs); +} + +=item C + +Add some clients to the given group. + +=over + +=item Param C + +The ID of the group to which you'd like to add clients. + +=item Param C + +An array-ref containing the IDs of the clients that shall be added. + +=item Return Value + +C<1> if the group/client references could be set, C if not. + +=back + +=cut + +sub addClientIDsToGroup +{ + my $self = shift; + my $groupID = shift; + my $newClientIDs = _aref(shift); + + my @clientIDs = $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + push @clientIDs, @$newClientIDs; + + return $self->setClientIDsOfGroup($groupID, \@clientIDs); +} + +=item C + +Remove some clients from the given group. + +=over + +=item Param C + +The ID of the group from which you'd like to remove clients. + +=item Param C + +An array-ref containing the IDs of the clients that shall be removed. + +=item Return Value + +C<1> if the group/client references could be set, C if not. + +=back + +=cut + +sub removeClientIDsFromGroup +{ + my $self = shift; + my $groupID = shift; + my $removedClientIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedClientIDs} = (); + my @clientIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchClientIDsOfGroup($groupID); + + return $self->setClientIDsOfGroup($groupID, \@clientIDs); +} + +=item C + +Specifies all systems that should be offered for booting by the given group. + +=over + +=item Param C + +The ID of the group whose systems you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the systems that shall be connected to the +group. + +=item Return Value + +C<1> if the group/system references could be set, C if not. + +=back + +=cut + +sub setSystemIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + my $systemIDs = _aref(shift); + + # filter out the default system, as no group should be associated to it + my @uniqueSystemIDs = grep { $_ > 0; } _unique(@$systemIDs); + + return $self->{'meta-db'}->setSystemIDsOfGroup($groupID, \@uniqueSystemIDs); +} + +=item C + +Adds some systems to the set that should be offered for booting by the given group. + +=over + +=item Param C + +The ID of the group to which you'd like to add systems. + +=item Param C + +An array-ref containing the IDs of the systems that shall be added. + +=item Return Value + +C<1> if the group/system references could be set, C if not. + +=back + +=cut + +sub addSystemIDsToGroup +{ + my $self = shift; + my $groupID = shift; + my $newSystemIDs = _aref(shift); + + my @systemIDs = $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + push @systemIDs, @$newSystemIDs; + + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); +} + +=item C + +Removes some systems from the set that should be offered for booting by the given group. + +=over + +=item Param C + +The ID of the group from which you'd like to remove systems. + +=item Param C + +An array-ref containing the IDs of the systems that shall be removed. + +=item Return Value + +C<1> if the group/system references could be set, C if not. + +=back + +=cut + +sub removeSystemIDsFromGroup +{ + my $self = shift; + my $groupID = shift; + my $removedSystemIDs = _aref(shift); + + my %toBeRemoved; + @toBeRemoved{@$removedSystemIDs} = (); + my @systemIDs = + grep { !exists $toBeRemoved{$_} } + $self->{'meta-db'}->fetchSystemIDsOfGroup($groupID); + + return $self->setSystemIDsOfGroup($groupID, \@systemIDs); +} + +=item C + +Removes all data from the database - the tables stay, but they will be empty. + +=over + +=item Return Value + +none + +=back + +=cut + +sub emptyDatabase +{ # clears all user-data from the database + my $self = shift; + + my @groupIDs = map { $_->{id} } $self->fetchGroupByFilter(); + $self->removeGroup(\@groupIDs); + + my @clientIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchClientByFilter(); + $self->removeClient(\@clientIDs); + + my @sysIDs = map { $_->{id} } + grep { $_->{name} ne '<<>>' } $self->fetchSystemByFilter(); + $self->removeSystem(\@sysIDs); + + my @exportIDs = map { $_->{id} } $self->fetchExportByFilter(); + $self->removeExport(\@exportIDs); + + my @vendorOSIDs = map { $_->{id} } $self->fetchVendorOSByFilter(); + $self->removeVendorOS(\@vendorOSIDs); + + return 1; +} + +=back + +=head2 Data Aggregation Methods + +=over + +=item C + +merges vendor-OS-specific plugin attributes and default system attributes into +the given system hash, and pushes the default client attributes on top of that. + +=over + +=item Param C + +The system whose attributes shall be merged into (completed). + +=item Return Value + +none + +=back + +=cut + +sub mergeDefaultAttributesIntoSystem +{ + my $self = shift; + my $system = shift; + my $installedPlugins = shift; + my $originInfo = shift; + + # merge any attributes found in the plugins that are installed into + # the vendor-OS: + if (ref $installedPlugins eq 'ARRAY' && @$installedPlugins) { + for my $plugin (@$installedPlugins) { + mergeAttributes($system, $plugin, $originInfo, 'vendor-OS'); + } + + # the above will have merged stage1 attributes, too, so we remove + # these from the resulting system (as they do not apply to systems) + my @stage3AttrNames = OpenSLX::AttributeRoster->getStage3Attrs(); + for my $attr (keys %{$system->{attrs}}) { + next if grep { $attr eq $_ } @stage3AttrNames; + delete $system->{attrs}->{$attr}; + } + } + + # merge yet unset stuff from default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + mergeAttributes($system, $defaultSystem, $originInfo, 'default-system'); + + # finally push the attributes specified for the default client (these + # overrule anything else) + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + pushAttributes($system, $defaultClient, $originInfo, 'default-client'); + + return 1; +} + +=item C + +merges default and group configurations into the given client hash. + +=over + +=item Param C + +The client whose attributes shall be merged into (completed). + +=item Return Value + +none + +=back + +=cut + +sub mergeDefaultAndGroupAttributesIntoClient +{ + my $self = shift; + my $client = shift; + my $originInfo = shift; + + # step over all groups this client belongs to + # (ordered by priority from highest to lowest): + my @groupIDs = _unique( + $self->fetchGroupIDsOfClient(0), + $self->fetchGroupIDsOfClient($client->{id}) + ); + my @groups + = sort { $a->{priority} <=> $b->{priority} } + $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # merge configuration from this group into the current client: + vlog( + 3, + _tr('merging from group %d:%s...', $group->{id}, $group->{name}) + ); + mergeAttributes($client, $group, $originInfo, "group '$group->{name}'"); + } + + # merge configuration from default client: + vlog(3, _tr('merging from default client...')); + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + mergeAttributes($client, $defaultClient, $originInfo, 'default-client'); + + return 1; +} + +=item C + +Returns an aggregated list of system-IDs that this client should offer for +booting (as indicated by itself, the default client and the client's groups) + +=over + +=item Param C + +The client whose aggregated systems you're interested in. + +=item Return Value + +A list of unqiue system-IDs. + +=back + +=cut + +sub aggregatedSystemIDsOfClient +{ + my $self = shift; + my $client = shift; + + # add all systems directly linked to client: + my @systemIDs = $self->fetchSystemIDsOfClient($client->{id}); + + # step over all groups this client belongs to: + my @groupIDs = $self->fetchGroupIDsOfClient($client->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all systems that the client inherits from the current group: + push @systemIDs, $self->fetchSystemIDsOfGroup($group->{id}); + } + + # add all systems inherited from default client + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id}); + + return _unique(@systemIDs); +} + +=item C + +Returns an aggregated list of client-IDs that offer this system for +booting (as indicated by itself, the default system and the system's groups) + +=over + +=item Param C + +The system whose aggregated clients you're interested in. + +=item Return Value + +A list of unqiue client-IDs. + +=back + +=cut + +sub aggregatedClientIDsOfSystem +{ + my $self = shift; + my $system = shift; + + # add all clients directly linked to system: + my $defaultClient = $self->fetchClientByFilter({name => '<<>>'}); + my @clientIDs = $self->fetchClientIDsOfSystem($system->{id}); + + if (grep { $_ == $defaultClient->{id}; } @clientIDs) { + # add *all* client-IDs if the system is being referenced by + # the default client, as that means that all clients should offer + # this system for booting: + push( + @clientIDs, + map { $_->{id} } $self->fetchClientByFilter(undef, 'id') + ); + } + + # step over all groups this system belongs to: + my @groupIDs = $self->fetchGroupIDsOfSystem($system->{id}); + my @groups = $self->fetchGroupByID(\@groupIDs); + foreach my $group (@groups) { + # add all clients that the system inherits from the current group: + push @clientIDs, $self->fetchClientIDsOfGroup($group->{id}); + } + + # add all clients inherited from default system + my $defaultSystem = $self->fetchSystemByFilter({name => '<<>>'}); + push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id}); + + return _unique(@clientIDs); +} + +=item C + +Returns aggregated information about the kernel and initialramfs +this system is using. + +=over + +=item Param C + +The system whose aggregated info you're interested in. + +=item Return Value + +A hash containing detailled info about the vendor-OS and export used by +this system, as well as the specific kernel-file and export-URI being used. + +=back + +=cut + +sub aggregatedSystemFileInfoFor +{ + my $self = shift; + my $system = shift; + + my $info = clone($system); + + my $export = $self->fetchExportByID($system->{export_id}); + if (!defined $export) { + die _tr( + "DB-problem: system '%s' references export with id=%s, but that doesn't exist!", + $system->{name}, $system->{export_id} || '' + ); + } + $info->{'export'} = $export; + + my $vendorOS = $self->fetchVendorOSByID($export->{vendor_os_id}); + if (!defined $vendorOS) { + die _tr( + "DB-problem: export '%s' references vendor-OS with id=%s, but that doesn't exist!", + $export->{name}, $export->{vendor_os_id} || '' + ); + } + $info->{'vendor-os'} = $vendorOS; + + my @installedPlugins = $self->fetchInstalledPlugins($vendorOS->{id}); + $info->{'installed-plugins'} = \@installedPlugins; + + # check if the specified kernel file really exists (follow links while + # checking) and if not, find the newest kernel file that is available. + my $kernelPath + = "$openslxConfig{'private-path'}/stage1/$vendorOS->{name}/boot"; + my $kernelFile = "$kernelPath/$system->{kernel}"; + while (-l $kernelFile) { + $kernelFile = followLink($kernelFile); + } + if (!-e $kernelFile) { + # pick best kernel file available + my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine"); + $osSetupEngine->initialize($vendorOS->{name}, 'none'); + $kernelFile = $osSetupEngine->pickKernelFile($kernelPath); + warn( + _tr( + "setting kernel of system '%s' to '%s'!", + $info->{name}, basename($kernelFile) + ) + ); + } + $info->{'kernel-file'} = $kernelFile; + + # auto-generate export_uri if none has been given + my $exportURI = $export->{'uri'} || ''; + if ($exportURI !~ m[\w]) { + # instantiate OSExport engine and ask it for exportURI + my $osExportEngine = instantiateClass("OpenSLX::OSExport::Engine"); + $osExportEngine->initializeFromExisting($export->{name}); + $exportURI = $osExportEngine->generateExportURI($export, $vendorOS); + } + $info->{'export-uri'} = $exportURI; + + return $info; +} + +=back + +=head2 Support Functions + +=over + +=item C + +Copies all attributes from source that are unset in target over (source extends target). + +=over + +=item Param C + +The hash to be used as copy target. + +=item Param C + +The hash to be used as copy source. + +=item Return Value + +none + +=back + +=cut + +sub mergeAttributes +{ + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; + + my $sourceAttrs = $source->{attrs} || {}; + + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; + + foreach my $key (keys %$sourceAttrs) { + my $sourceVal = $sourceAttrs->{$key}; + my $targetVal = $targetAttrs->{$key}; + if (!defined $targetVal) { + vlog(3, _tr( + "merging %s (val=%s)", $key, + defined $sourceVal ? $sourceVal : '' + )); + $targetAttrs->{$key} = $sourceVal; + if (defined $originInfo) { + $originInfo->{$key} = $origin; + } + } + } + + return 1; +} + +=item C + +Copies all attributes that are set in source into the target (source overrules target). + +=over + +=item Param C + +The hash to be used as copy target. + +=item Param C + +The hash to be used as copy source. + +=item Return Value + +none + +=back + +=cut + +sub pushAttributes +{ + my $target = shift; + my $source = shift; + my $originInfo = shift; + my $origin = shift; + + my $sourceAttrs = $source->{attrs} || {}; + + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; + + foreach my $key (keys %$sourceAttrs) { + my $sourceVal = $sourceAttrs->{$key}; + if (defined $sourceVal) { + vlog(3, _tr("pushing %s (val=%s)", $key, $sourceVal)); + $targetAttrs->{$key} = $sourceVal; + if (defined $originInfo) { + $originInfo->{$key} = $origin; + } + } + } + + return 1; +} + +=item C + +Returns the given system's name as an external ID - worked into a +state that is usable as a filename. + +=over + +=item Param C + +The system you are interested in. + +=item Return Value + +The external ID (name) of the given system. + +=back + +=cut + +sub externalIDForSystem +{ + my $system = shift; + + return "default" if $system->{name} eq '<<>>'; + + my $name = $system->{name}; + $name =~ tr[/][_]; + + return $name; +} + +=item C + +Returns the given client's MAC as an external ID - worked into a +state that is usable as a filename. + +=over + +=item Param C + +The client you are interested in. + +=item Return Value + +The external ID (MAC) of the given client. + +=back + +=cut + +sub externalIDForClient +{ + my $client = shift; + + return "default" if $client->{name} eq '<<>>'; + + my $mac = lc($client->{mac}); + # PXE seems to expect MACs being all lowercase + $mac =~ tr[:][-]; + + return "01-$mac"; +} + +=item C + +Returns the given client's name as an external ID - worked into a +state that is usable as a filename. + +=over + +=item Param C + +The client you are interested in. + +=item Return Value + +The external name of the given client. + +=back + +=cut + +sub externalConfigNameForClient +{ + my $client = shift; + + return "default" if $client->{name} eq '<<>>'; + + my $name = $client->{name}; + $name =~ tr[/][_]; + + return $name; +} + +=item C + +Returns the given variable as a placeholder - surrounded by '@@@' markers. + +=over + +=item Param C + +The variable you are interested in. + +=item Return Value + +The given variable as a placeholder string. + +=back + +=cut + +sub generatePlaceholderFor +{ + my $varName = shift; + + return '@@@' . $varName . '@@@'; +} + +################################################################################ +### private stuff +################################################################################ +sub _aref +{ # transparently converts the given reference to an array-ref + my $ref = shift; + + return [] unless defined $ref; + $ref = [$ref] unless ref($ref) eq 'ARRAY'; + + return $ref; +} + +sub _unique +{ # return given array filtered to unique elements + my %seenIDs; + return grep { !$seenIDs{$_}++; } @_; +} + +sub _checkCols +{ + my $valRows = shift; + my $table = shift; + my @colNames = @_; + + foreach my $valRow (@$valRows) { + foreach my $col (@colNames) { + die "need to set '$col' for $table!" if !$valRow->{$col}; + } + } + + return 1; +} + +sub _cloneAndUnhingeAttrs +{ + my $inValRows = shift; + + # clone data and unhinge attrs + my (@valRows, @attrValRows); + foreach my $inValRow (@$inValRows) { + push @attrValRows, $inValRow->{attrs}; + my $valRow = clone($inValRow); + delete $valRow->{attrs}; + push @valRows, $valRow; + } + + return (\@valRows, \@attrValRows); +} + +1; diff --git a/src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm b/src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm new file mode 100644 index 00000000..14b427c8 --- /dev/null +++ b/src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm @@ -0,0 +1,45 @@ +# 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/ +# ----------------------------------------------------------------------------- +# ISC.pm +# - provides ISC-specific implementation of DHCP export. +# ----------------------------------------------------------------------------- +package OpenSLX::ConfigExport::DHCP::ISC; + +use strict; +use warnings; + +our $VERSION = 1.01; # API-version . implementation-version + +################################################################################ +### This class provides an ISC specific implementation for DHCP export. +################################################################################ +use OpenSLX::Basics; + +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub execute +{ + my $self = shift; + my $clients = shift; + + vlog(1, _tr("writing dhcp-config for %s clients", scalar(@$clients))); + foreach my $client (@$clients) { +print "ISC-DHCP: $client->{name}\n"; + } +} \ No newline at end of file diff --git a/src/config-db/OpenSLX/DBSchema.pm b/src/config-db/OpenSLX/DBSchema.pm new file mode 100644 index 00000000..d3e7573b --- /dev/null +++ b/src/config-db/OpenSLX/DBSchema.pm @@ -0,0 +1,832 @@ +# 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/ +# ----------------------------------------------------------------------------- +# DBSchema.pm +# - provides database schema of the OpenSLX config-db. +# ----------------------------------------------------------------------------- +package OpenSLX::DBSchema; + +use strict; +use warnings; + +use OpenSLX::Basics; + +################################################################################ +### DB-schema definition +### This hash-ref describes the current OpenSLX configuration database +### schema. +### Each table is defined by a list of column descriptions (and optionally +### a list of default values). +### A column description is simply the name of the column followed by ':' +### followed by the data type description. The following data types are +### currently supported: +### b => boolean (providing the values 1 and 0 only) +### i => integer (32-bit, signed) +### s.20 => string, followed by length argument (in this case: 20) +### pk => primary key (integer) +### fk => foreign key (integer) +################################################################################ + +my $VERSION = 0.36; + +my $DbSchema = { + 'version' => $VERSION, + 'tables' => { + 'client' => { + # a client is a PC booting via network + 'cols' => [ + 'id:pk', # primary key + 'name:s.128', # official name of PC (e.g. as given by sticker + # on case) + 'mac:s.20', # MAC of NIC used for booting + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default client + 'id' => 0, + 'name' => '<<>>', + 'comment' => 'internal client that holds default values', + }, + ], + }, + 'client_attr' => { + # attributes of clients + 'cols' => [ + 'id:pk', # primary key + 'client_id:fk', # foreign key to client + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'client_system_ref' => { + # clients referring to the systems they should offer for booting + 'cols' => [ + 'client_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, + 'export' => { + # an export describes a vendor-OS "wrapped" in some kind of exporting + # format (NFS or NBD-squash). This represents the rootfs that the + # clients will see. + 'cols' => [ + 'id:pk', # primary key + 'name:s.64', # unique name of export, is automatically + # constructed like this: + # - + 'vendor_os_id:fk', # foreign key + 'comment:s.1024', # internal comment (optional, for admins) + 'type:s.10', # 'nbd', 'nfs', ... + 'server_ip:s.16', # IP of exporting server, if empty the + # boot server will be used + 'port:i', # some export types need to use a specific + # port for each incarnation, if that's the + # case you can specify it here + 'uri:s.255', # path to export (squashfs or NFS-path), if + # empty it will be auto-generated by + # config-demuxer + ], + }, + 'global_info' => { + # a home for global counters and other info + 'cols' => [ + 'id:s.32', # key + 'value:s.128', # value + ], + 'vals' => [ + { # add nbd-server-port + 'id' => 'next-nbd-server-port', + 'value' => '5000', + }, + ], + }, + 'groups' => { + # a group encapsulates a set of clients as one entity, managing + # a group-specific attribute set. All the different attribute + # sets a client inherits via group membership are folded into + # one resulting attribute set with respect to each group's priority. + 'cols' => [ + 'id:pk', # primary key + 'name:s.128', # name of group + 'priority:i', # priority, used for order in group-list + # (from 0-highest to 99-lowest) + 'comment:s.1024', # internal comment (optional, for admins) + ], + }, + 'group_attr' => { + # attributes of groups + 'cols' => [ + 'id:pk', # primary key + 'group_id:fk', # foreign key to group + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'group_client_ref' => { + # groups referring to their clients + 'cols' => [ + 'group_id:fk', # foreign key + 'client_id:fk', # foreign key + ], + }, + 'group_system_ref' => { + # groups referring to the systems each of their clients should + # offer for booting + 'cols' => [ + 'group_id:fk', # foreign key + 'system_id:fk', # foreign key + ], + }, + 'installed_plugin' => { + # holds the plugins that have been installed into a specific + # vendor-OS + 'cols' => [ + 'id:pk', # primary key + 'vendor_os_id:fk', # foreign key + 'plugin_name:s.64', # name of installed plugin + # (e.g. suse-9.3-kde, debian-3.1-ppc, + # suse-10.2-cloned-from-kiwi). + # This is used as the folder name for the + # corresponding stage1, too. + ], + }, + 'installed_plugin_attr' => { + # (stage1-)attributes of installed plugins + 'cols' => [ + 'id:pk', # primary key + 'installed_plugin_id:fk', # foreign key to installed plugin + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'meta' => { + # information about the database as such + 'cols' => [ + 'plugin_info_hash:s.32', # hash-value identifying a specific + # set of plugins and their + # attributes + 'schema_version:s.5', # schema-version currently + # implemented by DB + ], + 'vals' => [ + { + 'plugin_info_hash' => '', + 'schema_version' => $VERSION, + }, + ], + }, + 'system' => { + # a system describes one bootable instance of an export, it + # represents a selectable line in the PXE boot menu of all the + # clients associated with this system + 'cols' => [ + 'id:pk', # primary key + 'export_id:fk', # foreign key + 'name:s.64', # unique name of system, is automatically + # constructed like this: + # -- + 'label:s.64', # name visible to user (pxe-label) + # if empty, this will be autocreated from + # the name + 'kernel:s.128', # path to kernel file, relative to /boot + 'description:s.512', # visible description (for PXE TEXT) + 'pxe_prefix_ip:s.16', # ip prefix for PXE Menu entry + 'comment:s.1024', # internal comment (optional, for admins) + ], + 'vals' => [ + { # add default system + 'id' => 0, + 'name' => '<<>>', + 'comment' => 'internal system that holds default values', + }, + ], + }, + 'system_attr' => { + # attributes of systems + 'cols' => [ + 'id:pk', # primary key + 'system_id:fk', # foreign key to system + 'name:s.128', # attribute name + 'value:s.255', # attribute value + ], + }, + 'vendor_os' => { + # a vendor-OS describes a folder containing an operating system as + # provided by the vendor (a.k.a. unchanged and thus updatable) + 'cols' => [ + 'id:pk', # primary key + 'name:s.48', # structured name of OS installation + # (e.g. suse-9.3-kde, debian-3.1-ppc, + # suse-10.2-cloned-from-kiwi). + # This is used as the folder name for the + # corresponding stage1, too. + 'comment:s.1024', # internal comment (optional, for admins) + 'clone_source:s.255', # if vendor-OS was cloned, this contains + # the rsync-URI pointing to the original + ], + }, + }, +}; + +################################################################################ +### +### standard methods +### +################################################################################ +sub new +{ + my $class = shift; + + my $self = { + }; + + return bless $self, $class; +} + +sub checkAndUpgradeDBSchemaIfNecessary +{ + my $self = shift; + my $configDB = shift; + + my $metaDB = $configDB->{'meta-db'}; + + vlog(2, "trying to determine schema version..."); + my $currVersion = $metaDB->schemaFetchDBVersion(); + if (!defined $currVersion) { + # that's bad, someone has messed with our DB: there is a + # database, but the 'meta'-table is empty. + # There might still be data in the other tables, but we have no way to + # find out which schema version they're in. So it's safer to give up. + croak _tr('Could not determine schema version of database'); + } + + if ($currVersion == 0) { + vlog(1, _tr('Creating DB (schema version: %s)', $DbSchema->{version})); + foreach my $tableName (keys %{$DbSchema->{tables}}) { + # create table (optionally inserting default values, too) + $metaDB->schemaAddTable( + $tableName, + $DbSchema->{tables}->{$tableName}->{cols}, + $DbSchema->{tables}->{$tableName}->{vals} + ); + } + $metaDB->schemaSetDBVersion($DbSchema->{version}); + $configDB->cleanupAnyInconsistencies() + or die _tr('unable to cleanup DB!'); + vlog(1, _tr('DB has been created successfully')); + } elsif ($currVersion < $DbSchema->{version}) { + vlog( + 1, + _tr( + 'Our schema-version is %s, DB is %s, upgrading DB...', + $DbSchema->{version}, $currVersion + ) + ); + $self->_schemaUpgradeDBFrom($metaDB, $currVersion); + $configDB->cleanupAnyInconsistencies() + or die _tr('unable to cleanup DB!'); + vlog(1, _tr('upgrade done')); + } else { + vlog(1, _tr('DB matches current schema version (%s)', $currVersion)); + } + + return 1; +} + +sub getColumnsOfTable +{ + my $self = shift; + my $tableName = shift; + + return + map { (/^(\w+)\W/) ? $1 : $_; } + @{$DbSchema->{tables}->{$tableName}->{cols}}; +} + +################################################################################ +### +### methods for upgrading the DB schema +### +################################################################################ +my %DbSchemaHistory; + +sub _schemaUpgradeDBFrom +{ + my $self = shift; + my $metaDB = shift; + my $currVersion = shift; + + foreach my $version (sort { $a <=> $b } keys %DbSchemaHistory) { + next if $currVersion >= $version; + + vlog(0, "upgrading schema version to $version"); + if ($DbSchemaHistory{$version}->($metaDB)) { + $metaDB->schemaSetDBVersion($version); + } + } + + return 1; +} + +%DbSchemaHistory = ( + 0.2 => sub { + my $metaDB = shift; + + # move attributes into separate tables ... + # + # ... system attributes ... + $metaDB->schemaAddTable( + 'system_attr', + [ + 'id:pk', + 'system_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $system ($metaDB->fetchSystemByFilter()) { + my %attrs; + foreach my $key (keys %$system) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $system->{$key} || ''; + next if $system->{id} > 0 && !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setSystemAttrs($system->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'system', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_local_disk', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_ramfs_fsmods', + 'attr_ramfs_miscmods', + 'attr_ramfs_nicmods', + 'attr_ramfs_screen', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'export_id:fk', + 'name:s.64', + 'label:s.64', + 'kernel:s.128', + 'kernel_params:s.512', + 'hidden:b', + 'comment:s.1024', + ] + ); + # + # ... client attributes ... + $metaDB->schemaAddTable( + 'client_attr', + [ + 'id:pk', + 'client_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $client ($metaDB->fetchClientByFilter()) { + my %attrs; + foreach my $key (keys %$client) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $client->{$key} || ''; + next if !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setClientAttrs($client->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'client', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_local_disk', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'name:s.128', + 'mac:s.20', + 'boot_type:s.20', + 'unbootable:b', + 'kernel_params:s.128', + 'comment:s.1024', + ] + ); + # + # ... group attributes ... + $metaDB->schemaAddTable( + 'group_attr', + [ + 'id:pk', + 'group_id:fk', + 'name:s.128', + 'value:s.255', + ] + ); + foreach my $group ($metaDB->fetchGroupByFilter()) { + my %attrs; + foreach my $key (keys %$group) { + next if substr($key, 0, 5) ne 'attr_'; + my $attrValue = $group->{$key} || ''; + next if !length($attrValue); + my $newAttrName = substr($key, 5); + $attrs{$newAttrName} = $attrValue; + } + $metaDB->setGroupAttrs($group->{id}, \%attrs); + } + $metaDB->schemaDropColumns( + 'groups', + [ + 'attr_automnt_dir', + 'attr_automnt_src', + 'attr_country', + 'attr_dm_allow_shutdown', + 'attr_hw_graphic', + 'attr_hw_local_disk', + 'attr_hw_monitor', + 'attr_hw_mouse', + 'attr_late_dm', + 'attr_netbios_workgroup', + 'attr_nis_domain', + 'attr_nis_servers', + 'attr_sane_scanner', + 'attr_scratch', + 'attr_slxgrp', + 'attr_start_alsasound', + 'attr_start_atd', + 'attr_start_cron', + 'attr_start_dreshal', + 'attr_start_ntp', + 'attr_start_nfsv4', + 'attr_start_printer', + 'attr_start_samba', + 'attr_start_snmp', + 'attr_start_sshd', + 'attr_start_syslog', + 'attr_start_x', + 'attr_start_xdmcp', + 'attr_tex_enable', + 'attr_timezone', + 'attr_tvout', + 'attr_vmware', + ], + [ + 'id:pk', + 'name:s.128', + 'priority:i', + 'comment:s.1024', + ] + ); + + return 1; + }, + 0.21 => sub { + my $metaDB = shift; + + # add new table installed_plugin + $metaDB->schemaAddTable( + 'installed_plugin', + [ + 'id:pk', + 'vendor_os_id:fk', + 'plugin_name:s.64', + ] + ); + + return 1; + }, + 0.22 => sub { + my $metaDB = shift; + + # dummy schema change, just to trigger the attribute synchronization + # into the default system + + return 1; + }, + 0.23 => sub { + my $metaDB = shift; + + # add new column system.description + $metaDB->schemaAddColumns( + 'system', + [ + 'description:s.512', + ], + undef, + [ + 'id:pk', + 'export_id:fk', + 'name:s.64', + 'label:s.64', + 'kernel:s.128', + 'kernel_params:s.512', + 'hidden:b', + 'description:s.512', + 'comment:s.1024', + ] + ); + + return 1; + }, + 0.24 => sub { + my $metaDB = shift; + + # split theme::name into theme::splash, theme::displaymanager and + # theme::desktop + foreach my $system ($metaDB->fetchSystemByFilter()) { + my $attrs = $system->{attrs} || {}; + next if !exists $attrs->{'theme::name'}; + $attrs->{'theme::splash'} + = $attrs->{'theme::displaymanager'} + = $attrs->{'theme::desktop'} + = $attrs->{'theme::name'}; + delete $attrs->{'theme::name'}; + $metaDB->setSystemAttrs($system->{id}, $attrs); + } + + # force all plugin names to lowercase + foreach my $vendorOS ($metaDB->fetchVendorOSByFilter()) { + my @installedPlugins + = $metaDB->fetchInstalledPlugins($vendorOS->{id}); + foreach my $plugin (@installedPlugins) { + my $pluginName = $plugin->{plugin_name}; + $metaDB->removeInstalledPlugin($vendorOS->{id}, $pluginName); + $metaDB->addInstalledPlugin($vendorOS->{id}, lc($pluginName)); + } + } + + return 1; + }, + 0.25 => sub { + my $metaDB = shift; + + # drop attribute ramfs_screen + $metaDB->removeAttributeByName('ramfs_screen'); + + return 1; + }, + 0.26 => sub { + my $metaDB = shift; + + # rename all exports and systems that contain a single colon to + # the current naming scheme with a double colon + foreach my $system ($metaDB->fetchSystemByFilter()) { + if ($system->{name} =~ m{^([^:]+):([^:]+)$}) { + if ($system->{label} eq $system->{name}) { + $system->{label} = "${1}::${2}"; + } + $system->{name} = "${1}::${2}"; + $metaDB->changeSystem([ $system->{id} ], [ $system ]); + } + } + foreach my $export ($metaDB->fetchExportByFilter()) { + if ($export->{name} =~ m{^([^:]+):([^:]+)$}) { + $export->{name} = "${1}::${2}"; + $metaDB->changeExport([ $export->{id} ], [ $export ]); + } + } + + return 1; + }, + 0.27 => sub { + my $metaDB = shift; + + # add default vendor-OS, which holds info about the plugins that shall + # be automatically installed into all vendor-OS that are being created. + $metaDB->addVendorOS([{ + id => '0', + name => '<<>>', + comment => 'holds default plugins for all vendor-OS', + }]); + + return 1; + }, + 0.28 => sub { + my $metaDB = shift; + + # correct effects of implementation error last time around that caused + # the default vendor-OS to not have any plugins at all - so we add + # the default plugins here: +# OLTA: deactivated for good since this does not work anymore with newer +# implementations (as addInstalledPlugin requires the table +# 'installed_plugin_attr', which is going to be created in db-schema +# version 0.29 (see below) +# $metaDB->addInstalledPlugin(0, 'theme'); + + return 1; + }, + 0.29 => sub { + my $metaDB = shift; + + # add new table installed_plugin_attrs + $metaDB->schemaAddTable( + 'installed_plugin_attr', + [ + 'id:pk', + 'installed_plugin_id:fk', + 'name:s.128', + 'value:s.255', + ], + ); + + return 1; + }, + 0.30 => sub { + my $metaDB = shift; + + # dummy schema change, just to trigger the attribute synchronization + # into the default system (required since plugins have been added + # and removed) + + return 1; + }, + 0.31 => sub { + my $metaDB = shift; + + # dummy schema change, just to trigger the attribute synchronization + # again, as the respective code has been extended + + return 1; + }, + 0.32 => sub { + my $metaDB = shift; + + # dummy schema change, just to trigger the attribute synchronization, + # as the 'theme' plugin has been removed + + return 1; + }, + 0.33 => sub { + my $metaDB = shift; + + # add new column meta.plugin_info_hash + $metaDB->schemaAddColumns( + 'meta', + [ + 'plugin_info_hash:s.32', + ], + undef, + [ + 'plugin_info_hash:s.32', + 'schema_version:s.5', + ] + ); + + return 1; + }, + 0.34 => sub { + my $metaDB = shift; + + # turn client fields 'boot_type', 'kernel_params' and 'unbootable' + # into attributes: + foreach my $client ($metaDB->fetchClientByFilter()) { + my $attrs = $metaDB->fetchClientAttrs($client->{id}); + $attrs->{boot_type} = $client->{boot_type} || 'pxe'; + $attrs->{kernel_params_client} = $client->{kernel_params}; + $attrs->{unbootable} = $client->{unbootable}; + $metaDB->setClientAttrs($client->{id}, $attrs); + } + $metaDB->schemaDropColumns( + 'client', + [ + 'boot_type', + 'kernel_params', + 'unbootable', + ], + [ + 'id:pk', + 'name:s.128', + 'mac:s.20', + 'comment:s.1024', + ] + ); + + # turn system fields 'hidden' and 'kernel_params' into attributes: + foreach my $system ($metaDB->fetchSystemByFilter()) { + my $attrs = $metaDB->fetchSystemAttrs($system->{id}); + $attrs->{hidden} = $system->{hidden}; + $attrs->{kernel_params} = $system->{kernel_params}; + $metaDB->setSystemAttrs($system->{id}, $attrs); + } + $metaDB->schemaDropColumns( + 'system', + [ + 'hidden', + 'kernel_params', + ], + [ + 'id:pk', + 'export_id:fk', + 'name:s.64', + 'label:s.64', + 'kernel:s.128', + 'description:s.512', + 'comment:s.1024', + ] + ); + + return 1; + }, + 0.35 => sub { + my $metaDB = shift; + + # add new column system.pxe_prefix_ip + $metaDB->schemaAddColumns( + 'system', + [ + 'pxe_prefix_ip:s.16', + ], + undef + ); + + return 1; + }, + 0.36 => sub { + my $metaDB = shift; + + # value 'preboot-cd' in client-attr 'boot_type' has been changed + # to 'preboot', and a separate attribute 'preboot_media' has been + # introduced: + foreach my $client ($metaDB->fetchClientByFilter()) { + my $attrs = $metaDB->fetchClientAttrs($client->{id}); + if ($attrs->{boot_type} eq 'preboot-cd') { + $attrs->{boot_type} = 'preboot'; + $attrs->{preboot_media} = 'cd'; + $metaDB->setClientAttrs($client->{id}, $attrs); + } + } + + return 1; + }, +); + +1; diff --git a/src/config-db/OpenSLX/MetaDB/Base.pm b/src/config-db/OpenSLX/MetaDB/Base.pm new file mode 100644 index 00000000..f1fbd0f5 --- /dev/null +++ b/src/config-db/OpenSLX/MetaDB/Base.pm @@ -0,0 +1,1220 @@ +# 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 MetaDB API. +# ----------------------------------------------------------------------------- +package OpenSLX::MetaDB::Base; + +use strict; +use warnings; + +our $VERSION = 1.01; # API-version . implementation-version + +use OpenSLX::Basics; + +################################################################################ +### basic functions +################################################################################ +sub new +{ + confess "Don't create OpenSLX::MetaDB::Base - objects directly!"; +} + +sub connect ## no critic (ProhibitBuiltinHomonyms) +{ +} + +sub disconnect +{ +} + +sub quote +{ +} + +################################################################################ +### data access interface +################################################################################ +sub fetchVendorOSByFilter +{ +} + +sub fetchVendorOSByID +{ +} + +sub fetchExportByFilter +{ +} + +sub fetchExportByID +{ +} + +sub fetchExportIDsOfVendorOS +{ +} + +sub fetchSystemByFilter +{ +} + +sub fetchSystemByID +{ +} + +sub fetchSystemIDsOfExport +{ +} + +sub fetchSystemIDsOfClient +{ +} + +sub fetchSystemIDsOfGroup +{ +} + +sub fetchClientByFilter +{ +} + +sub fetchClientByID +{ +} + +sub fetchClientIDsOfSystem +{ +} + +sub fetchClientIDsOfGroup +{ +} + +sub fetchGroupByFilter +{ +} + +sub fetchGroupByID +{ +} + +sub fetchGroupIDsOfClient +{ +} + +sub fetchGroupIDsOfSystem +{ +} + +################################################################################ +### data manipulation interface +################################################################################ +sub generateNextIdForTable +{ # some DBs (CSV for instance) aren't able to generate any IDs, so we + # offer an alternative way (by pre-specifying IDs for INSERTs). + # NB: if this method is called without a tablename, it returns: + # 1 if this backend requires manual ID generation + # 0 if not. + return; +} + +sub addVendorOS +{ +} + +sub removeVendorOS +{ +} + +sub changeVendorOS +{ +} + +sub addExport +{ +} + +sub removeExport +{ +} + +sub changeExport +{ +} + +sub addSystem +{ +} + +sub removeSystem +{ +} + +sub changeSystem +{ +} + +sub setClientIDsOfSystem +{ +} + +sub setGroupIDsOfSystem +{ +} + +sub addClient +{ +} + +sub removeClient +{ +} + +sub changeClient +{ +} + +sub setSystemIDsOfClient +{ +} + +sub setGroupIDsOfClient +{ +} + +sub addGroup +{ +} + +sub removeGroup +{ +} + +sub changeGroup +{ +} + +sub setClientIDsOfGroup +{ +} + +sub setSystemIDsOfGroup +{ +} + +################################################################################ +### schema related functions +################################################################################ +sub schemaFetchDBVersion +{ +} + +sub schemaSetDBVersion +{ +} + +sub schemaCreate +{ +} + +sub schemaUpgradeToCurrent +{ +} + +sub schemaConvertTypeDescrToNative +{ +} + +sub schemaAddTable +{ +} + +sub schemaDropTable +{ +} + +sub schemaRenameTable +{ +} + +sub schemaAddColumns +{ +} + +sub schemaDropColumns +{ +} + +sub schemaChangeColumns +{ +} + +1; +################################################################################ + +=pod + +=head1 NAME + +OpenSLX::MetaDB::Base - the base class for all MetaDB drivers + +=head1 SYNOPSIS + + package OpenSLX::MetaDB::coolnewDB; + + use vars qw(@ISA $VERSION); + @ISA = ('OpenSLX::MetaDB::Base'); + $VERSION = 1.01; + + my $superVersion = $OpenSLX::MetaDB::Base::VERSION; + if ($superVersion < $VERSION) { + croak _tr('Unable to load module <%s> (Version <%s> required)', + 'OpenSLX::MetaDB::Base', $VERSION); + } + + use coolnewDB; + + sub new + { + my $class = shift; + my $self = {}; + return bless $self, $class; + } + + sub connectConfigDB + { + my $self = shift; + + my $dbName = $openslxConfig{'db-name'}; + vlog(1, "trying to connect to coolnewDB-database <$dbName>"); + $self->{'dbh'} = ... # get connection handle from coolnewDB + } + + sub disconnectConfigDB + { + my $self = shift; + + $self->{'dbh'}->disconnect; + } + + # override all methods of OpenSLX::MetaDB::Base in order to implement + # a full MetaDB driver + ... + +I> + +=head1 DESCRIPTION + +This class defines the MetaDB interface for the OpenSLX. + +Aim of the MetaDB abstraction is to make it possible to use a large set +of different databases (from CSV-files to a fullblown Oracle-installation) +transparently. + +While OpenSLX::ConfigDB represents the data layer to the outside world, each +implementation of OpenSLX::MetaDB::Base provides a backend for a specific database. + +This way, the different OpenSLX-scripts do not have to burden +themselves with any DB-specific details, they just request the data they want +from the ConfigDB-layer and that in turn creates and communicates with the +appropriate MetaDB driver in order to connect to the database and fetch and/or +change the data as instructed. + +The MetaDB interface contains of four different parts: + +=over + +=item - L (connection handling and utilities) + +=item - L (getting data) + +=item - L (adding, removing and changing data) + +=item - L (migrating between different DB-versions) + +=back + +In order to implement a MetaDB driver for a specific database, you need +to inherit from B and implement the full interface. As this +is quite some work, it might be wiser to actually inherit your driver from +B>, which is a default implementation for SQL databases. + +If there is a DBD-driver for the database your new MetaDB driver wants to talk +to then all you need to do is inherit from B and then +reimplement L> (and maybe some other methods in order to +improve efficiency). + +=head1 Special Concepts + +=over + +=item C + +A filter is a hash-ref defining the filter criteria to be applied to a database +query. Each key of the filter corresponds to a DB column and the (hash-)value +contains the respective column value. + +[At a later stage, this will be improved to support a more structured approach +to filtering (with boolean operators and hierarchical expressions)]. + +=back + +=head1 Methods + +=head2 Basic Methods + +The following basic methods need to be implemented in a MetaDB driver: + +=over + +=item C + +Tries to establish a connection to the DBMS that this MetaDB driver deals with. +The global configuration hash C<%config> contains further info about the +requested connection. When implementing this method, you may have to look at +the following entries in order to find out which database to connect to: + +=over + +=item C<$config{'db-spec'}> + +Full specification of database, a special string defining the +precise database to connect to (this allows connecting to a database +that requires specifications which aren't cared for by the existing +C<%config>-entries). + +=item C<$config{'db-name'}> + +The precise name of the database that should be connected (defaults to 'openslx'). + +=back + +=item C + +Tears down the connection to the DBMS that this MetaDB driver deals with and +cleans up. + +=item C + +Returns the given string quoted such that it can be used in SQL-statements +(with respect to the corresponding DBMS). + +This usually involves putting +single quotes around the string and escaping any single quote characters +enclosed in the given string with a backslash. + +=back + +=head2 Data Access Methods + +The following methods need to be implemented in a MetaDB driver in order to +allow the user to access data: + +=over + +=item C + +Fetches and returns information about all vendor-OSes that match the given +filter. + +=over + +=item Param C + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches and returns information the vendor-OSes with the given IDs. + +=over + +=item Param C + +An array of the vendor-OS-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches and returns information about all exports that match the given +filter. + +=over + +=item Param C + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches and returns information the exports with the given IDs. + +=over + +=item Param C + +An array of the export-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches the IDs of all exports that make use of the vendor-OS with the given ID. + +=over + +=item Param C + +ID of the vendor-OS whose exports shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=item C + +Fetches and returns information about all systems that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches and returns information the systems with the given IDs. + +=over + +=item Param C + +An array of the system-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches the IDs of all systems that make use of the export with the given ID. + +=over + +=item Param C + +ID of the export whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=item C + +Fetches the IDs of all systems that are used by the client with the given +ID. + +=over + +=item Param C + +ID of the client whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=item C + +Fetches the IDs of all systems that are part of the group with the given +ID. + +=over + +=item Param C + +ID of the group whose systems shall be returned. + +=item Return Value + +An array of system-IDs. + +=back + +=item C + +Fetches and returns information about all clients that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches and returns information the clients with the given IDs. + +=over + +=item Param C + +An array of the client-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + +=item C + +Fetches the IDs of all clients that make use of the system with the given +ID. + +=over + +=item Param C + +ID of the system whose clients shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + +=item C + +Fetches the IDs of all clients that are part of the group with the given +ID. + +=over + +=item Param C + +ID of the group whose clients shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + + + +=item C + +Fetches and returns information about all groups that match the given filter. + +=over + +=item Param C<$filter> + +A hash-ref containing the filter criteria that shall be applied - default +is no filtering. See L for more info. + +=item Param C<$resultCols> [Optional] + +A comma-separated list of colunm names that shall be returned. If not defined, +all available data must be returned. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + + + +=item C + +Fetches and returns information the groups with the given IDs. + +=over + +=item Param C + +An array of the group-IDs you are interested in. + +=item Param C + +A string listing the columns that shall be returned - default is all columns. + +=item Return Value + +An array of hash-refs containing the resulting data rows. + +=back + + + +=item C + +Fetches the IDs of all groups that contain the client with the given +ID. + +=over + +=item Param C + +ID of the client whose groups shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + + + +=item C + +Fetches the IDs of all groups that contain the system with the given +ID. + +=over + +=item Param C + +ID of the system whose groups shall be returned. + +=item Return Value + +An array of client-IDs. + +=back + + + +=head2 Data Manipulation Methods + +The following methods need to be implemented in a MetaDB driver in order to +allow the user to access change the underlying: + + + +=item C + +Adds one or more vendor-OS to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new vendor-OS(es). + +=item Return Value + +The IDs of the new vendor-OS(es), C if the creation failed. + +=back + + + +=item C + +Removes one or more vendor-OS from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the vendor-OSes that shall be removed. + +=item Return Value + +C<1> if the vendorOS(es) could be removed, C if not. + +=back + + + +=item C + +Changes the data of one or more vendor-OS. + +=over + +=item Param C + +An array-ref containing the IDs of the vendor-OSes that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the vendor-OS(es). + +=item Return Value + +C<1> if the vendorOS(es) could be changed, C if not. + +=back + + + +=item C + +Adds one or more export to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new export(s). + +=item Return Value + +The IDs of the new export(s), C if the creation failed. + +=back + + + +=item C + +Removes one or more export from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the exports that shall be removed. + +=item Return Value + +C<1> if the export(s) could be removed, C if not. + +=back + + + +=item C + +Changes the data of one or more export. + +=over + +=item Param C + +An array-ref containing the IDs of the exports that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the export(s). + +=item Return Value + +C<1> if the export(s) could be changed, C if not. + +=back + + + +=item C + +Adds one or more systems to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new system(s). + +=item Return Value + +The IDs of the new system(s), C if the creation failed. + +=back + + + +=item C + +Removes one or more systems from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the systems that shall be removed. + +=item Return Value + +C<1> if the system(s) could be removed, C if not. + +=back + + + +=item C + +Changes the data of one or more systems. + +=over + +=item Param C + +An array-ref containing the IDs of the systems that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the system(s). + +=item Return Value + +C<1> if the system(s) could be changed, C if not. + +=back + + + +=item C + +Specifies all clients that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system whose clients you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the clients that shall be connected to the +system. + +=item Return Value + +C<1> if the system/client references could be set, C if not. + +=back + + + +=item C + +Specifies all groups that should offer the given system for booting. + +=over + +=item Param C + +The ID of the system whose groups you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the groups that shall be connected to the +system. + +=item Return Value + +C<1> if the system/group references could be set, C if not. + +=back + + + +=item C + +Adds one or more clients to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new client(s). + +=item Return Value + +The IDs of the new client(s), C if the creation failed. + +=back + + + +=item C + +Removes one or more clients from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the clients that shall be removed. + +=item Return Value + +C<1> if the client(s) could be removed, C if not. + +=back + + + +=item C + +Changes the data of one or more clients. + +=over + +=item Param C + +An array-ref containing the IDs of the clients that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the client(s). + +=item Return Value + +C<1> if the client(s) could be changed, C if not. + +=back + + + +=item C + +Specifies all systems that should be offered for booting by the given client. + +=over + +=item Param C + +The ID of the client whose systems you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the systems that shall be connected to the +client. + +=item Return Value + +C<1> if the client/system references could be set, C if not. + +=back + + + +=item C + +Specifies all groups that the given client shall be part of. + +=over + +=item Param C + +The ID of the client whose groups you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the groups that the client should be part of. + +=item Return Value + +C<1> if the client/group references could be set, C if not. + +=back + + + +=item C + +Adds one or more groups to the database. + +=over + +=item Param C + +An array-ref containing hash-refs with the data of the new group(s). + +=item Return Value + +The IDs of the new group(s), C if the creation failed. + +=back + + + +=item C + +Removes one or more groups from the database. + +=over + +=item Param C + +An array-ref containing the IDs of the groups that shall be removed. + +=item Return Value + +C<1> if the group(s) could be removed, C if not. + +=back + + + +=item C + +Changes the data of one or more groups. + +=over + +=item Param C + +An array-ref containing the IDs of the groups that shall be changed. + +=item Param C + +An array-ref containing hash-refs with the new data for the group(s). + +=item Return Value + +C<1> if the group(s) could be changed, C if not. + +=back + + + +=item C + +Specifies all clients that should be part of the given group. + +=over + +=item Param C + +The ID of the group whose clients you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the clients that shall be part of the group. + +=item Return Value + +C<1> if the group/client references could be set, C if not. + +=back + + + +=item C + +Specifies all systems that should be offered for booting by the given group. + +=over + +=item Param C + +The ID of the group whose systems you'd like to specify. + +=item Param C + +An array-ref containing the IDs of the systems that shall be connected to the +group. + +=item Return Value + +C<1> if the group/system references could be set, C if not. + +=back + + + + + +=head2 Schema Related Methods + +The following methods need to be implemented in a MetaDB driver in order to +be able to automatically adjust to new database schema versions (by adding +and/or removing tables and table-columns). + +=cut diff --git a/src/config-db/OpenSLX/MetaDB/DBI.pm b/src/config-db/OpenSLX/MetaDB/DBI.pm new file mode 100644 index 00000000..a5a8e68e --- /dev/null +++ b/src/config-db/OpenSLX/MetaDB/DBI.pm @@ -0,0 +1,1540 @@ +# 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/ +# ----------------------------------------------------------------------------- +# DBI.pm +# - provides DBI-based implementation of the OpenSLX MetaDB API. +# ----------------------------------------------------------------------------- +package OpenSLX::MetaDB::DBI; + +use strict; +use warnings; + +use base qw(OpenSLX::MetaDB::Base); + +use DBI; +use OpenSLX::Basics; +use OpenSLX::Utils; + +################################################################################ +### basics +################################################################################ +sub new +{ + confess "Don't call OpenSLX::MetaDB::DBI::new directly!"; +} + +sub disconnect +{ + my $self = shift; + + $self->{'dbh'}->disconnect; + $self->{'dbh'} = undef; + return; +} + +sub quote +{ # default implementation quotes any given values through the DBI + my $self = shift; + + return $self->{'dbh'}->quote(@_); +} + +sub startTransaction +{ # default implementation passes on the request to the DBI + my $self = shift; + + return $self->{'dbh'}->begin_work(); +} + +sub commitTransaction +{ # default implementation passes on the request to the DBI + my $self = shift; + + return $self->{'dbh'}->commit(); +} + +sub rollbackTransaction +{ # default implementation passes on the request to the DBI + my $self = shift; + + return $self->{'dbh'}->rollback(); +} + +################################################################################ +### data access +################################################################################ +sub _trim +{ + my $s = shift; + $s =~ s[^\s*(.*?)\s*$][$1]; + return $s; +} + +sub _buildFilterClause +{ + my $self = shift; + my $filter = shift || {}; + my $filterClause = shift || ''; + + my ($connector, $quotedVal); + foreach my $col (keys %$filter) { + $connector = !length($filterClause) ? 'WHERE' : 'AND'; + if (defined $filter->{$col}) { + $quotedVal = $self->{dbh}->quote($filter->{$col}); + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector $col = $quotedVal + End-of-Here + } else { + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector $col IS NULL + End-of-Here + } + } + + return $filterClause || ''; +} + +sub _buildAttrFilterClause +{ + my $self = shift; + my $attrFilter = shift || {}; + my $table = shift; + my $filterClause = shift || ''; + + my %tableMap = ( + 'client' => 'client', + 'group' => 'groups', + 'system' => 'system', + ); + + my ($connector, $quotedName, $quotedValue); + foreach my $name (keys %$attrFilter) { + $connector = !length($filterClause) ? 'WHERE' : 'AND'; + $quotedName = $self->{dbh}->quote($name); + if (defined $attrFilter->{$name}) { + $quotedValue = $self->{dbh}->quote($attrFilter->{$name}); + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector EXISTS ( + SELECT name FROM ${table}_attr + WHERE name = $quotedName + AND value = $quotedValue + AND ${table}_id = $tableMap{$table}.id + ) + End-of-Here + } else { + $filterClause .= unshiftHereDoc(<<" End-of-Here"); + $connector NOT EXISTS ( + SELECT name FROM ${table}_attr + WHERE name = $quotedName + AND ${table}_id = $tableMap{$table}.id + ) + End-of-Here + } + } + + return $filterClause; +} + +sub _doSelect +{ + my $self = shift; + my $sql = shift; + my $resultCol = shift; + + my $dbh = $self->{'dbh'}; + + vlog(3, _trim($sql)); + my $sth = $dbh->prepare($sql) + or croak _tr( + q[Can't prepare SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); + $sth->execute() + or croak _tr( + q[Can't execute SQL-statement <%s> (%s)], $sql, $dbh->errstr + ); + my @vals; + while (my $row = $sth->fetchrow_hashref()) { + if (defined $resultCol) { + return $row->{$resultCol} unless wantarray(); + push @vals, $row->{$resultCol}; + } else { + return $row unless wantarray(); + push @vals, $row; + } + } + + # return undef if there's no result in scalar context + return if !wantarray(); + + return @vals; +} + +sub fetchVendorOSByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + my $sql = "SELECT $resultCols FROM vendor_os $filterClause"; + return $self->_doSelect($sql); +} + +sub fetchVendorOSByID +{ + my $self = shift; + my $ids = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM vendor_os WHERE id IN ($idStr)"; + return $self->_doSelect($sql); +} + +sub fetchInstalledPlugins +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $fullInfo = shift || 0; + + return if !defined $vendorOSID; + my $nameClause + = defined $pluginName + ? "AND plugin_name = '$pluginName'" + : ''; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT * FROM installed_plugin + WHERE vendor_os_id = '$vendorOSID' + $nameClause + End-of-Here + my @pluginInfos = $self->_doSelect($sql); + return if !@pluginInfos; + + @pluginInfos = map { + my $pluginInfo = $_; + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT * FROM installed_plugin_attr + WHERE installed_plugin_id = '$pluginInfo->{id}' + End-of-Here + my @attrs = $self->_doSelect($sql); + $pluginInfo->{attrs} = { + map { + ( $_->{name}, $fullInfo ? $_ : $_->{value} ) + } @attrs + }; + $pluginInfo; + } + @pluginInfos; + + return wantarray() ? @pluginInfos : $pluginInfos[0]; +} + +sub fetchExportByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + my $sql = "SELECT $resultCols FROM export $filterClause"; + return $self->_doSelect($sql); +} + +sub fetchExportByID +{ + my $self = shift; + my $ids = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM export WHERE id IN ($idStr)"; + return $self->_doSelect($sql); +} + +sub fetchExportIDsOfVendorOS +{ + my $self = shift; + my $vendorOSID = shift; + + my $sql = qq[ + SELECT id FROM export WHERE vendor_os_id = '$vendorOSID' + ]; + return $self->_doSelect($sql, 'id'); +} + +sub fetchGlobalInfo +{ + my $self = shift; + my $id = shift; + + return if !length($id); + my $sql = "SELECT value FROM global_info WHERE id = " . $self->quote($id); + return $self->_doSelect($sql, 'value'); +} + +sub fetchSystemByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'system', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM system + $filterClause + End-of-Here + return $self->_doSelect($sql); +} + +sub fetchSystemByID +{ + my $self = shift; + my $ids = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM system WHERE id IN ($idStr)"; + return $self->_doSelect($sql); +} + +sub fetchSystemAttrs +{ + my $self = shift; + my $systemID = $self->{dbh}->quote(shift); + + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM system_attr + WHERE system_id = $systemID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; +} + +sub fetchSystemIDsOfExport +{ + my $self = shift; + my $exportID = shift; + + my $sql = qq[ + SELECT id FROM system WHERE export_id = '$exportID' + ]; + return $self->_doSelect($sql, 'id'); +} + +sub fetchSystemIDsOfClient +{ + my $self = shift; + my $clientID = shift; + + my $sql = qq[ + SELECT system_id FROM client_system_ref WHERE client_id = '$clientID' + ]; + return $self->_doSelect($sql, 'system_id'); +} + +sub fetchSystemIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + + my $sql = qq[ + SELECT system_id FROM group_system_ref WHERE group_id = '$groupID' + ]; + return $self->_doSelect($sql, 'system_id'); +} + +sub fetchClientByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'client', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM client + $filterClause + End-of-Here + return $self->_doSelect($sql); +} + +sub fetchClientByID +{ + my $self = shift; + my $ids = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM client WHERE id IN ($idStr)"; + return $self->_doSelect($sql); +} + +sub fetchClientAttrs +{ + my $self = shift; + my $clientID = $self->{dbh}->quote(shift); + + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM client_attr + WHERE client_id = $clientID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; +} + +sub fetchClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + + my $sql = qq[ + SELECT client_id FROM client_system_ref WHERE system_id = '$systemID' + ]; + return $self->_doSelect($sql, 'client_id'); +} + +sub fetchClientIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + + my $sql = qq[ + SELECT client_id FROM group_client_ref WHERE group_id = '$groupID' + ]; + return $self->_doSelect($sql, 'client_id'); +} + +sub fetchGroupByFilter +{ + my $self = shift; + my $filter = shift; + my $resultCols = shift; + my $attrFilter = shift; + + $resultCols = '*' unless (defined $resultCols); + my $filterClause = $self->_buildFilterClause($filter); + $filterClause = $self->_buildAttrFilterClause( + $attrFilter, 'group', $filterClause + ); + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT $resultCols FROM groups + $filterClause + End-of-Here + return $self->_doSelect($sql); +} + +sub fetchGroupByID +{ + my $self = shift; + my $ids = shift; + my $resultCols = shift; + + $resultCols = '*' unless (defined $resultCols); + my $idStr = join ',', @$ids; + return if !length($idStr); + my $sql = "SELECT $resultCols FROM groups WHERE id IN ($idStr)"; + return $self->_doSelect($sql); +} + +sub fetchGroupAttrs +{ + my $self = shift; + my $groupID = $self->{dbh}->quote(shift); + + my $sql = unshiftHereDoc(<<" End-of-Here"); + SELECT name, value FROM group_attr + WHERE group_id = $groupID + End-of-Here + my @attrs = $self->_doSelect($sql); + my $Result = {}; + foreach my $attr (@attrs) { + $Result->{$attr->{name}} = $attr->{value}; + } + return $Result; +} + +sub fetchGroupIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + + my $sql = qq[ + SELECT group_id FROM group_system_ref WHERE system_id = '$systemID' + ]; + return $self->_doSelect($sql, 'group_id'); +} + +sub fetchGroupIDsOfClient +{ + my $self = shift; + my $clientID = shift; + + my $sql = qq[ + SELECT group_id FROM group_client_ref WHERE client_id = '$clientID' + ]; + return $self->_doSelect($sql, 'group_id'); +} + +################################################################################ +### data manipulation functions +################################################################################ +sub _doInsert +{ + my $self = shift; + my $table = shift; + my $valRows = shift; + my $ignoreIDs = shift; + + my $dbh = $self->{'dbh'}; + my $valRow = (@$valRows)[0]; + return if !defined $valRow || !scalar keys %$valRow; + + if ($table =~ m[_ref$]) { + # reference tables do not have IDs: + $ignoreIDs = 1; + } + + my $needToGenerateIDs = $self->generateNextIdForTable(undef); + if (!$ignoreIDs && $needToGenerateIDs) { + # DB requires pre-specified IDs, so we add the 'id' column: + $valRow->{id} = undef unless exists $valRow->{id}; + } + my @ids; + foreach my $valRow (@$valRows) { + if (!defined $valRow->{id} && !$ignoreIDs && $needToGenerateIDs) { + # let DB-backend pre-specify ID, as current DB can't generate IDs: + $valRow->{id} = $self->generateNextIdForTable($table); + vlog(3, "generated id for <$table> is <$valRow->{id}>"); + } + my $cols = join ', ', keys %$valRow; + my $values = join ', ', + map { $self->quote($valRow->{$_}) } keys %$valRow; + my $sql = "INSERT INTO $table ( $cols ) VALUES ( $values )"; + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't insert into table <%s> (%s)], $table, + $dbh->errstr); + if (!$ignoreIDs) { + my $lastID = $dbh->last_insert_id(undef, undef, $table, 'id'); + if (!defined $valRow->{id}) { + # id has not been pre-specified, we need to fetch it from DB: + $valRow->{'id'} = $lastID; + vlog(3, "DB-generated id for <$table> is <$valRow->{id}>"); + } + elsif ($valRow->{'id'} ne $lastID) { + # id has been pre-specified, but DB changed it, so we update + # it with the pre-specified value + my $sql2 = unshiftHereDoc(<<" End-of-Here"); + UPDATE $table SET id='$valRow->{'id'}' WHERE id='$lastID' + End-of-Here + vlog(3, $sql2); + $dbh->do($sql2) or croak _tr( + q[Can't update table <%s> (%s)], $table, $dbh->errstr + ); + } + } + push @ids, $valRow->{'id'}; + } + return wantarray() ? @ids : shift @ids; +} + +sub _doDelete +{ + my $self = shift; + my $table = shift; + my $IDs = shift; + my $idCol = shift; + my $additionalWhereClause = shift; + + my $dbh = $self->{'dbh'}; + + $IDs = [undef] unless defined $IDs; + $idCol = 'id' unless defined $idCol; + foreach my $id (@$IDs) { + my $sql = "DELETE FROM $table"; + if (defined $id) { + $sql .= " WHERE $idCol = " . $self->quote($id); + if (defined $additionalWhereClause) { + $sql .= $additionalWhereClause; + } + } + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't delete from table <%s> (%s)], $table, + $dbh->errstr); + } + return 1; +} + +sub _doUpdate +{ + my $self = shift; + my $table = shift; + my $IDs = shift; + my $valRows = shift; + + my $dbh = $self->{'dbh'}; + my $valRow = (@$valRows)[0]; + return 1 if !defined $valRow || !scalar keys %$valRow; + + my $idx = 0; + foreach my $valRow (@$valRows) { + my $id = $IDs->[$idx++]; + my %valData = %$valRow; + # fail if asked to change the column 'id', as that is bogus + return if exists $valData{id} && $valData{id} ne $id; + # filter column 'id' if present, as we don't want to write it + delete $valData{id}; + my @cols = map { "$_ = " . $self->quote($valRow->{$_}) } + grep { $_ ne 'id' } + # filter column 'id' if present, as we don't want + # to update it! + keys %$valRow; + next if !@cols; + my $cols = join ', ', @cols; + my $sql = "UPDATE $table SET $cols"; + if (defined $id) { + $sql .= " WHERE id = " . $self->quote($id); + } + vlog(3, $sql); + my $sth = $dbh->prepare($sql) + or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + $sth->execute() + or croak _tr(q[Can't update table <%s> (%s)], $table, $dbh->errstr); + } + return 1; +} + +sub _updateRefTable +{ + my $self = shift; + my $table = shift; + my $keyID = shift; + my $newValueIDs = shift; + my $keyCol = shift; + my $valueCol = shift; + my $oldValueIDs = shift; + + my %lastValueIDs; + @lastValueIDs{@$oldValueIDs} = (); + + foreach my $valueID (@$newValueIDs) { + if (!exists $lastValueIDs{$valueID}) { + # value-ID is new, create it + my $valRow = { + $keyCol => $keyID, + $valueCol => $valueID, + }; + $self->_doInsert($table, [$valRow]); + } else { + # value-ID already exists, leave as is, but remove from hash: + delete $lastValueIDs{$valueID}; + } + } + + # all the remaining value-IDs need to be removed: + if (scalar keys %lastValueIDs) { + $self->_doDelete($table, [keys %lastValueIDs], + $valueCol, " AND $keyCol='$keyID'"); + } + return 1; +} + +sub _updateOneToManyRefAttr +{ + my $self = shift; + my $table = shift; + my $oneID = shift; + my $newManyIDs = shift; + my $fkCol = shift; + my $oldManyIDs = shift; + + my %lastManyIDs; + @lastManyIDs{@$oldManyIDs} = (); + + foreach my $id (@$newManyIDs) { + if (!exists $lastManyIDs{$id}) { + # ID has changed, update it + $self->_doUpdate($table, $id, [{$fkCol => $oneID}]); + } else { + # ID hasn't changed, leave as is, but remove from hash: + delete $lastManyIDs{$id}; + } + } + + # all the remaining many-IDs need to be set to 0: + foreach my $id (scalar keys %lastManyIDs) { + $self->_doUpdate($table, $id, [{$fkCol => '0'}]); + } + return 1; +} + +sub addVendorOS +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('vendor_os', $valRows); +} + +sub removeVendorOS +{ + my $self = shift; + my $vendorOSIDs = shift; + + return $self->_doDelete('vendor_os', $vendorOSIDs); +} + +sub changeVendorOS +{ + my $self = shift; + my $vendorOSIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('vendor_os', $vendorOSIDs, $valRows); +} + +sub addInstalledPlugin +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + my $newAttrs = shift; + + return if !defined $vendorOSID || !$pluginName; + + my $installedPlugin + = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); + if (!$installedPlugin) { + return if !$self->_doInsert('installed_plugin', [ { + vendor_os_id => $vendorOSID, + plugin_name => $pluginName, + } ] ); + $installedPlugin + = $self->fetchInstalledPlugins($vendorOSID, $pluginName, 1); + } + return if !$installedPlugin; + + # determine the required attribute actions ... + my $oldAttrs = $installedPlugin->{attrs} || {}; + my @attrsToBeInserted + = grep { + exists $newAttrs->{$_} && !exists $oldAttrs->{$_} + } keys %$newAttrs; + my @attrsToBeDeleted = grep { !exists $newAttrs->{$_} } keys %$oldAttrs; + my @attrsToBeUpdated + = grep { + exists $newAttrs->{$_} && exists $oldAttrs->{$_} + && ($oldAttrs->{$_}->{value} || '-') ne ($newAttrs->{$_} || '-') + } keys %$newAttrs; + + # ... insert the new ones ... + my @attrData + = map { + { + installed_plugin_id => $installedPlugin->{id}, + name => $_, + value => $newAttrs->{$_}, + } + } + @attrsToBeInserted; + $self->_doInsert('installed_plugin_attr', \@attrData); + + # ... delete the old ones ... + my @oldIDs = map { $oldAttrs->{$_}->{id} } @attrsToBeDeleted; + $self->_doDelete('installed_plugin_attr', \@oldIDs); + + # ... and update the changed ones ... + my @IDs = map { $oldAttrs->{$_}->{id} } @attrsToBeUpdated; + @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; + $self->_doUpdate('installed_plugin_attr', \@IDs, \@attrData); + + return 1; +} + +sub removeInstalledPlugin +{ + my $self = shift; + my $vendorOSID = shift; + my $pluginName = shift; + + return if !defined $vendorOSID || !$pluginName; + + my $plugin = $self->fetchInstalledPlugins($vendorOSID, $pluginName); + return if !$plugin; + return if !$self->_doDelete( + 'installed_plugin_attr', [ $plugin->{id} ], 'installed_plugin_id' + ); + return $self->_doDelete('installed_plugin', [ $plugin->{id} ] ); +} + +sub addExport +{ + my $self = shift; + my $valRows = shift; + + return $self->_doInsert('export', $valRows); +} + +sub removeExport +{ + my $self = shift; + my $exportIDs = shift; + + return $self->_doDelete('export', $exportIDs); +} + +sub changeExport +{ + my $self = shift; + my $exportIDs = shift; + my $valRows = shift; + + return $self->_doUpdate('export', $exportIDs, $valRows); +} + +sub changeGlobalInfo +{ + my $self = shift; + my $id = shift; + my $value = shift; + + return $self->_doUpdate('global_info', [$id], [{'value' => $value}]); +} + +sub addSystem +{ + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; + + # ... store the systems to get the IDs ... + my @systemIDs = $self->_doInsert('system', $valRows); + + # ... finally store the individual attribute sets + foreach my $id (@systemIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setSystemAttrs($id, $attrs); + } + + return @systemIDs; +} + +sub removeSystem +{ + my $self = shift; + my $systemIDs = shift; + + return $self->_doDelete('system', $systemIDs); +} + +sub changeSystem +{ + my $self = shift; + my $systemIDs = shift; + my $valRows = shift; + my $attrValRows = shift; + + # store the attribute hashes individually + foreach my $id (@$systemIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setSystemAttrs($id, $attrs); + } + + # finally update all systems in one go + return $self->_doUpdate('system', $systemIDs, $valRows); +} + +sub setSystemAttrs +{ + my $self = shift; + my $systemID = shift; + my $newAttrs = shift; + + # fetch info about existing attrs + my $sql = "SELECT * FROM system_attr WHERE system_id = $systemID"; + my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); + + # We write undefined attributes for the default system only, such that + # it shows all existing attributes. All other systems never write undefined + # attributes (if they have not defined a specific attribute, it is + # inherited from "above"). We encapsulate that decision in the following + # delegate + my $valueIsOK = sub { + my $value = shift; + return $systemID == 0 || defined $value; + }; + + # determine the required actions ... + my @attrsToBeInserted + = grep { + $valueIsOK->($newAttrs->{$_}) && !exists $oldAttrs{$_} + } keys %$newAttrs; + my @attrsToBeDeleted + = grep { + !exists $newAttrs->{$_} || !$valueIsOK->($newAttrs->{$_}) + } keys %oldAttrs; + my @attrsToBeUpdated + = grep { + $valueIsOK->($newAttrs->{$_}) && exists $oldAttrs{$_} + && ((defined($oldAttrs{$_}->{value}) xor defined($newAttrs->{$_})) + || (defined($oldAttrs{$_}->{value}) && defined($newAttrs->{$_}) + && $oldAttrs{$_}->{value} ne $newAttrs->{$_})) + } keys %$newAttrs; + + # ... insert the new ones ... + my @attrData + = map { + { + system_id => $systemID, + name => $_, + value => $newAttrs->{$_}, + } + } + @attrsToBeInserted; + $self->_doInsert('system_attr', \@attrData); + + # ... delete the old ones ... + my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; + $self->_doDelete('system_attr', \@oldIDs); + + # ... and update the changed ones ... + my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; + @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; + $self->_doUpdate('system_attr', \@IDs, \@attrData); + + return 1; +} + +sub setClientIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $clientIDs = shift; + + my @currClients = $self->fetchClientIDsOfSystem($systemID); + return $self->_updateRefTable( + 'client_system_ref', $systemID, $clientIDs, 'system_id', 'client_id', + \@currClients + ); +} + +sub setGroupIDsOfSystem +{ + my $self = shift; + my $systemID = shift; + my $groupIDs = shift; + + my @currGroups = $self->fetchGroupIDsOfSystem($systemID); + return $self->_updateRefTable( + 'group_system_ref', $systemID, $groupIDs, 'system_id', 'group_id', + \@currGroups + ); +} + +sub addClient +{ + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; + + # ... store the clients to get the IDs ... + my @clientIDs = $self->_doInsert('client', $valRows); + + # ... finally store the individual attribute sets + foreach my $id (@clientIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setClientAttrs($id, $attrs); + } + + return @clientIDs; +} + +sub removeAttributeByName +{ + my $self = shift; + my $attrName = shift; + + return $self->_doDelete('system_attr', [ $attrName ], 'name') + && $self->_doDelete('client_attr', [ $attrName ], 'name') + && $self->_doDelete('group_attr', [ $attrName ], 'name'); +} + +sub removeClient +{ + my $self = shift; + my $clientIDs = shift; + + return $self->_doDelete('client', $clientIDs); +} + +sub changeClient +{ + my $self = shift; + my $clientIDs = shift; + my $valRows = shift; + my $attrValRows = shift; + + # store the attribute hashes individually + foreach my $id (@$clientIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setClientAttrs($id, $attrs); + } + + # finally update all systems in one go + return $self->_doUpdate('client', $clientIDs, $valRows); +} + +sub setClientAttrs +{ + my $self = shift; + my $clientID = shift; + my $newAttrs = shift; + + # fetch info about existing attrs + my $sql = "SELECT * FROM client_attr WHERE client_id = $clientID"; + my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); + + # determine the required actions ... + my @attrsToBeInserted + = grep { + defined $newAttrs->{$_} && !exists $oldAttrs{$_} + } keys %$newAttrs; + my @attrsToBeDeleted = grep { !defined $newAttrs->{$_} } keys %oldAttrs; + my @attrsToBeUpdated + = grep { + defined $newAttrs->{$_} && exists $oldAttrs{$_} + && ($oldAttrs{$_}->{value} || '') ne ($newAttrs->{$_} || '') + } keys %$newAttrs; + + # ... insert the new ones ... + my @attrData + = map { + { + client_id => $clientID, + name => $_, + value => $newAttrs->{$_}, + } + } + @attrsToBeInserted; + $self->_doInsert('client_attr', \@attrData); + + # ... delete the old ones ... + my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; + $self->_doDelete('client_attr', \@oldIDs); + + # ... and update the changed ones ... + my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; + @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; + $self->_doUpdate('client_attr', \@IDs, \@attrData); + + return 1; +} + +sub setSystemIDsOfClient +{ + my $self = shift; + my $clientID = shift; + my $systemIDs = shift; + + my @currSystems = $self->fetchSystemIDsOfClient($clientID); + return $self->_updateRefTable( + 'client_system_ref', $clientID, $systemIDs, 'client_id', 'system_id', + \@currSystems + ); +} + +sub setGroupIDsOfClient +{ + my $self = shift; + my $clientID = shift; + my $groupIDs = shift; + + my @currGroups = $self->fetchGroupIDsOfClient($clientID); + return $self->_updateRefTable( + 'group_client_ref', $clientID, $groupIDs, 'client_id', 'group_id', + \@currGroups + ); +} + +sub addGroup +{ + my $self = shift; + my $valRows = shift; + my $attrValRows = shift; + + # ... store the groups to get the IDs ... + my @groupIDs = $self->_doInsert('groups', $valRows); + + # ... finally store the individual attribute sets + foreach my $id (@groupIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setGroupAttrs($id, $attrs); + } + + return @groupIDs; +} + +sub removeGroup +{ + my $self = shift; + my $groupIDs = shift; + + return $self->_doDelete('groups', $groupIDs); +} + +sub changeGroup +{ + my $self = shift; + my $groupIDs = shift; + my $valRows = shift; + my $attrValRows = shift; + + # store the attribute hashes individually + foreach my $id (@$groupIDs) { + my $attrs = shift @$attrValRows; + next if !defined $attrs; + return if !$self->setGroupAttrs($id, $attrs); + } + + # finally update all groups in one go + return $self->_doUpdate('groups', $groupIDs, $valRows); +} + +sub setGroupAttrs +{ + my $self = shift; + my $groupID = shift; + my $newAttrs = shift; + + # fetch info about existing attrs + my $sql = "SELECT * FROM group_attr WHERE group_id = $groupID"; + my %oldAttrs = map { ($_->{name}, $_) } $self->_doSelect($sql); + + # determine the required actions ... + my @attrsToBeInserted + = grep { + defined $newAttrs->{$_} && !exists $oldAttrs{$_} + } keys %$newAttrs; + my @attrsToBeDeleted = grep { !defined $newAttrs->{$_} } keys %oldAttrs; + my @attrsToBeUpdated + = grep { + defined $newAttrs->{$_} && exists $oldAttrs{$_} + && ($oldAttrs{$_}->{value} || '') ne ($newAttrs->{$_} || '') + } keys %$newAttrs; + + # ... insert the new ones ... + my @attrData + = map { + { + group_id => $groupID, + name => $_, + value => $newAttrs->{$_}, + } + } + @attrsToBeInserted; + $self->_doInsert('group_attr', \@attrData); + + # ... delete the old ones ... + my @oldIDs = map { $oldAttrs{$_}->{id} } @attrsToBeDeleted; + $self->_doDelete('group_attr', \@oldIDs); + + # ... and update the changed ones ... + my @IDs = map { $oldAttrs{$_}->{id} } @attrsToBeUpdated; + @attrData = map { { value => $newAttrs->{$_} } } @attrsToBeUpdated; + $self->_doUpdate('group_attr', \@IDs, \@attrData); + + return 1; +} + +sub setClientIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + my $clientIDs = shift; + + my @currClients = $self->fetchClientIDsOfGroup($groupID); + return $self->_updateRefTable( + 'group_client_ref', $groupID, $clientIDs, 'group_id', 'client_id', + \@currClients + ); +} + +sub setSystemIDsOfGroup +{ + my $self = shift; + my $groupID = shift; + my $systemIDs = shift; + + my @currSystems = $self->fetchSystemIDsOfGroup($groupID); + return $self->_updateRefTable( + 'group_system_ref', $groupID, $systemIDs, 'group_id', 'system_id', + \@currSystems + ); +} + +################################################################################ +### schema related functions +################################################################################ +sub _convertColDescrsToDBNativeString +{ + my $self = shift; + my $colDescrs = shift; + + my $colDescrString = join ', ', map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:\s*(\S+?)\s*$]) { + croak _tr('UnknownDbSchemaColumnDescr', $_); + } + "$1 " . $self->schemaConvertTypeDescrToNative($2); + } @$colDescrs; + return $colDescrString; +} + +sub _convertColDescrsToColNames +{ + my $self = shift; + my $colDescrs = shift; + + return map { + # convert each column description into database native format + # (e.g. convert 'name:s.45' to 'name char(45)'): + if (!m[^\s*(\S+?)\s*:.+$]) { + croak _tr('UnknownDbSchemaColumnDescr', $_); + } + $1; + } @$colDescrs; +} + +sub _convertColDescrsToColNamesString +{ + my $self = shift; + my $colDescrs = shift; + + return join ', ', $self->_convertColDescrsToColNames($colDescrs); +} + +sub schemaFetchDBVersion +{ + my $self = shift; + + my $dbh = $self->{dbh}; + local $dbh->{RaiseError} = 1; + my $row = + eval { $dbh->selectrow_hashref('SELECT schema_version FROM meta'); }; + return 0 if $@; + # no database access possible + return unless defined $row; + # no entry in meta-table + return $row->{schema_version}; +} + +sub schemaSetDBVersion +{ + my $self = shift; + my $dbVersion = shift; + + $self->{dbh}->do("UPDATE meta SET schema_version = '$dbVersion'") + or croak _tr('Unable to set DB-schema version to %s!', $dbVersion); + + return 1; +} + +sub schemaFetchPluginInfoHashVal +{ + my $self = shift; + + my $row + = $self->{dbh}->selectrow_hashref('SELECT plugin_info_hash FROM meta'); + + return $row->{plugin_info_hash}; +} + +sub schemaSetPluginInfoHashVal +{ + my $self = shift; + my $pluginInfoHashVal = shift; + + $self->{dbh}->do("UPDATE meta SET plugin_info_hash = '$pluginInfoHashVal'") + or croak _tr( + 'Unable to set plugin-info-hash-value to %s!', $pluginInfoHashVal + ); + + return 1; +} + +sub schemaConvertTypeDescrToNative +{ # a default implementation, many DBs need to override... + my $self = shift; + my $typeDescr = lc(shift); + + if ($typeDescr eq 'b') { + return 'integer'; + } elsif ($typeDescr eq 'i') { + return 'integer'; + } elsif ($typeDescr eq 'pk') { + return 'integer primary key'; + } elsif ($typeDescr eq 'fk') { + return 'integer'; + } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { + return "varchar($1)"; + } else { + croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } +} + +sub schemaAddTable +{ + my $self = shift; + my $table = shift; + my $colDescrs = shift; + my $initialVals = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "adding table <$table> to schema...") unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $table ($colDescrString)"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't create table <%s> (%s)], $table, $dbh->errstr); + if (defined $initialVals) { + # don't care about IDs if there's no 'id' column in this table + my $ignoreIDs = ($colDescrString !~ m[\bid\b]); + $self->_doInsert($table, $initialVals, $ignoreIDs); + } + return; +} + +sub schemaDropTable +{ + my $self = shift; + my $table = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "dropping table <$table> from schema...") unless $isSubCmd; + my $sql = "DROP TABLE $table"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop table <%s> (%s)], $table, $dbh->errstr); + return; +} + +sub schemaRenameTable +{ # a rather simple-minded implementation that renames a table in several + # steps: + # - create the new table + # - copy the data over from the old one + # - drop the old table + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE RENAME TO ' SQL-command (which + # is much more efficient). + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $colDescrString = $self->_convertColDescrsToDBNativeString($colDescrs); + my $sql = "CREATE TABLE $newTable ($colDescrString)"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't create table <%s> (%s)], $oldTable, $dbh->errstr); + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $oldTable"); + $self->_doInsert($newTable, \@dataRows); + $sql = "DROP TABLE $oldTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop table <%s> (%s)], $oldTable, $dbh->errstr); + return; +} + +sub schemaAddColumns +{ # a rather simple-minded implementation that adds columns to a table + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these more often than not + # implement the 'ALTER TABLE ADD COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my @newColNames = $self->_convertColDescrsToColNames($newColDescrs); + my $newColStr = join ', ', @newColNames; + vlog(1, "adding columns <$newColStr> to table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + # N.B.: for the insert, we rely on the caller having added the new + # columns to the end of the table (if that isn't the case, things + # break here!) + + if (defined $newColDefaultVals) { + # default values have been provided, we apply them now: + $self->_doUpdate($tempTable, undef, $newColDefaultVals); + } + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; +} + +sub schemaDropColumns +{ # a rather simple-minded implementation that drops columns from a table + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE
DROP COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $dropColStr = join ', ', @$dropColNames; + vlog(1, "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT $colNamesString FROM $table"); + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; +} + +sub schemaChangeColumns +{ # a rather simple-minded implementation that changes columns + # in several steps: + # - create a temp table with the new layout + # - copy the data from the old table into the new one + # - drop the old table + # - rename the temp table to the original name + # This should be overriden for advanced DBs, as these sometimes + # implement the 'ALTER TABLE
CHANGE COLUMN ' SQL-command (which + # is much more efficient). + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $tempTable = "${table}_temp"; + my $changeColStr = join ', ', keys %$colChanges; + vlog(1, "changing columns <$changeColStr> of table <$table>...") + unless $isSubCmd; + $self->schemaAddTable($tempTable, $colDescrs, undef, 1); + + # copy the data from the old table to the new: + my $colNamesString = $self->_convertColDescrsToColNamesString($colDescrs); + my @dataRows = $self->_doSelect("SELECT * FROM $table"); + foreach my $oldCol (keys %$colChanges) { + my $newCol = + $self->_convertColDescrsToColNamesString([$colChanges->{$oldCol}]); + # rename current column in all data-rows: + foreach my $row (@dataRows) { + $row->{$newCol} = $row->{$oldCol}; + delete $row->{$oldCol}; + } + } + $self->_doInsert($tempTable, \@dataRows); + + $self->schemaDropTable($table, 1); + $self->schemaRenameTable($tempTable, $table, $colDescrs, 1); + return; +} + +1; + +=head1 NAME + +DBI.pm - provides DBI-based implementation of the OpenSLX MetaDB API. + +=head1 SYNOPSIS + +This class is the base for all DBI-related metaDB variants. +It provides a default implementation for every method, such that +each DB-specific implementation needs to override only the methods +that require a different implementation than the one provided here. + +=head1 NOTES + +In case you ask yourself why none of the SQL-statements in this +file make use of SQL bind params (?), the answer is that at least +one DBD-driver didn't like them at all. As the performance gains +from bound params are not really necessary here, we simply do +not use them. + diff --git a/src/config-db/OpenSLX/MetaDB/SQLite.pm b/src/config-db/OpenSLX/MetaDB/SQLite.pm new file mode 100644 index 00000000..0846582f --- /dev/null +++ b/src/config-db/OpenSLX/MetaDB/SQLite.pm @@ -0,0 +1,130 @@ +# 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/ +# ----------------------------------------------------------------------------- +# SQLite.pm +# - provides SQLite-specific overrides of the OpenSLX MetaDB API. +# ----------------------------------------------------------------------------- +package OpenSLX::MetaDB::SQLite; + +use strict; +use warnings; + +use base qw(OpenSLX::MetaDB::DBI); + +################################################################################ +### This class provides a MetaDB backend for SQLite databases. +### - by default the db will be created inside a 'openslxdata-sqlite' directory. +################################################################################ +use DBD::SQLite; +use OpenSLX::Basics; + +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub databaseExists +{ + my $self = shift; + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + return -e $fullDBPath; +} + +sub dropDatabase +{ + my $self = shift; + + if ($self->{dbh}) { + die "need to disconnect before you can drop the database!"; + } + + my $fullDBPath = $self->_getDBPath() . "/$openslxConfig{'db-name'}"; + system("rm -rf $fullDBPath") if -e $fullDBPath; +} + +sub connect ## no critic (ProhibitBuiltinHomonyms) +{ + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + my $dbPath = $self->_getDBPath; + system("mkdir -p $dbPath") unless -e $dbPath; + $dbSpec = "dbname=$dbPath/$openslxConfig{'db-name'}"; + } + vlog(1, "trying to connect to SQLite-database <$dbSpec>"); + $self->{'dbh'} = DBI->connect( + "dbi:SQLite:$dbSpec", undef, undef, + {PrintError => 0, AutoCommit => 1, sqlite_unicode => 1} + ) or die _tr("Cannot connect to database <%s> (%s)", $dbSpec, $DBI::errstr); + return 1; +} + +sub schemaRenameTable +{ + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak(_tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr)); + return; +} + +sub schemaAddColumns +{ + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); + vlog(1, "adding columns <$newColNames> to table <$table>") + unless $isSubCmd; + foreach my $colDescr (@$newColDescrs) { + my $colDescrString = + $self->_convertColDescrsToDBNativeString([$colDescr]); + my $sql = "ALTER TABLE $table ADD COLUMN $colDescrString"; + vlog(3, $sql); + $dbh->do($sql) + or croak(_tr(q[Can't add column to table <%s> (%s)], $table, + $dbh->errstr)); + } + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } + return; +} + +sub _getDBPath +{ + my $self = shift; + + return "$openslxConfig{'private-path'}/db/sqlite"; +} + +1; diff --git a/src/config-db/OpenSLX/MetaDB/mysql.pm b/src/config-db/OpenSLX/MetaDB/mysql.pm new file mode 100644 index 00000000..82487191 --- /dev/null +++ b/src/config-db/OpenSLX/MetaDB/mysql.pm @@ -0,0 +1,179 @@ +# 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/ +# ----------------------------------------------------------------------------- +# mysql.pm +# - provides mysql-specific overrides of the OpenSLX MetaDB API. +# ----------------------------------------------------------------------------- +package OpenSLX::MetaDB::mysql; + +use strict; +use warnings; + +use base qw(OpenSLX::MetaDB::DBI); + +################################################################################ +### This class provides a MetaDB backend for mysql databases. +### - by default the db will be created inside a 'openslxdata-mysql' directory. +################################################################################ +use DBD::mysql; +use OpenSLX::Basics; +use OpenSLX::Utils; + +################################################################################ +### implementation +################################################################################ +sub new +{ + my $class = shift; + my $self = {}; + return bless $self, $class; +} + +sub connect ## no critic (ProhibitBuiltinHomonyms) +{ + my $self = shift; + + my $dbSpec = $openslxConfig{'db-spec'}; + if (!defined $dbSpec) { + # build $dbSpec from individual parameters: + $dbSpec = "database=$openslxConfig{'db-name'}"; + } + my $dbUser + = $openslxConfig{'db-user'} + ? $openslxConfig{'db-user'} + : (getpwuid($>))[0]; + my $dbPasswd = $openslxConfig{'db-passwd'}; + if (!defined $dbPasswd) { + $dbPasswd = readPassword("db-password> "); + } + + vlog(1, "trying to connect user '$dbUser' to mysql-database '$dbSpec'"); + $self->{'dbh'} = DBI->connect( + "dbi:mysql:$dbSpec", $dbUser, $dbPasswd, { + PrintError => 0, + mysql_auto_reconnect => 1, + } + ) or die _tr("Cannot connect to database '%s' (%s)", $dbSpec, $DBI::errstr); + return 1; +} + +sub schemaConvertTypeDescrToNative +{ + my $self = shift; + my $typeDescr = lc(shift); + + if ($typeDescr eq 'b') { + return 'integer'; + } elsif ($typeDescr eq 'i') { + return 'integer'; + } elsif ($typeDescr eq 'pk') { + return 'integer AUTO_INCREMENT primary key'; + } elsif ($typeDescr eq 'fk') { + return 'integer'; + } elsif ($typeDescr =~ m[^s\.(\d+)$]i) { + return "varchar($1)"; + } else { + croak _tr('UnknownDbSchemaTypeDescr', $typeDescr); + } + return; +} + +sub schemaRenameTable +{ + my $self = shift; + my $oldTable = shift; + my $newTable = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + vlog(1, "renaming table <$oldTable> to <$newTable>...") unless $isSubCmd; + my $sql = "ALTER TABLE $oldTable RENAME TO $newTable"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't rename table <%s> (%s)], $oldTable, $dbh->errstr); + return; +} + +sub schemaAddColumns +{ + my $self = shift; + my $table = shift; + my $newColDescrs = shift; + my $newColDefaultVals = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $newColNames = $self->_convertColDescrsToColNamesString($newColDescrs); + vlog(1, "adding columns <$newColNames> to table <$table>") unless $isSubCmd; + my $addClause = join ', ', + map { "ADD COLUMN " . $self->_convertColDescrsToDBNativeString([$_]); } + @$newColDescrs; + my $sql = "ALTER TABLE $table $addClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't add columns to table <%s> (%s)], $table, + $dbh->errstr); + # if default values have been provided, we apply them now: + if (defined $newColDefaultVals) { + $self->_doUpdate($table, undef, $newColDefaultVals); + } + return; +} + +sub schemaDropColumns +{ + my $self = shift; + my $table = shift; + my $dropColNames = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $dropColStr = join ', ', @$dropColNames; + vlog(1, + "dropping columns <$dropColStr> from table <$table>...") + unless $isSubCmd; + my $dropClause = join ', ', map { "DROP COLUMN $_" } @$dropColNames; + my $sql = "ALTER TABLE $table $dropClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't drop columns from table <%s> (%s)], $table, + $dbh->errstr); + return; +} + +sub schemaChangeColumns +{ + my $self = shift; + my $table = shift; + my $colChanges = shift; + my $colDescrs = shift; + my $isSubCmd = shift; + + my $dbh = $self->{'dbh'}; + my $changeColStr = join ', ', keys %$colChanges; + vlog(1, "changing columns <$changeColStr> in table <$table>...") + unless $isSubCmd; + my $changeClause = join ', ', map { + "CHANGE COLUMN $_ " + . $self->_convertColDescrsToDBNativeString([$colChanges->{$_}]); + } + keys %$colChanges; + my $sql = "ALTER TABLE $table $changeClause"; + vlog(3, $sql); + $dbh->do($sql) + or croak _tr(q[Can't change columns in table <%s> (%s)], $table, + $dbh->errstr); + return; +} + +1; diff --git a/src/config-db/slxconfig b/src/config-db/slxconfig new file mode 100755 index 00000000..d4749f97 --- /dev/null +++ b/src/config-db/slxconfig @@ -0,0 +1,1785 @@ +#! /usr/bin/perl +# ----------------------------------------------------------------------------- +# 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/ +# ----------------------------------------------------------------------------- +use strict; +use warnings; + +my $abstract = q[ +slxconfig + This script can be used to display or change the OpenSLX configuration + database. You can create systems that use a specific vendor-OS + and you can create clients for these systems, too. +]; + +use Clone qw(clone); +use Getopt::Long qw(:config pass_through); +use List::Util qw(max); +use Pod::Usage; + +# add the folder this script lives in and the lib-folder to perl's +# search path for modules: +use FindBin; +use lib "$FindBin::RealBin"; +use lib "$FindBin::RealBin/../lib"; + +use lib "$FindBin::RealBin/../config-db"; + +# development path to config-db + +use OpenSLX::AttributeRoster; +use OpenSLX::Basics; +use OpenSLX::ConfigDB; +use OpenSLX::ConfigFolder; +use OpenSLX::Utils; + +my %option; + +GetOptions( + 'help|?' => \$option{helpReq}, + 'inherited' => \$option{inherited}, + 'man' => \$option{manReq}, + 'verbose' => \$option{verbose}, + 'version' => \$option{versionReq}, +) or pod2usage(2); +pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; +if ($option{manReq}) { + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); +} +if ($option{versionReq}) { + system('slxversion'); + exit 1; +} + +# if the user requested to see inherited attributes, we activate verbose mode, +# too, such that we actually show attributes +if ($option{inherited}) { + $option{verbose} = 1; +} + +openslxInit(); + +my $openslxDB = OpenSLX::ConfigDB->new(); +$openslxDB->connect(); + +my $action = shift @ARGV || ''; +if ($action =~ m[^add-c]i) { + addClientToConfigDB(@ARGV); +} +elsif ($action =~ m[^add-g]i) { + addGroupToConfigDB(@ARGV); +} +elsif ($action =~ m[^add-s]i) { + addSystemToConfigDB(@ARGV); +} +elsif ($action =~ m[^change-v]i) { + changeVendorOSInConfigDB(@ARGV); +} +elsif ($action =~ m[^change-e]i) { + changeExportInConfigDB(@ARGV); +} +elsif ($action =~ m[^change-g]i) { + changeGroupInConfigDB(@ARGV); +} +elsif ($action =~ m[^change-s]i) { + changeSystemInConfigDB(@ARGV); +} +elsif ($action =~ m[^change-c]i) { + changeClientInConfigDB(@ARGV); +} +elsif ($action =~ m[^cleanup-db]i) { + cleanupConfigDB(@ARGV); +} +elsif ($action =~ m[^list-a]) { + listAttributes(@ARGV); +} +elsif ($action =~ m[^list-c]) { + print _tr("List of clients:\n"); + listClients(@ARGV); +} +elsif ($action =~ m[^list-e]) { + print _tr("List of exports:\n"); + listExports(@ARGV); +} +elsif ($action =~ m[^list-g]) { + print _tr("List of groups:\n"); + listGroups(@ARGV); +} +elsif ($action =~ m[^list-s]) { + print _tr("List of systems:\n"); + listSystems(@ARGV); +} +elsif ($action =~ m[^list-v]) { + print _tr("List of vendor-OSes:\n"); + listVendorOSes(@ARGV); +} +elsif ($action =~ m[^search-c]) { + print _tr("Matching clients:\n"); + searchClients(@ARGV); +} +elsif ($action =~ m[^search-e]) { + print _tr("Matching exports:\n"); + searchExports(@ARGV); +} +elsif ($action =~ m[^search-g]) { + print _tr("Matching groups:\n"); + searchGroups(@ARGV); +} +elsif ($action =~ m[^search-s]) { + print _tr("Matching systems:\n"); + searchSystems(@ARGV); +} +elsif ($action =~ m[^search-v]) { + print _tr("Matching vendor-OSes:\n"); + searchVendorOSes(@ARGV); +} +elsif ($action =~ m[^remove-c]i) { + removeClientFromConfigDB(@ARGV); +} +elsif ($action =~ m[^remove-g]i) { + removeGroupFromConfigDB(@ARGV); +} +elsif ($action =~ m[^remove-s]i) { + removeSystemFromConfigDB(@ARGV); +} +else { + vlog(0, _tr(unshiftHereDoc(<<' END-OF-HERE'), $0)); + You need to specify exactly one of these actions: + add-client + add-group + add-system + change-client + change-export + change-group + change-system + change-vendor-os + cleanup-db + list-attributes + list-client + list-export + list-group + list-system + list-vendor-os + remove-client + remove-group + remove-system + search-client + search-export + search-group + search-system + search-vendor-os + Try '%s --help' for more info. + END-OF-HERE +} + +$openslxDB->disconnect(); + +sub parseKeyValueArgs +{ + my $allowedKeys = shift; + my $table = shift; + + my %dataHash; + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + if (!grep { $_ eq $key } @$allowedKeys) { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + $dataHash{$key} = $value; + } + + return \%dataHash; +} + +sub parseKeyValueArgsWithAttrs +{ + my $allowedKeys = shift; + my $allowedAttrKeys = shift; + my $table = shift; + + my (%dataHash, %attrHash); + while (my $param = shift) { + if ($param !~ m[^\s*([\w\-:]+)\s*=(.*)$]) { + die _tr( + "value specification %s has unknown format, expected =\n", + $param + ); + } + my $key = lc($1); + my $value = $2; + + # replace escaped newlines and tab chars by the respective real thing + $value =~ s{\\n}{\n}gms; + $value =~ s{\\t}{\t}gms; + + # accept '-' as placeholder for undefined + if ($value eq '-') { + $value = undef; + } + + if (grep { $_ eq $key } @$allowedKeys) { + $dataHash{$key} = $value; + } elsif (grep { $_ eq $key } @$allowedAttrKeys) { + $attrHash{$key} = $value; + } else { + die _tr("unknown key '%s' specified for %s\n", $key, $table); + } + } + + if (wantarray) { + return (\%dataHash, \%attrHash); + } + else { + if (%attrHash) { + $dataHash{attrs} = \%attrHash; + } + return \%dataHash; + } +} + +sub checkGivenStage3Attrs +{ + my $stage3Attrs = shift; + my $vendorOSID = shift; + + my $attrProblems; + + if ($vendorOSID) { + my $vendorOS = $openslxDB->fetchVendorOSByID($vendorOSID); + my @installedPlugins = $openslxDB->fetchInstalledPlugins($vendorOSID); + $attrProblems = OpenSLX::AttributeRoster->findProblematicValues( + $stage3Attrs, $vendorOS->{name}, \@installedPlugins + ); + } + else { + $attrProblems = OpenSLX::AttributeRoster->findProblematicValues( + $stage3Attrs + ); + } + + if ($attrProblems) { + my $complaint = join "\n", @$attrProblems; + die $complaint; + } + + return 1; +} + +sub cleanupConfigDB +{ + return $openslxDB->cleanupAnyInconsistencies(); +} + +sub mergeNonExistingAttributes +{ + my $target = shift; + my $source = shift; + + my $sourceAttrs = $source->{attrs} || {}; + + $target->{attrs} ||= {}; + my $targetAttrs = $target->{attrs}; + + foreach my $key (keys %$sourceAttrs) { + next if exists $targetAttrs->{$key}; + $targetAttrs->{$key} = $sourceAttrs->{$key}; + } + + return 1; +} + +sub dumpElements +{ + my $objName = shift; + my $nameClause = shift || sub { "\t$_->{name}\n" }; + + if ($option{verbose}) { + my $ind = ' ' x 4; + foreach my $elem (@_) { + print "$objName '$elem->{name}':\n"; + my $spcLen = max map { length($_) } keys %$elem; + print join( + '', + map { + my $elemVal = defined $elem->{$_} ? $elem->{$_} : '-'; + if (ref($elemVal) eq 'HASH') { + my $spcLen + = max(map { length($_) } keys %$elemVal) || 0; + my $spc = ' ' x $spcLen; + my $subLines = join( + "\n", + map { + my $spc = ' ' x $spcLen; + my $val + = defined $elemVal->{$_} + ? $elemVal->{$_} + : ''; + $val =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $val"; + } + sort { + # drop [] construct (origin) from key for + # sorting purposes + (my $aa = $a) =~ s{^\s*\[.+\]\s*}{}; + (my $bb = $b) =~ s{^\s*\[.+\]\s*}{}; + return $aa cmp $bb; + } keys %$elemVal + ); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } elsif (ref($elemVal) eq 'ARRAY') { + my $subLines + = join( "\n", map { "$ind$_" } sort @$elemVal); + $subLines ||= "$ind"; + " $_:\n$subLines\n"; + } else { + my $spc = ' ' x $spcLen; + $elemVal =~ s[\n][\n$ind$spc ]g; + "$ind$_" . substr($spc, length($_)) . " = $elemVal\n"; + } + } + sort { + my $refCmp = ref($elem->{$a}) cmp ref($elem->{$b}); + return $refCmp ? $refCmp : $a cmp $b; + } + grep { + $_ ne 'name'; + } + keys %$elem + ); + } + } + else { + print join('', sort map { $nameClause->($_); } @_); + } + + return 1; +} + +sub listAttributes +{ + my $attrSpec = shift; + + my $listHeader = _tr("List of known attributes:\n"); + my $attrInfo + = OpenSLX::AttributeRoster->getAttrInfo( { scope => $attrSpec } ); + if ($attrInfo && keys %$attrInfo) { + $listHeader + = _tr("List of known attributes for scope '%s':\n", $attrSpec); + } + else { + $attrInfo = + OpenSLX::AttributeRoster->getAttrInfo( { name => $attrSpec } ); + $listHeader = _tr("Details for attribute '%s':\n", $attrSpec); + $option{verbose} = 1; + } + + print $listHeader; + dumpElements( + 'attribute', undef, + map { + my $attr = clone($attrInfo->{$_}); + $attr->{name} = $_; + delete $attr->{content_regex}; # no use for display purposes + $attr; + } + sort keys %$attrInfo + ); + + return 1; +} + +sub listClients +{ + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter(\%nameSpec) + ) + ); + + return 1; +} + +sub listGroups +{ + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter(\%nameSpec) + ) + ); + + return 1; +} + +sub listExports +{ + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter(\%nameSpec) + ); + + return 1; +} + +sub listSystems +{ + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter(\%nameSpec) + ) + ); + + return 1; +} + +sub listVendorOSes +{ + my $name = _cleanName(shift); + + my %nameSpec; + + # set verbose mode if any params have been passed in: + if (defined $name) { + $option{verbose} = 1; + $nameSpec{name} = $name; + } + + dumpElements('vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + my %attrHash; + foreach my $plugin (@plugins) { + foreach my $attr (keys %{$plugin->{attrs}}) { + $attrHash{$attr} = $plugin->{attrs}->{$attr}; + } + } + $_->{ATTRIBUTES} = \%attrHash; + $_->{PLUGINS} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter(\%nameSpec)); + + return 1; +} + +sub searchClients +{ + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($clientData, $clientAttrs) = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$clientData; + + dumpElements( + 'client', undef, + _expandClients( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByFilter($clientData, undef, $clientAttrs) + ) + ); + + return 1; +} + +sub searchGroups +{ + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my ($groupData, $groupAttrs) = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$groupData; + + dumpElements( + 'group', undef, + _expandGroups( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchGroupByFilter($groupData, undef, $groupAttrs) + ) + ); + + return 1; +} + +sub searchExports +{ + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$exportData; + + dumpElements( + 'export', + sub { + "\t$_->{name}" + . substr(' ' x 30, length($_->{name})) + . "($_->{type})\n"; + }, + map { + my $vendorOS = + $openslxDB->fetchVendorOSByID($_->{vendor_os_id}, 'name'); + if (defined $vendorOS) { + $_->{vendor_os_id} .= " ($vendorOS->{name})"; + } + $_; + } + sort { $a->{name} eq $b->{name} || $a->{type} cmp $b->{type} } + $openslxDB->fetchExportByFilter($exportData) + ); + + return 1; +} + +sub searchSystems +{ + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my ($systemData, $systemAttrs) = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$systemData; + + dumpElements( + 'system', undef, + _expandSystems( + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByFilter($systemData, undef, $systemAttrs) + ) + ); + + return 1; +} + +sub searchVendorOSes +{ + my @vendorOSKeys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@vendorOSKeys, 'vendor_os', @_); + + # set verbose mode if any params have been passed in: + $option{verbose} = 1 if %$vendorOSData; + + dumpElements( + 'vendor-OS', undef, + map { + my @plugins = $openslxDB->fetchInstalledPlugins($_->{id}); + $_->{plugins} + = @plugins + ? join(',', sort map { $_->{plugin_name} } @plugins) + : ''; + $_; + } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchVendorOSByFilter($vendorOSData) + ); + + return 1; +} + +sub changeVendorOSInConfigDB +{ + my $vendorOSName = _cleanName(shift || ''); + + if (!length($vendorOSName)) { + die _tr( + "you have to specify the name for the vendor-OS you'd like to change!\n" + ); + } + + my @keys = $openslxDB->getColumnsOfTable('vendor_os'); + my $vendorOSData = parseKeyValueArgs(\@keys, 'vendor_os', @_); + + my $vendorOS = $openslxDB->fetchVendorOSByFilter({'name' => $vendorOSName}); + if (!defined $vendorOS) { + die _tr("the vendor-OS '%s' doesn't exists in the DB, giving up!\n", + $vendorOSName); + } + + $openslxDB->changeVendorOS($vendorOS->{id}, [$vendorOSData]); + vlog( + 0, _tr("vendor-OS '%s' has been successfully changed\n", $vendorOSName) + ); + + listVendorOSes("id=$vendorOS->{id}") if $option{verbose}; + + return 1; +} + +sub changeExportInConfigDB +{ + my $exportName = _cleanName(shift || ''); + + if (!length($exportName)) { + die _tr( + "you have to specify the name for the export you'd like to change!\n" + ); + } + + my @exportKeys = $openslxDB->getColumnsOfTable('export'); + my $exportData = parseKeyValueArgs(\@exportKeys, 'export', @_); + + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("the export '%s' doesn't exists in the DB, giving up!\n", + $exportName); + } + + $openslxDB->changeExport($export->{id}, [$exportData]); + vlog(0, _tr("export '%s' has been successfully changed\n", $exportName)); + + listExports("id=$export->{id}") if $option{verbose}; + + return 1; +} + +sub addClientToConfigDB +{ + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr("you have to specify the name for the new client\n"); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + $clientData->{name} = $clientName; + + checkGivenStage3Attrs($clientData->{attrs}); + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $clientData->{systems}; + delete $clientData->{systems}; + } + + if (!$clientData->{mac}) { + die _tr("you have to specify the MAC for the new client\n"); + } + if ($clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + if ($openslxDB->fetchClientByFilter({'name' => $clientName})) { + die _tr("the client '%s' already exists in the DB, giving up!\n", + $clientName); + } + if ($openslxDB->fetchClientByFilter({'mac' => $clientData->{mac}})) { + die _tr( + "a client with the MAC '%s' already exists in the DB, giving up!\n", + $clientData->{mac} + ); + } + my $clientID = $openslxDB->addClient([$clientData]); + vlog( + 0, + _tr( + "client '%s' has been successfully added to DB (ID=%s)\n", + $clientName, $clientID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToClient($clientID, \@systemIDs); + } + if ($option{verbose}) { + listClients("id=$clientID"); + } + + return 1; +} + +sub addGroupToConfigDB +{ + my $groupName = _cleanName(shift || ''); + if (!length($groupName)) { + die _tr("you have to specify the name for the new group\n"); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('groups'); + push @groupKeys, 'systems', 'clients'; + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + $groupData->{name} = $groupName; + + checkGivenStage3Attrs($groupData->{attrs}); + + my @systemIDs; + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split '\s*,\s*', $groupData->{systems}; + delete $groupData->{systems}; + } + my @clientIDs; + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $groupData->{clients}; + delete $groupData->{clients}; + } + + if (!defined $groupData->{priority} || !length($groupData->{priority})) { + $groupData->{priority} = 50; + vlog(0, _tr("priority of new group has been set to default (50).")); + } + + if ($openslxDB->fetchGroupByFilter({'name' => $groupName})) { + die _tr("the group '%s' already exists in the DB, giving up!\n", + $groupName); + } + my $groupID = $openslxDB->addGroup([$groupData]); + vlog( + 0, + _tr( + "group '%s' has been successfully added to DB (ID=%s)\n", + $groupName, $groupID + ) + ); + if (@systemIDs) { + $openslxDB->addSystemIDsToGroup($groupID, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->addClientIDsToGroup($groupID, \@clientIDs); + } + listGroups("id=$groupID") if $option{verbose}; + + return 1; +} + +sub addSystemToConfigDB +{ + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr("you have to specify the name of the new system!\n"); + } + + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'export'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + $systemData->{name} = $systemName; + $systemData->{attrs} ||= {}; + + my $exportName = $systemData->{export} || ''; + delete $systemData->{export}; + if (!length($exportName)) { + $exportName = $systemName; + + # try falling back to given system name + } + my $export = $openslxDB->fetchExportByFilter({'name' => $exportName}); + if (!defined $export) { + die _tr("export '%s' could not be found in DB, giving up!\n", + $exportName); + } + $systemData->{export_id} = $export->{id}; + + checkGivenStage3Attrs($systemData->{attrs}, $export->{vendor_os_id}); + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split '\s*,\s*', $systemData->{clients}; + delete $systemData->{clients}; + } + else { + # no clients given, so we add this system to the default client, + # which will make this system bootable by *all* clients (unless + # they are configured otherwise). + my $defaultClient = + $openslxDB->fetchClientByFilter({'name' => '<<>>'}); + push @clientIDs, $defaultClient->{id}; + } + + if ($openslxDB->fetchSystemByFilter({'name' => $systemName})) { + die _tr("the system '%s' already exists in the DB, giving up!\n", + $systemName); + } + + my $systemConfigPath = + "$openslxConfig{'private-path'}/config/$systemName/default"; + if (!-e $systemConfigPath) { + # create the default (empty) config folders for this system: + createConfigFolderForSystem($systemName); + } + + my $systemID = $openslxDB->addSystem([$systemData]); + vlog( + 0, + _tr( + "system '%s' has been successfully added to DB (ID=%s)\n", + $systemName, $systemID + ) + ); + if (@clientIDs) { + $openslxDB->addClientIDsToSystem($systemID, \@clientIDs); + } + listSystems("id=$systemID") if $option{verbose}; + + return 1; +} + +sub changeClientInConfigDB +{ + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to change!\n" + ); + } + + my @clientKeys = $openslxDB->getColumnsOfTable('client'); + push @clientKeys, 'systems', 'add-systems', 'remove-systems'; + my @clientAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $clientData = parseKeyValueArgsWithAttrs( + \@clientKeys, \@clientAttrKeys, 'client', @_ + ); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + + checkGivenStage3Attrs($clientData->{attrs}); + + mergeNonExistingAttributes($clientData, $client); + + my @systemIDs; + if (exists $clientData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{systems}; + delete $clientData->{systems}; + } + if (exists $clientData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $clientData->{'add-systems'}; + delete $clientData->{'add-systems'}; + } + if (exists $clientData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfClient($client->{id}); + foreach my $sysName (split ",", $clientData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $clientData->{'remove-systems'}; + } + + if ($clientData->{name} && $client->{name} eq '<<>>') { + die _tr( + "you can't rename the default client - no changes were made!\n"); + } + + if ( $clientData->{mac} + && $clientData->{mac} !~ + m[^(?:[[:xdigit:]][[:xdigit:]]:){5}?[[:xdigit:]][[:xdigit:]]$]) + { + die _tr( + "unknown MAC-format given, expected something like '01:02:03:04:05:06'!\n" + ); + } + + $openslxDB->changeClient($client->{id}, [$clientData]); + vlog(0, _tr("client '%s' has been successfully changed\n", $clientName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfClient($client->{id}, \@systemIDs); + } + listClients("id=$client->{id}") if $option{verbose}; + + return 1; +} + +sub changeGroupInConfigDB +{ + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to change!\n" + ); + } + + my @groupKeys = $openslxDB->getColumnsOfTable('group'); + push @groupKeys, qw( + systems add-systems remove-systems clients add-clients remove-clients + ); + my @groupAttrKeys = OpenSLX::AttributeRoster->getClientAttrs(); + my $groupData = parseKeyValueArgsWithAttrs( + \@groupKeys, \@groupAttrKeys, 'group', @_ + ); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + + checkGivenStage3Attrs($groupData->{attrs}); + + mergeNonExistingAttributes($groupData, $group); + + my (@systemIDs, @clientIDs); + if (exists $groupData->{systems}) { + @systemIDs = map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{systems}; + delete $groupData->{systems}; + } + if (exists $groupData->{'add-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + push @systemIDs, map { + my $system = $openslxDB->fetchSystemByFilter({'name' => $_}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $_); + } + $system->{id}; + } + split ",", $groupData->{'add-systems'}; + delete $groupData->{'add-systems'}; + } + if (exists $groupData->{'remove-systems'}) { + @systemIDs = $openslxDB->fetchSystemIDsOfGroup($group->{id}); + foreach my $sysName (split ',', $groupData->{'remove-systems'}) { + my $system = $openslxDB->fetchSystemByFilter({'name' => $sysName}); + if (!defined $system) { + die _tr("system '%s' doesn't exist!\n", $sysName); + } + @systemIDs = grep { $_ != $system->{id} } @systemIDs; + } + delete $groupData->{'remove-systems'}; + } + if (exists $groupData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{clients}; + delete $groupData->{clients}; + } + if (exists $groupData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $groupData->{'add-clients'}; + delete $groupData->{'add-clients'}; + } + if (exists $groupData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfGroup($group->{id}); + foreach my $clientName (split ",", $groupData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $groupData->{'remove-clients'}; + } + + if (defined $groupData->{priority} && $groupData->{priority} !~ m{^\d+$}) { + die _tr("unknown priority-format given, expected an integer!\n"); + } + + $openslxDB->changeGroup($group->{id}, [$groupData]); + vlog(0, _tr("group '%s' has been successfully changed\n", $groupName)); + if (@systemIDs) { + $openslxDB->setSystemIDsOfGroup($group->{id}, \@systemIDs); + } + if (@clientIDs) { + $openslxDB->setClientIDsOfGroup($group->{id}, \@clientIDs); + } + listGroups("id=$group->{id}") if $option{verbose}; + + return 1; +} + +sub changeSystemInConfigDB +{ + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to change!\n" + ); + } + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + my @systemKeys = $openslxDB->getColumnsOfTable('system'); + push @systemKeys, 'clients', 'add-clients', 'remove-clients'; + my @systemAttrKeys = OpenSLX::AttributeRoster->getSystemAttrs(); + my $systemData = parseKeyValueArgsWithAttrs( + \@systemKeys, \@systemAttrKeys, 'system', @_ + ); + + my $export = $openslxDB->fetchExportByID($system->{export_id}); + checkGivenStage3Attrs($systemData->{attrs}, $export->{vendor_os_id}); + + mergeNonExistingAttributes($systemData, $system); + + my @clientIDs; + if (exists $systemData->{clients}) { + @clientIDs = map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist in DB, giving up!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{clients}; + delete $systemData->{clients}; + } + if (exists $systemData->{'add-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + push @clientIDs, map { + my $client = $openslxDB->fetchClientByFilter({'name' => $_}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $_); + } + $client->{id}; + } + split ",", $systemData->{'add-clients'}; + delete $systemData->{'add-clients'}; + } + if (exists $systemData->{'remove-clients'}) { + @clientIDs = $openslxDB->fetchClientIDsOfSystem($system->{id}); + foreach my $clientName (split ",", $systemData->{'remove-clients'}) { + my $client = + $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("client '%s' doesn't exist!\n", $clientName); + } + @clientIDs = grep { $_ != $client->{id} } @clientIDs; + } + delete $systemData->{'remove-clients'}; + } + if ($systemData->{name} && $system->{name} eq '<<>>') { + die _tr( + "you can't rename the default system - no changes were made!\n"); + } + + $openslxDB->changeSystem($system->{id}, $systemData); + vlog(0, _tr("system '%s' has been successfully changed\n", $systemName)); + if (@clientIDs) { + $openslxDB->setClientIDsOfSystem($system->{id}, \@clientIDs); + } + listSystems("id=$system->{id}")if $option{verbose}; + + return 1; +} + +sub removeClientFromConfigDB +{ + my $clientName = _cleanName(shift || ''); + + if (!length($clientName)) { + die _tr( + "you have to specify the name of the client you'd like to remove!\n" + ); + } + + my $clientData = parseKeyValueArgs(['name'], 'client', @_); + + my $client = $openslxDB->fetchClientByFilter({'name' => $clientName}); + if (!defined $client) { + die _tr("the client '%s' doesn't exists in the DB, giving up!\n", + $clientName); + } + if ($client->{name} eq '<<>>') { + die _tr("you can't remove the default client!\n"); + } + $openslxDB->removeClient($client->{id}); + vlog(0, + _tr("client '%s' has been successfully removed from DB\n", $clientName) + ); + + return 1; +} + +sub removeGroupFromConfigDB +{ + my $groupName = _cleanName(shift || ''); + + if (!length($groupName)) { + die _tr( + "you have to specify the name of the group you'd like to remove!\n" + ); + } + + my $groupData = parseKeyValueArgs(['name'], 'group', @_); + + my $group = $openslxDB->fetchGroupByFilter({'name' => $groupName}); + if (!defined $group) { + die _tr("the group '%s' doesn't exists in the DB, giving up!\n", + $groupName); + } + $openslxDB->removeGroup($group->{id}); + vlog(0, + _tr("group '%s' has been successfully removed from DB\n", $groupName) + ); + + return 1; +} + +sub removeSystemFromConfigDB +{ + my $systemName = _cleanName(shift || ''); + + if (!length($systemName)) { + die _tr( + "you have to specify the name of the system you'd like to remove!\n" + ); + } + + my $systemData = parseKeyValueArgs(['name'], 'system', @_); + + my $system = $openslxDB->fetchSystemByFilter({'name' => $systemName}); + if (!defined $system) { + die _tr("the system '%s' doesn't exists in the DB, giving up!\n", + $systemName); + } + if ($system->{name} eq '<<>>') { + die _tr("you can't remove the default system!\n"); + } + $openslxDB->removeSystem($system->{id}); + vlog(0, + _tr("system '%s' has been successfully removed from DB\n", $systemName) + ); + + return 1; +} + +sub _expandClients +{ # expands info for given clients + return + map { + my @sysIDs = $openslxDB->fetchSystemIDsOfClient($_->{id}); + $_->{systems} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@sysIDs, 'name'); + if ($option{inherited}) { + my $mergedClient = clone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAndGroupAttributesIntoClient( + $mergedClient, $originInfo + ); + my $mergedAttrs = $mergedClient->{attrs} || {}; + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; +} + +sub _expandGroups +{ # expands info for given groups + return + map { + my @systemIDs = $openslxDB->fetchSystemIDsOfGroup($_->{id}); + $_->{systems} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchSystemByID(\@systemIDs, 'name'); + my @clientIDs = $openslxDB->fetchClientIDsOfGroup($_->{id}); + $_->{clients} + = join "\n", map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; +} + +sub _expandSystems +{ # expands info for given systems + return + map { + my @clientIDs = $openslxDB->fetchClientIDsOfSystem($_->{id}); + $_->{clients} + = join "\n", + map { $_->{name} } + sort { $a->{name} cmp $b->{name} } + $openslxDB->fetchClientByID(\@clientIDs, 'name'); + my @activePlugins; + my $export = $openslxDB->fetchExportByID($_->{export_id}); + if (defined $export) { + $_->{export_id} = "$export->{id} ($export->{name})"; + + # fetch detailed info about active plugins + my @installedPlugins = $openslxDB->fetchInstalledPlugins( + $export->{vendor_os_id} + ); + my $mergedSystem = clone($_); + my $originInfo = {}; + $openslxDB->mergeDefaultAttributesIntoSystem( + $mergedSystem, \@installedPlugins, $originInfo + ); + my $mergedAttrs = $mergedSystem->{attrs} || {}; + foreach my $plugin (@installedPlugins) { + next if !$mergedAttrs->{"$plugin->{plugin_name}::active"}; + push @activePlugins, $plugin; + } + if ($option{inherited}) { + $_->{attrs} = {}; + foreach my $attr (keys %$mergedAttrs) { + my $origin = $originInfo->{$attr}; + my $enhancedName = $origin ? "[$origin] $attr" : $attr; + $_->{attrs}->{$enhancedName} = $mergedAttrs->{$attr}; + } + } + } + $_->{PLUGINS} = [ sort map { $_->{plugin_name} } @activePlugins ]; + # rename attrs to ATTRIBUTES for display + $_->{ATTRIBUTES} = $_->{attrs}; + delete $_->{attrs}; + $_; + } + @_; +} + +sub _cleanName +{ # removes 'name=""' constructs from the name, as it is rather tempting + # for the user to type that ... (and we'd like to play along with DWIM) + my $name = shift; + + return unless defined $name; + + if ($name =~ m[^name=(.+)$]) { + return $1; + } + + # for convenience, we alias default to <<>> + $name = '<<>>' if $name eq 'default'; + + return $name; +} + +=head1 NAME + +slxconfig - OpenSLX-script to view & change the configurational database + +=head1 SYNOPSIS + +slxconfig [options] + +=head3 Options + + --help brief help message + --inherited show inherited attributes, too + --man show full documentation + --verbose be more verbose + --version show version + +=head3 Actions + +=over 8 + +=item B<< add-client mac= [= ...] >> + +adds a new client to the config-DB + +=item B<< add-system [export=] \ >> + +=item B<< = ...] >> + +adds a new system to the config-DB + +=item B<< add-group [priority=] [= ...] >> + +adds a new group to the config-DB + +=item B<< change-vendor-os [= ...] >> + +changes the data of an existing vendor-OS in the config-DB. + +=item B<< change-export [= ...] >> + +changes the data of an existing export in the config-DB + +=item B<< change-client [= ...] >> + +changes the data of an existing client in the config-DB + +Note: you can use the special value '-' to unset a key (mostly useful +for attributes). + +=item B<< change-group [= ...] >> + +changes the data of an existing group in the config-DB + +Note: you can use the special value '-' to unset a key (mostly useful +for attributes). + +=item B<< change-system [= ...] >> + +changes the data of an existing system in the config-DB + +Note: you can use the special value '-' to unset a key (mostly useful +for attributes). + +=item B<< cleanup-db >> + +utility command that looks for any inconsistencies in the DB (stale references +and/or references to plugins that do not exists) and removes them. + +You should only invoke this if you are a developer and have removed one or +more plugins from the repository and would like to get rid of the left-overs +in your local DB. + +=item B<< list-attributes [] >> + +lists all attributes, the ones in the given scope or the one with the given +name + +=item B<< list-client [] >> + +lists client with given name + +=item B<< list-export [] >> + +lists export with given name + +=item B<< list-group [] >> + +lists group with given name + +=item B<< list-system [] >> + +lists system with given name + +=item B<< list-vendor-os [] >> + +lists vendor-OS with given name + +=item B<< remove-client >> + +removes a client from the config-DB + +=item B<< remove-group >> + +removes a group from the config-DB + +=item B<< remove-system >> + +removes a system from the config-DB + +=item B<< search-client [= ...] >> + +shows all clients in config-DB (optionally matching given criteria) + +=item B<< search-export [= ...] >> + +shows all exports in config-DB (optionally matching given criteria) + +=item B<< search-group [= ...] >> + +shows all groups in config-DB (optionally matching given criteria) + +=item B<< search-system [= ...] >> + +shows all systems in config-DB (optionally matching given +criteria) + +=item B<< search-vendor-os [= ...] >> + +shows all vendor-OSes in config-DB (optionally matching given criteria) + +=back + +=head1 DESCRIPTION + +B can be used to view the contents of the configurational database. +Additionally, you can add systems as well as clients and change their specific +boot configuration. + +=head1 OPTIONS + +=over 8 + +=item B<< --help >> + +Prints a brief help message and exits. + +=item B<< --man >> + +Prints the manual page and exits. + +=item B<< --verbose >> + +Prints more information during execution of any action. + +=item B<< --version >> + +Prints the version and exits. + +=back + +=head1 EXAMPLES + +=head3 Listing existing Clients / Exports / Groups / Systems / Vendor-OSes + +=over 8 + +=item B<< slxconfig list-client >> + +=item B<< slxconfig list-export >> + +=item B<< slxconfig list-group >> + +=item B<< slxconfig list-system >> + +=item B<< slxconfig list-vendor-os >> + +lists all existing instances of the respective DB-objects + +=item B<< slxconfig list-system "<<>>" >> + +Lists the details of the default-system. + +=item B<< slxconfig --inherited list-system suse-10.2::nfs >> + +Lists the details of the 'suse-10.2::nfs'-system with all the attributes +that it inherits from the default-system or the default-client. + +=back + +=head3 Listing known attributes + +=over 8 + +=item B<< slxconfig list-attr >> + +lists all known attributes (--verbose will give details). + +=item B<< slxconfig list-attr >> + +lists all known attributes for the given scope (use 'core' to see only +non-scoped attributes). + +=back + +=head3 Adding a new System to an exported Vendor-OS + +=over 8 + +=item B<< slxconfig add-system debian-4.0 >> + +adds a new system named 'debian-4.0' to the config-DB that will +use the export of the same name. No client will be associated +with this system, yet. + +=item B<< slxconfig add-system suse-11.1 export-name=suse-11.1-kde \ >> + +=item B<< clients=PC131,PC132,PC133 \ >> + +=item B<< label="Linux Desktop" >> + +adds a new system name 'suse-11.1' to the config-DB that will +use the export named 'suse-11.1-kde'. The system will be labeled +'Linux Desktop' and the clients 'PC131, 'PC132' and 'PC133' are +associated with this system (so they can boot it). + +=back + +=head3 Adding a new Client + +=over 8 + +=item B<< slxconfig add-client vmware-1 mac=01:02:03:04:05:06 >> + +adds a new client named 'vmware-1', being identified by the MAC +'01:02:03:04:05:06' to the config-DB. No system will be +associated with this client, yet (so it can't boot anything). + +=item B<< slxconfig add-client vmware-1 mac=01:02:03:04:05:06 \ >> + +=item B<< systems=suse-11.1,debian-4.0 \ >> + +=item B<< boot_type=pxe >> + +adds a new client named 'vmware-1', being identified by the MAC +'01:02:03:04:05:06' to the config-DB. The systems 'suse-11.1' & +'Debian-4.0' will be associated with this client (so it will +offer these systems for booting). + +This client will use PXE for booting (which is the default, anyway). + +=back + +=head3 Changing a System + +=over 8 + +=item B<< slxconfig change-system suse-11.1 boot_type=preboot-cd >> + +will change the system named 'suse-11.1' such that it will use a preboot-CD +environment for booting. + +=item B<< slxconfig change-system suse-11.1 add-clients=vmware-1 >> + +will associate the client 'vmware-1' with the system named +'suse-11.1'. + +=item B<< slxconfig change-system suse-11.1 remove-clients=vmware-1 >> + +will remove the client 'vmware-1' from the system named +'suse-11.1'. + +=back + +=head3 Changing a Client + +=over 8 + +=item B<< slxconfig change-client PC131 start_snmp=yes >> + +will change the client named 'PC131' such that it will start +the SNMP daemon on all systems that it boots. + +=item B<< slxconfig change-client PC131 add-systems=Debian-4.0 >> + +will associate the system 'Debian-4.0' with the client named +'PC131'. + +=item B<< slxconfig change-client PC131 remove-systems=Debian-4.0 >> + +will remove the system 'Debian-4.0' from the client named +'PC131'. + +=back + +=head3 Removing a Client / Group / System + +=over 8 + +=item B<< slxconfig remove-client >> + +=item B<< slxconfig remove-group >> + +=item B<< slxconfig remove-system >> + +removes the client/group/system with the given name. + +=back + +=head3 Searching for Clients / Exports / Groups / Systems / Vendor-OSes + +=over 8 + +=item B<< slxconfig search-client mac='01:02:03:04:05:06' >> + +displays all clients with the MAC '01:02:03:04:05:06' (should be only one) + +=item B<< slxconfig search-export type=nfs >> + +displays the exports of type 'nfs' + +=item B<< slxconfig list-group priority=50 >> + +displays the groups that have the default priority (50) + +=back + +=head1 SEE ALSO + +slxsettings, slxos-setup, slxos-export, slxconfig-demuxer + +=head1 GENERAL OPENSLX OPTIONS + +Being a part of OpenSLX, this script supports several other options +which can be used to overrule the OpenSLX settings: + + --db-name= name of database + --db-spec= full DBI-specification of database + --db-type= type of database to connect to + --locale= locale to use for translations + --log-level= level of logging verbosity (0-3) + --logfile= file to write logging output to + --private-path= path to private data + --public-path= path to public (client-accesible) data + --temp-path= path to temporary data + +Please refer to the C-manpage for a more detailed description +of these options. + +=cut diff --git a/src/config-db/slxconfig-demuxer b/src/config-db/slxconfig-demuxer new file mode 100755 index 00000000..b88efeb6 --- /dev/null +++ b/src/config-db/slxconfig-demuxer @@ -0,0 +1,918 @@ +#! /usr/bin/perl +# ----------------------------------------------------------------------------- +# 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/ +# ----------------------------------------------------------------------------- +# slxconfig-demuxer +# - OpenSLX configuration demultiplexer +# ----------------------------------------------------------------------------- +use strict; +use warnings; +use Switch; + + +my $abstract = q[ +slxconfig-demuxer + This script will read information about all systems, clients and + groups from the OpenSLX configuration database, mix & match the individual + configurational attributes and then demultiplex the resulting information + to a set of configuration files. These files are used by any OpenSLX-client + during boot to find out which systems to offer for booting. + + The resulting files will be put into the OpenSLX-tftpboot-path. + + Please use the --man option in order to read the full manual. +]; + +use Config::General; +use Digest::MD5 qw(md5_hex); +use File::Basename; +use File::Find; +use File::Path; +use List::Util qw(first); +use Getopt::Long qw(:config pass_through); +use Pod::Usage; + +# add the lib-folder and the folder this script lives in to perl's search +# path for modules: +use FindBin; +use lib "$FindBin::RealBin/../lib"; +use lib "$FindBin::RealBin"; +# development path to config-db stuff + +use OpenSLX::Basics; +use OpenSLX::ConfigDB qw(:support); +use OpenSLX::ConfigFolder; +use OpenSLX::OSPlugin::Roster; +use OpenSLX::Utils; + +my ( + $systemConfCount, + # number of system configurations written + $systemErrCount, + # number of systems that had errors + $bootEnvErrCount, + # number of boot environments that had errors + $clientSystemConfCount, + # number of (system-specific) client configurations written + $initramfsCount, + # number of initramfs that were created + @targetSystems, + # systems to create initramfs for, defaults to all systems + %bootEnvMap, + # objects encapsulating the bootloader specific configurations + %option, + # cmdline option hash +); + +if ($> != 0) { + die _tr("Sorry, this script can only be executed by the superuser!\n"); +} + +GetOptions( + 'dhcp-export-type=s' => \$option{dhcpType}, + 'dry-run' => \$option{dryRun}, + 'help|?' => \$option{helpReq}, + 'man' => \$option{manReq}, + 'version' => \$option{versionReq}, + ) + or pod2usage(2); +pod2usage(-msg => $abstract, -verbose => 0, -exitval => 1) if $option{helpReq}; +if ($option{manReq}) { + # avoid dubious problem with perldoc in combination with UTF-8 that + # leads to strange dashes and single-quotes being used + $ENV{LC_ALL} = 'POSIX'; + pod2usage(-verbose => 2); +} +if ($option{versionReq}) { + slxsystem('slxversion'); + exit 1; +} + +openslxInit(); + +my $openslxDB = OpenSLX::ConfigDB->new(); +$openslxDB->connect(); + +my $clientConfigPath = "$openslxConfig{'private-path'}/config"; +# make sure that the default config folders exist: +if (createConfigFolderForDefaultSystem()) { + # this path should have been generated by earlier stage (slxsettings), so + # we indicate that there is some kind of problem: + warn _tr( + "Completed client-config-folder '%s', since at least some parts of it didn't exist!", + $clientConfigPath + ); +} + +# protect against parallel execution of this script +my $demuxerLock = grabLock('slxconfig-demuxer'); + +my $tempPath = "$openslxConfig{'temp-path'}/slxconfig-demuxer"; +if (!$option{dryRun}) { + rmtree($tempPath); + mkpath($tempPath); + if (!-d $tempPath) { + die _tr("Unable to create or access temp-path '%s'!", $tempPath); + } +} + +my $deleteInFinalize = 0; + +my @demuxableSystems + = grep { $_->{name} ne '<<>>' } $openslxDB->fetchSystemByFilter(); +if (@ARGV) { + # create initramfs only for systems given on cmdline + for my $systemName (@ARGV) { + if ($systemName eq '<<>>') { + warn _tr( + 'The default-system can not be demuxed - it will be skipped.' + ); + next; + } + my $system = first { $_->{name} eq $systemName } @demuxableSystems; + if (!$system) { + warn _tr( + 'The system "%s" is unknown and will be ignored.', $systemName + ); + next; + } + push @targetSystems, $system; + } +} +else { + # create initramfs for all systems + @targetSystems = @demuxableSystems; + $deleteInFinalize = 1; +} + +writeConfigurations(); + +my $wr = $option{dryRun} ? 'would have written' : 'wrote'; +my $errCount = $systemErrCount ? $systemErrCount : 'no'; +my $systemStatusString + = $systemErrCount ? "$errCount system(s) had errors" : 'all systems ok'; +$errCount = $bootEnvErrCount ? $bootEnvErrCount : 'no'; +my $bootEnvStatusString + = $bootEnvErrCount + ? "$errCount boot environment(s) had errors" + : 'all boot-environments ok'; +print "\n", unshiftHereDoc(<<"End-of-Here"); + $wr $systemConfCount system-specific and $clientSystemConfCount client-specific configurations + $initramfsCount initramfs were created + $systemStatusString + $bootEnvStatusString +End-of-Here + +$openslxDB->disconnect(); + +rmtree([$tempPath]); + +# allow all boot-environments to clean up and active the new configuration +foreach my $bootEnv (values %bootEnvMap) { + $bootEnv->finalize($deleteInFinalize); +} + +exit; + +################################################################################ +### +################################################################################ +sub folderContainsFiles +{ + my $folder = shift; + + return 0 unless -d $folder; + + my $result = 0; + my $wanted = sub { + if ($result) { + # skip anything else if we have found a file already + $File::Find::prune = 1; + } + $result = 1 if -f; + }; + find({wanted => $wanted, follow_fast => 1}, $folder); + vlog(2, "result for folderContainsFiles($folder): $result\n"); + return $result; +} + +sub digestAttributes +{ # returns a digest-string for the given attribute hash, in order to + # facilitate comparing different attribute hashes. + my $object = shift; + + my $attrs = $object->{attrs} || {}; + my $attrsAsString + = join ';', + map { "$_=$attrs->{$_}" } + sort + grep { defined $attrs->{$_} } + keys %$attrs; + + vlog(3, "Attribute-string: $attrsAsString"); + return md5_hex($attrsAsString); +} + +sub writeAttributesToFile +{ + my $object = shift; + my $fileName = shift; + + return if $option{dryRun}; + + my $content = "# attributes set by slxconfig-demuxer:\n"; + my $attrs = $object->{attrs} || {}; + # filter out any plugin-specific attributes (we only want to handle + # the attributes relevant to the core here) + my @attrs = sort grep { index($_, '::') == -1 } keys %$attrs; + foreach my $attr (@attrs) { + my $attrVal = $attrs->{$attr}; + next if !defined $attrVal; + $content .= qq[$attr="$attrVal"\n]; + } + # Overwrite attribute file even if it exists, to make sure that our users + # will never try to fiddle with machine-setup directly in the file-system. + # The config-DB is the keeper of that info! + spitFile($fileName, $content); + if ($openslxConfig{'log-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + return; +} + +sub writeSlxConfigToFile +{ + my $slxConf = shift; + my $fileName = shift; + + return if $option{dryRun}; + + my $content = ''; + foreach my $key (sort keys %$slxConf) { + $content .= qq[$key="$slxConf->{$key}"\n]; + } + spitFile($fileName, $content); + return; +} + +sub copyExternalSystemConfig +{ # copies local configuration extensions of given system from private + # config folder (var/lib/openslx/config/...) into a temporary folder + my $systemName = shift; + my $targetPath = shift; + my $clientName = shift; # optional + + if ($targetPath !~ m[^$tempPath]) { + # bail if target-path isn't within temp folder, as we do not dare + # executing 'rm -rf' in that case! + die _tr("system-error: illegal target-path <%s>!", $targetPath); + } + return if $option{dryRun}; + + slxsystem("rm -rf $targetPath"); + mkpath $targetPath; + + # first copy default files ... + my $defaultConfigPath = "$clientConfigPath/default"; + vlog(2, "checking $defaultConfigPath for default config..."); + if (-d $defaultConfigPath) { + slxsystem("cp -a $defaultConfigPath/* $targetPath"); + } + # ... now pour system-specific configuration on top (if any) ... + my $systemSpecConfigPath = "$clientConfigPath/$systemName/default"; + vlog(2, "checking $systemSpecConfigPath for system config..."); + if (folderContainsFiles($systemSpecConfigPath)) { + slxsystem("cp -a $systemSpecConfigPath/* $targetPath"); + } + if (defined $clientName) { + # ... and finally pour client-specific configuration on top (if any): + my $clientSpecConfigPath = "$clientConfigPath/$systemName/$clientName"; + vlog(2, "checking $clientSpecConfigPath for client config..."); + if (folderContainsFiles($clientSpecConfigPath)) { + slxsystem("cp -a $clientSpecConfigPath/* $targetPath"); + } + } + return; +} + +sub createTarOfPath +{ + my $buildPath = shift; + my $tarName = shift; + my $destinationPath = shift; + + my $tarFile = "$destinationPath/$tarName"; + vlog(1, _tr('creating tar %s', $tarFile)); + return if $option{dryRun}; + + mkpath $destinationPath; + my $tarCmd = "cd $buildPath && tar czf $tarFile *"; + if (slxsystem("$tarCmd") != 0) { + die _tr("unable to execute shell-command:\n\t%s \n\t(%s)", $tarCmd, $!); + } +} + +sub bootEnvironmentForType +{ + my $bootTypeIn = shift || 'pxe'; + + my %bootTypeMap = ( + 'pxe' => 'PXE', + 'preboot' => 'Preboot', + 'pbs' => 'PBS', + ); + my $bootType = $bootTypeMap{lc($bootTypeIn)} + or die _tr( + "'%s' is not one of the supported boot-types (pxe,preboot)", + $bootTypeIn + ); + + if (!$bootEnvMap{$bootType}) { + my $bootEnv = instantiateClass("OpenSLX::BootEnvironment::$bootType"); + $bootEnv->initialize( { + 'dry-run' => $option{dryRun}, + } ); + $bootEnvMap{$bootType} = $bootEnv; + } + + return $bootEnvMap{$bootType}; +} + + + +################################################################################ +### +################################################################################ +sub writeBootloaderMenus +{ + my @infos = @_; + + # iterate over all clients and write a bootloader configuration for each + my @clients = $openslxDB->fetchClientByFilter(); + foreach my $client (@clients) { + # fetch all infos relevant to this client (including the bootable + # systems) + my %systemIDs; + @systemIDs{$openslxDB->aggregatedSystemIDsOfClient($client)} = (); + my @systemInfos = grep { exists $systemIDs{$_->{id}} } @infos; + + # now write bootloader menu with all bootable systems for this client + my $bootEnv = bootEnvironmentForType($client->{attrs}->{boot_type}); + my $externalID = externalIDForClient($client); + my $success = eval { + $bootEnv->writeBootloaderMenuFor( + $client, $externalID, \@systemInfos + ); + 1; + }; + if (!$success) { + print STDERR $@; + $bootEnvErrCount++; + } + } + return; +} + +sub writeDhcpConfig +{ + vlog(0, _tr("sorry, exporting dhcp data is not implemented yet!")); + my $dhcpModule = "OpenSLX::ConfigExport::DHCP::$option{dhcpType}"; + if (!eval { require $dhcpModule } ) { + die _tr("unable to load DHCP-Export backend '%s'! (%s)\n", + $dhcpModule, $@); + } + my $dhcpBackend = $dhcpModule->new(); + my @clients = $openslxDB->fetchClientByFilter(); + $dhcpBackend->execute(\@clients); + return; +} + +sub writeClientConfigurationsForSystem +{ + my $info = shift; + my $buildPath = shift; + my $attrFile = shift; + my $bootType = shift; + my $clients = shift || []; + + foreach my $client (@$clients) { + next if $client->{name} eq '<<>>'; + # skip default client, as it doesn't need any config-tgz + + next if ($client->{attrs}->{boot_type} || 'pxe') ne $bootType; + # skip clients with non-matching boot type + + my $externalSystemID = $info->{'external-id'}; + my $externalClientName = externalConfigNameForClient($client); + my $clientConfigPath + = "$clientConfigPath/$externalSystemID/$externalClientName"; + + # merge configurations of groups, default client and system into the + # current client (overwriting only values the client does not specify) + $openslxDB->mergeDefaultAndGroupAttributesIntoClient($client); + mergeAttributes($client, $info); + + # compute a digest value of the merged attributes ... + my $clientAttrDigest = digestAttributes($client); + vlog( + 2, + _tr( + "attribute-digest for client '%s' is '%s'", $client->{name}, + $clientAttrDigest + ) + ); + # ... and export client-specific config only if attributes are different + # from system and/or a client-specific config-folder exists: + if ($clientAttrDigest ne $info->{'attr-digest'} + || -d $clientConfigPath) + { + vlog( + 1, + _tr( + "creating config-tgz for client %d:%s", $client->{id}, + $client->{name} + ) + ); + $clientSystemConfCount++; + + # merge default, system and client configuration folders into + # a configuration folder specific to the current client: + copyExternalSystemConfig( + $externalSystemID, $buildPath, $externalClientName + ); + + # add plugin configuration and note if the client adds any active + # plugin (as opposed to current state) + my $activeClientPlugins = writePluginConfigurations( + $info, $buildPath, $client->{attrs} + ); + my @additionalActivePlugins = grep { + my $activeClientPlugin = $_; + ! grep { + $activeClientPlugin eq $_ + } @{$info->{'active-plugins'}}; + } @$activeClientPlugins; + if (@additionalActivePlugins) { + push @{$info->{'active-plugins'}}, @additionalActivePlugins; + my $additionalActivePluginStr + = join ',', @additionalActivePlugins; + vlog(0, _tr( + "client '%s' activates additional plugins: %s", + $client->{name}, $additionalActivePluginStr + )); + } + + # check attributes against illegal values and write them into + # a file if they're ok: + my $attrProblems = OpenSLX::AttributeRoster->findProblematicValues( + $client->{attrs}, $info->{'vendor-os'}->{name}, + $info->{'installed-plugins'} + ); + if ($attrProblems) { + my $complaint = join "\n", @$attrProblems; + $complaint =~ s{^}{client $client->{name}: }gms; + warn $complaint; + } + writeAttributesToFile($client, $attrFile); + + # create a tar containing the external configuration folder + # and client attribute file, this time referring to the client + # via its external ID (the PXE-style MAC), as the TGZ needs to + # be accessed from the client-PC, which doesn't know about the + # name it is referred to in the openslx-config-DB: + my $externalClientID = externalIDForClient($client); + my $bootEnv = bootEnvironmentForType($bootType); + switch ($bootType) { + case 'pxe' { + createTarOfPath( + $buildPath, "${externalClientID}.tgz", + "$bootEnv->{'target-path'}/client-config/$externalSystemID" + ); + } + case 'preboot' { + # for preboot types + my $cname = $client->{name}; + createTarOfPath( + $buildPath, "${cname}.tgz", + "$bootEnv->{'target-path'}/client-config/$externalSystemID" + ); + } + case 'pbs' { + # for preboot types + my $cname = $client->{name}; + createTarOfPath( + $buildPath, "${cname}.tgz", + "$bootEnv->{'target-path'}/client-config/$externalSystemID" + ); + } + } + } + } + return; +} + +sub writePluginConfigurations +{ + my $info = shift || confess 'need to pass in info-hash!'; + my $buildPath = shift || confess 'need to pass in build-path!'; + my $attrs = shift || {}; + + my $pluginConfPath = "$buildPath/initramfs/plugin-conf"; + + my @activePlugins; + foreach my $pluginInfo (@{$info->{'installed-plugins'}}) { + my $pluginName = $pluginInfo->{plugin_name}; + vlog(2, _tr("checking configuration of plugin '%s'", $pluginName)); + + # skip inactive plugins + next unless $attrs->{"${pluginName}::active"}; + push @activePlugins, $pluginName; + + my $plugin = OpenSLX::OSPlugin::Roster->getPlugin($pluginName); + my $requiredPlugins = $plugin->getInfo()->{required} || []; + my @missingPlugins + = grep { + my $required = $_; + ! grep { + $_->{plugin_name} eq $required + } @{$info->{'installed-plugins'}}; + } + @$requiredPlugins; + if (@missingPlugins) { + die _tr( + 'the plugin "%s" requires the following plugins to be installed: "%s"!', + $pluginName, join(',', @missingPlugins) + ); + } + + next if $option{dryRun}; + + mkpath([ $pluginConfPath ]); + + vlog(2, _tr("writing configuration file for plugin '%s'", $pluginName)); + # write plugin configuration to a file: + my $content; + my @pluginAttrs = grep { $_ =~ m{^${pluginName}::} } keys %$attrs; + foreach my $attr (sort @pluginAttrs) { + my $attrVal = $attrs->{$attr}; + if (!defined $attrVal) { + $attrVal = ''; + } + my $attrName = substr($attr, index($attr, '::')+2); + $content .= qq[${pluginName}_$attrName="$attrVal"\n]; + } + my $fileName = "$pluginConfPath/${pluginName}.conf"; + spitFile($fileName, $content); + if ($openslxConfig{'log-level'} > 2) { + vlog(0, "--- START OF $fileName ---"); + vlog(0, $content); + vlog(0, "--- END OF $fileName --- "); + } + } + return \@activePlugins; +} + +sub createBootEnvironmentsForSystem +{ + my $info = shift; + my $buildPath = shift; + my $attrFile = shift; + my $clients = shift || []; + + my %bootTypes; + foreach my $client (@$clients) { + my $type = $client->{attrs}->{boot_type} || 'pxe'; + $bootTypes{$type}++; + } + + foreach my $bootType (sort keys %bootTypes) { + vlog(0, _tr("creating boot environment (system part) for $bootType")); + + my $bootEnv = bootEnvironmentForType($bootType); + + # only create a default.tgz if required by boot environment + if ($bootEnv->requiresDefaultClientConfig()) { + writeAttributesToFile($info, $attrFile); + + my $systemPath + = "$bootEnv->{'target-path'}/client-config/$info->{'external-id'}"; + createTarOfPath($buildPath, "default.tgz", $systemPath); + } + } + + foreach my $bootType (sort keys %bootTypes) { + vlog(0, _tr("creating boot environment (client part) for $bootType")); + + my $bootEnv = bootEnvironmentForType($bootType); + + writeClientConfigurationsForSystem( + $info, $buildPath, $attrFile, $bootType, $clients + ); + + # let boot environment copy the kernel and create the initramfs + $initramfsCount + += $bootEnv->writeFilesRequiredForBooting($info, $buildPath); + } + + return; +} + +sub writeSystemConfiguration +{ + my $info = shift; + my $isTargetSystem = shift; + + $info->{'initramfs-name'} = "initramfs-$info->{id}"; + + # if this is not a target system, we shall not write any configurations, + # but we simply incorporate inherited attributes + if (!$isTargetSystem) { + $openslxDB->mergeDefaultAttributesIntoSystem($info); + return; + } + + # write configuration files for this system + my $buildPath = "$tempPath/build"; + copyExternalSystemConfig(externalIDForSystem($info), $buildPath); + + $openslxDB->mergeDefaultAttributesIntoSystem( + $info, $info->{'installed-plugins'} + ); + $info->{'attr-digest'} = digestAttributes($info); + vlog( + 2, + _tr( + "attribute-digest for system '%s' is '%s'", $info->{name}, + $info->{'attr-digest'} + ) + ); + + # check if uclibc-rootfs in corresponding vendor-OS matches the current + # version and add a warning if it does not: + my $uclibcVersionPath + = "$openslxConfig{'private-path'}/stage1/$info->{'vendor-os'}->{name}/opt/openslx/uclib-rootfs.version"; + chomp(my $uclibcVersion + = slurpFile($uclibcVersionPath, { failIfMissing => 0 } )); + chomp(my $currVersion = qx{slxversion}); + if ($currVersion !~ m{M$} && $uclibcVersion ne $currVersion) { + warn _tr( + "uclibc-rootfs for system '%s' may not be up-to-date - consider updating the vendor-OS!", + $info->{name}, $uclibcVersion, $currVersion + ); + } + + my $attrProblems = OpenSLX::AttributeRoster->findProblematicValues( + $info->{attrs}, $info->{'vendor-os'}->{name}, + $info->{'installed-plugins'} + ); + if ($attrProblems) { + my $complaint = join "\n", @$attrProblems; + $complaint =~ s{^}{system $info->{name}: }gms; + warn $complaint; + } + + my $activePlugins + = writePluginConfigurations($info, $buildPath, $info->{attrs}); + $info->{'active-plugins'} = $activePlugins; + my $activePluginStr + = @$activePlugins ? join ',', @$activePlugins : ''; + vlog(0, _tr("active plugins: %s", $activePluginStr)); + + # create all required (pre-)boot-environments (PXE, CD, ...) + my $attrFile = "$buildPath/initramfs/machine-setup"; + my @clientIDs = $openslxDB->aggregatedClientIDsOfSystem($info); + my @clients = $openslxDB->fetchClientByID(\@clientIDs); + createBootEnvironmentsForSystem($info, $buildPath, $attrFile, \@clients); + + slxsystem("rm -rf $buildPath") unless $option{dryRun}; + + $systemConfCount++; + + return; +} + +sub writeConfigurations +{ + $initramfsCount = $systemConfCount = $systemErrCount + = $clientSystemConfCount = 0; + my @infos; + foreach my $system (@demuxableSystems) { + my $isTargetSystem + = first { $_->{name} eq $system->{name} } @targetSystems; + if ($isTargetSystem) { + vlog( + 0, + _tr("\ndemuxing system %d : %s", $system->{id}, $system->{name}) + ); + } + else { + vlog( + 0, + _tr( + "\nlinking demuxed system %d : %s into bootloader menu", + $system->{id}, $system->{name} + ) + ); + } + + my $success = eval { + my $info = $openslxDB->aggregatedSystemFileInfoFor($system); + $info->{'external-id'} = externalIDForSystem($system); + + writeSystemConfiguration($info, $isTargetSystem); + + push @infos, $info; + 1; + }; + if (!$success) { + print STDERR $@; + $systemErrCount++; + } + } + my $imageBaseDir = "$openslxConfig{'public-path'}/images"; + rmtree($imageBaseDir) unless $option{dryRun}; + writeBootloaderMenus(@infos); + if (defined $option{dhcpType}) { + writeDhcpConfig(); + } + return; +} + +=head1 NAME + +slxconfig-demuxer - OpenSLX configuration demultiplexer + +=head1 SYNOPSIS + +slxconfig-demuxer [options] [ ...] + +=head3 Script Options + + --dry-run avoids writing anything, for testing + +=head3 General Options + + --help brief help message + --man full documentation + --version show version + +=head1 DESCRIPTION + +B will read information about all systems, clients and +groups from the OpenSLX configuration database, mix & match the individual +configurational attributes and then demultiplex the resulting information +to a set of configuration files. These files are used by any OpenSLX-client +during boot to find out which systems to offer for booting. + +If you invoke the script with one or more system names, only these systems +will be demuxed. All other systems (which are expected to have been demuxed +before) will just be linked into the bootloader menu. + +The resulting files will be put into the OpenSLX-tftpboot-path. + +=head2 FILE CREATION + +The following set of files will be created: + +=over 8 + +=item B + +The basic PXE files (F, F) will be copied into +F<$SLX_PUBLIC_PATH/tftpboot> to make them available to any PXE-client via tftp. + +=item B + +For each client, a PXE configuration file will be generated and written to +F<$SLX_PUBLIC_PATH/tftpboot/pxelinux.cfg/01->. This file will +contain information about the systems this client shall offer for booting. +For each of these systems, the kernel cmdline options required for that +particular system setup is specified (via PXE's APPEND option). + +Any client that is not known to OpenSLX (so it will not have a specific +configuration file) will use the configuration from the default client +(appropriately named 'default'). + +=item B + +For each bootable system, that system's kernel will be copied to +F<$SLX_PUBLIC_PATH/tftpboot//kernel and an OpenSLX-specific initramfs +required for booting that particular system is generated (by means of +slxmkramfs) and put into F<$SLX_PUBLIC_PATH/tftpboot//initramfs. + +These two files (kernel & initramfs) will be referenced by the PXE client +configuration of all clients that offer this specific system for booting. + +=item B + +For each system, an OpenSLX configuration archive will be generated and written +to F<$SLX_PUBLIC_PATH/tftpboot/client-config//default. Furthermore, +every client of that system whose attributes differ from the system's default +will get its own configuration archive generated here, too (e.g. +F<$SLX_PUBLIC_PATH/tftpboot/client-config//01-.tgz>). + +Each of these archives will contain the file F, +specifying all the attributes of that particular system and/or client +(e.g. whether or not it should start the X-server). + +Furthermore, each system-specific archive may contain additional system files +that are required for that system (e.g. a special PAM-module required for LDAP +authentication). These files are copied from F<$SLX_PRIVATE_PATH/config/default> +and F<$SLX_PROVATE_PATH/config/>. + +On top of that, each client may have its own set of system files, too (e.g. +some config files required to install a special kind of hardware available only +on that client). These files are copied from +F<< $SLX_PROVATE_PATH/config//01- >>. + +=back + +=head2 MIXING & MATCHING (THE DEMUXER) + +In the OpenSLX configuration database, each system, group and client may have +several configurational attributes set to a specific value that will cause +a client booting that system to behave in a certain way. The mixing of all +these different attributes into one set that is relevant for a specific client +booting one specific system is one important task of the slxconfig-demuxer. + +As an example, let's assume one system setup that is configured to boot directly +into a special application that demands a rather low screen-resolution of +1024x768 pixels, as otherwise the text would be unreadable due to very small +fonts being used by that app. In order to achieve this, the administrator can +set the I-attribute of the B to '1024x768'. +Let's say one of the clients, however, is connected to a very old monitor that +has problems with this resolution and only supports 800x600 pixels. In that +case, the administrator can set the I-attribute of that B to +'800x600'. The mixing & matching process would make sure that this specific +client would run that system with a resolution of 800x600, while all other +clients would run that system in 1024x768. + +So the slxconfig-demuxer demultiplexes the individual configurational attributes +into a concrete set of configuration settings for specific clients and their +offered systems, making sure that each client/system combination uses the +appropriate settings. + +=head1 OPTIONS + +=head3 Script Options + +=over 8 + +=item B<< --dry-run >> + +Runs the script but avoids writing anything. This is useful for testing, as +you can learn from the logging output what would have been done. + +=back + +=head3 General Options + +=over 8 + +=item B<< --help >> + +Prints a brief help message and exits. + +=item B<< --man >> + +Prints the manual page and exits. + +=item B<< --version >> + +Prints the version and exits. + +=back + +=head1 SEE ALSO + +slxsettings, slxos-setup, slxos-export, slxconfig + +=head1 GENERAL OPENSLX OPTIONS + +Being a part of OpenSLX, this script supports several other options +which can be used to overrule the OpenSLX settings: + + --db-name= name of database + --db-spec= full DBI-specification of database + --db-type= type of database to connect to + --locale= locale to use for translations + --log-level= level of logging verbosity (0-3) + --logfile= file to write logging output to + --private-path= path to private data + --public-path= path to public (client-accesible) data + --temp-path= path to temporary data + +Please refer to the C-manpage for a more detailed description +of these options. + +=cut diff --git a/src/config-db/t/01-basics.t b/src/config-db/t/01-basics.t new file mode 100644 index 00000000..1fb7083b --- /dev/null +++ b/src/config-db/t/01-basics.t @@ -0,0 +1,23 @@ +use Test::More qw(no_plan); + +use lib '/opt/openslx/lib'; + +# basic stuff +use_ok(OpenSLX::ConfigDB); + +use strict; +use warnings; + +# connecting and disconnecting +ok(my $configDB = OpenSLX::ConfigDB->new, 'can create object'); +isa_ok($configDB, 'OpenSLX::ConfigDB'); + +{ + # create a second object - should work and yield different objects + ok(my $configDB2 = OpenSLX::ConfigDB->new, 'can create another object'); + cmp_ok($configDB, 'ne', $configDB2, 'should have two different objects now'); +} + +ok($configDB->connect(), 'connecting'); +ok($configDB->disconnect(), 'disconnecting'); + diff --git a/src/config-db/t/10-vendor-os.t b/src/config-db/t/10-vendor-os.t new file mode 100644 index 00000000..a71ee4ac --- /dev/null +++ b/src/config-db/t/10-vendor-os.t @@ -0,0 +1,258 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +is( + my $vendorOS = $configDB->fetchVendorOSByFilter, undef, + 'no vendor-OS yet (scalar context)' +); + +my $wrongVendorOS = { + 'comment' => 'test', +}; +ok( + ! eval { my $vendorOSID = $configDB->addVendorOS($wrongVendorOS); }, + 'trying to insert an unnamed vendor-OS should fail' +); + +is( + my @vendorOSes = $configDB->fetchVendorOSByFilter, 0, + 'no vendor-OS yet (array context)' +); + +my $inVendorOS1 = { + 'name' => 'vos-1', + 'comment' => '', +}; +is( + my $vendorOS1ID = $configDB->addVendorOS($inVendorOS1), 1, + 'first vendor-OS has ID 1' +); + +my $inVendorOS2 = { + 'name' => 'vos-2.0', + 'comment' => 'batch 2', +}; +my $inVendorOS3 = { + 'name' => 'vos-3.0', + 'comment' => 'batch 2', + 'clone_source' => 'kiwi::test-vos', +}; +ok( + my ($vendorOS2ID, $vendorOS3ID) = $configDB->addVendorOS([ + $inVendorOS2, $inVendorOS3 + ]), + 'add two more vendor-OSes' +); +is($vendorOS2ID, 2, 'vendor-OS 2 should have ID=2'); +is($vendorOS3ID, 3, 'vendor-OS 3 should have ID=3'); + +# fetch vendor-OS 3 by id and check all values +ok(my $vendorOS3 = $configDB->fetchVendorOSByID(3), 'fetch vendor-OS 3'); +is($vendorOS3->{id}, 3, 'vendor-OS 3 - id'); +is($vendorOS3->{name}, 'vos-3.0', 'vendor-OS 3 - name'); +is($vendorOS3->{comment}, 'batch 2', 'vendor-OS 3 - comment'); +is($vendorOS3->{clone_source}, 'kiwi::test-vos', 'vendor-OS 3 - clone_source'); + +# fetch vendor-OS 2 by a filter on id and check all values +ok( + my $vendorOS2 = $configDB->fetchVendorOSByFilter({ id => 2 }), + 'fetch vendor-OS 2 by filter on id' +); +is($vendorOS2->{id}, 2, 'vendor-OS 2 - id'); +is($vendorOS2->{name}, 'vos-2.0', 'vendor-OS 2 - name'); +is($vendorOS2->{comment}, 'batch 2', 'vendor-OS 2 - comment'); +is($vendorOS2->{clone_source}, undef, 'vendor-OS 2 - clone_source'); + +# fetch vendor-OS 1 by filter on name and check all values +ok( + my $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => 'vos-1' }), + 'fetch vendor-OS 1 by filter on name' +); +is($vendorOS1->{id}, 1, 'vendor-OS 1 - id'); +is($vendorOS1->{name}, 'vos-1', 'vendor-OS 1 - name'); +is($vendorOS1->{comment}, '', 'vendor-OS 1 - comment'); +is($vendorOS1->{clone_source}, undef, 'vendor-OS 1 - clone_source'); + +# fetch vendor-OSes 3 & 1 by id +ok( + my @vendorOSes3And1 + = $configDB->fetchVendorOSByID([3, 1]), + 'fetch vendor-OSes 3 & 1 by id' +); +is(@vendorOSes3And1, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 3 and 1 +@vendorOSes3And1 = sort { $a->{id} cmp $b->{id} } @vendorOSes3And1; +is($vendorOSes3And1[0]->{id}, 1, 'first id should be 1'); +is($vendorOSes3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching vendor-OSes by id without giving any should yield undef +is( + $configDB->fetchVendorOSByID(), undef, + 'fetch vendor-OSes by id without giving any' +); + +# fetching vendor-OSes by filter without giving any should yield all of them +ok( + @vendorOSes = $configDB->fetchVendorOSByFilter(), + 'fetch vendor-OSes by filter without giving any' +); +is(@vendorOSes, 3, 'should have got all three vendor-OSes'); + +# fetch vendor-OSes 2 & 3 by filter on comment +ok( + my @vendorOSes2And3 + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2' }), + 'fetch vendor-OSes 2 & 3 by filter on comment' +); +is(@vendorOSes2And3, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 2 and 3 +@vendorOSes2And3 = sort { $a->{id} cmp $b->{id} } @vendorOSes2And3; +is($vendorOSes2And3[0]->{id}, 2, 'first id should be 2'); +is($vendorOSes2And3[1]->{id}, 3, 'second id should be 3'); + +# try to fetch with multi-column filter +ok( + ($vendorOS2, $vendorOS3) + = $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 2 }), + 'fetching vendor-OS with comment="batch 2" and id=2 should work' +); +is($vendorOS2->{name}, 'vos-2.0', 'should have got vos-2.0'); +is($vendorOS3, undef, 'should not get vos-3.0'); + +# try to fetch multiple occurrences of the same vendor-OS, combined with +# some unknown IDs +ok( + my @vendorOSes1And3 + = $configDB->fetchVendorOSByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of vendor-OSes by ID' +); +is(@vendorOSes1And3, 2, 'should have got 2 vendor-OSes'); +# now sort by ID and check if we have really got 1 and 3 +@vendorOSes1And3 = sort { $a->{id} cmp $b->{id} } @vendorOSes1And3; +is($vendorOSes1And3[0]->{id}, 1, 'first id should be 1'); +is($vendorOSes1And3[1]->{id}, 3, 'second id should be 3'); + +# try to fetch a couple of non-existing vendor-OSes by id +is( + $configDB->fetchVendorOSByID(-1), undef, + 'vendor-OS with id -1 should not exist' +); +is( + $configDB->fetchVendorOSByID(0), undef, + 'vendor-OS with id 0 should not exist' +); +is( + $configDB->fetchVendorOSByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown vendor-OS' +); + +# try to fetch a couple of non-existing vendor-OSes by filter +is( + $configDB->fetchVendorOSByFilter({ id => 0 }), undef, + 'fetching vendor-OS with id=0 by filter should fail' +); +is( + $configDB->fetchVendorOSByFilter({ name => 'vos-1.x' }), undef, + 'fetching vendor-OS with name="vos-1.x" should fail' +); +is( + $configDB->fetchVendorOSByFilter({ comment => 'batch 2', id => 1 }), undef, + 'fetching vendor-OS with comment="batch 2" and id=1 should fail' +); + +# rename vendor-OS 1 and then fetch it by its new name +ok($configDB->changeVendorOS(1, { name => q{VOS-'1'} }), 'changing vendor-OS 1'); +ok( + $vendorOS1 = $configDB->fetchVendorOSByFilter({ name => q{VOS-'1'} }), + 'fetching renamed vendor-OS 1' +); +is($vendorOS1->{id}, 1, 'really got vendor-OS number 1'); +is($vendorOS1->{name}, q{VOS-'1'}, q{really got vendor-OS named "VOS-'1'"}); + +# changing nothing at all should succeed +ok($configDB->changeVendorOS(1), 'changing nothing at all in vendor-OS 1'); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeVendorOS(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok(! $configDB->changeVendorOS(1, { id => 23 }), 'changing id should fail'); + +# test adding & removing of installed plugins +is( + my @plugins = $configDB->fetchInstalledPlugins(3), + 0, 'there should be no installed plugins' +); +ok($configDB->addInstalledPlugin(3, 'Example'), 'adding installed plugin'); +is( + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' +); +is( + $configDB->addInstalledPlugin(3, 'Example'), 1, + 'adding plugin again should work (but do not harm, just update the attrs)' +); +is( + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should still have 1 installed plugin' +); +is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); +ok($configDB->addInstalledPlugin(3, 'Test'), 'adding a second plugin'); +is( + @plugins = $configDB->fetchInstalledPlugins(3), + 2, + 'should have 2 installed plugin' +); +ok( + !$configDB->removeInstalledPlugin(3, 'xxx'), + 'removing unknown plugin should fail' +); +ok( + @plugins = $configDB->fetchInstalledPlugins(3, 'Example'), + 'fetching specific plugin' +); +is($plugins[0]->{plugin_name}, 'Example', 'should have got plugin "Example"'); +ok( + @plugins = $configDB->fetchInstalledPlugins(3, 'Test'), + 'fetching another specific plugin' +); +is($plugins[0]->{plugin_name}, 'Test', 'should have got plugin "Test"'); +is( + @plugins = $configDB->fetchInstalledPlugins(3, 'xxx'), 0, + 'fetching unknown specific plugin' +); +ok($configDB->removeInstalledPlugin(3, 'Example'), 'removing installed plugin'); +is( + @plugins = $configDB->fetchInstalledPlugins(3), + 1, + 'should have 1 installed plugin' +); +ok($configDB->removeInstalledPlugin(3, 'Test'), 'removing second plugin'); +is( + @plugins = $configDB->fetchInstalledPlugins(3), + 0, + 'should have no installed plugins' +); + +# now remove a vendor-OS and check if that worked +ok($configDB->removeVendorOS(3), 'removing vendor-OS 3 should be ok'); +is($configDB->fetchVendorOSByID(3, 'id'), undef, 'vendor-OS 3 should be gone'); +is($configDB->fetchVendorOSByID(1)->{id}, 1, 'vendor-OS 1 should still exist'); +is($configDB->fetchVendorOSByID(2)->{id}, 2, 'vendor-OS 2 should still exist'); + +$configDB->disconnect(); + diff --git a/src/config-db/t/11-export.t b/src/config-db/t/11-export.t new file mode 100644 index 00000000..3dd0ae6c --- /dev/null +++ b/src/config-db/t/11-export.t @@ -0,0 +1,247 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +is( + my $export = $configDB->fetchExportByFilter, undef, + 'no export yet (scalar context)' +); + +foreach my $requiredCol (qw(name vendor_os_id type)) { + my $wrongExport = { + 'name' => 'name', + 'vendor_os_id' => 1, + 'type ' => 'nfs', + 'comment' => 'has column missing', + }; + delete $wrongExport->{$requiredCol}; + ok( + ! eval { my $exportID = $configDB->addExport($wrongExport); }, + "inserting an export without '$requiredCol' column should fail" + ); +} + +is( + my @exports = $configDB->fetchExportByFilter, 0, + 'no export yet (array context)' +); + +is( + my @exportIDs = $configDB->fetchExportIDsOfVendorOS(1), 0, + 'vendor-OS 1 has no export IDs yet' +); + +is( + @exportIDs = $configDB->fetchExportIDsOfVendorOS(2), 0, + 'vendor-OS 2 has no export IDs yet' +); + +my $inExport1 = { + 'name' => 'exp-1', + 'type' => 'nfs', + 'vendor_os_id' => 1, + 'comment' => '', +}; +is( + my $export1ID = $configDB->addExport($inExport1), 1, + 'first export has ID 1' +); + +my $inExport2 = { + 'name' => 'exp-2.0', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 1, + 'comment' => undef, +}; +my $fullExport = { + 'name' => 'exp-nr-3', + 'type' => 'sqfs-nbd', + 'vendor_os_id' => 2, + 'comment' => 'nuff said', + 'server_ip' => '192.168.212.243', + 'port' => '65432', + 'uri' => 'sqfs-nbd://somehost/somepath?param=val&yes=1', +}; +ok( + my ($export2ID, $export3ID) = $configDB->addExport([ + $inExport2, $fullExport + ]), + 'add two more exports' +); +is($export2ID, 2, 'export 2 should have ID=2'); +is($export3ID, 3, 'export 3 should have ID=3'); + +# fetch export 3 by id and check all values +ok(my $export3 = $configDB->fetchExportByID(3), 'fetch export 3'); +is($export3->{id}, 3, 'export 3 - id'); +is($export3->{name}, 'exp-nr-3', 'export 3 - name'); +is($export3->{type}, 'sqfs-nbd', 'export 3 - type'); +is($export3->{vendor_os_id}, '2', 'export 3 - vendor_os_id'); +is($export3->{comment}, 'nuff said', 'export 3 - comment'); +is($export3->{server_ip}, '192.168.212.243', 'export 3 - server_ip'); +is($export3->{port}, '65432', 'export 3 - port'); +is( + $export3->{uri}, + 'sqfs-nbd://somehost/somepath?param=val&yes=1', + 'export 3 - uri' +); + +# fetch export 2 by a filter on id and check all values +ok( + my $export2 = $configDB->fetchExportByFilter({ id => 2 }), + 'fetch export 2 by filter on id' +); +is($export2->{id}, 2, 'export 2 - id'); +is($export2->{name}, 'exp-2.0', 'export 2 - name'); +is($export2->{type}, 'sqfs-nbd', 'export 2 - type'); +is($export2->{vendor_os_id}, '1', 'export 2 - vendor_os_id'); +is($export2->{comment}, undef, 'export 2 - comment'); + +# fetch export 1 by filter on name and check all values +ok( + my $export1 = $configDB->fetchExportByFilter({ name => 'exp-1' }), + 'fetch export 1 by filter on name' +); +is($export1->{id}, 1, 'export 1 - id'); +is($export1->{name}, 'exp-1', 'export 1 - name'); +is($export1->{vendor_os_id}, '1', 'export 1 - vendor_os_id'); +is($export1->{type}, 'nfs', 'export 1 - type'); +is($export1->{comment}, '', 'export 1 - comment'); +is($export1->{port}, undef, 'export 1 - port'); +is($export1->{server_ip}, undef, 'export 1 - server_ip'); +is($export1->{uri}, undef, 'export 1 - uri'); + +is( + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(1)), + 2, 'vendor-OS 1 has two export IDs' +); +is($exportIDs[0], 1, 'first export ID of vendor-OS 1 (1)'); +is($exportIDs[1], 2, 'second export ID of vendor-OS 1 (2)'); + +is( + @exportIDs = sort( { $a <=> $b } $configDB->fetchExportIDsOfVendorOS(2)), + 1, 'vendor-OS 2 has one export IDs' +); +is($exportIDs[0], 3, 'first export ID of vendor-OS 2 (3)'); + +# fetch exports 3 & 1 by id +ok( + my @exports3And1 = $configDB->fetchExportByID([3, 1]), + 'fetch exports 3 & 1 by id' +); +is(@exports3And1, 2, 'should have got 2 exports'); +# now sort by ID and check if we have really got 3 and 1 +@exports3And1 = sort { $a->{id} cmp $b->{id} } @exports3And1; +is($exports3And1[0]->{id}, 1, 'first id should be 1'); +is($exports3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching exports by id without giving any should yield undef +is( + $configDB->fetchExportByID(), undef, + 'fetch exports by id without giving any' +); + +# fetching exports by filter without giving any should yield all of them +ok( + @exports = $configDB->fetchExportByFilter(), + 'fetch exports by filter without giving any' +); +is(@exports, 3, 'should have got all three exports'); + +# fetch exports 1 & 2 by filter on vendor_os_id +ok( + my @exports1And2 = $configDB->fetchExportByFilter({ vendor_os_id => '1' }), + 'fetch exports 1 & 2 by filter on vendor_os_id' +); +is(@exports1And2, 2, 'should have got 2 exports'); +# now sort by ID and check if we have really got 1 and 2 +@exports1And2 = sort { $a->{id} cmp $b->{id} } @exports1And2; +is($exports1And2[0]->{id}, 1, 'first id should be 1'); +is($exports1And2[1]->{id}, 2, 'second id should be 2'); + +# try to fetch with multi-column filter +ok( + ($export2, $export3) + = $configDB->fetchExportByFilter({ vendor_os_id => '1', id => 2 }), + 'fetching export with vendor_os_id=1 and id=2 should work' +); +is($export2->{name}, 'exp-2.0', 'should have got exp-2.0'); +is($export3, undef, 'should not get exp-nr-3'); + +# try to fetch multiple occurrences of the same export, combined with +# some unknown IDs +ok( + my @exports1And3 = $configDB->fetchExportByID([ 1, 21, 4-1, 1, 0, 1, 1 ]), + 'fetch a complex set of exports by ID' +); +is(@exports1And3, 2, 'should have got 2 exports'); +# now sort by ID and check if we have really got 1 and 3 +@exports1And3 = sort { $a->{id} cmp $b->{id} } @exports1And3; +is($exports1And3[0]->{id}, 1, 'first id should be 1'); +is($exports1And3[1]->{id}, 3, 'second id should be 3'); + +# try to fetch a couple of non-existing exports by id +is( + $configDB->fetchExportByID(-1), undef, + 'export with id -1 should not exist' +); +is( + $configDB->fetchExportByID(0), undef, + 'export with id 0 should not exist' +); +is( + $configDB->fetchExportByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown export' +); + +# try to fetch a couple of non-existing exports by filter +is( + $configDB->fetchExportByFilter({ id => 0 }), undef, + 'fetching export with id=0 by filter should fail' +); +is( + $configDB->fetchExportByFilter({ name => 'exp-1.x' }), undef, + 'fetching export with name="exp-1.x" should fail' +); +is( + $configDB->fetchExportByFilter({ vendor_os_id => '2', id => 1 }), undef, + 'fetching export with vendor_os_id=2 and id=1 should fail' +); + +# rename export 1 and then fetch it by its new name +ok($configDB->changeExport(1, { name => q{EXP-'1'} }), 'changing export 1'); +ok( + $export1 = $configDB->fetchExportByFilter({ name => q{EXP-'1'} }), + 'fetching renamed export 1' +); +is($export1->{id}, 1, 'really got export number 1'); +is($export1->{name}, q{EXP-'1'}, q{really got export named "EXP-'1'"}); + +# changing nothing at all should succeed +ok($configDB->changeExport(1), 'changing nothing at all in export 1'); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeExport(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok(! $configDB->changeExport(1, { id => 23 }), 'changing id should fail'); + +# now remove an export and check if that worked +ok($configDB->removeExport(2), 'removing export 2 should be ok'); +is($configDB->fetchExportByID(2, 'id'), undef, 'export 2 should be gone'); +is($configDB->fetchExportByID(1)->{id}, 1, 'export 1 should still exist'); +is($configDB->fetchExportByID(3)->{id}, 3, 'export 3 should still exist'); + +$configDB->disconnect(); + diff --git a/src/config-db/t/12-system.t b/src/config-db/t/12-system.t new file mode 100644 index 00000000..0c3a3042 --- /dev/null +++ b/src/config-db/t/12-system.t @@ -0,0 +1,360 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +ok( + my $system = $configDB->fetchSystemByFilter, + 'one system [default] should exist (scalar context)' +); + +foreach my $requiredCol (qw(name export_id)) { + my $wrongSystem = { + 'name' => 'name', + 'export_id' => 1, + 'comment' => 'has column missing', + }; + delete $wrongSystem->{$requiredCol}; + ok( + ! eval { my $systemID = $configDB->addSystem($wrongSystem); }, + "inserting a system without '$requiredCol' column should fail" + ); +} + +is( + my @systems = $configDB->fetchSystemByFilter, 1, + 'still just one system [default] should exist (array context)' +); + +my $inSystem1 = { + 'name' => 'sys-1', + 'export_id' => 1, + 'comment' => '', + 'attrs' => { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'e1000 forcedeth r8169', + 'start_sshd' => 'yes', + }, +}; +is( + my $system1ID = $configDB->addSystem($inSystem1), 1, + 'first system has ID 1' +); + +my $inSystem2 = { + 'name' => 'sys-2.0', + 'kernel' => 'vmlinuz', + 'export_id' => 1, + 'comment' => undef, +}; +my $fullSystem = { + 'name' => 'sys-nr-3', + 'kernel' => 'vmlinuz-2.6.22.13-0.3-default', + 'export_id' => 3, + 'comment' => 'nuff said', + 'label' => 'BlingBling System - really kuul!', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'hidden' => '1', + 'kernel_params' => 'debug=3 console=ttyS1', + 'ramfs_fsmods' => 'l', + 'ramfs_miscmods' => 'm', + 'ramfs_nicmods' => 'n', + 'scratch' => 'q', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'timezone' => 'G', + }, +}; +ok( + my ($system2ID, $system3ID) = $configDB->addSystem([ + $inSystem2, $fullSystem + ]), + 'add two more systems' +); +is($system2ID, 2, 'system 2 should have ID=2'); +is($system3ID, 3, 'system 3 should have ID=3'); + +# fetch system 3 by id and check all values +ok(my $system3 = $configDB->fetchSystemByID(3), 'fetch system 3'); +is($system3->{id}, '3', 'system 3 - id'); +is($system3->{name}, 'sys-nr-3', 'system 3 - name'); +is($system3->{kernel}, 'vmlinuz-2.6.22.13-0.3-default', 'system 3 - type'); +is($system3->{export_id}, '3', 'system 3 - export_id'); +is($system3->{comment}, 'nuff said', 'system 3 - comment'); +is($system3->{label}, 'BlingBling System - really kuul!', 'system 3 - label'); +is($system3->{attrs}->{automnt_dir}, 'a', 'system 3 - attr automnt_dir'); +is($system3->{attrs}->{automnt_src}, 'b', 'system 3 - attr automnt_src'); +is($system3->{attrs}->{country}, 'c', 'system 3 - attr country'); +is($system3->{attrs}->{hidden}, '1', 'system 3 - attr hidden'); +is($system3->{attrs}->{kernel_params}, 'debug=3 console=ttyS1', 'system 3 - attr kernel_params'); +is($system3->{attrs}->{ramfs_fsmods}, 'l', 'system 3 - attr ramfs_fsmods'); +is($system3->{attrs}->{ramfs_miscmods}, 'm', 'system 3 - attr ramfs_miscmods'); +is($system3->{attrs}->{ramfs_nicmods}, 'n', 'system 3 - attr ramfs_nicmods'); +is($system3->{attrs}->{scratch}, 'q', 'system 3 - attr scratch'); +is($system3->{attrs}->{start_atd}, 't', 'system 3 - attr start_atd'); +is($system3->{attrs}->{start_cron}, 'u', 'system 3 - attr start_cron'); +is($system3->{attrs}->{start_dreshal}, 'v', 'system 3 - attr start_dreshal'); +is($system3->{attrs}->{start_ntp}, 'w', 'system 3 - attr start_ftp'); +is($system3->{attrs}->{start_nfsv4}, 'x', 'system 3 - attr start_nfsv4'); +is($system3->{attrs}->{start_snmp}, 'A', 'system 3 - attr start_snmp'); +is($system3->{attrs}->{start_sshd}, 'B', 'system 3 - attr start_sshd'); +is($system3->{attrs}->{timezone}, 'G', 'system 3 - attr timezone'); +is(keys %{$system3->{attrs}}, 17, 'system 3 - attribute count'); + +# fetch system 2 by a filter on id and check all values +ok( + my $system2 = $configDB->fetchSystemByFilter({ id => 2 }), + 'fetch system 2 by filter on id' +); +is($system2->{id}, 2, 'system 2 - id'); +is($system2->{name}, 'sys-2.0', 'system 2 - name'); +is($system2->{kernel}, 'vmlinuz', 'system 2 - kernel'); +is($system2->{export_id}, '1', 'system 2 - export_id'); +is($system2->{comment}, undef, 'system 2 - comment'); +is(keys %{$system2->{attrs}}, 0, 'system 2 - attribute count'); + +# fetch system 1 by filter on name and check all values +ok( + my $system1 = $configDB->fetchSystemByFilter({ name => 'sys-1' }), + 'fetch system 1 by filter on name' +); +is($system1->{id}, 1, 'system 1 - id'); +is($system1->{name}, 'sys-1', 'system 1 - name'); +is($system1->{export_id}, '1', 'system 1 - export_id'); +is($system1->{kernel}, 'vmlinuz', 'system 1 - kernel'); +is($system1->{comment}, '', 'system 1 - comment'); +is($system1->{label}, 'sys-1', 'system 1 - label'); +is(keys %{$system1->{attrs}}, 3, 'system 1 - attribute count'); +is($system1->{attrs}->{ramfs_fsmods}, 'squashfs', 'system 1 - attr ramfs_fsmods'); +is($system1->{attrs}->{ramfs_nicmods}, 'e1000 forcedeth r8169', 'system 1 - attr ramfs_nicmods'); +is($system1->{attrs}->{start_sshd}, 'yes', 'system 1 - attr start_sshd'); + +# fetch systems 3 & 1 by id +ok( + my @systems3And1 = $configDB->fetchSystemByID([3, 1]), + 'fetch systems 3 & 1 by id' +); +is(@systems3And1, 2, 'should have got 2 systems'); +# now sort by ID and check if we have really got 3 and 1 +@systems3And1 = sort { $a->{id} cmp $b->{id} } @systems3And1; +is($systems3And1[0]->{id}, 1, 'first id should be 1'); +is($systems3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching systems by id without giving any should yield undef +is( + $configDB->fetchSystemByID(), undef, + 'fetch systems by id without giving any' +); + +# fetching systems by filter without giving any should yield all of them +ok( + @systems = $configDB->fetchSystemByFilter(), + 'fetch systems by filter without giving any' +); +is(@systems, 4, 'should have got all four systems'); + +# fetch systems 1 & 2 by filter on export_id +ok( + my @systems1And2 = $configDB->fetchSystemByFilter({ export_id => '1' }), + 'fetch systems 1 & 2 by filter on export_id' +); +is(@systems1And2, 2, 'should have got 2 systems'); +# now sort by ID and check if we have really got 1 and 2 +@systems1And2 = sort { $a->{id} cmp $b->{id} } @systems1And2; +is($systems1And2[0]->{id}, 1, 'first id should be 1'); +is($systems1And2[1]->{id}, 2, 'second id should be 2'); + +# try to fetch with multi-column filter +ok( + ($system2, $system3) + = $configDB->fetchSystemByFilter({ export_id => '1', id => 2 }), + 'fetching system with export_id=1 and id=2 should work' +); +is($system2->{name}, 'sys-2.0', 'should have got sys-2.0'); +is($system3, undef, 'should not get sys-nr-3'); + +# try to fetch multiple occurrences of the same system, combined with +# some unknown IDs +ok( + my @systems1And3 = $configDB->fetchSystemByID([ 1, 21, 4-1, 1, 3, 1, 1 ]), + 'fetch a complex set of systems by ID' +); +is(@systems1And3, 2, 'should have got 2 systems'); +# now sort by ID and check if we have really got 1 and 3 +@systems1And3 = sort { $a->{id} cmp $b->{id} } @systems1And3; +is($systems1And3[0]->{id}, 1, 'first id should be 1'); +is($systems1And3[1]->{id}, 3, 'second id should be 3'); + +# filter systems by different attributes & values in combination +ok( + my @system1Only = $configDB->fetchSystemByFilter( {}, undef, { + ramfs_nicmods => 'e1000 forcedeth r8169' + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' +); + +is(@system1Only, 1, 'should have got 1 system'); +is($system1Only[0]->{id}, 1, 'first id should be 1'); + +ok( + @system1Only = $configDB->fetchSystemByFilter( undef, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by filter on attribute ramfs_nicmods' +); +is(@system1Only, 1, 'should have got 1 system'); +is($system1Only[0]->{id}, 1, 'first id should be 1'); + +ok( + @system1Only = $configDB->fetchSystemByFilter( { + export_id => 1, + comment => '', + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + 'fetch system 1 by multiple filter on values and attributes' +); +is(@system1Only, 1, 'should have got 1 system'); +is($system1Only[0]->{id}, 1, 'first id should be 1'); + +is( + $configDB->fetchSystemByFilter( { + export_id => 2, + }, 'id', { + ramfs_nicmods => 'e1000 forcedeth r8169', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect value' +); +is( + $configDB->fetchSystemByFilter( { + export_id => 1, + }, 'id', { + ramfs_nicmods => 'xxxx', + slxgrp => undef, + } ), + undef, + 'mismatch system 1 by filter with incorrect attribute value' +); +is( + $configDB->fetchSystemByFilter( { + name => 'sys-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch system 1 by filter with attribute not being empty' +); + +# fetch systems 1 & 2 by filter on attribute start_samba not existing +ok( + @systems1And2 = $configDB->fetchSystemByFilter( {}, undef, { + start_snmp => undef, + } ), + 'fetch systems 1 & 2 by filter on attribute start_snmp not existing' +); +is(@systems1And2, 2, 'should have got 2 systems'); +# now sort by ID and check if we have really got 1 and 2 +@systems1And2 = sort { $a->{id} cmp $b->{id} } @systems1And2; +is($systems1And2[0]->{id}, 1, 'first id should be 1'); +is($systems1And2[1]->{id}, 2, 'second id should be 2'); + +# try to fetch a couple of non-existing systems by id +is( + $configDB->fetchSystemByID(-1), undef, + 'system with id -1 should not exist' +); +ok($configDB->fetchSystemByID(0), 'system with id 0 should exist'); +is( + $configDB->fetchSystemByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown system' +); + +# try to fetch a couple of non-existing systems by filter +is( + $configDB->fetchSystemByFilter({ id => 4 }), undef, + 'fetching system with id=4 by filter should fail' +); +is( + $configDB->fetchSystemByFilter({ name => 'sys-1.x' }), undef, + 'fetching system with name="sys-1.x" should fail' +); +is( + $configDB->fetchSystemByFilter({ export_id => '2', id => 1 }), undef, + 'fetching system with export_id=2 and id=1 should fail' +); + +# rename system 1 and then fetch it by its new name +ok($configDB->changeSystem(1, { name => q{SYS-'1'} }), 'changing system 1'); +ok( + $system1 = $configDB->fetchSystemByFilter({ name => q{SYS-'1'} }), + 'fetching renamed system 1' +); +is($system1->{id}, 1, 'really got system number 1'); +is($system1->{name}, q{SYS-'1'}, q{really got system named "SYS-'1'"}); + +# changing nothing at all should succeed +ok($configDB->changeSystem(1), 'changing nothing at all in system 1'); + +# adding attributes should work +$inSystem1->{attrs}->{slxgrp} = 'slxgrp1'; +$inSystem1->{attrs}->{vmware} = 'yes'; +ok($configDB->changeSystem(1, $inSystem1), 'adding attrs to system 1'); +$system1 = $configDB->fetchSystemByID(1); +is($system1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($system1->{attrs}->{vmware}, 'yes', 'attr vmware has correct value'); + +# changing an attribute should work +$inSystem1->{attrs}->{vmware} = 'no'; +ok($configDB->changeSystem(1, $inSystem1), 'changing vmware in system 1'); +$system1 = $configDB->fetchSystemByID(1); +is($system1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($system1->{attrs}->{vmware}, 'no', 'attr vmware has correct value'); + +# deleting an attribute should remove it +delete $inSystem1->{attrs}->{slxgrp}; +ok($configDB->changeSystem(1, $inSystem1), 'changing slxgrp in system 1'); +$system1 = $configDB->fetchSystemByID(1); +ok(!exists $system1->{attrs}->{slxgrp}, 'attr slxgrp should be gone'); + +# undef'ing an attribute should remove it, too +$inSystem1->{attrs}->{vmware} = undef; +ok($configDB->changeSystem(1, $inSystem1), 'undefining vmware in system 1'); +$system1 = $configDB->fetchSystemByID(1); +ok(!exists $system1->{attrs}->{vmware}, 'attr vmware should be gone'); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeSystem(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok(! $configDB->changeSystem(1, { id => 23 }), 'changing id should fail'); + +# now remove an system and check if that worked +ok($configDB->removeSystem(2), 'removing system 2 should be ok'); +is($configDB->fetchSystemByID(2, 'id'), undef, 'system 2 should be gone'); +is($configDB->fetchSystemByID(1)->{id}, 1, 'system 1 should still exist'); +is($configDB->fetchSystemByID(3)->{id}, 3, 'system 3 should still exist'); + +$configDB->disconnect(); + diff --git a/src/config-db/t/13-client.t b/src/config-db/t/13-client.t new file mode 100644 index 00000000..8be71518 --- /dev/null +++ b/src/config-db/t/13-client.t @@ -0,0 +1,320 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +ok( + my $client = $configDB->fetchClientByFilter, + 'one client [default] should exist (scalar context)' +); + +foreach my $requiredCol (qw(name mac)) { + my $wrongClient = { + 'name' => 'name', + 'mac' => '01:02:03:04:05:06', + 'comment' => 'has column missing', + }; + delete $wrongClient->{$requiredCol}; + ok( + ! eval { my $clientID = $configDB->addClient($wrongClient); }, + "inserting a client without '$requiredCol' column should fail" + ); +} + +is( + my @clients = $configDB->fetchClientByFilter, 1, + 'still just one client [default] should exist (array context)' +); + +my $inClient1 = { + 'name' => 'cli-1', + 'mac' => '01:02:03:04:05:01', + 'comment' => '', + 'attrs' => { + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, +}; +is( + my $client1ID = $configDB->addClient($inClient1), 1, + 'first client has ID 1' +); + +my $inClient2 = { + 'name' => 'cli-2.0', + 'mac' => '01:02:03:04:05:02', + 'comment' => undef, + 'attrs' => { + 'boot_type' => 'etherboot', + 'unbootable' => 1, + } +}; +my $fullClient = { + 'name' => 'cli-nr-3', + 'mac' => '01:02:03:04:05:03', + 'comment' => 'nuff said', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'boot_type' => 'pxe', + 'country' => 'c', + 'kernel_params_client' => 'debug=3 console=ttyS1', + 'scratch' => 'q', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'timezone' => 'G', + 'unbootable' => '0', + }, +}; +ok( + my ($client2ID, $client3ID) = $configDB->addClient([ + $inClient2, $fullClient + ]), + 'add two more clients' +); +is($client2ID, 2, 'client 2 should have ID=2'); +is($client3ID, 3, 'client 3 should have ID=3'); + +# fetch client 3 by id and check all values +ok(my $client3 = $configDB->fetchClientByID(3), 'fetch client 3'); +is($client3->{id}, '3', 'client 3 - id'); +is($client3->{name}, 'cli-nr-3', 'client 3 - name'); +is($client3->{mac}, '01:02:03:04:05:03', 'client 3 - mac'); +is($client3->{comment}, 'nuff said', 'client 3 - comment'); +is($client3->{attrs}->{automnt_dir}, 'a', 'client 3 - attr automnt_dir'); +is($client3->{attrs}->{automnt_src}, 'b', 'client 3 - attr automnt_src'); +is($client3->{attrs}->{boot_type}, 'pxe', 'client 3 - attr boot_type'); +is($client3->{attrs}->{country}, 'c', 'client 3 - attr country'); +is($client3->{attrs}->{kernel_params_client}, 'debug=3 console=ttyS1', 'client 3 - attr kernel_params_client'); +is($client3->{attrs}->{scratch}, 'q', 'client 3 - attr scratch'); +is($client3->{attrs}->{start_atd}, 't', 'client 3 - attr start_atd'); +is($client3->{attrs}->{start_cron}, 'u', 'client 3 - attr start_cron'); +is($client3->{attrs}->{start_dreshal}, 'v', 'client 3 - attr start_dreshal'); +is($client3->{attrs}->{start_ntp}, 'w', 'client 3 - attr start_ftp'); +is($client3->{attrs}->{start_nfsv4}, 'x', 'client 3 - attr start_nfsv4'); +is($client3->{attrs}->{start_snmp}, 'A', 'client 3 - attr start_snmp'); +is($client3->{attrs}->{start_sshd}, 'B', 'client 3 - attr start_sshd'); +is($client3->{attrs}->{timezone}, 'G', 'client 3 - attr timezone'); +is($client3->{attrs}->{unbootable}, '0', 'client 3 - attr unbootable'); +is(keys %{$client3->{attrs}}, 15, 'client 3 - attribute count'); + +# fetch client 2 by a filter on id and check all values +ok( + my $client2 = $configDB->fetchClientByFilter({ id => 2 }), + 'fetch client 2 by filter on id' +); +is($client2->{id}, 2, 'client 2 - id'); +is($client2->{name}, 'cli-2.0', 'client 2 - name'); +is($client2->{mac}, '01:02:03:04:05:02', 'client 2 - mac'); +is($client2->{comment}, undef, 'client 2 - comment'); +is(keys %{$client2->{attrs}}, 2, 'client 2 - attribute count'); +is($client2->{attrs}->{boot_type}, 'etherboot', 'client 2 - attr boot_type'); +is($client2->{attrs}->{unbootable}, '1', 'client 2 - attr unbootable'); + +# fetch client 1 by filter on name and check all values +ok( + my $client1 = $configDB->fetchClientByFilter({ name => 'cli-1' }), + 'fetch client 1 by filter on name' +); +is($client1->{id}, 1, 'client 1 - id'); +is($client1->{name}, 'cli-1', 'client 1 - name'); +is($client1->{mac}, '01:02:03:04:05:01', 'client 1 - mac'); +is($client1->{comment}, '', 'client 1 - comment'); +is(keys %{$client1->{attrs}}, 2, 'client 1 - attribute count'); +is($client1->{attrs}->{start_snmp}, 'no', 'client 1 - attr start_snmp'); +is($client1->{attrs}->{start_sshd}, 'yes', 'client 1 - attr start_sshd'); + +# fetch clients 3 & 1 by id +ok( + my @clients3And1 = $configDB->fetchClientByID([3, 1]), + 'fetch clients 3 & 1 by id' +); +is(@clients3And1, 2, 'should have got 2 clients'); +# now sort by ID and check if we have really got 3 and 1 +@clients3And1 = sort { $a->{id} cmp $b->{id} } @clients3And1; +is($clients3And1[0]->{id}, 1, 'first id should be 1'); +is($clients3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching clients by id without giving any should yield undef +is( + $configDB->fetchClientByID(), undef, + 'fetch clients by id without giving any' +); + +# fetching clients by filter without giving any should yield all of them +ok( + @clients = $configDB->fetchClientByFilter(), + 'fetch clients by filter without giving any' +); +is(@clients, 4, 'should have got all four clients'); + +# try to fetch multiple occurrences of the same client, combined with +# some unknown IDs +ok( + my @clients1And3 = $configDB->fetchClientByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of clients by ID' +); +is(@clients1And3, 2, 'should have got 2 clients'); +# now sort by ID and check if we have really got 1 and 3 +@clients1And3 = sort { $a->{id} cmp $b->{id} } @clients1And3; +is($clients1And3[0]->{id}, 1, 'first id should be 1'); +is($clients1And3[1]->{id}, 3, 'second id should be 3'); + +# filter clients by different attributes & values in combination +ok( + my @client1Only = $configDB->fetchClientByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch client 1 by filter on attribute start_snmp' +); + +is(@client1Only, 1, 'should have got 1 client'); +is($client1Only[0]->{id}, 1, 'first id should be 1'); + +ok( + @client1Only = $configDB->fetchClientByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch client 1 by filter on attribute start_snmp + non-existing attr' +); +is(@client1Only, 1, 'should have got 1 client'); +is($client1Only[0]->{id}, 1, 'first id should be 1'); + +is( + $configDB->fetchClientByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + start_dreshal => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect value' +); +is( + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_snmp => 'yes', + start_dreshal => undef, + } ), + undef, + 'mismatch client 1 by filter with incorrect attribute value' +); +is( + $configDB->fetchClientByFilter( { + name => 'cli-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch client 1 by filter with attribute not being empty' +); + +# fetch clients 0, 1 & 2 by filter on attribute start_dreshal not existing +ok( + my @clients01And2 = $configDB->fetchClientByFilter( {}, undef, { + start_dreshal => undef, + } ), + 'fetch clients 0,1 & 2 by filter on attribute start_dreshal not existing' +); +is(@clients01And2, 3, 'should have got 3 clients'); +# now sort by ID and check if we have really got 0, 1 and 2 +@clients01And2 = sort { $a->{id} cmp $b->{id} } @clients01And2; +is($clients01And2[0]->{id}, 0, 'first id should be 0'); +is($clients01And2[1]->{id}, 1, 'second id should be 1'); +is($clients01And2[2]->{id}, 2, 'third id should be 2'); + +# try to fetch a couple of non-existing clients by id +is( + $configDB->fetchClientByID(-1), undef, + 'client with id -1 should not exist' +); +ok($configDB->fetchClientByID(0), 'client with id 0 should exist'); +is( + $configDB->fetchClientByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown client' +); + +# try to fetch a couple of non-existing clients by filter +is( + $configDB->fetchClientByFilter({ id => 4 }), undef, + 'fetching client with id=4 by filter should fail' +); +is( + $configDB->fetchClientByFilter({ name => 'cli-1.x' }), undef, + 'fetching client with name="cli-1.x" should fail' +); +is( + $configDB->fetchClientByFilter({ mac => '01:01:01:01:01:01', id => 1 }), undef, + 'fetching client with mac=01:01:01:01:01:01 and id=1 should fail' +); + +# rename client 1 and then fetch it by its new name +ok($configDB->changeClient(1, { name => q{CLI-'1'} }), 'changing client 1'); +ok( + $client1 = $configDB->fetchClientByFilter({ name => q{CLI-'1'} }), + 'fetching renamed client 1' +); +is($client1->{id}, 1, 'really got client number 1'); +is($client1->{name}, q{CLI-'1'}, q{really got client named "CLI-'1'"}); + +# changing nothing at all should succeed +ok($configDB->changeClient(1), 'changing nothing at all in client 1'); + +# adding attributes should work +$inClient1->{attrs}->{slxgrp} = 'slxgrp1'; +$inClient1->{attrs}->{vmware} = 'yes'; +ok($configDB->changeClient(1, $inClient1), 'adding attrs to client 1'); +$client1 = $configDB->fetchClientByID(1); +is($client1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($client1->{attrs}->{vmware}, 'yes', 'attr vmware has correct value'); + +# changing an attribute should work +$inClient1->{attrs}->{vmware} = 'no'; +ok($configDB->changeClient(1, $inClient1), 'changing vmware in client 1'); +$client1 = $configDB->fetchClientByID(1); +is($client1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($client1->{attrs}->{vmware}, 'no', 'attr vmware has correct value'); + +# deleting an attribute should remove it +delete $inClient1->{attrs}->{slxgrp}; +ok($configDB->changeClient(1, $inClient1), 'changing slxgrp in client 1'); +$client1 = $configDB->fetchClientByID(1); +ok(!exists $client1->{attrs}->{slxgrp}, 'attr slxgrp should be gone'); + +# undef'ing an attribute should remove it, too +$inClient1->{attrs}->{vmware} = undef; +ok($configDB->changeClient(1, $inClient1), 'undefining vmware in client 1'); +$client1 = $configDB->fetchClientByID(1); +ok(!exists $client1->{attrs}->{vmware}, 'attr vmware should be gone'); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeClient(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok(! $configDB->changeClient(1, { id => 23 }), 'changing id should fail'); + +# now remove an client and check if that worked +ok($configDB->removeClient(2), 'removing client 2 should be ok'); +is($configDB->fetchClientByID(2, 'id'), undef, 'client 2 should be gone'); +is($configDB->fetchClientByID(1)->{id}, 1, 'client 1 should still exist'); +is($configDB->fetchClientByID(3)->{id}, 3, 'client 3 should still exist'); + +$configDB->disconnect(); + diff --git a/src/config-db/t/14-group.t b/src/config-db/t/14-group.t new file mode 100644 index 00000000..5c5d0f81 --- /dev/null +++ b/src/config-db/t/14-group.t @@ -0,0 +1,384 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +is( + my $group = $configDB->fetchGroupByFilter, undef, + 'no group should exist (scalar context)' +); + +foreach my $requiredCol (qw(name)) { + my $wrongGroup = { + 'name' => 'name', + 'priority' => 41, + 'comment' => 'has column missing', + }; + delete $wrongGroup->{$requiredCol}; + ok( + ! eval { my $groupID = $configDB->addGroup($wrongGroup); }, + "inserting a group without '$requiredCol' column should fail" + ); +} + +is( + my @groups = $configDB->fetchGroupByFilter, 0, + 'still no group should exist (array context)' +); + +my $inGroup1 = { + 'name' => 'grp-1', + 'comment' => '', + 'attrs' => { + 'slxgrp' => 'slxgrp', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + }, +}; +is( + my $group1ID = $configDB->addGroup($inGroup1), 1, + 'first group has ID 1' +); + +my $inGroup2 = { + 'name' => 'grp-2.0', + 'priority' => 30, + 'comment' => undef, +}; +my $fullGroup = { + 'name' => 'grp-nr-3', + 'priority' => 50, + 'comment' => 'nuff said', + 'attrs' => { + 'automnt_dir' => 'a', + 'automnt_src' => 'b', + 'country' => 'c', + 'dm_allow_shutdown' => 'd', + 'hw_graphic' => 'e', + 'hw_monitor' => 'f', + 'hw_mouse' => 'g', + 'late_dm' => 'h', + 'netbios_workgroup' => 'i', + 'nis_domain' => 'j', + 'nis_servers' => 'k', + 'sane_scanner' => 'p', + 'scratch' => 'q', + 'slxgrp' => 'r', + 'start_alsasound' => 's', + 'start_atd' => 't', + 'start_cron' => 'u', + 'start_dreshal' => 'v', + 'start_ntp' => 'w', + 'start_nfsv4' => 'x', + 'start_printer' => 'y', + 'start_samba' => 'z', + 'start_snmp' => 'A', + 'start_sshd' => 'B', + 'start_syslog' => 'C', + 'start_x' => 'D', + 'start_xdmcp' => 'E', + 'tex_enable' => 'F', + 'timezone' => 'G', + 'tvout' => 'H', + 'vmware' => 'I', + }, +}; +ok( + my ($group2ID, $group3ID) = $configDB->addGroup([ + $inGroup2, $fullGroup + ]), + 'add two more groups' +); +is($group2ID, 2, 'group 2 should have ID=2'); +is($group3ID, 3, 'group 3 should have ID=3'); + +# fetch group 3 by id and check all values +ok(my $group3 = $configDB->fetchGroupByID(3), 'fetch group 3'); +is($group3->{id}, '3', 'group 3 - id'); +is($group3->{name}, 'grp-nr-3', 'group 3 - name'); +is($group3->{priority}, 50, 'group 3 - priority'); +is($group3->{comment}, 'nuff said', 'group 3 - comment'); +is($group3->{attrs}->{automnt_dir}, 'a', 'group 3 - attr automnt_dir'); +is($group3->{attrs}->{automnt_src}, 'b', 'group 3 - attr automnt_src'); +is($group3->{attrs}->{country}, 'c', 'group 3 - attr country'); +is($group3->{attrs}->{dm_allow_shutdown}, 'd', 'group 3 - attr dm_allow_shutdown'); +is($group3->{attrs}->{hw_graphic}, 'e', 'group 3 - attr hw_graphic'); +is($group3->{attrs}->{hw_monitor}, 'f', 'group 3 - attr hw_monitor'); +is($group3->{attrs}->{hw_mouse}, 'g', 'group 3 - attr hw_mouse'); +is($group3->{attrs}->{late_dm}, 'h', 'group 3 - attr late_dm'); +is($group3->{attrs}->{netbios_workgroup}, 'i', 'group 3 - attr netbios_workgroup'); +is($group3->{attrs}->{nis_domain}, 'j', 'group 3 - attr nis_domain'); +is($group3->{attrs}->{nis_servers}, 'k', 'group 3 - attr nis_servers'); +is($group3->{attrs}->{sane_scanner}, 'p', 'group 3 - attr sane_scanner'); +is($group3->{attrs}->{scratch}, 'q', 'group 3 - attr scratch'); +is($group3->{attrs}->{slxgrp}, 'r', 'group 3 - attr slxgrp'); +is($group3->{attrs}->{start_alsasound}, 's', 'group 3 - attr start_alsasound'); +is($group3->{attrs}->{start_atd}, 't', 'group 3 - attr start_atd'); +is($group3->{attrs}->{start_cron}, 'u', 'group 3 - attr start_cron'); +is($group3->{attrs}->{start_dreshal}, 'v', 'group 3 - attr start_dreshal'); +is($group3->{attrs}->{start_ntp}, 'w', 'group 3 - attr start_ftp'); +is($group3->{attrs}->{start_nfsv4}, 'x', 'group 3 - attr start_nfsv4'); +is($group3->{attrs}->{start_printer}, 'y', 'group 3 - attr start_printer'); +is($group3->{attrs}->{start_samba}, 'z', 'group 3 - attr start_samba'); +is($group3->{attrs}->{start_snmp}, 'A', 'group 3 - attr start_snmp'); +is($group3->{attrs}->{start_sshd}, 'B', 'group 3 - attr start_sshd'); +is($group3->{attrs}->{start_syslog}, 'C', 'group 3 - attr start_syslog'); +is($group3->{attrs}->{start_x}, 'D', 'group 3 - attr start_x'); +is($group3->{attrs}->{start_xdmcp}, 'E', 'group 3 - attr start_xdmcp'); +is($group3->{attrs}->{tex_enable}, 'F', 'group 3 - attr tex_enable'); +is($group3->{attrs}->{timezone}, 'G', 'group 3 - attr timezone'); +is($group3->{attrs}->{tvout}, 'H', 'group 3 - attr tvout'); +is($group3->{attrs}->{vmware}, 'I', 'group 3 - attr vmware'); +is(keys %{$group3->{attrs}}, 31, 'group 3 - attribute count'); + +# fetch group 2 by a filter on id and check all values +ok( + my $group2 = $configDB->fetchGroupByFilter({ id => 2 }), + 'fetch group 2 by filter on id' +); +is($group2->{id}, 2, 'group 2 - id'); +is($group2->{name}, 'grp-2.0', 'group 2 - name'); +is($group2->{priority}, 30, 'group 2 - priority'); +is($group2->{comment}, undef, 'group 2 - comment'); +is(keys %{$group2->{attrs}}, 0, 'group 2 - attribute count'); + +# fetch group 1 by filter on name and check all values +ok( + my $group1 = $configDB->fetchGroupByFilter({ name => 'grp-1' }), + 'fetch group 1 by filter on name' +); +is($group1->{id}, 1, 'group 1 - id'); +is($group1->{name}, 'grp-1', 'group 1 - name'); +is($group1->{priority}, 50, 'group 1 - priority'); +is($group1->{comment}, '', 'group 1 - comment'); +is(keys %{$group1->{attrs}}, 3, 'group 1 - attribute count'); +is($group1->{attrs}->{slxgrp}, 'slxgrp', 'group 1 - attr slxgrp'); +is($group1->{attrs}->{start_snmp}, 'no', 'group 1 - attr start_snmp'); +is($group1->{attrs}->{start_sshd}, 'yes', 'group 1 - attr start_sshd'); + +# fetch groups 3 & 1 by id +ok( + my @groups3And1 = $configDB->fetchGroupByID([3, 1]), + 'fetch groups 3 & 1 by id' +); +is(@groups3And1, 2, 'should have got 2 groups'); +# now sort by ID and check if we have really got 3 and 1 +@groups3And1 = sort { $a->{id} cmp $b->{id} } @groups3And1; +is($groups3And1[0]->{id}, 1, 'first id should be 1'); +is($groups3And1[1]->{id}, 3, 'second id should be 3'); + +# fetching groups by id without giving any should yield undef +is( + $configDB->fetchGroupByID(), undef, + 'fetch groups by id without giving any' +); + +# fetching groups by filter without giving any should yield all of them +ok( + @groups = $configDB->fetchGroupByFilter(), + 'fetch groups by filter without giving any' +); +is(@groups, 3, 'should have got all three groups'); + +# fetch groups 1 & 2 by filter on priority +ok( + my @groups1And3 = $configDB->fetchGroupByFilter({ priority => 50 }), + 'fetch groups 1 & 3 by filter on priority' +); +is(@groups1And3, 2, 'should have got 2 groups'); +# now sort by ID and check if we have really got 1 and 3 +@groups1And3 = sort { $a->{id} cmp $b->{id} } @groups1And3; +is($groups1And3[0]->{id}, 1, 'first id should be 1'); +is($groups1And3[1]->{id}, 3, 'second id should be 3'); + +# fetch group 2 by filter on comment being undef'd +ok( + my @group2Only = $configDB->fetchGroupByFilter({ comment => undef }), + 'fetch group 2 by filter on comment being undefined' +); +is(@group2Only, 1, 'should have got 1 group'); +is($group2Only[0]->{id}, 2, 'first id should be 2'); + +# try to fetch with multi-column filter +ok( + ($group1, $group3) + = $configDB->fetchGroupByFilter({ priority => '50', id => 1 }), + 'fetching group with priority=50 and id=1 should work' +); +is($group1->{name}, 'grp-1', 'should have got grp-1'); +is($group3, undef, 'should not get grp-nr-3'); + +# try to fetch multiple occurrences of the same group, combined with +# some unknown IDs +ok( + @groups1And3 = $configDB->fetchGroupByID([ 1, 21, 4-1, 1, 4, 1, 1 ]), + 'fetch a complex set of groups by ID' +); +is(@groups1And3, 2, 'should have got 2 groups'); +# now sort by ID and check if we have really got 1 and 3 +@groups1And3 = sort { $a->{id} cmp $b->{id} } @groups1And3; +is($groups1And3[0]->{id}, 1, 'first id should be 1'); +is($groups1And3[1]->{id}, 3, 'second id should be 3'); + +# filter groups by different attributes & values in combination +ok( + my @group1Only = $configDB->fetchGroupByFilter( {}, undef, { + start_snmp => 'no', + } ), + 'fetch group 1 by filter on attribute start_snmp' +); + +is(@group1Only, 1, 'should have got 1 group'); +is($group1Only[0]->{id}, 1, 'first id should be 1'); + +ok( + @group1Only = $configDB->fetchGroupByFilter( undef, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by filter on attribute start_snmp + non-existing attr' +); +is(@group1Only, 1, 'should have got 1 group'); +is($group1Only[0]->{id}, 1, 'first id should be 1'); + +ok( + @group1Only = $configDB->fetchGroupByFilter( { + name => 'grp-1', + priority => 50, + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + 'fetch group 1 by multiple filter on values and attributes' +); +is(@group1Only, 1, 'should have got 1 group'); +is($group1Only[0]->{id}, 1, 'first id should be 1'); + +is( + $configDB->fetchGroupByFilter( { + comment => 'xxx', + }, 'id', { + start_snmp => 'no', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect value' +); +is( + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_snmp => 'yes', + tex_enable => undef, + } ), + undef, + 'mismatch group 1 by filter with incorrect attribute value' +); +is( + $configDB->fetchGroupByFilter( { + name => 'grp-1', + }, 'id', { + start_sshd => undef, + } ), + undef, + 'mismatch group 1 by filter with attribute not being empty' +); + +# fetch groups 1 & 2 by filter on attribute start_samba not existing +ok( + my @groups1And2 = $configDB->fetchGroupByFilter( {}, undef, { + start_samba => undef, + } ), + 'fetch groups 1 & 2 by filter on attribute start_samba not existing' +); +is(@groups1And2, 2, 'should have got 2 groups'); +# now sort by ID and check if we have really got 1 and 2 +@groups1And2 = sort { $a->{id} cmp $b->{id} } @groups1And2; +is($groups1And2[0]->{id}, 1, 'first id should be 1'); +is($groups1And2[1]->{id}, 2, 'second id should be 2'); + +# try to fetch a couple of non-existing groups by id +is($configDB->fetchGroupByID(-1), undef, 'group with id -1 should not exist'); +is($configDB->fetchGroupByID(0), undef, 'group with id 0 should not exist'); +is( + $configDB->fetchGroupByID(1 << 31 + 1000), undef, + 'trying to fetch another unknown group' +); + +# try to fetch a couple of non-existing groups by filter +is( + $configDB->fetchGroupByFilter({ id => 4 }), undef, + 'fetching group with id=4 by filter should fail' +); +is( + $configDB->fetchGroupByFilter({ name => 'grp-1.x' }), undef, + 'fetching group with name="grp-1.x" should fail' +); +is( + $configDB->fetchGroupByFilter({ priority => '22', id => 1 }), undef, + 'fetching group with priority=22 and id=1 should fail' +); + +# rename group 1 and then fetch it by its new name +ok($configDB->changeGroup(1, { name => q{GRP-'1'} }), 'changing group 1'); +ok( + $group1 = $configDB->fetchGroupByFilter({ name => q{GRP-'1'} }), + 'fetching renamed group 1' +); +is($group1->{id}, 1, 'really got group number 1'); +is($group1->{name}, q{GRP-'1'}, q{really got group named "GRP-'1'"}); + +# changing nothing at all should succeed +ok($configDB->changeGroup(1), 'changing nothing at all in group 1'); + +# adding attributes should work +$inGroup1->{attrs}->{slxgrp} = 'slxgrp1'; +$inGroup1->{attrs}->{vmware} = 'yes'; +ok($configDB->changeGroup(1, $inGroup1), 'adding attrs to group 1'); +$group1 = $configDB->fetchGroupByID(1); +is($group1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($group1->{attrs}->{vmware}, 'yes', 'attr vmware has correct value'); + +# changing an attribute should work +$inGroup1->{attrs}->{vmware} = 'no'; +ok($configDB->changeGroup(1, $inGroup1), 'changing vmware in group 1'); +$group1 = $configDB->fetchGroupByID(1); +is($group1->{attrs}->{slxgrp}, 'slxgrp1', 'attr slxgrp has correct value'); +is($group1->{attrs}->{vmware}, 'no', 'attr vmware has correct value'); + +# deleting an attribute should remove it +delete $inGroup1->{attrs}->{slxgrp}; +ok($configDB->changeGroup(1, $inGroup1), 'changing slxgrp in group 1'); +$group1 = $configDB->fetchGroupByID(1); +ok(!exists $group1->{attrs}->{slxgrp}, 'attr slxgrp should be gone'); + +# undef'ing an attribute should remove it, too +$inGroup1->{attrs}->{vmware} = undef; +ok($configDB->changeGroup(1, $inGroup1), 'undefining vmware in group 1'); +$group1 = $configDB->fetchGroupByID(1); +ok(!exists $group1->{attrs}->{vmware}, 'attr vmware should be gone'); + +# changing a non-existing column should fail +ok( + ! eval { $configDB->changeGroup(1, { xname => "xx" }) }, + 'changing unknown colum should fail' +); + +ok(! $configDB->changeGroup(1, { id => 23 }), 'changing id should fail'); + +# now remove an group and check if that worked +ok($configDB->removeGroup(2), 'removing group 2 should be ok'); +is($configDB->fetchGroupByID(2, 'id'), undef, 'group 2 should be gone'); +is($configDB->fetchGroupByID(1)->{id}, 1, 'group 1 should still exist'); +is($configDB->fetchGroupByID(3)->{id}, 3, 'group 3 should still exist'); + +$configDB->disconnect(); + diff --git a/src/config-db/t/15-global_info.t b/src/config-db/t/15-global_info.t new file mode 100644 index 00000000..8f2f8cf1 --- /dev/null +++ b/src/config-db/t/15-global_info.t @@ -0,0 +1,43 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +# fetch global-info 'next-nbd-server-port' +ok( + my $globalInfo = $configDB->fetchGlobalInfo('next-nbd-server-port'), + 'fetch global-info' +); +is($globalInfo, '5000', 'global-info - value'); + +# try to fetch a couple of non-existing global-infos +is( + $configDB->fetchGlobalInfo(-1), undef, + 'global-info with id -1 should not exist' +); +is($configDB->fetchGlobalInfo('xxx'), undef, + 'global-info with id xxx should not exist'); + +# change value of global-info and then fetch and check the new value +ok($configDB->changeGlobalInfo('next-nbd-server-port', '5050'), 'changing global-info'); +is( + $configDB->fetchGlobalInfo('next-nbd-server-port'), '5050', + 'fetching changed global-info' +); + +# changing a non-existing global-info should fail +ok( + ! eval { $configDB->changeGlobalInfo('xxx', 'new-value') }, + 'changing unknown global-info should fail' +); + +$configDB->disconnect(); + diff --git a/src/config-db/t/20-client_system_ref.t b/src/config-db/t/20-client_system_ref.t new file mode 100644 index 00000000..93b86950 --- /dev/null +++ b/src/config-db/t/20-client_system_ref.t @@ -0,0 +1,208 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +# fetch clients & systems +my @clients = sort { $a->{id} <=> $b->{id} } $configDB->fetchClientByFilter(); +is(@clients, 3, 'should have got 3 clients (default, 1 and 3)'); +my $defaultClient = shift @clients; +my $client1 = shift @clients; +my $client3 = shift @clients; + +my @systems = sort { $a->{id} <=> $b->{id} } $configDB->fetchSystemByFilter(); +is(@systems, 3, 'should have got 3 systems (default, 1 and 3)'); +my $defaultSystem = shift @systems; +my $system1 = shift @systems; +my $system3 = shift @systems; + +foreach my $client ($defaultClient, $client1, $client3) { + is( + my @systemIDs = $configDB->fetchSystemIDsOfClient($client->{id}), + 0, "client $client->{id} has no system-IDs yet" + ); +} + +foreach my $system ($defaultSystem, $system1, $system3) { + is( + my @clientIDs = $configDB->fetchClientIDsOfSystem($system->{id}), + 0, "system $system->{id} has no client-IDs yet" + ); +} + +ok( + $configDB->addSystemIDsToClient(1, [3]), + 'system-ID 3 has been associated to client 1' +); +is( + my @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-ID" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" +); +is($systemIDs[0], 3, "first system of client 1 should have ID 3"); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" +); +is( + my @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 1, "system 3 should have one client-ID" +); +is($clientIDs[0], 1, "first client of system 3 should have ID 1"); + +ok( + $configDB->addSystemIDsToClient(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to client 3' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no system-IDs" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 1, "client 1 should have one system-ID" +); +is($systemIDs[0], 3, "first system of client 1 should have ID 3"); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 2, "client 3 should have two system-IDs" +); +is($systemIDs[0], 1, "first system of client 3 should have ID 1"); +is($systemIDs[1], 3, "second system of client 3 should have ID 3"); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-ID" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" +); +is($clientIDs[0], 3, "first client of system 1 should have ID 3"); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 2, "system 3 should have two client-IDs" +); +is($clientIDs[0], 1, "first client of system 3 should have ID 1"); +is($clientIDs[1], 3, "second client of system 3 should have ID 3"); + +ok( + $configDB->setClientIDsOfSystem(3, []), + 'client-IDs of system 3 have been set to empty array' +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-IDs" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 1, "client 3 should have one system-ID" +); +is($systemIDs[0], 1, "first system of client 3 should have ID 1"); + +ok( + $configDB->addSystemIDsToClient(1, [0]), + 'associating the default system should have no effect' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should still have no system-ID" +); + +ok( + $configDB->removeClientIDsFromSystem(1, [1]), + 'removing an unassociated client-ID should have no effect' +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 1, "system 1 should have one client-ID" +); +ok( + $configDB->removeClientIDsFromSystem(1, [3]), + 'removing an associated client-ID should work' +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no more client-ID" +); + +$configDB->addSystem({ + 'name' => 'sys-4', + 'export_id' => 1, + 'comment' => 'shortlived', +}); +ok( + $configDB->addClientIDsToSystem(4, [0]), + 'default client has been associated to system 4' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" +); +is($systemIDs[0], 4, "first system of default client should have ID 4"); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(1)), + 0, "client 1 should have no system-ID" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfClient(3)), + 0, "client 3 should have no system-ID" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(0)), + 0, "default system should have no client-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(1)), + 0, "system 1 should have no client-ID" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(3)), + 0, "system 3 should have no client-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfSystem(4)), + 1, "system 4 should have one client-ID" +); +is($clientIDs[0], 0, "first client of system 4 should have ID 0"); + +ok( + $configDB->removeSystemIDsFromClient(0, [6]), + 'removing an unassociated system-ID should have no effect' +); +is( + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 1, "default client should have one system-ID" +); +ok( + $configDB->removeSystem(4), + 'removing a system should drop client associations, too' +); +is( + @clientIDs = sort($configDB->fetchSystemIDsOfClient(0)), + 0, "default client should have no more system-ID" +); + +$configDB->disconnect(); diff --git a/src/config-db/t/21-group_system_ref.t b/src/config-db/t/21-group_system_ref.t new file mode 100644 index 00000000..b643f7e0 --- /dev/null +++ b/src/config-db/t/21-group_system_ref.t @@ -0,0 +1,195 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +# fetch groups & systems +my @groups = sort { $a->{id} <=> $b->{id} } $configDB->fetchGroupByFilter(); +is(@groups, 2, 'should have got 2 groups (1 and 3)'); +my $group1 = shift @groups; +my $group3 = shift @groups; + +my @systems = sort { $a->{id} <=> $b->{id} } $configDB->fetchSystemByFilter(); +is(@systems, 3, 'should have got 3 systems (default, 1 and 3)'); +my $defaultSystem = shift @systems; +my $system1 = shift @systems; +my $system3 = shift @systems; + +foreach my $group ($group1, $group3) { + is( + my @systemIDs = $configDB->fetchSystemIDsOfGroup($group->{id}), + 0, "group $group->{id} has no system-IDs yet" + ); +} + +foreach my $system ($defaultSystem, $system1, $system3) { + is( + my @groupIDs = $configDB->fetchGroupIDsOfSystem($system->{id}), + 0, "system $system->{id} has no group-IDs yet" + ); +} + +ok( + $configDB->addSystemIDsToGroup(1, [3]), + 'system-ID 3 has been associated to group 1' +); +is( + my @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" +); +is($systemIDs[0], 3, "first system of group 1 should have ID 3"); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no system-ID" +); +is( + my @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 1, "system 3 should have one group-ID" +); +is($groupIDs[0], 1, "first group of system 3 should have ID 1"); + +ok( + $configDB->addSystemIDsToGroup(3, [1,3,3,1,3]), + 'system-IDs 1 and 3 have been associated to group 3' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 1, "group 1 should have one system-ID" +); +is($systemIDs[0], 3, "first system of group 1 should have ID 3"); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 2, "group 3 should have two system-IDs" +); +is($systemIDs[0], 1, "first system of group 3 should have ID 1"); +is($systemIDs[1], 3, "second system of group 3 should have ID 3"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-ID" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" +); +is($groupIDs[0], 3, "first group of system 1 should have ID 3"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 2, "system 3 should have two group-IDs" +); +is($groupIDs[0], 1, "first group of system 3 should have ID 1"); +is($groupIDs[1], 3, "second group of system 3 should have ID 3"); + +ok( + $configDB->setGroupIDsOfSystem(3, []), + 'group-IDs of system 3 have been set to empty array' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no more system-IDs" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" +); +is($systemIDs[0], 1, "first system of group 3 should have ID 1"); + +ok( + $configDB->addSystemIDsToGroup(1, [0]), + 'associating the default system should have no effect' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should still have no system-ID" +); + +ok( + $configDB->removeGroupIDsFromSystem(1, [1]), + 'removing an unassociated group-ID should have no effect' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 1, "system 1 should have one group-ID" +); +ok( + $configDB->removeGroupIDsFromSystem(1, [3]), + 'removing an associated group-ID should work' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no more group-ID" +); + +$configDB->addSystem({ + 'name' => 'sys-5', + 'export_id' => 1, + 'comment' => 'shortlived', +}); +ok( + $configDB->addGroupIDsToSystem(5, [3]), + 'default group has been associated to system 5' +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(1)), + 0, "group 1 should have no system-ID" +); +is( + @systemIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have no system-ID" +); +is($systemIDs[0], 5, "first system of group 3 should have ID 5"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(0)), + 0, "default system should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(1)), + 0, "system 1 should have no group-ID" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(3)), + 0, "system 3 should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfSystem(5)), + 1, "system 5 should have one group-ID" +); +is($groupIDs[0], 3, "first group of system 5 should have ID 3"); + +ok( + $configDB->removeSystemIDsFromGroup(3, [6]), + 'removing an unassociated system-ID should have no effect' +); +is( + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 1, "group 3 should have one system-ID" +); +ok( + $configDB->removeSystem(5), + 'removing a system should drop group associations, too' +); +is( + @groupIDs = sort($configDB->fetchSystemIDsOfGroup(3)), + 0, "group 3 should have no more system-ID" +); + +$configDB->disconnect(); diff --git a/src/config-db/t/22-group_client_ref.t b/src/config-db/t/22-group_client_ref.t new file mode 100644 index 00000000..ff9d6ca7 --- /dev/null +++ b/src/config-db/t/22-group_client_ref.t @@ -0,0 +1,186 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +# fetch groups & clients +my @groups = sort { $a->{id} <=> $b->{id} } $configDB->fetchGroupByFilter(); +is(@groups, 2, 'should have got 2 groups (1 and 3)'); +my $group1 = shift @groups; +my $group3 = shift @groups; + +my @clients = sort { $a->{id} <=> $b->{id} } $configDB->fetchClientByFilter(); +is(@clients, 3, 'should have got 3 clients (default, 1 and 3)'); +my $defaultClient = shift @clients; +my $client1 = shift @clients; +my $client3 = shift @clients; + +foreach my $group ($group1, $group3) { + is( + my @clientIDs = $configDB->fetchClientIDsOfGroup($group->{id}), + 0, "group $group->{id} has no client-IDs yet" + ); +} + +foreach my $client ($defaultClient, $client1, $client3) { + is( + my @groupIDs = $configDB->fetchGroupIDsOfClient($client->{id}), + 0, "client $client->{id} has no group-IDs yet" + ); +} + +ok( + $configDB->addClientIDsToGroup(1, [3]), + 'client-ID 3 has been associated to group 1' +); +is( + my @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" +); +is($clientIDs[0], 3, "first client of group 1 should have ID 3"); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no client-ID" +); +is( + my @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 1, "client 3 should have one group-ID" +); +is($groupIDs[0], 1, "first group of client 3 should have ID 1"); + +ok( + $configDB->addClientIDsToGroup(3, [1,3,3,1,3]), + 'client-IDs 1 and 3 have been associated to group 3' +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 1, "group 1 should have one client-ID" +); +is($clientIDs[0], 3, "first client of group 1 should have ID 3"); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 2, "group 3 should have two client-IDs" +); +is($clientIDs[0], 1, "first client of group 3 should have ID 1"); +is($clientIDs[1], 3, "second client of group 3 should have ID 3"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-ID" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" +); +is($groupIDs[0], 3, "first group of client 1 should have ID 3"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 2, "client 3 should have two group-IDs" +); +is($groupIDs[0], 1, "first group of client 3 should have ID 1"); +is($groupIDs[1], 3, "second group of client 3 should have ID 3"); + +ok( + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set to empty array' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no more client-IDs" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" +); +is($clientIDs[0], 1, "first client of group 3 should have ID 1"); + +ok( + $configDB->removeGroupIDsFromClient(1, [1]), + 'removing an unassociated group-ID should have no effect' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 1, "client 1 should have one group-ID" +); +ok( + $configDB->removeGroupIDsFromClient(1, [3]), + 'removing an associated group-ID should work' +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no more group-ID" +); + +$configDB->addClient({ + 'name' => 'cli-4', + 'mac' => '01:01:01:02:02:02', + 'comment' => 'shortlived', +}); +ok( + $configDB->addGroupIDsToClient(4, [3]), + 'default group has been associated to client 4' +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(1)), + 0, "group 1 should have no client-ID" +); +is( + @clientIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" +); +is($clientIDs[0], 4, "first client of group 3 should have ID 1"); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(0)), + 0, "default client should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(1)), + 0, "client 1 should have no group-ID" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(3)), + 0, "client 3 should have no group-IDs" +); +is( + @groupIDs = sort($configDB->fetchGroupIDsOfClient(4)), + 1, "client 4 should have one group-ID" +); +is($groupIDs[0], 3, "first group of client 4 should have ID 3"); + +ok( + $configDB->removeClientIDsFromGroup(3, [6]), + 'removing an unassociated client-ID should have no effect' +); +is( + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 1, "group 3 should have one client-ID" +); +ok( + $configDB->removeClient(4), + 'removing a client should drop group associations, too' +); +is( + @groupIDs = sort($configDB->fetchClientIDsOfGroup(3)), + 0, "group 3 should have no more client-ID" +); + +$configDB->disconnect(); diff --git a/src/config-db/t/25-attributes.t b/src/config-db/t/25-attributes.t new file mode 100644 index 00000000..9662684c --- /dev/null +++ b/src/config-db/t/25-attributes.t @@ -0,0 +1,677 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +use Clone qw(clone); + +# basic init +use OpenSLX::ConfigDB qw(:support); + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +my $defaultAttrs = { # mostly copied from DBSchema + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 e100 tg3 via-rhine r8169 pcnet32', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'no', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'yes', + 'start_xdmcp' => 'kdm', + 'tex_enable' => 'no', + 'timezone' => 'Europe/Berlin', + 'tvout' => 'no', + 'vmware' => 'no', +}; +ok( + $configDB->changeSystem(0, { attrs => $defaultAttrs } ), + 'attributes of default system have been set' +); +my $defaultSystem = $configDB->fetchSystemByID(0); + +my $system1 = $configDB->fetchSystemByID(1); +my $sys1Attrs = { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + 'start_x' => 'no', + 'start_xdmcp' => '', +}; +ok( + $configDB->changeSystem(1, { attrs => $sys1Attrs } ), + 'attributes of system 1 have been set' +); + +my $system3 = $configDB->fetchSystemByID(3); +my $sys3Attrs = { + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => '23', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => '29', + 'tvout' => '30', + 'vmware' => '31', +}; +ok( + $configDB->changeSystem(3, { attrs => $sys3Attrs } ), + 'attributes of system 3 have been set' +); + +my $defaultClient = $configDB->fetchClientByID(0); +my $defaultClientAttrs = { + # pretend the whole computer centre has been warped to London ;-) + 'timezone' => 'Europe/London', + # pretend we wanted to activate snmp globally (e.g. for testing) + 'start_snmp' => 'yes', +}; +ok( + $configDB->changeClient(0, { attrs => $defaultClientAttrs } ), + 'attributes of default client have been set' +); + +# check merging of default attributes, the order should be: +# default system attributes overruled by system attributes overruled by +# default client attributes: +my $shouldBeAttrs1 = { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'no', +}; +my $mergedSystem1 = $configDB->fetchSystemByID(1); +ok( + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem1), + 'merging default attributes into system 1' +); +foreach my $key (sort keys %$shouldBeAttrs1) { + is( + $mergedSystem1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for system 1" + ); +} + +# check merging code for completeness (using all attributes): +my $shouldBeAttrs3 = { + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '13', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => '31', +}; +my $mergedSystem3 = $configDB->fetchSystemByID(3); +ok( + $configDB->mergeDefaultAttributesIntoSystem($mergedSystem3), + 'merging default attributes into system 3' +); +foreach my $key (sort keys %$shouldBeAttrs3) { + is( + $mergedSystem3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for system 3" + ); +} + +# setup client / group relations +my $group1 = $configDB->fetchGroupByID(1); +my $group1Attrs = { + 'priority' => '50', + # this group of clients is connected via underwater cable ... + 'timezone' => 'America/New_York', + # ... and use a local scratch partition + 'scratch' => '/dev/sdd1', + # the following should be a noop (as that attribute is system-specific) +# 'ramfs_nicmods' => 'e1000', +}; +ok( + $configDB->changeGroup(1, { attrs => $group1Attrs } ), + 'attributes of group 1 have been set' +); +my $group3 = $configDB->fetchGroupByID(3); +my $group3Attrs = { + 'priority' => '30', + # this specific client group is older and thus has a different scratch + 'scratch' => '/dev/hdd1', + 'vmware' => 'yes', +}; +ok( + $configDB->changeGroup(3, { attrs => $group3Attrs } ), + 'attributes of group 3 have been set' +); +my $client1 = $configDB->fetchClientByID(1); +my $client1Attrs = { + # this specific client uses yet another local scratch partition + 'scratch' => '/dev/sdx3', +}; +ok( + $configDB->changeClient(1, { attrs => $client1Attrs } ), + 'attributes of client 1 have been set' +); +ok( + $configDB->setGroupIDsOfClient(1, [1]), + 'group-IDs of client 1 have been set' +); +ok( + $configDB->setGroupIDsOfClient(3, []), + 'group-IDs of client 3 have been set' +); + +# check merging of attributes into client, the order should be: +# default client attributes overruled by group attributes (ordered by priority) +# overruled by specific client attributes: +$shouldBeAttrs1 = { + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => undef, +}; +my $mergedClient1 = $configDB->fetchClientByID(1); +ok( + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' +); +foreach my $key (sort keys %$shouldBeAttrs1) { + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); +} + +$shouldBeAttrs3 = { + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => undef, + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => undef, +}; + +# remove all attributes from client 3 +$configDB->changeClient(3, { attrs => {} } ); + +my $mergedClient3 = $configDB->fetchClientByID(3); +ok( + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' +); +foreach my $key (sort keys %$shouldBeAttrs1) { + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); +} + +# now associate default client with group 3 and try again +ok( + $configDB->setGroupIDsOfClient(0, [3]), + 'group-IDs of default client have been set' +); +$shouldBeAttrs1 = { + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'America/New_York', + 'tvout' => undef, + 'vmware' => 'yes', +}; +$mergedClient1 = $configDB->fetchClientByID(1); +ok( + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient1), + 'merging default and group attributes into client 1' +); +foreach my $key (sort keys %$shouldBeAttrs1) { + is( + $mergedClient1->{attrs}->{$key}, $shouldBeAttrs1->{$key}, + "checking merged attribute $key for client 1" + ); +} + +$shouldBeAttrs3 = { + 'ramfs_fsmods' => undef, + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => undef, + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => undef, + 'dm_allow_shutdown' => undef, + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => undef, + 'netbios_workgroup' => undef, + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => undef, + 'start_atd' => undef, + 'start_cron' => undef, + 'start_dreshal' => undef, + 'start_ntp' => undef, + 'start_nfsv4' => undef, + 'start_printer' => undef, + 'start_samba' => undef, + 'start_snmp' => 'yes', + 'start_sshd' => undef, + 'start_syslog' => undef, + 'start_x' => undef, + 'start_xdmcp' => undef, + 'tex_enable' => undef, + 'timezone' => 'Europe/London', + 'tvout' => undef, + 'vmware' => 'yes', +}; +$mergedClient3 = $configDB->fetchClientByID(3); +ok( + $configDB->mergeDefaultAndGroupAttributesIntoClient($mergedClient3), + 'merging default and group attributes into client 3' +); +foreach my $key (sort keys %$shouldBeAttrs1) { + is( + $mergedClient3->{attrs}->{$key}, $shouldBeAttrs3->{$key}, + "checking merged attribute $key for client 3" + ); +} + +# finally we merge systems into clients and check the outcome of that +my $fullMerge11 = clone($mergedClient1); +ok( + mergeAttributes($fullMerge11, $mergedSystem1), + 'merging system 1 into client 1' +); +my $shouldBeAttrs11 = { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/sdx3', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'America/New_York', + 'tvout' => 'no', + 'vmware' => 'yes', +}; +foreach my $key (sort keys %$shouldBeAttrs11) { + is( + $fullMerge11->{attrs}->{$key}, $shouldBeAttrs11->{$key}, + "checking merged attribute $key for client 1 / system 1" + ); +} + +my $fullMerge31 = clone($mergedClient3); +ok( + mergeAttributes($fullMerge31, $mergedSystem1), + 'merging system 1 into client 3' +); +my $shouldBeAttrs31 = { + 'ramfs_fsmods' => 'squashfs', + 'ramfs_miscmods' => undef, + 'ramfs_nicmods' => 'forcedeth e1000 r8169', + + 'automnt_dir' => undef, + 'automnt_src' => undef, + 'country' => 'de', + 'dm_allow_shutdown' => 'user', + 'hw_graphic' => undef, + 'hw_monitor' => undef, + 'hw_mouse' => undef, + 'late_dm' => 'no', + 'netbios_workgroup' => 'slx-network', + 'nis_domain' => undef, + 'nis_servers' => undef, + 'sane_scanner' => undef, + 'scratch' => '/dev/hdd1', + 'slxgrp' => undef, + 'start_alsasound' => 'yes', + 'start_atd' => 'no', + 'start_cron' => 'no', + 'start_dreshal' => 'yes', + 'start_ntp' => 'initial', + 'start_nfsv4' => 'no', + 'start_printer' => 'no', + 'start_samba' => 'may', + 'start_snmp' => 'yes', + 'start_sshd' => 'yes', + 'start_syslog' => 'yes', + 'start_x' => 'no', + 'start_xdmcp' => '', + 'tex_enable' => 'no', + 'timezone' => 'Europe/London', + 'tvout' => 'no', + 'vmware' => 'yes', +}; +foreach my $key (sort keys %$shouldBeAttrs31) { + is( + $fullMerge31->{attrs}->{$key}, $shouldBeAttrs31->{$key}, + "checking merged attribute $key for client 3 / system 1" + ); +} + +my $fullMerge13 = clone($mergedClient1); +ok( + mergeAttributes($fullMerge13, $mergedSystem3), + 'merging system 3 into client 1' +); +my $shouldBeAttrs13 = { + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/sdx3', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'America/New_York', + 'tvout' => '30', + 'vmware' => 'yes', +}; +foreach my $key (sort keys %$shouldBeAttrs13) { + is( + $fullMerge13->{attrs}->{$key}, $shouldBeAttrs13->{$key}, + "checking merged attribute $key for client 1 / system 3" + ); +} + +my $fullMerge33 = clone($mergedClient3); +ok( + mergeAttributes($fullMerge33, $mergedSystem3), + 'merging system 3 into client 3' +); +my $shouldBeAttrs33 = { + 'ramfs_fsmods' => '-4', + 'ramfs_miscmods' => '-3', + 'ramfs_nicmods' => '-2', + + 'automnt_dir' => '1', + 'automnt_src' => '2', + 'country' => '3', + 'dm_allow_shutdown' => '4', + 'hw_graphic' => '5', + 'hw_monitor' => '6', + 'hw_mouse' => '7', + 'late_dm' => '8', + 'netbios_workgroup' => '9', + 'nis_domain' => '10', + 'nis_servers' => '11', + 'sane_scanner' => '12', + 'scratch' => '/dev/hdd1', + 'slxgrp' => '14', + 'start_alsasound' => '15', + 'start_atd' => '16', + 'start_cron' => '17', + 'start_dreshal' => '18', + 'start_ntp' => '19', + 'start_nfsv4' => '20', + 'start_printer' => '21', + 'start_samba' => '22', + 'start_snmp' => 'yes', + 'start_sshd' => '24', + 'start_syslog' => '25', + 'start_x' => '26', + 'start_xdmcp' => '27', + 'tex_enable' => '28', + 'timezone' => 'Europe/London', + 'tvout' => '30', + 'vmware' => 'yes', +}; +foreach my $key (sort keys %$shouldBeAttrs33) { + is( + $fullMerge33->{attrs}->{$key}, $shouldBeAttrs33->{$key}, + "checking merged attribute $key for client 3 / system 3" + ); +} + +$configDB->disconnect(); diff --git a/src/config-db/t/29-transaction.t b/src/config-db/t/29-transaction.t new file mode 100644 index 00000000..1f1566bf --- /dev/null +++ b/src/config-db/t/29-transaction.t @@ -0,0 +1,58 @@ +use Test::More qw(no_plan); + +use strict; +use warnings; + +use lib '/opt/openslx/lib'; + +# basic init +use OpenSLX::ConfigDB; + +my $configDB = OpenSLX::ConfigDB->new; +$configDB->connect(); + +my @vendorOSes = $configDB->fetchVendorOSByFilter(); +my @exports = $configDB->fetchExportByFilter(); +my @systems = $configDB->fetchSystemByFilter(); +my @clients = $configDB->fetchClientByFilter(); +my @groups = $configDB->fetchGroupByFilter(); + +ok($configDB->startTransaction(), 'starting a transaction'); + +ok($configDB->emptyDatabase(), 'emptying the DB'); + +ok($configDB->rollbackTransaction(), 'rolling back the transaction'); + +my @vendorOSes2 = $configDB->fetchVendorOSByFilter(); +my @exports2 = $configDB->fetchExportByFilter(); +my @systems2 = $configDB->fetchSystemByFilter(); +my @clients2 = $configDB->fetchClientByFilter(); +my @groups2 = $configDB->fetchGroupByFilter(); + +is( + scalar @vendorOSes2, scalar @vendorOSes, "should still have all vendor-OSes" +); +is(scalar @exports2, scalar @exports, "should still have all exports"); +is(scalar @systems2, scalar @systems, "should still have all systems"); +is(scalar @clients2, scalar @clients, "should still have all clients"); +is(scalar @groups2, scalar @groups, "should still have all groups"); + +ok($configDB->startTransaction(), 'starting a transaction'); + +ok($configDB->emptyDatabase(), 'emptying the DB'); + +ok($configDB->commitTransaction(), 'committing the transaction'); + +my @vendorOSes3 = $configDB->fetchVendorOSByFilter(); +my @exports3 = $configDB->fetchExportByFilter(); +my @systems3 = $configDB->fetchSystemByFilter(); +my @clients3 = $configDB->fetchClientByFilter(); +my @groups3 = $configDB->fetchGroupByFilter(); + +is(scalar @vendorOSes3, 0, "should have no vendor-OSes"); +is(scalar @exports3, 0, "should have no exports"); +is(scalar @systems3, 1, "should have one system (default)"); +is(scalar @clients3, 1, "should have one client (default)"); +is(scalar @groups3, 0, "should have no groups"); + +$configDB->disconnect(); diff --git a/src/config-db/t/run-all-tests.pl b/src/config-db/t/run-all-tests.pl new file mode 100755 index 00000000..8fb351c7 --- /dev/null +++ b/src/config-db/t/run-all-tests.pl @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use warnings; +use strict; + +use Test::Harness; + +# add the development paths to perl's search path for modules: +use FindBin; +use lib "$FindBin::RealBin/../"; +use lib "$FindBin::RealBin/../../lib"; + +chdir "$FindBin::RealBin" or die "unable to chdir to $FindBin::RealBin! ($!)\n"; + +use OpenSLX::Basics; + +use OpenSLX::MetaDB::SQLite; + +# make sure a specific test-db will be used +$cmdlineConfig{'private-path'} = $ENV{SLX_PRIVATE_PATH} = '/tmp/slx-db-test'; +$cmdlineConfig{'db-name'} = $ENV{SLX_DB_NAME} = 'slx-test'; +$cmdlineConfig{'db-type'} = $ENV{SLX_DB_TYPE} = 'SQLite'; + +openslxInit(); + +$Test::Harness::Verbose = 1 if $openslxConfig{'log-level'}; + +# remove the test-db if it already exists +my $metaDB = OpenSLX::MetaDB::SQLite->new(); +if ($metaDB->databaseExists()) { + print "removing leftovers of slx-test-db\n"; + $metaDB->dropDatabase(); +} +runtests(glob("*.t")); + +$metaDB->dropDatabase(); -- cgit v1.2.3-55-g7522