#!/usr/bin/perl use strict; use warnings; use Net::EasyTCP; use constant LOG_DIR => '/tmp'; use constant LOG_FILE => 'daemon.log'; use constant PIDDIR => LOG_DIR; use Proc::PID_File; use Proc::Daemon; use Log::Dispatch; use Log::Dispatch::File; use Date::Format; use File::Spec; sub dienice ($); our $ME = $0; $ME =~ s|.*/||; our $PIDFILE = PIDDIR."/$ME.pid"; startDaemon(); our $HOSTNAME = `hostname`; chomp $HOSTNAME; my $log = new Log::Dispatch( callbacks => sub { my %h=@_; return Date::Format::time2str('%B %e %T', time)." ".$HOSTNAME." $0\[$$]: ".$h{message}."\n"; } ); $log->add( Log::Dispatch::File->new( name => 'file1', min_level => 'warning', mode => 'append', filename => File::Spec->catfile(LOG_DIR, LOG_FILE), ) ); $log->warning("Starting Processing: ".time() ); my $daemon_path = $0; my $perl_path; open(SOURCE, $daemon_path); =~ /^#!(\S+)/; $perl_path = $1; close(SOURCE); if (!-x $perl_path) { $perl_path = $^X; } my @daemon_argv = @ARGV; my $server; $server = Net::EasyTCP->new( mode => "server", port => 12345, ) || die "ERROR CREATING SERVER: $@\n"; $server->setcallback( data => \&gotdata, connect => \&connected, disconnect => \&disconnected ) || die "ERROR SETTING CALLBACKS: $@\n"; $log->warning('Server starting...'); $server->start() || die "ERROR STARTING SERVER: $@\n"; $log->warning('Server has stopped - we need to restart!'); &restart_daemon; #------------------------------------------------------------------------------ # sub gotdata #------------------------------------------------------------------------------ sub gotdata { my $client = shift; my $serial = $client->serial(); my $data = $client->data(); $log->warning( "Client sent data: $data" ); if( $data eq "HUP" ){ $server->stop(); $log->warning( 'Server sent HUP by client!' ); } } #------------------------------------------------------------------------------ # sub connected #------------------------------------------------------------------------------ sub connected { my $client = shift; my $serial = $client->serial(); $log->warning( "Client $serial just connected." ); } #------------------------------------------------------------------------------ # sub disconnected #------------------------------------------------------------------------------ sub disconnected { my $client = shift; my $serial = $client->serial(); $log->warning( "Client $serial just disconnected." ); } #------------------------------------------------------------------------------ # sub restart_daemon #------------------------------------------------------------------------------ sub restart_daemon { $log->warning( "RESTART: $perl_path, $daemon_path, @daemon_argv" ); release_the_pid_file(); exec($perl_path, $daemon_path, @daemon_argv) || $log->warning("EXEC failed: $! $? $@"); die "Failed to restart daemon"; } #------------------------------------------------------------------------------ # sub restart_daemon #------------------------------------------------------------------------------ sub startDaemon { eval { Proc::Daemon::Init; }; dienice("Unable to start daemon: $@") if $@; dienice("Already running!") if hold_pid_file($PIDFILE); } #------------------------------------------------------------------------------ # sub dienice #------------------------------------------------------------------------------ sub dienice ($) { my ($package, $filename, $line) = caller; $log->critical("$_[0] at line $line in $filename"); die $_[0]; } __END__