1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
|
#!/usr/local/bin/perl5
# $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 = '/usr/local/lib/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;
}
|
