Any-Daemon

 view release on metacpan or  search on metacpan

ChangeLog  view on Meta::CPAN

	- use Unix::SaveIDs to set the user, because you want the
	  saved-uid to be changed as well. [Andrew Beverley]
	- fix: start of more than one child was broken: loop line
	  misteriously lost from the source. Fixed by [Andrew Beverley]

version 0.12: Mon Apr 18 13:55:23 CEST 2011
	- panic when the child dies with run-time program errors.
	- added example

version 0.11: Mon Mar 21 16:46:45 CET 2011
	- use $EUID and $EGID to change user/group, not setuid/setgid
	- change EUID only after changing EGID
	- create workdir after changing ids
	- create pidfile before changing ids
	- added generic start-stop script to distribution
	- fix when uid==0 and gid==0

version 0.10: Wed Jan 26 16:22:26 CET 2011
	- initial released version, based on various own implementations
	  in active duty.

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

package Any::Daemon;
use vars '$VERSION';
$VERSION = '0.96';


use warnings;
use strict;

use Log::Report::Optional  'any-daemon';

use POSIX         qw(setsid setuid setgid :sys_wait_h);
use English       qw/$EUID $EGID $PID/;
use File::Spec    ();

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

# One program can only run one daemon

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

        }
        else { $self->{AD_uid} = $user }
    }
    elsif($EUID==0)
    {   warning __"running daemon as root is dangerous: please specify user";
    }

    my $group = $args->{group};
    if(defined $group)
    {   if($group =~ m/[^0-9]/)
        {   my $gid = $self->{AD_gid} = getgrnam $group;
            defined $gid
                or error __x"group {name} does not exist", name => $group;
        }
    }

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

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

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

    my $pidfn = $self->pidFilename;
    if(defined $pidfn)
    {   local *PIDF;
        if(open PIDF, '>', $pidfn)
        {   print PIDF "$PID\n";
            close PIDF;
        }
    }

    my $gid = $self->{AD_gid} || $EGID;
    my $uid = $self->{AD_uid} || $EUID;

    chown $uid,$gid, $wd if $wd;   # don't check success: user may have plan

    if($gid != $EGID)
    {   if($] > 5.015007)
        {   setgid $gid or fault __x"cannot change to group {gid}", gid => $gid;
        }
        else   # in old versions of Perl, the uid and gid gets cached
        {   eval { $EGID = $gid };
            $@ and error __x"cannot switch to group {gid}: {err}"
               , gid => $gid, err => $@;
        }
    }

    if($uid != $EUID)
    {   if($] > 5.015007)
        {   setuid $uid or fault __x"cannot change to user {uid}", uid => $uid;
        }
        else
        {   eval { $EUID = $uid };
            $@ and error __x"cannot switch to user {uid}: {err}"

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

        sleep 2;         # give childs some time to stop
        kill TERM => 0;  # terminate the whole process group

        my $pidfn = $self->pidFilename;
        unlink $pidfn if $pidfn;

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

    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');

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

      { my $signal = shift;
        notice "daemon terminated by signal $signal";

        my $pidfn = $self->pidFilename;
        unlink $pidfn if $pidfn;

        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(@)