2 # Copyright (C) 2006, David Muir Sharnoff <perl@dave.sharnoff.org>
4 package Daemon::Generic;
13 our @ISA = qw(Exporter);
14 our @EXPORT = qw(newdaemon);
18 our $force_quit_delay = 15;
19 our $package = __PACKAGE__;
25 my $pkg = $caller || caller() || 'main';
27 my $foo = bless {}, $pkg;
29 unless ($foo->isa($package)) {
31 my $isa = \@{"${pkg}::ISA"};
32 unshift(@$isa, $package);
35 bless $foo, 'This::Package::Does::Not::Exist';
43 my ($pkg, %args) = @_;
45 if ($pkg eq __PACKAGE__) {
46 $pkg = caller() || 'main';
49 srand(time ^ ($$ << 5))
50 unless $args{no_srand};
57 gd_pidfile => $args{pidfile},
58 gd_logpriority => $args{logpriority},
59 gd_progname => $args{progname}
62 gd_pidbase => $args{pidbase}
65 ? "/var/run/$args{progname}"
67 gd_foreground => $args{foreground} || 0,
68 configfile => $args{configfile}
71 ? "/etc/$args{progname}.conf"
73 debug => $args{debug} || 0,
80 my $do = $self->{do} = $ARGV[0];
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';
87 $self->gd_pidfile unless $self->{gd_pidfile};
89 my %newconfig = $self->gd_preconfig;
91 $self->{gd_pidfile} = $newconfig{pidfile} if $newconfig{pidfile};
93 print "Configuration looks okay\n" if $do eq 'check';
95 my $pidfile = $self->{gd_pidfile};
99 if ($locked = lock($pidfile, undef, 'nonblocking')) {
100 # old process is dead
101 if ($do eq 'status') {
106 sleep(2) if -M $pidfile < 2/86400;
107 my $oldpid = read_file($pidfile);
110 if ($do eq 'stop' or $do eq 'restart') {
111 $killed = $self->gd_kill($oldpid);
112 $locked = lock($pidfile);
117 } elsif ($do eq 'reload') {
118 if (kill(1,$oldpid)) {
119 print "Requested reconfiguration\n";
122 print "Kill failed: $!\n";
124 } elsif ($do eq 'status') {
125 if (kill(0,$oldpid)) {
126 print "$0 running - pid $oldpid\n";
127 $self->gd_check($pidfile, $oldpid);
133 } elsif ($do eq 'check') {
134 if (kill(0,$oldpid)) {
135 print "$0 running - pid $oldpid\n";
136 $self->gd_check($pidfile, $oldpid);
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
144 $self->gd_error("Pid file $pidfile is invalid but locked, exiting\n");
148 $locked = lock($pidfile, undef, 'nonblocking')
149 or die "Could not lock pid file $pidfile: $!";
152 if ($do eq 'reload' || $do eq 'stop' || $do eq 'check' || ($do eq 'restart' && ! $killed)) {
153 print "No $0 running\n";
161 if ($do eq 'status') {
166 if ($do eq 'check') {
167 $self->gd_check($pidfile);
171 unless ($do eq 'reload' || $do eq 'restart' || $do eq 'start') {
172 $self->gd_other_cmd($do, $locked);
175 unless ($self->{gd_foreground}) {
179 $locked or lock($pidfile, undef, 'nonblocking')
180 or die "Could not lock PID file $pidfile: $!";
182 write_file($pidfile, "$$\n");
184 print STDERR "Starting up...\n";
186 $self->gd_postconfig(%newconfig);
188 $self->gd_setup_signals;
198 sub gd_more_opt { return() }
203 Getopt::Long::Configure("auto_version");
205 'configfile=s' => \$self->{configfile},
206 'foreground!' => \$self->{gd_foreground},
207 'debug!' => \$self->{debug},
208 $self->{gd_args}{options}
209 ? %{$self->{gd_args}{options}}
211 $self->gd_more_opt(),
212 ) or exit($self->gd_usage());
214 if (@ARGV < ($self->{gd_args}{minimum_args} || 1)) {
215 exit($self->gd_usage());
217 if (@ARGV > ($self->{gd_args}{maximum_args} || 1)) {
218 exit($self->gd_usage());
222 sub gd_parse_argv { }
227 exit($self->gd_usage($self->{gd_args}));
234 my $v = $self->{gd_args}{version}
235 || ${ref($self)."::VERSION"}
239 print "$self->{gd_progname} - version $v\n";;
246 my $x = $self->{configfile};
248 $self->{gd_pidfile} = "$self->{gd_pidbase}$x.pid";
258 sub gd_redirect_output
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));
266 open(STDOUT, ">&STDERR") or die "redirect STDOUT -> STDERR: $!";
273 print "Starting $self->{gd_progname} server\n";
274 $self->gd_redirect_output();
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;
284 print "Sucessfully daemonized\n";
290 return $self->{gd_progname}."[$$]";
293 sub gd_reconfig_event
296 print STDERR "Reconfiguration requested\n";
297 $self->gd_postconfig($self->gd_preconfig());
303 print STDERR "Quitting...\n";
310 $SIG{INT} = sub { $self->gd_quit_event() };
311 $SIG{HUP} = sub { $self->gd_reconfig_event() };
314 sub gd_run { die "must defined gd_run()" }
320 my $do = $self->{do};
321 if ($do && $do eq 'stop') {
328 sub gd_flags_more { return () }
334 '-c file' => "Specify configuration file (instead of $self->{configfile})",
335 '-f' => "Run in the foreground (don't detach)",
340 sub gd_commands_more { 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")
354 ($self->gd_can_uninstall()
355 ? ('uninstall' => "Do not run $self->{gd_progname} after reboots")
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}",
363 sub gd_positional_more { return() }
369 for (my $i = $offset; $i <= $#_; $i += 2) {
370 push(@results, $_[$i]);
384 my @flags = $self->gd_flags;
385 my @commands = $self->gd_commands;
386 my @positional = $self->gd_positional_more;
388 my $summary = "Usage: $self->{gd_progname} ";
390 for my $i (gd_alts(0, @flags)) {
391 $summary .= "[ $i ] ";
394 $summary .= join(" | ", gd_alts(0, @commands));
396 $summary .= join(" ", gd_alts(0, @positional));
398 my (@all) = (@flags, @commands, @positional);
400 my ($key, $desc) = splice(@all, 0, 2);
401 local($Text::Wrap::columns) = 79;
403 sprintf(" %-${col}s ", $key),
409 print "$summary\n$details";
413 sub gd_install_pre {}
414 sub gd_install_post {}
419 require File::Basename;
420 my $basename = File::Basename::basename($0);
422 -x "/usr/sbin/update-rc.d"
426 $0 !~ m{^(?:/usr|/var)?/tmp/}
428 eval { symlink("",""); 1 }
432 ! -e "/etc/init.d/$basename"
435 $self->gd_install_pre("update-rc.d");
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");
443 $self->gd_install_post("update-rc.d");
444 exit($exit) if $exit;
454 my $ifunc = $self->gd_can_install();
455 die "Install command not supported\n" unless $ifunc;
460 sub gd_uninstall_pre {}
461 sub gd_uninstall_post {}
466 require File::Basename;
467 my $basename = File::Basename::basename($0);
469 my $abs_path = Cwd::abs_path($0) || 'no abs path';
470 my $link = readlink("/etc/init.d/$basename") || 'no link';
474 -x "/usr/sbin/update-rc.d"
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");
482 $self->gd_uninstall_post("update-rc.d");
483 exit($exit) if $exit;
492 my $ufunc = $self->gd_can_uninstall();
493 die "Cannot uninstall\n" unless $ufunc;
500 my ($self, $pid) = @_;
507 print "Killing $pid\n";
509 sleep(1) if kill(0, $pid);
510 if ($force_quit_delay && kill(0, $pid)) {
511 print "Waiting for $pid to die...\n";
513 while(kill(0, $pid) && time - $t < $force_quit_delay) {
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) {
524 sleep(1) if kill(0, $pid);
528 print "Killing $pid with -KILL...\n";
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";
537 print "Waiting for $pid to die...\n";
541 print "Process $pid is gone\n" if $talkmore;
543 print "Process $pid no longer running\n";
548 sub gd_preconfig { die "gd_preconfig() must be redefined"; }
550 sub gd_postconfig { }