perlquestion
graq
<p>Esteemed monks!</p>
<p>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.</p>
<p>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.</p>
<readmore>
<p>The server</p>
<code>
#!/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);
<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__
</code>
</readmore>
<p>And the 'hupping' client</p>
<readmore>
<code>
#!/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 CLIENT2: $@\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__
</code>
</readmore>
<p>Something somewhere is stopping this from restarting itself, and I cannot, for whatever reason, see it:
<code>
>perl client_hup.pl
HUP Done
ERROR CREATING CLIENT2: Could not connect to localhost:12345: Connection refused
</code>
<p><i>EDIT</i><br>Server output:</p>
<code>
February 14 15:26:21 localhost easy_daemon.pl[32293]: Starting Processing: 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 connected.
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 stopped - we need to restart!
February 14 15:32:43 localhost easy_daemon.pl[32293]: RESTART: /usr/bin/perl, easy_daemon.pl,
</code>
<div class="pmsig"><div class="pmsig-79379">
<p>-=( <a href="http://www.graq.co.uk">Graq</a> )=-</p>
</div></div>