line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Script::Daemonizer; |
2
|
|
|
|
|
|
|
|
3
|
4
|
|
|
4
|
|
89109
|
use 5.006; |
|
4
|
|
|
|
|
16
|
|
|
4
|
|
|
|
|
146
|
|
4
|
4
|
|
|
4
|
|
22
|
use strict; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
121
|
|
5
|
4
|
|
|
4
|
|
26
|
use warnings; |
|
4
|
|
|
|
|
17
|
|
|
4
|
|
|
|
|
132
|
|
6
|
4
|
|
|
4
|
|
22
|
use Carp qw/carp croak/; |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
293
|
|
7
|
4
|
|
|
4
|
|
3525
|
use POSIX qw(:signal_h); |
|
4
|
|
|
|
|
27356
|
|
|
4
|
|
|
|
|
23
|
|
8
|
4
|
|
|
4
|
|
6168
|
use Fcntl qw/:DEFAULT :flock/; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
1889
|
|
9
|
4
|
|
|
4
|
|
3604
|
use FindBin (); |
|
4
|
|
|
|
|
4387
|
|
|
4
|
|
|
|
|
81
|
|
10
|
4
|
|
|
4
|
|
23
|
use File::Spec; |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
62
|
|
11
|
4
|
|
|
4
|
|
18
|
use File::Basename (); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
439
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
$Script::Daemonizer::VERSION = '1.01.01'; |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
16
|
|
|
|
|
|
|
# 'Private' vars |
17
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
18
|
|
|
|
|
|
|
my @argv_copy; |
19
|
|
|
|
|
|
|
my $devnull = File::Spec->devnull; |
20
|
|
|
|
|
|
|
my @daemon_options = ( qw{ |
21
|
|
|
|
|
|
|
chdir |
22
|
|
|
|
|
|
|
do_not_tie_stdhandles |
23
|
|
|
|
|
|
|
drop_privileges |
24
|
|
|
|
|
|
|
output_file |
25
|
|
|
|
|
|
|
pidfile |
26
|
|
|
|
|
|
|
restart_on |
27
|
|
|
|
|
|
|
setsid |
28
|
|
|
|
|
|
|
sigunmask |
29
|
|
|
|
|
|
|
stdout_file |
30
|
|
|
|
|
|
|
stderr_file |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
_DEBUG |
33
|
|
|
|
|
|
|
} ); |
34
|
|
|
|
|
|
|
my %id_map = ( |
35
|
|
|
|
|
|
|
user => 'uid', |
36
|
|
|
|
|
|
|
group => 'gid', |
37
|
|
|
|
|
|
|
euser => 'euid', |
38
|
|
|
|
|
|
|
egroup => 'egid', |
39
|
|
|
|
|
|
|
); |
40
|
|
|
|
|
|
|
my $global_pidfh; |
41
|
|
|
|
|
|
|
my %defaults = ( |
42
|
|
|
|
|
|
|
working_dir => File::Spec->rootdir(), |
43
|
|
|
|
|
|
|
umask => 0, |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
################################################################################ |
49
|
|
|
|
|
|
|
# SAVING @ARGV for restart() |
50
|
|
|
|
|
|
|
################################################################################ |
51
|
|
|
|
|
|
|
# |
52
|
|
|
|
|
|
|
# restart() needs the exact list of arguments in order to relaunch the script, |
53
|
|
|
|
|
|
|
# if requested. |
54
|
|
|
|
|
|
|
# User is free to shift(@ARGV) and/or modify it in any way, we ensure we always |
55
|
|
|
|
|
|
|
# get the "real" args (unless someone takes some extra effort to modify them |
56
|
|
|
|
|
|
|
# before we get here). |
57
|
|
|
|
|
|
|
# restart() gets an array of args, thoug, so there is no need to tamper with |
58
|
|
|
|
|
|
|
# this: |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
BEGIN { |
61
|
4
|
|
|
4
|
|
3616
|
@argv_copy = @ARGV; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
################################################################################ |
65
|
|
|
|
|
|
|
# HANDLING SIGHUP |
66
|
|
|
|
|
|
|
################################################################################ |
67
|
|
|
|
|
|
|
# |
68
|
|
|
|
|
|
|
# When the script restarts itself upon receiving SIGHUP, that signal is masked. |
69
|
|
|
|
|
|
|
# When starting, we unmask the signals so that they do not stop working for us. |
70
|
|
|
|
|
|
|
# We do this regardless of how we were launched. |
71
|
|
|
|
|
|
|
# |
72
|
|
|
|
|
|
|
{ |
73
|
|
|
|
|
|
|
my $sigset = POSIX::SigSet->new( SIGHUP ); # Just handle HUP |
74
|
|
|
|
|
|
|
sigprocmask(SIG_UNBLOCK, $sigset); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
################################################################################ |
80
|
|
|
|
|
|
|
# HANDLING IMPORT TAGS |
81
|
|
|
|
|
|
|
################################################################################ |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
sub import { |
84
|
4
|
|
|
4
|
|
37
|
my $class = shift; |
85
|
4
|
|
|
|
|
4110
|
for my $opt (@_) { |
86
|
2
|
100
|
|
|
|
7
|
if ($opt eq ':NOCHDIR') { |
|
|
50
|
|
|
|
|
|
87
|
1
|
|
|
|
|
3
|
delete $defaults{working_dir}; |
88
|
|
|
|
|
|
|
} elsif ($opt eq ':NOUMASK') { |
89
|
1
|
|
|
|
|
1638
|
delete $defaults{umask}; |
90
|
|
|
|
|
|
|
} else { |
91
|
0
|
|
|
|
|
0
|
croak "Unknown tag: $opt"; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
99
|
|
|
|
|
|
|
# 'Private' functions |
100
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
################ |
103
|
|
|
|
|
|
|
# sub _debug() # |
104
|
|
|
|
|
|
|
################ |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
sub _debug { |
107
|
5
|
|
|
5
|
|
10
|
my $self = shift; |
108
|
5
|
50
|
|
|
|
17
|
print @_, "\n" |
109
|
|
|
|
|
|
|
if $self->{_DEBUG}; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
################## |
114
|
|
|
|
|
|
|
# sub _set_umask # |
115
|
|
|
|
|
|
|
################## |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub _set_umask { |
118
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
119
|
2
|
50
|
|
|
|
38
|
defined(umask($self->{umask})) or |
120
|
|
|
|
|
|
|
croak qq(Cannot set umask to "), $self->{umask}, qq(": $!); |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
############### |
124
|
|
|
|
|
|
|
# sub _fork # |
125
|
|
|
|
|
|
|
############### |
126
|
|
|
|
|
|
|
# fork() a child |
127
|
|
|
|
|
|
|
sub _fork { |
128
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
|
|
|
0
|
return unless $self->{fork}; # Just in case, but already checked when |
131
|
|
|
|
|
|
|
# _fork() is called |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
# See http://code.activestate.com/recipes/278731/ or the source of |
134
|
|
|
|
|
|
|
# Proc::Daemon for a discussion on ignoring SIGHUP. |
135
|
|
|
|
|
|
|
# Since ignoring it across the fork() should not be harmful, I prefer to set |
136
|
|
|
|
|
|
|
# this to IGNORE anyway. |
137
|
0
|
|
|
|
|
0
|
local $SIG{'HUP'} = 'IGNORE'; |
138
|
|
|
|
|
|
|
|
139
|
0
|
0
|
|
|
|
0
|
defined(my $pid = fork()) |
140
|
|
|
|
|
|
|
or croak "Cannot fork: $!"; |
141
|
|
|
|
|
|
|
|
142
|
0
|
0
|
|
|
|
0
|
exit 0 if $pid; # parent exits here |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
0
|
$self->{fork}--; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
0
|
$self->_debug("Forked, remaining forks: ", $self->{fork}); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
############### |
151
|
|
|
|
|
|
|
# sub _setsid # |
152
|
|
|
|
|
|
|
############### |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub _setsid { |
155
|
1
|
|
|
1
|
|
9
|
my $self = shift; |
156
|
|
|
|
|
|
|
return if |
157
|
1
|
50
|
33
|
|
|
23
|
( exists $self->{ setsid } && $self->{ setsid } eq 'SKIP' ); |
158
|
1
|
50
|
|
|
|
49
|
POSIX::setsid() or |
159
|
|
|
|
|
|
|
croak "Unable to set session id: $!"; |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
######################### |
163
|
|
|
|
|
|
|
# sub _write_pidfile # |
164
|
|
|
|
|
|
|
######################### |
165
|
|
|
|
|
|
|
# Open the pidfile (creating it if necessary), then lock it, then truncate it, |
166
|
|
|
|
|
|
|
# then write pid into it. Then retun filehandle. |
167
|
|
|
|
|
|
|
# If environment variable $_pidfile_fileno is set, then we assume we're product |
168
|
|
|
|
|
|
|
# of an exec() and take that file descriptor as the (already opened) pidfile. |
169
|
|
|
|
|
|
|
sub _write_pidfile { |
170
|
2
|
|
|
2
|
|
14
|
my $self = shift; |
171
|
2
|
|
|
|
|
4
|
my $pidfile = $self->{pidfile}; |
172
|
2
|
|
|
|
|
6
|
my $fh; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
# First we must see if there is a _pidfile_fileno variable in environment; |
175
|
|
|
|
|
|
|
# that means that we were started by an exec() and we must keep the same |
176
|
|
|
|
|
|
|
# pidfile as before |
177
|
2
|
|
|
|
|
16
|
my $pidfd = delete $ENV{_pidfile_fileno}; |
178
|
2
|
50
|
33
|
|
|
14
|
if (defined $pidfd && $pidfd =~ /^\d+$/) { |
179
|
0
|
|
|
|
|
0
|
$self->_debug("Reopening pidfile from file descriptor"); |
180
|
0
|
0
|
|
|
|
0
|
open($fh, ">&=$pidfd") |
181
|
|
|
|
|
|
|
or croak "can't open fd $pidfd: $!"; |
182
|
|
|
|
|
|
|
# Re-set close-on-exec bit for pidfile filehandle |
183
|
0
|
0
|
|
|
|
0
|
fcntl($fh, F_SETFD, 1) |
184
|
|
|
|
|
|
|
or die "Can't set close-on-exec flag on pidfile filehandle: $!\n"; |
185
|
|
|
|
|
|
|
} else { |
186
|
2
|
|
|
|
|
10
|
$self->_debug("Opening a new pid file"); |
187
|
|
|
|
|
|
|
# Open configured pidfile |
188
|
2
|
50
|
|
|
|
276
|
sysopen($fh, $pidfile, O_RDWR | O_CREAT) |
189
|
|
|
|
|
|
|
or croak "can't open $pidfile: $!"; |
190
|
|
|
|
|
|
|
} |
191
|
2
|
50
|
|
|
|
24
|
flock($fh, LOCK_EX|LOCK_NB) |
192
|
|
|
|
|
|
|
or croak "can't lock $pidfile: $! - is another instance running?"; |
193
|
2
|
50
|
|
|
|
82
|
truncate($fh, 0) |
194
|
|
|
|
|
|
|
or croak "can't truncate $pidfile: $!"; |
195
|
|
|
|
|
|
|
|
196
|
2
|
|
|
|
|
18
|
select((select( $fh ), ++$|)[0]); |
197
|
|
|
|
|
|
|
|
198
|
2
|
|
|
|
|
112
|
print $fh $$; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# Save it as a global so that in short init syntax |
201
|
|
|
|
|
|
|
# Script::Daemonizer->new( pidfile => $pfile )->daemonize; |
202
|
|
|
|
|
|
|
# it stays in scope |
203
|
2
|
|
|
|
|
26
|
return $global_pidfh = $self->{pidfh} = $fh; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
############## |
208
|
|
|
|
|
|
|
# sub _chdir # |
209
|
|
|
|
|
|
|
############## |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub _chdir { |
212
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
213
|
1
|
50
|
|
|
|
36
|
chdir($self->{'working_dir'}) or |
214
|
|
|
|
|
|
|
croak "Cannot change directory to ", $self->{'working_dir'}, ": $!"; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
################# |
219
|
|
|
|
|
|
|
# sub _close # |
220
|
|
|
|
|
|
|
################# |
221
|
|
|
|
|
|
|
# Handle closing of STDOUT/STDERR |
222
|
|
|
|
|
|
|
sub _close { |
223
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
224
|
0
|
|
|
|
|
0
|
my $fh = shift; |
225
|
|
|
|
|
|
|
# Have to lookup handles by name |
226
|
0
|
|
|
|
|
0
|
$self->_debug("Closing $fh"); |
227
|
4
|
|
|
4
|
|
33
|
no strict "refs"; |
|
4
|
|
|
|
|
11
|
|
|
4
|
|
|
|
|
612
|
|
228
|
0
|
0
|
|
|
|
0
|
open *$fh, '>', $devnull |
229
|
|
|
|
|
|
|
or croak "Unable to open $fh on $devnull: $!"; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
################# |
234
|
|
|
|
|
|
|
# sub _redirect # |
235
|
|
|
|
|
|
|
################# |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub _redirect { |
238
|
2
|
|
|
2
|
|
14
|
my ( $self, $fh, $destination ) = @_; |
239
|
|
|
|
|
|
|
|
240
|
2
|
50
|
|
|
|
11
|
$destination = $devnull |
241
|
|
|
|
|
|
|
if $destination eq '/dev/null'; |
242
|
|
|
|
|
|
|
|
243
|
2
|
|
|
|
|
6
|
$self->_debug("Redirecting $fh on: $destination ", $destination); |
244
|
4
|
|
|
4
|
|
22
|
no strict "refs"; |
|
4
|
|
|
|
|
10
|
|
|
4
|
|
|
|
|
6153
|
|
245
|
2
|
50
|
|
|
|
138
|
open *$fh, '>>', $destination |
246
|
|
|
|
|
|
|
or croak "Unable to open $fh on $destination: $!"; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
} |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
########################## |
251
|
|
|
|
|
|
|
# sub _manage_stdhandles # |
252
|
|
|
|
|
|
|
########################## |
253
|
|
|
|
|
|
|
sub _manage_stdhandles { |
254
|
1
|
|
|
1
|
|
19
|
my $self = shift; |
255
|
|
|
|
|
|
|
|
256
|
1
|
50
|
|
|
|
112
|
open STDIN, '<', $devnull |
257
|
|
|
|
|
|
|
or croak "Cannot reopen STDIN on $devnull: $!"; |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# If we were requested to redirect output on a file, do it now and return |
260
|
1
|
50
|
|
|
|
4
|
if ($self->{output_file}) { |
261
|
1
|
|
|
|
|
6
|
$self->_debug("Using output file"); |
262
|
1
|
|
|
|
|
16
|
$self->_redirect( $_, $self->{output_file}) for (qw{STDOUT STDERR}); |
263
|
1
|
|
|
|
|
13
|
return 1; |
264
|
|
|
|
|
|
|
} |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
# Use Tie::Syslog unless both stdout/stderr redirected to file |
267
|
0
|
0
|
0
|
|
|
0
|
unless ($self->{stdout_file} && $self->{stderr_file}) { |
268
|
0
|
|
|
|
|
0
|
$self->_debug("Using Tie::Syslog"); |
269
|
0
|
|
|
|
|
0
|
eval { |
270
|
0
|
|
|
|
|
0
|
require Tie::Syslog; |
271
|
|
|
|
|
|
|
}; |
272
|
|
|
|
|
|
|
|
273
|
0
|
0
|
|
|
|
0
|
if ($@) { |
274
|
0
|
0
|
|
|
|
0
|
carp "Unable to load Tie::Syslog module. Error is:\n----\n$@----\nI will continue without output" |
275
|
|
|
|
|
|
|
if $self->{_DEBUG}; |
276
|
0
|
|
|
|
|
0
|
$self->_close( $_ ) for (qw{STDOUT STDERR}); |
277
|
0
|
|
|
|
|
0
|
return 0; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
0
|
|
|
|
|
0
|
$Tie::Syslog::ident = $self->{name}; |
281
|
0
|
|
|
|
|
0
|
$Tie::Syslog::logopt = 'ndelay,pid'; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# STDOUT |
285
|
0
|
0
|
|
|
|
0
|
if ($self->{stdout_file}) { |
286
|
0
|
|
|
|
|
0
|
$self->_redirect( 'STDOUT', $self->{stdout_file} ); |
287
|
|
|
|
|
|
|
} else { |
288
|
0
|
|
|
|
|
0
|
$self->_close( 'STDOUT' ); |
289
|
0
|
|
|
|
|
0
|
$self->_debug("Tying STDOUT to Tie::Syslog"); |
290
|
0
|
|
|
|
|
0
|
tie *STDOUT, 'Tie::Syslog', { |
291
|
|
|
|
|
|
|
facility => 'LOG_DAEMON', |
292
|
|
|
|
|
|
|
priority => 'LOG_INFO', |
293
|
|
|
|
|
|
|
}; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
# STDERR |
297
|
0
|
0
|
|
|
|
0
|
if ($self->{stderr_file}) { |
298
|
0
|
|
|
|
|
0
|
$self->_redirect( 'STDERR', $self->{stderr_file} ); |
299
|
|
|
|
|
|
|
} else { |
300
|
0
|
|
|
|
|
0
|
$self->_close( 'STDERR' ); |
301
|
0
|
|
|
|
|
0
|
$self->_debug("Tying STDERR to Tie::Syslog"); |
302
|
0
|
|
|
|
|
0
|
tie *STDERR, 'Tie::Syslog', { |
303
|
|
|
|
|
|
|
facility => 'LOG_DAEMON', |
304
|
|
|
|
|
|
|
priority => 'LOG_ERR', |
305
|
|
|
|
|
|
|
}; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
######################## |
311
|
|
|
|
|
|
|
# sub _get_signal_list # |
312
|
|
|
|
|
|
|
######################## |
313
|
|
|
|
|
|
|
sub _get_signal_list { |
314
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
} |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
319
|
|
|
|
|
|
|
# 'Public' functions |
320
|
|
|
|
|
|
|
# ------------------------------------------------------------------------------ |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub drop_privileges { |
323
|
|
|
|
|
|
|
|
324
|
6
|
|
|
6
|
1
|
32
|
my $self = shift; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# Check parameters: |
327
|
6
|
50
|
|
|
|
20
|
croak "Odd number of arguments in drop_privileges() call!" |
328
|
|
|
|
|
|
|
if @_ % 2; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
# Get parameters |
331
|
6
|
100
|
|
|
|
20
|
my %ids = @_ ? @_ : %{ $self->{drop_privileges} }; |
|
4
|
|
|
|
|
20
|
|
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# Resolve user name to user id if given |
334
|
6
|
|
|
|
|
16
|
for (qw{ user euser }) { |
335
|
12
|
100
|
|
|
|
42
|
defined( my $us = delete $ids{ $_ } ) |
336
|
|
|
|
|
|
|
or next; |
337
|
4
|
50
|
|
|
|
290
|
defined ( $ids{ $id_map{ $_ } } = getpwnam( $us ) ) |
338
|
|
|
|
|
|
|
or croak "No such user: $us"; |
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# Resolve group name to group id if given |
342
|
6
|
|
|
|
|
12
|
for (qw{ group egroup }) { |
343
|
12
|
100
|
|
|
|
36
|
defined( my $gr = delete $ids{ $_ } ) |
344
|
|
|
|
|
|
|
or next; |
345
|
4
|
50
|
|
|
|
214
|
defined ( $ids{ $id_map{ $_ } } = getgrnam( $gr ) ) |
346
|
|
|
|
|
|
|
or croak "No such group: $gr"; |
347
|
|
|
|
|
|
|
} |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
# Get ids |
350
|
6
|
|
|
|
|
18
|
my ($euid, $egid, $uid, $gid) = @ids{qw(euid egid uid gid)}; |
351
|
|
|
|
|
|
|
|
352
|
|
|
|
|
|
|
# Drop GROUP ID |
353
|
6
|
50
|
|
|
|
24
|
if (defined $gid) { |
|
|
0
|
|
|
|
|
|
354
|
6
|
50
|
|
|
|
78
|
POSIX::setgid((split " ", $gid)[0]) |
355
|
|
|
|
|
|
|
or croak "POSIX::setgid() failed: $!"; |
356
|
|
|
|
|
|
|
} elsif (defined $egid) { |
357
|
|
|
|
|
|
|
# $egid might be a list |
358
|
0
|
|
|
|
|
0
|
$) = $egid; |
359
|
0
|
0
|
|
|
|
0
|
croak "Cannot drop effective group id to $egid: $!" |
360
|
|
|
|
|
|
|
if $!; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
# Drop USER ID |
364
|
6
|
50
|
|
|
|
16
|
if (defined $uid) { |
|
|
0
|
|
|
|
|
|
365
|
6
|
50
|
|
|
|
48
|
POSIX::setuid($uid) |
366
|
|
|
|
|
|
|
or croak "POSIX::setuid() failed: $!"; |
367
|
|
|
|
|
|
|
} elsif (defined $euid) { |
368
|
|
|
|
|
|
|
# Drop EUID too, unless explicitly forced to something else |
369
|
0
|
|
|
|
|
0
|
$> = $euid; |
370
|
0
|
0
|
|
|
|
0
|
croak "Cannot drop effective user id to $uid: $!" |
371
|
|
|
|
|
|
|
if $!; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
6
|
|
|
|
|
80
|
return 1; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub new { |
379
|
|
|
|
|
|
|
|
380
|
15
|
|
|
15
|
1
|
12992
|
my $pkg = shift; |
381
|
|
|
|
|
|
|
|
382
|
15
|
50
|
|
|
|
52
|
croak ("This is a class method!") |
383
|
|
|
|
|
|
|
if ref($pkg); |
384
|
|
|
|
|
|
|
|
385
|
15
|
100
|
|
|
|
211
|
croak "Odd number of arguments in configuration!" |
386
|
|
|
|
|
|
|
if @_ %2; |
387
|
|
|
|
|
|
|
|
388
|
14
|
|
|
|
|
83
|
my $self = { |
389
|
|
|
|
|
|
|
%defaults, |
390
|
|
|
|
|
|
|
}; |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
# Get the configuration |
393
|
14
|
|
|
|
|
50
|
my %params = @_; |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# Set useful defaults |
396
|
14
|
|
66
|
|
|
365
|
$self->{name} = delete $params{name} || (File::Spec->splitpath($0))[-1]; |
397
|
14
|
50
|
33
|
|
|
81
|
$self->{fork} = (exists $params{fork} && $params{fork} =~ /^[012]$/) |
398
|
|
|
|
|
|
|
? delete $params{fork} |
399
|
|
|
|
|
|
|
: 2; |
400
|
|
|
|
|
|
|
|
401
|
14
|
50
|
|
|
|
32
|
$self->{working_dir} = delete $params{working_dir} if $params{working_dir}; |
402
|
|
|
|
|
|
|
|
403
|
14
|
50
|
|
|
|
85
|
if (exists $params{umask}) { |
404
|
0
|
0
|
|
|
|
0
|
croak "Invalid umask specified: ", $params{umask} |
405
|
|
|
|
|
|
|
unless $params{umask} =~ /^[0-7]{1,3}$/; |
406
|
0
|
|
|
|
|
0
|
$self->{umask} = delete $params{umask}; |
407
|
|
|
|
|
|
|
} |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
# Get other options as they are: |
410
|
14
|
|
|
|
|
42
|
for (@daemon_options) { |
411
|
154
|
100
|
|
|
|
353
|
$self->{ $_ } = delete $params{ $_ } |
412
|
|
|
|
|
|
|
if exists $params{ $_ }; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
14
|
|
|
|
|
35
|
my @extra_args = keys %params; |
416
|
|
|
|
|
|
|
{ |
417
|
14
|
|
|
|
|
18
|
local $" = ", "; |
|
14
|
|
|
|
|
25
|
|
418
|
14
|
100
|
|
|
|
158
|
croak sprintf "Invalid argument(s) passed: @extra_args" |
419
|
|
|
|
|
|
|
if @extra_args; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
13
|
|
|
|
|
28
|
bless $self, $pkg; |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
# Set up signal handlers |
425
|
13
|
50
|
33
|
|
|
49
|
if ($self->{restart_on} && ref $self->{restart_on} eq 'ARRAY') { |
426
|
0
|
|
|
|
|
0
|
my @sigs = @{ $self->{restart_on} }; |
|
0
|
|
|
|
|
0
|
|
427
|
0
|
|
|
|
|
0
|
for (@sigs) { |
428
|
|
|
|
|
|
|
$SIG{ $_ } = sub { |
429
|
0
|
|
|
0
|
|
0
|
$self->restart(); |
430
|
0
|
|
|
|
|
0
|
}; |
431
|
|
|
|
|
|
|
} |
432
|
0
|
|
|
|
|
0
|
$self->sigunmask( @sigs ); |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
# Unmask signals if requested |
436
|
13
|
50
|
33
|
|
|
34
|
if ($self->{sigunmask} && ref $self->{sigunmask} eq 'ARRAY') { |
437
|
0
|
|
|
|
|
0
|
$self->sigunmask(@{ $self->{sigunmask} }); |
|
0
|
|
|
|
|
0
|
|
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
13
|
|
|
|
|
293
|
return $self; |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
} |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub daemonize { |
445
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
# Step 0.0 - OPTIONAL: drop privileges |
448
|
0
|
0
|
|
|
|
|
$self->drop_privileges |
449
|
|
|
|
|
|
|
if $self->{drop_privileges}; |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# Step 1. |
452
|
0
|
0
|
|
|
|
|
$self->_set_umask |
453
|
|
|
|
|
|
|
if exists $self->{umask}; |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
# Step 2. |
456
|
0
|
0
|
|
|
|
|
$self->_fork() |
457
|
|
|
|
|
|
|
if $self->{fork}; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
# Step 3. |
460
|
0
|
|
|
|
|
|
$self->_setsid(); |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# Step 4. |
463
|
0
|
0
|
|
|
|
|
$self->_fork() |
464
|
|
|
|
|
|
|
if $self->{fork}; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# Step 4.5 - OPTIONAL: take a lock on pidfile |
467
|
|
|
|
|
|
|
# (and write pid into it) |
468
|
0
|
0
|
|
|
|
|
$self->_write_pidfile() |
469
|
|
|
|
|
|
|
if $self->{pidfile}; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
# Step 5. |
472
|
0
|
0
|
|
|
|
|
$self->_chdir() |
473
|
|
|
|
|
|
|
if $self->{working_dir}; |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
# Step 6. |
477
|
|
|
|
|
|
|
# REMOVED! |
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
# Step 7. |
481
|
0
|
|
|
|
|
|
$self->_manage_stdhandles(); |
482
|
|
|
|
|
|
|
|
483
|
0
|
|
|
|
|
|
return 1; |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
} |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub restart { |
488
|
|
|
|
|
|
|
|
489
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
490
|
|
|
|
|
|
|
|
491
|
0
|
0
|
|
|
|
|
my @args = @_ ? @_ : @argv_copy; |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
# See perlipc |
494
|
|
|
|
|
|
|
# make the daemon cross-platform, so exec always calls the script |
495
|
|
|
|
|
|
|
# itself with the right path, no matter how the script was invoked. |
496
|
0
|
|
|
|
|
|
my $script = File::Basename::basename($0); |
497
|
0
|
|
|
|
|
|
my $SELF = File::Spec->catfile($FindBin::Bin, $script); |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
# $pidf must be kept open across exec() if we don't want race conditions: |
500
|
0
|
0
|
|
|
|
|
if (my $pidfh = $self->{pidfh}) { |
501
|
0
|
|
|
|
|
|
$self->_debug("Keeping current pidfile open"); |
502
|
|
|
|
|
|
|
# Clear close-on-exec bit for pidfile filehandle |
503
|
0
|
0
|
|
|
|
|
fcntl($pidfh, F_SETFD, 0) |
504
|
|
|
|
|
|
|
or die "Can't clear close-on-exec flag on pidfile filehandle: $!\n"; |
505
|
|
|
|
|
|
|
# Now we must notify ourseves that pidfile is already open |
506
|
0
|
|
|
|
|
|
$ENV{_pidfile_fileno} = fileno( $pidfh ); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
0
|
0
|
|
|
|
|
exec($SELF, @args) |
510
|
|
|
|
|
|
|
or croak "$0: couldn't restart: $!"; |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# Bye default, we unmask SIGHUP but, if other signals must be unmasked too, |
515
|
|
|
|
|
|
|
# then use this and pass in a list of signals to be unmasked. |
516
|
|
|
|
|
|
|
sub sigunmask { |
517
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
518
|
0
|
0
|
|
|
|
|
croak "sigunmask called without arguments" |
519
|
|
|
|
|
|
|
unless @_; |
520
|
4
|
|
|
4
|
|
24
|
no strict "refs"; |
|
4
|
|
|
|
|
8
|
|
|
4
|
|
|
|
|
619
|
|
521
|
|
|
|
|
|
|
# Have to convert manually signal names into numbers. I remove the prefix |
522
|
|
|
|
|
|
|
# POSIX::[SIG] from signal name and add it back again, this allows user to |
523
|
|
|
|
|
|
|
# refer to signals in any way, for example: |
524
|
|
|
|
|
|
|
# QUIT |
525
|
|
|
|
|
|
|
# SIGQUIT |
526
|
|
|
|
|
|
|
# POSIX::QUIT |
527
|
|
|
|
|
|
|
# POSIX::SIGQUIT |
528
|
0
|
|
|
|
|
|
my @sigs = map { |
529
|
0
|
|
|
|
|
|
( my $signal = $_ ) =~ s/^POSIX:://; |
530
|
0
|
|
|
|
|
|
$signal =~ s/^SIG//; |
531
|
0
|
|
|
|
|
|
$signal = "POSIX::SIG".$signal; |
532
|
0
|
|
|
|
|
|
&$signal |
533
|
|
|
|
|
|
|
} @_; |
534
|
0
|
|
|
|
|
|
my $sigset = POSIX::SigSet->new( @sigs ); # Handle all given signals |
535
|
0
|
|
|
|
|
|
sigprocmask(SIG_UNBLOCK, $sigset); |
536
|
|
|
|
|
|
|
} |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
'End of Script::Daemonizer' |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
__END__ |