174 lines
5.8 KiB
Plaintext
174 lines
5.8 KiB
Plaintext
|
#!/usr/bin/perl -w
|
||
|
|
||
|
# {{ ansible_managed }}
|
||
|
|
||
|
# $Header: /usr/local/etc/RCS/mail-throttled,v 1.11 2008/12/06 01:50:28 root Exp $
|
||
|
|
||
|
# mail-throttled [-l] [-D dbm_file] -k key -t throttle_seconds [-f from] -r recipient [-d] [-T tie_attempts_max] [-S tie_retry_sleep] [-s subject]
|
||
|
#
|
||
|
# Sends mail body (read from STDIN) to 'recipient', but avoids doing so "too frequently."
|
||
|
#
|
||
|
# You provide a 'key', which is an arbitrary string used to identify this notification.
|
||
|
# You also provide 'throttle_seconds', an integer. If we've sent anything that
|
||
|
# specified this 'key' within the last 'throttle_seconds', we do not send the message.
|
||
|
# Otherwise, we send the message, and the remember that we've sent a message for this 'key'
|
||
|
# at the current time.
|
||
|
#
|
||
|
# This key/timesent tuples are stored on-disk, in a dbm. As a result, the 'key'
|
||
|
# you supply must satisfy the syntactic requirements for dbm keys.
|
||
|
# The caller needs to have permission to read and write this DBM (and create it if
|
||
|
# it does not already exist). If you fail to specify a dbm_file, we'll use a default
|
||
|
# value, which may not be what you want (since the caller might not be able to r/w that
|
||
|
# particular DBM).
|
||
|
# We never clean this dbm. You can safely erase it entirely, if you don't mind losing
|
||
|
# the state, and you know the caller has permission to create a new instance of the DBM.
|
||
|
#
|
||
|
# The 'recipient' should be a valid email address. Naturally, it should not
|
||
|
# be one that will cause any ack or bounce mail to return to us!
|
||
|
# If there are several addresses (delimited by spaces), be sure to quote them as a single arg.
|
||
|
#
|
||
|
# If a subject is specified, be sure to quote it if it contains any spaces or other shell
|
||
|
# metachars.
|
||
|
#
|
||
|
# If -l is specified, then any errors, warnings, or debugging output is written to syslog
|
||
|
# in addition to its usual destination (STDERR). This is helpful if you call this from an
|
||
|
# environment where STDERR may get lost.
|
||
|
#
|
||
|
# Irwin Tillman
|
||
|
|
||
|
use Getopt::Std;
|
||
|
use GDBM_File;
|
||
|
use Errno qw(EAGAIN);
|
||
|
use Sys::Syslog qw(:DEFAULT setlogsock);
|
||
|
|
||
|
use strict;
|
||
|
use warnings;
|
||
|
|
||
|
use vars qw($DBM_FILE_DEFAULT $MAILCMD $MAILCMD_OPTS $FROM_DEFAULT);
|
||
|
$DBM_FILE_DEFAULT = '{{ ansible_local.root.lib + "/dhcp-probe/mail-throttled.gdbm" }}';
|
||
|
$MAILCMD = "/usr/lib/sendmail";
|
||
|
# $MAILCMD_OPTS = "-t -ODeliveryMode=queueonly";
|
||
|
$MAILCMD_OPTS = "-t";
|
||
|
$FROM_DEFAULT = "root";
|
||
|
|
||
|
my $SYSLOG_FACILITY="daemon"; # name of facility to use if syslogging
|
||
|
my $SYSLOG_OPT = 'pid,cons'; # syslog options to use if syslogging, ignored otherwise
|
||
|
my $SYSLOG_PRIORITY = 'LOG_ERR';
|
||
|
|
||
|
# The tie() call sometimes fails with EAGAIN.
|
||
|
# Perhaps that's due to some other process having the DBM open;
|
||
|
# in fact, that may be more likely if the process that calls us may calls us multiple times in quick succession.
|
||
|
# So when tie() fails with EAGAIN, we can sleep and retry some number of times before giving up entirely.
|
||
|
my $TIE_ATTEMPTS_MAX = 3; # number of times to try tie() before giving up
|
||
|
my $TIE_RETRY_SLEEP = 1; # seconds to sleep before retrying tie()
|
||
|
|
||
|
(my $prog = $0) =~ s/.*\///;
|
||
|
|
||
|
use vars qw($opt_f $opt_D $opt_d $opt_k $opt_l $opt_r $opt_s $opt_S $opt_t $opt_T);
|
||
|
&getopts('dD:f:k:lr:s:S:t:T:');
|
||
|
|
||
|
my $debug = $opt_d || "";
|
||
|
my $dbm_file = $opt_D || $DBM_FILE_DEFAULT;
|
||
|
my $key = $opt_k || "";
|
||
|
my $from = $opt_f || $FROM_DEFAULT;
|
||
|
my $recipient = $opt_r || "";
|
||
|
my $throttle_secs = $opt_t || 1;
|
||
|
my $subject = $opt_s || "";
|
||
|
my $also_syslog = $opt_l || "";
|
||
|
my $tie_attempts_max = $opt_T || $TIE_ATTEMPTS_MAX; # we deliberately override if CLI option specifies 0, as that makes no sense
|
||
|
my $tie_retry_sleep = $opt_S || $TIE_RETRY_SLEEP;
|
||
|
|
||
|
if ($also_syslog) {
|
||
|
# init our use of syslog
|
||
|
# setlogsock('unix'); # talk to syslog with UNIX domain socket, not INET domain. XXX causes failure in Solaris 7
|
||
|
openlog($prog, $SYSLOG_OPT, $SYSLOG_FACILITY);
|
||
|
}
|
||
|
|
||
|
my_warn("${prog}:\nkey=$key\nthrottle_secs=$throttle_secs\nfrom=$from\nrecipient=$recipient\ntie_attempts_max=$tie_attempts_max\ntie_retry_sleep=$tie_retry_sleep\nsubject=$subject") if $debug;
|
||
|
|
||
|
# certain options and args are required
|
||
|
&Usage() unless ($key && $throttle_secs && $recipient);
|
||
|
|
||
|
my %last_sent = ();
|
||
|
my $tie_succeeded = 0;
|
||
|
my $tie_attempts_left = $TIE_ATTEMPTS_MAX;
|
||
|
|
||
|
while ($tie_attempts_left--) {
|
||
|
if (tie(%last_sent, 'GDBM_File', $dbm_file, &GDBM_WRCREAT, 0644)) {
|
||
|
$tie_succeeded = 1;
|
||
|
last;
|
||
|
}
|
||
|
# the tie() failed
|
||
|
|
||
|
if ($! == EAGAIN) {
|
||
|
# The failure may be due to a transient problem.
|
||
|
# Retrying may help.
|
||
|
sleep $TIE_RETRY_SLEEP;
|
||
|
next;
|
||
|
|
||
|
} else {
|
||
|
# Some other (presumably more serious) error.
|
||
|
last;
|
||
|
}
|
||
|
}
|
||
|
unless ($tie_succeeded) {
|
||
|
my_warn("${prog}: can't tie ${dbm_file}: $!");
|
||
|
exit 10;
|
||
|
}
|
||
|
|
||
|
my @mailbody = "";
|
||
|
@mailbody = <STDIN>; # read it even if we decide not to send it
|
||
|
|
||
|
my $now = time;
|
||
|
|
||
|
my_warn("now = $now") if $debug;
|
||
|
|
||
|
$last_sent{$key} = 0 unless defined($last_sent{$key}); # so it's defined before we use it in subtraction (placate use strict)
|
||
|
|
||
|
if ($now - $last_sent{$key} >= $throttle_secs) {
|
||
|
my_warn("last_sent = $last_sent{$key}, will send") if $debug;
|
||
|
unless (open(MAIL, "| $MAILCMD $MAILCMD_OPTS -f\"$from\"")) {
|
||
|
my_warn("${prog}: error executing '${MAILCMD}': open(): $!");
|
||
|
exit 20;
|
||
|
}
|
||
|
print MAIL "From: $from\n",
|
||
|
"To: $recipient\n",
|
||
|
($subject ? "Subject: $subject\n" : "") ,
|
||
|
"\n",
|
||
|
@mailbody;
|
||
|
unless (close(MAIL)) {
|
||
|
my_warn("${prog}: error executing '${MAILCMD}': close(): " .
|
||
|
($! ?
|
||
|
"syserror closing pipe: $!"
|
||
|
:
|
||
|
"wait status $? from pipe"
|
||
|
)
|
||
|
);
|
||
|
exit 21;
|
||
|
}
|
||
|
|
||
|
$last_sent{$key} = $now;
|
||
|
} else {
|
||
|
my_warn("last_sent = $last_sent{$key}, suppressing") if $debug;
|
||
|
}
|
||
|
|
||
|
untie %last_sent;
|
||
|
|
||
|
exit 0;
|
||
|
|
||
|
|
||
|
|
||
|
sub Usage {
|
||
|
my_warn("Usage: $prog [-l] [-D dbm_file] -k key -t throttle_seconds [-f from] -r recipient [-T tie_attempts_max] [-S tie_retry_sleep] [-s subject]");
|
||
|
exit 1;
|
||
|
}
|
||
|
|
||
|
|
||
|
sub my_warn {
|
||
|
# Just a wrapper for warn, but with a possible copy to syslog too.
|
||
|
my $msg = shift;
|
||
|
warn $msg, "\n";
|
||
|
syslog($SYSLOG_PRIORITY, $msg) if $also_syslog;
|
||
|
return;
|
||
|
}
|