modules/fallback/Daemon/Generic.pm

   1
   2 # Copyright (C) 2006, David Muir Sharnoff <perl@dave.sharnoff.org>
   3
   4 package Daemon::Generic;
   5
   6 use strict;
   7 use warnings;
   8 require Exporter;
   9 require POSIX;
  10 use Getopt::Long;
  11 use File::Slurp;
  12 use File::Flock;
  13 our @ISA = qw(Exporter);
  14 our @EXPORT = qw(newdaemon);
  15
  16 our $VERSION = 0.71;
  17
  18 our $force_quit_delay = 15;
  19 our $package = __PACKAGE__;
  20 our $caller;
  21
  22 sub newdaemon
  23 {
  24         my (%args) = @_;
  25         my $pkg = $caller || caller() || 'main';
  26
  27         my $foo = bless {}, $pkg;
  28
  29         unless ($foo->isa($package)) {
  30                 no strict qw(refs);
  31                 my $isa = \@{"${pkg}::ISA"};
  32                 unshift(@$isa, $package);
  33         }
  34
  35         bless $foo, 'This::Package::Does::Not::Exist';
  36         undef $foo;
  37
  38         new($pkg, %args);
  39 }
  40
  41 sub new
  42 {
  43         my ($pkg, %args) = @_;
  44
  45         if ($pkg eq __PACKAGE__) {
  46                 $pkg = caller() || 'main';
  47         }
  48
  49         srand(time ^ ($$ << 5))
  50                 unless $args{no_srand};
  51
  52         my $av0 = $0;
  53         $av0 =~ s!/!/.!g;
  54
  55         my $self = {
  56                 gd_args         => \%args,
  57                 gd_pidfile      => $args{pidfile},
  58                 gd_logpriority  => $args{logpriority},
  59                 gd_progname     => $args{progname}
  60                                         ? $args{progname}
  61                                         : $0,
  62                 gd_pidbase      => $args{pidbase}
  63                                         ? $args{pidbase}
  64                                         : ($args{progname}
  65                                                 ? "/var/run/$args{progname}"
  66                                                 : "/var/run/$av0"),
  67                 gd_foreground   => $args{foreground} || 0,
  68                 configfile      => $args{configfile}
  69                                         ? $args{configfile}
  70                                         : ($args{progname}
  71                                                 ? "/etc/$args{progname}.conf"
  72                                                 : "/etc/$av0"),
  73                 debug           => $args{debug} || 0,
  74         };
  75         bless $self, $pkg;
  76
  77         $self->gd_getopt;
  78         $self->gd_parse_argv;
  79
  80         my $do = $self->{do} = $ARGV[0];
  81
  82         $self->gd_help          if $do eq 'help';
  83         $self->gd_version       if $do eq 'version';
  84         $self->gd_install       if $do eq 'install';
  85         $self->gd_uninstall     if $do eq 'uninstall';
  86
  87         $self->gd_pidfile unless $self->{gd_pidfile};
  88
  89         my %newconfig = $self->gd_preconfig;
  90
  91         $self->{gd_pidfile} = $newconfig{pidfile} if $newconfig{pidfile};
  92
  93         print "Configuration looks okay\n" if $do eq 'check';
  94
  95         my $pidfile = $self->{gd_pidfile};
  96         my $killed = 0;
  97         my $locked = 0;
  98         if (-e $pidfile) {
  99                 if ($locked = lock($pidfile, undef, 'nonblocking')) {
 100                         # old process is dead
 101                         if ($do eq 'status') {
 102                             print "$0 dead\n";
 103                             exit 1;
 104                         }
 105                 } else {
 106                         sleep(2) if -M $pidfile < 2/86400;
 107                         my $oldpid = read_file($pidfile);
 108                         chomp($oldpid);
 109                         if ($oldpid) {
 110                                 if ($do eq 'stop' or $do eq 'restart') {
 111                                         $killed = $self->gd_kill($oldpid);
 112                                         $locked = lock($pidfile);
 113                                         if ($do eq 'stop') {
 114                                                 unlink($pidfile);
 115                                                 exit;
 116                                         }
 117                                 } elsif ($do eq 'reload') {
 118                                         if (kill(1,$oldpid)) {
 119                                                 print "Requested reconfiguration\n";
 120                                                 exit;
 121                                         } else {
 122                                                 print "Kill failed: $!\n";
 123                                         }
 124                                 } elsif ($do eq 'status') {
 125                                         if (kill(0,$oldpid)) {
 126                                                 print "$0 running - pid $oldpid\n";
 127                                                 $self->gd_check($pidfile, $oldpid);
 128                                                 exit 0;
 129                                         } else {
 130                                                 print "$0 dead\n";
 131                                                 exit 1;
 132                                         }
 133                                 } elsif ($do eq 'check') {
 134                                         if (kill(0,$oldpid)) {
 135                                                 print "$0 running - pid $oldpid\n";
 136                                                 $self->gd_check($pidfile, $oldpid);
 137                                                 exit;
 138                                         }
 139                                 } elsif ($do eq 'start') {
 140                                         print "\u$self->{gd_progname} is already running (pid $oldpid)\n";
 141                                         exit; # according to LSB, this is no error
 142                                 }
 143                         } else {
 144                                 $self->gd_error("Pid file $pidfile is invalid but locked, exiting\n");
 145                         }
 146                 }
 147         } else {
 148                 $locked = lock($pidfile, undef, 'nonblocking')
 149                         or die "Could not lock pid file $pidfile: $!";
 150         }
 151
 152         if ($do eq 'reload' || $do eq 'stop' || $do eq 'check' || ($do eq 'restart' && ! $killed)) {
 153                 print "No $0 running\n";
 154         }
 155
 156         if ($do eq 'stop') {
 157                 unlink($pidfile);
 158                 exit;
 159         }
 160
 161         if ($do eq 'status') {
 162                 print "Unused\n";
 163                 exit 3;
 164         }
 165
 166         if ($do eq 'check') {
 167                 $self->gd_check($pidfile);
 168                 exit
 169         }
 170
 171         unless ($do eq 'reload' || $do eq 'restart' || $do eq 'start') {
 172                 $self->gd_other_cmd($do, $locked);
 173         }
 174
 175         unless ($self->{gd_foreground}) {
 176                 $self->gd_daemonize;
 177         }
 178
 179         $locked or lock($pidfile, undef, 'nonblocking')
 180                 or die "Could not lock PID file $pidfile: $!";
 181
 182         write_file($pidfile, "$$\n");
 183
 184         print STDERR "Starting up...\n";
 185
 186         $self->gd_postconfig(%newconfig);
 187
 188         $self->gd_setup_signals;
 189
 190         $self->gd_run;
 191
 192         unlink($pidfile);
 193         exit(0);
 194 }
 195
 196 sub gd_check {}
 197
 198 sub gd_more_opt { return() }
 199
 200 sub gd_getopt
 201 {
 202         my $self = shift;
 203         Getopt::Long::Configure("auto_version");
 204         GetOptions(
 205                 'configfile=s'  => \$self->{configfile},
 206                 'foreground!'   => \$self->{gd_foreground},
 207                 'debug!'        => \$self->{debug},
 208                 $self->{gd_args}{options}
 209                         ? %{$self->{gd_args}{options}}
 210                         : (),
 211                 $self->gd_more_opt(),
 212         ) or exit($self->gd_usage());
 213
 214         if (@ARGV < ($self->{gd_args}{minimum_args} || 1)) {
 215                 exit($self->gd_usage());
 216         }
 217         if (@ARGV > ($self->{gd_args}{maximum_args} || 1)) {
 218                 exit($self->gd_usage());
 219         }
 220 }
 221
 222 sub gd_parse_argv { }
 223
 224 sub gd_help
 225 {
 226         my $self = shift;
 227         exit($self->gd_usage($self->{gd_args}));
 228 }
 229
 230 sub gd_version
 231 {
 232         my $self = shift;
 233         no strict qw(refs);
 234         my $v = $self->{gd_args}{version}
 235                 || ${ref($self)."::VERSION"}
 236                 || $::VERSION
 237                 || $main::VERSION
 238                 || "?";
 239         print "$self->{gd_progname} - version $v\n";;
 240         exit;
 241 }
 242
 243 sub gd_pidfile
 244 {
 245         my $self = shift;
 246         my $x = $self->{configfile};
 247         $x =~ s!/!.!g;
 248         $self->{gd_pidfile} = "$self->{gd_pidbase}$x.pid";
 249 }
 250
 251 sub gd_other_cmd
 252 {
 253         my $self = shift;
 254         $self->gd_usage;
 255         exit(1);
 256 }
 257
 258 sub gd_redirect_output
 259 {
 260         my $self = shift;
 261         return if $self->{gd_foreground};
 262         my $logname = $self->gd_logname;
 263         my $p = $self->{gd_logpriority} ? "-p $self->{gd_logpriority}" : "";
 264         open(STDERR, "|logger $p -t '$logname'") or (print "could not open stderr: $!" && exit(1));
 265         close(STDOUT);
 266         open(STDOUT, ">&STDERR") or die "redirect STDOUT -> STDERR: $!";
 267         close(STDIN);
 268 }
 269
 270 sub gd_daemonize
 271 {
 272         my $self = shift;
 273         print "Starting $self->{gd_progname} server\n";
 274         $self->gd_redirect_output();
 275         my $pid;
 276         POSIX::_exit(0) if $pid = fork;
 277         die "Could not fork: $!" unless defined $pid;
 278         POSIX::_exit(0) if $pid = fork;
 279         die "Could not fork: $!" unless defined $pid;
 280
 281         POSIX::setsid();
 282         select(STDERR);
 283         $| = 1;
 284         print "Sucessfully daemonized\n";
 285 }
 286
 287 sub gd_logname
 288 {
 289         my $self = shift;
 290         return $self->{gd_progname}."[$$]";
 291 }
 292
 293 sub gd_reconfig_event
 294 {
 295         my $self = shift;
 296         print STDERR "Reconfiguration requested\n";
 297         $self->gd_postconfig($self->gd_preconfig());
 298 }
 299
 300 sub gd_quit_event
 301 {
 302         my $self = shift;
 303         print STDERR "Quitting...\n";
 304         exit(0);
 305 }
 306
 307 sub gd_setup_signals
 308 {
 309         my $self = shift;
 310         $SIG{INT} = sub { $self->gd_quit_event() };
 311         $SIG{HUP} = sub { $self->gd_reconfig_event() };
 312 }
 313
 314 sub gd_run { die "must defined gd_run()" }
 315
 316 sub gd_error
 317 {
 318         my $self = shift;
 319         my $e = shift;
 320         my $do = $self->{do};
 321         if ($do && $do eq 'stop') {
 322                 warn $e;
 323         } else {
 324                 die $e;
 325         }
 326 }
 327
 328 sub gd_flags_more { return () }
 329
 330 sub gd_flags
 331 {
 332         my $self = shift;
 333         return (
 334                 '-c file'       => "Specify configuration file (instead of $self->{configfile})",
 335                 '-f'            => "Run in the foreground (don't detach)",
 336                 $self->gd_flags_more
 337         );
 338 }
 339
 340 sub gd_commands_more { return () }
 341
 342 sub gd_commands
 343 {
 344         my $self = shift;
 345         return (
 346                 start           => "Starts a new $self->{gd_progname} if there isn't one running already",
 347                 stop            => "Stops a running $self->{gd_progname}",
 348                 reload          => "Causes a running $self->{gd_progname} to reload it's config file.  Starts a new one if none is running.",
 349                 restart         => "Stops a running $self->{gd_progname} if one is running.  Starts a new one.",
 350                 $self->gd_commands_more(),
 351                 ($self->gd_can_install()
 352                         ? ('install' => "Setup $self->{gd_progname} to run automatically after reboot")
 353                         : ()),
 354                 ($self->gd_can_uninstall()
 355                         ? ('uninstall' => "Do not run $self->{gd_progname} after reboots")
 356                         : ()),
 357                 check           => "Check the configuration file and report the daemon state",
 358                 help            => "Display this usage info",
 359                 version         => "Display the version of $self->{gd_progname}",
 360         )
 361 }
 362
 363 sub gd_positional_more { return() }
 364
 365 sub gd_alts
 366 {
 367         my $offset = shift;
 368         my @results;
 369         for (my $i = $offset; $i <= $#_; $i += 2) {
 370                 push(@results, $_[$i]);
 371         }
 372         return @results;
 373 }
 374
 375 sub gd_usage
 376 {
 377         my $self = shift;
 378
 379         require Text::Wrap;
 380         import Text::Wrap;
 381
 382         my $col = 15;
 383
 384         my @flags = $self->gd_flags;
 385         my @commands = $self->gd_commands;
 386         my @positional = $self->gd_positional_more;
 387
 388         my $summary = "Usage: $self->{gd_progname} ";
 389         my $details = '';
 390         for my $i (gd_alts(0, @flags)) {
 391                 $summary .= "[ $i ] ";
 392         }
 393         $summary .= "{ ";
 394         $summary .= join(" | ", gd_alts(0, @commands));
 395         $summary .= " } ";
 396         $summary .= join(" ", gd_alts(0, @positional));
 397
 398         my (@all) = (@flags, @commands, @positional);
 399         while (@all) {
 400                 my ($key, $desc) = splice(@all, 0, 2);
 401                 local($Text::Wrap::columns) = 79;
 402                 $details .= wrap(
 403                         sprintf(" %-${col}s ", $key),
 404                         " " x ($col + 2),
 405                         $desc);
 406                 $details .= "\n";
 407         }
 408
 409         print "$summary\n$details";
 410         return 0;
 411 }
 412
 413 sub gd_install_pre {}
 414 sub gd_install_post {}
 415
 416 sub gd_can_install
 417 {
 418         my $self = shift;
 419         require File::Basename;
 420         my $basename = File::Basename::basename($0);
 421         if (
 422                 -x "/usr/sbin/update-rc.d"
 423                 &&
 424                 -x $0
 425                 &&
 426                 $0 !~ m{^(?:/usr|/var)?/tmp/}
 427                 &&
 428                 eval { symlink("",""); 1 }
 429                 &&
 430                 -d "/etc/init.d"
 431                 &&
 432                 ! -e "/etc/init.d/$basename"
 433         ) {
 434                 return sub {
 435                         $self->gd_install_pre("update-rc.d");
 436                         require Cwd;
 437                         my $abs_path = Cwd::abs_path($0);
 438                         symlink($abs_path, "/etc/init.d/$basename")
 439                                 or die "Install failed: symlink /etc/init.d/$basename -> $abs_path: $!\n";
 440                         print "+ /usr/sbin/update-rc.d $basename defaults\n";
 441                         system("/usr/sbin/update-rc.d", $basename, "defaults");
 442                         my $exit = $? >> 8;
 443                         $self->gd_install_post("update-rc.d");
 444                         exit($exit) if $exit;
 445                 };
 446         }
 447
 448         return 0;
 449 }
 450
 451 sub gd_install
 452 {
 453         my $self = shift;
 454         my $ifunc = $self->gd_can_install();
 455         die "Install command not supported\n" unless $ifunc;
 456         &$ifunc($self);
 457         exit(0);
 458 }
 459
 460 sub gd_uninstall_pre {}
 461 sub gd_uninstall_post {}
 462
 463 sub gd_can_uninstall
 464 {
 465         my $self = shift;
 466         require File::Basename;
 467         my $basename = File::Basename::basename($0);
 468         require Cwd;
 469         my $abs_path = Cwd::abs_path($0) || 'no abs path';
 470         my $link = readlink("/etc/init.d/$basename") || 'no link';
 471         if (
 472                 $link eq $abs_path
 473                 &&
 474                 -x "/usr/sbin/update-rc.d"
 475         ) {
 476                 return sub {
 477                         $self->gd_uninstall_pre("update-rc.d");
 478                         unlink("/etc/init.d/$basename");
 479                         print "+ /usr/sbin/update-rc.d $basename remove\n";
 480                         system("/usr/sbin/update-rc.d", $basename, "remove");
 481                         my $exit = $? >> 8;
 482                         $self->gd_uninstall_post("update-rc.d");
 483                         exit($exit) if $exit;
 484                 }
 485         }
 486         return 0;
 487 }
 488
 489 sub gd_uninstall
 490 {
 491         my $self = shift;
 492         my $ufunc = $self->gd_can_uninstall();
 493         die "Cannot uninstall\n" unless $ufunc;
 494         &$ufunc($self);
 495         exit(0);
 496 }
 497
 498 sub gd_kill
 499 {
 500         my ($self, $pid) = @_;
 501
 502         my $talkmore = 0;
 503         my $killed = 0;
 504         if (kill(0, $pid)) {
 505                 $killed = 1;
 506                 kill(2,$pid);
 507                 print "Killing $pid\n";
 508                 my $t = time;
 509                 sleep(1) if kill(0, $pid);
 510                 if ($force_quit_delay && kill(0, $pid)) {
 511                         print "Waiting for $pid to die...\n";
 512                         $talkmore = 1;
 513                         while(kill(0, $pid) && time - $t < $force_quit_delay) {
 514                                 sleep(1);
 515                         }
 516                 }
 517                 if (kill(15, $pid)) {
 518                         print "Killing $pid with -TERM...\n";
 519                         if ($force_quit_delay) {
 520                                 while(kill(0, $pid) && time - $t < $force_quit_delay * 2) {
 521                                         sleep(1);
 522                                 }
 523                         } else {
 524                                 sleep(1) if kill(0, $pid);
 525                         }
 526                 }
 527                 if (kill(9, $pid)) {
 528                         print "Killing $pid with -KILL...\n";
 529                         my $k9 = time;
 530                         my $max = $force_quit_delay * 4;
 531                         $max = 60 if $max < 60;
 532                         while(kill(0, $pid)) {
 533                                 if (time - $k9 > $max) {
 534                                         print "Giving up on $pid ever dying.\n";
 535                                         exit(1);
 536                                 }
 537                                 print "Waiting for $pid to die...\n";
 538                                 sleep(1);
 539                         }
 540                 }
 541                 print "Process $pid is gone\n" if $talkmore;
 542         } else {
 543                 print "Process $pid no longer running\n";
 544         }
 545         return $killed;
 546 }
 547
 548 sub gd_preconfig { die "gd_preconfig() must be redefined"; }
 549
 550 sub gd_postconfig { }
 551
 552
 553 1;