Webmin System stats git

#!/usr/bin/perl -w
###############################################################################
#    Webmin Sysstats - mailq.pl
#
#    Webmin Sysstats Module
#    Copyright (C) 2002 by Eric Gerbier
#    Bug reports to: gerbier@users.sourceforge.net
#    $Id$
#
#    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.
#
###############################################################################

use strict;
use warnings;

# to be used alone or from sysstat.pl without warning
# because require verify the path
require '../../gen-lib.pl' if ( !exists $ENV{WEBMINSTAT_TEMP} );

use RRDs;

my $info2 = 'mailq';

###############################################################################
sub nb_dest_waiting() {
	my $nb_dest = 'U';
	my $nb_mail = 'U';

	# get errors just in debug mode
	my $cmd = $info2 . stderr_debug() . '|';
	my $fh_mailq;
	if ( open( $fh_mailq, $cmd ) ) {
		$nb_dest = 0;
		$nb_mail = 0;
		while (<$fh_mailq>) {
			if ( (m/\@/) or (m/MAILER-DAEMON$/) ) {
				if (m/MAILER-DAEMON$/) {

					# a real mail
					$nb_mail++;
				}
				elsif (m/^\S.*\@/) {

					# begin with a space : one of the dest of a mail
					$nb_dest++;
				}
				else {

					# a real mail
					$nb_mail++;
				}
			}
		}
		close($fh_mailq);
	}
	else {
		warning("can not open $info2 : $!");
	}
	return ( $nb_dest, $nb_mail );
}
###############################################################################
sub parse_maillog($) {
	my $log = shift(@_);

	my ( $nb_mta, $nb_pop, $nb_imap, $nb_reject ) = ( 0, 0, 0, 0 );

	test_log_size($log);
	my $fh_log;
	if ( open( $fh_log, '<', $log ) ) {
		my $line;
		while ( $line = <$fh_log> ) {
			$nb_mta++
			  if ( ( $line =~ m/sendmail.* from=.* size=/ )
				|| ( $line =~ m/postfix.* from=.* size=/ )
				|| ( $line =~ m/exim.* from=/ )
				|| ( $line =~ m/qmail.* from=/ ) );

			$nb_pop++
			  if ( ( $line =~ m/ipop3d.*: Login user=/ )
				|| ( $line =~ m/ipop3d.*: Auth user=/ )
				|| ( $line =~ m/pop3-login.*: Login/ )
				|| ( $line =~ m/cyrus\/pop3d.*: login:/ ) );

			$nb_imap++
			  if ( ( $line =~ m/imapd.*: Login user=/ )
				|| ( $line =~ m/imap-login.*: Login/ )
				|| ( $line =~ m/imapd.*: Authenticated user=/ )
				|| ( $line =~ m/cyrus\/imapd.*: login:/ ) );
			$nb_reject++
			  if ( ( $line =~ m/relaying denied/ )
				|| ( $line =~ m/ reject=/ )
				|| ( $line =~ m/ reject:/ )
				|| ( $line =~ m/User unknown in local/ ) );
		}
		close($fh_log);

		$nb_mta  = sec_2_min($nb_mta);
		$nb_pop  = sec_2_min($nb_pop);
		$nb_imap = sec_2_min($nb_imap);
	}
	else {
		warning("can not open maillog $log : $!");
		( $nb_mta, $nb_pop, $nb_imap, $nb_reject ) = ( 'U', 'U', 'U', 'U' );
	}
	return ( $nb_mta, $nb_pop, $nb_imap, $nb_reject );
}

###############################################################################

my %config;
read_file_cached( 'config', \%config );

# maillog
my $log = $config{'maillog'};

my ( $nb_mta, $nb_pop, $nb_imap, $nb_reject );

if ( $log eq '' ) {
	( $nb_mta, $nb_pop, $nb_imap, $nb_reject ) = ( 'U', 'U', 'U', 'U' );
}
else {
	( $nb_mta, $nb_pop, $nb_imap, $nb_reject ) = parse_maillog($log);
}

debug(
"mailq : nb_mta=$nb_mta nb_pop=$nb_pop nb_imap=$nb_imap nb_reject=$nb_reject"
);

# mailq
my ( $nb_dest, $nb_mailq ) = nb_dest_waiting();

debug("mailq : nb_dest=$nb_dest nb_mail=$nb_mailq");

RRDs::update( 'mailq.rrd', "N:$nb_mailq:$nb_mta:$nb_pop:$nb_imap" );
my $ERR = RRDs::error();
warning("ERROR while updating mailq.rrd: $ERR") if $ERR;

RRDs::update( 'mailq2.rrd', "N:$nb_dest" );
$ERR = RRDs::error();
warning("ERROR while updating mailq2.rrd: $ERR") if $ERR;

RRDs::update( 'mailq3.rrd', "N:$nb_reject" );
$ERR = RRDs::error();
warning("ERROR while updating mailq2.rrd: $ERR") if $ERR;