Setup-File
view release on metacpan or search on metacpan
lib/Setup/File.pm view on Meta::CPAN
local $File::chmod::UMASK = 0;
# TMP, schema
my $tx_action = $args{-tx_action} // '';
my $dry_run = $args{-dry_run};
my $path = $args{path};
defined($path) or return [400, "Please specify path"];
my $follow_sym = $args{follow_symlink} // 0;
my $orig_mode = $args{orig_mode};
my $want_mode = $args{mode};
defined($want_mode) or return [400, "Please specify mode"];
my $is_sym = (-l $path);
return [412, "$path is a symlink"] if !$follow_sym && $is_sym;
my $exists = $is_sym || (-e _);
my @st = stat($path);
my $cur_mode; $cur_mode = $st[2] & 07777 if $exists; ## no critic: ValuesAndExpressions::ProhibitLeadingZeros
if (!$args{-tx_recovery} && defined($orig_mode) && defined($cur_mode) &&
$cur_mode != $orig_mode && !$args{-confirm}) {
return [331, "File $path has changed permission mode, confirm chmod?"];
}
if ($want_mode =~ /\D/) {
return [412, "Symbolic mode ($want_mode) requires path $path to exist"]
unless $exists;
$want_mode = File::chmod::getchmod($want_mode, $path);
}
#$log->tracef("path=%s, cur_mode=%04o, want_mode=%04o", $path, $cur_mode, $want_mode);
if ($tx_action eq 'check_state') {
my @undo;
return [412, "Path $path doesn't exist"] if !$exists;
if ($cur_mode != $want_mode) {
log_info("(DRY) chmod %s to %04o ...", $path, $want_mode)
if $dry_run;
unshift @undo, [chmod => {
path => $path, mode=>$cur_mode, orig_mode=>$want_mode,
follow_symlink => $follow_sym,
}];
}
if (@undo) {
log_info("(DRY) Chmod %s to %04o ...", $path, $want_mode)
if $dry_run;
return [200, "Path $path needs to be chmod'ed to ".
sprintf("%04o", $want_mode), undef,
{undo_actions=>\@undo}];
} else {
return [304, "Fixed, mode already ".sprintf("%04o", $cur_mode)];
}
} elsif ($tx_action eq 'fix_state') {
log_info("Chmod %s to %04o ...", $path, $want_mode);
if (CORE::chmod($want_mode, $path)) {
return [200, "Fixed"];
} else {
return [500, "Can't chmod $path, $want_mode: $!"];
}
}
[400, "Invalid -tx_action"];
}
$SPEC{chown} = {
v => 1.1,
summary => "Set file's ownership",
description => <<'_',
Fixed state: `path` exists and ownership is already correct.
Fixable state: `path` exists but ownership is not correct.
Unfixable state: `path` doesn't exist.
_
args => {
path => {
summary => 'Path to file/directory',
schema => 'str*',
req => 1,
pos => 0,
},
owner => {
summary => 'Numeric UID or username',
schema => 'str*',
},
group => {
summary => 'Numeric GID or group',
schema => 'str*',
},
follow_symlink => {
summary => 'Whether to follow symlink',
schema => [bool => {default=>0}],
},
orig_owner => {
summary=>'If set, confirm if current owner is not the same as this',
schema => 'str',
},
orig_group => {
summary=>'If set, confirm if current group is not the same as this',
schema => 'str',
},
},
features => {
tx => {v=>2},
idempotent => 1,
},
};
sub chown {
require Lchown;
return [412, "lchown() is not available on this system"] unless
Lchown::LCHOWN_AVAILABLE();
my %args = @_;
# TMP, schema
my $tx_action = $args{-tx_action} // '';
my $dry_run = $args{-dry_run};
my $path = $args{path};
defined($path) or return [400, "Please specify path"];
my $follow_sym = $args{follow_symlink} // 0;
my $orig_owner = $args{orig_owner};
my $orig_group = $args{orig_group};
my $want_owner = $args{owner};
my $want_group = $args{group};
defined($want_owner) || defined($want_group)
or return [400, "Please specify at least either owner/group"];
my ($orig_uid, $orig_uname);
if (defined $orig_owner) {
if ($orig_owner =~ /\A\d+\z/) {
$orig_uid = $orig_owner;
my @ent = getpwuid($orig_uid);
$orig_uname = $ent[0] if @ent;
} else {
$orig_uname = $orig_owner;
my @ent = getpwnam($orig_uname);
return [412, "User doesn't exist: $orig_uname"] unless @ent;
$orig_uid = $ent[2];
}
}
my ($want_uid, $want_uname);
if (defined $want_owner) {
if ($want_owner =~ /\A\d+\z/) {
$want_uid = $want_owner;
my @ent = getpwuid($want_uid);
$want_uname = $ent[0] if @ent;
} else {
$want_uname = $want_owner;
my @ent = getpwnam($want_uname);
return [412, "User doesn't exist: $want_uname"] unless @ent;
$want_uid = $ent[2];
}
}
my ($orig_gid, $orig_gname);
if (defined $orig_group) {
if ($orig_group =~ /\A\d+\z/) {
$orig_gid = $orig_group;
my @grent = getgrgid($orig_gid);
$orig_gname = $grent[0] if @grent;
} else {
$orig_gname = $orig_group;
my @grent = getgrnam($orig_gname);
return [412, "Group doesn't exist: $orig_gname"] unless @grent;
$orig_gid = $grent[2];
}
}
my ($want_gid, $want_gname);
if (defined $want_group) {
if ($want_group =~ /\A\d+\z/) {
$want_gid = $want_group;
my @grent = getgrgid($want_gid);
$want_gname = $grent[0] if @grent;
} else {
$want_gname = $want_group;
my @grent = getgrnam($want_gname);
return [412, "Group doesn't exist: $want_gname"] unless @grent;
$want_gid = $grent[2];
}
}
my @st = lstat($path);
my $is_sym = (-l _);
my $exists = $is_sym || (-e _);
if ($follow_sym && $exists) {
@st = stat($path);
return [500, "Can't stat $path (2): $!"] unless @st;
}
my $cur_uid = $st[4];
my $cur_gid = $st[5];
if (!$args{-tx_recovery} && !$args{-confirm}) {
my $changed = defined($orig_uid) && $orig_uid != $cur_uid ||
defined($orig_gid) && $orig_gid != $cur_gid;
return [331, "File $path has changed ownership, confirm chown?"]
if $changed;
}
#$log->tracef("path=%s, cur_uid=%s, cur_gid=%s, want_uid=%s, want_uname=%s, want_gid=%s, want_gname=%s", $cur_uid, $cur_gid, $want_uid, $want_uname, $want_gid, $want_gname);
if ($tx_action eq 'check_state') {
my @undo;
return [412, "$path doesn't exist"] if !$exists;
if (defined($want_uid) && $cur_uid != $want_uid ||
defined($want_gid) && $cur_gid != $want_gid) {
log_info("(DRY) Chown %s to (%s, %s)",
$path, $want_owner, $want_group) if $dry_run;
unshift @undo, [chown => {
path => $path,
owner => (defined($want_uid) &&
$cur_uid != $want_uid ? $cur_uid : undef),
group => (defined($want_gid) &&
$cur_gid != $want_gid ? $cur_gid : undef),
orig_owner => $want_owner, orig_group => $want_group,
follow_symlink => $follow_sym,
}];
}
if (@undo) {
return [200, "Path $path needs to be chown'ed to ".
"(".($want_owner // "-").", ".($want_group // "-").")",
undef, {undo_actions=>\@undo}];
} else {
return [304, "Path $path already has correct owner and group"];
}
} elsif ($tx_action eq 'fix_state') {
my $res;
log_info("%schown %path to (%s, %s) ...", $follow_sym ? "" : "l",
$path, $want_uid // -1, $want_gid // -1);
if ($follow_sym) {
$res = CORE::chown ($want_uid // -1, $want_gid // -1, $path);
} else {
$res = Lchown::lchown($want_uid // -1, $want_gid // -1, $path);
}
if ($res) {
return [200, "Fixed"];
} else {
return [500, "Can't chown $path, ".($want_uid // -1).", ".
($want_gid // -1).": $!"];
}
}
[400, "Invalid -tx_action"];
}
$SPEC{rmfile} = {
v => 1.1,
summary => 'Delete file',
description => <<'_',
Fixed state: `path` doesn't exist.
Fixable state: `path` exists and is a file (or, a symlink to a file, if
`allow_symlink` option is enabled).
Unfixable state: `path` exists but is not a file.
_
args => {
path => {
schema => 'str*',
req => 1,
pos => 0,
},
allow_symlink => {
schema => [bool => {default => 0}],
summary => 'Whether to regard symlink to a file as file',
},
orig_content => {
summary =>
'If set, confirm if current content is not the same as this',
description => <<'_',
Alternatively, you can use `orig_content_hash`.
_
schema => 'str',
},
orig_content_md5 => {
summary =>
'If set, confirm if current content MD5 hash '.
'is not the same as this',
description => <<'_',
MD5 hash should be expressed in hex (e.g. bed6626e019e5870ef01736b3553e570).
Alternatively, you can use `orig_content` (for shorter content).
_
schema => 'str',
},
suffix => {
summary => 'Use this suffix when trashing',
schema => 'str',
},
},
features => {
tx => {v=>2},
idempotent => 1,
lib/Setup/File.pm view on Meta::CPAN
if (!$allow_sym && $is_sym) {
if (!$replace_sym) {
return [412,
"must replace symlink $path but instructed not to"];
}
log_info("(DRY) Replacing symlink $path with $which ...")
if $dry_run;
push @do , $act_trash;
unshift @undo, $act_untrash;
} elsif ($is_dir && $which eq 'file') {
if (!$replace_dir) {
return [412, "must replace dir $path but instructed not to"];
}
log_info("(DRY) Replacing file $path with $which ...")
if $dry_run;
push @do , $act_trash;
unshift @undo, $act_untrash;
} elsif (!$is_dir && $which eq 'dir') {
if (!$replace_file) {
return [412, "must replace file $path but instructed not to"];
}
log_info("(DRY) Replacing dir $path with $which ...")
if $dry_run;
push @do , $act_trash;
unshift @undo, $act_untrash;
}
my $act_mk = $which eq 'file' ? $act_mkfile : $act_mkdir;
if (!$exists) {
push @do , $act_mk;
unshift @undo, $act_trash_n;
} else {
# get the undo actions from the mk action
no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
my $res =
*{$act_mk->[0]}{CODE}->(
%{$act_mk->[1]},
-tx_action=>'check_state', -tx_action_id=>$taid,
);
if ($res->[0] == 200) {
push @do , $res->[3]{do_actions} ?
@{ $res->[3]{do_actions} } : $act_mk;
unshift @undo, @{ $res->[3]{undo_actions} };
} elsif ($res->[0] == 304) {
# do nothing
} else {
return $res;
}
}
if (defined $args{mode}) {
my $cur_mode; $cur_mode = @st ? $st[2] & 07777 : undef; ## no critic: ValuesAndExpressions::ProhibitLeadingZeros
push @do, ["chmod" => {
path=>$path, mode=>$args{mode}}];
unshift @undo, ["chmod" => {
path=>$path, mode=>$cur_mode}] if defined($cur_mode);
}
if (defined $args{owner}) {
my $cur_uid = @st ? $st[4] : undef;
push @do, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
owner=>$args{owner}}];
unshift @undo, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
mode=>$cur_uid}] if defined($cur_uid);
}
if (defined $args{group}) {
my $cur_gid =@st ? $st[5] : undef;
push @do, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
group=>$args{group}}];
unshift @undo, ["chown" => {
path=>$path, follow_symlink=>$allow_sym,
group=>$cur_gid}] if defined($cur_gid);
}
} # block
if (@do) {
[200, "", undef, {do_actions=>\@do, undo_actions=>\@undo}];
} else {
[304, "Already fixed"];
}
}
$SPEC{setup_file} = {
v => 1.1,
name => 'setup_file',
summary => "Setup file (existence, mode, permission, content)",
description => <<'_',
On do, will create file (if it doesn't already exist) and correct
mode/permission as well as content.
On undo, will restore old mode/permission/content, or delete the file again if
it was created by this function *and* its content hasn't changed since (if
content/ownership/mode has changed, function will request confirmation).
_
args => {
path => {
schema => ['str*'],
summary => 'Path to file',
req => 1,
pos => 0,
},
should_exist => {
schema => 'bool',
summary => 'Whether file should exist',
description => <<'_',
If undef, file need not exist. If set to 0, file must not exist and will be
deleted if it does. If set to 1, file must exist and will be created if it
doesn't.
_
},
mode => {
schema => 'str',
summary => 'Expected permission mode',
description => <<'_',
Mode is as supported by File::chmod. Either an octal string (e.g. '0755') or a
symbolic mode (e.g. 'u+rw').
_
},
owner => {
schema => 'str',
summary => 'Expected owner (either numeric or username)',
},
group => {
schema => 'str',
lib/Setup/File.pm view on Meta::CPAN
=over 4
=item * B<follow_symlink> => I<bool> (default: 0)
Whether to follow symlink.
=item * B<mode>* => I<str>
Permission mode, either numeric or symbolic (e.g. a+w).
=item * B<orig_mode> => I<int>
If set, confirm if current mode is not the same as this.
=item * B<path>* => I<str>
Path to fileE<sol>directory.
=back
Special arguments:
=over 4
=item * B<-tx_action> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_action_id> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_recovery> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_rollback> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_v> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=back
Returns an enveloped result (an array).
First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.
Return value: (any)
=head2 chown
Usage:
chown(%args) -> [$status_code, $reason, $payload, \%result_meta]
Set file's ownership.
Fixed state: C<path> exists and ownership is already correct.
Fixable state: C<path> exists but ownership is not correct.
Unfixable state: C<path> doesn't exist.
This function is not exported.
This function is idempotent (repeated invocations with same arguments has the same effect as single invocation). This function supports transactions.
Arguments ('*' denotes required arguments):
=over 4
=item * B<follow_symlink> => I<bool> (default: 0)
Whether to follow symlink.
=item * B<group> => I<str>
Numeric GID or group.
=item * B<orig_group> => I<str>
If set, confirm if current group is not the same as this.
=item * B<orig_owner> => I<str>
If set, confirm if current owner is not the same as this.
=item * B<owner> => I<str>
Numeric UID or username.
=item * B<path>* => I<str>
Path to fileE<sol>directory.
=back
Special arguments:
=over 4
=item * B<-tx_action> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_action_id> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
=item * B<-tx_recovery> => I<str>
For more information on transaction, see LE<lt>Rinci::TransactionE<gt>.
( run in 0.621 second using v1.01-cache-2.11-cpan-5511b514fd6 )