[Pancutan-commits] r71 - in pancutan: . debian lib/Pancutan tests tests/lib/Pancutan/Test
tincho-guest at alioth.debian.org
tincho-guest at alioth.debian.org
Mon Aug 20 14:32:17 UTC 2007
Author: tincho-guest
Date: 2007-08-20 14:32:17 +0000 (Mon, 20 Aug 2007)
New Revision: 71
Modified:
pancutan/Makefile.PL
pancutan/debian/changelog
pancutan/debian/control
pancutan/lib/Pancutan/Config.pm
pancutan/lib/Pancutan/Util.pm
pancutan/pancutan
pancutan/tests/Makefile.PL
pancutan/tests/lib/Pancutan/Test/Booting.pm
pancutan/tests/lib/Pancutan/Test/Files.pm
Log:
- Parsing of configuration files of bootloaders: silo, delo, yaboot, syslinux,
elilo, chrp/bootinfo completed. Missing parts: mips & alpha, corner cases.
- Support for handling temp files and dirs (and their destruction)
Modified: pancutan/Makefile.PL
===================================================================
--- pancutan/Makefile.PL 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/Makefile.PL 2007-08-20 14:32:17 UTC (rev 71)
@@ -8,11 +8,13 @@
Carp => 0,
"Device::Cdio" => "0.2.4",
"File::Find" => 0,
+ "File::Path" => 0,
+ "File::Temp" => 0,
"IO::Handle" => 0,
"IO::Select" => 0,
POSIX => 0,
YAML => 0,
"YAML::Syck" => 0,
- Cwd => 0
+ Cwd => 0,
});
Modified: pancutan/debian/changelog
===================================================================
--- pancutan/debian/changelog 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/debian/changelog 2007-08-20 14:32:17 UTC (rev 71)
@@ -1,3 +1,10 @@
+pancutan (0.3) unstable; urgency=low
+
+ * A lot of work done, specially on the booting area.
+ * Support for running without any privilege, inside user-mode-linux.
+
+ -- Martín Ferrari <martin.ferrari at gmail.com> Sun, 19 Aug 2007 05:35:18 +0100
+
pancutan (0.2) unstable; urgency=low
* New release, just to order my work.
Modified: pancutan/debian/control
===================================================================
--- pancutan/debian/control 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/debian/control 2007-08-20 14:32:17 UTC (rev 71)
@@ -7,7 +7,7 @@
Package: pancutan
Architecture: any
-Depends: ${perl:Depends}, libyaml-syck-perl | libyaml-perl, libdigest-sha-perl, libcdio7, libdevice-cdio-perl (>= 0.2.4-2), libcompress-zlib-perl (>= 2.005-3), libcompress-bzip2-perl, hfsbootfiles
+Depends: ${perl:Depends}, libyaml-syck-perl | libyaml-perl, libdigest-sha-perl, libcdio7, libdevice-cdio-perl (>= 0.2.4-2), libcompress-zlib-perl (>= 2.005-3), libcompress-bzip2-perl, libio-compress-zlib-perl, hfsbootfiles
Description: A modular lintian-like tool to test ISO files created with debian-cd
Pancután is a tool to test ISO files before they are distributed, in a way
similar to lintian. It aims to support CDDs, and even Debian-Live CDs.
Modified: pancutan/lib/Pancutan/Config.pm
===================================================================
--- pancutan/lib/Pancutan/Config.pm 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/lib/Pancutan/Config.pm 2007-08-20 14:32:17 UTC (rev 71)
@@ -73,7 +73,7 @@
exists($validopts{$_}));
$CONFIG{$_} = $argv_opts->{$_};
}
- unless($CONFIG{mount_method} =~ /^(mount|sudomount|fuseiso9660|uml)$/) {
+ unless($CONFIG{mount_method} =~ /^(umlmount|sudomount|fuseiso9660|uml)$/) {
die "Unknown mount method: $CONFIG{mount_method}\n";
}
unless($CONFIG{temp_dir}) {
@@ -97,7 +97,7 @@
next if($_ eq "temp_dir");
push @umlargs, ( "--$_" => $argv_opts->{$_} );
}
- push @umlargs, ( "--mount-method" => "mount",
+ push @umlargs, ( "--mount-method" => "umlmount",
"--temp-dir" => "/tmp/pancutan" );
my(@blocks, @files);
my $fh;
@@ -134,8 +134,10 @@
}
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($uml_scriptfh, $uml_script) = mktmpfile("uml_init");
+ $uml_script = Cwd::realpath($uml_script);
+ my($uml_bootlogfh, $uml_bootlog) = mktmpfile("bootlog");
+ close $uml_bootlogfh;
my $script_text = <<END ;
#!/bin/dash
if [ -z "\$1" -a \$\$ -eq 1 ]; then
@@ -186,10 +188,8 @@
fi
END
debug("UML script:\n$script_text");
- open($fh, ">", $uml_script)
- or die("Error creating UML script: $!");
- print $fh $script_text;
- close $fh;
+ print $uml_scriptfh $script_text;
+ close $uml_scriptfh;
chmod 0755 => $uml_script;
# OK, we now execute UML
local $SIG{CHLD} = "DEFAULT";
@@ -234,8 +234,6 @@
}
$st >>= 8;
warn("UML exited with code $st\n") if($st);
- unlink $uml_script;
- unlink $uml_bootlog;
exit $st;
}
sub get_default_config {
Modified: pancutan/lib/Pancutan/Util.pm
===================================================================
--- pancutan/lib/Pancutan/Util.pm 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/lib/Pancutan/Util.pm 2007-08-20 14:32:17 UTC (rev 71)
@@ -5,11 +5,15 @@
use warnings;
use Pancutan::Config;
use IO::Select;
+use File::Temp qw(tempfile tempdir);
+use File::Path;
use POSIX ":sys_wait_h";
+use Cwd;
use Exporter ();
our @ISA = qw(Exporter);
-our @EXPORT = qw(execute debug info warnn mount umount_all);
+our @EXPORT = qw(execute debug info warnn mount umount_all mktmpfile
+rmtmpfiles mktmpdir rmtmpdirs);
our @EXPORT_OK = qw(running queue_init run_task collect_results can_run);
our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_OK ],
queue => [ @EXPORT_OK ] );
@@ -58,31 +62,56 @@
return($res, @out) if(wantarray);
return $res;
}
+my %tmpdirs = ();
+sub mktmpdir {
+ my $template = shift || "tmp";
+ my $erase = shift;
+ $template .= "_XXXX";
+ my $dir = tempdir($template, DIR => $CONFIG{temp_dir}, CLEANUP => 0);
+ push @{$tmpdirs{$$}}, [ $dir => $erase ];
+ return $dir;
+}
+sub rmtmpdirs {
+ foreach(@{$tmpdirs{$$}}) {
+ rmtree $_->[0] if($_->[1]);
+ rmdir $_->[0];
+ }
+}
+my %tmpfiles = ();
+sub mktmpfile {
+ my $template = shift || "tmp";
+ my $suffix = shift;
+ $template .= "_XXXX";
+ my($fh, $file) = tempfile($template, DIR => $CONFIG{temp_dir},
+ UNLINK => 0, ($suffix ? (SUFFIX => $suffix) : ()));
+ push @{$tmpfiles{$$}}, $file;
+ return($fh, $file);
+}
+sub rmtmpfiles {
+ unlink $_ foreach(@{$tmpfiles{$$}});
+}
my %mntcmds = (
fuseiso9660 => {
mount => 'fuseiso9660 %file %mntpnt',
unmount => 'fusermount -u %mntpnt'
},
- mount => {
- mount => 'mount -oro,loop %file %mntpnt',
- mountdev => 'mount -o ro %file %mntpnt',
+ umlmount => {
+ mount => 'mount -oro,loop,nosuid,nodev %file %mntpnt',
+ mountdev => 'mount -o ro,nosuid,nodev %file %mntpnt',
unmount => 'umount %mntpnt',
+ unloop => '/sbin/losetup -d %file'
},
sudomount => {
- mount => 'sudo mount -oro,loop %file %mntpnt',
- mountdev => 'sudo mount -o ro %file %mntpnt',
+ mount => 'sudo mount -oro,loop,nosuid,nodev %file %mntpnt',
+ mountdev => 'sudo mount -o ro,nosuid,nodev %file %mntpnt',
unmount => 'sudo umount %mntpnt',
},
- uml => {
- mount => 'mount -o ro,loop %file %mntpnt',
- mountdev => 'mount -o ro %file %mntpnt',
- unmount => 'umount %mntpnt',
- }
+ uml => {}
);
my %mounts;
sub mount {
my($file, $mntpnt) = @_;
- mkdir $mntpnt or die $!;
+ mkdir $mntpnt;
my $mthd = $CONFIG{mount_method};
unless(exists $mntcmds{$mthd}) {
die "Unknown method $mthd\n";
@@ -101,12 +130,30 @@
push @{$mounts{$$}}, [ $file => $mntpnt ];
}
sub umount_all {
+ return unless($mounts{$$});
my $cmd = $mntcmds{$CONFIG{mount_method}}{unmount}
- or die "Unknown method {$CONFIG{mount_method}\n";
- foreach(@{$mounts{$$}}) {
- my $r = execute(replace_mount_cmd($cmd, $_->[0], $_->[1]));
- warn "Error while unmounting $_->[0]: $r\n" if($r);
- rmdir $_->[1] or warn "Error removing directory: $!\n";
+ or die "Unknown method $CONFIG{mount_method}\n";
+ foreach(reverse @{$mounts{$$}}) {
+ my($file, $mnt) = @$_;
+ my $loop;
+ if($mntcmds{$CONFIG{mount_method}}{unloop}) {
+ $mnt = Cwd::realpath($mnt);
+ my $fh;
+ open($fh, "<", "/proc/mounts") or die $!;
+ while(<$fh>) {
+ next unless(/(\S+)\s+\Q$mnt\E\s/);
+ $loop = $1;
+ last;
+ }
+ close $fh;
+ }
+ my $r = execute(replace_mount_cmd($cmd, $file, $mnt));
+ warn "Error while unmounting $file: $r\n" if($r);
+ if($loop and $loop =~ m#/dev/loop#) {
+ execute(replace_mount_cmd($mntcmds{$CONFIG{mount_method}}{unloop},
+ $loop, $file));
+ }
+ rmdir $mnt or warn "Error removing directory $mnt: $!\n";
}
}
sub replace_mount_cmd {
@@ -285,6 +332,14 @@
Unmounts all the files that were mounted by the current process
+=item B<mktmpfile>
+
+=item B<mktmpdir>
+
+=item B<rmtmpfiles>
+
+=item B<rmtmpdirs>
+
=item B<queue_init>
Initialises the queue for parallel task management.
Modified: pancutan/pancutan
===================================================================
--- pancutan/pancutan 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/pancutan 2007-08-20 14:32:17 UTC (rev 71)
@@ -156,6 +156,8 @@
}
sub cleanup {
umount_all();
+ rmtmpfiles();
+ rmtmpdirs();
return if($i_am_a_fork);
info("Cleaning up");
rmdir $CONFIG{temp_dir};
Modified: pancutan/tests/Makefile.PL
===================================================================
--- pancutan/tests/Makefile.PL 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/tests/Makefile.PL 2007-08-20 14:32:17 UTC (rev 71)
@@ -11,6 +11,7 @@
"File::Spec" => 0,
"Compress::Zlib" => "2.0005",
"Compress::Bzip2" => 0,
+ "IO::Uncompress::Gunzip" => 0,
"Math::BigInt" => 0,
"HTML::Entities" => 0,
"HTML::PullParser" => 0,
Modified: pancutan/tests/lib/Pancutan/Test/Booting.pm
===================================================================
--- pancutan/tests/lib/Pancutan/Test/Booting.pm 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/tests/lib/Pancutan/Test/Booting.pm 2007-08-20 14:32:17 UTC (rev 71)
@@ -8,9 +8,11 @@
use Fcntl qw(:DEFAULT :seek);
# For portable 64 bit operations
use Math::BigInt;
-# Yes, this is surreal, I know - for CHRP
-use HTML::Entities;
-use HTML::PullParser;
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+## Yes, this is surreal, I know - for CHRP
+## But other day I will write the proper parser
+#use HTML::Entities;
+#use HTML::PullParser;
my %mbrtypes = ( # Taken from fdisk
0x00 => "Empty",
@@ -361,6 +363,7 @@
my $start = $part[$_]{start};
my $desc = $part[$_]{desc};
my $type = $part[$_]{type};
+ my $size = $part[$_]{size};
# Start is in 512-byte blocks
if($start % 2048) {
push(@res, "invalid-mbr", "Partition " . ($_ + 1) .
@@ -368,7 +371,7 @@
}
$start = int($start / 2048);
info("MBR partition: ", $_ + 1, ", type $desc, ",
- "start LBA: $start, size: $part[$_]{size}");
+ "start LBA: $start, size: $size");
if($type == 0x96) { # CHRP
if($start > 0) {
push(@res, "invalid-mbr", "Partition type \"$desc\" " .
@@ -396,6 +399,8 @@
if($type == 0x41) { # PReP
push @{$meta->{set}[$ncd]{boot}{images}}, {
method => "prep",
+ offset => $start * 2048,
+ size => $size,
file => $bfile
};
info("PReP boot file: $bfile");
@@ -628,12 +633,11 @@
}
sub detect_boot_sequence {
my ($meta, $ncd, $scratch) = @_;
- my($fh, $buf, @res, @firststage, @initrd);
+ my($fh, $buf, @res, @bootconfig, %bootpair);
my $file = $meta->{set}[$ncd]{file};
+ my $basedir = $meta->{set}[$ncd]{mount};
sysopen($fh, $file, O_RDONLY) or die "Error opening ISO file: $!";
foreach(@{$meta->{set}[$ncd]{boot}{images}}) {
- use Data::Dumper;
- print Dumper $_;
if($_->{method} eq "eltorito") {
$buf = _myread($fh, $_->{offset}, 2048);
my $imgtype;
@@ -667,11 +671,155 @@
$boottype = "pc";
}
}
- info("$boottype boot loader $_->{file}");
- push(@firststage, [ $boottype => $_ ]);
+ debug("$boottype boot loader $_->{file}");
+ if($boottype eq "pc") {
+ if(index($buf, "ISOLINUX") >= 0) {
+ # geez, nothing better to look for
+ my $isocfg;
+ if(exists $scratch->{dirs}{"boot/isolinux"}) {
+ $isocfg = "boot/isolinux/isolinux.cfg";
+ } elsif(exists $scratch->{dirs}{"isolinux"}) {
+ $isocfg = "isolinux/isolinux.cfg";
+ } else {
+ $isocfg = "isolinux.cfg";
+ }
+ if(! $scratch->{files}{$isocfg}) {
+ push(@res, "missing-boot-element",
+ "Missing ISOLINUX configuration file: $isocfg");
+ } else {
+ info("ISOLINUX boot loader");
+ push(@bootconfig, [ isolinux => $isocfg ]);
+ }
+ } else {
+ push(@res, "unknown-boot-loader",
+ "I don't understand the bootloader at " .$_->{file});
+ }
+ } elsif($boottype eq "ia64") {
+ my $mntpnt = mktmpdir("ia64mnt");
+ mount($basedir ."/". $_->{file}, $mntpnt);
+ unless(-e "$mntpnt/efi/boot/bootia64.efi") {
+ push(@res, "missing-boot-element",
+ "Missing ia64 boot element in boot image ",
+ $_->{file}, ": /efi/boot/bootia64.efi");
+ next;
+ }
+ # FIXME: need a way to check that this is elilo
+ my $eliloconf;
+ if(-e "$mntpnt/efi/boot/elilo-ia64.conf") {
+ $eliloconf = "efi/boot/elilo-ia64.conf";
+ } elsif(-e "$mntpnt/efi/boot/elilo.conf") {
+ $eliloconf = "efi/boot/elilo.conf";
+ } else {
+ push(@res, "missing-boot-element",
+ "Missing ELILO configuration file");
+ next;
+ }
+ info("ELILO boot loader");
+ push(@bootconfig, [ elilo => { mnt => $mntpnt,
+ config => $eliloconf } ]);
+ } else {
+ # FIXME
+ push(@res, "unknown-boot-loader",
+ "I don't understand (yet) the boot at " .$_->{file});
+ }
} elsif($_->{method} eq "mac" or $_->{method} eq "chrp") {
+ my $chrpb = $_->{file};
+ my $fh2;
+ open($fh2, "<", "$basedir/$chrpb")
+ or die "Error opening $chrpb: $!";
+ my $chrpdat = join("", <$fh2>);
+ close $fh2;
+ my @boots = ($chrpdat =~ m#<boot-script>(.*?)</boot-script>#sig);
+ unless(@boots) {
+ push(@res, "invalid-boot-element",
+ "$chrpb doesn't define any boot script");
+ next;
+ }
+ foreach(@boots) {
+ my $bootline = $_;
+ unless($bootline =~ /^\s*boot\s+(?:.*?:)?(?:.*?,)?(\S+)\s*$/m) {
+ push(@res, "invalid-boot-element",
+ "Syntax error in $chrpb: $bootline");
+ next;
+ }
+ $bootline = $1;
+ my $bootdir = $chrpb;
+ $bootdir =~ s(/[^/]*$)();
+ $bootline =~ s/\&directory;|\\\\/$bootdir/;
+ $bootline =~ s/\\/\//g;
+ unless(-e "$basedir/$bootline") {
+ push(@res, "invalid-boot-element",
+ "Cannot find the boot image referenced in $chrpb: " .
+ $bootline);
+ next;
+ }
+ # FIXME: need a way to check that this is yaboot
+ unless($bootline =~ /yaboot/) {
+ push(@res, "unknown-boot-loader",
+ "I don't understand (yet) the bootloader at $bootline");
+ next;
+ }
+ my $yabootconf;
+ if(! $scratch->{files}{"etc/yaboot.conf"}) {
+ push(@res, "missing-boot-element",
+ "Missing YABOOT configuration file: /etc/yaboot.conf");
+ next;
+ }
+ info("YABOOT boot loader");
+ push(@bootconfig, [ yaboot => "etc/yaboot.conf" ]);
+ }
} elsif($_->{method} eq "prep") {
- push(@initrd, [ prep => $_->{file} ]);
+ $buf = _myread($fh, $_->{offset}, $_->{size});
+ # We will suppose that this is a compressed kernel + compressed
+ # initrd stuffed into a loader. FIXME: ugly hack
+ my $kstart = 0;
+ while($kstart < $_->{size}) {
+ $kstart = index($buf, "vmlinux", $kstart);
+ if($kstart < 10) {
+ push(@res, "unknown-boot-loader", "Can't find a " .
+ "compressed kernel in $_->{file}");
+ next;
+ }
+ last if(substr($buf, $kstart - 10, 2) eq "\x1f\x8b");
+ $kstart++;
+ }
+ $kstart -= 10;
+ my $vstart = 0;
+ while($vstart < $_->{size}) {
+ $vstart = index($buf, "initrd", $vstart);
+ if($vstart < 10) {
+ push(@res, "unknown-boot-loader", "Can't find a " .
+ "compressed initrd in $_->{file}");
+ next;
+ }
+ last if(substr($buf, $vstart - 10, 2) eq "\x1f\x8b");
+ $vstart++;
+ }
+ $vstart -= 10;
+ debug(sprintf("PReP kernel@%x initrd@%x", $kstart, $vstart));
+ my($kfh, $kfile) = mktmpfile("kernel.prep");
+ $buf = _myread($fh, $_->{offset} + $kstart, ($kstart < $vstart)
+ ? $vstart - $kstart : $_->{size} - $kstart);
+ my $st = gunzip(\$buf => $kfh);
+ close $kfh;
+ unless($st) {
+ push(@res, "invalid-boot-element", "The compressed " .
+ "kernel at $_->{file} cannot be decompressed: " .
+ $GunzipError);
+ next;
+ }
+ my($vfh, $vfile) = mktmpfile("initrd.prep");
+ $buf = _myread($fh, $_->{offset} + $vstart, ($vstart < $kstart)
+ ? $kstart - $vstart : $_->{size} - $vstart);
+ $st = gunzip(\$buf => $vfh);
+ close $vfh;
+ unless($st) {
+ push(@res, "invalid-boot-element", "The compressed " .
+ "initrd at $_->{file} cannot be decompressed: " .
+ $GunzipError);
+ next;
+ }
+ $bootpair{$_->{file}} = [ $kfile, $vfile ];
} elsif($_->{method} eq "sparc") {
# This is not very clear, just in case, we try all slices
$buf = _myread($fh, $_->{offset} + 512, 15 * 512);
@@ -685,13 +833,14 @@
"Missing SILO configuration file");
} else {
info("SILO boot loader");
- push(@firststage, [ silo => "/boot/silo.conf" ]);
+ push(@bootconfig, [ silo => "/boot/silo.conf" ]);
}
} else {
push(@res, "unknown-boot-loader",
"At block " . ($_->{offset} / 512));
}
} elsif($_->{method} eq "mips") {
+ # FIXME
} elsif($_->{method} eq "mipsel") {
my $realsize = $scratch->{files}{$_->{file}}{size};
my $realstart = $scratch->{files}{$_->{file}}{LSN} * 2048;
@@ -705,15 +854,80 @@
"Missing DELO configuration file");
} else {
info("DELO boot loader: $_->{file}");
- push(@firststage, [ delo => "/etc/delo.conf" ]);
+ push(@bootconfig, [ delo => "/etc/delo.conf" ]);
}
} elsif(not @elfres) {
info("Unknown boot loader: $_->{file}");
}
} elsif($_->{method} eq "alpha") {
+ # FIXME
} else {
+ die("This doesn't exist ", $_->{method});
}
}
+ close($fh);
+ foreach(@bootconfig) {
+ my($type, $data) = @$_;
+ if($type eq "isolinux" or $type eq "delo") {
+ open($fh, "<", "$basedir/$data")
+ or die "Error opening $data: $!";
+ my($defappnd, $inlabel, $kernel, $append);
+ while(<$fh>) {
+ chomp;
+ if(/label\s*=?\s*(\S+)/i) {
+ if($inlabel and $kernel) {
+ $append ||= $defappnd;
+ $bootpair{"$kernel|$append"} = [ $kernel, $append ];
+ }
+ $kernel = $append = "";
+ $inlabel = $1;
+ } elsif(/(?:kernel|image|linux)\s*=?\s*(\S+)/i) {
+ $kernel = "$basedir/$1";
+ } elsif(/append\s*=?.*initrd=(\S+)/i) {
+ if($inlabel) {
+ $append = "$basedir/$1";
+ } else {
+ $defappnd = "$basedir/$1";
+ }
+ }
+ }
+ close $fh;
+ if($inlabel and $kernel) {
+ $append ||= $defappnd;
+ $bootpair{"$kernel|$append"} = [ $kernel, $append ];
+ }
+ }
+ if($type eq "silo" or $type eq "elilo" or $type eq "yaboot") {
+ my $basedir2 = ($type ne "elilo") ? $basedir : $data->{mnt};
+ my $conf = ($type ne "elilo") ? $data : $data->{config};
+ open($fh, "<", "$basedir2/$conf") or die "Error opening $data: $!";
+ my($definitrd, $inlabel, $initrd);
+ while(<$fh>) {
+ chomp;
+ if(/image(?:\[[^]]*\])?\s*=\s*(\S+)/i) {
+ if($inlabel) {
+ $initrd ||= $definitrd;
+ $bootpair{"$inlabel|$initrd"} = [ $inlabel, $initrd ];
+ }
+ $initrd = "";
+ $inlabel = "$basedir2/$1";
+ } elsif(/initrd\s*=\s*(\S+)/i) {
+ if($inlabel) {
+ $initrd = "$basedir2/$1";
+ } else {
+ $definitrd = "$basedir2/$1";
+ }
+ }
+ }
+ close $fh;
+ if($inlabel) {
+ $initrd ||= $definitrd;
+ $bootpair{"$inlabel|$initrd"} = [ $inlabel, $initrd ];
+ }
+ }
+ }
+ use Data::Dumper;
+ print Dumper(\@bootconfig, \%bootpair);
return @res;
}
sub _myread {
Modified: pancutan/tests/lib/Pancutan/Test/Files.pm
===================================================================
--- pancutan/tests/lib/Pancutan/Test/Files.pm 2007-08-19 04:38:02 UTC (rev 70)
+++ pancutan/tests/lib/Pancutan/Test/Files.pm 2007-08-20 14:32:17 UTC (rev 71)
@@ -18,19 +18,20 @@
my $iso = Device::Cdio::ISO9660::IFS->new(
-source => $file) or die "Error opening ISO file: $!";
my $basedir = canonpath($cd->{mount});
- my @files;
+ my(@files, @dirs);
find({ wanted => sub {
push @files, abs2rel($_, $basedir) if(-f);
+ push @dirs, abs2rel($_, $basedir) if(-d);
}, no_chdir => 1}, $basedir);
my @stats = map {
my $s = $iso->stat($_);
defined($s) or die "Can't stat file $_ -- libcdio must be confused";
($s->{LSN}, $s->{size}) } @files;
$iso->close();
- return \@files, \@stats;
+ return \@files, \@stats, \@dirs;
}
sub scan_files_master {
- my($global, $ncd, $scratch, $files, $stats) = @_;
+ my($global, $ncd, $scratch, $files, $stats, $dirs) = @_;
foreach(0..$#{$files}) {
$scratch->{files}{$files->[$_]} = {
LSN => $stats->[$_*2],
@@ -39,6 +40,7 @@
$scratch->{lsnidx}{$stats->[$_*2]} = $files->[$_];
}
$scratch->{filelist} = [ @$files ];
+ $scratch->{dirs} = { map({$_ => 1} @$dirs) };
debug(scalar @$files, " files found");
return ();
}
More information about the Pancutan-commits
mailing list