#!/usr/bin/env perl use FindBin; use lib "$FindBin::Bin/../lib"; use App::Netdisco; use Dancer qw/:moose :script/; use Dancer::Plugin::DBIC 'schema'; use Daemon::Generic::While1; use Parallel::Prefork; use Net::Domain 'hostfqdn'; use Role::Tiny; use Try::Tiny; # Parallel::Prefork instance my $pp = undef; # track worker pids and their roles my %workers = (); my $next_role = undef; # must come after globals initialization newdaemon( progname => 'netdisco-daemon', ($> != 0 ? (pidbase => './') : ()), logpriority => 'daemon.info', ); sub gd_preconfig { my $gd = shift; # used for locking jobs in central Pg queue $gd->{nd_host} = hostfqdn; set(daemon_pollers => 2) if !defined setting('daemon_pollers'); set(daemon_interactives => 2) if !defined setting('daemon_interactives'); # need to do this after setting defaults $pp = Parallel::Prefork->new( max_workers => (1 + setting('daemon_pollers') + setting('daemon_interactives')), spawn_interval => 2, before_fork => \&set_next_worker_role, after_fork => \®ister_worker, on_child_reap => \&unregister_worker, trap_signals => { TERM => 'TERM', INT => 'TERM', }, ); # do not remove this line - required by Daemon::Generic return (); } # main loop sub gd_run_body { my $gd = shift; $gd->handle_term if $pp->signal_received =~ m/^(?:TERM|INT)$/; $pp->start(sub { print STDERR ">>> new $next_role worker starting...\n"; with "App::Netdisco::Daemon::Worker::$next_role"; $gd->worker_begin if $gd->can('worker_begin'); $gd->worker_body; $gd->worker_end if $gd->can('worker_end'); }); # I don't think Parallel::Prefork ever returns from start() # until a child exits. Not sure this is ever reached. $gd->gd_sleep( setting('daemon_sleep_time') || 5 ) if not $pp->signal_received; } sub register_worker { my (undef, $pid) = @_; $workers{$pid} = $next_role; } sub unregister_worker { my (undef, $pid, $status) = @_; delete $workers{$pid}; # also check for bad exit status? # revert any running jobs (will be such if child died) try { schema('daemon')->resultset('Admin') ->search({status => "running-$pid"}) ->update({status => 'queued', started => undef}); } catch { warn "error reverting jobs for pid $pid: $_\n" }; } sub set_next_worker_role { my $pp = shift; $next_role = _find_next_worker_role(); } sub _find_next_worker_role { my @cur = values %workers; my $manager = scalar grep {$_ eq 'Manager'} @cur; my $poller = scalar grep {$_ eq 'Poller'} @cur; my $inter = scalar grep {$_ eq 'Interactive'} @cur; return 'Manager' if $manager < 1; my $need_poller = $poller < setting('daemon_pollers'); my $need_inter = $inter < setting('daemon_interactives'); if ($need_poller and $need_inter) { return (int(rand(2)) ? 'Interactive' : 'Poller'); } return 'Interactive' if $need_inter; return 'Poller' if $need_poller; } sub handle_term { my $gd = shift; $pp->wait_all_children; $gd->gd_quit_event } # in case we screw up and die ourselves END { if (defined $pp) { $pp->signal_all_children('TERM'); $pp->wait_all_children; } } # nullify this to permit Parallel::Prefork to register handlers instead sub gd_setup_signals {}