1# -*- perl -*- 2# 3# Net::Server::Daemonize - Daemonization utilities. 4# 5# Copyright (C) 2001-2017 6# 7# Jeremy Howard 8# j+daemonize@howard.fm 9# 10# Paul Seamons <paul@seamons.com> 11# 12# This package may be distributed under the terms of either the 13# GNU General Public License 14# or the 15# Perl Artistic License 16# 17# All rights reserved. 18# 19################################################################ 20 21package Net::Server::Daemonize; 22 23use strict; 24use base qw(Exporter); 25use POSIX qw(SIGINT SIG_BLOCK SIG_UNBLOCK); 26 27our $VERSION = "0.06"; 28 29our @EXPORT_OK = qw(check_pid_file create_pid_file unlink_pid_file 30 is_root_user get_uid get_gid set_uid set_gid 31 set_user safe_fork daemonize); 32 33###----------------------------------------------------------------### 34 35### check for existence of pid_file 36### if the file exists, check for a running process 37sub check_pid_file ($) { 38 my $pid_file = shift; 39 return 1 if ! -e $pid_file or ! -s $pid_file && -M _ > 0.01; 40 41 open my $fh, '<', $pid_file or die "$pid_file: Couldn't open existent pid_file [$!]\n"; 42 my $current_pid = <$fh> || ""; 43 close $fh; 44 $current_pid = ($current_pid =~ /^(\d{1,10})/) ? $1 : die "$pid_file: Couldn't find pid in existent pid_file"; 45 46 my $exists; 47 if ($$ == $current_pid) { 48 warn "Pid_file created by this same process. Doing nothing.\n"; 49 return 1; 50 } elsif (-d "/proc/$$") { # try a proc file system 51 $exists = -e "/proc/$current_pid"; 52 } elsif (kill 0, $current_pid) { 53 $exists = 1; 54 } 55 die "Pid_file already exists for running process ($current_pid)... aborting\n" 56 if $exists; 57 58 # remove the pid_file 59 warn "Pid_file \"$pid_file\" already exists. Overwriting!\n"; 60 unlink $pid_file || die "Couldn't remove pid_file \"$pid_file\" [$!]\n"; 61 return 1; 62} 63 64### actually create the pid_file, calls check_pid_file 65### before proceeding 66sub create_pid_file ($) { 67 my $pid_file = shift; 68 69 check_pid_file($pid_file); 70 71 open my $fh, '>', $pid_file or die "Couldn't open pid file \"$pid_file\" [$!].\n"; 72 print $fh "$$\n"; 73 close $fh; 74 75 die "Pid_file \"$pid_file\" not created.\n" if ! -e $pid_file; 76 return 1; 77} 78 79### Allow for safe removal of the pid_file. 80### Make sure this process owns it. 81sub unlink_pid_file ($) { 82 my $pid_file = shift; 83 return 1 if ! -e $pid_file; # no pid_file = return success 84 85 open my $fh, '<', $pid_file or die "$pid_file: Couldn't open existent pid_file [$!]\n"; # slight race 86 my $current_pid = <$fh>; 87 close $fh; 88 chomp $current_pid; 89 90 die "Process $$ doesn't own pid_file \"$pid_file\". Can't remove it.\n" 91 if $current_pid ne $$; 92 93 unlink($pid_file) || die "$pid_file: Couldn't unlink pid_file [$!]\n"; 94 return 1; 95} 96 97###----------------------------------------------------------------### 98 99sub is_root_user () { 100 my $id = get_uid('root'); 101 return ! defined($id) || $< == $id || $> == $id; 102} 103 104### get the uid for the passed user 105sub get_uid ($) { 106 my $user = shift; 107 my $uid = ($user =~ /^(\d+)$/) ? $1 : getpwnam($user); 108 die "No such user \"$user\"\n" unless defined $uid; 109 return $uid; 110} 111 112### get all of the gids that this group is (space delimited) 113sub get_gid { 114 my @gid; 115 116 foreach my $group ( split( /[, ]+/, join(" ",@_) ) ){ 117 if( $group =~ /^\d+$/ ){ 118 push @gid, $group; 119 }else{ 120 my $id = getgrnam($group); 121 die "No such group \"$group\"\n" unless defined $id; 122 push @gid, $id; 123 } 124 } 125 126 die "No group found in arguments.\n" unless @gid; 127 return join(" ",$gid[0],@gid); 128} 129 130### change the process to run as this uid 131sub set_uid { 132 my $uid = get_uid(shift()); 133 134 POSIX::setuid($uid); 135 if ($< != $uid || $> != $uid) { # check $> also (rt #21262) 136 $< = $> = $uid; # try again - needed by some 5.8.0 linux systems (rt #13450) 137 if ($< != $uid) { 138 die "Couldn't become uid \"$uid\": $!\n"; 139 } 140 } 141 142 return 1; 143} 144 145### change the process to run as this gid(s) 146### multiple groups must be space or comma delimited 147sub set_gid { 148 my $gids = get_gid(@_); 149 my $gid = (split /\s+/, $gids)[0]; 150 eval { $) = $gids }; # store all the gids - this is really sort of optional 151 152 POSIX::setgid($gid); 153 if (! grep {$gid == $_} split /\s+/, $() { # look for any valid id in the list 154 die "Couldn't become gid \"$gid\": $!\n"; 155 } 156 157 return 1; 158} 159 160### backward compatibility sub 161sub set_user { 162 my ($user, @group) = @_; 163 set_gid(@group) || return undef; 164 set_uid($user) || return undef; 165 return 1; 166} 167 168###----------------------------------------------------------------### 169 170### routine to protect process during fork 171sub safe_fork () { 172 173 # block signal for fork 174 my $sigset = POSIX::SigSet->new(SIGINT); 175 POSIX::sigprocmask(SIG_BLOCK, $sigset) or die "Can't block SIGINT for fork: [$!]\n"; 176 177 my $pid = fork; 178 die "Couldn't fork: [$!]" if ! defined $pid; 179 180 $SIG{'INT'} = 'DEFAULT'; # make SIGINT kill us as it did before 181 182 POSIX::sigprocmask(SIG_UNBLOCK, $sigset) or die "Can't unblock SIGINT for fork: [$!]\n"; 183 184 return $pid; 185} 186 187###----------------------------------------------------------------### 188 189### routine to completely dissociate from terminal process. 190sub daemonize ($$$) { 191 my ($user, $group, $pid_file) = @_; 192 193 check_pid_file($pid_file) if defined $pid_file; 194 195 my $uid = get_uid($user); 196 my $gid = get_gid($group); # returns list of groups 197 $gid = (split /\s+/, $gid)[0]; 198 199 my $pid = safe_fork(); 200 201 exit(0) if $pid; # exit parent 202 203 # child 204 create_pid_file($pid_file) if defined $pid_file; 205 chown($uid, $gid, $pid_file) if defined $pid_file; 206 207 set_user($uid, $gid); 208 209 open STDIN, '<', '/dev/null' or die "Can't open STDIN from /dev/null: [$!]\n"; 210 open STDOUT, '>', '/dev/null' or die "Can't open STDOUT to /dev/null: [$!]\n"; 211 open STDERR, '>&STDOUT' or die "Can't open STDERR to STDOUT: [$!]\n"; 212 213 ### does this mean to be chroot ? 214 chdir '/' or die "Can't chdir to \"/\": [$!]"; 215 216 POSIX::setsid(); # Turn process into session leader, and ensure no controlling terminal 217 218 ### install a signal handler to make sure SIGINT's remove our pid_file 219 $SIG{'INT'} = sub { HUNTSMAN($pid_file) } if defined $pid_file; 220 return 1; 221} 222 223### SIGINT routine that will remove the pid_file 224sub HUNTSMAN { 225 my $path = shift; 226 unlink $path; 227 228 eval { 229 require Unix::Syslog; 230 Unix::Syslog::syslog(Unix::Syslog::LOG_ERR(), "Exiting on INT signal."); 231 }; 232 233 exit; 234} 235 236 2371; 238 239__END__ 240 241=head1 NAME 242 243Net::Server::Daemonize - Safe fork and daemonization utilities 244 245=head1 SYNOPSIS 246 247 use Net::Server::Daemonize qw(daemonize); 248 249 daemonize( 250 'nobody', # User 251 'nobody', # Group 252 '/var/state/mydaemon.pid' # Path to PID file - optional 253 ); 254 255=head1 DESCRIPTION 256 257This module is intended to let you simply and safely daemonize your 258server on systems supporting the POSIX module. This means that your 259Perl script runs in the background, and it's process ID is stored in a 260file so you can easily stop it later. 261 262=head1 EXPORTED FUNCTIONS 263 264=over 4 265 266=item daemonize 267 268Main routine. Arguments are user (or userid), group (or group id or 269space delimited list of groups), and pid_file (path to file). This 270routine will check on the pid file, safely fork, create the pid file 271(storing the pid in the file), become another user and group, close 272STDIN, STDOUT and STDERR, separate from the process group (become 273session leader), and install $SIG{INT} to remove the pid file. In 274otherwords - daemonize. All errors result in a die. As of version 2750.89 the pid_file is optional. 276 277=item safe_fork 278 279Block SIGINT during fork. No arguments. Returns pid of forked child. 280All errors result in a die. 281 282=item set_user 283 284Become another user and group. Arguments are user (or userid) and 285group (or group id or space delimited list of groups). 286 287=item set_uid 288 289Become another user. Argument is user (or userid). All errors die. 290 291=item set_gid 292 293Become another group. Arguments are groups (or group ids or space 294delimited list of groups or group ids). All errors die. 295 296=item get_uid 297 298Find the uid. Argument is user (userid returns userid). Returns 299userid. All errors die. 300 301=item get_gid 302 303Find the gids. Arguments are groups or space delimited list of 304groups. All errors die. 305 306=item is_root_user 307 308Determine if the process is running as root. Returns 1 or undef. 309 310=item check_pid_file 311 312Arguments are pid_file (full path to pid_file). Checks for existence 313of pid_file. If file exists, open it and determine if the process 314that created it is still running. This is done first by checking for 315a /proc file system and second using a "ps" command (BSD syntax). (If 316neither of these options exist it assumed that the process has ended) 317If the process is still running, it aborts. Otherwise, returns true. 318All errors die. 319 320=item create_pid_file. 321 322Arguments are pid_file (full path to pid_file). Calls check_pid_file. 323If it is successful (no pid_file exists), creates a pid file and 324stores $$ in the file. 325 326=item unlink_pid_file 327 328Does just that. 329 330=back 331 332=head1 SEE ALSO 333 334L<Net::Server>. 335L<Net::Daemon>, The Perl Cookbook Recipe 17.15. 336 337=head1 AUTHORS 338 339Jeremy Howard <j+daemonize@howard.fm> 340 341Program flow, concepts and initial work. 342 343Paul Seamons <paul@seamons.com> 344 345Code rework and componentization. 346Ongoing maintainer. 347 348=head1 LICENSE 349 350 This package may be distributed under the terms of either the 351 GNU General Public License 352 or the 353 Perl Artistic License 354 355 All rights reserved. 356 357=cut 358