#!/usr/bin/perl -w
# ==========================================================================
# Copyright (C) 2005, Guy Antony Halse, All Rights Reserved.
# Please send bug reports and comments to guy-japh@rucus.net
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are
# met: 
#
# Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# Redistributions in binary form must reproduce the above copyright notice,
# this list of conditions and the following disclaimer in the documentation
# and/or other materials provided with the distribution.
#
# Neither name Guy Antony Halse nor the names of any contributors
# may be used to endorse or promote products derived from this software
# without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
# IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
# PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
#
# ==========================================================================
use strict;
use IO::Socket;
use IO::Select;

# config
my $pollinterval = 15;
my $debug = 3;
my $ups = 'upsname@upshost.example.net';
my $timeout = 10;
my $notify = 'SEND';
my $shutdown = 'DOWN -f';

# initialise things
my ($onbatt, $lowbatt, $lostconn) = (0, 0, 0);
my (%upsstatus) = ();
sub getupsstatus ($);
sub debug($;$);

# not sure if this is really necessary
open PID, ">/tmp/posixnut.pid";
print PID "$$\n";
close PID;

# or if this actually does anything
$0 = 'Network UPS Tool Monitor';

# main loop
while (1) {

  # talk to mr ups
  my $status = getupsstatus($ups);
  my $thispollinterval = $pollinterval;

  unless (defined ($status) and $status) {
    # something bad happened
    
    if (!$lostconn) {
      $lostconn++;  
      debug("Lost communication with UPS", 1);
    }
  
  } else {
  
    # fail states
    if ($status =~ m/FSD/) {
      # we should be shutting down
      debug("UPS tells us we should switch off at", 1);
      if (defined($shutdown) and $shutdown) {
        system("$notify \"Total power failure is imminent. System shuting down immediately.\"") if defined($notify) and $notify;
        system($shutdown);
        exit;
      }
    }

    # transitions
    if ($status =~ m/OB/ and not $onbatt) {
      # we've just gone on battery
      $onbatt++;
      debug("UPS went on battery", 1);
      system("$notify \"Mains power has failed, system running on standby batteries.\"") if defined($notify) and $notify;
    } elsif ($status =~ m/OL/ and $onbatt) {
      # we've just come off battery
      $onbatt = 0;
      debug("UPS went off battery", 1);
      system("$notify \"Mains power has been restored.\"") if defined($notify) and $notify;
    }
    if ($status =~ m/LB/ and not $lowbatt) {
      # we've just gone low battery;
      $lowbatt++;
      debug("UPS went low battery", 1);
      system("$notify \"Standby batteries are almost flat.  System will shutdown shortly.\"") if defined($notify) and $notify;
    } elsif ($status !~ m/LB/ and $status !~ m/FSD/ and $lowbatt) {
      # we've just gone off low battery;
      $lowbatt = 0;
      debug("UPS went off low battery", 1);
      system("$notify \"Standby batteries have recovered.\"") if defined($notify) and $notify;
    }

    if ($lostconn) {
      $lostconn = 0;
      debug("Communication with UPS restored", 1);
    }

    # poll more frequently on battery
    $thispollinterval = $pollinterval/2 if ($status =~ m/OB/);

  }
  
  sleep $pollinterval;
}


sub getupsstatus ($) {
  my ($name, $host) = split /\@/, shift;
  my ($return);

  # try to establish a connection to the UPS 
  unless (exists($upsstatus{$host}) and defined ($upsstatus{$host}) and $upsstatus{$host}->connected()) {
    debug("Connecting to $host", 2);
    $upsstatus{$host} = IO::Socket::INET->new(PeerAddr => $host, PeerPort => 3493, Proto => 'tcp');
    return undef unless defined ($upsstatus{$host});
    $upsstatus{$host}->autoflush(1);
    $upsstatus{$host}->timeout(10);
  }

  debug("Polling $name\@$host", 2);
  my ($select) = IO::Select->new($upsstatus{$host});

  # send a command to the UPS
  IO::Select->select(undef, $select, $select, $timeout);
  $upsstatus{$host}->print("GET VAR $name ups.status\r\n");

  # get the response 
  IO::Select->select($select, undef, $select, $timeout);
  $return = $upsstatus{$host}->getline();

  # return the response to the main loop
  debug("Poll returned: " . (defined($return) ? $return  : "UNKNOWN"), 2);
  if (defined($return) and $return =~ m/^VAR\s+$name\s+ups.status\s+\"?([^"]+)\"?\s*$/) {
    return $1;
  } else {
    return undef;
  } 
}

sub debug ($;$) {
  my $msg = shift;
  my $level = shift || 0;
  chomp($msg);

  if ($debug & $level) {
    print STDERR time() . " " . $msg . "\n";
  }
}