Apache-Logmonster

 view release on metacpan or  search on metacpan

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

    mkpath( $dir, 0, oct('0755') )
        or return $log->error( "mkdir $dir failed: $!");
    $log->audit( "created $dir");
    return 1;
}

sub error {
    my $self = shift;
    my $message = shift;
    my %p = validate( @_,
        {   location => { type => SCALAR,  optional => 1, },
            %std_opts,
        },
    );

    my $location = $p{location};
    my $debug = $p{debug};
    my $fatal = $p{fatal};

    if ( $message ) {
        my @caller = $p{caller} || caller;

        # append message and location to the error stack
        push @{ $log->{errors} }, {
            errmsg => $message,
            errloc => $location || join( ", ", $caller[0], $caller[2] ),
            };
    }
    else {
        $message = @{ $log->{errors} }[-1];
    }

    if ( $debug || $fatal ) {
        $self->dump_audit();
        $self->dump_errors();
    }

    exit 1 if $fatal;
    return;
}

sub extract_archive {
    my $self = shift;
    my $archive = shift or die "missing archive name";
    my %p = validate( @_, { %std_opts } );
    my %args = $self->get_std_args( %p );

    my $r;

    if ( !-e $archive ) {
        if    ( -e "$archive.tar.gz" )  { $archive = "$archive.tar.gz" }
        elsif ( -e "$archive.tgz" )     { $archive = "$archive.tgz" }
        elsif ( -e "$archive.tar.bz2" ) { $archive = "$archive.tar.bz2" }
        else {
            return $log->error( "file $archive is missing!", %args );
        }
    }

    $log->audit("found $archive");

    $ENV{PATH} = '/bin:/usr/bin'; # do this or taint checks will blow up on ``

    return $log->error( "unknown archive type: $archive", %args )
        if $archive !~ /[bz2|gz]$/;

    # find these binaries, we need them to inspect and expand the archive
    my $tar  = $self->find_bin( 'tar',  %args );
    my $file = $self->find_bin( 'file', %args );

    my %types = (
        gzip => { bin => 'gunzip',  content => 'gzip',       },
        bzip => { bin => 'bunzip2', content => 'b(un)?zip2', },
            # on BSD bunzip2, on Linux bzip2
    );

    my $type
        = $archive =~ /bz2$/ ? 'bzip'
        : $archive =~ /gz$/  ? 'gzip'
        :  return $log->error( 'unknown archive type', %args);

    # make sure the archive contents match the file extension
    return $log->error( "$archive not a $type compressed file", %args)
        unless grep ( /$types{$type}{content}/, `$file $archive` );

    my $bin = $self->find_bin( $types{$type}{bin}, %args);

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

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

};

