#!/usr/bin/perl
use strict;
use File::Path qw(mkpath);
print "$0 archive.mbox dir/\n" and exit unless @ARGV == 2;
my $archivename = shift @ARGV;
my $rootdir = shift @ARGV;
my $archive = Acme::Archive::Mbox->new();
$archive->read($archivename);
for my $file ($archive->get_files()) {
my $name = File::Spec->canonpath($file->name());
die "Absolute path, refusing to extract: $name\n" if (File::Spec->file_name_is_absolute($name));
my (undef, $dirs, $filename) = File::Spec->splitpath($name);
my @parts = File::Spec->splitdir($dirs);
push @parts, $filename;
die "Directory traversal attempted: $name\n" unless (File::Spec->no_upwards(@parts) == @parts);
mkpath(File::Spec->catdir($rootdir, $dirs));
my $writename = File::Spec->catfile($rootdir, $dirs, $filename);
write_file($writename, {binmode => ':raw'}, $file->contents );
chmod $file->mode, $writename or warn "$0: chmod $writename: $!\n";
if ($> == 0) {
chown $file->uid, $file->gid, $writename or warn "$0: chown $writename: $!\n";
}
}
=head1 NAME
mboxextract - extract mbox archive
=head1 USAGE
mboxify archive.mbox root_directory
Files will be extracted to root_directory, overwriting any files by the
same name. (root_directory may be '.')
=head1 VERSION
Version 0.01
=head1 BUGS
=over 4
=item Currently mtime is ignored
=back
=cut