Apache-Logmonster
view release on metacpan or search on metacpan
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
unless ( $response eq $response2 ) {
print "\nPasswords don't match, try again.\n";
goto PROMPT;
}
system "stty echo";
print "\n";
}
chomp $response;
return $response if $response; # if they typed something, return it
return $default if $default; # return the default, if available
return ''; # return empty handed
}
sub audit {
my $self = shift;
my $mess = shift;
my %p = validate( @_, { %std_opts } );
if ($mess) {
push @{ $log->{audit} }, $mess;
print "$mess\n" if $self->{debug} || $p{debug};
}
return \$log->{audit};
}
sub archive_file {
my $self = shift;
my $file = shift or return $log->error("missing filename in request");
my %p = validate( @_,
{ 'sudo' => { type => BOOLEAN, optional => 1, default => 1 },
'mode' => { type => SCALAR, optional => 1 },
destdir => { type => SCALAR, optional => 1 },
%std_opts,
}
);
my %args = $self->get_std_args( %p );
return $log->error( "file ($file) is missing!", %args )
if !-e $file;
my $archive = $file . '.' . time;
if ( $p{destdir} && -d $p{destdir} ) {
my ($vol,$dirs,$file_wo_path) = File::Spec->splitpath( $archive );
$archive = File::Spec->catfile( $p{destdir}, $file_wo_path );
};
# see if we can write to both files (new & archive) with current user
if ( $self->is_writable( $file, %args )
&& $self->is_writable( $archive, %args ) ) {
# we have permission, use perl's native copy
copy( $file, $archive );
if ( -e $archive ) {
$log->audit("archive_file: $file backed up to $archive");
$self->chmod( file => $file, mode => $p{mode}, %args ) if $p{mode};
return $archive;
};
}
# 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( @_,
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
if !-e $file;
# one way to get file mode (using File::mode)
# my $raw_mode = stat($file)->[2];
## no critic
my $mode = sprintf "%04o", stat($file)->[2] & 07777;
# another way to get it
# my $st = stat($file);
# my $mode = sprintf "%lo", $st->mode & 07777;
$log->audit( "file $file has mode: $mode" );
return $mode;
}
sub file_write {
my $self = shift;
my $file = shift or return $log->error("missing filename in request");
my %p = validate(
@_,
{ 'lines' => { type => ARRAYREF },
'append' => { type => BOOLEAN, optional => 1, default => 0 },
'mode' => { type => SCALAR, optional => 1 },
%std_opts
}
);
my $append = $p{append};
my $lines = $p{lines};
my %args = $self->get_std_args( %p );
return $log->error( "oops, $file is a directory", %args) if -d $file;
return $log->error( "oops, $file is not writable", %args )
if ( ! $self->is_writable( $file, %args) );
my $m = "wrote";
my $write_mode = '>'; # (over)write
if ( $append ) {
$m = "appended";
$write_mode = '>>';
if ( -f $file ) {
copy $file, "$file.tmp" or return $log->error(
"couldn't create $file.tmp for safe append", %args );
};
};
open my $HANDLE, $write_mode, "$file.tmp"
or return $log->error( "file_write: couldn't open $file: $!", %args );
my $c = 0;
foreach ( @$lines ) { chomp; print $HANDLE "$_\n"; $c++ };
close $HANDLE or return $log->error( "couldn't close $file: $!", %args );
$log->audit( "file_write: $m $c lines to $file", %args );
move( "$file.tmp", $file )
or return $log->error(" unable to update $file", %args);
# set file permissions mode if requested
$self->chmod( file => $file, mode => $p{mode}, %args )
or return if $p{mode};
return 1;
}
sub files_diff {
my $self = shift;
my %p = validate(
@_,
{ f1 => { type => SCALAR },
f2 => { type => SCALAR },
type => { type => SCALAR, optional => 1, default => 'text' },
%std_opts,
}
);
my ( $f1, $f2, $type ) = ( $p{f1}, $p{f2}, $p{type} );
my %args = $log->get_std_args(%p);
if ( !-e $f1 || !-e $f2 ) {
$log->error( "$f1 or $f2 does not exist!", %args );
return -1;
};
return $self->files_diff_md5( $f1, $f2, \%args)
if $type ne "text";
### TODO
# use file here to make sure files are ASCII
#
$log->audit("comparing ascii files $f1 and $f2 using diff", %args);
my $diff = $self->find_bin( 'diff', %args );
my $r = `$diff $f1 $f2`;
chomp $r;
return $r;
};
sub files_diff_md5 {
my $self = shift;
my ($f1, $f2, $args) = @_;
$log->audit("comparing $f1 and $f2 using md5", %$args);
eval { require Digest::MD5 };
return $log->error( "couldn't load Digest::MD5!", %$args )
if $EVAL_ERROR;
$log->audit( "\t Digest::MD5 loaded", %$args );
my @md5sums;
foreach my $f ( $f1, $f2 ) {
my ( $sum, $changed );
# if the md5 file exists
if ( -f "$f.md5" ) {
$sum = $self->file_read( "$f.md5", %$args );
$log->audit( " md5 file for $f exists", %$args );
}
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
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; };
return $log->error( "could not send notice, Mail::Send is not installed!", fatal => 0)
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;
};
my $age = time() - stat($file)->mtime;
if ( $age < 1200 ) { # less than 20 minutes old
return $log->error( "check_pidfile: $file is " . $age / 60
. " minutes old and might still be running. If it is not running,"
. " please remove the file (rm $file).", %args);
}
elsif ( $age < 3600 ) { # 1 hour
return $log->error( "check_pidfile: $file is " . $age / 60
. " minutes old and might still be running. If it is not running,"
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
######### 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!
( run in 0.761 second using v1.01-cache-2.11-cpan-cdf2f3d4e48 )