* implemented support for recursive file-based locks

* used improved locking mechanism to protect not only slxconfig-demuxer
  against being executed twice, but also to avoid two different process groups
  from chrooting into the same vendor-OS


git-svn-id: http://svn.openslx.org/svn/openslx/openslx/trunk@2213 95ad53e4-c205-0410-b2fa-d234c58c8868

1 files changed, 83 insertions, 12 deletions

diff --git a/lib/OpenSLX/Utils.pm b/lib/OpenSLX/Utils.pm
index 6ebd4d7c..0ce253b9 100644
--- a/lib/OpenSLX/Utils.pm
+++ b/lib/OpenSLX/Utils.pm
@@ -23,18 +23,19 @@ $VERSION = 1.01;
 @ISA     = qw(Exporter);
 
 @EXPORT = qw(
-  copyFile fakeFile linkFile 
-  copyBinaryWithRequiredLibs
-  slurpFile spitFile appendFile
-  followLink 
-  unshiftHereDoc
-  string2Array
-  chrootInto
-  mergeHash
-  getFQDN
-  readPassword
-  hostIs64Bit
-  getAvailableBusyboxApplets
+    copyFile fakeFile linkFile 
+    copyBinaryWithRequiredLibs
+    slurpFile spitFile appendFile
+    followLink 
+    unshiftHereDoc
+    string2Array
+    chrootInto
+    mergeHash
+    getFQDN
+    readPassword
+    hostIs64Bit
+    getAvailableBusyboxApplets
+    grabLock
 );
 
 =head1 NAME
@@ -48,6 +49,7 @@ OpenSLX.
 
 =cut
 
+use Fcntl qw(:DEFAULT :flock);
 use File::Basename;
 use File::Path;
 use Socket;
@@ -55,6 +57,7 @@ use Sys::Hostname;
 use Term::ReadLine;
 
 use OpenSLX::Basics;
+use OpenSLX::ScopedResource;
 
 =head1 PUBLIC FUNCTIONS
 
@@ -584,4 +587,72 @@ sub getAvailableBusyboxApplets
     return @busyboxApplets;
 }
 
+=item grabLock()
+
+=cut
+
+sub grabLock
+{
+    my $lockName = shift || die 'you need to pass a lock-name to grabLock()!';
+
+    my $lockPath = "$openslxConfig{'private-path'}/locks";
+    mkpath($lockPath) unless -e $lockPath;
+    my $lockFile = "$lockPath/$lockName";
+
+    my $lockFH;
+
+    my $lock = OpenSLX::ScopedResource->new({
+        name    => "lock::$lockName",
+        acquire => sub { 
+            # use a lock-file to implement the actual locking:
+            if (-e $lockFile) {
+                my $ctime = (stat($lockFile))[10];
+                my $now   = time();
+                if ($now - $ctime > 15 * 60) {
+                    # existing lock file is older than 15 minutes, we consider
+                    # that to be a leftover (which shouldn't happen of course)
+                    # and wipe it:
+                    unlink $lockFile;
+                }
+            }
+            
+            local $| = 1;
+            my $waiting;
+            while(!(sysopen($lockFH, $lockFile, O_RDWR | O_CREAT | O_EXCL)
+                && print $lockFH getpgrp() . "\n")) {
+                if ($! == 13) {
+                    die _tr(
+                        qq[Unable to create lock "%s", giving up!], $lockFile
+                    );
+                } else {
+                    # check if the lock is owned by our own process group
+                    # and only block if it isn't (this allows recursive locking)
+                    my $pgrpOfLock 
+                        = slurpFile($lockFile, { failIfMissing => 0});
+                    last if $pgrpOfLock && $pgrpOfLock == getpgrp();
+
+                    # wait for lock to become available
+                    if (!$waiting) {
+                        print _tr('waiting for "%s"-lock ', $lockName);
+                        $waiting = 1;
+                    }
+                    else {
+                        print '.';
+                    }
+                    sleep(1);
+                }
+            }
+            print "ok\n" if $waiting;
+            1
+        },
+        release => sub {
+            close($lockFH);
+            unlink $lockFile;
+            1
+        },
+    });
+    
+    return $lock;
+}
+
 1;