summaryrefslogtreecommitdiffstats
path: root/src/config-db
diff options
context:
space:
mode:
authorSebastian Schmelzer2010-09-02 17:50:49 +0200
committerSebastian Schmelzer2010-09-02 17:50:49 +0200
commit416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5 (patch)
tree4715f7d742fec50931017f38fe6ff0a89d4ceccc /src/config-db
parentFix for the problem reported on the list (sed filter forgotten for the (diff)
downloadcore-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.tar.gz
core-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.tar.xz
core-416ab8a37f1b07dc9f6c0fb3ff1a8ff2036510b5.zip
change dir structure
Diffstat (limited to 'src/config-db')
-rw-r--r--src/config-db/OpenSLX/AttributeRoster.pm537
-rw-r--r--src/config-db/OpenSLX/ConfigDB.pm3190
-rw-r--r--src/config-db/OpenSLX/ConfigExport/DHCP/ISC.pm45
-rw-r--r--src/config-db/OpenSLX/DBSchema.pm832
-rw-r--r--src/config-db/OpenSLX/MetaDB/Base.pm1220
-rw-r--r--src/config-db/OpenSLX/MetaDB/DBI.pm1540
-rw-r--r--src/config-db/OpenSLX/MetaDB/SQLite.pm130
-rw-r--r--src/config-db/OpenSLX/MetaDB/mysql.pm179
-rwxr-xr-xsrc/config-db/slxconfig1785
-rwxr-xr-xsrc/config-db/slxconfig-demuxer918
-rw-r--r--src/config-db/t/01-basics.t23
-rw-r--r--src/config-db/t/10-vendor-os.t258
-rw-r--r--src/config-db/t/11-export.t247
-rw-r--r--src/config-db/t/12-system.t360
-rw-r--r--src/config-db/t/13-client.t320
-rw-r--r--src/config-db/t/14-group.t384
-rw-r--r--src/config-db/t/15-global_info.t43
-rw-r--r--src/config-db/t/20-client_system_ref.t208
-rw-r--r--src/config-db/t/21-group_system_ref.t195
-rw-r--r--src/config-db/t/22-group_client_ref.t186
-rw-r--r--src/config-db/t/25-attributes.t677
-rw-r--r--src/config-db/t/29-transaction.t58
-rwxr-xr-xsrc/config-db/t/run-all-tests.pl36
23 files changed, 13371 insertions, 0 deletions
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<getAttrInfo()>
+
+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<getStage3Attrs()>
+
+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<getSystemAttrs()>
+
+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<getClientAttrs()>
+
+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<findProblematicValues()>
+
+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<computeMD5HashOverAllAttrs()>
+
+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' => '<<<default>>>'})
+
+ # 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<basic methods> (connection handling)
+
+=item - L<data access methods> (getting data)
+
+=item - L<data manipulation methods> (adding, removing and changing data)
+
+=item - L<data aggregation methods> (getting info about the resulting
+configurations after mixing individual client-, group- and system-
+configurations).
+
+=item - L<suppport functions> (useful helpers)
+
+=back
+
+=head1 Special Concepts
+
+=over
+
+=item C<Filters>
+
+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<new()>
+
+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<connect()>
+
+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<disconnect()>
+
+Tears down the connection to the database and cleans up.
+
+=cut
+
+sub disconnect
+{
+ my $self = shift;
+
+ $self->{'meta-db'}->disconnect();
+
+ return 1;
+}
+
+=item C<startTransaction()>
+
+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<commitTransaction()>
+
+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<rollbackTransaction()>
+
+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<cleanupAnyInconsistencies()>
+
+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<synchronizeAttributesWithDB()>
+
+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<getColumnsOfTable($tableName)>
+
+Returns the names of the columns of the given table.
+
+=over
+
+=item Param C<tableName>
+
+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<fetchVendorOSByFilter([%$filter], [$resultCols])>
+
+Fetches and returns information about all vendor-OSes 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</"Filters"> for more info.
+
+=item Param C<resultCols>
+
+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<fetchVendorOSByID(@$ids, [$resultCols])>
+
+Fetches and returns information the vendor-OSes with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the vendor-OS-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchInstalledPlugins($vendorOSID)>
+
+Returns the names of all plugins that have been installed into the given
+vendor-OS.
+
+=over
+
+=item Param C<vendorOSID>
+
+The id of the vendor-OS whose plugins you are interested in
+
+=item Param C<pluginName> [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<fetchExportByFilter([%$filter], [$resultCols])>
+
+Fetches and returns information about all exports 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</"Filters"> for more info.
+
+=item Param C<resultCols>
+
+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<fetchExportByID(@$ids, [$resultCols])>
+
+Fetches and returns information the exports with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the export-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchExportIDsOfVendorOS($id)>
+
+Fetches the IDs of all exports that make use of the vendor-OS with the given ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchGlobalInfo($id)>
+
+Fetches the global info element specified by the given ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchSystemByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchSystemByID(@$ids, [$resultCols])>
+
+Fetches and returns information the systems with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the system-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchSystemIDsOfExport($id)>
+
+Fetches the IDs of all systems that make use of the export with the given ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchSystemIDsOfClient($id)>
+
+Fetches the IDs of all systems that are used by the client with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchSystemIDsOfGroup($id)>
+
+Fetches the IDs of all systems that are part of the group with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchClientByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchClientByID(@$ids, [$resultCols])>
+
+Fetches and returns information the clients with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the client-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchClientIDsOfSystem($id)>
+
+Fetches the IDs of all clients that make use of the system with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchClientIDsOfGroup($id)>
+
+Fetches the IDs of all clients that are part of the group with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchGroupByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchGroupByID(@$ids, [$resultCols])>
+
+Fetches and returns information the groups with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the group-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchGroupIDsOfSystem($id)>
+
+Fetches the IDs of all groups that contain the system with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<fetchGroupIDsOfClient($id)>
+
+Fetches the IDs of all groups that contain the client with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<addVendorOS(@$valRows)>
+
+Adds one or more vendor-OS to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> 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<removeVendorOS(@$vendorOSIDs)>
+
+Removes one or more vendor-OS from the database.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+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<undef> 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<changeVendorOS(@$vendorOSIDs, @$valRows)>
+
+Changes the data of one or more vendor-OS.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+An array-ref containing the IDs of the vendor-OSes that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> 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<addInstalledPlugin($vendorOSID, $pluginName)>
+
+Adds a freshly installed plugin to a vendor-OS.
+
+=over
+
+=item Param C<vendorOSID>
+
+The id of the vendor-OS the given plugin has been installed into
+
+=item Param C<pluginName>
+
+The name of the plugin that has been installed
+
+=item Return Value
+
+The ID of the new reference entry, C<undef> 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<removeInstalledPlugin($vendorOSID, $pluginName)>
+
+Removes a uninstalled plugin for a vendor-OS.
+
+=over
+
+=item Param C<vendorOSID>
+
+The id of the vendor-OS the given plugin has been uninstalled from
+
+=item Param C<pluginName>
+
+The name of the plugin that has been uninstalled
+
+=item Return Value
+
+1 if it worked, C<undef> 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<addExport(@$valRows)>
+
+Adds one or more export to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> 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<removeExport(@$exportIDs)>
+
+Removes one or more export from the database.
+
+=over
+
+=item Param C<exportIDs>
+
+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<undef> if not.
+
+=back
+
+=cut
+
+sub removeExport
+{
+ my $self = shift;
+ my $exportIDs = _aref(shift);
+
+ return $self->{'meta-db'}->removeExport($exportIDs);
+}
+
+=item C<changeExport(@$exportIDs, @$valRows)>
+
+Changes the data of one or more export.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+An array-ref containing the IDs of the exports that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> 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<incrementGlobalCounter($counterName)>
+
+Increments the global counter of the given name and returns the *old* value.
+
+=over
+
+=item Param C<counterName>
+
+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<changeGlobalInfo($id, $value)>
+
+Sets the global info element specified by the given ID to the given value.
+
+=over
+
+=item Param C<id>
+
+The ID specifying the global info you'd like to change.
+
+=item Param C<value>
+
+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<addSystem(@$valRows)>
+
+Adds one or more systems to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> 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<removeSystem(@$systemIDs)>
+
+Removes one or more systems from the database.
+
+=over
+
+=item Param C<systemIDs>
+
+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<undef> 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<changeSystem(@$systemIDs, @$valRows)>
+
+Changes the data of one or more systems.
+
+=over
+
+=item Param C<systemIDs>
+
+An array-ref containing the IDs of the systems that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> 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<setSystemAttr($systemID, $attrName, $attrValue)>
+#
+#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<systemID>
+#
+#The ID of the system whose attribute shall be changed.
+#
+#=item Param C<attrName>
+#
+#The name of the attribute to change.
+#
+#=item Param C<attrValue>
+#
+#The new value for the attribute.
+#
+#=item Return Value
+#
+#C<1> if the attribute could be set, C<undef> 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<setClientIDsOfSystem($systemID, @$clientIDs)>
+
+Specifies all clients that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system whose clients you'd like to specify.
+
+=item Param C<clientIDs>
+
+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<undef> 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<addClientIDsToSystem($systemID, @$clientIDs)>
+
+Add one or more clients to the set that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system that you wish to add the clients to.
+
+=item Param C<clientIDs>
+
+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<undef> 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<removeClientIDsFromSystem($systemID, @$clientIDs)>
+
+Removes the connection between the given clients and the given system.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system you'd like to remove groups from.
+
+=item Param C<clientIDs>
+
+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<undef> 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<setGroupIDsOfSystem($systemID, @$groupIDs)>
+
+Specifies all groups that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system whose groups you'd like to specify.
+
+=item Param C<groupIDs>
+
+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<undef> 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<addGroupIDsToSystem($systemID, @$groupIDs)>
+
+Add one or more groups to the set that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system that you wish to add the groups to.
+
+=item Param C<groupIDs>
+
+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<undef> 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<removeGroupIDsFromSystem($systemID, @$groupIDs)>
+
+Removes the connection between the given groups and the given system.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system you'd like to remove groups from.
+
+=item Param C<groupIDs>
+
+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<undef> 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<addClient(@$valRows)>
+
+Adds one or more clients to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> 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<removeClient(@$clientIDs)>
+
+Removes one or more clients from the database.
+
+=over
+
+=item Param C<clientIDs>
+
+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<undef> 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<changeClient(@$clientIDs, @$valRows)>
+
+Changes the data of one or more clients.
+
+=over
+
+=item Param C<clientIDs>
+
+An array-ref containing the IDs of the clients that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> 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<setClientAttr($clientID, $attrName, $attrValue)>
+#
+#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<clientID>
+#
+#The ID of the client whose attribute shall be changed.
+#
+#=item Param C<attrName>
+#
+#The name of the attribute to change.
+#
+#=item Param C<attrValue>
+#
+#The new value for the attribute.
+#
+#=item Return Value
+#
+#C<1> if the attribute could be set, C<undef> 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<setSystemIDsOfClient($clientID, @$systemIDs)>
+
+Specifies all systems that should be offered for booting by the given client.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client whose systems you'd like to specify.
+
+=item Param C<systemIDs>
+
+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<undef> 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<addSystemIDsToClient($clientID, @$systemIDs)>
+
+Adds some systems to the set that should be offered for booting by the given client.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client to which you'd like to add systems to.
+
+=item Param C<systemIDs>
+
+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<undef> 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<removeSystemIDsFromClient($clientID, @$systemIDs)>
+
+Removes some systems from the set that should be offered for booting by the given client.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client to which you'd like to remove systems from.
+
+=item Param C<systemIDs>
+
+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<undef> 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<setGroupIDsOfClient($clientID, @$groupIDs)>
+
+Specifies all groups that the given client shall be part of.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client whose groups you'd like to specify.
+
+=item Param C<groupIDs>
+
+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<undef> 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<addGroupIDsToClient($clientID, @$groupIDs)>
+
+Adds the given client to the given groups.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client that you'd like to add to the given groups.
+
+=item Param C<groupIDs>
+
+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<undef> 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<removeGroupsIDsFromClient($clientID, @$groupIDs)>
+
+Removes the given client from the given groups.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client that you'd like to remove from the given groups.
+
+=item Param C<groupIDs>
+
+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<undef> 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<addGroup(@$valRows)>
+
+Adds one or more groups to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> 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<removeGroup(@$groupIDs)>
+
+Removes one or more groups from the database.
+
+=over
+
+=item Param C<groupIDs>
+
+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<undef> 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<setGroupAttr($groupID, $attrName, $attrValue)>
+#
+#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<groupID>
+#
+#The ID of the group whose attribute shall be changed.
+#
+#=item Param C<attrName>
+#
+#The name of the attribute to change.
+#
+#=item Param C<attrValue>
+#
+#The new value for the attribute.
+#
+#=item Return Value
+#
+#C<1> if the attribute could be set, C<undef> 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<changeGroup(@$groupIDs, @$valRows)>
+
+Changes the data of one or more groups.
+
+=over
+
+=item Param C<groupIDs>
+
+An array-ref containing the IDs of the groups that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> 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<setClientIDsOfGroup($groupID, @$clientIDs)>
+
+Specifies all clients that should be part of the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group whose clients you'd like to specify.
+
+=item Param C<clientIDs>
+
+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<undef> 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<addClientIDsToGroup($groupID, @$clientIDs)>
+
+Add some clients to the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group to which you'd like to add clients.
+
+=item Param C<clientIDs>
+
+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<undef> 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<removeClientIDsFromGroup($groupID, @$clientIDs)>
+
+Remove some clients from the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group from which you'd like to remove clients.
+
+=item Param C<clientIDs>
+
+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<undef> 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<setSystemIDsOfGroup($groupID, @$systemIDs)>
+
+Specifies all systems that should be offered for booting by the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group whose systems you'd like to specify.
+
+=item Param C<systemIDs>
+
+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<undef> 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<addSystemIDsToGroup($groupID, @$systemIDs)>
+
+Adds some systems to the set that should be offered for booting by the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group to which you'd like to add systems.
+
+=item Param C<systemIDs>
+
+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<undef> 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<removeSystemIDsFromGroup($groupID, @$systemIDs)>
+
+Removes some systems from the set that should be offered for booting by the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group from which you'd like to remove systems.
+
+=item Param C<systemIDs>
+
+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<undef> 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<emptyDatabase()>
+
+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 '<<<default>>>' } $self->fetchClientByFilter();
+ $self->removeClient(\@clientIDs);
+
+ my @sysIDs = map { $_->{id} }
+ grep { $_->{name} ne '<<<default>>>' } $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<mergeDefaultAttributesIntoSystem($system)>
+
+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<system>
+
+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 => '<<<default>>>'});
+ mergeAttributes($system, $defaultSystem, $originInfo, 'default-system');
+
+ # finally push the attributes specified for the default client (these
+ # overrule anything else)
+ my $defaultClient = $self->fetchClientByFilter({name => '<<<default>>>'});
+ pushAttributes($system, $defaultClient, $originInfo, 'default-client');
+
+ return 1;
+}
+
+=item C<mergeDefaultAndGroupAttributesIntoClient($client)>
+
+merges default and group configurations into the given client hash.
+
+=over
+
+=item Param C<client>
+
+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 => '<<<default>>>'});
+ mergeAttributes($client, $defaultClient, $originInfo, 'default-client');
+
+ return 1;
+}
+
+=item C<aggregatedSystemIDsOfClient($client)>
+
+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<client>
+
+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 => '<<<default>>>'});
+ push @systemIDs, $self->fetchSystemIDsOfClient($defaultClient->{id});
+
+ return _unique(@systemIDs);
+}
+
+=item C<aggregatedClientIDsOfSystem($system)>
+
+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<system>
+
+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 => '<<<default>>>'});
+ 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 => '<<<default>>>'});
+ push @clientIDs, $self->fetchClientIDsOfSystem($defaultSystem->{id});
+
+ return _unique(@clientIDs);
+}
+
+=item C<aggregatedSystemFileInfoFor($system)>
+
+Returns aggregated information about the kernel and initialramfs
+this system is using.
+
+=over
+
+=item Param C<system>
+
+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<mergeAttributes($target, $source)>
+
+Copies all attributes from source that are unset in target over (source extends target).
+
+=over
+
+=item Param C<target>
+
+The hash to be used as copy target.
+
+=item Param C<source>
+
+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<pushAttributes($target, $source)>
+
+Copies all attributes that are set in source into the target (source overrules target).
+
+=over
+
+=item Param C<target>
+
+The hash to be used as copy target.
+
+=item Param C<source>
+
+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<externalIDForSystem($system)>
+
+Returns the given system's name as an external ID - worked into a
+state that is usable as a filename.
+
+=over
+
+=item Param C<system>
+
+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 '<<<default>>>';
+
+ my $name = $system->{name};
+ $name =~ tr[/][_];
+
+ return $name;
+}
+
+=item C<externalIDForClient($client)>
+
+Returns the given client's MAC as an external ID - worked into a
+state that is usable as a filename.
+
+=over
+
+=item Param C<client>
+
+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 '<<<default>>>';
+
+ my $mac = lc($client->{mac});
+ # PXE seems to expect MACs being all lowercase
+ $mac =~ tr[:][-];
+
+ return "01-$mac";
+}
+
+=item C<externalConfigNameForClient($client)>
+
+Returns the given client's name as an external ID - worked into a
+state that is usable as a filename.
+
+=over
+
+=item Param C<client>
+
+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 '<<<default>>>';
+
+ my $name = $client->{name};
+ $name =~ tr[/][_];
+
+ return $name;
+}
+
+=item C<generatePlaceholdersFor($varName)>
+
+Returns the given variable as a placeholder - surrounded by '@@@' markers.
+
+=over
+
+=item Param C<varName>
+
+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' => '<<<default>>>',
+ '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-name>-<export-type>
+ '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:
+ # <vendor-os-name>-<export-type>-<kernel>
+ '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' => '<<<default>>>',
+ '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 => '<<<default>>>',
+ 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<The synopsis above outlines a class that implements a
+MetaDB driver for the (imaginary) database B<coolnewDB>>
+
+=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<basic methods> (connection handling and utilities)
+
+=item - L<data access methods> (getting data)
+
+=item - L<data manipulation methods> (adding, removing and changing data)
+
+=item - L<schema related methods> (migrating between different DB-versions)
+
+=back
+
+In order to implement a MetaDB driver for a specific database, you need
+to inherit from B<OpenSLX::MetaDB::Base> and implement the full interface. As this
+is quite some work, it might be wiser to actually inherit your driver from
+B<L<OpenSLX::MetaDB::DBI|OpenSLX::MetaDB::DBI>>, 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<OpenSLX::MetaDB::DBI> and then
+reimplement L<C<connectConfigDB>> (and maybe some other methods in order to
+improve efficiency).
+
+=head1 Special Concepts
+
+=over
+
+=item C<Filters>
+
+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<connectConfigDB()>
+
+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<disconnectConfigDB()>
+
+Tears down the connection to the DBMS that this MetaDB driver deals with and
+cleans up.
+
+=item C<quote(string)>
+
+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<fetchVendorOSByFilter([%$filter], [$resultCols])>
+
+Fetches and returns information about all vendor-OSes 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</"Filters"> for more info.
+
+=item Param C<resultCols>
+
+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<fetchVendorOSByID(@$ids, [$resultCols])>
+
+Fetches and returns information the vendor-OSes with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the vendor-OS-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchExportByFilter([%$filter], [$resultCols])>
+
+Fetches and returns information about all exports 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</"Filters"> for more info.
+
+=item Param C<resultCols>
+
+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<fetchExportByID(@$ids, [$resultCols])>
+
+Fetches and returns information the exports with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the export-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchExportIDsOfVendorOS($id)>
+
+Fetches the IDs of all exports that make use of the vendor-OS with the given ID.
+
+=over
+
+=item Param C<id>
+
+ID of the vendor-OS whose exports shall be returned.
+
+=item Return Value
+
+An array of system-IDs.
+
+=back
+
+=item C<fetchSystemByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchSystemByID(@$ids, [$resultCols])>
+
+Fetches and returns information the systems with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the system-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchSystemIDsOfExport($id)>
+
+Fetches the IDs of all systems that make use of the export with the given ID.
+
+=over
+
+=item Param C<id>
+
+ID of the export whose systems shall be returned.
+
+=item Return Value
+
+An array of system-IDs.
+
+=back
+
+=item C<fetchSystemIDsOfClient($id)>
+
+Fetches the IDs of all systems that are used by the client with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+ID of the client whose systems shall be returned.
+
+=item Return Value
+
+An array of system-IDs.
+
+=back
+
+=item C<fetchSystemIDsOfGroup($id)>
+
+Fetches the IDs of all systems that are part of the group with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+ID of the group whose systems shall be returned.
+
+=item Return Value
+
+An array of system-IDs.
+
+=back
+
+=item C<fetchClientByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchClientByID(@$ids, [$resultCols])>
+
+Fetches and returns information the clients with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the client-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchClientIDsOfSystem($id)>
+
+Fetches the IDs of all clients that make use of the system with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+ID of the system whose clients shall be returned.
+
+=item Return Value
+
+An array of client-IDs.
+
+=back
+
+=item C<fetchClientIDsOfGroup($id)>
+
+Fetches the IDs of all clients that are part of the group with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+ID of the group whose clients shall be returned.
+
+=item Return Value
+
+An array of client-IDs.
+
+=back
+
+
+
+=item C<fetchGroupByFilter([%$filter], [$resultCols])>
+
+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</"Filters"> 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<fetchGroupByID(@$ids, [$resultCols])>
+
+Fetches and returns information the groups with the given IDs.
+
+=over
+
+=item Param C<ids>
+
+An array of the group-IDs you are interested in.
+
+=item Param C<resultCols>
+
+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<fetchGroupIDsOfClient($id)>
+
+Fetches the IDs of all groups that contain the client with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+ID of the client whose groups shall be returned.
+
+=item Return Value
+
+An array of client-IDs.
+
+=back
+
+
+
+=item C<fetchGroupIDsOfSystem($id)>
+
+Fetches the IDs of all groups that contain the system with the given
+ID.
+
+=over
+
+=item Param C<id>
+
+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<addVendorOS(@$valRows)>
+
+Adds one or more vendor-OS to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> if the creation failed.
+
+=back
+
+
+
+=item C<removeVendorOS(@$vendorOSIDs)>
+
+Removes one or more vendor-OS from the database.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<changeVendorOS(@$vendorOSIDs, @$valRows)>
+
+Changes the data of one or more vendor-OS.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+An array-ref containing the IDs of the vendor-OSes that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<addExport(@$valRows)>
+
+Adds one or more export to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> if the creation failed.
+
+=back
+
+
+
+=item C<removeExport(@$exportIDs)>
+
+Removes one or more export from the database.
+
+=over
+
+=item Param C<exportIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<changeExport(@$exportIDs, @$valRows)>
+
+Changes the data of one or more export.
+
+=over
+
+=item Param C<vendorOSIDs>
+
+An array-ref containing the IDs of the exports that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<addSystem(@$valRows)>
+
+Adds one or more systems to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> if the creation failed.
+
+=back
+
+
+
+=item C<removeSystem(@$systemIDs)>
+
+Removes one or more systems from the database.
+
+=over
+
+=item Param C<systemIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<changeSystem(@$systemIDs, @$valRows)>
+
+Changes the data of one or more systems.
+
+=over
+
+=item Param C<systemIDs>
+
+An array-ref containing the IDs of the systems that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setClientIDsOfSystem($systemID, @$clientIDs)>
+
+Specifies all clients that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system whose clients you'd like to specify.
+
+=item Param C<clientIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setGroupIDsOfSystem($systemID, @$groupIDs)>
+
+Specifies all groups that should offer the given system for booting.
+
+=over
+
+=item Param C<systemID>
+
+The ID of the system whose groups you'd like to specify.
+
+=item Param C<clientIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<addClient(@$valRows)>
+
+Adds one or more clients to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> if the creation failed.
+
+=back
+
+
+
+=item C<removeClient(@$clientIDs)>
+
+Removes one or more clients from the database.
+
+=over
+
+=item Param C<clientIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<changeClient(@$clientIDs, @$valRows)>
+
+Changes the data of one or more clients.
+
+=over
+
+=item Param C<clientIDs>
+
+An array-ref containing the IDs of the clients that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setSystemIDsOfClient($clientID, @$clientIDs)>
+
+Specifies all systems that should be offered for booting by the given client.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client whose systems you'd like to specify.
+
+=item Param C<systemIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setGroupIDsOfClient($clientID, @$groupIDs)>
+
+Specifies all groups that the given client shall be part of.
+
+=over
+
+=item Param C<clientID>
+
+The ID of the client whose groups you'd like to specify.
+
+=item Param C<groupIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<addGroup(@$valRows)>
+
+Adds one or more groups to the database.
+
+=over
+
+=item Param C<valRows>
+
+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<undef> if the creation failed.
+
+=back
+
+
+
+=item C<removeGroup(@$groupIDs)>
+
+Removes one or more groups from the database.
+
+=over
+
+=item Param C<groupIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<changeGroup(@$groupIDs, @$valRows)>
+
+Changes the data of one or more groups.
+
+=over
+
+=item Param C<groupIDs>
+
+An array-ref containing the IDs of the groups that shall be changed.
+
+=item Param C<valRows>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setClientIDsOfGroup($groupID, @$clientIDs)>
+
+Specifies all clients that should be part of the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group whose clients you'd like to specify.
+
+=item Param C<clientIDs>
+
+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<undef> if not.
+
+=back
+
+
+
+=item C<setSystemIDsOfGroup($groupID, @$groupIDs)>
+
+Specifies all systems that should be offered for booting by the given group.
+
+=over
+
+=item Param C<groupID>
+
+The ID of the group whose systems you'd like to specify.
+
+=item Param C<systemIDs>
+
+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<undef> 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 <old> RENAME TO <new>' 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 <table> ADD COLUMN <col>' 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 <table> DROP COLUMN <col>' 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 <table> CHANGE COLUMN <col>' 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 <key>=<value>\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 <key>=<value>\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<none>";
+ " $_:\n$subLines\n";
+ } elsif (ref($elemVal) eq 'ARRAY') {
+ my $subLines
+ = join( "\n", map { "$ind$_" } sort @$elemVal);
+ $subLines ||= "$ind<none>";
+ " $_:\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)
+ : '<none>';
+ $_;
+ }
+ 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)
+ : '<none>';
+ $_;
+ }
+ 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' => '<<<default>>>'});
+ 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 '<<<default>>>') {
+ 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 '<<<default>>>') {
+ 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 '<<<default>>>') {
+ 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 '<<<default>>>') {
+ 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 <<<default>>>
+ $name = '<<<default>>>' if $name eq 'default';
+
+ return $name;
+}
+
+=head1 NAME
+
+slxconfig - OpenSLX-script to view & change the configurational database
+
+=head1 SYNOPSIS
+
+slxconfig [options] <action> <key-value-pairs>
+
+=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 <client-name> mac=<MAC> [<key>=<value> ...] >>
+
+adds a new client to the config-DB
+
+=item B<< add-system <system-name> [export=<export-name>] \ >>
+
+=item B<< <key>=<value> ...] >>
+
+adds a new system to the config-DB
+
+=item B<< add-group <group-name> [priority=<Number>] [<key>=<value> ...] >>
+
+adds a new group to the config-DB
+
+=item B<< change-vendor-os <vendor-os-name> [<key>=<value> ...] >>
+
+changes the data of an existing vendor-OS in the config-DB.
+
+=item B<< change-export <export-name> [<key>=<value> ...] >>
+
+changes the data of an existing export in the config-DB
+
+=item B<< change-client <client-name> [<key>=<value> ...] >>
+
+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 <group-name> [<key>=<value> ...] >>
+
+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 <system-name> [<key>=<value> ...] >>
+
+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 [<attr-scope-or-attr-name>] >>
+
+lists all attributes, the ones in the given scope or the one with the given
+name
+
+=item B<< list-client [<client-name>] >>
+
+lists client with given name
+
+=item B<< list-export [<export-name>] >>
+
+lists export with given name
+
+=item B<< list-group [<group-name>] >>
+
+lists group with given name
+
+=item B<< list-system [<system-name>] >>
+
+lists system with given name
+
+=item B<< list-vendor-os [<vendorOS-name>] >>
+
+lists vendor-OS with given name
+
+=item B<< remove-client <client-name> >>
+
+removes a client from the config-DB
+
+=item B<< remove-group <group-name> >>
+
+removes a group from the config-DB
+
+=item B<< remove-system <system-name> >>
+
+removes a system from the config-DB
+
+=item B<< search-client [<key>=<value> ...] >>
+
+shows all clients in config-DB (optionally matching given criteria)
+
+=item B<< search-export [<key>=<value> ...] >>
+
+shows all exports in config-DB (optionally matching given criteria)
+
+=item B<< search-group [<key>=<value> ...] >>
+
+shows all groups in config-DB (optionally matching given criteria)
+
+=item B<< search-system [<key>=<value> ...] >>
+
+shows all systems in config-DB (optionally matching given
+criteria)
+
+=item B<< search-vendor-os [<key>=<value> ...] >>
+
+shows all vendor-OSes in config-DB (optionally matching given criteria)
+
+=back
+
+=head1 DESCRIPTION
+
+B<slxconfig> 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 "<<<default>>>" >>
+
+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 <scope> >>
+
+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 <client-name> >>
+
+=item B<< slxconfig remove-group <group-name> >>
+
+=item B<< slxconfig remove-system <system-name> >>
+
+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=<string> name of database
+ --db-spec=<string> full DBI-specification of database
+ --db-type=<string> type of database to connect to
+ --locale=<string> locale to use for translations
+ --log-level=<int> level of logging verbosity (0-3)
+ --logfile=<string> file to write logging output to
+ --private-path=<string> path to private data
+ --public-path=<string> path to public (client-accesible) data
+ --temp-path=<string> path to temporary data
+
+Please refer to the C<slxsettings>-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 '<<<default>>>' } $openslxDB->fetchSystemByFilter();
+if (@ARGV) {
+ # create initramfs only for systems given on cmdline
+ for my $systemName (@ARGV) {
+ if ($systemName eq '<<<default>>>') {
+ 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 '<<<default>>>';
+ # 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 : '<none>';
+ 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] [<system-name> ...]
+
+=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<slxconfig-demuxer> 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<Basic PXE Setup>
+
+The basic PXE files (F<menu.c32>, F<pxelinux.0>) will be copied into
+F<$SLX_PUBLIC_PATH/tftpboot> to make them available to any PXE-client via tftp.
+
+=item B<PXE Client Configurations>
+
+For each client, a PXE configuration file will be generated and written to
+F<$SLX_PUBLIC_PATH/tftpboot/pxelinux.cfg/01-<MAC-of-client>>. 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<System Kernels and Initialram-Filesystems>
+
+For each bootable system, that system's kernel will be copied to
+F<$SLX_PUBLIC_PATH/tftpboot/<vendor-os-name>/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/<vendor-os-name>/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<OpenSLX Client Configurations>
+
+For each system, an OpenSLX configuration archive will be generated and written
+to F<$SLX_PUBLIC_PATH/tftpboot/client-config/<system-name>/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/<system-name>/01-<MAC-of-client>.tgz>).
+
+Each of these archives will contain the file F<initramfs/machine-setup>,
+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/<system-name>>.
+
+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/<system-name>/01-<MAC-of-client> >>.
+
+=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<hw_monitor>-attribute of the B<system> 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<hw_monitor>-attribute of that B<client> 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=<string> name of database
+ --db-spec=<string> full DBI-specification of database
+ --db-type=<string> type of database to connect to
+ --locale=<string> locale to use for translations
+ --log-level=<int> level of logging verbosity (0-3)
+ --logfile=<string> file to write logging output to
+ --private-path=<string> path to private data
+ --public-path=<string> path to public (client-accesible) data
+ --temp-path=<string> path to temporary data
+
+Please refer to the C<slxsettings>-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();