r45425 - in /branches/upstream/libapp-daemon-perl: ./ current/ current/adm/ current/eg/ current/t/
xoswald at users.alioth.debian.org
xoswald at users.alioth.debian.org
Wed Oct 7 15:27:57 UTC 2009
Author: xoswald
Date: Wed Oct 7 15:27:47 2009
New Revision: 45425
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45425
Log:
[svn-inject] Installing original source of libapp-daemon-perl
Added:
branches/upstream/libapp-daemon-perl/
branches/upstream/libapp-daemon-perl/current/
branches/upstream/libapp-daemon-perl/current/.cvsignore
branches/upstream/libapp-daemon-perl/current/Changes
branches/upstream/libapp-daemon-perl/current/Daemon.pm
branches/upstream/libapp-daemon-perl/current/MANIFEST
branches/upstream/libapp-daemon-perl/current/META.yml
branches/upstream/libapp-daemon-perl/current/Makefile.PL
branches/upstream/libapp-daemon-perl/current/README
branches/upstream/libapp-daemon-perl/current/adm/
branches/upstream/libapp-daemon-perl/current/adm/release (with props)
branches/upstream/libapp-daemon-perl/current/eg/
branches/upstream/libapp-daemon-perl/current/eg/test-daemon (with props)
branches/upstream/libapp-daemon-perl/current/eg/test-detach (with props)
branches/upstream/libapp-daemon-perl/current/t/
branches/upstream/libapp-daemon-perl/current/t/001Basic.t
branches/upstream/libapp-daemon-perl/current/t/002Params.t
Added: branches/upstream/libapp-daemon-perl/current/.cvsignore
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/.cvsignore?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/.cvsignore (added)
+++ branches/upstream/libapp-daemon-perl/current/.cvsignore Wed Oct 7 15:27:47 2009
@@ -1,0 +1,4 @@
+blib
+pm_to_blib
+Makefile
+adm
Added: branches/upstream/libapp-daemon-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/Changes?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/Changes (added)
+++ branches/upstream/libapp-daemon-perl/current/Changes Wed Oct 7 15:27:47 2009
@@ -1,0 +1,31 @@
+Revision history for Perl extension App::Daemon.
+
+0.06 (03/05/2009)
+ (ms) Added detach() as an importable method for simple daemons.
+
+0.05 (02/17/2009)
+ (ms) Better docs as requested by Tim Appnel
+ (ms) docs on application-specific command line options
+ (ms) Better daemonization according to Stevens (Advanced Programming
+ in the UNIX environment)
+ (ms) Make sure the child isn't killed by a closed session before
+ it is able to detach from the tty.
+ (ms) Better __DIE__ handler as suggested by Karl Rune Nilsen in
+ http://rt.cpan.org/Ticket/Display.html?id=39917.
+
+0.04 10/02/2008
+ (ms) Fixed logfile permissions if daemon starts up at root and
+ then drops priviledges. Added docs.
+
+0.03 08/03/2008
+ (ms) Fixed test suite for Freebsd, which locks tempfiles
+ exclusively. Thanks to to CPAN tester Slaven Rezic.
+ (ms) Removed restriction on perl-5.8.
+
+0.02 08/01/2008
+ (ms) Added setting logfile and pidfile within the script itself, as
+ suggested by Kimo Rosenbaum.
+ (ms) Fixed OLDERR warnings in test suite.
+
+0.01 07/19/2008
+ (ms) Where it all began.
Added: branches/upstream/libapp-daemon-perl/current/Daemon.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/Daemon.pm?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/Daemon.pm (added)
+++ branches/upstream/libapp-daemon-perl/current/Daemon.pm Wed Oct 7 15:27:47 2009
@@ -1,0 +1,584 @@
+package App::Daemon;
+use strict;
+use warnings;
+
+our $VERSION = '0.06';
+
+use Getopt::Std;
+use Pod::Usage;
+use Log::Log4perl qw(:easy);
+use File::Basename;
+use Proc::ProcessTable;
+use Log::Log4perl qw(:easy);
+use POSIX;
+use Exporter;
+use Fcntl qw/:flock/;
+
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(daemonize cmd_line_parse detach);
+
+our ($pidfile, $logfile, $l4p_conf, $as_user, $background,
+ $loglevel, $action, $appname);
+$action = "";
+$appname = appname();
+
+###########################################
+sub cmd_line_parse {
+###########################################
+
+ if( find_option("-h") ) {
+ pod2usage();
+ }
+
+ if(!defined $pidfile) {
+ $pidfile = find_option('-p', 1) || ( '/tmp/' . $appname . ".pid" );
+ }
+
+ if(!defined $logfile) {
+ $logfile = find_option('-l', 1) || ( '/tmp/' . $appname . ".log" );
+ }
+
+ if(!defined $l4p_conf) {
+ $l4p_conf = find_option('-l4p', 1);
+ }
+
+ if(!defined $as_user) {
+ $as_user = find_option('-u', 1) || "nobody";
+ }
+
+ if($> != 0) {
+ # Not root? Then we're ourselves
+ ($as_user) = getpwuid($>);
+ }
+
+ if(!defined $background) {
+ $background = find_option('-X') ? 0 : 1,
+ }
+
+ if(!defined $loglevel) {
+ $loglevel = find_option('-v') ? $DEBUG : $INFO;
+ $loglevel = $DEBUG if !$background;
+ }
+
+ for (qw(start stop status)) {
+ if( find_option( $_ ) ) {
+ $action = $_;
+ last;
+ }
+ }
+
+ if($action eq "stop" or $action eq "restart") {
+ $background = 0;
+ }
+
+ if( $l4p_conf ) {
+ Log::Log4perl->init( $l4p_conf );
+ } elsif( !$background ) {
+ Log::Log4perl->easy_init({ level => $loglevel,
+ layout => "%F{1}-%L: %m%n" });
+ } elsif( $logfile ) {
+ my $levelstring = Log::Log4perl::Level::to_level( $loglevel );
+ Log::Log4perl->init(\ qq{
+ log4perl.logger = $levelstring, FileApp
+ log4perl.appender.FileApp = Log::Log4perl::Appender::File
+ log4perl.appender.FileApp.filename = $logfile
+ log4perl.appender.FileApp.owner = $as_user
+ log4perl.appender.FileApp.layout = PatternLayout
+ log4perl.appender.FileApp.layout.ConversionPattern = %d %m%n
+ });
+ }
+
+ if(!$background) {
+ DEBUG "Running in foreground";
+ }
+}
+
+###########################################
+sub daemonize {
+###########################################
+ cmd_line_parse();
+
+ # Check beforehand so the user knows what's going on.
+ if(! -w dirname($pidfile) or -f $pidfile and ! -w $pidfile) {
+ my ($name,$passwd,$uid) = getpwuid($>);
+ LOGDIE "$pidfile not writable by user $name";
+ }
+
+ if($action eq "status") {
+ status();
+ exit 0;
+ }
+
+ if($action eq "stop" or $action eq "restart") {
+ if(-f $pidfile) {
+ my $pid = pid_file_read();
+ if(kill 0, $pid) {
+ kill 2, $pid;
+ } else {
+ ERROR "Process $pid not running\n";
+ unlink $pidfile or die "Can't remove $pidfile ($!)";
+ }
+ } else {
+ ERROR "According to my pidfile, there's no instance ",
+ "of me running.";
+ }
+ if($action eq "restart") {
+ sleep 1;
+ } else {
+ exit 0;
+ }
+ }
+
+ if ( my $num = pid_file_process_running() ) {
+ LOGDIE "Already running: $num (pidfile=$pidfile)\n";
+ }
+
+ if( $background ) {
+ detach( $as_user );
+ }
+
+ $SIG{__DIE__} = sub {
+ # Make sure it's not an eval{} triggering the handler.
+ if(defined $^S && $^S==0) {
+ unlink $pidfile or warn "Cannot remove $pidfile";
+ }
+ };
+
+ INFO "Process ID is $$";
+ pid_file_write($$);
+ INFO "Written to $pidfile";
+
+ return 1;
+}
+
+###########################################
+sub detach {
+###########################################
+ my($as_user) = @_;
+
+ umask(0);
+
+ # Make sure the child isn't killed when the uses closes the
+ # terminal session before the child detaches from the tty.
+ $SIG{'HUP'} = 'IGNORE';
+
+ my $child = fork();
+
+ if($child < 0) {
+ LOGDIE "Fork failed ($!)";
+ }
+
+ if( $child ) {
+ # parent doesn't do anything
+ exit 0;
+ }
+
+ # Become the session leader of a new session, become the
+ # process group leader of a new process group.
+ POSIX::setsid();
+
+ if($as_user) {
+ user_switch();
+ }
+
+ # close std file descriptors
+ close(STDIN);
+ close(STDOUT);
+ close(STDERR);
+}
+
+###########################################
+sub user_switch {
+###########################################
+ if($> == 0) {
+ # If we're root, become the user set as 'as_user';
+ my ($name,$passwd,$uid) = getpwnam($as_user);
+ if(! defined $name) {
+ LOGDIE "Cannot switch to user $as_user";
+ }
+ $> = $uid;
+ }
+}
+
+###########################################
+sub status {
+###########################################
+ print "Pid file: $pidfile\n";
+ if(-f $pidfile) {
+ my $pid = pid_file_read();
+ print "Pid in file: $pid\n";
+ print "Running: ", process_running($pid) ? "yes" : "no", "\n";
+ } else {
+ print "No pidfile found\n";
+ }
+ my @cmdlines = processes_running_by_name( $appname );
+ print "Name match: ", scalar @cmdlines, "\n";
+ for(@cmdlines) {
+ print " ", $_, "\n";
+ }
+ return 1;
+}
+
+
+###########################################
+sub process_running {
+###########################################
+ my($pid) = @_;
+
+ # kill(0,pid) doesn't work if we're checking a process running on
+ # different uid, so we need this.
+
+ my $t = Proc::ProcessTable->new();
+
+ foreach my $p ( @{$t->table} ){
+ return 1 if $p->pid() == $pid;
+ }
+ return 0;
+}
+
+###########################################
+sub processes_running_by_name {
+###########################################
+ my($name) = @_;
+
+ $name = basename($name);
+ my @procs = ();
+
+ my $t = Proc::ProcessTable->new();
+
+ foreach my $p ( @{$t->table} ){
+ if($p->cmndline() =~ /\b\Q${name}\E\b/) {
+ next if $p->pid() == $$;
+ DEBUG "Match: ", $p->cmndline();
+ push @procs, $p->cmndline();
+ }
+ }
+ return @procs;
+}
+
+###########################################
+sub appname {
+###########################################
+ my $base = basename($0);
+ return $base;
+}
+
+###########################################
+sub find_option {
+###########################################
+ my($opt, $has_arg) = @_;
+
+ my $idx = 0;
+
+ for my $argv (@ARGV) {
+ if($argv eq $opt) {
+ if( $has_arg ) {
+ my @args = splice @ARGV, $idx, 2;
+ return $args[1];
+ } else {
+ return splice @ARGV, $idx, 1;
+ }
+ }
+
+ $idx++;
+ }
+
+ return undef;
+}
+
+###########################################
+sub def_or {
+###########################################
+ if(! defined $_[0]) {
+ $_[0] = $_[1];
+ }
+}
+
+###########################################
+sub pid_file_write {
+###########################################
+ my($pid) = @_;
+
+ open FILE, "+>$pidfile" or LOGDIE "Cannot open pidfile $pidfile";
+ flock FILE, LOCK_EX;
+ seek(FILE, 0, 0);
+ print FILE "$pid\n";
+ close FILE;
+}
+
+###########################################
+sub pid_file_read {
+###########################################
+ open FILE, "<$pidfile" or LOGDIE "Cannot open pidfile $pidfile";
+ flock FILE, LOCK_SH;
+ my $pid = <FILE>;
+ chomp $pid if defined $pid;
+ close FILE;
+ return $pid;
+}
+
+###########################################
+sub pid_file_process_running {
+###########################################
+ if(! -f $pidfile) {
+ return undef;
+ }
+ my $pid = pid_file_read();
+ if(! $pid) {
+ return undef;
+ }
+ if(process_running($pid)) {
+ return $pid;
+ }
+
+ return undef;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+App::Daemon - Start an Application as a Daemon
+
+=head1 SYNOPSIS
+
+ # Program:
+ use App::Daemon qw( daemonize );
+ daemonize();
+ do_something_useful(); # your application
+
+ # Then, in the shell: start application,
+ # which returns immediately, but continues
+ # to run do_something_useful() in the background
+ $ app start
+ $
+
+ # stop application
+ $ app stop
+
+ # start app in foreground (for testing)
+ $ app -X
+
+ # show if app is currently running
+ $ app status
+
+=head1 DESCRIPTION
+
+C<App::Daemon> helps running an application as a daemon. The idea is
+that you prepend your script with the
+
+ use App::Daemon qw( daemonize );
+ daemonize();
+
+and 'daemonize' it that way. That means, that if you write
+
+ use App::Daemon qw( daemonize );
+
+ daemonize();
+ sleep(10);
+
+you'll get a script that, when called from the command line, returns
+immediatly, but continues to run as a daemon for 10 seconds.
+
+Along with the
+common features offered by similar modules on CPAN, it
+
+=over 4
+
+=item *
+
+supports logging with Log4perl: In background mode, it logs to a
+logfile. In foreground mode, log messages go directly to the screen.
+
+=item *
+
+detects if another instance is already running and ends itself
+automatically in this case.
+
+=item *
+
+shows with the 'status' command if an instance is already running
+and which PID it has:
+
+ ./my-app status
+ Pid file: /tmp/tt.pid
+ Pid in file: 14914
+ Running: no
+ Name match: 0
+
+=back
+
+=head2 Actions
+
+C<App::Daemon> recognizes three different actions:
+
+=over 4
+
+=item my-app start
+
+will start up the daemon. "start" itself is optional, as this is the
+default action,
+
+ $ ./my-app
+
+will also run the 'start' action. If the -X option is given, the program
+is run in foreground mode for testing purposes.
+
+=item stop
+
+will find the daemon's PID in the pidfile and send it a kill signal. It
+won't verify if this actually shut down the daemon or if it's immune to
+the kill signal.
+
+=item status
+
+will print out diagnostics on what the status of the daemon is. Typically,
+the output look like this:
+
+ Pid file: /tmp/tt.pid
+ Pid in file: 15562
+ Running: yes
+ Name match: 1
+ /usr/local/bin/perl -w test.pl
+
+This indicates that the pidfile says that the daemon has PID 15562 and
+that a process with this PID is actually running at this moment. Also,
+a name grep on the process name in the process table results in 1 match,
+according to the output above.
+
+Note that the name match is unreliable, as it just looks for a command line
+that looks approximately like the script itself. So if the script is
+C<test.pl>, it will match lines like "perl -w test.pl" or
+"perl test.pl start", but unfortunately also lines like
+"vi test.pl".
+
+If the process is no longer running, the status output might look like
+this instead:
+
+ Pid file: /tmp/tt.pid
+ Pid in file: 14914
+ Running: no
+ Name match: 0
+
+=head2 Command Line Options
+
+=over 4
+
+=item -X
+
+Foreground mode. Log messages go to the screen.
+
+=item -l logfile
+
+Logfile to send Log4perl messages to in background mode. Defaults
+to C</tmp/[appname].log>.
+
+=item -u as_user
+
+User to run as if started as root. Defaults to 'nobody'.
+
+=item -l4p l4p.conf
+
+Path to Log4perl configuration file.
+
+=item -p pidfile
+
+Where to save the pid of the started process.
+Defaults to C</tmp/[appname].pid>.
+
+=head2 Setting Parameters
+
+Instead of setting paramteters like the logfile, the pidfile etc. from
+the command line, you can directly manipulate App::Daemon's global
+variables:
+
+ use App::Daemon qw(daemonize);
+
+ $App::Daemon::logfile = "mylog.log";
+ $App::Daemon::pidfile = "mypid.log";
+ $App::Daemon::l4p_conf = "myconf.l4p";
+ $App::Daemon::background = 1;
+ $App::Daemon::as_user = "nobody";
+
+ use Log::Log4perl qw(:levels);
+ $App::Daemon::loglevel = $DEBUG;
+
+ daemonize();
+
+=head2 Application-specific command line options
+
+If an application needs additional command line options, it can
+use whatever is not yet taken by App::Daemon, as described previously
+in the L<Command Line Options> section.
+
+However, it needs to make sure to remove these additional options before
+calling daemonize(), or App::Daemon will complain. To do this, create
+an options hash C<%opts> and store application-specific options in there
+while removing them from @ARGV:
+
+ my %opts = ();
+
+ for my $opt (qw(k P U)) {
+ my $v = App::Daemon::find_option( $opt, 1 );
+ $opts{ $opt } = $v if defined $v;
+ }
+
+After this, options C<-k>, C<-P>, and C<-U> will have disappeared from
+ at ARGV and can be checked in C<$opts{k}>, C<$opts{P}>, and C<$opts{U}>.
+
+=head2 Gotchas
+
+If the process is started as root but later drops permissions to a
+non-priviledged user for security purposes, it's important that
+logfiles are created with correct permissions.
+
+If they're created as root when the program starts, the non-priviledged
+user won't be able to write to them later (unless they're world-writable
+which is also undesirable because of security concerns).
+
+The best strategy to handle this case is to specify the non-priviledged
+user as the owner of the logfile in the Log4perl configuration:
+
+ log4perl.logger = DEBUG, FileApp
+ log4perl.appender.FileApp = Log::Log4perl::Appender::File
+ log4perl.appender.FileApp.filename = /var/log/foo-app.log
+ log4perl.appender.FileApp.owner = nobody
+ log4perl.appender.FileApp.layout = PatternLayout
+ log4perl.appender.FileApp.layout.ConversionPattern = %d %m%n
+
+This way, the process starts up as root, creates the logfile if it
+doesn't exist yet, and changes its owner to 'nobody'. Later, when the
+process assumes the identity of the user 'nobody', it will continue
+to write to the logfile without permission problems.
+
+=head2 Detach only
+
+If you want to create a daemon without the fancy command line parsing
+and PID file checking functions, use
+
+ use App::Daemon qw(detach);
+ detach();
+ # ... some code here
+
+This will fork a child, terminate the parent and detach the child from
+the terminal. Issued from the command line, the program above will
+continue to run the code following the detach() call but return to the
+shell prompt immediately.
+
+=back
+
+=head1 AUTHOR
+
+Mike Schilli, cpan at perlmeister.com
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2008 by Mike Schilli
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.5 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
Added: branches/upstream/libapp-daemon-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/MANIFEST?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/MANIFEST (added)
+++ branches/upstream/libapp-daemon-perl/current/MANIFEST Wed Oct 7 15:27:47 2009
@@ -1,0 +1,12 @@
+.cvsignore
+adm/release
+Changes
+Daemon.pm
+eg/test-daemon
+eg/test-detach
+Makefile.PL
+MANIFEST
+README
+t/001Basic.t
+t/002Params.t
+META.yml Module meta-data (added by MakeMaker)
Added: branches/upstream/libapp-daemon-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/META.yml?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/META.yml (added)
+++ branches/upstream/libapp-daemon-perl/current/META.yml Wed Oct 7 15:27:47 2009
@@ -1,0 +1,21 @@
+--- #YAML:1.0
+name: App-Daemon
+version: 0.06
+abstract: Start an Application as a Daemon
+license: ~
+generated_by: ExtUtils::MakeMaker version 6.31
+distribution_type: module
+requires:
+ File::Basename: 0
+ File::Pid: 0
+ File::Temp: 0
+ Getopt::Std: 0
+ Log::Log4perl: 1.0
+ Pod::Usage: 0
+ Proc::ProcessTable: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Mike Schilli <m at perlmeister.com>
Added: branches/upstream/libapp-daemon-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/Makefile.PL?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/Makefile.PL (added)
+++ branches/upstream/libapp-daemon-perl/current/Makefile.PL Wed Oct 7 15:27:47 2009
@@ -1,0 +1,20 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'App::Daemon',
+ VERSION_FROM => 'Daemon.pm', # finds $VERSION
+ PREREQ_PM => {
+ Log::Log4perl => "1.0",
+ File::Pid => 0,
+ Proc::ProcessTable => 0,
+ Getopt::Std => 0,
+ Pod::Usage => 0,
+ File::Basename => 0,
+ Test::More => 0,
+ File::Temp => 0,
+ }, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'Daemon.pm', # retrieve abstract from module
+ AUTHOR => 'Mike Schilli <m at perlmeister.com>') : ()),
+);
Added: branches/upstream/libapp-daemon-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/README?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/README (added)
+++ branches/upstream/libapp-daemon-perl/current/README Wed Oct 7 15:27:47 2009
@@ -1,0 +1,216 @@
+######################################################################
+ App::Daemon 0.06
+######################################################################
+
+NAME
+ App::Daemon - Start an Application as a Daemon
+
+SYNOPSIS
+ # Program:
+ use App::Daemon qw( daemonize );
+ daemonize();
+ do_something_useful(); # your application
+
+ # Then, in the shell: start application,
+ # which returns immediately, but continues
+ # to run do_something_useful() in the background
+ $ app start
+ $
+
+ # stop application
+ $ app stop
+
+ # start app in foreground (for testing)
+ $ app -X
+
+ # show if app is currently running
+ $ app status
+
+DESCRIPTION
+ "App::Daemon" helps running an application as a daemon. The idea is that
+ you prepend your script with the
+
+ use App::Daemon qw( daemonize );
+ daemonize();
+
+ and 'daemonize' it that way. That means, that if you write
+
+ use App::Daemon qw( daemonize );
+
+ daemonize();
+ sleep(10);
+
+ you'll get a script that, when called from the command line, returns
+ immediatly, but continues to run as a daemon for 10 seconds.
+
+ Along with the common features offered by similar modules on CPAN, it
+
+ * supports logging with Log4perl: In background mode, it logs to a
+ logfile. In foreground mode, log messages go directly to the screen.
+
+ * detects if another instance is already running and ends itself
+ automatically in this case.
+
+ * shows with the 'status' command if an instance is already running
+ and which PID it has:
+
+ ./my-app status
+ Pid file: /tmp/tt.pid
+ Pid in file: 14914
+ Running: no
+ Name match: 0
+
+ Actions
+ "App::Daemon" recognizes three different actions:
+
+ my-app start
+ will start up the daemon. "start" itself is optional, as this is the
+ default action,
+
+ $ ./my-app
+
+ will also run the 'start' action. If the -X option is given, the
+ program is run in foreground mode for testing purposes.
+
+ stop
+ will find the daemon's PID in the pidfile and send it a kill signal.
+ It won't verify if this actually shut down the daemon or if it's
+ immune to the kill signal.
+
+ status
+ will print out diagnostics on what the status of the daemon is.
+ Typically, the output look like this:
+
+ Pid file: /tmp/tt.pid
+ Pid in file: 15562
+ Running: yes
+ Name match: 1
+ /usr/local/bin/perl -w test.pl
+
+ This indicates that the pidfile says that the daemon has PID 15562
+ and that a process with this PID is actually running at this moment.
+ Also, a name grep on the process name in the process table results
+ in 1 match, according to the output above.
+
+ Note that the name match is unreliable, as it just looks for a
+ command line that looks approximately like the script itself. So if
+ the script is "test.pl", it will match lines like "perl -w test.pl"
+ or "perl test.pl start", but unfortunately also lines like "vi
+ test.pl".
+
+ If the process is no longer running, the status output might look
+ like this instead:
+
+ Pid file: /tmp/tt.pid
+ Pid in file: 14914
+ Running: no
+ Name match: 0
+
+ Command Line Options
+ -X Foreground mode. Log messages go to the screen.
+
+ -l logfile
+ Logfile to send Log4perl messages to in background mode.
+ Defaults to "/tmp/[appname].log".
+
+ -u as_user
+ User to run as if started as root. Defaults to 'nobody'.
+
+ -l4p l4p.conf
+ Path to Log4perl configuration file.
+
+ -p pidfile
+ Where to save the pid of the started process. Defaults to
+ "/tmp/[appname].pid".
+
+ Setting Parameters
+ Instead of setting paramteters like the logfile, the pidfile
+ etc. from the command line, you can directly manipulate
+ App::Daemon's global variables:
+
+ use App::Daemon qw(daemonize);
+
+ $App::Daemon::logfile = "mylog.log";
+ $App::Daemon::pidfile = "mypid.log";
+ $App::Daemon::l4p_conf = "myconf.l4p";
+ $App::Daemon::background = 1;
+ $App::Daemon::as_user = "nobody";
+
+ use Log::Log4perl qw(:levels);
+ $App::Daemon::loglevel = $DEBUG;
+
+ daemonize();
+
+ Application-specific command line options
+ If an application needs additional command line options, it can
+ use whatever is not yet taken by App::Daemon, as described
+ previously in the "Command Line Options" section.
+
+ However, it needs to make sure to remove these additional
+ options before calling daemonize(), or App::Daemon will
+ complain. To do this, create an options hash %opts and store
+ application-specific options in there while removing them from
+ @ARGV:
+
+ my %opts = ();
+
+ for my $opt (qw(k P U)) {
+ my $v = App::Daemon::find_option( $opt, 1 );
+ $opts{ $opt } = $v if defined $v;
+ }
+
+ After this, options "-k", "-P", and "-U" will have disappeared
+ from @ARGV and can be checked in $opts{k}, $opts{P}, and
+ $opts{U}.
+
+ Gotchas
+ If the process is started as root but later drops permissions to
+ a non-priviledged user for security purposes, it's important
+ that logfiles are created with correct permissions.
+
+ If they're created as root when the program starts, the
+ non-priviledged user won't be able to write to them later
+ (unless they're world-writable which is also undesirable because
+ of security concerns).
+
+ The best strategy to handle this case is to specify the
+ non-priviledged user as the owner of the logfile in the Log4perl
+ configuration:
+
+ log4perl.logger = DEBUG, FileApp
+ log4perl.appender.FileApp = Log::Log4perl::Appender::File
+ log4perl.appender.FileApp.filename = /var/log/foo-app.log
+ log4perl.appender.FileApp.owner = nobody
+ log4perl.appender.FileApp.layout = PatternLayout
+ log4perl.appender.FileApp.layout.ConversionPattern = %d %m%n
+
+ This way, the process starts up as root, creates the logfile if
+ it doesn't exist yet, and changes its owner to 'nobody'. Later,
+ when the process assumes the identity of the user 'nobody', it
+ will continue to write to the logfile without permission
+ problems.
+
+ Detach only
+ If you want to create a daemon without the fancy command line
+ parsing and PID file checking functions, use
+
+ use App::Daemon qw(detach);
+ detach();
+ # ... some code here
+
+ This will fork a child, terminate the parent and detach the
+ child from the terminal. Issued from the command line, the
+ program above will continue to run the code following the
+ detach() call but return to the shell prompt immediately.
+
+AUTHOR
+ Mike Schilli, cpan at perlmeister.com
+
+COPYRIGHT AND LICENSE
+ Copyright (C) 2008 by Mike Schilli
+
+ This library is free software; you can redistribute it and/or modify
+ it under the same terms as Perl itself, either Perl version 5.8.5
+ or, at your option, any later version of Perl 5 you may have
+ available.
+
Added: branches/upstream/libapp-daemon-perl/current/adm/release
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/adm/release?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/adm/release (added)
+++ branches/upstream/libapp-daemon-perl/current/adm/release Wed Oct 7 15:27:47 2009
@@ -1,0 +1,8 @@
+#!/usr/local/bin/perl
+use warnings;
+use strict;
+
+ # Available at http://perlmeister.com/scripts
+use lib "$ENV{HOME}/perl-modules";
+use ModDevUtils;
+ModDevUtils::release(0) or exit 0;
Propchange: branches/upstream/libapp-daemon-perl/current/adm/release
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libapp-daemon-perl/current/eg/test-daemon
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/eg/test-daemon?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/eg/test-daemon (added)
+++ branches/upstream/libapp-daemon-perl/current/eg/test-daemon Wed Oct 7 15:27:47 2009
@@ -1,0 +1,7 @@
+#!/usr/local/bin/perl -w
+use strict;
+
+ # Program:
+use App::Daemon qw( daemonize );
+daemonize();
+sleep(100);
Propchange: branches/upstream/libapp-daemon-perl/current/eg/test-daemon
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libapp-daemon-perl/current/eg/test-detach
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/eg/test-detach?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/eg/test-detach (added)
+++ branches/upstream/libapp-daemon-perl/current/eg/test-detach Wed Oct 7 15:27:47 2009
@@ -1,0 +1,11 @@
+#!/usr/local/bin/perl -w
+use strict;
+
+ # Program:
+use App::Daemon qw( detach );
+detach();
+sleep(5);
+
+open FILE, ">foo.txt" or die;
+print FILE "Waaah!\n";
+close FILE;
Propchange: branches/upstream/libapp-daemon-perl/current/eg/test-detach
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libapp-daemon-perl/current/t/001Basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/t/001Basic.t?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/t/001Basic.t (added)
+++ branches/upstream/libapp-daemon-perl/current/t/001Basic.t Wed Oct 7 15:27:47 2009
@@ -1,0 +1,39 @@
+use Test::More tests => 4;
+
+use App::Daemon qw(daemonize cmd_line_parse);
+use File::Temp qw(tempfile);
+use Fcntl qw/:flock/;
+
+my($fh, $tempfile) = tempfile();
+my($pf, $pidfile) = tempfile();
+
+ # Turdix locks temp files, so unlock them just in case
+flock $fh, LOCK_UN;
+flock $pf, LOCK_UN;
+
+ok(1, "loaded ok");
+
+open(OLDERR, ">&STDERR");
+open(STDERR, ">$tempfile");
+
+ at ARGV = ("-X", "-p", $pidfile);
+daemonize();
+
+close STDERR;
+open(STDERR, ">&OLDERR");
+close OLDERR;
+
+ok(1, "running in foreground with -X");
+
+open PIDFILE, "<$pidfile";
+my $pid = <PIDFILE>;
+chomp $pid;
+close PIDFILE;
+
+is($pid, $$, "check pid");
+
+open FILE, "<$tempfile";
+my $data = join '', <FILE>;
+close FILE;
+
+like($data, qr/Written to $pidfile/, "log message");
Added: branches/upstream/libapp-daemon-perl/current/t/002Params.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libapp-daemon-perl/current/t/002Params.t?rev=45425&op=file
==============================================================================
--- branches/upstream/libapp-daemon-perl/current/t/002Params.t (added)
+++ branches/upstream/libapp-daemon-perl/current/t/002Params.t Wed Oct 7 15:27:47 2009
@@ -1,0 +1,41 @@
+use Test::More tests => 4;
+
+use App::Daemon qw(daemonize cmd_line_parse);
+use File::Temp qw(tempfile);
+use Fcntl qw/:flock/;
+
+my($fh, $tempfile) = tempfile();
+my($pf, $pidfile) = tempfile();
+
+# Turdix locks temp files, so unlock them just in case
+flock $fh, LOCK_UN;
+flock $pf, LOCK_UN;
+
+ok(1, "loaded ok");
+
+open(OLDERR, ">&STDERR");
+open(STDERR, ">$tempfile");
+
+ at ARGV = ();
+$App::Daemon::background = 0;
+$App::Daemon::pidfile = $pidfile;
+daemonize();
+
+close STDERR;
+open(STDERR, ">&OLDERR");
+close OLDERR;
+
+ok(1, "running in foreground");
+
+open PIDFILE, "<$pidfile";
+my $pid = <PIDFILE>;
+chomp $pid;
+close PIDFILE;
+
+is($pid, $$, "check pid");
+
+open FILE, "<$tempfile";
+my $data = join '', <FILE>;
+close FILE;
+
+like($data, qr/Written to $pidfile/, "log message");
More information about the Pkg-perl-cvs-commits
mailing list