Blame t/25_traversal.t

rpm-build 29bc80
use strict;
rpm-build 29bc80
use warnings;
rpm-build 29bc80
rpm-build 29bc80
use Archive::Zip qw( :ERROR_CODES );
rpm-build 29bc80
use File::Spec;
rpm-build 29bc80
use File::Path;
rpm-build 29bc80
use lib 't';
rpm-build 29bc80
use common;
rpm-build 29bc80
rpm-build 29bc80
use Test::More tests => 41;
rpm-build 29bc80
rpm-build 29bc80
# These tests check for CVE-2018-10860 vulnerabilities.
rpm-build 29bc80
# If an archive contains a symlink and then a file that traverses that symlink,
rpm-build 29bc80
# extracting the archive tree could write into an abitrary file selected by
rpm-build 29bc80
# the symlink value.
rpm-build 29bc80
# Another issue is if an archive contains a file whose path component refers
rpm-build 29bc80
# to a parent direcotory. Then extracting that file could write into a file
rpm-build 29bc80
# out of current working directory subtree.
rpm-build 29bc80
# These tests check extracting of these files is refuses and that they are
rpm-build 29bc80
# indeed not created.
rpm-build 29bc80
rpm-build 29bc80
# Suppress croaking errors, the tests produce some.
rpm-build 29bc80
Archive::Zip::setErrorHandler(sub {});
rpm-build 29bc80
my ($existed, $ret, $zip, $allowed_file, $forbidden_file);
rpm-build 29bc80
rpm-build 29bc80
# Change working directory to a temporary directory because some tested
rpm-build 29bc80
# functions operarates there and we need prepared symlinks there.
rpm-build 29bc80
my @data_path = (File::Spec->splitdir(File::Spec->rel2abs('.')), 't', 'data');
rpm-build 29bc80
ok(chdir TESTDIR, "Working directory changed");
rpm-build 29bc80
rpm-build 29bc80
# Case 1:
rpm-build 29bc80
#   link-dir -> /tmp
rpm-build 29bc80
#   link-dir/gotcha-linkdir
rpm-build 29bc80
# writes into /tmp/gotcha-linkdir file.
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    # Symlink tests make sense only if a file system supports them.
rpm-build 29bc80
    my $link = 'trylink';
rpm-build 29bc80
    $ret = eval { symlink('.', $link)};
rpm-build 29bc80
    skip 'Symbolic links are not supported', 12 if $@;
rpm-build 29bc80
    unlink $link;
rpm-build 29bc80
rpm-build 29bc80
    # Extracting an archive tree must fail
rpm-build 29bc80
    $zip = Archive::Zip->new();
rpm-build 29bc80
    isa_ok($zip, 'Archive::Zip');
rpm-build 29bc80
    is($zip->read(File::Spec->catfile(@data_path, 'link-dir.zip')), AZ_OK,
rpm-build 29bc80
        'Archive read');
rpm-build 29bc80
    $existed = -e File::Spec->catfile('', 'tmp', 'gotcha-linkdir');
rpm-build 29bc80
    $ret = eval { $zip->extractTree() };
rpm-build 29bc80
    is($ret, AZ_ERROR, 'Tree extraction aborted');
rpm-build 29bc80
    SKIP: {
rpm-build 29bc80
        skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
        ok(! -e File::Spec->catfile('link-dir', 'gotcha-linkdir'),
rpm-build 29bc80
            'A file was not created in a symlinked directory');
rpm-build 29bc80
    }
rpm-build 29bc80
    ok(unlink(File::Spec->catfile('link-dir')), 'link-dir removed');
rpm-build 29bc80
rpm-build 29bc80
    # The same applies to extracting an archive member without an explicit
rpm-build 29bc80
    # local file name. It must abort.
rpm-build 29bc80
    $link = 'link-dir';
rpm-build 29bc80
    ok(symlink('.', $link), 'A symlink to a directory created');
rpm-build 29bc80
    $forbidden_file = File::Spec->catfile($link, 'gotcha-linkdir');
rpm-build 29bc80
    $existed = -e $forbidden_file;
rpm-build 29bc80
    $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir') };
