#!/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 S<[ B<-h>, B<--help> ]> S<[ B<-M>, B<--man> ]> S<[ B<-V>, B<--version> ]> S<[ B<-d>, B<--debug-level> [I] ]> S<[ B<-L>, B<--logfile> [I] ]> S<[ B<-P>, B<--port> [I] ]> S<[ B<-p>, B<--pidfile> I ]> [I] =head1 DESCRIPTION B enables remote control over a local UPS on a serial device specified by the optional F parameter via TCP/IP using port F. If F is omitted, F, i.e. the COM1 port, is used per default unless overriden by the environment variable F. If the TCP/IP port F is not specified port F<9050> is used unless overriden by the environment variable F. The program listens on F 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 (this screen) using B, B and B 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] Sets the integer debug level I. 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 Sets the logfile to I. If not specified, the default log file F will be used. =item B<-p>, B<--pidfile> I Sets the PID file to I. If not specified, the default PID file F will be used. =item B<-P>, B<--port> I Sets the TCP/IP port I 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. =back =head1 EXAMPLES =over 4 =item B 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 B<-p> I<1200> I 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 <= 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;