File Coverage

blib/lib/App/Base/Daemon.pm
Criterion Covered Total %
statement 82 104 78.8
branch 23 56 41.0
condition 13 35 37.1
subroutine 17 17 100.0
pod 2 2 100.0
total 137 214 64.0


line stmt bran cond sub pod time code
1             use 5.010;
2 9     9   731574 use Moose::Role;
  9         99  
3 9     9   2517 with 'App::Base::Script::Common';
  9         2872071  
  9         51  
4              
5             our $VERSION = '0.08'; ## VERSION
6              
7             =head1 NAME
8              
9             App::Base::Daemon - A lazy person's tool for writing self-documenting, self-monitoring daemons
10              
11             =head1 SYNOPSIS
12              
13             package App::Base::Daemon::example;
14             use Moose;
15             with 'App::Base::Daemon';
16             sub documentation { return 'This is an example daemon.'; }
17              
18             sub options {
19              
20             # See App::Base::Script::Common
21             }
22              
23             sub daemon_run {
24             my $self = shift;
25             while (1) {
26             # do something
27             sleep(1)
28             }
29              
30             return 0; # This will never be reached
31             }
32              
33             sub handle_shutdown {
34             my $self = shift;
35             # do something
36             return 0;
37             }
38              
39             no Moose;
40             __PACKAGE__->meta->make_immutable;
41             1;
42              
43             exit App::Base::Daemon::example->new->run;
44              
45             =head1 DESCRIPTION
46              
47             App::Base::Daemon builds on App::Base::Script::Common and provides common infrastructure for writing daemons, including:
48              
49             =over 4
50              
51             =item -
52              
53             Standardized logging techniques via syslog
54              
55             =item -
56              
57             Signal processing and graceful shutdown
58              
59             =back
60              
61             =head1 BUILT-IN OPTIONS
62              
63             Every App::Base::Daemon-implementing class gets some daemon-specific options for
64             free, in addition to those provided by App::Base::Script::Common. They are:
65              
66             =head2 --no-fork
67              
68             Rather than double-forking and detaching from the console, the daemon
69             runs in the foreground (parent) process. Useful for debugging or
70             interactive invocations.
71              
72             =head2 --pid-file
73              
74             Writes PID of the daemon into specified file, by default writes pid into /var/run/__PACKAGE__.pid
75              
76             =head2 --no-pid-file
77              
78             Do not write pid file, and do not check if it is exist and locked.
79              
80             =head2 --no-warn
81              
82             Do not produce warnings, silent mode
83              
84             =head1 REQUIRED SUBCLASS METHODS
85              
86             =cut
87              
88             use namespace::autoclean;
89 9     9   54648 use Syntax::Keyword::Try;
  9         47628  
  9         57  
90 9     9   5115 use Path::Tiny;
  9         18753  
  9         51  
91 9     9   5466  
  9         72756  
  9         669  
92             =head2 daemon_run
93              
94             The main loop that runs the daemon. Typically this will include while(1) or
95             something similar. If this method returns, daemon exits.
96              
97             =cut
98              
99             requires 'daemon_run';
100              
101             =head2 handle_shutdown
102              
103             Called before the daemon shuts down in response to a shutdown signal. Should
104             clean up any resources in use by the daemon. The return value of
105             handle_shutdown is used as the exit status of the daemon.
106              
107             =cut
108              
109             requires 'handle_shutdown';
110              
111             use Socket;
112 9     9   3387 use IO::Handle;
  9         29118  
  9         3948  
113 9     9   3156 use File::Flock::Tiny;
  9         35184  
  9         402  
114 9     9   4155 use POSIX qw();
  9         10008  
  9         285  
115 9     9   2979  
  9         37194  
  9         10719  
