bind all required perl includes to chrooted system

required for distroutils

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

1 files changed, 68 insertions, 57 deletions

diff --git a/os-plugins/OpenSLX/OSPlugin/Engine.pm b/os-plugins/OpenSLX/OSPlugin/Engine.pm
index d1eb961d..4fbf3209 100644
--- a/os-plugins/OpenSLX/OSPlugin/Engine.pm
+++ b/os-plugins/OpenSLX/OSPlugin/Engine.pm
@@ -625,72 +625,83 @@ sub _callChrootedFunctionForPlugin
     # create os-setup engine here in order to block access to the vendor-OS
     # via other processes (which could cause problems)
     my $osSetupEngine = $self->_osSetupEngine();
-
-    # prepare bind-mount of openslx base and config paths to /mnt of 
-    # vendor-OS:
-    my $basePath         = $openslxConfig{'base-path'};
-    my $basePathInChroot = "$self->{'vendor-os-path'}/mnt/opt/openslx";
-    mkpath($basePathInChroot);
-    my $configPath         = $openslxConfig{'config-path'};
-    my $configPathInChroot = "$self->{'vendor-os-path'}/mnt/etc/opt/openslx";
-    mkpath($configPathInChroot);
-    # prepare bind-mount of host's perl corelib path to /mnt of  vendor-OS:
-    my $hostPerlCorePath         = $Config{privlibexp};
-    my $hostPerlCorePathInChroot = "$self->{'vendor-os-path'}/mnt/host-perl";
-    mkpath($hostPerlCorePathInChroot);
+    
+    my @bindmounts;
+    my @chrootPerlIncludes;
+    
+    # setup list of perl modules we want to bind into chroot
+    push @chrootPerlIncludes, "/mnt/opt/openslx/lib";
+    
+    push @bindmounts, { 
+        'source' => $Config{privlibexp}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/perl/privlibexp"
+    };
+    push @chrootPerlIncludes, "/mnt/perl/privlibexp";
+    push @bindmounts, { 
+        'source' => $Config{archlibexp}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/perl/archlibexp"
+    };
+    push @chrootPerlIncludes, "/mnt/perl/archlibexp";
+    push @bindmounts, { 
+        'source' => $Config{vendorlibexp}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/perl/vendorlibexp"
+    };
+    push @chrootPerlIncludes, "/mnt/perl/vendorlibexp";
+    push @bindmounts, { 
+        'source' => $Config{vendorarchexp}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/perl/vendorarchexp"
+    };
+    push @chrootPerlIncludes, "/mnt/perl/vendorarchexp";
+    
+    # prepare openslx bind mounts
+    push @bindmounts, { 
+        'source' => $openslxConfig{'base-path'}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/opt/openslx"
+    };
+    push @bindmounts, { 
+        'source' => $openslxConfig{'config-path'}, 
+        'target' => "$self->{'vendor-os-path'}/mnt/etc/opt/openslx"
+    };
+    
+    # create mountpoints
+    foreach (@bindmounts) {
+    	mkpath($_->{'target'});
+    }
 
     my $pluginSession = OpenSLX::ScopedResource->new({
         name    => 'osplugin::session',
         acquire => sub { 
-            # bind mount openslx base and config paths into vendor-OS
-            slxsystem("mount -o bind -o ro $basePath $basePathInChroot") == 0
-                or die _tr(
-                    "unable to bind mount '%s' to '%s'! (%s)", 
-                    $basePath, $basePathInChroot, $!
-                );
-            slxsystem(
-                "mount -o bind -o ro $configPath $configPathInChroot"
-            ) == 0
-                or die _tr(
-                    "unable to bind mount '%s' to '%s'! (%s)", 
-                    $configPath, $configPathInChroot, $!
-                );
-            # Bind mount hosts perl core path into vendor-OS and add it to
-            # perl's search paths, in order to let dynamic loading of perl
-            # modules/scripts work. Currently, we hope that only the perl core
-            # path (privlibexp) is required for that, but we might have to 
-            # mount the architecture dependent path (archlibexp) or the
-            # vendor perl paths (vendorlibexp and vendorarchexp), too.
-            slxsystem(
-                "mount -o bind -o ro $hostPerlCorePath $hostPerlCorePathInChroot"
-            ) == 0
-                or die _tr(
-                    "unable to bind mount '%s' to '%s'! (%s)", 
-                    $hostPerlCorePath, $hostPerlCorePathInChroot, $!
-                );
-            unshift @INC, '/mnt/host-perl';
-            unshift @INC, "/mnt$openslxConfig{'base-path'}/lib";
+            # bind mount perl includes, openslx base and config paths into vendor-OS
+            foreach (@bindmounts) {
+	            slxsystem("mount -o bind -o ro $_->{'source'} $_->{'target'}") == 0
+	                or die _tr(
+	                    "unable to bind mount '%s' to '%s'! (%s)", 
+	                    $_->{'source'}, $_->{'target'}, $!
+	                );
+            }
+            
+            # add mounted perl includes to @INC
+            foreach (@chrootPerlIncludes) {
+            	unshift @INC, $_;
+            }
             1 
         },
         release => sub {
-            if ($INC[0] eq "/mnt$openslxConfig{'base-path'}/lib") {
-                shift @INC;
+        	# cleanup @INC again
+            while (my $perlinc = pop(@chrootPerlIncludes)) {
+	            if ($INC[0] eq $perlinc) {
+	                shift @INC;
+	            }
             }
-            if ($INC[0] eq '/mnt/host-perl') {
-                shift @INC;
+            
+            # unmount bindmounts
+            foreach (@bindmounts) {
+                slxsystem("umount $_->{'target'}") == 0
+                    or die _tr(
+                        "unable to umount '%s'! (%s)", 
+                        $_->{'target'}, $!
+                    );
             }
-            slxsystem("umount $hostPerlCorePathInChroot") == 0
-                or die _tr(
-                    "unable to umount '%s'! (%s)", $hostPerlCorePathInChroot, $!
-                );
-            slxsystem("umount $configPathInChroot") == 0
-                or die _tr(
-                    "unable to umount '%s'! (%s)", $configPathInChroot, $!
-                );
-            slxsystem("umount $basePathInChroot") == 0
-                or die _tr(
-                    "unable to umount '%s'! (%s)", $basePathInChroot, $!
-                );
             1
         },
     });