From 2be1ce2c051c0621a819517680c064cc99c2731a Mon Sep 17 00:00:00 2001
From: Oliver Tappe
Date: Sat, 17 Mar 2007 15:10:23 +0000
Subject: * added executeInSubprocess() which encapsulates the starting and  
 reliable killing of a subprocess * added slxsystem() which handles any killed
 child processes   more properly (by exiting the parent, too).

git-svn-id: http://svn.openslx.org/svn/openslx/trunk@781 95ad53e4-c205-0410-b2fa-d234c58c8868
---
 lib/OpenSLX/Basics.pm | 49 ++++++++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 44 insertions(+), 5 deletions(-)

(limited to 'lib')

diff --git a/lib/OpenSLX/Basics.pm b/lib/OpenSLX/Basics.pm
index b1e052a4..c519a50d 100644
--- a/lib/OpenSLX/Basics.pm
+++ b/lib/OpenSLX/Basics.pm
@@ -15,7 +15,8 @@ $VERSION = 1.01;
 
 @EXPORT = qw(
 	&openslxInit %openslxConfig %cmdlineConfig
-	&_tr &trInit die
+	&_tr &trInit 
+	&die &executeInSubprocess &slxsystem
 	&vlog
 );
 
@@ -29,14 +30,13 @@ use FindBin;
 use Getopt::Long;
 use POSIX qw(locale_h);
 
-my $DEBUG = 0;
-
 my %translations;
 
 # this hash will hold the active openslx configuration,
 # the initial content is based on environment variables or default values.
 # Each value may be overrided from config files and/or cmdline arguments.
 %openslxConfig = (
+	'croak' => '0',
 	'db-datadir' => $ENV{SLX_DB_DATADIR},
 	'db-name' => $ENV{SLX_DB_NAME} || 'openslx',
 	'db-spec' => $ENV{SLX_DB_SPEC},
@@ -74,6 +74,8 @@ my %openslxCmdlineArgs = (
 		# path to binaries and scripts
 	'config-path=s' => \$cmdlineConfig{'config-path'},
 		# path to configuration files
+	'croak' => \$cmdlineConfig{'croak'},
+		# activates debug mode, this will show the lines where any error occured
 	'db-basepath=s' => \$cmdlineConfig{'db-basepath'},
 		# basic path to openslx database, defaults to "${private-path}/db"
 	'db-datadir=s' => \$cmdlineConfig{'db-datadir'},
@@ -273,15 +275,52 @@ sub _tr
 	return sprintf($formatStr, @_);
 }
 
+# ------------------------------------------------------------------------------
+sub executeInSubprocess
+{
+	my $childFunc = shift;
+
+	my $pid = fork();
+	if (!$pid) {
+		# child...
+		# ...execute the given function and exit:
+		&$childFunc();
+		exit 0;
+	}
+
+	# parent...
+	# ...pass on interrupt- and terminate-signals to child...
+	local $SIG{INT} 
+		= sub { kill 'INT', $pid; waitpid($pid, 0); exit $? };
+	local $SIG{TERM} 
+		= sub { kill 'TERM', $pid; waitpid($pid, 0); exit $? };
+	# ...and wait for child to do its work:
+	waitpid($pid, 0);
+	if ($?) {
+		exit $?;
+	}
+}
+
+# ------------------------------------------------------------------------------
+sub slxsystem
+{
+	my $res = system(@_);
+	if ($res & 127) {
+		# child got killed, so we stop, too
+		exit;
+	}
+	return $res;
+}
+
 # ------------------------------------------------------------------------------
 sub die
 {
 	my $msg = shift;
-	if ($DEBUG) {
+	if ($openslxConfig{'croak'}) {
 		print STDERR "*** ";
 		croak $msg;
 	} else {
-		$msg =~ s[^][!!! ]igms;
+		$msg =~ s[^][*** ]igms;
 		chomp $msg;
 		print STDERR "$msg\n";
 		exit $!;
-- 
cgit v1.2.3-55-g7522