I’m using a small Perl script to send SMS for Nagios notifications. Up to now I didn’t have any flood control (i. e. logic that limits the rate of messages to be sent) built into the script, which made me feel bad (especially since I had already been SMS-bombed a while ago when the link to the servers to be monitored broke down).
My search for some Perl sample code that implements flood control led me to an article on Perl.com and the CPAN Perl package Algorithm::FloodControl, which does exactly what I need and which is easy to use at the same time. I very much recommend this package.
One reply on “Preventing flooding in Perl”
Since I was asked for the script here it is (download it here)…
#!/usr/bin/perl -w
use strict;
use URI::Escape;
use POSIX qw(strftime);
use Storable qw( store retrieve );
use LockFile::Simple qw( lock unlock );
use Algorithm::FloodControl;
if (@ARGV != 2) { \n", $0; must be given as 00491721234567\n";
printf "%s: too few arguments\n", $0;
printf "Usage: %s
print "
exit 1;
}
# this is the file that should keep the flood data though /tmp is not
# the perfect place for it
my $flood_file = "/var/lib/sendsms/flood.dat";
# first of all--lock the flood file
lock($flood_file);
# now read the flood data if flood file exists
my $FLOOD = retrieve($flood_file) if -r $flood_file;
# load flood data into the internal storage
flood_storage($FLOOD) if $FLOOD;
# do the actual flood check: max 3 times per minute, 10 times per hour,
# 20 times per day
my $wait1 = flood_check(3, 60, "MIN");
my $wait2 = flood_check(10, 3600, "HR");
my $wait3 = flood_check(20, 86400, "DAY");
# save the internal data back to the disk
my $save_umask = umask(0000);
store(flood_storage(), $flood_file);
umask($save_umask);
# and finally unlock the file
unlock( $flood_file );
if($wait1 || $wait2 || $wait3) {
# report flood situation
my $max = ($wait1 > $wait2 ? $wait1 : $wait2);
$max = ($max > $wait3 ? $max : $wait3);
print "You have to wait $max seconds before trying again.\n";
exit(1);
}
# there is no flood, continue with the real work here
(my $msisdn, my $text) = @ARGV;
my $esc_text = uri_escape($text);
my $res = qx(/usr/bin/curl -s 'http://smshost.example.org/sms/cgi-bin/sendsms?username=johndoe&password=thePass&to=$msisdn&text=$esc_text&from=491727654321');
my $now = strftime "%Y-%m-%d %H:%M:%S", localtime;
open LOG, ">>/var/log/sendsms.log" or die "can't open logfile: $!";
print LOG "$now MSISDN=$msisdn, text=$esc_text, result=$res\n";
close LOG;
Hope it helps!