perl

Squelching SMS floods from Nagios being sent via a third party SMS provider

So at work they implemented some 'SMS Squelching' methods to interact with a 'mail > sms' gnokii script to try and 'squelch' megaloads of SMSs that come through from Nagios all at once. It's a bunch of perl and very much specific to working with a serial-attached Nokia and gnokii. The way it essentially worked was that if an SMS got queued to mail2smsgnokii/gsm's spool, the timestamp was compared with the last sms that got sent and if the length of time in between SMS was inside a threshold (say 30 minutes), the SMS would not be sent.

Nagios website regex pattern check

Here's a simple perl script that uses curl to search for a regex pattern on a website.

It returns status values that are Nagios compatible. This means you can write a command definition for Nagios that looks like this:

# regex check
define command{
        command_name    check_regex
        command_line    /usr/lib/nagios/plugins/check_regex $ARG1$ $ARG2$
}

And write a couple of service definitions like this:

define service {
        host_name                       foo
        service_description           foo regex

Perl script to send e-mail

#!/bin/perl
 
# Build an array of e-mail addresses to be Bcc'd to
my @bcc_addresses = (
'foo@bar.com',
'foo@bar2.com');
 
# The main recipient
my $to='foofoo@bar.com';
 
# Join the bcc addresses from the array, separate with comma
my $bcc = join(", ", @bcc_addresses);
 
# Where it's coming from
my $from='miguel@foobar.com';
 
# e-mail Subject 
my $subject="Perl mail example";
 
# The e-mail content follows
my $out = "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. 
Nullam vestibulum dictum lectus. 
Etiam at sapien. Donec fermentum dictum nisi. In ornare adipiscing massa.";
 
 
# Now let's fire up sendmail and push the data into it, then send
open(MAIL, "|/usr/sbin/sendmail -t");
print MAIL "To: $to\n";
print MAIL "Bcc: $bcc\n";
print MAIL "From: $from\n";
print MAIL "Subject: $subject\n";
print MAIL $out;
 
close(MAIL);

Perl script to check website with regex, alert if failure

Wrote this script today using the WWW::Curl::Easy example.

Background: Recently eaccelerator screwed up a dev server so that while Apache didn't die, php scripts weren't parsing, and I got no alerts.

This script parses a php script using curl, which contains a basic 'hello()' function that prints hello out.

The perl script checks the output for 'hello' and if it doesn't find it, it sends me an e-mail (it also sends me an SMS using our Clickatell account, but I'm not giving you the credentials, silly.)

#!/usr/bin/perl
#
# Checks a php script using curl and if there is a
# problem, e-mail me
#
use strict;
use WWW::Curl::Easy;
my $url = "http://localhost/test.php";
# Init the curl session
my $curl= WWW::Curl::Easy->new() or die "curl init failed!\n";
# Give curl the URL to use
$curl->setopt(CURLOPT_URL, $url);
# a subroutine which is called for each 'chunk' as the
# file is received.
sub body_callback {
    my ($chunk,$context)=@_;
    # add the chunk we received to the end of the array we've been given
    push @{$context}, $chunk;
    return length($chunk); # OK
}
# configure which subroutine to call when some data comes in
$curl->setopt(CURLOPT_WRITEFUNCTION, \&body_callback);
my @body;
# tell the subroutine which array to put the data into
$curl->setopt(CURLOPT_FILE, \@body);
if ($curl->perform() != 0) {
    print "Failed ::".$curl->errbuf."\n";
};
my $output = join("",@body);
# Check if we got 'hello' out of the php script. If we did, ignore it
if ($output=~ m/hello/i) {
}
else {
        #sms me, incidentally this is done with curl too, so I create another instance of WWW::Curl::Easy
        my $alert_url = "http://the-clickatell-api-command-to-sms-me";
        my $curl_alert= WWW::Curl::Easy->new() or die "curl init failed!\n";
        $curl_alert->setopt(CURLOPT_URL, $alert_url);
        $curl_alert->setopt(CURLOPT_WRITEFUNCTION, \&body_callback);
        $curl_alert->setopt(CURLOPT_FILE, \@body);
        if ($curl_alert->perform() != 0) {
            print "Failed ::".$curl_alert->errbuf."\n";
        };
        # send me an e-mail now, using Sendmail
        unless(open (MAIL, "|/usr/sbin/sendmail -t")) {
                print "error.\n";
                warn "Error starting sendmail: $!";
        }
        else {
                print MAIL "From: web\@the-server.com\n";
                print MAIL "To: miguel\@example.com\n";
                print MAIL "Subject: PHP problem on the server\n\n";
                print MAIL "The server has stopped parsing php! Panic! Panic!";
                close(MAIL) || warn "Error closing mail: $!";
        }
}

Parsing HTML table into Excel spreadsheet

This script fetches a HTML page from the internet and parses the tables it finds in it, into an Excel spreadsheet.
This has been used for grabbing an AWstats index.html summary of sites and their bandwidth, and then parsing to Excel so one can tally up totals.

It's not perfect - I haven't used it in a while but from memory, it overwrites some rows due to being poorly coded :)

When the time comes that I need to use this again, I'll have another look at it.

#!/usr/bin/perl -w
use Spreadsheet::WriteExcel;
use HTML::TableExtract;
use LWP::Simple;
# Create a Table extraction
my $te = new HTML::TableExtract(gridmap=>1);
# Get the table out of my stats page
my $content = get("http://localhost/stats/index.html");
# Pass the data out of the table
$te->parse($content);
# Create a new Excel workbook
my $workbook = Spreadsheet::WriteExcel->new("totals.xls");
# Add a worksheet
my $worksheet = $workbook->add_worksheet();
# For each table, dump its parsed table rows into the worksheet
for my $ts ($te->table(1,0))
{
     foreach my $row ($ts->rows)
     {
         $worksheet->write(0,0, $row, @{$row});
     }
}
 
for my $ts ($te->table(1,1))
{
     foreach my $row ($ts->rows)
     {
         $worksheet->write(1,0, $row, @{$row});
     }
}
 
# Now add up the Total bandwidth
$worksheet->write_formula(2, 3, '=SUM(D1:D2)/1000000' );
#worksheet->write_formula(2, 3, '=SUM(D3/1000000)');

This site is archived. mig5 is taking a break from writing.