Acme-Archive-Mbox

 view release on metacpan or  search on metacpan

bin/mboxextract  view on Meta::CPAN

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";

lib/Acme/Archive/Mbox.pm  view on Meta::CPAN

sub add_file {
    my $self = shift;
    my $name = shift;
    my $altname = shift || $name;
    my %attr;

    my $contents = read_file($name, err_mode => 'carp', binmode => ':raw');
    return unless $contents;

    my (undef, undef, $mode, undef, $uid, $gid, undef, undef, undef, $mtime) = stat $name;
    $attr{mode} = $mode & 0777;
    $attr{uid} = $uid;
    $attr{gid} = $gid;
    $attr{mtime} = $mtime;

    my $file = Acme::Archive::Mbox::File->new($altname, $contents, %attr);
    push @{$self->{files}}, $file if $file;

    return $file;
}

t/archive.t  view on Meta::CPAN

is($files[2]->name, 'optional/filename', 'add_file filename');

# TODO: These tests are weak
SKIP: {
    # write
    my $tmpnam = tmpnam();
    skip "Unable to create temporary file", 3 unless $tmpnam;

    ok($archive->write($tmpnam), 'write');

    $archive = undef;
    $archive = Acme::Archive::Mbox->new();
    $archive->read($tmpnam);

    my @files = $archive->get_files();
    my ($file) = grep { $_->name eq 'test/file' } @files;

    is($file->contents, 'aoeuidhtns'x10, 'file contents');
    is($file->name, 'test/file', 'file name');
    is($file->uid, 1337, 'file uid');

t/file.t  view on Meta::CPAN

my $name = '/a/b//c';
my $contents = 'a'x20;
my %attr = ( mode => 0644,
             uid  => 1000,
             gid  => 1001,
             mtime => $time,
           );

# No contents, this should fail.
my $file = Acme::Archive::Mbox::File->new( $name );
is($file, undef, "fail to create object without required args");

$file = Acme::Archive::Mbox::File->new( $name, $contents, %attr );

isa_ok($file, 'Acme::Archive::Mbox::File', "Object created");
is($file->name, $name, "name $name");
is($file->contents, $contents, "contents");
is($file->mode, 0644, "mode");
is($file->uid, 1000, "uid");
is($file->gid, 1001, "gid");
is($file->mtime, $time, "mtime");