#####
#
# Copyright (C) 2006 Chet Luther <chet.luther@gmail.com>
#
# This file is part of the SEC program.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; see the file COPYING.  If not, write to
# the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
#
#####

package SEC::Prelude;

use strict;
use warnings;


# Logging constants.
use constant LOG_CRIT           => 1;
use constant LOG_ERR            => 2;
use constant LOG_WARN           => 3;
use constant LOG_NOTICE         => 4;
use constant LOG_INFO           => 5;
use constant LOG_DEBUG          => 6;


sub new { my $class = ref($_[0]) || $_[0];
    my $self = {
        'opt'    => $_[1],
        'ptypes' => [ 'idmef' ],
        'atypes' => [ 'prelude' ],

        'client' => undef,
        'analyzer' => undef,
        'path_cache' => {}
    };

    eval { require Prelude };
    if ($@) {
        $self->{'bindings_error'} = $@;
        $self->{'have_bindings'} = 0;
    } else {
        $self->{'have_bindings'} = 1;
    }

    bless $self, $class;

    return $self;
}

sub handles_ptype { my ($self, $ptype) = @_;
    return 1 if grep /^$ptype$/i, @{$self->{'ptypes'}};
    return 0;
}

sub handles_atype { my ($self, $atype) = @_;
    return 1 if grep /^$atype$/i, @{$self->{'atypes'}};
    return 0;
}

sub open { my $self = $_[0];
    if (!$self->{'have_bindings'}) {
        log_msg(LOG_ERR, "Perl bindings not found.");
        log_msg(LOG_ERR, $self->{'bindings_error'});
        return 0;
    }

    my @argv = ($0, "--prelude", split(/\s+/, $self->{'opt'}));

    my $ret = Prelude::prelude_init(scalar(@argv), \@argv);
    if ($ret < 0) {
        log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
        return 0;
    }

    $ret = Prelude::prelude_client_new(\$self->{'client'}, 'sec');
    if ($ret < 0) {
        log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
        return 0;
    }

    { no warnings 'once';
        Prelude::prelude_client_set_required_permission($self->{'client'},
            $Prelude::PRELUDE_CONNECTION_PERMISSION_IDMEF_READ |
            $Prelude::PRELUDE_CONNECTION_PERMISSION_IDMEF_WRITE);
    }

    $self->{'analyzer'} =
        Prelude::prelude_client_get_analyzer($self->{'client'});

    Prelude::idmef_analyzer_set_model($self->{'analyzer'}, 'SEC');
    Prelude::idmef_analyzer_set_class($self->{'analyzer'}, 'Correlator');
    Prelude::idmef_analyzer_set_version($self->{'analyzer'}, $main::SEC_VERSION);

    $ret = Prelude::prelude_client_start($self->{'client'});
    if ($ret < 0) {
        log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
        return 0;
    }

    return 1;
}

sub close { my $self = $_[0];
    Prelude::prelude_client_destroy($self->{'client'},
        $Prelude::PRELUDE_CLIENT_EXIT_STATUS_SUCCESS);

    return 1;
}

sub read_line { my $self = $_[0];
    my $pool = Prelude::prelude_client_get_connection_pool($self->{'client'});
    return undef unless $pool;

    while (1) {
        my ($prelude_conn, $prelude_msg, $idmef_message);

        my $ret = Prelude::prelude_connection_pool_recv($pool, 0, \$prelude_conn, \$prelude_msg);
        if ($ret < 0) {
            log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
            return undef;
        } 

	Prelude::prelude_timer_wake_up();
	
	if ($ret == 0) {
            return undef;
        }

        my $msg_tag = Prelude::prelude_msg_get_tag($prelude_msg);

        { no warnings 'once';
            if ($msg_tag != $Prelude::PRELUDE_MSG_IDMEF) {
                my $msgbuf;

                $ret = Prelude::prelude_connection_new_msgbuf($prelude_conn, \$msgbuf);
                if ( $ret < 0 ) {
                   Prelude::prelude_msg_destroy($prelude_msg);
                   next;
                }

                Prelude::prelude_client_handle_msg_default($self->{'client'}, $prelude_msg, $msgbuf);
                Prelude::prelude_msg_destroy($prelude_msg);
                Prelude::prelude_msgbuf_destroy($msgbuf);
                return undef;
            }
        }

        $ret = Prelude::idmef_message_new(\$idmef_message);
        if ($ret < 0) {
            log_msg(LOG_ERR, Prelude::prelude_strerror($ret));

            Prelude::prelude_msg_destroy($prelude_msg);
            return undef;
        }

        $ret = Prelude::idmef_message_read($idmef_message, $prelude_msg);
        if ($ret < 0) {
            log_msg(LOG_ERR, Prelude::prelude_strerror($ret));

            Prelude::prelude_msg_destroy($prelude_msg);
            return undef;
        }

        return {
            'prelude' => $prelude_msg,
            'idmef' => $idmef_message
        };
    }

    return undef;
}

sub free_line { my $self = $_[0];
    Prelude::idmef_message_destroy(
        $main::input_buffer[$main::bufpos]->{'idmef'});

    Prelude::prelude_msg_destroy(
        $main::input_buffer[$main::bufpos]->{'prelude'});
}