rpm-build 29bc80
    is($ret, AZ_ERROR, 'Member extraction without a local name aborted');
rpm-build 29bc80
    SKIP: {
rpm-build 29bc80
        skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
        ok(! -e $forbidden_file,
rpm-build 29bc80
            'A file was not created in a symlinked directory');
rpm-build 29bc80
    }
rpm-build 29bc80
rpm-build 29bc80
    # But allow extracting an archive member into a supplied file name
rpm-build 29bc80
    $allowed_file = File::Spec->catfile($link, 'file');
rpm-build 29bc80
    $ret = eval { $zip->extractMember('link-dir/gotcha-linkdir', $allowed_file) };
rpm-build 29bc80
    is($ret, AZ_OK, 'Member extraction passed');
rpm-build 29bc80
    ok(-e $allowed_file, 'File created');
rpm-build 29bc80
    ok(unlink($allowed_file), 'File removed');
rpm-build 29bc80
    ok(unlink($link), 'A symlink to a directory removed');
rpm-build 29bc80
}
rpm-build 29bc80
rpm-build 29bc80
# Case 2:
rpm-build 29bc80
#   unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath
rpm-build 29bc80
# writes into ../../../../tmp/gotcha-dotdot-unexistingpath, that is
rpm-build 29bc80
# /tmp/gotcha-dotdot-unexistingpath file if CWD is not deeper than
rpm-build 29bc80
# 4 directories.
rpm-build 29bc80
$zip = Archive::Zip->new();
rpm-build 29bc80
isa_ok($zip, 'Archive::Zip');
rpm-build 29bc80
is($zip->read(File::Spec->catfile(@data_path,
rpm-build 29bc80
            'dotdot-from-unexistant-path.zip')), AZ_OK, 'Archive read');
rpm-build 29bc80
$forbidden_file = File::Spec->catfile('..', '..', '..', '..', 'tmp',
rpm-build 29bc80
    'gotcha-dotdot-unexistingpath');
rpm-build 29bc80
$existed = -e $forbidden_file;
rpm-build 29bc80
$ret = eval { $zip->extractTree() };
rpm-build 29bc80
is($ret, AZ_ERROR, 'Tree extraction aborted');
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
    ok(! -e $forbidden_file, 'A file was not created in a parent directory');
rpm-build 29bc80
}
rpm-build 29bc80
rpm-build 29bc80
# The same applies to extracting an archive member without an explicit local
rpm-build 29bc80
# file name. It must abort.
rpm-build 29bc80
$existed = -e $forbidden_file;
rpm-build 29bc80
$ret = eval { $zip->extractMember(
rpm-build 29bc80
        'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath',
rpm-build 29bc80
    ) };
rpm-build 29bc80
is($ret, AZ_ERROR, 'Member extraction without a local name aborted');
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
    ok(! -e $forbidden_file, 'A file was not created in a parent directory');
rpm-build 29bc80
}
rpm-build 29bc80
rpm-build 29bc80
# But allow extracting an archive member into a supplied file name
rpm-build 29bc80
ok(mkdir('directory'), 'Directory created');
rpm-build 29bc80
$allowed_file = File::Spec->catfile('directory', '..', 'file');
rpm-build 29bc80
$ret = eval { $zip->extractMember(
rpm-build 29bc80
        'unexisting/../../../../../tmp/gotcha-dotdot-unexistingpath',
rpm-build 29bc80
        $allowed_file
rpm-build 29bc80
    ) };
rpm-build 29bc80
is($ret, AZ_OK, 'Member extraction passed');
rpm-build 29bc80
ok(-e $allowed_file, 'File created');
rpm-build 29bc80
ok(unlink($allowed_file), 'File removed');
rpm-build 29bc80
rpm-build 29bc80
# Case 3:
rpm-build 29bc80
#   link-file -> /tmp/gotcha-samename
rpm-build 29bc80
#   link-file
rpm-build 29bc80
# writes into /tmp/gotcha-samename. It must abort. (Or replace the symlink in
rpm-build 29bc80
# more relaxed mode in the future.)
rpm-build 29bc80
$zip = Archive::Zip->new();
rpm-build 29bc80
isa_ok($zip, 'Archive::Zip');
rpm-build 29bc80
is($zip->read(File::Spec->catfile(@data_path, 'link-samename.zip')), AZ_OK,
rpm-build 29bc80
    'Archive read');