sub install_from_source {
    my $self = shift;
    my %p = validate(
        @_,
        {   'site'           => { type => SCALAR,   optional => 0, },
            'url'            => { type => SCALAR,   optional => 0, },
            'package'        => { type => SCALAR,   optional => 0, },
            'targets'        => { type => ARRAYREF, optional => 1, },
            'patches'        => { type => ARRAYREF, optional => 1, },
            'patch_url'      => { type => SCALAR,   optional => 1, },
            'patch_args'     => { type => SCALAR,   optional => 1, },
            'source_dir'     => { type => SCALAR,   optional => 1, },
            'source_sub_dir' => { type => SCALAR,   optional => 1, },
            'bintest'        => { type => SCALAR,   optional => 1, },
            %std_opts,
        },
    );

    return $p{test_ok} if defined $p{test_ok};
    my %args = $self->get_std_args( %p );

    my ( $site, $url, $package, $targets, $patches, $bintest ) =
        ( $p{site},    $p{url}, $p{package},
          $p{targets}, $p{patches}, $p{bintest} );

    my $patch_args = $p{patch_args} || '';
    my $src = $p{source_dir} || "/usr/local/src";
       $src .= "/$p{source_sub_dir}" if $p{source_sub_dir};

    my $original_directory = cwd;

    $self->cwd_source_dir( $src, %args );

    if ( $bintest && $self->find_bin( $bintest, fatal => 0, debug => 0 ) ) {
        return if ! $self->yes_or_no(
            "$bintest exists, suggesting that "
                . "$package is installed. Do you want to reinstall?",
            timeout  => 60,
        );
    }

    $log->audit( "install_from_source: building $package in $src");

    $self->install_from_source_cleanup($package,$src) or return;
    $self->install_from_source_get_files($package,$site,$url,$p{patch_url},$patches) or return;

    $self->extract_archive( $package )
        or return $log->error( "Couldn't expand $package: $!", %args );

    # cd into the package directory
    my $sub_path;
    if ( -d $package ) {
        chdir $package or
            return $log->error( "FAILED to chdir $package!", %args );
    }
    else {

       # some packages (like daemontools) unpack within an enclosing directory
        $sub_path = `find ./ -name $package`;       # tainted data
        chomp $sub_path;
        ($sub_path) = $sub_path =~ /^([-\w\/.]+)$/; # untaint it

        $log->audit( "found sources in $sub_path" ) if $sub_path;
        return $log->error( "FAILED to find $package sources!",fatal=>0)
            unless ( -d $sub_path && chdir($sub_path) );
    }

    $self->install_from_source_apply_patches($src, $patches, $patch_args) or return;

    # set default build targets if none are provided
    if ( !@$targets[0] ) {
        $log->audit( "\tusing default targets (./configure, make, make install)" );
        @$targets = ( "./configure", "make", "make install" );
    }

    my $msg = "install_from_source: using targets\n";
    foreach (@$targets) { $msg .= "\t$_\n" };
    $log->audit( $msg ) if $p{debug};

    # build the program
    foreach my $target (@$targets) {

        if ( $target =~ /^cd (.*)$/ ) {
            $log->audit( "cwd: " . cwd . " -> " . $1 );
            chdir($1) or return $log->error( "couldn't chdir $1: $!", %args);
            next;
        }

        $self->syscmd( $target, %args ) or
            return $log->error( "pwd: " . cwd .  "\n$target failed: $!", %args );
    }

    # clean up the build sources
    chdir $src;
    $self->syscmd( "rm -rf $package", %args ) if -d $package;

    $self->syscmd( "rm -rf $package/$sub_path", %args )
        if defined $sub_path && -d "$package/$sub_path";

    chdir $original_directory;
    return 1;
}

sub install_from_source_apply_patches {
    my $self = shift;
    my ($src, $patches,$patch_args) = @_;

    return 1 if ! $patches;
    return 1 if ! $patches->[0];

    my $patchbin = $self->find_bin( "patch" );
    foreach my $patch (@$patches) {
        $self->syscmd( "$patchbin $patch_args < $src/$patch" )
            or return $log->error("failed to apply patch $patch");
    }
    return 1;
};