sub get_path { my ($self, $object) = @_;
    $object = "alert.$object";

    if (!$self->{'path_cache'}->{$object}) {
        my $path;

        my $ret = Prelude::idmef_path_new(\$path, $object);
        if ($ret < 0) {
            log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
            return undef;
        }

        $self->{'path_cache'}->{$object} = $path;
    }

    return $self->{'path_cache'}->{$object};
}

sub analyze_pattern { my ($self, $pattern) = @_;
    foreach (split(/;/, $pattern)) {
        my ($object, $value);

        if (m/^\s*([a-z\(\)0-9\._-]+):\s+(.+)$/) {
            ($object, $value) = ($1, $2);
        } else {
            log_msg(LOG_ERR, "invalid pattern: \"$_\"");
            return 0;
        }

        return 0 unless defined $self->get_path($object);
    }

    return 1;
}

sub match { my ($self, $pattern, $subst_ref) = @_;
    my $msg = $main::input_buffer[$main::bufpos];

    @{$subst_ref} = ();

    my $found_match = 1;
    my @matched_paths = ();

    foreach (split(/;/, $pattern)) {
        return 0 unless m/^\s*([a-z\(\)0-9\._\-]+):\s+(.+)$/;

        my ($object, $value, @m_paths) = ($1, $2);

        if (ref($msg) eq "HASH") {
            @m_paths = $self->match_idmef($msg, $object, $value, $subst_ref);
        } else {
            @m_paths = $self->match_string($msg, $object, $value, $subst_ref);
        }

        if (defined $m_paths[0]) {
            push(@matched_paths, join(';', @m_paths));
        } else {
            $found_match = 0;
        }
    }

    if ($found_match) {
        unshift(@{$subst_ref}, join(';', @matched_paths));
        return 1;
    }

    return 0;
}

sub match_idmef { my ($self, $msg, $m_object, $m_value, $subst_ref) = @_;
    my $path = $self->get_path($m_object);

    my $value;
    my $value_string = "";

    my $ret = Prelude::idmef_path_get($path, $msg->{'idmef'}, \$value);
    if ($ret < 0) {
        log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
        return undef;
    }

    if ($ret == 1) {
        $value_string = Prelude::idmef_value_to_string($value);
        Prelude::idmef_value_destroy($value);
    }   

    if (my @sref = ($value_string =~ /$m_value/)) {
        push(@{$subst_ref}, @sref) if $m_value =~ /\(.+\)/;
        return ("$m_object: $value_string");
    }

    return undef;
}

sub match_string { my ($self, $msg, $m_object, $m_value, $subst_ref) = @_;
    my @matched_paths = ();

    my $found_match = 0;

    foreach (split(/;/, $msg)) {
        return 0 unless m/^\s*([a-z\(\)0-9\._]+):\s+(.+)$/;

        my ($object, $value) = ($1, $2);

        next unless $object eq $m_object;

        if (my @sref = ($value =~ /$m_value/)) {
            push(@{$subst_ref}, @sref);
            push(@matched_paths, "$object: $value");

            $found_match = 1;
        }
    }

    if ($found_match) {
        return @matched_paths;
    }

    return undef;
}

sub action { my ($self, $text, $args) = @_;
    my ($message, $time, $alert, $path, $i_value);

    # We require args to function.
    return unless $args;

    # Integrate alertidents into the arg string.
    $args =~ s/[\n\r]+/;/g;

    my $ret = Prelude::idmef_message_new(\$message);
    if ($ret < 0) {
        log_msg(LOG_ERR, Prelude::prelude_strerror($ret));
        return 0;
    }

    Prelude::idmef_time_new_from_gettimeofday(\$time);
    Prelude::idmef_message_new_alert($message, \$alert);
    Prelude::idmef_alert_set_analyzer($alert,
        Prelude::idmef_analyzer_ref($self->{'analyzer'}), -1);
    Prelude::idmef_alert_set_create_time($alert, $time);

    foreach (split(/;/, $args)) {
        next unless m/^\s*([a-z\(\)0-9\._\->>]+)\s*=\s*(.+)$/;

        my ($object, $value) = ($1, $2);

        # Temporary hack to handle the -1 index case.
        if ($object =~ /^(.+)\(\-1\)(.+)$/) {
            my ($pre, $post) = ($1, $2);

            my $base_path = $self->get_path($pre);
            $ret = Prelude::idmef_path_get($base_path, $message, \$i_value);
            if ($ret < 0) {
                next;
            }

            my $current_index = Prelude::idmef_value_get_count($i_value) - 1;
            $object = "$pre($current_index)$post";
	    
	    Prelude::idmef_value_destroy($i_value);
        }

        if (!($path = $self->get_path($object))) {
            next;
        }

        $ret = Prelude::idmef_value_new_from_path(\$i_value, $path, $value);
        if ($ret < 0) {
            log_msg(LOG_WARN, Prelude::prelude_strerror($ret));
            next;
        }

        $ret = Prelude::idmef_path_set($path, $message, $i_value);
        Prelude::idmef_value_destroy($i_value);
        if ($ret < 0) {
            log_msg(LOG_WARN, Prelude::prelude_strerror($ret));
            Prelude::idmef_value_destroy($i_value);
            next;
        }

        print STDERR "DEBUG: $object = $value\n";
    }

    Prelude::prelude_client_send_idmef($self->{'client'}, $message);
    Prelude::idmef_message_destroy($message);
}

sub log_msg { my ($priority, $msg) = @_;
    if ($main::debuglevel >= $priority) {
        main::log_msg($priority, "Prelude: $msg");
    }
}

1;