summaryrefslogtreecommitdiffstats
path: root/src/installer/OpenSLX/OSExport/FileSystem
diff options
context:
space:
mode:
Diffstat (limited to 'src/installer/OpenSLX/OSExport/FileSystem')
-rw-r--r--src/installer/OpenSLX/OSExport/FileSystem/Base.pm148
-rw-r--r--src/installer/OpenSLX/OSExport/FileSystem/NFS.pm238
-rw-r--r--src/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm410
3 files changed, 796 insertions, 0 deletions
diff --git a/src/installer/OpenSLX/OSExport/FileSystem/Base.pm b/src/installer/OpenSLX/OSExport/FileSystem/Base.pm
new file mode 100644
index 00000000..05f3c6a0
--- /dev/null
+++ b/src/installer/OpenSLX/OSExport/FileSystem/Base.pm
@@ -0,0 +1,148 @@
+# Copyright (c) 2006, 2007 - OpenSLX GmbH
+#
+# This program is free software distributed under the GPL version 2.
+# See http://openslx.org/COPYING
+#
+# If you have any feedback please consult http://openslx.org/feedback and
+# send your suggestions, praise, or complaints to feedback@openslx.org
+#
+# General information about OpenSLX can be found at http://openslx.org/
+# -----------------------------------------------------------------------------
+# Base.pm
+# - provides empty base of the OpenSLX OSExport::FileSystem API.
+# -----------------------------------------------------------------------------
+package OpenSLX::OSExport::FileSystem::Base;
+
+use strict;
+use warnings;
+
+our $VERSION = 1.01; # API-version . implementation-version
+
+use File::Basename;
+use Scalar::Util qw( weaken );
+
+use OpenSLX::Basics;
+use OpenSLX::Utils;
+
+################################################################################
+### interface methods
+################################################################################
+sub new
+{
+ confess "Creating OpenSLX::OSExport::FileSystem::Base-objects directly makes no sense!";
+}
+
+sub initialize
+{
+ my $self = shift;
+ my $engine = shift;
+
+ $self->{'engine'} = $engine;
+ weaken($self->{'engine'});
+ # avoid circular reference between file-system and its engine
+}
+
+sub exportVendorOS
+{
+}
+
+sub purgeExport
+{
+}
+
+sub checkRequirements
+{
+ return 1;
+}
+
+sub addExportToConfigDB
+{
+ my $self = shift;
+ my $export = shift;
+ my $openslxDB = shift;
+
+ return $openslxDB->addExport($export);
+}
+
+sub generateExportURI
+{
+}
+
+sub requiredFSMods
+{
+}
+
+sub requiredFSTools
+{
+}
+
+sub showExportConfigInfo
+{
+}
+
+################################################################################
+### implementation methods
+################################################################################
+sub _pickKernelVersion
+{
+ my $self = shift;
+ my $vendorOSPath = shift;
+
+ my $kernel = followLink("$vendorOSPath/boot/vmlinuz");
+ if (!-e $kernel) {
+ # 'vmlinuz'-link doesn't exist, so we have to pick the kernel manually
+ my $osSetupEngine = instantiateClass("OpenSLX::OSSetup::Engine");
+ $osSetupEngine->initialize($self->{engine}->{'vendor-os-name'}, 'none');
+ $kernel = $osSetupEngine->pickKernelFile("$vendorOSPath/boot");
+ }
+ my $kernelName = basename($kernel);
+ if ($kernelName !~ m[-(.+)$]) {
+ die _tr("unable to determine version of kernel '%s'!", $kernelName);
+ }
+ return $1;
+}
+
+sub _locateKernelModule
+{
+ my $self = shift;
+ my $vendorOSPath = shift;
+ my $moduleName = shift;
+ my $defaultPaths = shift;
+
+ vlog(1, _tr("locating kernel-module '%s'", $moduleName));
+ # check default paths first:
+ foreach my $defPath (@$defaultPaths) {
+ vlog(2, "trying $defPath/$moduleName");
+ my $target = followLink("$defPath/$moduleName", $vendorOSPath);
+ return $target unless !-e $target;
+ }
+ # use brute force to search for the newest incarnation of the module:
+ use File::Find;
+ my $location;
+ my $locationAge = 9999999;
+ vlog(2, "searching in $vendorOSPath/lib/modules");
+ find sub {
+ return unless $_ eq $moduleName;
+ if (-M _ < $locationAge) {
+ $locationAge = -M _;
+ $location = $File::Find::name;
+ vlog(2, "located at $location (age=$locationAge days)");
+ }
+ }, "$vendorOSPath/lib/modules";
+ if (defined $location) {
+ return followLink($location, $vendorOSPath);
+ }
+ return;
+}
+
+1;
+
+################################################################################
+
+=pod
+
+=head1 NAME
+
+OpenSLX::OSExport::FileSystem::Base - the base class for all OSExport::FileSystems
+
+=cut
diff --git a/src/installer/OpenSLX/OSExport/FileSystem/NFS.pm b/src/installer/OpenSLX/OSExport/FileSystem/NFS.pm
new file mode 100644
index 00000000..9bd2ca87
--- /dev/null
+++ b/src/installer/OpenSLX/OSExport/FileSystem/NFS.pm
@@ -0,0 +1,238 @@
+# 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/
+# -----------------------------------------------------------------------------
+# NFS.pm
+# - provides NFS-specific overrides of the OpenSLX::OSExport::FileSystem API.
+# -----------------------------------------------------------------------------
+package OpenSLX::OSExport::FileSystem::NFS;
+
+use strict;
+use warnings;
+
+use base qw(OpenSLX::OSExport::FileSystem::Base);
+
+use File::Basename;
+use OpenSLX::Basics;
+use OpenSLX::ConfigDB qw(:support);
+use OpenSLX::Utils;
+
+################################################################################
+### interface methods
+################################################################################
+sub new
+{
+ my $class = shift;
+ my $self = {
+ 'name' => 'nfs',
+ };
+ return bless $self, $class;
+}
+
+sub initialize
+{
+ my $self = shift;
+ my $engine = shift;
+
+ $self->SUPER::initialize($engine);
+
+ my $exportBasePath = "$openslxConfig{'public-path'}/export";
+ $self->{'export-path'} = "$exportBasePath/nfs/$engine->{'vendor-os-name'}";
+ return;
+}
+
+sub exportVendorOS
+{
+ my $self = shift;
+ my $source = shift;
+
+ my $target = $self->{'export-path'};
+ if ($self->_isTargetBindMounted($source, $target)) {
+ warn _tr(
+ "%s is a bind-mount to vendor-OS root - rsync step is skipped!",
+ $target
+ );
+ return;
+ }
+
+ $self->_copyViaRsync($source, $target);
+
+ return;
+}
+
+sub purgeExport
+{
+ my $self = shift;
+
+ my $source = $self->{'engine'}->{'vendor-os-path'};
+ my $target = $self->{'export-path'};
+ if ($self->_isTargetBindMounted($source, $target)) {
+ warn _tr(
+ "%s is a bind-mount to vendor-OS root - removal step is skipped!",
+ $target
+ );
+ return;
+ }
+
+ if (system("rm -r $target")) {
+ vlog(0, _tr("unable to remove export '%s'!", $target));
+ return 0;
+ }
+ return 1;
+}
+
+sub checkRequirements
+{
+ my $self = shift;
+ my $vendorOSPath = shift;
+
+ # determine most appropriate kernel version ...
+ my $kernelVer = $self->_pickKernelVersion($vendorOSPath);
+
+ # ... and check if that kernel-version provides all the required modules
+ my $nfsMod = $self->_locateKernelModule(
+ $vendorOSPath,
+ 'nfs.ko',
+ [
+ "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/nfs",
+ "$vendorOSPath/lib/modules/$kernelVer/kernel/fs"
+ ]
+ );
+ if (!defined $nfsMod) {
+ warn _tr("unable to find nfs-module for kernel version '%s'.",
+ $kernelVer);
+ return;
+ }
+ return 1;
+}
+
+sub generateExportURI
+{
+ my $self = shift;
+ my $export = shift;
+ my $vendorOS = shift;
+
+ my $serverIP = $export->{server_ip} || '';
+ my $server
+ = length($serverIP) ? $serverIP : generatePlaceholderFor('serverip');
+ my $port = $export->{port} || '';
+ $server .= ":$port" if length($port);
+
+ my $exportPath = "$openslxConfig{'public-path'}/export";
+ return "nfs://$server$exportPath/nfs/$vendorOS->{name}";
+}
+
+sub requiredFSMods
+{
+ my $self = shift;
+
+ return qw( nfs );
+}
+
+sub showExportConfigInfo
+{
+ my $self = shift;
+ my $export = shift;
+
+ print (('#' x 80)."\n");
+ print _tr("Please make sure the following line is contained in /etc/exports\nin order to activate the NFS-export of this vendor-OS:\n\t%s\n",
+ "$self->{'export-path'}\t*(ro,no_root_squash,async,no_subtree_check)");
+ print (('#' x 80)."\n");
+
+# TODO : add something a bit more clever here...
+# my $exports = slurpFile("/etc/exports");
+ return;
+}
+
+################################################################################
+### implementation methods
+################################################################################
+sub _copyViaRsync
+{
+ my $self = shift;
+ my $source = shift;
+ my $target = shift;
+
+ if (system("mkdir -p $target")) {
+ die _tr("unable to create directory '%s', giving up! (%s)\n",
+ $target, $!);
+ }
+ my $includeExcludeList = $self->_determineIncludeExcludeList();
+ vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList));
+ my $rsyncFH;
+ my $additionalRsyncOptions = $ENV{SLX_RSYNC_OPTIONS} || '';
+ my $rsyncCmd
+ = "rsync -av --delete-excluded --exclude-from=- $additionalRsyncOptions"
+ . " $source/ $target";
+ vlog(2, "executing: $rsyncCmd\n");
+ open($rsyncFH, '|-', $rsyncCmd)
+ or die _tr("unable to start rsync for source '%s', giving up! (%s)",
+ $source, $!);
+ print $rsyncFH $includeExcludeList;
+ close($rsyncFH)
+ or die _tr("unable to export to target '%s', giving up! (%s)",
+ $target, $!);
+ return;
+}
+
+sub _determineIncludeExcludeList
+{
+ my $self = shift;
+
+ # Rsync uses a first match strategy, so we mix the local specifications
+ # in front of the filterset given by the package (as the local filters
+ # should always overrule the vendor filters):
+ my $distroName = $self->{engine}->{'distro-name'};
+ my $localFilterFile
+ = "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter";
+ my $includeExcludeList
+ = slurpFile($localFilterFile, { failIfMissing => 0 });
+ $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'};
+ $includeExcludeList =~ s[^\s+][]igms;
+ # remove any leading whitespace, as rsync doesn't like it
+ return $includeExcludeList;
+}
+
+sub _isTargetBindMounted
+{
+ my $self = shift;
+ my $source = shift;
+ my $target = shift;
+
+ # For development purposes, it is very desirable to be able to take a
+ # shortcut that avoids doing the actual copying of the folders (as that
+ # takes a considerable amount of time).
+ # In order to support this, we explicitly check if the OpenSLX NFS export
+ # root folder (/srv/openslx/export/nfs) is a bind-mount of the OpenSLX
+ # stage1 folder (/var/opt/openslx/stage1).
+ # If that is the case, we print a notice and skip the rsync step (which
+ # wouldn't work anyway, as source and target folder are the same).
+ my $stage1Root = dirname($source);
+ my $nfsRoot = dirname($target);
+ chomp(my $canonicalStage1Root = qx{readlink -f $stage1Root} || $stage1Root);
+ chomp(my $canonicalNFSRoot = qx{readlink -f $nfsRoot} || $nfsRoot);
+ my @mounts = slurpFile('/etc/mtab');
+ for my $mount (@mounts) {
+ if ($mount =~ m{
+ ^
+ $canonicalStage1Root # mount source
+ \s+
+ $canonicalNFSRoot # mount target
+ \s+
+ none # filesystem for bind mounts is 'none'
+ \s+
+ \S*\bbind\b\S* # look for bind mounts only
+ }gmsx) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+1;
diff --git a/src/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm b/src/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm
new file mode 100644
index 00000000..77034c9c
--- /dev/null
+++ b/src/installer/OpenSLX/OSExport/FileSystem/SquashFS.pm
@@ -0,0 +1,410 @@
+# 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/
+# -----------------------------------------------------------------------------
+# SquashFS.pm
+# - provides SquashFS-specific overrides of the OpenSLX::OSExport::ExportType
+# API.
+# -----------------------------------------------------------------------------
+package OpenSLX::OSExport::FileSystem::SquashFS;
+
+use strict;
+use warnings;
+
+use base qw(OpenSLX::OSExport::FileSystem::Base);
+
+use File::Basename;
+use OpenSLX::Basics;
+use OpenSLX::ConfigDB qw(:support);
+use OpenSLX::OSExport::FileSystem::Base 1;
+use OpenSLX::Utils;
+
+################################################################################
+### interface methods
+################################################################################
+sub new
+{
+ my $class = shift;
+ my $self = {'name' => 'sqfs',};
+ return bless $self, $class;
+}
+
+sub initialize
+{
+ my $self = shift;
+ my $engine = shift;
+ my $blockDevice = shift || confess('need to pass in block-device!');
+
+ $self->SUPER::initialize($engine);
+
+ $self->{'block-device'} = $blockDevice;
+ my $exportBasePath = "$openslxConfig{'public-path'}/export";
+ $self->{'export-path'} = "$exportBasePath/sqfs/$engine->{'vendor-os-name'}";
+ return;
+}
+
+sub exportVendorOS
+{
+ my $self = shift;
+ my $source = shift;
+
+ my $includeExcludeList = $self->_determineIncludeExcludeList();
+ # in order to do the filtering as part of mksquashfs, we need to map
+ # our internal (rsync-)filter format to regexes:
+ $includeExcludeList =
+ $self->_mapRsyncFilter2Regex($source, $includeExcludeList);
+ vlog(1, _tr("using include-exclude-filter:\n%s\n", $includeExcludeList));
+ my $target = $self->{'export-path'};
+
+ my $sourceTime = (stat($source))[9] || 0;
+ my $targetTime = (stat($target))[9] || 0;
+ vlog(2, "source-time=$sourceTime target-time=$targetTime");
+
+ if ($targetTime && $sourceTime < $targetTime) {
+ vlog(
+ 0,
+ "!!! creation of squashfs skipped, as vendor-OS hasn't changed since last export!\n"
+ . "!!! Use 'touch $source' to force an export."
+ );
+ } else {
+ $self->_createSquashFS($source, $target, $includeExcludeList);
+ }
+ $self->_addBlockDeviceTagToExport($target);
+ return;
+}
+
+sub purgeExport
+{
+ my $self = shift;
+
+ my $target = $self->{'export-path'};
+ if ($self->_removeBlockDeviceTagFromExport($target)) {
+ # no more tags, we can remove the image:
+ if (slxsystem("rm $target")) {
+ vlog(0, _tr("unable to remove export '%s'!", $target));
+ return 0;
+ }
+ }
+ return 1;
+}
+
+sub checkRequirements
+{
+ my $self = shift;
+ my $vendorOSPath = shift;
+
+ # determine most appropriate kernel version ...
+ my $kernelVer = $self->_pickKernelVersion($vendorOSPath);
+
+ # ... and check if that kernel-version provides all the required modules
+ my @blockModNames = $self->{'block-device'}->requiredBlockDeviceModules();
+ foreach my $blockModName (@blockModNames) {
+ my $blockMod =
+ $self->_locateKernelModule($vendorOSPath, "$blockModName.ko",
+ ["$vendorOSPath/lib/modules/$kernelVer/kernel/drivers/block"]);
+ if (!defined $blockMod) {
+ warn _tr(
+ "unable to find blockdevice-module '%s' for kernel version '%s'.",
+ $blockModName, $kernelVer
+ );
+ return;
+ }
+ }
+ my $squashfsMod = $self->_locateKernelModule(
+ $vendorOSPath,
+ 'squashfs.ko',
+ [
+ "$vendorOSPath/lib/modules/$kernelVer/kernel/fs/squashfs",
+ "$vendorOSPath/lib/modules/$kernelVer/kernel/fs"
+ ]
+ );
+ if (!defined $squashfsMod) {
+ warn _tr("unable to find squashfs-module for kernel version '%s'.",
+ $kernelVer);
+ return;
+ }
+ return 1;
+}
+
+sub addExportToConfigDB
+{
+ my $self = shift;
+ my $export = shift;
+ my $openslxDB = shift;
+
+ $export->{port} = $self->{'block-device'}->getExportPort($openslxDB);
+
+ my $res = $openslxDB->addExport($export);
+ return $res;
+}
+
+sub generateExportURI
+{
+ my $self = shift;
+ my $export = shift;
+ my $vendorOS = shift;
+
+ my $URI = $self->{'block-device'}->generateExportURI($export);
+ $URI .= '/squashfs';
+ return $URI;
+}
+
+sub requiredFSMods
+{
+ my $self = shift;
+
+ my @mods = $self->{'block-device'}->requiredBlockDeviceModules();
+ push @mods, 'squashfs ';
+ return @mods;
+}
+
+sub requiredFSTools
+{
+ my $self = shift;
+
+ return $self->{'block-device'}->requiredBlockDeviceTools();
+}
+
+sub showExportConfigInfo
+{
+ my $self = shift;
+ my $export = shift;
+
+ $self->{'block-device'}->showExportConfigInfo($export);
+ return;
+}
+
+################################################################################
+### implementation methods
+################################################################################
+
+#################################################################################
+# Branch to choose the appropriate squashfs version according to target system #
+################################################################################
+
+sub _createSquashFS
+{
+ my $self = shift;
+ my $source = shift;
+ my $target = shift;
+ my $includeExcludeList = shift;
+
+
+ my @versionString = split(/-/, $self->{engine}->{'vendor-os-name'});
+ my $mksquashfsVersion = $self->{engine}->{distro}->getSquashfsVersion($versionString[1]);
+
+ vlog(0, "found version string $versionString[1] out of $self->{engine}->{'vendor-os-name'}");
+ vlog(0, "use squashfs version: $mksquashfsVersion");
+
+ $self->_createSquashFS_prepare($target);
+
+ my $mksquashfsParams;
+
+ $mksquashfsVersion == '3.2' && do
+ {$mksquashfsParams = $self->_createSquashFS_setup_3_2($includeExcludeList)};
+ $mksquashfsVersion == '3.3' && do
+ {$mksquashfsParams = $self->_createSquashFS_setup_3_3($includeExcludeList)};
+ $mksquashfsVersion == '4.0' && do
+ {$mksquashfsParams = $self->_createSquashFS_setup_4($includeExcludeList)};
+
+ $self->_createSquashFS_run($source, $target, $mksquashfsParams);
+
+ return;
+}
+
+sub _createSquashFS_prepare
+{
+ my $self = shift;
+ my $target = shift;
+
+ system("rm -f $target");
+ # mksquasfs isn't significantly faster if fs already exists, but it
+ # causes the filesystem to grow somewhat, so we remove it in order to
+ # get the smallest FS-file possible.
+
+ my $baseDir = dirname($target);
+ if (!-e $baseDir) {
+ if (system("mkdir -p $baseDir")) {
+ die _tr("unable to create directory '%s', giving up! (%s)\n",
+ $baseDir, $!);
+ }
+ }
+ return;
+}
+
+
+sub _createSquashFS_run {
+ my $self = shift;
+ my $source = shift;
+ my $target = shift;
+ my $params = shift;
+
+ # ... invoke mksquashfs ...
+ vlog(0, _tr("invoking mksquashfs..."));
+ my $mksquashfsBinary =
+ "$openslxConfig{'base-path'}/share/squashfs/$params->{binary}";
+ my $res =
+ system("$mksquashfsBinary $source $target $params->{cmdlineOptions}");
+ unlink($params->{tmpfile});
+ # ... remove filter file if done
+ if ($res) {
+ die _tr(
+ "unable to create squashfs for source '%s' as target '%s', giving up! (%s)",
+ $source, $target, $!);
+ }
+ return;
+}
+
+sub _createSquashFS_setup_4
+{
+ my $self = shift;
+ my $includeExcludeList = shift;
+
+ # dump filter to a file ...
+ my $filterFile = "/tmp/slx-nbdsquash-filter-$$";
+ my $includeFile = "/tmp/slx-nbdsquash-includes-$$";
+ spitFile($filterFile, $includeExcludeList);
+
+ slxsystem("sed $filterFile -e '/^-/d' -e 's/^+[ \t]*//' > $includeFile");
+ slxsystem("sed -i $filterFile -e '/^+/d' -e 's/^-[ \t]*//'");
+
+ my $result = {
+ binary => "mksquashfs_4",
+ cmdlineOptions => "-wildcards -ef $filterFile",
+ tmpfile => "$filterFile"
+ };
+
+ return $result;
+}
+
+
+sub _createSquashFS_setup_3_3
+{
+ my $self = shift;
+ my $includeExcludeList = shift;
+
+ # dump filter to a file ...
+ my $filterFile = "/tmp/slx-nbdsquash-filter-$$";
+ my $includeFile = "/tmp/slx-nbdsquash-includes-$$";
+ spitFile($filterFile, $includeExcludeList);
+
+ slxsystem("sed $filterFile -e '/^-/d' -e 's/^+[ \t]*//' > $includeFile");
+ slxsystem("sed -i $filterFile -e '/^+/d' -e 's/^-[ \t]*//'");
+
+ my $result = {
+ binary => "mksquashfs_3_3",
+ cmdlineOptions => "-wildcards -ef $filterFile",
+ tmpfile => "$filterFile"
+ };
+
+ return $result;
+}
+
+
+sub _createSquashFS_setup_3_2
+{
+ my $self = shift;
+ my $includeExcludeList = shift;
+
+ # dump filter to a file ...
+ my $filterFile = "/tmp/slx-nbdsquash-filter-$$";
+ spitFile($filterFile, $includeExcludeList);
+
+ my $result = {
+ binary => "mksquashfs_3_2",
+ cmdlineOptions => "-ff $filterFile",
+ tmpfile => "$filterFile"
+ };
+
+ return $result;
+}
+
+sub _determineIncludeExcludeList
+{
+ my $self = shift;
+
+ # Rsync uses a first match strategy, so we mix the local specifications
+ # in front of the filterset given by the package (as the local filters
+ # should always overrule the vendor filters):
+ my $distroName = $self->{engine}->{'distro-name'};
+ my $localFilterFile =
+ "$openslxConfig{'config-path'}/distro-info/$distroName/export-filter";
+ my $includeExcludeList
+ = slurpFile($localFilterFile, { failIfMissing => 0 });
+ $includeExcludeList .= $self->{engine}->{distro}->{'export-filter'};
+ $includeExcludeList =~ s[^\s+][]igms;
+ # remove any leading whitespace, as rsync doesn't like it
+ return $includeExcludeList;
+}
+
+sub _mapRsyncFilter2Regex
+{
+ my $self = shift;
+ my $sourcePath = shift;
+ my $rsyncFilter = shift;
+
+ return join(
+ "\n",
+ map {
+ if ($_ =~ m[^([-+]\s*)(.+?)\s*$])
+ {
+ my $action = $1;
+ my $regex = $2;
+ $regex =~ s[\*\*][.+]g;
+ # '**' matches everything
+ $regex =~ s[\*][[^/]+]g;
+ # '*' matches anything except slashes
+ $regex =~ s[\?][[^/]?]g;
+ # '*' matches any single char except slash
+ $regex =~ s[\?][[^/]?]g;
+ # '*' matches any single char except slash
+ $regex =~ s[\.][\\.]g;
+ # escape any dots
+ if (substr($regex, 0, 1) eq '/') {
+ # absolute path given, need to extend by source-path:
+ "$action^$sourcePath$regex\$";
+ } else {
+ # filename pattern given, need to anchor to the end only:
+ "$action$regex\$";
+ }
+ } else {
+ $_;
+ }
+ }
+ split "\n",
+ $rsyncFilter
+ );
+}
+
+sub _addBlockDeviceTagToExport
+{
+ my $self = shift;
+ my $target = shift;
+
+ my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name});
+ linkFile(basename($target), $tagName);
+ return;
+}
+
+sub _removeBlockDeviceTagFromExport
+{
+ my $self = shift;
+ my $target = shift;
+
+ my $tagName = "$target" . '@' . lc($self->{'block-device'}->{name});
+ slxsystem("rm $tagName");
+ # now find out whether or not there are any other tags left:
+ my $vendorOSName = basename($target);
+ opendir(DIR, dirname($target));
+ my @tags = grep { /^$vendorOSName\@/ } readdir(DIR);
+ return @tags ? 0 : 1;
+ # return 1 if no more tags (i.e. it is safe to remove the image)
+}
+
+1;