X-Git-Url: http://wagnertech.de/gitweb/gitweb.cgi/mfinanz.git/blobdiff_plain/ee71ba3372b47b7de1e30d56db92c1315ae1e104..23d894990d46c57b3d354b080ca8a373dbeeb756:/modules/fallback/Daemon/Generic.pm

diff --git a/modules/fallback/Daemon/Generic.pm b/modules/fallback/Daemon/Generic.pm
new file mode 100644
index 000000000..c185e8ae6
--- /dev/null
+++ b/modules/fallback/Daemon/Generic.pm
@@ -0,0 +1,553 @@
+
+# Copyright (C) 2006, David Muir Sharnoff <perl@dave.sharnoff.org>
+
+package Daemon::Generic;
+
+use strict;
+use warnings;
+require Exporter;
+require POSIX;
+use Getopt::Long;
+use File::Slurp;
+use File::Flock;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(newdaemon);
+
+our $VERSION = 0.71;
+
+our $force_quit_delay = 15;
+our $package = __PACKAGE__;
+our $caller;
+
+sub newdaemon
+{
+	my (%args) = @_;
+	my $pkg = $caller || caller() || 'main';
+
+	my $foo = bless {}, $pkg;
+
+	unless ($foo->isa($package)) {
+		no strict qw(refs);
+		my $isa = \@{"${pkg}::ISA"};
+		unshift(@$isa, $package);
+	}
+
+	bless $foo, 'This::Package::Does::Not::Exist';
+	undef $foo;
+
+	new($pkg, %args);
+}
+
+sub new
+{
+	my ($pkg, %args) = @_;
+
+	if ($pkg eq __PACKAGE__) {
+		$pkg = caller() || 'main';
+	}
+
+	srand(time ^ ($$ << 5))
+		unless $args{no_srand};
+
+	my $av0 = $0;
+	$av0 =~ s!/!/.!g;
+
+	my $self = {
+		gd_args		=> \%args,
+		gd_pidfile	=> $args{pidfile},
+		gd_logpriority	=> $args{logpriority},
+		gd_progname	=> $args{progname}
+					? $args{progname}
+					: $0,
+		gd_pidbase	=> $args{pidbase}
+					? $args{pidbase}
+					: ($args{progname} 
+						? "/var/run/$args{progname}"
+						: "/var/run/$av0"),
+		gd_foreground	=> $args{foreground} || 0,
+		configfile	=> $args{configfile}
+					? $args{configfile}
+					: ($args{progname}
+						? "/etc/$args{progname}.conf"
+						: "/etc/$av0"),
+		debug		=> $args{debug} || 0,
+	};
+	bless $self, $pkg;
+
+	$self->gd_getopt;
+	$self->gd_parse_argv;
+
+	my $do = $self->{do} = $ARGV[0];
+
+	$self->gd_help		if $do eq 'help';
+	$self->gd_version	if $do eq 'version';
+	$self->gd_install	if $do eq 'install';
+	$self->gd_uninstall	if $do eq 'uninstall';
+
+	$self->gd_pidfile unless $self->{gd_pidfile};
+
+	my %newconfig = $self->gd_preconfig;
+
+	$self->{gd_pidfile} = $newconfig{pidfile} if $newconfig{pidfile};
+
+	print "Configuration looks okay\n" if $do eq 'check';
+
+	my $pidfile = $self->{gd_pidfile};
+	my $killed = 0;
+	my $locked = 0;
+	if (-e $pidfile) {
+		if ($locked = lock($pidfile, undef, 'nonblocking')) {
+			# old process is dead
+			if ($do eq 'status') {
+			    print "$0 dead\n";
+			    exit 1;
+			}
+		} else {
+			sleep(2) if -M $pidfile < 2/86400;
+			my $oldpid = read_file($pidfile);
+			chomp($oldpid);
+			if ($oldpid) {
+				if ($do eq 'stop' or $do eq 'restart') {
+					$killed = $self->gd_kill($oldpid);
+					$locked = lock($pidfile);
+					if ($do eq 'stop') {
+						unlink($pidfile);
+						exit;
+					}
+				} elsif ($do eq 'reload') {
+					if (kill(1,$oldpid)) {
+						print "Requested reconfiguration\n";
+						exit;
+					} else {
+						print "Kill failed: $!\n";
+					}
+				} elsif ($do eq 'status') {
+					if (kill(0,$oldpid)) {
+						print "$0 running - pid $oldpid\n";
+						$self->gd_check($pidfile, $oldpid);
+						exit 0;
+					} else {
+						print "$0 dead\n";
+						exit 1;
+					}
+				} elsif ($do eq 'check') {
+					if (kill(0,$oldpid)) {
+						print "$0 running - pid $oldpid\n";
+						$self->gd_check($pidfile, $oldpid);
+						exit;
+					} 
+				} elsif ($do eq 'start') {
+					print "\u$self->{gd_progname} is already running (pid $oldpid)\n";
+					exit; # according to LSB, this is no error
+				}
+			} else {
+				$self->gd_error("Pid file $pidfile is invalid but locked, exiting\n");
+			}
+		}
+	} else {
+		$locked = lock($pidfile, undef, 'nonblocking') 
+			or die "Could not lock pid file $pidfile: $!";
+	}
+
+	if ($do eq 'reload' || $do eq 'stop' || $do eq 'check' || ($do eq 'restart' && ! $killed)) {
+		print "No $0 running\n";
+	}
+
+	if ($do eq 'stop') {
+		unlink($pidfile);
+		exit;
+	}
+
+	if ($do eq 'status') {
+		print "Unused\n";
+		exit 3;
+	}
+
+	if ($do eq 'check') {
+		$self->gd_check($pidfile);
+		exit 
+	}
+
+	unless ($do eq 'reload' || $do eq 'restart' || $do eq 'start') {
+		$self->gd_other_cmd($do, $locked);
+	}
+
+	unless ($self->{gd_foreground}) {
+		$self->gd_daemonize;
+	}
+
+	$locked or lock($pidfile, undef, 'nonblocking') 
+		or die "Could not lock PID file $pidfile: $!";
+
+	write_file($pidfile, "$$\n");
+
+	print STDERR "Starting up...\n";
+
+	$self->gd_postconfig(%newconfig);
+
+	$self->gd_setup_signals;
+
+	$self->gd_run;
+
+	unlink($pidfile);
+	exit(0);
+}
+
+sub gd_check {}
+
+sub gd_more_opt { return() }
+
+sub gd_getopt
+{
+	my $self = shift;
+	Getopt::Long::Configure("auto_version");
+	GetOptions(
+		'configfile=s'	=> \$self->{configfile},
+		'foreground!'	=> \$self->{gd_foreground},
+		'debug!'	=> \$self->{debug},
+		$self->{gd_args}{options}
+			? %{$self->{gd_args}{options}}
+			: (),
+		$self->gd_more_opt(),
+	) or exit($self->gd_usage());
+
+	if (@ARGV < ($self->{gd_args}{minimum_args} || 1)) {
+		exit($self->gd_usage());
+	}
+	if (@ARGV > ($self->{gd_args}{maximum_args} || 1)) {
+		exit($self->gd_usage());
+	}
+}
+
+sub gd_parse_argv { }
+
+sub gd_help
+{
+	my $self = shift;
+	exit($self->gd_usage($self->{gd_args}));
+}
+
+sub gd_version
+{
+	my $self = shift;
+	no strict qw(refs);
+	my $v = $self->{gd_args}{version} 
+		|| ${ref($self)."::VERSION"} 
+		|| $::VERSION 
+		|| $main::VERSION 
+		|| "?";
+	print "$self->{gd_progname} - version $v\n";;
+	exit;
+} 
+
+sub gd_pidfile
+{
+	my $self = shift;
+	my $x = $self->{configfile};
+	$x =~ s!/!.!g;
+	$self->{gd_pidfile} = "$self->{gd_pidbase}$x.pid";
+}
+
+sub gd_other_cmd
+{
+	my $self = shift;
+	$self->gd_usage;
+	exit(1);
+}
+
+sub gd_redirect_output
+{
+	my $self = shift;
+	return if $self->{gd_foreground};
+	my $logname = $self->gd_logname;
+	my $p = $self->{gd_logpriority} ? "-p $self->{gd_logpriority}" : "";
+	open(STDERR, "|logger $p -t '$logname'") or (print "could not open stderr: $!" && exit(1));
+	close(STDOUT);
+	open(STDOUT, ">&STDERR") or die "redirect STDOUT -> STDERR: $!";
+	close(STDIN);
+}
+
+sub gd_daemonize
+{
+	my $self = shift;
+	print "Starting $self->{gd_progname} server\n";
+	$self->gd_redirect_output();
+	my $pid;
+	POSIX::_exit(0) if $pid = fork;
+	die "Could not fork: $!" unless defined $pid;
+	POSIX::_exit(0) if $pid = fork;
+	die "Could not fork: $!" unless defined $pid;
+
+	POSIX::setsid();
+	select(STDERR);
+	$| = 1;
+	print "Sucessfully daemonized\n";
+}
+
+sub gd_logname
+{
+	my $self = shift;
+	return $self->{gd_progname}."[$$]";
+}
+
+sub gd_reconfig_event
+{
+	my $self = shift;
+	print STDERR "Reconfiguration requested\n";
+	$self->gd_postconfig($self->gd_preconfig());
+}
+
+sub gd_quit_event
+{
+	my $self = shift;
+	print STDERR "Quitting...\n";
+	exit(0);
+}
+
+sub gd_setup_signals
+{
+	my $self = shift;
+	$SIG{INT} = sub { $self->gd_quit_event() };
+	$SIG{HUP} = sub { $self->gd_reconfig_event() };
+}
+
+sub gd_run { die "must defined gd_run()" }
+
+sub gd_error
+{
+	my $self = shift;
+	my $e = shift;
+	my $do = $self->{do};
+	if ($do && $do eq 'stop') {
+		warn $e;
+	} else {
+		die $e;
+	}
+}
+
+sub gd_flags_more { return () }
+
+sub gd_flags
+{
+	my $self = shift;
+	return (
+		'-c file'	=> "Specify configuration file (instead of $self->{configfile})",
+		'-f'		=> "Run in the foreground (don't detach)",
+		$self->gd_flags_more
+	);
+}
+
+sub gd_commands_more { return () }
+
+sub gd_commands
+{
+	my $self = shift;
+	return (
+		start		=> "Starts a new $self->{gd_progname} if there isn't one running already",
+		stop		=> "Stops a running $self->{gd_progname}",
+		reload		=> "Causes a running $self->{gd_progname} to reload it's config file.  Starts a new one if none is running.",
+		restart		=> "Stops a running $self->{gd_progname} if one is running.  Starts a new one.",
+		$self->gd_commands_more(),
+		($self->gd_can_install()
+			? ('install' => "Setup $self->{gd_progname} to run automatically after reboot")
+			: ()),
+		($self->gd_can_uninstall()
+			? ('uninstall' => "Do not run $self->{gd_progname} after reboots")
+			: ()),
+		check		=> "Check the configuration file and report the daemon state",
+		help		=> "Display this usage info",
+		version		=> "Display the version of $self->{gd_progname}",
+	)
+}
+
+sub gd_positional_more { return() }
+
+sub gd_alts
+{
+	my $offset = shift;
+	my @results;
+	for (my $i = $offset; $i <= $#_; $i += 2) {
+		push(@results, $_[$i]);
+	}
+	return @results;
+}
+
+sub gd_usage
+{
+	my $self = shift;
+
+	require Text::Wrap;
+	import Text::Wrap;
+
+	my $col = 15;
+
+	my @flags = $self->gd_flags;
+	my @commands = $self->gd_commands;
+	my @positional = $self->gd_positional_more;
+
+	my $summary = "Usage: $self->{gd_progname} ";
+	my $details = '';
+	for my $i (gd_alts(0, @flags)) {
+		$summary .= "[ $i ] ";
+	}
+	$summary .= "{ ";
+	$summary .= join(" | ", gd_alts(0, @commands));
+	$summary .= " } ";
+	$summary .= join(" ", gd_alts(0, @positional));
+
+	my (@all) = (@flags, @commands, @positional);
+	while (@all) {
+		my ($key, $desc) = splice(@all, 0, 2);
+		local($Text::Wrap::columns) = 79;
+		$details .= wrap(
+			sprintf(" %-${col}s ", $key),
+			" " x ($col + 2),
+			$desc);
+		$details .= "\n";
+	}
+
+	print "$summary\n$details";
+	return 0;
+}
+
+sub gd_install_pre {}
+sub gd_install_post {}
+
+sub gd_can_install
+{
+	my $self = shift;
+	require File::Basename;
+	my $basename = File::Basename::basename($0);
+	if (
+		-x "/usr/sbin/update-rc.d"
+		&& 
+		-x $0
+		&& 
+		$0 !~ m{^(?:/usr|/var)?/tmp/}
+		&&
+		eval { symlink("",""); 1 }
+		&& 
+		-d "/etc/init.d"
+		&&
+		! -e "/etc/init.d/$basename"
+	) {
+		return sub {
+			$self->gd_install_pre("update-rc.d");
+			require Cwd;
+			my $abs_path = Cwd::abs_path($0);
+			symlink($abs_path, "/etc/init.d/$basename")
+				or die "Install failed: symlink /etc/init.d/$basename -> $abs_path: $!\n";
+			print "+ /usr/sbin/update-rc.d $basename defaults\n";
+			system("/usr/sbin/update-rc.d", $basename, "defaults");
+			my $exit = $? >> 8;
+			$self->gd_install_post("update-rc.d");
+			exit($exit) if $exit;
+		};
+	}
+
+	return 0;
+}
+
+sub gd_install
+{
+	my $self = shift;
+	my $ifunc = $self->gd_can_install();
+	die "Install command not supported\n" unless $ifunc;
+	&$ifunc($self);
+	exit(0);
+}
+
+sub gd_uninstall_pre {}
+sub gd_uninstall_post {}
+
+sub gd_can_uninstall
+{
+	my $self = shift;
+	require File::Basename;
+	my $basename = File::Basename::basename($0);
+	require Cwd;
+	my $abs_path = Cwd::abs_path($0) || 'no abs path';
+	my $link = readlink("/etc/init.d/$basename") || 'no link';
+	if (
+		$link eq $abs_path
+		&& 
+		-x "/usr/sbin/update-rc.d"
+	) {
+		return sub {
+			$self->gd_uninstall_pre("update-rc.d");
+			unlink("/etc/init.d/$basename");
+			print "+ /usr/sbin/update-rc.d $basename remove\n";
+			system("/usr/sbin/update-rc.d", $basename, "remove");
+			my $exit = $? >> 8;
+			$self->gd_uninstall_post("update-rc.d");
+			exit($exit) if $exit;
+		}
+	}
+	return 0;
+}
+
+sub gd_uninstall
+{
+	my $self = shift;
+	my $ufunc = $self->gd_can_uninstall();
+	die "Cannot uninstall\n" unless $ufunc;
+	&$ufunc($self);
+	exit(0);
+}
+
+sub gd_kill
+{
+	my ($self, $pid) = @_;
+
+	my $talkmore = 0;
+	my $killed = 0;
+	if (kill(0, $pid)) {
+		$killed = 1;
+		kill(2,$pid);
+		print "Killing $pid\n";
+		my $t = time;
+		sleep(1) if kill(0, $pid);
+		if ($force_quit_delay && kill(0, $pid)) {
+			print "Waiting for $pid to die...\n";
+			$talkmore = 1;
+			while(kill(0, $pid) && time - $t < $force_quit_delay) {
+				sleep(1);
+			}
+		}
+		if (kill(15, $pid)) {
+			print "Killing $pid with -TERM...\n";
+			if ($force_quit_delay) {
+				while(kill(0, $pid) && time - $t < $force_quit_delay * 2) {
+					sleep(1);
+				}
+			} else {
+				sleep(1) if kill(0, $pid);
+			}
+		}
+		if (kill(9, $pid)) {
+			print "Killing $pid with -KILL...\n";
+			my $k9 = time;
+			my $max = $force_quit_delay * 4;
+			$max = 60 if $max < 60;
+			while(kill(0, $pid)) {
+				if (time - $k9 > $max) {
+					print "Giving up on $pid ever dying.\n";
+					exit(1);
+				}
+				print "Waiting for $pid to die...\n";
+				sleep(1);
+			}
+		}
+		print "Process $pid is gone\n" if $talkmore;
+	} else {
+		print "Process $pid no longer running\n";
+	}
+	return $killed;
+}
+
+sub gd_preconfig { die "gd_preconfig() must be redefined"; }
+
+sub gd_postconfig { }
+
+
+1;