Apache-Logmonster
view release on metacpan or search on metacpan
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
# we failed with existing permissions, try to escalate
$self->archive_file_sudo( $file ) if ( $p{sudo} && $< != 0 );
return $log->error( "backup of $file to $archive failed: $!", %args)
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
$self->file_delete( $file, %args );
}
elsif ( -d $file ) {
rmtree $file or return $log->error( "couldn't delete $file", %args);
}
else {
$log->audit( "Cannot delete unknown entity: $file" );
}
}
chdir $before;
return 1;
}
sub cwd_source_dir {
my $self = shift;
my $dir = shift or die "missing dir in request\n";
my %p = validate( @_,
{ 'src' => { type => SCALAR, optional => 1, },
'sudo' => { type => BOOLEAN, optional => 1, },
%std_opts,
}
);
my ( $src, $sudo, ) = ( $p{src}, $p{sudo}, );
my %args = $self->get_std_args( %p );
return $log->error( "Something (other than a directory) is at $dir and " .
"that's my build directory. Please remove it and try again!", %args )
if ( -e $dir && !-d $dir );
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
{ 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;
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
$portname =~ s/::/-/g;
my $yum = '/usr/bin/yum';
system "$yum -y install $portname" if -x $yum;
}
};
sub is_interactive {
## no critic
# borrowed from IO::Interactive
my $self = shift;
my ($out_handle) = ( @_, select ); # Default to default output handle
# Not interactive if output is not to terminal...
return if not -t $out_handle;
# If *ARGV is opened, we're interactive if...
if ( openhandle * ARGV ) {
# ...it's currently opened to the magic '-' file
return -t *STDIN if defined $ARGV && $ARGV eq '-';
# ...it's at end-of-file and the next file is the magic '-' file
return @ARGV > 0 && $ARGV[0] eq '-' && -t *STDIN if eof *ARGV;
# ...it's directly attached to the terminal
return -t *ARGV;
};
# If *ARGV isn't opened, it will be interactive if *STDIN is attached
# to a terminal and either there are no files specified on the command line
# or if there are files and the first is the magic '-' file
return -t *STDIN && ( @ARGV == 0 || $ARGV[0] eq '-' );
}
sub is_process_running {
my ( $self, $process ) = @_;
my $ps = $self->find_bin( 'ps', debug => 0 );
if ( lc($OSNAME) =~ /solaris/i ) { $ps .= ' -ef'; }
elsif ( lc($OSNAME) =~ /irix/i ) { $ps .= ' -ef'; }
elsif ( lc($OSNAME) =~ /linux/i ) { $ps .= ' -efw'; }
else { $ps .= ' axww'; };
my @procs = `$ps`;
chomp @procs;
return scalar grep {/$process/i} @procs;
}
sub is_readable {
my $self = shift;
my $file = shift or die "missing file or dir name\n";
my %p = validate( @_, { %std_opts } );
my %args = ( debug => $p{debug}, fatal => $p{fatal} );
-e $file or return $log->error( "$file does not exist.", %args);
-r $file or return $log->error( "$file is not readable by you ("
. getpwuid($>)
. "). You need to fix this, using chown or chmod.", %args);
return 1;
}
sub is_writable {
my $self = shift;
my $file = shift or die "missing file or dir name\n";
my %p = validate( @_, { %std_opts } );
my %args = $self->get_std_args( %p );
my $nl = "\n";
$nl = "<br>" if ( $ENV{GATEWAY_INTERFACE} );
if ( !-e $file ) {
my ( $base, $path, $suffix ) = fileparse($file);
return $log->error( "is_writable: $path not writable by "
. getpwuid($>)
. "$nl$nl", %args) if (-e $path && !-w $path);
return 1;
}
return $log->error( " $file not writable by " . getpwuid($>) . "$nl$nl", %args ) if ! -w $file;
$log->audit( "$file is writable" );
return 1;
}
sub logfile_append {
my $self = shift;
my %p = validate(
@_,
{ 'file' => { type => SCALAR, optional => 0, },
'lines' => { type => ARRAYREF, optional => 0, },
'prog' => { type => BOOLEAN, optional => 1, default => 0, },
%std_opts,
},
);
my ( $file, $lines ) = ( $p{file}, $p{lines} );
my %args = $self->get_std_args( %p );
my ( $dd, $mm, $yy, $lm, $hh, $mn, $ss ) = $self->get_the_date( %args );
open my $LOG_FILE, '>>', $file
or return $log->error( "couldn't open $file: $OS_ERROR", %args);
print $LOG_FILE "$yy-$mm-$dd $hh:$mn:$ss $p{prog} ";
my $i;
foreach (@$lines) { print $LOG_FILE "$_ "; $i++ }
print $LOG_FILE "\n";
close $LOG_FILE;
$log->audit( "logfile_append wrote $i lines to $file", %args );
return 1;
}
sub mail_toaster {
my $self = shift;
$self->install_module( 'Mail::Toaster' );
}
sub mkdir_system {
my $self = shift;
my %p = validate(
@_,
{ 'dir' => { type => SCALAR, optional => 0, },
'mode' => { type => SCALAR, optional => 1, },
'sudo' => { type => BOOLEAN, optional => 1, default => 0 },
%std_opts,
}
);
my ( $dir, $mode ) = ( $p{dir}, $p{mode} );
my %args = $self->get_std_args( %p );
return $log->audit( "mkdir_system: $dir already exists.") if -d $dir;
my $mkdir = $self->find_bin( 'mkdir', %args) or return;
# if we are root, just do it (no sudo nonsense)
if ( $< == 0 ) {
$self->syscmd( "$mkdir -p $dir", %args) or return;
$self->chmod( dir => $dir, mode => $mode, %args ) if $mode;
return 1 if -d $dir;
return $log->error( "failed to create $dir", %args);
}
if ( $p{sudo} ) {
my $sudo = $self->sudo();
$log->audit( "trying $sudo $mkdir -p $dir");
$self->syscmd( "$sudo $mkdir -p $dir", %args);
$log->audit( "setting ownership to $<.");
my $chown = $self->find_bin( 'chown', %args);
$self->syscmd( "$sudo $chown $< $dir", %args);
$self->chmod( dir => $dir, mode => $mode, sudo => $sudo, %args)
if $mode;
return -d $dir ? 1 : 0;
}
$log->audit( "trying mkdir -p $dir" );
# no root and no sudo, just try and see what happens
$self->syscmd( "$mkdir -p $dir", %args ) or return;
$self->chmod( dir => $dir, mode => $mode, %args) if $mode;
return $log->audit( "mkdir_system created $dir" ) if -d $dir;
return $log->error( '', %args );
}
sub path_parse {
# code left here for reference, use File::Basename instead
my ( $self, $dir ) = @_;
# if it ends with a /, chop if off
if ( $dir =~ q{/$} ) { chop $dir }
# get the position of the last / in the path
my $rindex = rindex( $dir, "/" );
# grabs everything up to the last /
my $updir = substr( $dir, 0, $rindex );
$rindex++;
# matches from the last / char +1 to the end of string
my $curdir = substr( $dir, $rindex );
return $updir, $curdir;
}
sub check_pidfile {
my $self = shift;
my $file = shift;
my %p = validate( @_, { %std_opts } );
my %args = $self->get_std_args( %p );
return $log->error( "missing filename", %args) if ! $file;
return $log->error( "$file is not a regular file", %args)
if ( -e $file && !-f $file );
# test if file & enclosing directory is writable, revert to /tmp if not
$self->is_writable( $file, %args)
or do {
my ( $base, $path, $suffix ) = fileparse($file);
$log->audit( "NOTICE: using /tmp for file, $path is not writable!", %args);
$file = "/tmp/$base";
};
# if it does not exist
if ( !-e $file ) {
$log->audit( "writing process id $PROCESS_ID to $file...");
$self->file_write( $file, lines => [$PROCESS_ID], %args) and return $file;
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
############################################
# Usage : use Apache::Logmonster::Utility;
# : my $util = Apache::Logmonster::Utility->new;
# Purpose : create a new Apache::Logmonster::Utility object
# Returns : a bona fide object
# Parameters : none
############################################
=item ask
Get a response from the user. If the user responds, their response is returned. If not, then the default response is returned. If no default was supplied, 0 is returned.
############################################
# Usage : my $ask = $util->ask( "Would you like fries with that",
# default => "SuperSized!",
# timeout => 30
# );
# Purpose : prompt the user for information
#
# Returns : S - the users response (if not empty) or
# : S - the default ask or
# : S - an empty string
#
# Parameters
# Required : S - question - what to ask
# Optional : S - default - a default answer
# : I - timeout - how long to wait for a response
# Throws : no exceptions
# See Also : yes_or_no
=item extract_archive
Decompresses a variety of archive formats using your systems built in tools.
############### extract_archive ##################
# Usage : $util->extract_archive( 'example.tar.bz2' );
# Purpose : test the archiver, determine its contents, and then
# use the best available means to expand it.
# Returns : 0 - failure, 1 - success
# Parameters : S - archive - a bz2, gz, or tgz file to decompress
=item cwd_source_dir
Changes the current working directory to the supplied one. Creates it if it does not exist. Tries to create the directory using perl's builtin mkdir, then the system mkdir, and finally the system mkdir with sudo.
############ cwd_source_dir ###################
# Usage : $util->cwd_source_dir( "/usr/local/src" );
# Purpose : prepare a location to build source files in
# Returns : 0 - failure, 1 - success
# Parameters : S - dir - a directory to build programs in
=item check_homedir_ownership
Checks the ownership on all home directories to see if they are owned by their respective users in /etc/password. Offers to repair the permissions on incorrectly owned directories. This is useful when someone that knows better does something like "ch...
######### check_homedir_ownership ############
# Usage : $util->check_homedir_ownership();
# Purpose : repair user homedir ownership
# Returns : 0 - failure, 1 - success
# Parameters :
# Optional : I - auto - no prompts, just fix everything
# See Also : sysadmin
Comments: Auto mode should be run with great caution. Run it first to see the results and then, if everything looks good, run in auto mode to do the actual repairs.
=item chown_system
The advantage this sub has over a Pure Perl implementation is that it can utilize sudo to gain elevated permissions that we might not otherwise have.
############### chown_system #################
# Usage : $util->chown_system( dir=>"/tmp/example", user=>'matt' );
# Purpose : change the ownership of a file or directory
# Returns : 0 - failure, 1 - success
# Parameters : S - dir - the directory to chown
# : S - user - a system username
# Optional : S - group - a sytem group name
# : I - recurse - include all files/folders in directory?
# Comments : Uses the system chown binary
# See Also : n/a
=item clean_tmp_dir
############## 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.
( run in 0.490 second using v1.01-cache-2.11-cpan-71847e10f99 )