#!/usr/bin/perl -w
#==============================================================================
# description:
#------------------------------------------------------------------------------
# Perl script to enable to watch an UPS on a serial device remotely via
# TCP/IP.
#==============================================================================
#==============================================================================
# embedded pod documentation:
#------------------------------------------------------------------------------
=head1 NAME
upsagent - enables remote control over a local UPS on a serial device
=head1 SYNOPSIS
B<upsagent>
S<[ B<-h>, B<--help> ]> S<[ B<-M>, B<--man> ]> S<[ B<-V>, B<--version> ]>
S<[ B<-d>, B<--debug-level> [I<debuglevel>] ]>
S<[ B<-L>, B<--logfile> [I<logfile>] ]>
S<[ B<-P>, B<--port> [I<port>] ]>
S<[ B<-p>, B<--pidfile> I<pidfile> ]>
[I<device-name>]
=head1 DESCRIPTION
B<upsagent> enables remote control over a local UPS on a serial device
specified by the optional F<device-name> parameter via TCP/IP using port
F<port>. If F<device-name> is omitted, F</dev/ttyS0>, i.e. the COM1 port, is
used per default unless overriden by the environment variable F<UPS_PORT>. If
the TCP/IP port F<port> is not specified port F<9050> is used unless overriden
by the environment variable F<UPS_TCPPORT>.
The program listens on F<port> for incoming requests and sends the data
received to the local UPS. The answer of the UPS is sent back.
=head1 OPTIONS
=over 4
=item B<-h>, B<--help>
Displays a short usage help message and exits without errors.
=item B<-M>, B<--man>
Displays the embedded pod documentation of B<upsagent> (this screen) using
B<pod2man>, B<groff> and B<less> as pager; it exits without errors.
=item B<-V>, B<--version>
Displays version information and exits without errors.
=item B<-d>, B<--debug-level> [I<debuglevel>]
Sets the integer debug level I<debuglevel>. If the debug level is not
specified a default of 1 is assumed. A higher debug level will increase the
verbosity.
=item B<-L>, B<--logfile> I<logfile>
Sets the logfile to I<logfile>. If not specified, the default log file
F</var/run/upsagent.log> will be used.
=item B<-p>, B<--pidfile> I<pidfile>
Sets the PID file to I<pidfile>. If not specified, the default PID file
F</var/run/upsagent.pid> will be used.
=item B<-P>, B<--port> I<port>
Sets the TCP/IP port I<port> the programs waits for incoming requests to the
local UPS. If not specified, the default port F<9050> is used unless overriden
by the environment variable F<UPS_TCPPORT>.
=back
=head1 EXAMPLES
=over 4
=item B<upsagent>
Listens on TCP/IP port 9050 for incoming requests and sends them to the local
UPS on COM1. The response of the UPS is sent back.
=item B<upsagent> B<-p> I<1200> I</dev/ttyS1>
Listens on TCP/IP port 1200 for incoming requests and sends them to the local
UPS on COM2. The response of the UPS is sent back.
=back
=head1 SEE ALSO
groff(1),
less(1),
pod2man(1),
upsadm(1),
upsstat(1),
upswatch(1),
Getopt::Long(3pm),
IO::Select(3pm),
IO::Socket::INET(3pm),
Net::hostent(3pm),
Hardware::UPS::Perl::Connection(3pm),
Hardware::UPS::Perl::Connection::Net(3pm),
Hardware::UPS::Perl::Connection::Serial(3pm),
Hardware::UPS::Perl::Constants(3pm),
Hardware::UPS::Perl::Driver(3pm),
Hardware::UPS::Perl::Driver::Megatec(3pm),
Hardware::UPS::Perl::General(3pm),
Hardware::UPS::Perl::Logging(3pm),
Hardware::UPS::Perl::PID(3pm),
Hardware::UPS::Perl::Utils(3pm)
=head1 AUTHOR
Christian Reile, Christian.Reile@t-online.de
=cut
#==============================================================================
# Entries for revision control:
#------------------------------------------------------------------------------
# Revision : $Revision: 1.11 $
# Author : $Author: creile $
# Last Modified On: $Date: 2007/04/17 19:52:44 $
# Status : $State: Exp $
#------------------------------------------------------------------------------
# Modifications :
#------------------------------------------------------------------------------
#
# $Log: upsagent.pl,v $
# Revision 1.11 2007/04/17 19:52:44 creile
# unnecessary comments removed.
#
# Revision 1.10 2007/04/14 16:48:19 creile
# documentation bugfix.
#
# Revision 1.9 2007/04/14 09:37:26 creile
# documentation update.
#
# Revision 1.8 2007/04/07 15:25:20 creile
# adaptations to "best practices" style;
# update of documentation.
#
# Revision 1.7 2007/03/13 17:23:33 creile
# main while() loop revised for readers, writers and out-of-band
# data;
# adaptations to options as anonymous hashes.
#
# Revision 1.6 2007/03/03 21:29:48 creile
# new variable $UPSERROR added;
# adaptations to new Constants.pm.
#
# Revision 1.5 2007/02/25 17:12:15 creile
# connection handling added.
#
# Revision 1.4 2007/02/05 20:49:38 creile
# OO logging (log file) and OO PID files added;
# maximum connections at main socket;
# information about connections added.
#
# Revision 1.3 2007/01/28 05:43:58 creile
# adaptations to new package structure;
# timeout of 0.1s added to call of select();
# protocall change concerning size of response;
# bug fix concerning call of chomp();
# update of pod documentation.
#
# Revision 1.2 2007/01/21 15:07:20 creile
# some beautifications;
# writing/deleting PID file added.
#
# Revision 1.1 2007/01/20 08:22:52 creile
# initial revision
#
#
#==============================================================================
#==============================================================================
# packages required:
#------------------------------------------------------------------------------
#
# Errno - System errno constants
# Getopt::Long - processing options
# IO::Select - OO interface to the select system call
# IO::Socket - Object interface to socket communications
# Net::hostent - by-name interface to Perl's built-in
# gethost*() functions
# strict - restricting unsafe constructs
# Tie::RefHash - use references as hash keys
#
# Hardware::UPS::Perl::Connection - importing a Hardware::UPS::Perl connection
# Hardware::UPS::Perl::Constants - importing Hardware::UPS::Perl constants
# Hardware::UPS::Perl::General - importing Hardware::UPS::Perl variables
# and functions for scripts
# Hardware::UPS::Perl::Logging - importing Hardware::UPS::Perl methods
# dealing with log files
# Hardware::UPS::Perl::PID - importing Hardware::UPS::Perl methods
# dealing with PID files
#
#==============================================================================
use Errno qw(
EWOULDBLOCK
);
use Getopt::Long;
use IO::Select;
use IO::Socket::INET;
use Net::hostent;
use strict;
use Tie::RefHash;
use Hardware::UPS::Perl::Connection;
use Hardware::UPS::Perl::Constants qw(
UPSFQDN
UPSLOGFILE
UPSPIDFILE
UPSPORT
UPSSCRIPT
UPSTCPPORT
);
use Hardware::UPS::Perl::General;
use Hardware::UPS::Perl::Logging;
use Hardware::UPS::Perl::PID;
#==============================================================================
# defining global variables:
#------------------------------------------------------------------------------
#
# $DebugLevel - the debug level
# $Logger - the UPS logging object
# $Pid - the PID file object
# $Port - the actual serial device the UPS is located on
# $TCPPort - the TCP/IP port address
# %ClientInfo - hash containing client information (IP address
# and/or the FQDN)
# %RequestBuffer - hash holding the incoming requests of the clients
# %ResponseBuffer - hash holding the UPS responses for each client
# %HandlingBuffer - hash holding the final requests ready to be sent
# to the UPS
#
#==============================================================================
use vars qw(
$DebugLevel
$Logger
$Port
$Pid
$TCPPort
%ClientInfo
%RequestBuffer
%ResponseBuffer
%HandlingBuffer
);
#==============================================================================
# defining subroutines:
#==============================================================================
sub Init {
# subroutine for initializing the working environment
# initializing the working environment
InitWE();
# revision number
use constant REVISION_VERSION => sprintf(
"%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/
);
# revison date
use constant REVISION_DATE => sprintf(
"%d/%02d/%02d", q$Date: 2007/04/17 19:52:44 $ =~ /(\d+)\/(\d+)\/(\d+)/
);
# initializing buffers
%ClientInfo = ();
%RequestBuffer = ();
%ResponseBuffer = ();
%HandlingBuffer = ();
tie %ClientInfo , 'Tie::RefHash';
tie %RequestBuffer , 'Tie::RefHash';
tie %ResponseBuffer, 'Tie::RefHash';
tie %HandlingBuffer, 'Tie::RefHash';
# setting the timeout
use constant TIMEOUT => 0.1;
} # end of subroutine "Init"
sub GetParameters {
# subroutine for getting and checking options
# hidden local variables
my $debugLevel; # switch to specify the debug level
my $tcpPort; # switch to specify the TCP/IP port to listen to
my $logFile; # switch to specify the log file
my $pidFile; # switch to specify the PID file
my $help; # switch for displaying usage help
my $manpage; # switch for displaying man page
my $version; # switch for displaying version information
my $return; # returning error
# configuring subroutine `GetOptions': case sensitivity
&Getopt::Long::config("no_ignore_case");
# getting options
$return = GetOptions(
"debug-level|d:i" => \$debugLevel ,
"logfile|L=s" => \$logFile ,
"pidfile|p=s" => \$pidFile ,
"port|P=i" => \$tcpPort ,
"help|h" => \$help ,
"man|M" => \$manpage ,
"version|V" => \$version ,
);
# checking all options
Usage(1) if ( ! $return );
# displaying usage help and exit without errors
Usage(0) if ( $help );
# displaying man page and exit without errors
ManPage() if ( $manpage );
# displaying version information and exit without errors
if ( $version ) {
Version(
REVISION_VERSION,
REVISION_DATE,
"enables remote control over a local UPS on a serial device"
);
}
# checking individual options
#
# setting the debug level
if ( defined($debugLevel) ) {
$DebugLevel = $debugLevel ? $debugLevel : 1;
}
else {
$DebugLevel = 0;
}
# setting the TCP/IP port
$TCPPort = $tcpPort ? $tcpPort : UPSTCPPORT;
# setting the serial port
$Port = $ARGV[0] ? $ARGV[0] : UPSPORT;
# opening the log file
if ($logFile) {
$Logger = Hardware::UPS::Perl::Logging->new({
File => $logFile ,
Scheme => "daily" ,
});
}
else {
$Logger = Hardware::UPS::Perl::Logging->new({
File => UPSLOGFILE,
Scheme => "daily" ,
});
}
if (!defined $Logger) {
Error("creating logger failed -- $UPSERROR");
}
SetLogger($Logger);
# writing the PID file
if ($pidFile) {
$Pid = Hardware::UPS::Perl::PID->new({
PIDFile => $pidFile ,
Logger => $Logger ,
});
}
else {
$Pid = Hardware::UPS::Perl::PID->new({
PIDFile => UPSPIDFILE,
Logger => $Logger ,
});
}
unless (defined $Pid) {
$Logger->fatal("PID file creation failed -- $UPSERROR");
}
SetPID($Pid);
} # end of subroutine "GetParameters"
sub Usage {
# subroutine for displaying a short usage help and exiting, if
# $exitStatus >= 0;
#
# parameters: $exitStatus (input) - status on exit
# input as hidden local variable
my $exitStatus = shift;
# displaying short usage help on STDOUT
print <<EOF;
Usage: ${\(UPSSCRIPT)} [options] [device-name]
Argument:
device-name the (optional) serial device name
[${\(UPSPORT)}]
Options:
-h, --help Displays this help message.
-M, --man Displays the man page of "${\(UPSSCRIPT)}".
-V, --version Displays version information.
-d, --debug-level [debuglevel] sets the optional debug level
debuglevel [debuglevel=1].
-L, --logfile [logfile] sets the log file to logfile
[logfile=${\(UPSLOGFILE)}.YYYY-MM-DD.x]
-p, --pidfile pidfile sets the PID file to be used to pidfile
[pidfile=/var/run/${\(UPSPIDFILE)}].
-P, --port port sets the TCP/IP port to listen to for
incoming requests [port=${\(UPSTCPPORT)}].
EOF
# exiting, if $exitStatus >= 0
exit $exitStatus;
} # end of subroutine "Usage"
#==============================================================================
# start of main body:
#==============================================================================
# hidden local variables
my $connection; # the connection object to local UPS
my $serverSocket; # the server socket
my $clientSocket; # a client socket
my $selectObject; # the select object
my $request; # the request buffer
my $command; # the command to be sent to the UPS
my $response; # the response
my $responseSize; # the size of the response buffer
my $return; # the number of bytes received or sent
my $clientInfo; # temporary client info
# initializing of working environment
Init();
# getting options
GetParameters();
# connecting to the local UPS
$connection = Hardware::UPS::Perl::Connection->new({
Type => "serial",
Options => {
SerialPort => $Port,
},
Logger => $Logger,
});
if (!defined $connection) {
$Logger->fatal("serial connection to $Port failed -- $UPSERROR");
}
$connection->getConnectionHandle()->setDebugLevel($DebugLevel);
# opening a listening socket
$serverSocket = new IO::Socket::INET (
LocalHost => UPSFQDN ,
LocalPort => $TCPPort ,
Listen => SOMAXCONN,
Proto => "tcp" ,
ReuseAddr => 1 ,
Blocking => 0 ,
);
if (!defined $serverSocket) {
$Logger->fatal("unable to create server socket -- $!");
}
$selectObject = IO::Select->new($serverSocket)
or $Logger->fatal("unable to create select object -- $!");
##### loops here until killed #####
RUN:
while (1) {
# reading
READING_CLIENT:
foreach $clientSocket ($selectObject->can_read(TIMEOUT)) {
if ($clientSocket == $serverSocket) {
# new connection
my $newClientSocket = $serverSocket->accept();
my $hostinfo = gethostbyaddr($newClientSocket->peeraddr());
my $hostaddr = $newClientSocket->peerhost();
$clientInfo = $hostinfo
? $hostinfo->name().q{ (}.$hostaddr.q{)}
: $hostaddr
;
$Logger->info("connection received from ".$clientInfo);
$ClientInfo{$newClientSocket} = $clientInfo;
$selectObject->add($newClientSocket);
# setting non-blocking mode to socket
$newClientSocket->blocking(0);
}
else {
# reading data
$request = q{};
$return = $clientSocket->recv($request, 1024, 0);
if (defined $return and length($request)) {
$RequestBuffer{$clientSocket} .= $request;
if ($RequestBuffer{$clientSocket} =~ s/(.*)\n//) {
$HandlingBuffer{$clientSocket} = $1;
}
}
else {
# end of receive, closing client
$clientInfo = delete $ClientInfo{$clientSocket};
$Logger->info("connection to $clientInfo closed");
delete $RequestBuffer{$clientSocket};
delete $ResponseBuffer{$clientSocket};
delete $HandlingBuffer{$clientSocket};
$selectObject->remove($clientSocket);
$clientSocket->close();
next READING_CLIENT;
}
}
}
# handling requests
HANDLING:
foreach $clientSocket (keys %HandlingBuffer) {
$request = delete $HandlingBuffer{$clientSocket};
($command, $responseSize) = split(//, $request);
$response = q{};
if (!$connection->sendCommand($command, \$response, $responseSize)) {
$Logger->error(
"sending command <$command> failed -- ".$connection->getErrorMessage()
);
}
chomp($response);
if ($DebugLevel > 0) {
$Logger->debug("command <$command> => response: <$response>");
}
$ResponseBuffer{$clientSocket} = $response . "\n";
}
# sending responses back
WRITING_CLIENT:
foreach $clientSocket ($selectObject->can_write(TIMEOUT)) {
# skipping client without response
next WRITING_CLIENT if (!exists $ResponseBuffer{$clientSocket});
# sending response
$response = $ResponseBuffer{$clientSocket};
$return = $clientSocket->send($response, 0);
if (!defined $return) {
$Logger->error("could not deliver message -- $!");
next WRITING_CLIENT;
}
my $responseSize = length($response);
if ($responseSize == $return || EWOULDBLOCK == $!) {
substr($ResponseBuffer{$clientSocket}, 0, $return) = q{};
if (!$responseSize) {
delete $ResponseBuffer{$clientSocket}
}
}
else {
# closing connection
$clientInfo = delete $ClientInfo{$clientSocket};
$Logger->info("connection to $clientInfo closed");
delete $RequestBuffer{$clientSocket};
delete $ResponseBuffer{$clientSocket};
delete $HandlingBuffer{$clientSocket};
$selectObject->remove($clientSocket);
$clientSocket->close();
next WRITING_CLIENT;
}
}
# handling out of band data
OUT_OF_BAND:
foreach $clientSocket ($selectObject->has_exception(0)) {
$Logger->error(
"out of band data for connection to host ".$ClientInfo{$clientSocket}
);
}
}
# exiting
exit 0;