sub install_from_source_cleanup {
    my $self = shift;
    my ($package,$src) = @_;

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

    my %p = validate( @_, { %std_opts } );

    # if we are running as root via $<
    if ( $REAL_USER_ID == 0 ) {
        $log->audit( "sudo: you are root, sudo isn't necessary.");
        return '';    # return an empty string, purposefully
    }

    my $sudo;
    my $path_to_sudo = $self->find_bin( 'sudo', fatal => 0 );

    # sudo is installed
    if ( $path_to_sudo && -x $path_to_sudo ) {
        $log->audit( "sudo: sudo was found at $path_to_sudo.");
        return "$path_to_sudo -p 'Password for %u@%h:'";
    }

    $log->audit( "\nWARNING: Couldn't find sudo. This may not be a problem but some features require root permissions and will not work without them. Having sudo can allow legitimate and limited root permission to non-root users. Some features of Apa...

    # try installing sudo
    $self->yes_or_no( "may I try to install sudo?", timeout => 20 ) or do {
        print "very well then, skipping along.\n";
        return "";
    };

    -x $self->find_bin( "sudo", fatal => 0 ) or
        $self->install_from_source(
            package => 'sudo-1.6.9p17',
            site    => 'http://www.courtesan.com',
            url     => '/sudo/',
            targets => [ './configure', 'make', 'make install' ],
            patches => '',
            debug   => 1,
        );

    # can we find it now?
    $path_to_sudo = $self->find_bin( "sudo" );

    if ( !-x $path_to_sudo ) {
        print "sudo install failed!";
        return '';
    }

    return "$path_to_sudo -p 'Password for %u@%h:'";
}

sub syscmd {
    my $self = shift;
    my $cmd = shift or die "missing command!\n";
    my %p = validate(
        @_,
        {   'timeout' => { type => SCALAR, optional => 1 },
            %std_opts,
        },
    );

    my %args  = $log->get_std_args( %p );

    $log->audit("syscmd: $cmd");

    my ( $is_safe, $tainted, $bin, @args );

    # separate the program from its arguments
    if ( $cmd =~ m/\s+/xm ) {
        ($cmd) = $cmd =~ /^\s*(.*?)\s*$/; # trim lead/trailing whitespace
        @args = split /\s+/, $cmd;  # split on whitespace
        $bin = shift @args;
        $is_safe++;
        $log->audit("\tprogram: $bin, args : " . join ' ', @args, %args);
    }
    else {
        # does not not contain a ./ pattern
        if ( $cmd !~ m{\./} ) { $bin = $cmd; $is_safe++; };
    }

    if ( $is_safe && !$bin ) {
        return $log->error("command is not safe! BAILING OUT!", %args);
    }

    my $message;
    $message .= "syscmd: bin is <$bin>" if $bin;
    $message .= " (safe)" if $is_safe;
    $log->audit($message, %args );

    if ( $bin && !-e $bin ) {  # $bin is set, but we have not found it
        $bin = $self->find_bin( $bin, fatal => 0, debug => 0 )
            or return $log->error( "$bin was not found", %args);
    }
    unshift @args, $bin;

    require Scalar::Util;
    $tainted++ if Scalar::Util::tainted($cmd);

    my $before_path = $ENV{PATH};

    # instead of croaking, maybe try setting a
    # very restrictive PATH?  I'll err on the side of safety
    # $ENV{PATH} = '';
    return $log->error( "syscmd request has tainted data", %args)
        if ( $tainted && !$is_safe );

    if ($is_safe) {
        my $prefix = "/usr/local";   # restrict the path
        $prefix = "/opt/local" if -d "/opt/local";
        $ENV{PATH} = "/bin:/sbin:/usr/bin:/usr/sbin:$prefix/bin:$prefix/sbin";
    }

    my $r;
    eval {
        if ( defined $p{timeout} ) {
            local $SIG{ALRM} = sub { die "alarm\n" };
            alarm $p{timeout};
        };
        #$r = system $cmd;
        $r = `$cmd 2>&1`;
        alarm 0 if defined $p{timeout};
    };

    if ($EVAL_ERROR) {
        if ( $EVAL_ERROR eq "alarm\n" ) {
            $log->audit("timed out");
        }
        else {
            return $log->error( "unknown error '$EVAL_ERROR'", %args);
        }
    }
    $ENV{PATH} = $before_path;   # set PATH back to original value

    my @caller = caller;
    return $self->syscmd_exit_code( $r, $CHILD_ERROR, \@caller, \%args  );
}

sub syscmd_exit_code {
    my $self = shift;
    my ($r, $err, $caller, $args) = @_;

    $log->audit( "r: $r" );

    my $exit_code = sprintf ("%d", $err >> 8);
    return 1 if $exit_code == 0; # success

    #print 'error # ' . $ERRNO . "\n";   # $! == $ERRNO
    $log->error( "$err: $r",fatal=>0);

    if ( $err == -1 ) {     # check $? for "normal" errors
        $log->error( "failed to execute: $ERRNO", fatal=>0);
    }
    elsif ( $err & 127 ) {  # check for core dump
        printf "child died with signal %d, %s coredump\n", ( $? & 127 ),
            ( $? & 128 ) ? 'with' : 'without';
    }

    return $log->error( "$err: $r", location => join( ", ", @$caller ), %$args );
};

sub yes_or_no {
    my $self = shift;
    my $question = shift;
    my %p = validate(
        @_,