rpm-build 29bc80
$existed = -e File::Spec->catfile('', 'tmp', 'gotcha-samename');
rpm-build 29bc80
$ret = eval { $zip->extractTree() };
rpm-build 29bc80
is($ret, AZ_ERROR, 'Tree extraction aborted');
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
    ok(! -e File::Spec->catfile('', 'tmp', 'gotcha-samename'),
rpm-build 29bc80
        'A file was not created through a symlinked file');
rpm-build 29bc80
}
rpm-build 29bc80
ok(unlink(File::Spec->catfile('link-file')), 'link-file removed');
rpm-build 29bc80
rpm-build 29bc80
# The same applies to extracting an archive member using extractMember()
rpm-build 29bc80
# without an explicit local file name. It must abort.
rpm-build 29bc80
my $link = 'link-file';
rpm-build 29bc80
my $target = 'target';
rpm-build 29bc80
ok(symlink($target, $link), 'A symlink to a file created');
rpm-build 29bc80
$forbidden_file = File::Spec->catfile($target);
rpm-build 29bc80
$existed = -e $forbidden_file;
rpm-build 29bc80
# Select a member by order due to same file names.
rpm-build 29bc80
my $member = ${[$zip->members]}[1];
rpm-build 29bc80
ok($member, 'A member to extract selected');
rpm-build 29bc80
$ret = eval { $zip->extractMember($member) };
rpm-build 29bc80
is($ret, AZ_ERROR,
rpm-build 29bc80
    'Member extraction using extractMember() without a local name aborted');
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
    ok(! -e $forbidden_file,
rpm-build 29bc80
        'A symlinked target file was not created');
rpm-build 29bc80
}
rpm-build 29bc80
rpm-build 29bc80
# But allow extracting an archive member using extractMember() into a supplied
rpm-build 29bc80
# file name.
rpm-build 29bc80
$allowed_file = $target;
rpm-build 29bc80
$ret = eval { $zip->extractMember($member, $allowed_file) };
rpm-build 29bc80
is($ret, AZ_OK, 'Member extraction using extractMember() passed');
rpm-build 29bc80
ok(-e $allowed_file, 'File created');
rpm-build 29bc80
ok(unlink($allowed_file), 'File removed');
rpm-build 29bc80
rpm-build 29bc80
# The same applies to extracting an archive member using
rpm-build 29bc80
# extractMemberWithoutPaths() without an explicit local file name.
rpm-build 29bc80
# It must abort.
rpm-build 29bc80
$existed = -e $forbidden_file;
rpm-build 29bc80
# Select a member by order due to same file names.
rpm-build 29bc80
$ret = eval { $zip->extractMemberWithoutPaths($member) };
rpm-build 29bc80
is($ret, AZ_ERROR,
rpm-build 29bc80
    'Member extraction using extractMemberWithoutPaths() without a local name aborted');
rpm-build 29bc80
SKIP: {
rpm-build 29bc80
    skip 'A canary file existed before the test', 1 if $existed;
rpm-build 29bc80
    ok(! -e $forbidden_file,
rpm-build 29bc80
        'A symlinked target file was not created');
rpm-build 29bc80
}
rpm-build 29bc80
rpm-build 29bc80
# But allow extracting an archive member using extractMemberWithoutPaths()
rpm-build 29bc80
# into a supplied file name.
rpm-build 29bc80
$allowed_file = $target;
rpm-build 29bc80
$ret = eval { $zip->extractMemberWithoutPaths($member, $allowed_file) };
rpm-build 29bc80
is($ret, AZ_OK, 'Member extraction using extractMemberWithoutPaths() passed');
rpm-build 29bc80
ok(-e $allowed_file, 'File created');
rpm-build 29bc80
ok(unlink($allowed_file), 'File removed');
rpm-build 29bc80
ok(unlink($link), 'A symlink to a file removed');