Any-Daemon

 view release on metacpan or  search on metacpan

examples/net.pl  view on Meta::CPAN

my $daemon = Any::Daemon->new(%os_opts);

$daemon->run
  ( child_task => \&run_task
  , %run_opts
  );

exit 1;   # will never be called

sub run_task()
{
    while(my $client = $socket->accept)
    {   info __x"new client {host}", host => $client->peerhost;
        my $line = <$client>;
        chomp $line;
        info __x"received {line}", line => $line;
        $client->print(scalar(reverse $line), "\n");
        $client->close;
    }

lib/Any/Daemon.pm  view on Meta::CPAN

use constant
  { SLEEP_FOR_SOME_TIME   =>  10
  , ERROR_RECOVERY_SLEEP  =>   5
  , SLOW_WARN_AGAIN_AFTER => 300
  };

# One program can only run one daemon
my %childs;


sub new(@) {my $class = shift; (bless {}, $class)->init({@_})}

sub init($)
{   my ($self, $args) = @_;
    $self->{AD_pidfn} = $args->{pid_file};

    my $user = $args->{user};
    if(defined $user)
    {   if($user =~ m/[^0-9]/)
        {   my $uid = $self->{AD_uid} = getpwnam $user;
            defined $uid
                or error __x"user {name} does not exist", name => $user;
        }

lib/Any/Daemon.pm  view on Meta::CPAN

                or error __x"group {name} does not exist", name => $group;
        }
    }

    $self->{AD_wd} = $args->{workdir};
    $self;
}

#--------------------

sub workdir() {shift->{AD_wd}}
sub pidFilename() { shift->{AD_pidfn} }

#--------------------

sub _mkcall($)
{   return $_[1] if ref $_[1] eq 'CODE';
    my ($self, $what) = @_;
    sub { $self->$what(@_) };
}

sub run(@)
{   my ($self, %args) = @_;

    my $wd = $self->workdir;
    if($wd)
    {   -d $wd or mkdir $wd, 0700
            or fault __x"cannot create working directory {dir}", dir => $wd;

        chdir $wd
            or fault __x"cannot change to working directory {dir}", dir => $wd;
    }

lib/Any/Daemon.pm  view on Meta::CPAN

        open STDIN,  '<', File::Spec->devnull;
        open STDOUT, '>', File::Spec->devnull;
        open STDERR, '>', File::Spec->devnull;
    }

    if($child_task)
         { $self->_run_with_childs($child_task, %args) }
    else { $self->_run_without_childs($own_task, %args) }
}

sub _run_with_childs($%) {
    my ($self, $child_task, %args) = @_;
    my $reconfig    = $self->_mkcall($args{reconfig}    || 'reconfigDaemon');
    my $kill_childs = $self->_mkcall($args{kill_childs} || 'killChilds');
    my $child_died  = $self->_mkcall($args{child_died}  || 'childDied');
    my $max_childs  = $args{max_childs}  || 10;

    my $run_child   = sub
      { # re-seed the random number sequence per process
        srand(time+$$);

lib/Any/Daemon.pm  view on Meta::CPAN

    notice __x"daemon started; proc={proc} uid={uid} gid={gid} childs={max}"
      , proc => $PID, uid => $EUID, gid => $EGID, max => $max_childs;

    $child_died->($max_childs, $run_child);

    # child manager will never die
    sleep 60 while 1;
}

sub _run_without_childs($%) {
    my ($self, $run_task, %args) = @_;
    my $reconfig    = $self->_mkcall($args{reconfig}    || 'reconfigDaemon');

    # unhandled errors are to be treated seriously.
    my $rc = try { $run_task->(@_) };
    if(my $e = $@->wasFatal) { $e->throw(reason => 'ALERT'); $rc = 1 }

    $SIG{HUP}  = sub
      { notice "daemon received signal HUP";
        $reconfig->(keys %childs);

lib/Any/Daemon.pm  view on Meta::CPAN

        my $intrnr = $signal eq 'INT' ? 2 : 9;
        exit $intrnr+128;
      };

    notice __x"daemon started; proc={proc} uid={uid} gid={gid}"
      , proc => $PID, uid => $EUID, gid => $EGID;

    $run_task->();
}

sub reconfigDaemon(@)
{   my ($self, @childs) = @_;
    notice "HUP: reconfigure deamon not implemented";
}

sub killChilds(@)
{   my ($self, @childs) = @_;
    @childs or return;

    notice "killing ".@childs." children";
    kill TERM => @childs;
}

# standard implementation for starting new childs.
sub childDied($$)
{   my ($self, $max_childs, $run_child) = @_;

    # Clean-up zombies

  ZOMBIE:
    while(1)
    {   my $kid = waitpid -1, WNOHANG;
        last ZOMBIE if $kid <= 0;

        if($? != 0)