1#!@PERL_EXECUTABLE@ -wT 2# 3# ========================================================================== 4# 5# ZoneMinder Daemon Control Script, $Date$, $Revision$ 6# Copyright (C) 2001-2008 Philip Coombes 7# 8# This program is free software; you can redistribute it and/or 9# modify it under the terms of the GNU General Public License 10# as published by the Free Software Foundation; either version 2 11# of the License, or (at your option) any later version. 12# 13# This program is distributed in the hope that it will be useful, 14# but WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with this program; if not, write to the Free Software 20# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 21# 22# ========================================================================== 23 24=head1 NAME 25 26zmdc.pl - ZoneMinder Daemon Control script 27 28=head1 SYNOPSIS 29 30zmdc.pl {command} [daemon [options]] 31 32=head1 DESCRIPTION 33 34This script is the gateway for controlling the various ZoneMinder 35daemons. All starting, stopping and restarting goes through here. 36On the first invocation it starts up a server which subsequently 37records what's running and what's not. Other invocations just 38connect to the server and pass instructions to it. 39 40=head1 OPTIONS 41 42{command} - One of 'startup|shutdown|status|check|logrot' or 43'start|stop|restart|reload|version'. 44[daemon [options]] - Daemon name and options, required for second group of commands 45 46=cut 47use strict; 48use warnings; 49use bytes; 50 51# ========================================================================== 52# 53# User config 54# 55# ========================================================================== 56 57# in useconds, not seconds. 58use constant MAX_CONNECT_DELAY => 40; 59 60# ========================================================================== 61# 62# Don't change anything from here on down 63# 64# ========================================================================== 65 66@EXTRA_PERL_LIB@ 67use ZoneMinder; 68use POSIX; 69use Socket; 70use IO::Handle; 71use Time::HiRes qw(usleep); 72 73use autouse 'Pod::Usage'=>qw(pod2usage); 74#use Data::Dumper; 75 76use constant SOCK_FILE => $Config{ZM_PATH_SOCKS}.'/zmdc'.($Config{ZM_SERVER_ID}?$Config{ZM_SERVER_ID}:'').'.sock'; 77 78$| = 1; 79 80$ENV{PATH} = '/bin:/usr/bin:/usr/local/bin'; 81$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL}; 82if ( $Config{ZM_LD_PRELOAD} ) { 83 Debug("Adding ENV{LD_PRELOAD} = $Config{ZM_LD_PRELOAD}"); 84 $ENV{LD_PRELOAD} = $Config{ZM_LD_PRELOAD}; 85 foreach my $lib ( split(/\s+/, $ENV{LD_PRELOAD} ) ) { 86 if ( ! -e $lib ) { 87 Warning("LD_PRELOAD lib $lib does not exist from LD_PRELOAD $ENV{LD_PRELOAD}."); 88 } 89 } 90} 91delete @ENV{qw(IFS CDPATH ENV BASH_ENV)}; 92 93my @daemons = ( 94 'zmc', 95 'zmfilter.pl', 96 'zmaudit.pl', 97 'zmtrigger.pl', 98 'zmx10.pl', 99 'zmwatch.pl', 100 'zmupdate.pl', 101 'zmstats.pl', 102 'zmtrack.pl', 103 'zmcontrol.pl', 104 'zm_rtsp_server', 105 'zmtelemetry.pl' 106 ); 107 108if ( $Config{ZM_OPT_USE_EVENTNOTIFICATION} ) { 109 push @daemons, 'zmeventnotification.pl'; 110} 111 112my $command = shift @ARGV; 113if ( !$command ) { 114 print(STDERR "No command given\n"); 115 pod2usage(-exitstatus => -1); 116} 117if ( $command eq 'version' ) { 118 print ZoneMinder::Base::ZM_VERSION."\n"; 119 exit(0); 120} 121my $needs_daemon = $command !~ /(?:startup|shutdown|status|check|logrot|version)/; 122my $daemon = shift @ARGV; 123if ( $needs_daemon && !$daemon ) { 124 print(STDERR "No daemon given\n"); 125 pod2usage(-exitstatus => -1); 126} 127my @args; 128 129my $daemon_patt = '('.join('|', @daemons).')'; 130if ( $needs_daemon ) { 131 if ( $daemon =~ /^${daemon_patt}$/ ) { 132 $daemon = $1; 133 } else { 134 print(STDERR "Invalid daemon '$daemon' specified"); 135 pod2usage(-exitstatus => -1); 136 } 137} 138 139foreach my $arg ( @ARGV ) { 140# Detaint arguments, if they look ok 141#if ( $arg =~ /^(-{0,2}[\w]+)/ ) 142 if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ ) { 143 push @args, $1; 144 } else { 145 print(STDERR "Bogus argument '$arg' found"); 146 exit(-1); 147 } 148} 149 150my $dbh = zmDbConnect(); 151 152socket(CLIENT, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!"); 153 154my $saddr = sockaddr_un(SOCK_FILE); 155my $server_up = connect(CLIENT, $saddr); 156 157if ( !$server_up ) { 158 if ( $Config{ZM_SERVER_ID} ) { 159 use Sys::MemInfo qw(totalmem freemem totalswap freeswap); 160 use ZoneMinder::Server qw(CpuLoad); 161 if ( ! defined $dbh->do(q{UPDATE Servers SET Status=?,TotalMem=?,FreeMem=?,TotalSwap=?,FreeSwap=? WHERE Id=?}, undef, 162 'NotRunning', &totalmem, &freemem, &totalswap, &freeswap, $Config{ZM_SERVER_ID} ) ) { 163 Error('Failed Updating status of Server record to Not Running for Id='.$Config{ZM_SERVER_ID}.': '.$dbh->errstr()); 164 } 165 } 166# Server is not up. Some commands can still be handled 167 if ( $command eq 'logrot' ) { 168 # If server is not running, then logrotate doesn't need to do anything. 169 Debug('Server is not running, logrotate doesn\'t need to do anything'); 170 exit(); 171 } 172 if ( $command eq 'check' ) { 173 print("stopped\n"); 174 exit(); 175 } elsif ( $command ne 'startup' ) { 176 print('Unable to connect to server using socket at '.SOCK_FILE."\n"); 177 exit(-1); 178 } 179 180 # The server isn't there 181 print("Starting server\n"); 182 close(CLIENT); 183 184 if ( my $cpid = fork() ) { 185 # Parent process just sleep and fall through 186 187 # I'm still not sure why we need to re-init the logs 188 logInit(); 189 190 socket(CLIENT, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!"); 191 my $attempts = 0; 192 while ( !connect(CLIENT, $saddr) ) { 193 $attempts++; 194 Debug('Waiting for zmdc.pl server process at '.SOCK_FILE.', attempt '.$attempts); 195 Fatal('Can\'t connect to zmdc.pl server process at '.SOCK_FILE.': '.$!) if $attempts > MAX_CONNECT_DELAY; 196 usleep(200000); 197 } # end while 198 } elsif ( defined($cpid) ) { 199 ZMServer::run(); 200 } else { 201 Fatal("Can't fork: $!"); 202 } 203} # end if ! server is up 204 205if ( ($command eq 'check') && !$daemon ) { 206 print("running\n"); 207 exit(); 208} elsif ( $command eq 'startup' ) { 209 # Our work here is done 210 exit() if !$server_up; 211} 212 213# The server is there, connect to it 214CLIENT->autoflush(); 215my $message = join(';', $command, ( $daemon ? $daemon : () ), @args); 216print(CLIENT $message); 217shutdown(CLIENT, 1); 218while( my $line = <CLIENT> ) { 219 chomp($line); 220 print("$line\n"); 221} 222close(CLIENT); 223 224exit; 225 226package ZMServer; 227 228use strict; 229use warnings; 230use bytes; 231 232@EXTRA_PERL_LIB@ 233use ZoneMinder; 234use POSIX; 235use Socket; 236use IO::Handle; 237use Time::HiRes qw(usleep); 238use Sys::MemInfo qw(totalmem freemem totalswap freeswap); 239use ZoneMinder::Server qw(CpuLoad); 240#use Data::Dumper; 241 242use constant KILL_DELAY => 10; # seconds to wait between sending TERM and sending KILL 243 244our %cmd_hash; 245our %pid_hash; 246our %terminating_processes; 247our %pids_to_reap; 248our $zm_terminate = 0; 249 250sub run { 251 252 # Call this first otherwise stdout/stderror redirects to the pidfile = bad 253 if ( open(my $PID, '>', ZM_PID) ) { 254 print($PID $$); 255 close($PID); 256 } else { 257 # Log not initialized at this point so use die instead 258 die 'Can\'t open pid file at '.ZM_PID."\n"; 259 } 260 261 my $fd = 0; 262 263 # This also closes dbh and CLIENT and SERVER 264 while ( $fd < POSIX::sysconf(&POSIX::_SC_OPEN_MAX) ) { 265 POSIX::close($fd++); 266 } 267 268 # Sets a process group, so that signals to go this and it's children I think 269 setpgrp(); 270 271 # dbh got closed with the rest of the fd's above, so need to reconnect. 272 my $dbh = zmDbConnect(1); 273 logInit(); 274 275 dPrint(ZoneMinder::Logger::INFO, 'Server starting at ' 276 .strftime('%y/%m/%d %H:%M:%S', localtime()) 277 ."\n" 278 ); 279 280 # We don't want to leave killall zombies, so ignore SIGCHLD 281 $SIG{CHLD} = 'IGNORE'; 282 # Tell any existing processes to die, wait 1 second between TERM and KILL 283 killAll(1); 284 285 dPrint(ZoneMinder::Logger::INFO, 'Socket should be open at ' .main::SOCK_FILE); 286 socket(SERVER, PF_UNIX, SOCK_STREAM, 0) or Fatal("Can't open socket: $!"); 287 unlink(main::SOCK_FILE) or Error('Unable to unlink ' . main::SOCK_FILE .". Error message was: $!") if -e main::SOCK_FILE; 288 bind(SERVER, $saddr) or Fatal('Can\'t bind to ' . main::SOCK_FILE . ": $!"); 289 listen(SERVER, SOMAXCONN) or Fatal("Can't listen: $!"); 290 291 $SIG{CHLD} = \&chld_sig_handler; 292 $SIG{INT} = \&shutdown_sig_handler; 293 $SIG{TERM} = \&shutdown_sig_handler; 294 $SIG{ABRT} = \&shutdown_sig_handler; 295 $SIG{HUP} = \&logrot; 296 297 my $rin = ''; 298 vec($rin, fileno(SERVER), 1) = 1; 299 my $win = $rin; 300 my $ein = $win; 301 my $timeout = 1; 302 my $secs_count = 0; 303 304 while ( !$zm_terminate ) { 305 306 if ( $Config{ZM_SERVER_ID} ) { 307 if ( ! ( $secs_count % 60 ) ) { 308 while ( (!$zm_terminate) and !($dbh and $dbh->ping()) ) { 309 Warning("Not connected to db ($dbh)".($dbh?' ping('.$dbh->ping().')':''). ($DBI::errstr?" errstr($DBI::errstr)":'').' Reconnecting'); 310 $dbh = zmDbConnect(); 311 sleep 10 if !$dbh; 312 } 313 last if $zm_terminate; 314 315 my @cpuload = CpuLoad(); 316 Debug("Updating Server record @cpuload"); 317 if ( ! defined $dbh->do('UPDATE Servers SET Status=?,CpuLoad=?,TotalMem=?,FreeMem=?,TotalSwap=?,FreeSwap=? WHERE Id=?', undef, 318 'Running', $cpuload[0], &totalmem, &freemem, &totalswap, &freeswap, $Config{ZM_SERVER_ID} ) ) { 319 Error("Failed Updating status of Server record for Id=$Config{ZM_SERVER_ID} :".$dbh->errstr()); 320 } 321 } 322 $secs_count += 1; 323 } 324 my $nfound = select(my $rout = $rin, undef, undef, $timeout); 325 if ( $nfound > 0 ) { 326 if ( vec($rout, fileno(SERVER), 1) ) { 327 my $paddr = accept(CLIENT, SERVER); 328 my $message = <CLIENT>; 329 330 next if !$message; 331 332 my ( $command, $daemon, @args ) = split(';', $message); 333 334 if ( $command eq 'start' ) { 335 start($daemon, @args); 336 } elsif ( $command eq 'stop' ) { 337 stop($daemon, @args); 338 } elsif ( $command eq 'restart' ) { 339 restart($daemon, @args); 340 } elsif ( $command eq 'reload' ) { 341 reload($daemon, @args); 342 } elsif ( $command eq 'startup' ) { 343# Do nothing, this is all we're here for 344 dPrint(ZoneMinder::Logger::WARNING, "Already running, ignoring command '$command'\n"); 345 } elsif ( $command eq 'shutdown' ) { 346 # Break out of while loop 347 last; 348 } elsif ( $command eq 'check' ) { 349 check($daemon, @args); 350 } elsif ( $command eq 'status' ) { 351 if ( $daemon ) { 352 status($daemon, @args); 353 } else { 354 status(); 355 } 356 } elsif ( $command eq 'logrot' ) { 357 logrot(); 358 } else { 359 dPrint(ZoneMinder::Logger::ERROR, "Invalid command '$command'\n"); 360 } 361 close(CLIENT); 362 } else { 363 Error('Bogus descriptor'); 364 } 365 } elsif ( $nfound < 0 ) { 366 if ( $! == EINTR ) { 367# Dead child, will be reaped 368#print( "Probable dead child\n" ); 369# See if it needs to start up again 370 } elsif ( $! == EPIPE ) { 371 Error("Can't select: $!"); 372 } else { 373 Fatal("Can't select: $!"); 374 } 375 } else { 376#print( "Select timed out\n" ); 377 } 378 379 restartPending(); 380 check_for_processes_to_kill() if %terminating_processes; 381 reaper() if %pids_to_reap; 382 } # end while 383 384 dPrint(ZoneMinder::Logger::INFO, 'Server exiting at ' 385 .strftime('%y/%m/%d %H:%M:%S', localtime()) 386 ."\n" 387 ); 388 if ( $Config{ZM_SERVER_ID} ) { 389 $dbh = zmDbConnect() if ! ($dbh and $dbh->ping()); 390 if ( ! defined $dbh->do(q{UPDATE Servers SET Status='NotRunning' WHERE Id=?}, undef, $Config{ZM_SERVER_ID}) ) { 391 Error("Failed Updating status of Server record for Id=$Config{ZM_SERVER_ID}".$dbh->errstr()); 392 } 393 } 394 shutdownAll(); 395} 396 397sub cPrint { 398 # One thought here, if no client exists to read these... does it block? 399 if ( fileno(CLIENT) ) { 400 print CLIENT @_ 401 } 402} 403 404# I think the purpose of this is to echo the logs to the client process so it can then display them. 405sub dPrint { 406 my $logLevel = shift; 407 cPrint(@_); 408 if ( $logLevel == ZoneMinder::Logger::DEBUG ) { 409 Debug(@_); 410 } elsif ( $logLevel == ZoneMinder::Logger::INFO ) { 411 Info(@_); 412 } elsif ( $logLevel == ZoneMinder::Logger::WARNING ) { 413 Warning(@_); 414 } elsif ( $logLevel == ZoneMinder::Logger::ERROR ) { 415 Error(@_); 416 } elsif ( $logLevel == ZoneMinder::Logger::FATAL ) { 417 Fatal(@_); 418 } 419} 420 421sub start { 422 my $daemon = shift; 423 my @args = @_; 424 425 my $command = join(' ', $daemon, @args); 426 my $process = $cmd_hash{$command}; 427 428 if ( !$process ) { 429# It's not running, or at least it's not been started by us 430 $process = { daemon=>$daemon, args=>\@args, command=>$command, keepalive=>!undef }; 431 } elsif ( $process->{pid} && $pid_hash{$process->{pid}} ) { 432 dPrint(ZoneMinder::Logger::INFO, "'$process->{command}' already running at " 433 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{started})) 434 .", pid = $process->{pid}\n" 435 ); 436 return; 437 } 438 439 # We have to block SIGCHLD during fork to prevent races while we setup our records for it 440 my $sigset = POSIX::SigSet->new; 441 my $blockset = POSIX::SigSet->new(SIGCHLD); 442 sigprocmask(SIG_BLOCK, $blockset, $sigset) or Fatal("Can't block SIGCHLD: $!"); 443 # Apparently the child closing the db connection can affect the parent. 444 zmDbDisconnect(); 445 if ( my $child_pid = fork() ) { 446 447 $dbh = zmDbConnect(1); 448 # This logReinit is required. Not sure why. 449 logReinit(); 450 451 $process->{pid} = $child_pid; 452 $process->{started} = time(); 453 delete $process->{pending}; 454 455 dPrint(ZoneMinder::Logger::INFO, "'$command' starting at " 456 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{started})) 457 .", pid = $process->{pid}\n" 458 ); 459 460 $cmd_hash{$process->{command}} = $pid_hash{$child_pid} = $process; 461 sigprocmask(SIG_SETMASK, $sigset) or Fatal("Can't restore SIGCHLD: $!"); 462 } elsif ( defined($child_pid) ) { 463 # Child process 464 465 # Force reconnection to the db. $dbh got copied, but isn't really valid anymore. 466 $dbh = zmDbConnect(1); 467 logReinit(); 468 469 dPrint(ZoneMinder::Logger::INFO, "'$command' started at " 470 .strftime('%y/%m/%d %H:%M:%S', localtime()) 471 ."\n" 472 ); 473 474 if ( $daemon =~ /^${daemon_patt}$/ ) { 475 $daemon = $Config{ZM_PATH_BIN}.'/'.$1; 476 } else { 477 Fatal("Invalid daemon '$daemon' specified"); 478 } 479 480 my @good_args; 481 foreach my $arg ( @args ) { 482 # Detaint arguments, if they look ok 483 if ( $arg =~ /^(-{0,2}[\w\/?&=.-]+)$/ ) { 484 push @good_args, $1; 485 } else { 486 Fatal("Bogus argument '$arg' found"); 487 } 488 } 489 490 logTerm(); 491 zmDbDisconnect(); 492 493 my $fd = 3; # leave stdin,stdout,stderr open. Closing them causes problems with libx264 494 while ( $fd < POSIX::sysconf(&POSIX::_SC_OPEN_MAX) ) { 495 POSIX::close($fd++); 496 } 497 498 $SIG{CHLD} = 'DEFAULT'; 499 $SIG{HUP} = 'DEFAULT'; 500 $SIG{INT} = 'DEFAULT'; 501 $SIG{TERM} = 'DEFAULT'; 502 $SIG{ABRT} = 'DEFAULT'; 503 504 exec($daemon, @good_args) or Fatal("Can't exec: $!"); 505 } else { 506 Fatal("Can't fork: $!"); 507 } 508} # end sub start 509 510# Sends the stop signal, without waiting around to see if the process died. 511sub send_stop { 512 my ( $final, $process ) = @_; 513 514 my $sigset = POSIX::SigSet->new; 515 my $blockset = POSIX::SigSet->new(SIGCHLD); 516 sigprocmask(SIG_BLOCK, $blockset, $sigset) or die "dying at block...\n"; 517 518 my $command = $process->{command}; 519 if ( $process->{pending} ) { 520 delete $cmd_hash{$command}; 521 dPrint(ZoneMinder::Logger::INFO, "Command '$command' removed from pending list at " 522 .strftime('%y/%m/%d %H:%M:%S', localtime()) 523 ."\n" 524 ); 525 sigprocmask(SIG_UNBLOCK, $blockset) or die "dying at unblock...\n"; 526 return(); 527 } 528 529 my $pid = $process->{pid}; 530 if ( !$pid ) { 531 dPrint(ZoneMinder::Logger::ERROR, "No process with command of '$command' is running\n"); 532 sigprocmask(SIG_UNBLOCK, $blockset) or die "dying at unblock...\n"; 533 return(); 534 } 535 if ( !$pid_hash{$pid} ) { 536 dPrint(ZoneMinder::Logger::ERROR, "No process with command of '$command' pid $pid is running\n"); 537 sigprocmask(SIG_UNBLOCK, $blockset) or die "dying at unblock...\n"; 538 return(); 539 } 540 541 dPrint(ZoneMinder::Logger::INFO, "'$command' sending stop to pid $pid at " 542 .strftime('%y/%m/%d %H:%M:%S', localtime()) 543 ."\n" 544 ); 545 $process->{keepalive} = !$final; 546 $process->{term_sent_at} = time if ! $process->{term_sent_at}; 547 $process->{pending} = 0; 548 $terminating_processes{$command} = $process; 549 550 kill('TERM', $pid); 551 sigprocmask(SIG_UNBLOCK, $blockset) or die "dying at unblock...\n"; 552 return $pid; 553} # end sub send_stop 554 555sub check_for_processes_to_kill { 556 # Turn off SIGCHLD 557 my $sigset = POSIX::SigSet->new; 558 my $blockset = POSIX::SigSet->new(SIGCHLD); 559 sigprocmask(SIG_BLOCK, $blockset, $sigset) or die "dying at block...\n"; 560 foreach my $command ( keys %terminating_processes ) { 561 my $process = $cmd_hash{$command}; 562 if ( ! $process ) { 563 Debug("No process found for $command"); 564 delete $terminating_processes{$command}; 565 next; 566 } 567 if ( ! $$process{pid} ) { 568 Warning("Have no pid for $command."); 569 delete $terminating_processes{$command}; 570 next; 571 } 572 my $now = time; 573 Debug("Have process $command at pid $$process{pid} $now - $$process{term_sent_at} = " . ( $now - $$process{term_sent_at} )); 574 if ( $$process{term_sent_at} and ( $now - $$process{term_sent_at} > KILL_DELAY ) ) { 575 dPrint(ZoneMinder::Logger::WARNING, "'$$process{command}' has not stopped at " 576 .strftime('%y/%m/%d %H:%M:%S', localtime()) 577 .' after ' . KILL_DELAY . ' seconds.' 578 ." Sending KILL to pid $$process{pid}\n" 579 ); 580 kill('KILL', $$process{pid}); 581 delete $terminating_processes{$command}; 582 } 583 } 584 sigprocmask(SIG_UNBLOCK, $blockset) or die "dying at unblock...\n"; 585} # end sub check_for_processess_to_kill 586 587sub stop { 588 my ( $daemon, @args ) = @_; 589 my $command = join(' ', $daemon, @args ); 590 my $process = $cmd_hash{$command}; 591 if ( !$process ) { 592 dPrint(ZoneMinder::Logger::WARNING, "Can't find process with command of '$command'"); 593 return; 594 } 595 596 send_stop(1, $process); 597} 598 599# restart is the same as stop, except that we flag the processes for restarting once it dies 600# One difference is that if we don't know about the process, then we start it. 601sub restart { 602 my ( $daemon, @args ) = @_; 603 604 my $command = join(' ', $daemon, @args); 605 dPrint(ZoneMinder::Logger::DEBUG, "Restarting $command\n"); 606 my $process = $cmd_hash{$command}; 607 if ( !$process ) { 608 dPrint(ZoneMinder::Logger::WARNING, "Can't find process with command of '$command'\n"); 609 start($daemon, @args); 610 return; 611 } 612 # Start will be handled by the reaper... 613 # unless it was already pending in which case send_stop will return () so we should start it 614 if ( !send_stop(0, $process) ) { 615 dPrint(ZoneMinder::Logger::WARNING, "!send_stop so starting '$command'\n"); 616 start($daemon, @args); 617 } 618 return; 619} 620 621sub reload { 622 my $daemon = shift; 623 my @args = @_; 624 625 my $command = join(' ', $daemon, @args); 626 my $process = $cmd_hash{$command}; 627 if ( $process ) { 628 if ( $process->{pid} ) { 629 kill('HUP', $process->{pid}); 630 } 631 } 632} 633 634sub logrot { 635 logReinit(); 636 foreach my $process ( values %pid_hash ) { 637 if ( $process->{pid} ) { 638 Debug("Hupping $$process{command} at $$process{pid}"); 639 # && $process->{command} =~ /^zm.*\.pl/ ) { 640 kill('HUP', $process->{pid}); 641 } else { 642 Debug("Not Hupping $$process{command}"); 643 } 644 } 645} 646 647sub shutdown_sig_handler { 648 $zm_terminate = 1; 649} 650 651sub chld_sig_handler { 652 my $saved_status = $!; 653 654 # Wait for a child to terminate 655 while ( (my $cpid = waitpid(-1, WNOHANG)) > 0 ) { 656 $pids_to_reap{$cpid} = { status=>$?, stopped=>time() }; 657 } # end while waitpid 658 $SIG{CHLD} = \&chld_sig_handler; 659 $! = $saved_status; 660} 661 662sub reaper { 663 foreach my $cpid ( keys %pids_to_reap ) { 664 my $process = $pid_hash{$cpid}; 665 delete $pid_hash{$cpid}; 666 my $reap_info = $pids_to_reap{$cpid}; 667 my ( $status, $stopped ) = @$reap_info{'status','stopped'}; 668 delete $pids_to_reap{$cpid}; 669 670 if ( !$process ) { 671 dPrint(ZoneMinder::Logger::INFO, "Can't find child with pid of '$cpid'\n"); 672 next; 673 } 674 delete $terminating_processes{$$process{command}}; 675 delete $$process{term_sent_at}; 676 677 $process->{stopped} = $stopped; 678 $process->{runtime} = ($process->{stopped}-$process->{started}); 679 delete $process->{pid}; 680 681 my $exit_status = $status>>8; 682 my $exit_signal = $status&0xfe; 683 my $core_dumped = $status&0x01; 684 685 my $out_str = "'$process->{command}' "; 686 if ( $exit_signal ) { 687 # 15 == TERM, 14 == ALARM 688 if ( $exit_signal == 15 || $exit_signal == 14 ) { 689 $out_str .= 'exited'; 690 } else { 691 $out_str .= 'crashed'; 692 } 693 $out_str .= ", signal $exit_signal"; 694 } else { 695 $out_str .= 'exited '; 696 if ( $exit_status ) { 697 $out_str .= "abnormally, exit status $exit_status"; 698 } else { 699 $out_str .= 'normally'; 700 } 701 } 702#print( ", core dumped" ) if ( $core_dumped ); 703 $out_str .= "\n"; 704 705 if ( $exit_status == 0 ) { 706 Info($out_str); 707 } else { 708 Error($out_str); 709 } 710 711 if ( $process->{keepalive} ) { 712# Schedule for immediate restart 713 $cmd_hash{$process->{command}} = $process; 714 if ( !$process->{delay} || ($process->{runtime} > $Config{ZM_MAX_RESTART_DELAY} ) ) { 715#start( $process->{daemon}, @{$process->{args}} ); 716 $process->{pending} = $process->{stopped}; 717 $process->{delay} = 5; 718 } else { 719 $process->{pending} = $process->{stopped}+$process->{delay}; 720 $process->{delay} *= 2; 721# Limit the start delay to 15 minutes max 722 if ( $process->{delay} > $Config{ZM_MAX_RESTART_DELAY} ) { 723 $process->{delay} = $Config{ZM_MAX_RESTART_DELAY}; 724 } 725 } 726 #Debug("Delay for $$process{command} is now $$process{delay}"); 727 } else { 728 delete $cmd_hash{$$process{command}}; 729 } 730 } # end foreach pid_to_reap 731} # end sub reaper 732 733sub restartPending { 734# Restart any pending processes, we list them first because cmd_hash may change in foreach 735 my @processes = values %cmd_hash; 736 foreach my $process ( @processes ) { 737 if ( $process->{pending} && $process->{pending} <= time() ) { 738 dPrint(ZoneMinder::Logger::INFO, "Starting pending process, $process->{command}\n"); 739 start($process->{daemon}, @{$process->{args}}); 740 } 741 } 742} 743 744sub shutdownAll { 745 foreach my $pid ( keys %pid_hash ) { 746# This is a quick fix because a SIGCHLD can happen and alter pid_hash while we are in here. 747 next if ! $pid_hash{$pid}; 748 send_stop(1, $pid_hash{$pid}); 749 } 750 while ( keys %terminating_processes ) { 751 752 reaper() if %pids_to_reap; 753 check_for_processes_to_kill(); 754 if ( %terminating_processes ) { 755 Debug("Still " . %terminating_processes . ' to die. sleeping'); 756 sleep(1); 757 } 758 } 759 dPrint(ZoneMinder::Logger::INFO, 'Server shutdown at ' 760 .strftime('%y/%m/%d %H:%M:%S', localtime()) 761 ."\n" 762 ); 763 unlink(main::SOCK_FILE) or Error("Unable to unlink " . main::SOCK_FILE .". Error message was: $!") if ( -e main::SOCK_FILE ); 764 unlink(ZM_PID) or Error("Unable to unlink " . ZM_PID .". Error message was: $!") if ( -e ZM_PID ); 765 close(CLIENT); 766 close(SERVER); 767 exit(); 768} 769 770sub check { 771 my $daemon = shift; 772 my @args = @_; 773 774 my $command = join(' ', $daemon, @args); 775 my $process = $cmd_hash{$command}; 776 if ( !$process ) { 777 cPrint("unknown\n"); 778 } elsif ( $process->{pending} ) { 779 cPrint("pending\n"); 780 } else { 781 my $cpid = $process->{pid}; 782 if ( ! $pid_hash{$cpid} ) { 783 cPrint("stopped\n"); 784 } else { 785 cPrint("running\n"); 786 } 787 } 788} 789 790sub status { 791 my $daemon = shift; 792 my @args = @_; 793 794 if ( defined($daemon) ) { 795 my $command = join(' ', $daemon, @args); 796 my $process = $cmd_hash{$command}; 797 if ( ! $process ) { 798 dPrint(ZoneMinder::Logger::DEBUG, "'$command' not running\n"); 799 return; 800 } 801 802 if ( $process->{pending} ) { 803 dPrint(ZoneMinder::Logger::DEBUG, "'$command' pending at " 804 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{pending})) 805 ."\n" 806 ); 807 } else { 808 my $pid = $process->{pid}; 809 if ( ! $pid_hash{$pid} ) { 810 dPrint(ZoneMinder::Logger::DEBUG, "'$command' not running\n"); 811 return; 812 } 813 } 814 dPrint(ZoneMinder::Logger::DEBUG, "'$command' running since " 815 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{started})) 816 .", pid = $process->{pid}" 817 ); 818 } else { 819 foreach my $process ( values %pid_hash ) { 820 my $out_str = "'$process->{command}' running since " 821 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{started})) 822 .", pid = $process->{pid}" 823 ; 824 $out_str .= ", valid" if ( kill(0, $process->{pid}) ); 825 $out_str .= "\n"; 826 dPrint(ZoneMinder::Logger::DEBUG, $out_str); 827 } 828 foreach my $process ( values %cmd_hash ) { 829 if ( $process->{pending} ) { 830 dPrint(ZoneMinder::Logger::DEBUG, "'$process->{command}' pending at " 831 .strftime('%y/%m/%d %H:%M:%S', localtime($process->{pending})) 832 ."\n" 833 ); 834 } 835 } # end foreach process 836 } 837} # end sub status 838 839sub killAll { 840 my $delay = shift; 841 # Why sleep before sending term? 842 #sleep( $delay ); 843 my $killall; 844 if ( '@HOST_OS@' eq 'BSD' ) { 845 $killall = 'killall -q -'; 846 } elsif ( '@HOST_OS@' eq 'solaris' ) { 847 $killall = 'pkill -'; 848 } else { 849 $killall = 'killall -q -s '; 850 } 851 foreach my $daemon ( @daemons ) { 852 my $cmd = $killall ."TERM $daemon"; 853 Debug($cmd); 854 qx($cmd); 855 } 856 sleep($delay); 857 foreach my $daemon ( @daemons ) { 858 my $cmd = $killall."KILL $daemon"; 859 Debug($cmd); 860 qx($cmd); 861 } 862} 8631; 864__END__ 865