Apache-Logmonster

 view release on metacpan or  search on metacpan

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

    };

    # 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,

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

    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 },

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

    $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;
}

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

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 );

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

    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 ) = @_;

lib/Apache/Logmonster/Utility.pm  view on Meta::CPAN

  ############### 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:

t/Utility.t  view on Meta::CPAN

            'chown no perms'
        );
    }
}

# tests system_chown because sudo is set, might cause testers to freak out
#	ok ($util->chown( $rwtest, uid=>$uid, gid=>$gid, sudo=>1, fatal=>0 ), 'chown');
#	ok ( ! $util->chown( $rwtest, uid=>'frobnob6i', gid=>'frobnob6i', sudo=>1, fatal=>0 ), 'chown');
#	ok ( ! $util->chown( $rwtest, uid=>$root, gid=>$wheel, sudo=>1,fatal=>0), 'chown');

# chmod
# get the permissions of the file in octal file mode
use File::stat;
my $st = stat($rwtest) or warn "No $tmp: $!\n";
my $before = sprintf "%lo", $st->mode & 07777;

#$util->syscmd( "ls -al $rwtest" );   # use ls -al to view perms

# change the permissions to something slightly unique
if ( lc($OSNAME) ne 'irix' ) {
# not sure why this doesn't work on IRIX, and since IRIX is EOL and nearly 
# extinct, I'm not too motivated to find out why.
    ok( $util->chmod(
            file_or_dir => $rwtest,   mode        => '0700',
            fatal       => 0,
        ),
        'chmod'
    );

# file_mode
    my $result_mode = $util->file_mode( file => $rwtest );
    cmp_ok( $result_mode, '==', 700, 'file_mode' );

#$util->syscmd( "ls -al $rwtest" );

# and then set them back
    ok( $util->chmod(
            file_or_dir => $rwtest,
            mode        => $before,
            fatal => 0,
        ),
        'chmod'
    );
};

#$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";

t/Utility.t  view on Meta::CPAN

        'logfile_append'
    );
}

# mailtoaster
#

# mkdir_system
my $mkdir = "$tmp/bar";
ok( $util->mkdir_system( dir => $mkdir ), 'mkdir_system' );
ok( $util->chmod( file_or_dir => $mkdir, mode => '0744', fatal => 0 ),
    'chmod' );
ok( rmdir($mkdir), 'mkdir_system' );

# path_parse
my $pr = "/usr/bin";
my $bi = "awk";
ok( my ( $up1dir, $userdir ) = $util->path_parse("$pr/$bi"), 'path_parse' );
ok( $pr eq $up1dir,  'path_parse' );
ok( $bi eq $userdir, 'path_parse' );

$log->dump_audit(quiet=>1);