116             =head1 ATTRIBUTES
117              
118             =head2 shutdown_signals
119              
120             An arrayref of signals that should result in termination of the daemon.
121             Defaults are: INT, QUIT, TERM.
122              
123             =cut
124              
125             has 'shutdown_signals' => (
126             is => 'ro',
127             default => sub {
128             [qw( INT QUIT TERM )];
129             },
130             );
131              
132             =head2 user
133              
134             Run as specified user, note that it is only possible if daemon started as root
135              
136             =cut
137              
138             has user => (is => 'ro');
139              
140             =head2 group
141              
142             Run as specified group, note that it is only possible if daemon started as root
143              
144             =cut
145              
146             has group => (is => 'ro');
147              
148             =head2 pid_file
149              
150             Pid file name
151              
152             =cut
153              
154             has pid_file => (
155             is => 'ro',
156             lazy => 1,
157             builder => '_build_pid_file',
158             );
159              
160             my $self = shift;
161             my $file = $self->getOption('pid-file');
162 19     19   97 unless ($file) {
163 19         82 my $class = ref $self;
164 19 50       72 my $piddir = $ENV{APP_BASE_DAEMON_PIDDIR} || '/var/run';
165 19         65 $file = path($piddir)->child("$class.pid");
166 19   50     159 }
167 19         80 return "$file";
168             }
169 19         1289  
170             =head2 can_do_hot_reload
171              
172             Should return true if implementation supports hot reloading
173              
174             =cut
175              
176              
177             around 'base_options' => sub {
178 19     19 1 106 my $orig = shift;
179             my $self = shift;
180             return [
181             @{$self->$orig},
182             {
183             name => 'no-fork',
184             documentation => "Do not detach and run in the background",
185             },
186             {
187             name => 'pid-file',
188             option_type => 'string',
189             documentation => "Use specified file to save PID",
190             },
191             {
192             name => 'no-pid-file',
193             documentation => "Do not check if pidfile exists and locked",
194             },
195             {
196             name => 'user',
197             documentation => "User to run as",
198             },
199             {
200             name => 'group',
201             documentation => "Group to run as",
202             },
203             {
204             name => 'no-warn',
205             documentation => 'Do not produce warnings',
206             },
207             ];
208             };
209              
210             =head1 METHODS
211              
212             =cut
213              
214             my $self = shift;
215             $self->handle_shutdown;
216             exit 0;
217             }
218 3     3   39  
219 3         76 my $self = shift;
220 3         193  
221             my $pid;
222             my $hot_reload = $ENV{APP_BASE_DAEMON_GEN}++ && $self->can_do_hot_reload;
223             unless ($self->getOption('no-pid-file') or $hot_reload) {
224 23     23   81 $pid = File::Flock::Tiny->trylock($self->pid_file);
225             unless ($pid) {
226 23         82 if ($self->can_do_hot_reload) {
227 23   66     417 chomp(my $pid = eval { my $fh = path($self->pid_file)->openr; <$fh>; });
228 23 100 66     145 if ($pid and kill USR2 => $pid) {
229 19         621 warn("Daemon is alredy running, initiated hot reload") unless $self->getOption('no-warn');
230 19 100       2248 exit 0;
231 4 50       52 } else {
232 0         0 $self->error("Neither could lock pid file nor send USR2 to already running daemon.");
  0         0  
  0         0  
233 0 0 0     0 }
234 0 0       0 } else {
235 0         0 die("Couldn't lock " . $self->pid_file . ". Is another copy of this daemon already running?");
236             }
237 0         0 }
238             }
239              
240 4         164 $SIG{PIPE} = 'IGNORE'; ## no critic (RequireLocalizedPunctuationVars)
241             foreach my $signal (@{$self->shutdown_signals}) {
242             $SIG{$signal} = sub { App::Base::Daemon::_signal_shutdown($self, @_) }; ## no critic (RequireLocalizedPunctuationVars)
243             }
244              
245 19         463 # Daemonize unless specifically asked not to.
246 19         66 unless ($self->getOption('no-fork') or $hot_reload) {
  19         702  
247 57     3   1242 my $child_pid = fork();
  3         1810222  
248             if (!defined($child_pid)) {
249             die("Can't fork child process: $!");
250             } elsif ($child_pid == 0) {
251 19 100 66     402 POSIX::setsid();
252 15         25148 my $grandchild_pid = fork();
253 15 50       1334 if (!defined($grandchild_pid)) {
    100          
254 0         0 die("Can't fork grandchild process: $!");
255             } elsif ($grandchild_pid != 0) {
256 7         827 $pid->close if $pid;
257 7         9704 exit 0;
258 7 50       759 } else {
    100          
259 0         0 # close all STD* files, and redirect STD* to /dev/null
260             for (0 .. 2) {
261 4 50       542 POSIX::close($_) unless $pid and $_ == $pid->fileno;
262 4         388 }
263             (open(STDIN, '<', '/dev/null') and open(STDOUT, '>', '/dev/null') and open(STDERR, '>', '/dev/null'))
264             or die "Couldn't open /dev/null: $!";
265 3         126 }
266 9 50 33     787 } else {
267             waitpid($child_pid, 0);
268 3 50 33     575 $pid->close if $pid;
      33        
269             return $?;
270             }
271             }
272 8         5884200  
273 8 50       799 $self->_set_user_and_group unless $hot_reload;
274 8         647  
275             $pid->write_pid if $pid;
276              
277             my $result;
278 7 50       227 try { $result = $self->daemon_run(@{$self->parsed_args}); }
279             catch ($e) {
280 7 100       194 $self->error($e);
281             }
282 7         841  
283             undef $pid;
284 7         47  
285             return $result;
286             }
287              
288 4         48 my $self = shift;
289              
290 4         16 my $user = $self->getOption('user') // $self->user;
291             my $group = $self->getOption('group') // $self->group;
292             if ($user or $group) {
293             if ($> == 0) {
294 7     7   58 my ($uid, $gid) = (0, 0);
295             if ($group) {
296 7   33     250 $gid = getgrnam($group) or $self->error("Can't find group $group");
297 7   33     43 }
298 7 50 33     133 if ($user) {
299 0 0       0 $uid = getpwnam($user) or $self->error("Can't find user $user");
300 0         0 }
301 0 0       0 if ($uid or $gid) {
302 0 0       0 chown $uid, $gid, $self->pid_file;
303             }
304 0 0       0 if ($gid) {
305 0 0       0 POSIX::setgid($gid);
306             }
307 0 0 0     0 if ($uid) {
308 0         0 POSIX::setuid($uid);
309             }
310 0 0       0 } else {
311 0         0 warn("Not running as root, can't setuid/setgid") unless $self->getOption('no-warn');
312             }
313 0 0       0 }
314 0         0  
315             return;
316             }
317 0 0       0  
318             =head2 error
319              
320             Handles the output of errors, including shutting down the running daemon by
321 7         45 calling handle_shutdown(). If you have a serious problem that should NOT
322             result in shutting down your daemon, use warn() instead.
323              
324             =cut
325              
326             my $self = shift;
327             warn("Shutting down: " . join(' ', @_)) unless $self->getOption('no-warn');
328              
329             $self->handle_shutdown();
330             return exit(-1);
331             }
332              
333 6     6 1 78 no Moose::Role;
334 6 50       30 1;
335              
336 6         414  
337 6         2442 =head1 USAGE
338              
339             =head2 Inheritance
340 9     9   75  
  9         24  
  9         90  
341             Invocation of a App::Base::Daemon-based daemon is accomplished as follows:
342              
343             =over 4
344              
345             =item -
346              
347             Define a class that implements App::Base::Daemon
348              
349             =item -
350              
351             Instantiate an object of that class via new()
352              
353             =item -
354              
355             Run the daemon by calling run(). The return value of run() is the exit
356             status of the daemon, and should typically be passed back to the calling
357             program via exit()
358              
359             =back
360              
361             =head2 The new() method
362              
363             (See App::Base::Script::Common::new)
364              
365             =head2 Options handling
366              
367             (See App::Base::Script::Common, "Options handling")
368              
369             =head1 LICENSE AND COPYRIGHT
370              
371             Copyright (C) 2010-2014 Binary.com
372              
373             This program is free software; you can redistribute it and/or modify it
374             under the terms of either: the GNU General Public License as published
375             by the Free Software Foundation; or the Artistic License.
376              
377             See http://dev.perl.org/licenses/ for more information.
378              
379             =cut