Doit
view release on metacpan or search on metacpan
- implement ci testing on github
- travis-ci: adapt for the travis-ci switch to xenial
- test_standard: more distributions to test
- test_standard: two passes now, one with "more testing"
0.025_54 2019-04-28
- features
- do_ssh_connect can take a Net::OpenSSH object (GH #3)
- new umask option for do_ssh_connect
- git_get_changed_files: new option ignore_untracked
- new quiet option for chmod and chown commands (used in Doit::File)
- Doit::File: new option check_change
- fixes
- Doit::Git: handle more edge cases wrt detached branches
- open3: fill errref before analyzing $?
- tests
- new TestUtil helper signal_kill_num
- skip some problematic tests on haiku (atime, root user)
- new build action test_standard
- ci improvements (for appveyor)
lib/Doit.pm view on Meta::CPAN
my $preserve_mode = exists $preserve{mode} ? delete $preserve{mode} : $preserve_default;
my $preserve_time = exists $preserve{time} ? delete $preserve{time} : $preserve_default;
error "Unhandled preserve values: " . join(" ", %preserve) if %preserve;
if ($preserve_mode) {
chmod $stat[2], $dest
or warning "Can't chmod $dest to " . sprintf("0%o", $stat[2]) . ": $!";
}
if ($preserve_ownership) {
chown $stat[4], $stat[5], $dest
or do {
my $save_err = $!; # otherwise it's lost in the get... calls
warning "Can't chown $dest to " .
(getpwuid($stat[4]))[0] . "/" .
(getgrgid($stat[5]))[0] . ": $save_err";
};
}
if ($preserve_time) {
utime $stat[8], $stat[9], $dest
or warning "Can't utime $dest to " .
scalar(localtime $stat[8]) . "/" .
scalar(localtime $stat[9]) .
": $!";
lib/Doit.pm view on Meta::CPAN
},
($quiet ? () : (msg => sprintf("chmod 0%o %s", $mode, join(" ", @files_to_change)))), # shellquote?
rv => scalar @files_to_change,
};
Doit::Commands->new(@commands);
} else {
Doit::Commands->return_zero;
}
}
sub cmd_chown {
my($self, @args) = @_;
my %options; if (@args && ref $args[0] eq 'HASH') { %options = %{ shift @args } }
my $quiet = delete $options{quiet};
error "Unhandled options: " . join(" ", %options) if %options;
my($uid, $gid, @files) = @args;
if (!defined $uid) {
$uid = -1;
} elsif ($uid !~ /^-?\d+$/) {
my $_uid = (getpwnam $uid)[2];
lib/Doit.pm view on Meta::CPAN
}
} else {
push @files_to_change, $file;
}
}
}
if (@files_to_change) {
my @commands = {
code => sub {
my $changed_files = chown $uid, $gid, @files_to_change;
if ($changed_files != @files_to_change) {
if (@files_to_change == 1) {
error "chown failed: $!";
} elsif ($changed_files == 0) {
error "chown failed on all files: $!";
} else {
error "chown failed on some files (" . (@files_to_change-$changed_files) . "/" . scalar(@files_to_change) . "): $!";
}
}
},
($quiet ? () : (msg => "chown $uid, $gid, @files_to_change")), # shellquote?
rv => scalar @files_to_change,
};
Doit::Commands->new(@commands);
} else {
Doit::Commands->return_zero;
}
}
sub cmd_cond_run {
my($self, %opts) = @_;
lib/Doit.pm view on Meta::CPAN
push @{ $self->{components} }, { module => $module, path => $INC{$mod_file}, relpath => $mod_file };
if ($o->can('add_components')) {
for my $sub_component ($o->add_components) {
$self->add_component($sub_component);
}
}
}
for my $cmd (
qw(chmod chown mkdir rename rmdir symlink unlink utime),
qw(make_path remove_tree), # File::Path
qw(copy move), # File::Copy
qw(run), # IPC::Run
qw(qx info_qx), # qx// and variant which even runs in dry-run mode, both using list syntax
qw(open2 info_open2), # IPC::Open2
qw(open3 info_open3), # IPC::Open3
qw(system info_system), # builtin system with variant
qw(cond_run), # conditional run
qw(touch), # like unix touch
qw(ln_nsf), # like unix ln -nsf
lib/Doit.pod view on Meta::CPAN
=head3 chmod
$doit->chmod($mode, $file ...);
$doit->chmod({quiet => $bool}, $mode, $file ...);
Make sure that the permission of the listed files is set to I<$mode>
(which is typically expressed as an octal number). Fails if not all
files could be changed. If C<quiet> is set to a true value, then no
logging is done. See L<perlfunc/chmod> for more details.
=head3 chown
$doit->chown($user, $group, $file ...);
$doit->chown({quiet => $bool}, $user, $group, $file ...);
Make sure that the owner (and group) of the listed files is set to the
given values. The user and group may be specified as uid/gid or as
username/groupname. A value of -1 or C<undef> for I<$user> and
I<$group> is interpreted to leave that value unchanged. This command
is not useful on Windows systems. If C<quiet> is set to a true value,
then no logging is done. See L<perlfunc/chown> for more details.
=head3 create_file_if_nonexisting
$doit->create_file_if_nonexisting($file ...);
Make sure that the listed files exist. Contrary to L<the Doit touch
command|/touch> and the system command L<touch(1)> this does nothing
if the file already exists.
=head3 copy
lib/Doit/File.pm view on Meta::CPAN
push @cleanup_fhs, $tmp_fh;
if (defined $mode) {
$doit->chmod({quiet => 1}, $mode, $tmp_file);
} else {
$doit->chmod({quiet => 1}, 0666 & ~umask, $tmp_file);
}
if ($tmp_dir ne $dest_dir) {
my @stat_destdir = stat $dest_dir;
if (@stat_destdir) { # may fail in dry-run mode if $dest_dir is missing
if ($^O =~ /bsd/ || $^O eq 'darwin' || ($stat_destdir[2] & 02000)) {
$doit->chown({quiet => 1 }, undef, $stat_destdir[5], $tmp_file);
}
}
}
}
my $same_fs = do {
my $tmp_dev = (stat($tmp_file))[0];
my $dest_dev = (stat($dest_dir))[0];
no warnings 'uninitialized'; # $dest_dev may be undefined in dry-run mode
$tmp_dev == $dest_dev;
};
lib/Doit/User.pm view on Meta::CPAN
if (defined $home) {
$got_home = $home;
} else {
$got_home = "/home/$username";
}
}
if (@ssh_keys) {
$self->mkdir("$got_home/.ssh");
$self->chmod(0700, "$got_home/.ssh");
$self->chown($username, $username, "$got_home/.ssh");
$self->create_file_if_nonexisting("$got_home/.ssh/authorized_keys");
$self->chmod(0600, "$got_home/.ssh/authorized_keys");
$self->chown($username, $username, "$got_home/.ssh/authorized_keys");
$self->change_file("$got_home/.ssh/authorized_keys",
(map { +{ add_if_missing => $_ } } @ssh_keys),
);
}
}
}
sub user_add_user_to_group {
my($self, %opts) = @_;
my $username = delete $opts{username};
eval { $r->chmod(0644, "does-not-exist-1", "does-not-exist-2") };
like $@, qr{chmod failed on all files: };
eval { $r->chmod(0644, "doit-test", "does-not-exist") };
like $@, qr{\Qchmod failed on some files (1/2): };
{
local $TODO = "No noop on Windows" if $^O eq 'MSWin32';
is $r->chmod(0644, "doit-test"), 0; # noop
}
######################################################################
# chown
is $r->chown(-1, -1, "doit-test"), 0;
is $r->chown($>, undef, "doit-test"), 0;
is $r->chown($>, -1, "doit-test"), 0;
is $r->chown($>, undef, "doit-test"), 0;
is $r->chown({quiet => 1 }, $>, undef, "doit-test"), 0;
SKIP: {
my @groups = split / /, $);
my $another_group = $groups[1];
skip "No other group available for test (we have only gids: $))", 3 if !defined $another_group || $groups[0] eq $another_group;
is $r->chown(undef, $another_group, "doit-test"), 1;
is $r->chown(undef, $another_group, "doit-test"), 0;
skip "getgrnam not available on MSWin32", 1 if $^O eq 'MSWin32';
my $another_groupname = getgrgid($another_group);
skip "Cannot get groupname for gid $another_group", 1 if !defined $another_groupname;
is $r->chown(undef, $another_groupname, 'doit-test'), 0;
}
SKIP: {
skip "chown never fails on MSWin32", 2 if $^O eq 'MSWin32';
eval { $r->chown($>, undef, "does-not-exist") };
like $@, qr{chown failed: };
eval { $r->chown($>, undef, "does-not-exist-1", "does-not-exist-2") };
like $@, qr{chown failed on all files: };
# no test case for "chown failed on some files"
}
SKIP: {
skip "getpwnam and getgrnam not available on MSWin32", 1 if $^O eq 'MSWin32';
eval { $r->chown("user-does-not-exist", undef, "doit-test") };
like $@, qr{\QUser 'user-does-not-exist' does not exist };
eval { $r->chown(undef, "group-does-not-exist", "doit-test") };
like $@, qr{\QGroup 'group-does-not-exist' does not exist };
SKIP: {
my $username = (getpwuid($>))[0];
skip "Cannot get username for uid $>", 1 if !defined $username;
is $r->chown($username, undef, "doit-test"), 0;
}
}
######################################################################
# rename, move
is $r->rename("doit-test", "doit-test3"), 1;
$r->move("doit-test3", "doit-test2");
is $r->rename("doit-test2", "doit-test"), 1;
eval { $r->rename("doit-test", "non-existent-directory/does-not-work") };
like $@, qr{ERROR.*\Q$errno_string{ENOENT}}, 'failed rename';
no_leftover_tmp $tempdir;
}
SKIP: { # Test with setgid bit
skip "No gid or setgid support under Windows", 1 if $^O eq 'MSWin32';
my @gids = split / /, $(;
my $test_gid = $gids[-1];
$doit->mkdir("$tempdir/setgid");
$doit->chown(undef, $test_gid, "$tempdir/setgid");
if ($^O =~ /bsd/ || $^O eq 'darwin') {
# no not for setgid on BSD like systems
} else {
$doit->chmod(((stat "$tempdir/setgid")[2] & 07777) | 02000, "$tempdir/setgid");
}
$doit->create_file_if_nonexisting("$tempdir/setgid/stat_reference");
is $doit->file_atomic_write("$tempdir/setgid/file", sub {
my $fh = shift;
my $fs_file = "$tempdir/testfs";
$doit->system(qw(dd if=/dev/zero), "of=$fs_file", qw(count=1 bs=1MB));
$doit->system(qw(/sbin/mkfs -t ext3), $fs_file);
my $mnt_point = "$tempdir/testmnt";
$doit->mkdir($mnt_point);
my $mount_scope = new_scope_cleanup {
$sudo->system(qw(umount), $mnt_point);
};
$sudo->system(qw(mount -o loop), $fs_file, $mnt_point);
$sudo->mkdir("$mnt_point/dir");
$sudo->chown($<, undef, "$mnt_point/dir");
return { other_fs_dir => "$mnt_point/dir", scope_cleanup => $mount_scope };
}
is((stat('target'))[9], 86400*3, 'explicit preserve option (mtime)');
$stat[8] = $stat[9] = 86400*4;
copy_stat(\@stat, 'target', 'mode' => 1);
is((stat('target'))[8], 86400*3, 'unchanged atime, non-matching preserve option') if $enable_atime_tests;
is((stat('target'))[9], 86400*3, 'unchanged mtime, non-matching preserve option');
# Must be last in this block --- source+target are deleted
SKIP: {
skip "Can't sudo: $sudo_info{error}", 2 if !$sudo;
$sudo->chown(0,0,"$tempdir/source");
$sudo->call_with_runner('run_copy_stat', "$tempdir/source", "$tempdir/target"); # NOTE: directory change does not apply to sudo context XXX would be nicer if $sudo->copy_stat could be used
is((stat('target'))[4], 0, 'preserving owner');
is((stat('target'))[5], 0, 'preserving group');
$sudo->unlink(qw(source target));
}
} $tempdir;
}
__END__
( run in 0.787 second using v1.01-cache-2.11-cpan-71847e10f99 )