#!/usr/bin/perl -w
#
# daemonise.pl - Perl code to become a "proper" Unix Daemon.
#
# The subroutine below will make a Perl program fork() and loose
# it's controlling TTY, process group and close filehandles.
# This Perl is much like the C code in Richard W. Steven's
# book "Unix Network Programming" (incidentally, that book
# is a well recommended read if you're playing around with
# this sort of thing - it's an excellent book, still current
# information, and well worth spending your cash on).
#
# If your Perl code runs daemonise(), then the shell that ran
# your code will return to a prompt and your code will run in
# the background. Any "print" statements will have no effect,
# as they'll actually be trying to print to a closed filehandle.
# Ideally, you shouldn't do such print statements as you may
# accidentally do some things you don't intend.
#
# Since all filehandles are closed, and there's no access to the
# terminal, any output from your program will have to be via files,
# log files or Syslog. Debugging can be less straight forward, as
# you won't get any STDERR either.
#
# fork() errors that may occur during daemonising are not handled
# as well as they might be. The daemonise code just exits - not
# graceful, but since there may be no terminal, that's all it can
# do without knowing what kind of logging you'd like to do.
#
# Be careful not to open filehandles (via open() or a plethora
# of modules that do open()s on your behalf) before you daemonise().
# Any filehandles get duplicated across fork()s, so the parents
# (which normally just die) will end up being Zombie processes.
# There is a potential solution here: Close those filehandles
# before the parents quit. However, this isn't ideal, and untested.
#
# The peril, run away forks() and the like, is all below here - enjoy!
use Fcntl;
require "asm/ioctls.ph";

sub daemonise
{
	# double fork and lose the terminal signals and indeed the
	# terminal itself

	$SIG{TTOU}='IGNORE';
	$SIG{TTIN}='IGNORE';
	$SIG{TSTP}='IGNORE';
	
	# Change directory to the root so we don't
	# hang up any disk mounts
	chdir("/");

	# First fork()
	my $pid;
	if($pid = fork)
	{
		# parent...
		exit(0);
	}
	elsif(defined $pid)
	{
		# (first) child ($pid is zero)
		# Lose the process group...
		setpgrp(0,$$);

		# Lose the controlling terminal...
		if(open(TTY,"> /dev/tty"))
		{
			my $nothing="";
			ioctl TTY, &TIOCNOTTY, $nothing;
			close(TTY);
		}
	
		# Second fork()
		my $pid2;
		if($pid2 = fork)
		{
			# parent, ie. the first child
			exit(0);
		}
		elsif(defined $pid2)
		{
			# second child
			$SIG{HUP}='IGNORE';
			# close all file descriptors
			# We actually just close STDIN, STDOUT and STDERR
			close(STDIN);
			close(STDOUT);
			close(STDERR);
			# Anyone know how Perl could close *all* filehandles?
		}
		else
		{
			# fork problem
			exit(6);
		}
	}
	else
	{
		# Fork problem (possibly recoverable, but
		# we don't bother trying)
		exit(5);
	}

	# To get here, we must be the second child...
	# We're all done.
	return 1;
}



MAIN:
{
	# Your stuff here!
}