view release on metacpan or  search on metacpan

lib/App/Foca/Server.pm  view on Meta::CPAN

        if ($code == FOCA_RUN_RC_OK) {
            return $self->build_response(HTTP_OK, $output);
        } elsif ($code == FOCA_RUN_RC_TIMEOUT_CMD) {
            return $self->build_response(HTTP_REQUEST_TIMEOUT, 'Timed out'); 
        } else {
            return $self->build_response(HTTP_INTERNAL_SERVER_ERROR, $output);
        }
    }
}

=head2 B<build_response($code, $body)>

Builds a HTTP response (C<HTTP::Response>) based on the given HTTP status code
and optionally adds a body.

Returns a C<HTTP::Response> so it can be send via the opened connection.

=cut
sub build_response {
    my ($self, $code, $body) = @_;

    my $res = HTTP::Response->new($code, status_message($code));

    my %default_headers = (
            pragma        => "must-revalidate, no-cache, no-store, expires: -1",
            no_cache      => 1,
            expires       => -1,
            cache_control => "no-cache, no-store, must-revalidate",
            content_type  => 'text/plain',
            );
    while(my($k, $v) = each %default_headers) {
        $res->header($k, $v);
    }
    # A body?
    $res->content($body) if $body;
    return $res;
}

=head2 B<validate_request($command, $request)>

re-define this method if you want to add some extra security. By default all
requests are valid at this point.

=cut
sub validate_request {
    my ($self, $command, $request) = @_;

    return 1;
}

=head2 B<run_cmd($connection, $name, $cmd, $params)>

Runs whatever the command is and sets a timeout to it. If it takes too long
then it will try to kill the process.

Depending on the settings given to the command it will return the STDOUT or
STDERR or even both. The rules are:

=over 4

=item 1. On success it will look for STDOUT, if nothing is there then it looks in
STDERR. If nothing is foudn in STDERR and STDOUT then an empty string is
returned.

=item 2. On error it will look for STDERR first, if nothing is there then it
looks in STDOUT. If nothing is there then it returns an empty string.

=back

Both STDOUT and STDERR can be returned if the command is defined as follows:

    server_uptime:
        cmd: '/usr/bin/uptime'
        capture_all: 'y'

=cut
sub run_cmd {
    my ($self, $connection, $name, $cmd, $params) = @_;

    my $output = '';
    if ($cmd->{'cmd'}) {
        my $capture_all = 0;
        if ($cmd->{'capture_all'}) {
            $capture_all = ($cmd->{'capture_all'} eq 'y');
        }
        my @foca_cmd;
        # For the args, the cmd has a {%args%} parameter?
        if ($cmd->{'cmd'} =~ /\{\%foca_args\%\}/) {
            my $cmd = $cmd->{'cmd'};
            if ($params) {
                $cmd =~ s/\{\%foca_args\%\}/$params/g;
            } else {
                $cmd =~ s/\{\%foca_args\%\}//g;
            }
            @foca_cmd = $cmd;
        } else {
            @foca_cmd = $cmd->{'cmd'};
            push(@foca_cmd, $params) if $params;
        }
        
        my $timeout  = $cmd->{'timeout'} ?
            int($cmd->{'timeout'}) : $self->{'commands_timeout'};
        
        my ($result, $out, $err, $error_msg, @foca_cmd_pids, $in);
        eval {
            my $ip = $connection->peerhost();
            log_info("Command - $name [timeout: $timeout][ip $ip] - About to run @foca_cmd");
            $result = run_forked("@foca_cmd", {
                    child_in => \$in,
                    timeout  => $timeout});
        };
        if ($result->{'timeout'} == $timeout) {
            return (FOCA_RUN_RC_TIMEOUT_CMD, 'Timed out');
        }
        # Ok, sometimes because of SIG{CHLD} we get exit codes of 255
        # with no stderr which foca thinks the command failed but it really did not,
        # so lets check if we got stderr too, if we did not then the command was 
        # OK (unless of course there is a real: 'y' command). Check anything >
        # than 1 cause 1 is by default an error (like /bin/false which wont
        # return nothing to STDERR...)
        if ($result->{'exit_code'} > 1) {
            unless ($result->{'stderr'}) {
                if (defined $cmd->{'real'}) {
                    if ($cmd->{'real'} ne 'y') {
                        # Force OK
                        $result->{'exit_code'} = 0;