Esteemed monks!
I am running a small TCP daemon that needs to be able to kick-start itself from a client connection. I.e. it is possible for the client to send data that should cause the whole script to restart itself.
I have scavenged around, and grabbed code from some of the nodes down these branches: 131572 and 529604. From those I have managed to replicate my same original problem.
The server
#!/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)." ".$HOSTN
+AME." $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);
<SOURCE> =~ /^#!(\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__
And the 'hupping' client
#!/usr/bin/perl
use strict;
use warnings;
use Net::EasyTCP;
my $host = $ARGV[0] || 'localhost';
my %client = (
mode => "client",
host => $host,
port => 12345,
);
my $client = Net::EasyTCP->new(%client) || die "ERROR CREATING CLIENT:
+ $@\n";
$client->send('HUP') || die "ERROR SENDING: $@\n";
print "HUP Done\n";
sleep 3;
my $client2 = Net::EasyTCP->new(%client) || die "ERROR CREATING CLIENT
+2: $@\n";
$client2->send('TEST') || die "ERROR SENDING: $@\n";
print "OK..\n";
my $reply = $client2->receive() || die "ERROR RECEIVING: $@\n";
print "reply: $reply\n";
$client->close();
__END__
Something somewhere is stopping this from restarting itself, and I cannot, for whatever reason, see it:
>perl client_hup.pl
HUP Done
ERROR CREATING CLIENT2: Could not connect to localhost:12345: Connecti
+on refused
EDIT
Server output:
February 14 15:26:21 localhost easy_daemon.pl[32293]: Starting Process
+ing: 1203002781
February 14 15:26:21 localhost easy_daemon.pl[32293]: Server starting.
+..
February 14 15:32:43 localhost easy_daemon.pl[32293]: Client 1 just co
+nnected.
February 14 15:32:43 localhost easy_daemon.pl[32293]: Client sent data
+: HUP
February 14 15:32:43 localhost easy_daemon.pl[32293]: Server sent HUP
+by client!
February 14 15:32:43 localhost easy_daemon.pl[32293]: Server has stopp
+ed - we need to restart!
February 14 15:32:43 localhost easy_daemon.pl[32293]: RESTART: /usr/bi
+n/perl, easy_daemon.pl,
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.