Apache-Logmonster
view release on metacpan or search on metacpan
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
if ! -e $archive;
$self->chmod( file => $file, mode => $p{mode}, %args ) if $p{mode};
$log->audit("$file backed up to $archive");
return $archive;
}
sub archive_file_sudo {
my $self = shift;
my ($file, $archive) = @_;
my $sudo = $self->sudo();
my $cp = $self->find_bin( 'cp',fatal=>0 );
if ( $sudo && $cp ) {
return $self->syscmd( "$sudo $cp $file $archive",fatal=>0 );
}
$log->error( "archive_file: sudo or cp was missing, could not escalate.",fatal=>0);
return;
};
sub chmod {
my $self = shift;
my %p = validate(
@_,
{ 'file' => { type => SCALAR, optional => 1, },
'file_or_dir' => { type => SCALAR, optional => 1, },
'dir' => { type => SCALAR, optional => 1, },
'mode' => { type => SCALAR, optional => 0, },
'sudo' => { type => BOOLEAN, optional => 1, default => 0 },
%std_opts,
}
);
my $mode = $p{mode};
my %args = $self->get_std_args( %p );
my $file = $p{file} || $p{file_or_dir} || $p{dir}
or return $log->error( "invalid params to chmod in ". ref $self );
if ( $p{sudo} ) {
my $chmod = $self->find_bin( 'chmod', debug => 0 );
my $sudo = $self->sudo();
$self->syscmd( "$sudo $chmod $mode $file", debug => 0 )
or return $log->error( "couldn't chmod $file: $!", %args );
}
# note the conversion of ($mode) to an octal value. Very important!
CORE::chmod( oct($mode), $file ) or
return $log->error( "couldn't chmod $file: $!", %args);
$log->audit("chmod $mode $file");
}
sub chown {
my $self = shift;
my $file = shift;
my %p = validate( @_,
{ 'uid' => { type => SCALAR },
'gid' => { type => SCALAR },
'sudo' => { type => BOOLEAN, optional => 1 },
%std_opts,
}
);
my %args = $self->get_std_args( %p );
my ( $uid, $gid, $sudo ) = ( $p{uid}, $p{gid}, $p{sudo} );
$file or return $log->error( "missing file or dir", %args );
return $log->error( "file $file does not exist!", %args ) if ! -e $file;
$log->audit("chown: preparing to chown $uid $file");
# sudo forces system chown instead of the perl builtin
return $self->chown_system( $file,
%args,
user => $uid,
group => $gid,
) if $sudo;
my ( $nuid, $ngid ); # if uid or gid is not numeric, convert it
if ( $uid =~ /\A[0-9]+\z/ ) {
$nuid = int($uid);
$log->audit(" using $nuid from int($uid)");
}
else {
$nuid = getpwnam($uid);
return $log->error( "failed to get uid for $uid", %args) if ! defined $nuid;
$log->audit(" converted $uid to a number: $nuid");
}
if ( $gid =~ /\A[0-9\-]+\z/ ) {
$ngid = int( $gid );
$log->audit(" using $ngid from int($gid)");
}
else {
$ngid = getgrnam( $gid );
return $log->error( "failed to get gid for $gid", %args) if ! defined $ngid;
$log->audit(" converted $gid to numeric: $ngid");
}
chown( $nuid, $ngid, $file )
or return $log->error( "couldn't chown $file: $!",%args);
return 1;
}
sub chown_system {
my $self = shift;
my $dir = shift;
my %p = validate( @_,
{ 'user' => { type => SCALAR, optional => 0, },
'group' => { type => SCALAR, optional => 1, },
'recurse' => { type => BOOLEAN, optional => 1, },
%std_opts,
}
);
my ( $user, $group, $recurse ) = ( $p{user}, $p{group}, $p{recurse} );
my %args = $self->get_std_args( %p );
$dir or return $log->error( "missing file or dir", %args );
my $cmd = $self->find_bin( 'chown', %args );
$cmd .= " -R" if $recurse;
$cmd .= " $user";
$cmd .= ":$group" if $group;
$cmd .= " $dir";
$log->audit( "cmd: $cmd" );
$self->syscmd( $cmd, %args ) or
return $log->error( "couldn't chown with $cmd: $!", %args);
my $mess;
$mess .= "Recursively " if $recurse;
$mess .= "changed $dir to be owned by $user";
$log->audit( $mess );
return 1;
}
sub clean_tmp_dir {
my $self = shift;
my $dir = shift or die "missing dir name";
my %p = validate( @_, { %std_opts } );
my %args = $self->get_std_args( %p );
my $before = cwd; # remember where we started
return $log->error( "couldn't chdir to $dir: $!", %args) if !chdir $dir;
foreach ( $self->get_dir_files( $dir ) ) {
next unless $_;
my ($file) = $_ =~ /^(.*)$/;
$log->audit( "deleting file $file" );
if ( -f $file ) {
unlink $file or
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
$self->syscmd( "$bin -c $archive | $tar -xf -" ) or return;
$log->audit( "extracted $archive" );
return 1;
}
sub file_delete {
my $self = shift;
my $file = shift or die "missing file argument";
my %p = validate( @_,
{ 'sudo' => { type => BOOLEAN, optional => 1, default => 0 },
%std_opts,
}
);
my %args = $self->get_std_args( %p );
return $log->error( "$file does not exist", %args ) if !-e $file;
if ( -w $file ) {
$log->audit( "write permission to $file: ok" );
unlink $file or return $log->error( "failed to delete $file", %args );
$log->audit( "deleted: $file" );
return 1;
}
if ( !$p{sudo} ) { # all done
return -e $file ? undef : 1;
}
my $err = "trying with system rm";
my $rm_command = $self->find_bin( "rm", %args );
$rm_command .= " -f $file";
if ( $< != 0 ) { # we're not running as root
my $sudo = $self->sudo( %args );
$rm_command = "$sudo $rm_command";
$err .= " (sudo)";
}
$self->syscmd( $rm_command, %args )
or return $log->error( $err, %args );
return -e $file ? 0 : 1;
}
sub file_is_newer {
my $self = shift;
my %p = validate( @_,
{ f1 => { type => SCALAR },
f2 => { type => SCALAR },
%std_opts,
}
);
my ( $file1, $file2 ) = ( $p{f1}, $p{f2} );
# get file attributes via stat
# (dev,ino,mode,nlink,uid,gid,rdev,size,atime,mtime,ctime,blksize,blocks)
$log->audit( "checking age of $file1 and $file2" );
my $stat1 = stat($file1)->mtime;
my $stat2 = stat($file2)->mtime;
$log->audit( "timestamps are $stat1 and $stat2");
return 1 if ( $stat2 > $stat1 );
return;
# I could just:
#
# if ( stat($f1)[9] > stat($f2)[9] )
#
# but that forces the reader to read the man page for stat
# to see what's happening
}
sub file_read {
my $self = shift;
my $file = shift or return $log->error("missing filename in request");
my %p = validate(
@_,
{ 'max_lines' => { type => SCALAR, optional => 1 },
'max_length' => { type => SCALAR, optional => 1 },
%std_opts
}
);
my ( $max_lines, $max_length ) = ( $p{max_lines}, $p{max_length} );
my %args = $self->get_std_args( %p );
return $log->error( "$file does not exist!", %args) if !-e $file;
return $log->error( "$file is not readable", %args ) if !-r $file;
open my $FILE, '<', $file or
return $log->error( "could not open $file: $OS_ERROR", %args );
my ( $line, @lines );
if ( ! $max_lines) {
chomp( @lines = <$FILE> );
close $FILE;
return @lines;
# TODO: make max_length work with slurp mode, without doing something ugly like
# reading in the entire line and then truncating it.
};
my $i = 0;
while ( $i < $max_lines ) {
if ($max_length) { $line = substr <$FILE>, 0, $max_length; }
else { $line = <$FILE>; };
last if ! $line;
last if eof $FILE;
push @lines, $line;
$i++;
}
chomp @lines;
close $FILE;
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
if ( !$found ) {
$fetchbin = $self->find_bin( 'wget', %args);
$found = $fetchbin if $fetchbin && -x $fetchbin;
}
return $log->error( "Failed to fetch $url.\n\tCouldn't find wget. Please install it.", %args )
if !$found;
my $fetchcmd = "$found $url";
my $timeout = $p{timeout} || 0;
if ( ! $timeout ) {
$self->syscmd( $fetchcmd, %args ) or return;
my $uri = URI->new($url);
my @parts = $uri->path_segments;
my $file = $parts[-1]; # everything after the last / in the URL
if ( -e $file && $dir && -d $dir ) {
$log->audit("moving file $file to $dir" );
move $file, "$dir/$file";
return 1;
};
};
my $r;
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $timeout;
$r = $self->syscmd( $fetchcmd, %args );
alarm 0;
};
if ($EVAL_ERROR) { # propagate unexpected errors
print "timed out!\n" if $EVAL_ERROR eq "alarm\n";
return $log->error( $EVAL_ERROR, %args );
}
return $log->error( "error executing $fetchcmd", %args) if !$r;
return 1;
}
sub has_module {
my $self = shift;
my ($name, $ver) = @_;
## no critic ( ProhibitStringyEval )
eval "use $name" . ($ver ? " $ver;" : ";");
## use critic
!$EVAL_ERROR;
};
sub install_if_changed {
my $self = shift;
my %p = validate(
@_,
{ newfile => { type => SCALAR, optional => 0, },
existing=> { type => SCALAR, optional => 0, },
mode => { type => SCALAR, optional => 1, },
uid => { type => SCALAR, optional => 1, },
gid => { type => SCALAR, optional => 1, },
sudo => { type => BOOLEAN, optional => 1, default => 0 },
notify => { type => BOOLEAN, optional => 1, },
email => { type => SCALAR, optional => 1, default => 'postmaster' },
clean => { type => BOOLEAN, optional => 1, default => 1 },
archive => { type => BOOLEAN, optional => 1, default => 0 },
%std_opts,
},
);
my ( $newfile, $existing, $mode, $uid, $gid, $email) = (
$p{newfile}, $p{existing}, $p{mode}, $p{uid}, $p{gid}, $p{email} );
my ($sudo, $notify ) = ($p{sudo}, $p{notify} );
my %args = $self->get_std_args( %p );
if ( $newfile !~ /\// ) {
# relative filename given
$log->audit( "relative filename given, use complete paths "
. "for more predicatable results!\n"
. "working directory is " . cwd() );
}
return $log->error( "file ($newfile) does not exist", %args )
if !-e $newfile;
return $log->error( "file ($newfile) is not a file", %args )
if !-f $newfile;
# make sure existing and new are writable
if ( !$self->is_writable( $existing, fatal => 0 )
|| !$self->is_writable( $newfile, fatal => 0 ) ) {
# root does not have permission, sudo won't do any good
return $log->error("no write permission", %args) if $UID == 0;
if ( $sudo ) {
$sudo = $self->find_bin( 'sudo', %args ) or
return $log->error( "you are not root, sudo was not found, and you don't have permission to write to $newfile or $existing" );
}
}
my $diffie;
if ( -f $existing ) {
$diffie = $self->files_diff( %args,
f1 => $newfile,
f2 => $existing,
type => "text",
) or do {
$log->audit( "$existing is already up-to-date.", %args);
unlink $newfile if $p{clean};
return 2;
};
};
$log->audit("checking $existing", %args);
$self->chown( $newfile,
uid => $uid,
gid => $gid,
sudo => $sudo,
%args
)
if ( $uid && $gid ); # set file ownership on the new file
# set file permissions on the new file
$self->chmod(
file_or_dir => $existing,
mode => $mode,
sudo => $sudo,
%args
)
if ( -e $existing && $mode );
$self->install_if_changed_notify( $notify, $email, $existing, $diffie);
$self->archive_file( $existing, %args) if ( -e $existing && $p{archive} );
$self->install_if_changed_copy( $sudo, $newfile, $existing, $p{clean}, \%args );
$self->chown( $existing,
uid => $uid,
gid => $gid,
sudo => $sudo,
%args
) if ( $uid && $gid ); # set ownership on new existing file
$self->chmod(
file_or_dir => $existing,
mode => $mode,
sudo => $sudo,
%args
)
if $mode; # set file permissions (paranoid)
$log->audit( " updated $existing" );
return 1;
}
sub install_if_changed_copy {
my $self = shift;
my ( $sudo, $newfile, $existing, $clean, $args ) = @_;
# install the new file
if ($sudo) {
my $cp = $self->find_bin( 'cp', %$args );
# back up the existing file
$self->syscmd( "$sudo $cp $existing $existing.bak", %$args)
if -e $existing;
# install the new one
if ( $clean ) {
my $mv = $self->find_bin( 'mv' );
$self->syscmd( "$sudo $mv $newfile $existing", %$args);
}
else {
$self->syscmd( "$sudo $cp $newfile $existing",%$args);
}
}
else {
# back up the existing file
copy( $existing, "$existing.bak" ) if -e $existing;
if ( $clean ) {
move( $newfile, $existing ) or
return $log->error( "failed copy $newfile to $existing", %$args);
}
else {
copy( $newfile, $existing ) or
return $log->error( "failed copy $newfile to $existing", %$args );
}
}
};
sub install_if_changed_notify {
my ($self, $notify, $email, $existing, $diffie) = @_;
return if ! $notify;
return if ! -f $existing;
# email diffs to admin
eval { require Mail::Send; };
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
############## clean_tmp_dir ################
# Usage : $util->clean_tmp_dir( $dir );
# Purpose : clean up old build stuff before rebuilding
# Returns : 0 - failure, 1 - success
# Parameters : S - $dir - a directory or file.
# Throws : die on failure
# Comments : Running this will delete its contents. Be careful!
=item get_mounted_drives
############# get_mounted_drives ############
# Usage : my $mounts = $util->get_mounted_drives();
# Purpose : Uses mount to fetch a list of mounted drive/partitions
# Returns : a hashref of mounted slices and their mount points.
=item archive_file
############### archive_file #################
# Purpose : Make a backup copy of a file by copying the file to $file.timestamp.
# Usage : my $archived_file = $util->archive_file( $file );
# Returns : the filename of the backup file, or 0 on failure.
# Parameters : S - file - the filname to be backed up
# Comments : none
=item chmod
Set the permissions (ugo-rwx) of a file. Will use the native perl methods (by default) but can also use system calls and prepend sudo if additional permissions are needed.
$util->chmod(
file_or_dir => '/etc/resolv.conf',
mode => '0755',
sudo => $sudo
)
arguments required:
file_or_dir - a file or directory to alter permission on
mode - the permissions (numeric)
arguments optional:
sudo - the output of $util->sudo
fatal - die on errors? (default: on)
debug
result:
0 - failure
1 - success
=item chown
Set the ownership (user and group) of a file. Will use the native perl methods (by default) but can also use system calls and prepend sudo if additional permissions are needed.
$util->chown(
file_or_dir => '/etc/resolv.conf',
uid => 'root',
gid => 'wheel',
sudo => 1
);
arguments required:
file_or_dir - a file or directory to alter permission on
uid - the uid or user name
gid - the gid or group name
arguments optional:
file - alias for file_or_dir
dir - alias for file_or_dir
sudo - the output of $util->sudo
fatal - die on errors? (default: on)
debug
result:
0 - failure
1 - success
=item file_delete
############################################
# Usage : $util->file_delete( $file );
# Purpose : Deletes a file.
# Returns : 0 - failure, 1 - success
# Parameters
# Required : file - a file path
# Comments : none
# See Also :
Uses unlink if we have appropriate permissions, otherwise uses a system rm call, using sudo if it is not being run as root. This sub will try very hard to delete the file!
=item get_url
$util->get_url( $url, debug=>1 );
Use the standard URL fetching utility (fetch, curl, wget) for your OS to download a file from the $url handed to us.
arguments required:
url - the fully qualified URL
arguments optional:
timeout - the maximum amount of time to try
fatal
debug
result:
1 - success
0 - failure
=item file_is_newer
compares the mtime on two files to determine if one is newer than another.
=item file_mode
usage:
my @lines = "1", "2", "3"; # named array
$util->file_write ( "/tmp/foo", lines=>\@lines );
or
$util->file_write ( "/tmp/foo", lines=>['1','2','3'] ); # anon arrayref
required arguments:
( run in 0.635 second using v1.01-cache-2.11-cpan-5735350b133 )