From 112bbb1bf3d2d7f1fd66fa6f8e558744d0784226 Mon Sep 17 00:00:00 2001
From: Oliver Tappe
Date: Sun, 23 Mar 2008 15:18:42 +0000
Subject: * moved syscall related code into a module of its own right *
 activated mounting of /proc again in startSession() and finishSession(),  
 this time in a more robust fashion (which tries hard to unmount it again)

git-svn-id: http://svn.openslx.org/svn/openslx/openslx/trunk@1677 95ad53e4-c205-0410-b2fa-d234c58c8868
---
 lib/OpenSLX/Syscall.pm | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 56 insertions(+)
 create mode 100644 lib/OpenSLX/Syscall.pm

(limited to 'lib')

diff --git a/lib/OpenSLX/Syscall.pm b/lib/OpenSLX/Syscall.pm
new file mode 100644
index 00000000..58eb683d
--- /dev/null
+++ b/lib/OpenSLX/Syscall.pm
@@ -0,0 +1,56 @@
+# Copyright (c) 2008 - 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/
+# -----------------------------------------------------------------------------
+# PerlHeaders.pm
+#    - provides automatic generation of required perl headers (for syscalls)
+# -----------------------------------------------------------------------------
+package OpenSLX::Syscall;
+
+use strict;
+use warnings;
+
+our $VERSION = 1.01;
+
+use OpenSLX::Basics;
+
+sub _loadPerlHeader
+{
+    my @phFiles = @_;
+
+    for my $phFile (@phFiles) {
+        if (!eval { require $phFile }) {
+            # perl-header has not been provided by host-OS, so we create it
+            # manually from C-header (via h2ph):
+            (my $hFile = $phFile) =~ s{\.ph$}{.h};
+            if (-e "/usr/include/$hFile") {
+                my $libDir = "$openslxConfig{'base-path'}/lib";
+                slxsystem("cd /usr/include && h2ph -d $libDir $hFile") == 0
+                    or die _tr('unable to create %s! (%s)', $phFile, $!);
+            }
+        }
+        return 1 if eval { require $phFile; 1 };
+    }
+    die _tr(
+        'unable to load any of these perl headers: %s', join(',', @phFiles)
+    );
+}
+
+sub enter32BitPersonality
+{
+    _loadPerlHeader('syscall.ph');
+    _loadPerlHeader('linux/personality.ph', 'sys/personality.ph');
+
+    syscall(&SYS_personality, PER_LINUX32()) != -1
+        or die _tr("unable to invoke syscall '%s'! ($!)", 'personality');
+
+    return;
+}
+
+1;
-- 
cgit v1.2.3-55-g7522