#! /usr/bin/perl -w
# vim:syntax=perl
use strict;
use lib '/usr/local/share/perl5';

use Lire::DlfSchema;
use Lire::Syslog;
use Lire::Program qw/:msg :dlf/;

use vars qw/ $dlf_maker $dlflines $debug /;

#-----------------------------------------------------------------------
#  Function Print_Server_Messages 
#  A function to dump server messages

sub Print_Server_Messages {
    my($list) = @_;

    lr_debug( <<EOT );
Server Messages
---------------

EOT

    foreach my $e (@$list) {
        lr_debug( $e );
    }

    lr_debug( "" );
}

#------------------------------------------------------------------------
# Function print_dlf
sub print_dlf {
    my($entry) = @_;

    #$entry->{status} =~ s/\s+/_/g if (defined $entry->{status});

    my $dlf = $dlf_maker->($entry);
    if ($#$dlf < 0) {
        # FIXME: When can this happen?
        lr_err( "*** ERROR in PRINT DLF 0 fields" )
    } else {
        print join( " ", @$dlf ), "\n";
    }
    $dlflines++;
}

#------------------------------------------------------------------------
# Function duration2sec
sub duration2sec {
    my($duration) = @_;

    my ($h,$m,$s) = split(/:/,$duration);
    my ($d) = $h * 3600 + $m * 60 + $s;
    return $d;
}

#------------------------------------------------------------------------
# Function extract_ip
#
sub extract_ip {
    die "can't extract IP address from $_[0]\n"
      unless $_[0] =~ /(\d+\.\d+\.\d+\.\d+)/;

    return $1;
}

#------------------------------------------------------------------------
# Function Process_Account_Notice_Close
sub Process_Account_Notice_Close {
    my($log,$fields) = @_;

    my($entry);

    chop($log->{process});

    # Now we parse the line which looks like:
    #   close [192.168.40.104] clairea 2002/2/20 0:15:55 0:00:00 157 502 0
  
    my($tag,$client_ip,$user,$date,$start_session,$duration,$nbr_msg,$tot_msg,$tag2) = @$fields;

    $duration  = duration2sec($duration);
  
    $entry->{time}          = $log->{timestamp};
    $entry->{localserver}   = $log->{hostname};
    $entry->{client_ip}     = extract_ip($client_ip);
    $entry->{user}          = lc $user;
    $entry->{protocol}      = $log->{process};
    $entry->{prot_cmd}      = $tag;
    $entry->{messages_downloaded} = $nbr_msg;
    $entry->{bytes_downloaded}  = $tot_msg;
    $entry->{session_duration}  = $duration;

    print_dlf($entry);
}

#------------------------------------------------------------------------
# Function Process_Account_Notice_Badlogin
sub Process_Account_Notice_Badlogin {
    my($log,$fields) = @_;

    my($entry,$prot_cmd, $client_ip, $user, $status);

    chop($log->{process});

    # Now we parse the line which looks like:
    #   badlogin: [192.168.40.101] login Password incorrect
    #   badlogin: [192.168.30.3] plaintext boki Password incorrect
    #   badlogin: [80.11.34.193] plaintext jean-claude.boutan User unknown

    if ($log->{process} =~ 'imap') {
        ($prot_cmd, $client_ip, $status) =
          ($log->{content} =~ /(badlogin): (\[.*\]) login (.*)/)
            or die "failed to parse IMAP badlogin event\n";
    } else {
        ($prot_cmd, $client_ip, $user, $status) =
          ($log->{content} =~ /(badlogin): (\[.*\]) plaintext ([^ ]+) (.*)/)
            or die "failed to parse IMAP badlogin event\n";

        # FIXME: rationale for lowercasing the account name?
        $entry->{user}               = lc $user;
    }

    $entry->{time}          = $log->{timestamp};
    $entry->{localserver}   = $log->{hostname};
    $entry->{client_ip}     = $client_ip;
    $entry->{protocol}      = $log->{process};
    $entry->{prot_cmd}      = $prot_cmd;
    $entry->{status}        = $status;
    $entry->{client_ip}     = extract_ip($client_ip);

    print_dlf($entry);
}


#------------------------------------------------------------------------
# Function Process_Account_Information
sub Process_Account_Information {
    my($log,$fields) = @_;

    my($entry);

    chop($log->{process});

    # Now we parse the line which looks like:
    #   close [192.168.40.104] clairea 2002/2/20 0:15:55 0:00:00 157 502 0
  
    my($prot_cmd,$client_ip,$user,$tag) = @$fields;

    $prot_cmd =~ s/\:$//;

    $entry->{time}               = $log->{timestamp};
    $entry->{localserver}        = $log->{hostname};
    $entry->{client_ip}          = extract_ip( $client_ip );
    $entry->{user}               = lc $user;
    $entry->{protocol}           = $log->{process};
    $entry->{prot_cmd}           = $prot_cmd;
    
    print_dlf($entry);
}

#------------------------------------------------------------------------
# Function Process_Protocol_Information
sub Process_Protocol_Information {
    my($log,$fields) = @_;

    my($entry);

    chop($log->{process});

    # Now we parse the line which looks like:
    #   irene_fischbach created mbox SENT
  
    my($user,$prot_cmd,$tag1,$tag2) = @$fields;

    $entry->{time}        = $log->{timestamp};
    $entry->{localserver} = $log->{hostname};
    $entry->{user}        = lc $user;
    $entry->{protocol}    = $log->{process};
    $entry->{prot_cmd}    = $prot_cmd ;

    print_dlf($entry);
}


