Doit
view release on metacpan or search on metacpan
if (!-e $man || -M $man > -M $pod || -M $man > -M "Build") {
$doit->make_path(dirname($man));
my $parser = Pod::Man->new(%options);
if ($doit->is_dry_run) {
info "$pod -> $man (dry-run)";
} else {
info "$pod -> $man";
$parser->parse_from_file($pod, $man)
or error "Could not install $man";
}
$doit->chmod(0644, $man); # XXX should this be changeable? like $PERM_RW in Makefile.PL?
}
}
},
no_chdir => 1,
},
"lib");
}
sub clean {
$doit->remove_tree('blib');
{
if (-l "Build") { # formerly this used to be a symlink
$doit->unlink("Build");
}
my $preamble = <<"EOF";
#! $Config{perlpath}
# MD5: $Build_PL_md5hex
EOF
$preamble .= $argv_serialized;
$doit->write_binary({quiet=>1}, 'Build', $preamble . qq{# line 1 "Build.PL"\n} . $Build_PL_file_contents);
$doit->chmod(0755, 'Build');
eval {
generate_META_json("MYMETA.json");
generate_META_yml("MYMETA.yml" );
};
warning "Failure while generating MYMETA.* files, continue without.\nError was:\n$@" if $@;
}
exit;
}
EOF
$doit->write_binary("$dir/.distro_support/run.sh", <<'EOF');
#! /bin/sh
set -ex
rm -f /etc/yum.repos.d/CentOS*.repo
rm -f /etc/yum.repos.d/epel.repo
cp .distro_support/CentOS.repo /etc/yum.repos.d/
cp .distro_support/epel.repo /etc/yum.repos.d/
yum clean all
EOF
$doit->chmod(0755, "$dir/.distro_support/run.sh");
}
}
sub _check_clean_git {
$doit->add_component('git');
my $status = $doit->git_short_status;
if ($status eq '<<') {
error 'Working directory has uncomitted changes: ' . `git status`;
}
- 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)
use Doit;
my $doit = Doit->init;
$d->add_component('user');
my $root = $doit->do_sudo; # for running commands/scripts as root
$root->write_binary('/etc/sudoers.d/20_cpansand', <<'EOF'); # for auto-installing system depencies with CPAN::Plugin::Sysdeps
cpansand ALL=(ALL) NOPASSWD: /usr/bin/apt-get install *
cpansand ALL=(ALL) NOPASSWD: /usr/bin/apt-get -y install *
EOF
$root->chmod(0440, '/etc/sudoers.d/20_cpansand');
chomp(my $zsh = `which zsh`);
$root->user_account(
username => 'cpansand',
uid => 1234,
shell => $zsh,
ssh_keys => ['ssh-rsa ... '],
);
my $cpansand = $d->do_sudo(sudo_opts => [qw(-u cpansand)]); # for running commands as cpansand user
$cpansand->make_path("/home/cpansand/.cpan/build");
lib/Doit.pm view on Meta::CPAN
error "Can't stat $src: $!" if !@stat;
my $preserve_default = !%preserve;
my $preserve_ownership = exists $preserve{ownership} ? delete $preserve{ownership} : $preserve_default;
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";
};
}
lib/Doit.pm view on Meta::CPAN
code => sub { $code->($self, \@args, $addinfo) },
msg => $msg->($self, \@args, $addinfo),
};
}
Doit::Commands->new(@commands);
};
no strict 'refs';
*{"cmd_$name"} = $cmd;
}
sub cmd_chmod {
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($mode, @files) = @args;
my @files_to_change;
for my $file (@files) {
my @s = stat($file);
if (@s) {
if (($s[2] & 07777) != $mode) {
push @files_to_change, $file;
}
} else {
push @files_to_change, $file;
}
}
if (@files_to_change) {
my @commands = {
code => sub {
my $changed_files = chmod $mode, @files_to_change;
if ($changed_files != @files_to_change) {
if (@files_to_change == 1) {
error "chmod failed: $!";
} elsif ($changed_files == 0) {
error "chmod failed on all files: $!";
} else {
error "chmod failed on some files (" . (@files_to_change-$changed_files) . "/" . scalar(@files_to_change) . "): $!";
}
}
},
($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) = @_;
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
my @files = @ARGV
or die "usage: ...";
=head2 CORE COMMANDS
All core commands throw exceptions on errors. If not stated otherwise,
then the return value is the number of changes, typically the number
of files affected --- in dry-run mode it's the number of changes which
would be done, and in real mode it's the number of changes performed.
=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
lib/Doit/File.pm view on Meta::CPAN
# This is just used for testing error on close()
$tmp_file = '/dev/full';
open $tmp_fh, '>', $tmp_file
or error "Can't write to $tmp_file: $!";
} else {
require File::Temp;
($tmp_fh,$tmp_file) = File::Temp::tempfile(SUFFIX => $tmp_suffix, DIR => $tmp_dir, EXLOCK => 0);
push @cleanup_files, $tmp_file;
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);
}
}
}
}
lib/Doit/File.pm view on Meta::CPAN
return 1;
}
sub _make_writeable {
my($doit, $file, $for) = @_;
return if $for eq 'rename' && !Doit::IS_WIN; # don't need to do anything
my @s = stat($file);
return if !@s; # not stat-able -> file does not exist yet?
my $old_mode = $s[2] & 07777;
return if ($old_mode & 0200); # already writable
$doit->chmod(($old_mode | 0200), $file);
}
1;
__END__
lib/Doit/File.pod view on Meta::CPAN
Change the suffix used for the temporary file. Default is C<.tmp>.
Change the suffix if a system may tolerate the existence of stray
temporary files if special suffixes are used. For example, in a
directory controlled by Debian's L<run-parts(8)> programm it can help
to use C<.dpkg-tmp> as the tempory file suffix.
=item C<< mode => I<mode> >>
Set permissions of the final destination file, using the
L<perlfunc/chmod> syntax.
If not used, then the permissions would be as creating a normal
non-executable file, which usually takes L<perlfunc/umask> into
account.
=item C<< check_change => I<bool> >>
If set to a true value, then two things are done:
=over
lib/Doit/User.pm view on Meta::CPAN
} else {
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) = @_;
t/change_file.t view on Meta::CPAN
eval { $r->change_file({unhandled_option=>1}, "blubber") };
like $@, qr{ERROR.*\QUnhandled options: unhandled_option }, 'error: unhandled option';
eval { $r->change_file("blubber") };
like $@, qr{blubber does not exist};
eval { $r->change_file(".") };
like $@, qr{\. is not a file};
$r->touch("work-file");
$r->chmod(0600, "work-file");
my $got_mode = (stat("work-file"))[2] & 07777;
if ($^O ne 'MSWin32') { # here it's 0666
is $got_mode, 0600, 'chmod worked';
}
$changes = $r->change_file("work-file");
ok -z "work-file", "still empty";
ok !$changes, 'no changes';
is $changes, 0, 'no changes == zero changes';
for my $iter (1..2) {
$changes = $r->change_file("work-file",
{add_if_missing => "a new line"},
);
t/change_file.t view on Meta::CPAN
1;
},
},
"work-file",
{add_if_missing => "add another line"},
);
is $changes, 1, 'one change, with check';
{ # add_after vs. add_after_first vs. add_before vs. add_before_last
$r->touch('work-file-2');
$r->chmod(0600, 'work-file-2');
for my $iter (1..2) {
$changes = $r->change_file('work-file-2',
{add_if_missing => 'a new line'},
{add_if_missing => 'a new line 2'},
{add_if_missing => 'this is the last line'},
);
is $changes, ($iter==1 ? 3 : 0), "changes in iteration $iter";
is slurp('work-file-2'), "a new line\na new line 2\nthis is the last line\n";
}
t/doit-exitcode.t view on Meta::CPAN
is $@->{exitcode}, 1, 'failing Doit one-liner';
}
with_tempfile {
my($tmpfh,$tmpfile) = @_;
print $tmpfh <<'EOF';
use Doit;
Doit->init->system($^X, '-e', 'exit 0');
EOF
close $tmpfh or die $!;
$doit->chmod(0755, $tmpfile);
$doit->system($^X, $tmpfile);
pass 'passing Doit script';
} SUFFIX => '_doit.pl';
with_tempfile {
my($tmpfh,$tmpfile) = @_;
print $tmpfh <<'EOF';
use Doit;
Doit->init->system($^X, '-e', 'exit 1');
EOF
close $tmpfh or die $!;
$doit->chmod(0755, $tmpfile);
eval { $doit->system($^X, $tmpfile) };
is $@->{exitcode}, 1, 'failing Doit script';
} SUFFIX => '_doit.pl';
sub with_tempfile (&;@) {
my($code, @opts) = @_;
my($tmpfh,$tmpfile) = File::Temp::tempfile(@opts);
my $sc = new_scope_cleanup { unlink $tmpfile };
$code->($tmpfh,$tmpfile);
}
is $r->unlink('doit-test2'), 1;
ok !-f 'doit-test2', 'file was deleted';
is $r->unlink('non-existing-directory/test'), 0; # not throwing exceptions, as a file check is done before
SKIP: {
skip "permissions probably work differently on Windows", 1 if $^O eq 'MSWin32';
skip "permissions probably work differently on cygwin", 1 if $^O eq 'cygwin';
skip "non-writable directory not a problem for the superuser", 1 if $> == 0;
$r->mkdir("non-writable-dir");
$r->create_file_if_nonexisting("non-writable-dir/test");
$r->chmod(0500, "non-writable-dir");
eval { $r->unlink("non-writable-dir/test") };
like $@, qr{ERROR.*\Q$errno_string{EACCES}};
$r->chmod(0700, "non-writable-dir");
$r->remove_tree("non-writable-dir");
}
$r->touch('doit-a', 'doit-b', 'doit-c');
is $r->unlink('not-existing', 'doit-a', 'doit-b', 'doit-c'), 3, 'three of four files were deleted';
######################################################################
# chmod
$r->create_file_if_nonexisting('doit-test2');
is $r->chmod(0755, "doit-test", "doit-test2"), 2; # changes expected
is $r->chmod(0644, "doit-test2"), 1; # one change expected
is $r->chmod({quiet => 1}, 0755, "doit-test2"), 1;
is $r->chmod({quiet => 1}, 0644, "doit-test2"), 1;
{
local $TODO = "No noop on Windows" if $^O eq 'MSWin32';
is $r->chmod(0755, "doit-test"), 0; # noop
}
eval { $r->chmod(0644, "does-not-exist") };
like $@, qr{chmod failed: };
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: {
ok ! -e "doit-test";
$r->unlink("doit-test");
eval { $r->write_binary("non-existing-dir/test", "egal\n") };
like $@, qr{ERROR.*\Q$errno_string{ENOENT}};
SKIP: {
skip "permissions probably work differently on Windows", 1 if $^O eq 'MSWin32';
skip "permissions probably work differently on cygwin", 1 if $^O eq 'cygwin';
skip "non-writable file not a problem for the superuser", 1 if $> == 0;
$r->write_binary({quiet=>1}, "unwritable-file", "something\n");
$r->chmod(0400, "unwritable-file");
eval { $r->write_binary({quiet=>1, atomic=>0}, "unwritable-file", "change will fail\n") };
like $@, qr{ERROR:.*\QCan't write to unwritable-file: $errno_string{EACCES}}, 'fail to write to unwritable file';
$r->chmod(0000, "unwritable-file"); # now also unreadable
eval { $r->write_binary({quiet=>1}, "unwritable-file", "something\n") }; # no change, but will fail due to unreadability
like $@, qr{ERROR:.*\QCan't open unwritable-file: $errno_string{EACCES}}, 'fail to read from unwritable file';
$r->unlink("unwritable-file");
}
SKIP: {
skip "permissions work differently on Windows", 1 if $^O eq 'MSWin32';
$r->write_binary({quiet=>1}, "permission-test", "something\n");
$r->chmod(0751, "permission-test");
$r->write_binary({quiet=>1}, "permission-test", "something changed\n");
my @s = stat "permission-test";
is(($s[2]&0777), 0751, 'permissions were preserved');
}
######################################################################
# mkdir
is $r->mkdir("doit-test"), 1;
ok -d "doit-test";
is $r->mkdir("doit-test"), 0;
my($code, $unreadable_dir) = @_;
error "not a CODE ref: $code" if ref $code ne 'CODE';
error "missing unreadable dir" if !defined $unreadable_dir;
SKIP: {
skip "unreadable directories behave differently on Windows", 1 if $^O eq 'MSWin32';
skip "unreadable directories behave differently on cygwin", 1 if $^O eq 'cygwin';
skip "unreadable directories not a problem for the superuser", 1 if $> == 0;
$r->mkdir($unreadable_dir);
$r->chmod(0000, $unreadable_dir);
my $cleanup = new_scope_cleanup {
$r->chmod(0700, $unreadable_dir);
$r->rmdir($unreadable_dir);
};
$code->();
}
}
__END__
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;
print $fh "test setgid\n";
}, tmpdir => $tempdir), 1; # use a non-setgid directory for tmpfile
ok -s "$tempdir/setgid/file", 'Created file exists and is non-empty';
is slurp("$tempdir/my_mode"), "changing my mode\n", 'content was changed';
@stat = stat("$tempdir/my_mode");
is(($stat[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0600), 'mode option on existing file');
no_leftover_tmp $tempdir;
}
{
$doit->chmod(0600, "$tempdir/1st");
my $mode_before = (stat("$tempdir/1st"))[2];
is $doit->file_atomic_write("$tempdir/1st", sub {
my $fh = shift;
print $fh "changed content\n";
}), 1;
is slurp("$tempdir/1st"), "changed content\n", 'content of existent file changed';
my $mode_after = (stat("$tempdir/1st"))[2];
is $mode_after, $mode_before, 'mode was preserved';
no_leftover_tmp $tempdir;
t/ssh-local.t view on Meta::CPAN
# Do a symlink test
my $dir = tempdir("doit_XXXXXXXX", TMPDIR => 1, CLEANUP => 1);
$doit->write_binary({quiet=>1}, "$dir/test-doit.pl", <<'EOF');
use Doit;
return 1 if caller;
my $doit = Doit->init;
my $ssh = $doit->do_ssh_connect((defined $ENV{USER} ? $ENV{USER}.'@' : '') . 'localhost', debug => 0, master_opts => [qw(-oPasswordAuthentication=no -oBatchMode=yes -oConnectTimeout=3)]);
my $ret = $ssh->info_qx('perl', '-e', 'print "yes\n"');
print $ret;
EOF
$doit->chmod(0755, "$dir/test-doit.pl");
$doit->symlink("$dir/test-doit.pl", "$dir/test-symlink.pl");
my $ret = $doit->info_qx($^X, "$dir/test-symlink.pl");
is $ret, "yes\n";
}
}
}
{
my $dir = tempdir("doit_XXXXXXXX", TMPDIR => 1, CLEANUP => 1);
$doit->write_binary({quiet=>1}, "$dir/test-doit.pl", <<'EOF');
use Doit;
sub fail_on_remote {
Doit::Log::error("fail on remote");
}
return 1 if caller;
my $doit = Doit->init;
my $ssh = $doit->do_ssh_connect((defined $ENV{USER} ? $ENV{USER}.'@' : '') . 'localhost', debug => 0, master_opts => [qw(-oPasswordAuthentication=no -oBatchMode=yes -oConnectTimeout=3)]);
$ssh->call_with_runner("fail_on_remote");
Doit::Log::warning("This should never be reached!");
EOF
$doit->chmod(0755, "$dir/test-doit.pl");
my $ret = eval { $doit->system($^X, "$dir/test-doit.pl"); 1 };
ok !$ret, 'system command failed';
like $@, qr{^Command exited with exit code (\d+) at}, 'expected error message';
isnt $1, 0, 'exit code is not zero';
}
__END__
my %sudo_info;
my $sudo = TestUtil::get_sudo($doit, info => \%sudo_info); # must run in this directory
my $tempdir = tempdir(TMPDIR => 1, CLEANUP => 1);
in_directory {
$doit->create_file_if_nonexisting('source');
$doit->create_file_if_nonexisting('target');
my @stat = stat('source');
$doit->chmod(0600, 'source');
copy_stat('source', 'target');
is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0600), 'preserving mode');
$stat[2] = 0400;
copy_stat(\@stat, 'target');
is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0444 : 0400), 'preserving mode using stat array');
$stat[2] = 0644;
copy_stat(\@stat, 'target', 'mode' => 1);
is(((stat('target'))[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0644), 'explicit preserve option');
use Doit;
my $doit = Doit->init;
my $tempdir = tempdir('doit_XXXXXXXX', TMPDIR => 1, CLEANUP => 1);
my $testcmdbase = "doit-which-test-command-$$";
my $testcmdpath = File::Spec->catfile($tempdir, $testcmdbase . ($^O eq 'MSWin32' ? '.bat' : ''));
$doit->create_file_if_nonexisting($testcmdpath);
$doit->chmod(0755, $testcmdpath);
{
eval { $doit->which };
like $@, qr{Expecting exactly one argument: command};
eval { $doit->which(1,2) };
like $@, qr{Expecting exactly one argument: command};
}
{
( run in 0.683 second using v1.01-cache-2.11-cpan-8d75d55dd25 )