view release on metacpan or  search on metacpan

t/basic.t  view on Meta::CPAN

#!perl

# vim: ts=4 sts=4 sw=4 et: syntax=perl
#
# Copyright (c) 2017-2022 Sven Kirmess
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use 5.006;
use strict;
use warnings;

use Carp qw(croak);
use Git::Background 0.003;
use Path::Tiny;
use Test::DZil;
use Test::Fatal;
use Test::More 0.88;

use Cwd            ();
use File::Basename ();
use File::Spec     ();
use lib File::Spec->catdir( File::Basename::dirname( Cwd::abs_path __FILE__ ), 'lib' );

use Local::Test::TempDir qw(tempdir);

main();

sub main {

  SKIP:
    {
        skip 'Cannot find Git in PATH', 1 if !defined Git::Background->version;

        _test_with_defaults();
        _test_with_changed_defaults();
        _test_with_config_bin();
        _test_with_config_bin_scripts();
        _test_with_config_scripts_unchanged();
    }

    done_testing();

    exit 0;
}

{
    # If you run chmod 0644 on a file and read the permissions back with
    # stat what you get back depends on your OS. On Unix you get 0644 back
    # but on Windows you will get something else back. This function creates
    # a hash that maps "permission we set with chmod" to "permission we read
    # back with stat",
    my %p;

    sub _p {
        my ($value) = @_;

        return $p{$value} if exists $p{$value};

        my $tmp_dir = path( tempdir() );
        my $file    = $tmp_dir->child('file.txt');
        $file->spew("hello world\n");

        chmod $value, $file or croak "chmod $value, $file: $!";
        my $perm = ( stat $file )[2] & 07777;

        note( sprintf q{On this system, 'chmod 0%o' results in 0%o}, $value, $perm );
        return $p{$value} = $perm;
    }
}

my $dir_perm;

sub _configure_root {
    my ($root_dir) = @_;

    # Create a git repository in the source
    my $git = Git::Background->new($root_dir);
    $git->run('init')->get;

    # Create some directories
    $root_dir->child('bin')->mkpath();
    $root_dir->child('scripts')->mkpath();
    $root_dir->child('lib')->mkpath();

    my @files;

    push @files, path($root_dir)->child('bin/a');
    $files[-1]->spew();
    $git->run( 'add', $files[-1] )->get;
    chmod 0755, $files[-1] or croak "chmod 0755, $files[-1]: $!";

    push @files, path($root_dir)->child('scripts/b');
    $files[-1]->spew();
    $git->run( 'add', $files[-1] )->get;
    chmod 0600, $files[-1] or croak "chmod 0600, $files[-1]: $!";

    push @files, path($root_dir)->child('lib/c.pm');
    $files[-1]->spew();
    $git->run( 'add', $files[-1] )->get;
    chmod 0, $files[-1] or croak "chmod 0, $files[-1]: $!";

    push @files, path($root_dir)->child('d');
    $files[-1]->spew();
    $git->run( 'add', $files[-1] )->get;
    chmod 0644, $files[-1] or croak "chmod 0644, $files[-1]: $!";

    my $sub_src = _create_submodule();
    push @files, path($root_dir)->child('s');
    if ( $git->run( 'submodule', 'add', $sub_src, 's' )->await->is_failed ) {

        # "protocol.file.allow=always" lets the submodule command clone from
        # a local directory. It's necessary as of Git 2.38.1, where the
        # default was changed to "user" in response to CVE-2022-39253.
        # It isn't a concern here where all repositories involved are
        # trusted. For more information, see:
        # https://vielmetti.typepad.com/logbook/2022/10/git-security-fixes-lead-to-fatal-transport-file-not-allowed-error-in-ci-systems-cve-2022-39253.html
        # https://github.com/microsoft/go-infra/pull/71/files
        # https://github.blog/2022-10-18-git-security-vulnerabilities-announced/#cve-2022-39253
        # https://bugs.launchpad.net/ubuntu/+source/git/+bug/1993586
        # https://git-scm.com/docs/git-config#Documentation/git-config.txt-protocolallow
        $git->run( '-c', 'protocol.file.allow=always', 'submodule', 'add', $sub_src, 's' )->get;
    }
    $dir_perm = ( stat $files[-1] )[2] & 07777;

    is( ( stat $files[0] )[2] & 07777, _p(0755),  sprintf q{File '%s' created correctly},      $files[0]->relative($root_dir) );
    is( ( stat $files[1] )[2] & 07777, _p(0600),  sprintf q{File '%s' created correctly},      $files[1]->relative($root_dir) );
    is( ( stat $files[2] )[2] & 07777, _p(0),     sprintf q{File '%s' created correctly},      $files[2]->relative($root_dir) );
    is( ( stat $files[3] )[2] & 07777, _p(0644),  sprintf q{File '%s' created correctly},      $files[3]->relative($root_dir) );
    is( ( stat $files[4] )[2] & 07777, $dir_perm, sprintf q{Submodule '%s' created correctly}, $files[4]->relative($root_dir) );

    return @files;
}

sub _create_submodule {
    my $dir = path( tempdir() );

    my $git = Git::Background->new($dir);
    $git->run('init')->get;

    my $file = $dir->child('file.txt');
    $file->spew();
    $git->run( 'add',    'file.txt' )->get;
    $git->run( 'config', 'user.email', 'test@example.com' )->get;
    $git->run( 'config', 'user.name',  'Test' )->get;
    $git->run( 'commit', '-m',         'initial' )->get;

    return $dir;
}

sub _test_with_defaults {

    note('test with default configuration');

    # Create a new "distribution".
    #
    # This copies the content of dist_root to a new directory: $tzil->root
    my $tzil = Builder->from_config(
        { dist_root => tempdir() },
        {
            add_files => {
                'source/dist.ini' => simple_ini(
                    'Git::GatherDir',
                    'Git::FilePermissions',
                ),
            },