#!perl -w =head1 NAME connection_time - log the duration of a connection =head1 DESCRIPTION The B plugin records the time of a connection between the first and the last possible hook in qpsmtpd (I and I) and writes a C (default, see below) line to the log. =head1 CONFIG =head2 loglevel Adjust the quantity of logging for this plugin. See docs/logging.pod connection_time loglevel +1 (less logging) connection_time loglevel -1 (more logging) =cut use strict; use warnings; use Qpsmtpd::Constants; use Time::HiRes qw(gettimeofday tv_interval); sub register { my ($self, $qp) = (shift, shift); if (@_ == 1) { # backwards compatible $self->{_args}{loglevel} = shift; if ($self->{_args}{loglevel} =~ /\D/) { $self->{_args}{loglevel} = Qpsmtpd::Constants::log_level($self->{_args}{loglevel}); } $self->{_args}{loglevel} ||= 6; } elsif (@_ % 2) { $self->log(LOGERROR, "invalid arguments"); } else { $self->{_args} = {@_}; # named args, inherits loglevel } # pre-connection is not available in the tcpserver deployment model. # duplicate the handler, so it works both ways with no redudant methods $self->register_hook('pre-connection', 'connect_handler'); $self->register_hook('connect', 'connect_handler'); } sub connect_handler { my $self = shift; return DECLINED if ($self->hook_name eq 'connect' && defined $self->{_connection_start}); $self->{_connection_start} = [gettimeofday]; $self->log(LOGDEBUG, "started at " . scalar gettimeofday); return DECLINED; } sub hook_post_connection { my $self = shift; if (!$self->{_connection_start}) { $self->log(LOGERROR, "Start time not set?!"); return DECLINED; } my $elapsed = tv_interval($self->{_connection_start}, [gettimeofday]); $self->log(LOGINFO, sprintf "%.3f s.", $elapsed); return DECLINED; }