Apache-Logmonster
view release on metacpan or search on metacpan
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
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;
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
############# 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',
lib/Apache/Logmonster/Utility.pm view on Meta::CPAN
# Throws : no exceptions
=item fstab_list
############ fstab_list ###################
# Usage : $util->fstab_list;
# Purpose : Fetch a list of drives that are mountable from /etc/fstab.
# Returns : an arrayref
# Comments : used in backup.pl
# See Also : n/a
=item get_dir_files
$util->get_dir_files( $dir, debug=>1 )
required arguments:
dir - a directory
t/Utility.t view on Meta::CPAN
ok( $util->file_write( $rwtest, lines => ["erase me please"] ), 'file_write');
my @lines = $util->file_read( $rwtest );
ok( @lines == 1, 'file_read' );
# file_append
# a typical invocation
ok( $util->file_write( $rwtest, lines => ["more junk"], append => 1 ), 'file_append');
# archive_file
# a typical invocation
my $backup = $util->archive_file( $rwtest, fatal => 0 );
ok( -e $backup, 'archive_file' );
ok( $util->file_delete( $backup, fatal => 0 ), 'file_delete' );
ok( !$util->archive_file( $backup, fatal => 0 ), 'archive_file' );
# eval {
# # invalid param, will raise an exception
# $util->archive_file( $backup, fatal=>0 );
# };
# ok( $EVAL_ERROR , "archive_file");
# file_check_[readable|writable]
# typical invocation
ok( $util->is_readable( $rwtest, fatal => 0 ), 'is_readable' );
# a non-existing file (we already deleted it)
ok( !$util->is_readable( $backup, fatal => 0,debug=>0 ), 'is_readable - negated' );
ok( $util->is_writable( $rwtest, fatal => 0 ), 'is_writable' );
# get_url
SKIP: {
skip "avoiding network tests", 2 if ( !$network );
ok( $util->cwd_source_dir( $tmp ), 'cwd_source_dir' );
my $url = "http://www.mail-toaster.org/etc/maildrop-qmail-domain";
t/Utility.t view on Meta::CPAN
#$util->syscmd( "ls -al $rwtest" );
# file_write
ok( $util->file_write( $rwtest, lines => ["17"], fatal => 0 ), 'file_write');
#$ENV{PATH} = ""; print `/bin/cat $rwtest`;
#print `/bin/cat $rwtest` . "\n";
# files_diff
# we need two files to work with
$backup = $util->archive_file( $rwtest );
# these two files are identical, so we should get 0 back from files_diff
ok( !$util->files_diff( f1 => $rwtest, f2 => $backup ), 'files_diff' );
# now we change one of the files, and this time they should be different
ok( $util->file_write( $rwtest,
lines => ["more junk"],
append => 1
),
'file_write'
);
ok( $util->files_diff( f1 => $rwtest, f2 => $backup ), 'files_diff' );
# make it use md5 checksums to compare
$backup = $util->archive_file( $rwtest );
ok( !$util->files_diff(
f1 => $rwtest,
f2 => $backup,
type => 'binary'
),
'files_diff'
);
# now we change one of the files, and this time they should be different
sleep 1;
ok( $util->file_write( $rwtest,
lines => ["extra junk"],
append => 1
),
'file_write'
);
ok( $util->files_diff(
f1 => $rwtest,
f2 => $backup,
type => 'binary'
),
'files_diff'
);
# file_is_newer
#
# find_bin
# a typical invocation
t/Utility.t view on Meta::CPAN
cmp_ok( $list[4], '==', `$date '+%H'`, 'get_the_date hour' );
cmp_ok( $list[5], '==', `$date '+%M'`, 'get_the_date minutes' );
}
else {
ok( 1, 'get_the_date - skipped (Date::Format not installed)' );
}
# graceful_exit
# install_if_changed
$backup = $util->archive_file( $rwtest, fatal => 0 );
# call it the new way
ok( $util->install_if_changed(
newfile => $backup,
existing => $rwtest,
mode => '0644',
notify => 0,
clean => 0,
),
'install_if_changed'
);
# install_from_sources_php
# sub is incomplete, so are the tests.
t/Utility.t view on Meta::CPAN
my $tmpfile = '/tmp/provision-unix-test';
ok( $util->syscmd( "touch $tmpfile", fatal => 0 ), 'syscmd +');
ok( ! $util->syscmd( "rm $tmpfile.nonexist", fatal => 0,debug=>0 ), 'syscmd -');
ok( ! $util->syscmd( "rm $tmpfile.nonexist", fatal => 0,,debug=>0, timeout=>1), 'syscmd - (w/timeout)');
ok( $util->syscmd( "rm $tmpfile", fatal => 0, ), 'syscmd +');
ok( $util->syscmd( "$rm $tmp/maildrop-qmail-domain", fatal => 0, ),
'syscmd +'
) if ( $network && -f "$tmp/maildrop-qmail-domain" );
# file_delete
ok( $util->file_delete( $backup ), 'file_delete' );
ok( !$util->file_delete( $backup, fatal => 0 ), 'file_delete' );
ok( $util->file_delete( $rwtest ), 'file_delete' );
ok( $util->file_delete( "$rwtest.md5" ), 'file_delete' );
ok( $util->clean_tmp_dir( $tmp ), 'clean_tmp_dir' );
# yes_or_no
ok( $util->yes_or_no( "test", timeout => 5 ), 'yes_or_no' );
( run in 1.633 second using v1.01-cache-2.11-cpan-49f99fa48dc )