Preventing flooding in Perl

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 thought on “Preventing flooding in Perl”

  1. 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) {
    printf "%s: too few arguments\n", $0;
    printf "Usage: %s \n", $0;
    print " must be given as 00491721234567\n";
    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!

Leave a Reply

Your email address will not be published. Required fields are marked *