Squashed commit of the following: commita785b88b43Author: Oliver Gorwits <oliver@cpan.org> Date: Wed Aug 6 21:32:11 2014 +0100 complete daemon pstree updates commitf77bf5361fMerge:f519410fcb8195Author: Oliver Gorwits <oliver@cpan.org> Date: Wed Aug 6 20:45:22 2014 +0100 Merge branch 'master' into og-proctitle commitf51941076fAuthor: Oliver Gorwits <oliver@cpan.org> Date: Tue Aug 5 22:14:58 2014 +0100 set proctitle on daemon
		
			
				
	
	
		
			130 lines
		
	
	
		
			2.9 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			130 lines
		
	
	
		
			2.9 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
| #!/usr/bin/env perl
 | |
| 
 | |
| use strict;
 | |
| use warnings;
 | |
| 
 | |
| use FindBin;
 | |
| FindBin::again();
 | |
| use Path::Class 'dir';
 | |
| 
 | |
| BEGIN {
 | |
|   # stuff useful locations into @INC
 | |
|   unshift @INC,
 | |
|     dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
 | |
|     dir($FindBin::RealBin, 'lib')->stringify;
 | |
| 
 | |
|   unshift @INC,
 | |
|     split m/:/, ($ENV{NETDISCO_INC} || '');
 | |
| }
 | |
| 
 | |
| use App::Netdisco;
 | |
| use Dancer qw/:moose :script/;
 | |
| warning sprintf "App::Netdisco %s backend", ($App::Netdisco::VERSION || 'HEAD');
 | |
| 
 | |
| # local job queue management
 | |
| use App::Netdisco::Daemon::LocalQueue ':all';
 | |
| 
 | |
| # needed to quench AF_INET6 symbol errors
 | |
| use NetAddr::IP::Lite ':lower';
 | |
| use List::Util 'sum';
 | |
| use Role::Tiny::With;
 | |
| use MCE::Signal '-setpgrp';
 | |
| use MCE;
 | |
| 
 | |
| # set temporary MCE files' location in home directory
 | |
| my $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});
 | |
| my $tmp_dir = ($ENV{NETDISCO_TEMP} || dir($home, 'tmp'));
 | |
| mkdir $tmp_dir if ! -d $tmp_dir;
 | |
| 
 | |
| setpgrp(0,0); # only portable variety of setpgrp
 | |
| $0 = 'netdisco-daemon: master';
 | |
| 
 | |
| my $mce = MCE->new(
 | |
|   spawn_delay => 0.15,
 | |
|   job_delay   => 1.15,
 | |
|   tmp_dir     => $tmp_dir,
 | |
|   user_func    => sub { $_[0]->worker_body },
 | |
|   on_post_exit => \&restart_this_worker,
 | |
|   user_tasks   => build_tasks_list(),
 | |
| )->run();
 | |
| 
 | |
| sub build_tasks_list {
 | |
|   # NB MCE does not like max_workers => 0
 | |
|   my $tasks = [];
 | |
| 
 | |
|   push @$tasks, {
 | |
|     max_workers => 1,
 | |
|     user_begin => worker_factory('Manager'),
 | |
|   } if num_workers() > 0;
 | |
| 
 | |
|   push @$tasks, {
 | |
|     max_workers => 1,
 | |
|     user_begin => worker_factory('Scheduler'),
 | |
|   } if setting('schedule');
 | |
| 
 | |
|   my @logmsg = ();
 | |
|   foreach my $key (keys %{setting('job_type_keys')}) {
 | |
|       my $val = setting('job_type_keys')->{$key};
 | |
| 
 | |
|       setting('workers')->{$val} = 2
 | |
|         if !defined setting('workers')->{$val};
 | |
| 
 | |
|       push @logmsg, setting('workers')->{$val} ." $key";
 | |
|       push @$tasks, {
 | |
|         max_workers => setting('workers')->{$val},
 | |
|         user_begin => worker_factory($key),
 | |
|       } if setting('workers')->{$val};
 | |
|   }
 | |
| 
 | |
|   info sprintf "MCE will load: %s Manager, %s Scheduler, %s",
 | |
|     (num_workers() ? 1 : 0),
 | |
|     (setting('schedule') ? 1 : 0),
 | |
|     (join ', ', @logmsg);
 | |
| 
 | |
|   return $tasks;
 | |
| }
 | |
| 
 | |
| sub num_workers {
 | |
|   return sum( 0, map { setting('workers')->{$_} }
 | |
|                      values %{setting('job_type_keys')} );
 | |
| }
 | |
| 
 | |
| sub worker_factory {
 | |
|   my $role = shift;
 | |
|   return sub {
 | |
|     my $self = shift;
 | |
|     my $wid = $self->wid;
 | |
|     $0 = sprintf 'netdisco-daemon: worker #%s %s: init', $wid, lc($role);
 | |
|     info "applying role $role to worker $wid";
 | |
| 
 | |
|     # $self->sendto('stderr', ">>> worker $wid starting with role $role\n");
 | |
|     Role::Tiny->apply_roles_to_object($self, "App::Netdisco::Daemon::Worker::$role");
 | |
| 
 | |
|     $self->worker_begin if $self->can('worker_begin');
 | |
|   };
 | |
| }
 | |
| 
 | |
| sub restart_this_worker {
 | |
|   my ($self, $e) = @_;
 | |
|   reset_jobs($e->{wid});
 | |
| 
 | |
|   debug "restarting worker $e->{wid}";
 | |
|   $self->restart_worker($e->{wid});
 | |
| }
 | |
| 
 | |
| =head1 NAME
 | |
| 
 | |
| netdisco-daemon-fg - Job Control for Netdisco
 | |
| 
 | |
| =head1 SEE ALSO
 | |
| 
 | |
| =over 4
 | |
| 
 | |
| =item *
 | |
| 
 | |
| L<App::Netdisco>
 | |
| 
 | |
| =back
 | |
| 
 | |
| =cut
 |