#=============================================================================
# Here we start the main of the program
#=============================================================================

my $schema = eval { Lire::DlfSchema::load_schema( "msgstore" ) };
lr_err( "failed to load msgstore schema: $@" ) if $@;

$dlf_maker =
  $schema->make_hashref2asciidlf_func( qw/time localserver client_ip user protocol prot_cmd messages_downloaded bytes_downloaded session_duration status/);

my $lines       = 0;
$dlflines       = 0;
my $errorlines  = 0;
my @server_msg  = ();
$debug          = 0;

my $parser = new Lire::Syslog;
init_dlf_converter( "msgstore" );
my $failed_line = undef;
while ( <> ) {
    chomp;
    $lines++;

    # Look for ^M in the log file which fooled the logging system
    if ( /\r$/ ) {
        $failed_line .= $_;
        next;
    } elsif ( defined $failed_line) {
        $_ = $failed_line . $_;
        $failed_line = undef;
    }

    # Let's eliminate the (-8174) case in Netscape logs.
    # This pattern:
    #   (-8174)
    # Happens when there is the line:
    #  ... SSL initialization error: couldn't open certdb /mailserv1fs/netscape/server4/alias/msg-amail1-cert7.db
    # An old Netscape log stupidity! A forgotten \n or a bogus missing 'chomp'
    if (/^\s+\(\-\d+\)$/) {
        push(@server_msg,$_);
        next;
    }

    my $line = $_;
    eval {
        my $log = $parser->parse( $_ );
        if ($log->{process} !~ /imapd/ && $log->{process} !~ /popd/ && $log->{process} !~ /httpd/) {
            die "not a popd, imapd or httpd log line\n";
        }

        my (@fields) = split(/ /, $log->{content});

        if ($log->{facility} eq 'General' ) {
            push( @server_msg, $line );
        } elsif ( $log->{facility} eq 'Account' ) {
            if ( $log->{level} eq 'Information' ) {
                Process_Account_Information( $log, \@fields);
            } elsif ( $log->{level} eq 'Notice' ) {
                if ($log->{content} =~ /close/) {
                    Process_Account_Notice_Close($log,\@fields);
                } elsif ($log->{content} =~ /badlogin/) {
                    Process_Account_Notice_Badlogin($log,\@fields);
                } else {
                    die "don't know how to process $log->{content}\n";
                }
            } else {
                die "don't know how to process $log->{level} Account messages\n";
            }
        } elsif ( $log->{facility} eq 'Protocol' ) {
            Process_Protocol_Information($log,\@fields);
        } else {
            die "don't know how to process $log->{facility} facility\n";
        }
    };
    if ($@) {
        lr_warn( $@ );
        lr_warn( "failed to parse line $. '$_'. Skipping." );
        $errorlines++;
    }
}

Print_Server_Messages(\@server_msg);

end_dlf_converter( $lines, $dlflines, $errorlines );

__END__


=pod

=head1 NAME

nmsstore2dlf - convert Netscape Messaging Server IMAP or POP log files to the Lire msgstore DLF

=head1 SYNOPSIS

B<nmsstore2dlf>

=head1 DESCRIPTION

This program converts Netscape Messaging Server log files generated by
the IMAP or POP services to the Lire msgstore DLF.

=head1 LIMITATIONS

In order to have this parser giving you useful information it is
recommended to set the NMS 4 logs at the right level. In order to fix
that problem please make sure you did the following.

Go on the Netscape Messaging Server 4 Message Store

Become the Mail Server user (usually this should not be root but
typically a user like mailsrv or whatever was defined at installation
time, check for the ownership of the files in your message server
instance for example)

Go to the right location, something like:
 server-root/msg-instance

For example it could be:
 /usr/netscape/server4/msg-mymailserver

Do:

 $ ./configutil -o logfile.pop.loglevel -v Informational
 OK SET
 $ ./configutil -o logfile.imap.loglevel -v Informational
 OK SET

Then become root, go again to your instance directory like:
 /usr/netscape/server4/msg-mymailserver

and do:

 # ./stop-msg pop
 /mailserv1fs/netscape/server4: Stopping POP3 daemon 24789 .... done: 24789

 # ./start-msg pop
 /mailserv1fs/netscape/server4: Starting POP3 daemon .... done: 17509

=head1 EXAMPLES

To process a log as produced by Netscape Messaging Server:

 $ nmsstore2dlf < ns-store.log

nmsstore2dlf will be rarely used on its own, but is more likely
called by lr_log2report:

 $ lr_log2report nmsstore < /var/log/ns-store.log > report

=head1 VERSION

$Id: nmsstore2dlf.in,v 1.9 2006/07/23 13:16:35 vanbaal Exp $

=head1 THANKS

Jean-Yves Monnier for supplying a patch.

=head1 AUTHORS

Arnaud Taddei <Arnaud.Taddei@sun.com>, Arnaud Gaillard
<Arnaud.Gaillard@orange.ch>, Elie Dufraiche <Elie.Dufraiche@sun.com>

=head1 COPYRIGHT

Copyright (C) 2002  Arnaud Taddei <Arnaud.Taddei@sun.com>, Arnaud Gaillard
<Arnaud.Gaillard@orange.ch>, Elie Dufraiche <Elie.Dufraiche@sun.com>

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 of the License, 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 COPYING); if not, check with
http://www.gnu.org/copyleft/gpl.html. 

=cut

# Local Variables:
# mode: cperl
# End:

