[Pancutan-commits] r69 - in pancutan: . lib/Pancutan
tincho-guest at alioth.debian.org
tincho-guest at alioth.debian.org
Sun Aug 19 04:32:29 UTC 2007
Author: tincho-guest
Date: 2007-08-19 04:32:28 +0000 (Sun, 19 Aug 2007)
New Revision: 69
Modified:
pancutan/lib/Pancutan/Config.pm
pancutan/lib/Pancutan/Util.pm
pancutan/pancutan
Log:
Finished the UML support. When detected in Config.pm, arranges everithing and spawns pancutan inside UML.
Modified: pancutan/lib/Pancutan/Config.pm
===================================================================
--- pancutan/lib/Pancutan/Config.pm 2007-08-17 16:28:20 UTC (rev 68)
+++ pancutan/lib/Pancutan/Config.pm 2007-08-19 04:32:28 UTC (rev 69)
@@ -4,31 +4,33 @@
use warnings;
use strict;
use Getopt::Long qw(:config no_ignore_case bundling auto_version);
+use Cwd;
+require Pancutan::Util; # Cyclic dependency
-BEGIN {
- use Exporter ();
- our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+use Exporter ();
+our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
- # set the version for version checking
- $VERSION = 0.02;
+# set the version for version checking
+$VERSION = 0.02;
- @ISA = qw(Exporter);
- @EXPORT = qw(%CONFIG);
- @EXPORT_OK = qw(get_default_config read_config);
- %EXPORT_TAGS = ( all => [ '%CONFIG', @EXPORT_OK ] );
+ at ISA = qw(Exporter);
+ at EXPORT = qw(%CONFIG);
+ at EXPORT_OK = qw(get_default_config read_config);
+%EXPORT_TAGS = ( all => [ '%CONFIG', @EXPORT_OK ] );
- eval { require YAML::Syck; import YAML::Syck; };
- if($@) {
- require YAML; import YAML;
- }
+BEGIN {
+ eval { require YAML::Syck; import YAML::Syck; };
+ if($@) {
+ require YAML; import YAML;
+ }
}
my %default = (
- testdef_dir => "/usr/share/pancutan/tests/",
- concurrency => 2,
- temp_dir => "",
- continue_on_fatal => 0,
- verbose => 0,
+ testdef_dir => "/usr/share/pancutan/tests/",
+ concurrency => 2,
+ temp_dir => "",
+ continue_on_fatal => 0,
+ verbose => 0,
mount_method => "sudomount",
);
@@ -37,50 +39,207 @@
our %CONFIG = ();
sub read_config {
- %CONFIG = %default;
- my $argv_opts = { };
- GetOptions($argv_opts, "help|?", "config|c=s",
- "testdef_dir|testdef-dir=s",
- "concurrency|j=i", "temp_dir|temp-dir=s",
- "continue_on_fatal|continue-on-fatal!",
+ %CONFIG = %default;
+ my $argv_opts = { };
+ GetOptions($argv_opts, "help|?", "config|c=s",
+ "testdef_dir|testdef-dir=s",
+ "concurrency|j=i", "temp_dir|temp-dir=s",
+ "continue_on_fatal|continue-on-fatal!",
"mount_method|mount-method|m=s",
- "verbose|v:+") or exit(0); # For auto_version
+ "verbose|v:+") or exit(0); # For auto_version
if($argv_opts->{help}) {
main::help();
exit(0);
}
- my $conffile = delete $argv_opts->{config};
- if(defined $conffile and not -e $conffile) {
- die "Configuration file doesn't exist: $conffile\n";
- }
- $conffile ||= "/etc/pancutan.conf";
- if(-e $conffile) {
- my $conf = LoadFile($conffile) or die $!;
- die "Invalid configuration file\n" unless(ref $conf and
- ref $conf eq "HASH");
- foreach(keys %$conf) {
- die "Unknown configuration parameter: $_\n" unless(
- exists($validopts{$_}));
- $CONFIG{$_} = $conf->{$_};
- }
- }
- # Command-line options override conffile
- foreach(keys %$argv_opts) {
- die "Unknown command-line option: $_\n" unless(
- exists($validopts{$_}));
- $CONFIG{$_} = $argv_opts->{$_};
- }
- unless($CONFIG{mount_method} =~ /^(sudomount|fuseiso9660|uml)$/) {
+ my $conffile = delete $argv_opts->{config};
+ if(defined $conffile and not -e $conffile) {
+ die "Configuration file doesn't exist: $conffile\n";
+ }
+ $conffile ||= "/etc/pancutan.conf";
+ if(-e $conffile) {
+ my $conf = LoadFile($conffile) or die $!;
+ die "Invalid configuration file\n" unless(ref $conf and
+ ref $conf eq "HASH");
+ foreach(keys %$conf) {
+ die "Unknown configuration parameter: $_\n" unless(
+ exists($validopts{$_}));
+ $CONFIG{$_} = $conf->{$_};
+ }
+ }
+ # Command-line options override conffile
+ foreach(keys %$argv_opts) {
+ die "Unknown command-line option: $_\n" unless(
+ exists($validopts{$_}));
+ $CONFIG{$_} = $argv_opts->{$_};
+ }
+ unless($CONFIG{mount_method} =~ /^(mount|sudomount|fuseiso9660|uml)$/) {
die "Unknown mount method: $CONFIG{mount_method}\n";
}
- unless($CONFIG{temp_dir}) {
- $CONFIG{temp_dir} = ".pancutan.$$";
- }
- return \%CONFIG;
+ unless($CONFIG{temp_dir}) {
+ $CONFIG{temp_dir} = ".pancutan.$$";
+ }
+ mkdir $CONFIG{temp_dir} or die "Cannot create temporary directory: $!\n";
+ foreach(@ARGV) {
+ unless(-f $_ or -b $_ or (-l $_ and -f Cwd::realpath($_))
+ or (-l $_ and -b Cwd::realpath($_))) {
+ die "$_ is not a plain file or block device\n";
+ }
+ unless(-r $_) {
+ die "$_ is not readable\n";
+ }
+ }
+ return \%CONFIG unless($CONFIG{mount_method} eq "uml");
+ # Ok, we will not return past this
+ my @umlargs = ( "--config" => Cwd::realpath($conffile) );
+ foreach(keys %$argv_opts) {
+ next if($_ eq "mount_method");
+ next if($_ eq "temp_dir");
+ push @umlargs, ( "--$_" => $argv_opts->{$_} );
+ }
+ push @umlargs, ( "--mount-method" => "mount",
+ "--temp-dir" => "/tmp/pancutan" );
+ my(@blocks, @files);
+ my $fh;
+ foreach(@ARGV) {
+ if(-b $_ or (-l $_ and -b Cwd::realpath($_))) {
+ # We need to check that the device is really readable
+ open($fh, "<", $_) or die("Can't open $_: $!");
+ close($fh);
+ push @blocks, $_;
+ push @files, "/dev/ubd" . chr(ord("a") + $#blocks);
+ } else {
+ push @files, "/tmp/origfs/" . Cwd::realpath($_);
+ }
+ }
+ my $nloop = scalar @files;
+ $nloop = $nloop * 2 + scalar @blocks; # just in case
+ die("Sorry -- UML doesn't support mapping more than 8 block ",
+ "devices\n") if(@blocks > 8);
+ import Pancutan::Util;
+ debug("Block files to map: @blocks");
+ my @in_uml_cmdline = (@umlargs, @files);
+ unshift @in_uml_cmdline, "/tmp/origfs/" . Cwd::realpath($0);
+ $_ =~ s/'/'\\''/g foreach(@in_uml_cmdline);
+ $_ = "'$_'" foreach(@in_uml_cmdline);
+ my $in_uml_cmdline = "@in_uml_cmdline";
+
+ my $in_uml_env = "";
+ $in_uml_env = qq(export PERL5OPT="$ENV{PERL5OPT}"\n) if($ENV{PERL5OPT});
+ if($ENV{PERL5LIB}) {
+ my @p = split(/:/, $ENV{PERL5LIB});
+ $_ = "/tmp/origfs/" . Cwd::realpath($_) foreach(@p);
+ $_ =~ s/'/'\\''/g foreach(@p);
+ $in_uml_env .= "export PERL5LIB='" . join(":", @p) . "'\n";
+ }
+ debug("pancutan-in-uml environ:\n$in_uml_env");
+ debug("pancutan-in-uml cmdline: $in_uml_cmdline");
+ my $uml_script = Cwd::realpath($CONFIG{temp_dir} . "/uml_init");
+ my $uml_bootlog = $CONFIG{temp_dir} . "/bootlog";
+ my $script_text = <<END ;
+#!/bin/dash
+if [ -z "\$1" -a \$\$ -eq 1 ]; then
+ exec > /dev/tty1 2> /dev/tty2
+ echo Bootstrapping...
+ mount -t proc proc /proc
+ mount -t sysfs sysfs /sys
+ mount -t hostfs -o /usr/lib/uml/modules/ hostfs /lib/modules
+ mount -t tmpfs tmpfs /tmp
+ mkdir /tmp/origfs
+ mount -t hostfs -o / hostfs /tmp/origfs
+ cp /tmp/origfs/"\$0" /tmp/bootscript
+ chmod 755 /tmp/bootscript
+
+ mount -t tmpfs dev /dev
+ echo "Populating /dev"
+ for d in console null stdin stdout stderr random urandom tty tty? zero; do
+ cp -a /tmp/origfs/dev/\$d /dev
+ done
+ mknod -m 0660 /dev/ubda b 98 0
+ mknod -m 0660 /dev/ubdb b 98 16
+ mknod -m 0660 /dev/ubdc b 98 32
+ mknod -m 0660 /dev/ubdd b 98 48
+ mknod -m 0660 /dev/ubde b 98 64
+ mknod -m 0660 /dev/ubdf b 98 80
+ mknod -m 0660 /dev/ubdg b 98 96
+ mknod -m 0660 /dev/ubdh b 98 112
+
+ modprobe loop max_loop=$nloop
+ for i in `seq 0 $nloop`; do
+ mknod -m 0660 /dev/loop\$i b 7 \$i
+ done
+
+ mkdir /dev/shm /dev/pts
+ mount -t tmpfs tmpfs /dev/shm
+ mount -t devpts devpts /dev/pts
+ setsid /tmp/bootscript
+ exitcode=\$?
+ echo \$exitcode > /proc/exitcode
+
+ /sbin/halt -d -f
+fi
+if [ \$\$ -ne 1 ]; then
+ exec < /dev/tty1 > /dev/tty1 2> /dev/tty2
+ stty sane < /dev/tty1
+ $in_uml_env
+ $in_uml_cmdline
+fi
+END
+ debug("UML script:\n$script_text");
+ open($fh, ">", $uml_script)
+ or die("Error creating UML script: $!");
+ print $fh $script_text;
+ close $fh;
+ chmod 0755 => $uml_script;
+ # OK, we now execute UML
+ local $SIG{CHLD} = "DEFAULT";
+ local $?;
+ my $pid = fork;
+ unless(defined $pid) {
+ die "Cannot fork: $!";
+ }
+ unless($pid) { # child
+ $main::i_am_a_fork = 1;
+ local $^F = 10000; # Avoid close-on-exec
+ open($fh, ">", $uml_bootlog);
+ my($fherr, $fhout);
+ open($fhout, ">&", \*STDOUT);
+ open($fherr, ">&", \*STDERR);
+ my @args =(linux => "con0=null,fd:" . fileno($fh),
+ "con1=fd:" . fileno(STDIN) . ",fd:" . fileno($fhout),
+ "con2=fd:" . fileno(STDIN) . ",fd:" . fileno($fherr),
+ qw(con=none root=/dev/root rootflags=/ rootfstype=hostfs
+ devfs=nomount quiet), "init=$uml_script" );
+ foreach(0..$#blocks) {
+ push @args, "ubd${_}r=$blocks[$_]";
+ }
+ debug("UML command line: @args");
+ open(STDERR, ">&", fileno $fh);
+ open(STDOUT, ">&", fileno $fh);
+ unless(exec(@args)) {
+ open(STDERR, ">&", $fherr);
+ open(STDOUT, ">&", $fhout);
+ die "Cannot exec UML: $!";
+ }
+ }
+ waitpid $pid, 0;
+ my $st = $?;
+ system("stty sane"); # needed
+ if($st == -1) {
+ die "Failed to execute UML: $!";
+ }
+ if($st & 127) {
+ die(sprintf("UML died with signal %d, %s coredump",
+ ($st & 127), ($st & 128) ? 'with' : 'without'));
+ }
+ $st >>= 8;
+ warn("UML exited with code $st\n") if($st);
+ unlink $uml_script;
+ unlink $uml_bootlog;
+ exit $st;
}
sub get_default_config {
- return Dump(\%default);
+ return Dump(\%default);
}
1;
Modified: pancutan/lib/Pancutan/Util.pm
===================================================================
--- pancutan/lib/Pancutan/Util.pm 2007-08-17 16:28:20 UTC (rev 68)
+++ pancutan/lib/Pancutan/Util.pm 2007-08-19 04:32:28 UTC (rev 69)
@@ -7,14 +7,14 @@
use IO::Select;
use POSIX ":sys_wait_h";
+use Exporter ();
+our @ISA = qw(Exporter);
+our @EXPORT = qw(execute debug info warnn mount umount_all);
+our @EXPORT_OK = qw(running queue_init run_task collect_results can_run);
+our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ],
+ queue => [ @EXPORT_OK ] );
+
BEGIN {
- use Exporter ();
- our @ISA = qw(Exporter);
- our @EXPORT = qw(execute debug info warnn mount umount_all);
- our @EXPORT_OK = qw(running queue_init run_task collect_results can_run);
- our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ],
- queue => [ @EXPORT_OK ] );
-
eval { require YAML::Syck; import YAML::Syck; };
if($@) {
require YAML; import YAML;
@@ -41,6 +41,7 @@
}
unless($pid) { # child
$main::i_am_a_fork = 1;
+ debug("About to execute: @argv");
exec(@argv);
die "Cannot exec: $!";
}
@@ -62,14 +63,19 @@
mount => 'fuseiso9660 %file %mntpnt',
unmount => 'fusermount -u %mntpnt'
},
+ mount => {
+ mount => 'mount -oro,loop %file %mntpnt',
+ mountdev => 'mount -o ro %file %mntpnt',
+ unmount => 'umount %mntpnt',
+ },
sudomount => {
- mount => 'sudo mount -oloop %file %mntpnt',
- mountdev => 'sudo mount %file %mntpnt',
+ mount => 'sudo mount -oro,loop %file %mntpnt',
+ mountdev => 'sudo mount -o ro %file %mntpnt',
unmount => 'sudo umount %mntpnt',
},
uml => {
- mount => 'mount -oloop %file %mntpnt',
- mountdev => 'mount %file %mntpnt',
+ mount => 'mount -o ro,loop %file %mntpnt',
+ mountdev => 'mount -o ro %file %mntpnt',
unmount => 'umount %mntpnt',
}
);
Modified: pancutan/pancutan
===================================================================
--- pancutan/pancutan 2007-08-17 16:28:20 UTC (rev 68)
+++ pancutan/pancutan 2007-08-19 04:32:28 UTC (rev 69)
@@ -15,7 +15,7 @@
my %error_t = (
fatal => [ "F", 8 ],
error => [ "E", 4 ],
- "warn" => [ "W", 2 ]);
+ warn => [ "W", 2 ]);
# Global variables
our $i_am_a_fork = 0;
@@ -32,21 +32,12 @@
my $run = build_running_plan($tasks, scalar @isos);
check_tree($run);
-info("Mounting ISO files");
-foreach(@isos) {
- die "File does not exist: $_\n" unless(-e $_);
- die "$_ is a directory\n" if(-d $_);
- die "File is not readable: $_\n" unless(-r $_);
-}
-unless(-d $CONFIG{temp_dir}) {
- mkdir $CONFIG{temp_dir} or die "Cannot create temporary directory: $!\n";
-}
-
$SIG{HUP} = $SIG{INT} = $SIG{QUIT} = \&sighandler;
$SIG{SEGV} = $SIG{PIPE} = $SIG{TERM} = \&sighandler;
$SIG{__DIE__} = \&diehandler;
$SIG{CHLD} = "DEFAULT";
+info("Mounting ISO files");
my $n = 0;
foreach(@isos) {
my $mntpt = "$CONFIG{temp_dir}/$n";
More information about the Pancutan-commits
mailing list