#! @PERL@ -w # vim:syntax=perl use strict; use lib '@LR_PERL5LIBDIR@'; 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( <{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 =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 Gaillard , Elie Dufraiche =head1 COPYRIGHT Copyright (C) 2002 Arnaud Taddei , Arnaud Gaillard , Elie Dufraiche 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: