#!/usr/local/bin/perl
#
# Here's an nntpsend that's written in perl.  It differs from the nntpsend
# that's distributed with NNTP in the following ways:
#
# It takes hosts on the command line, or from a file.
# It starts up all the nntpxmit's in parallel instead of serially.
# It doesn't use any other processes besides nntpxmit.
#
# I have 10 full feeds that I start nntpsend for each minute.  To get these
# going in parallel with stock nntpsend, that meant 10 csh's every minute,
# plus all the date, mv, rm, cat and shlock processes.  This filled up my
# accounting file pretty quickly, and generated huge cron log files.  And
# used a lot of CPU.  This version dramatically reduced my time to xmit news
# to my neighbors.  Perhaps it will be useful for you as well.
#
# Be sure to edit the configuration information near the front
# ($batchdir, $libdir, $nntpxmit).
#
# Paul DuBois
# dubois@primate.wisc.edu
#
# Modified by Theodore Ts'o to be more efficient --- (blame me, not Paul, 
#	for any bugs)
# tytso@athena.mit.edu 
#
#	nntpsend - start up nntpxmit processes to send news to neighboring
#		hosts.  Get them started quickly in parallel without using
#		a lot of extra processes.  (All of the date'ing, cat'ing,
#		mv'ing, rm'ing and shlock'ing is done here, and csh isn't
#		used.)
#
#	Syntax: nntpsend [ -d ] [ -q ] host ...
#	or	nntpsend [ -d ] [ -q ] -f file
#
#	In other words, either name a list of hosts to send to, or a file in
#	which the names of the hosts are found (one per line).
#
#	The options -d, -q, and -f must be given in that order
#
#	If a file of hosts is given, blank lines and lines beginning with
#	"#" are ignored (allows hosts to be commented out easily).
#
#	14 Sep 89	Paul DuBois	dubois@primate.wisc.edu
#
#	14 Sep 89 V1.0.  Created.  Modeled loosely after the nntpsend that's
#		distributed with NNTP.  Minimizes the number of processes
#		started, to lessen system load, and keep down the size of
#		accounting and (on systems which have them) cron log files.
#		This is a big win on hosts that send every minute to several
#		neighbors.
#
#	25 Sep 89 Modified by Theodore Ts'o to add the -q option (for
#		quiet mode).  Also added a signal handler for SIGCHLD,
#		as well as for SIGINT, SIGHUP, and SIGTERM.  Also improved
#		the batch file handling so as not to leave .tmp files
#		hanging around.  If an invalid lock is found, it nukes it
#		and processes that host instead of giving and waiting
#		for the next nntpsend to be fired off.  Only one lock
#		file is used, thus speeding up the locking process.
#		If no files for a host exists, skip the lock step.
#
#     9 Dec 1990 Modified by Theodore to add the -r option (for
#             repeat mode.)  In repeat mode, nntpsend sleeps for
#             some number of seconds and then respawns nntpxmit
#             processes as necessary.
#
#	26 Aug 1991 Modified by Theodore to chdir into $spooldir
#		before executing nntpxmit.  Needed for latest version
#		of C-News
#

$spooldir = "/usr/spool/news";
$batchdir = "/usr/spool/news/batch";
$libdir = "/usr/lib/news";
$nntpxmit = "/usr/lib/newsbin/nntpxmit";
$ESRCH = 3;			# Error return from kill....

chdir ($batchdir) || die "Can't cd to $batchdir\n";
if (-e "no_xmit") {
	exit 0;
}

$script = $0;			# script name
$script =~ s|^.*/||;		# get basename
$tmplock = "lock$$";
$repeatlock = "nntpsend_repeat";

$debug = 0;
$quiet = 0;
$repeat = 0;

@hosts = ();
@lockname = ();
$sigchld = 0;
$exitreq = 0;

# Must be running as root...... (or news, or whatever)
die "Not running as root!\n" if ($< != 0);

#	Process flags and figure out which hosts to send to.
if ($#ARGV >= 0 && $ARGV[0] eq "-d") {
	$debug++;
	shift (@ARGV);
}

if ($#ARGV >= 0 && $ARGV[0] eq "-q") {
	$quiet++;
	shift (@ARGV);
}

if ($#ARGV >= 1 && $ARGV[0] eq "-r") {
	shift(@ARGV);
	$repeat = $ARGV[0];
	shift(@ARGV);
}
	
if ($#ARGV >= 0 && $ARGV[0] eq "-f") {
	$#ARGV > 0 || die "No file named after -f\n";
	$file = $ARGV[1];
	open (f, "$file") || die "Can't open $file\n";
	while (<f>)
	{
		chop;
		next if /^#/;		# skip comments and lines with
		next unless /(\S+)/;	# no host named
		push (@hosts, $1);
	}
	close (f);
} else {
	while ($#ARGV >= 0) {
		push (@hosts, shift (@ARGV));
	}
}

#
# Initialization happens here.  Set the umask and the signal handlers, 
# cd into the batch directory, and initialize the lock file.  Locks
# are performed by linking files to this lock file.  It contains our
# pid, which is how people check to see if anyone is accessing that
# host.  Note that this means that we must never die before our
# nntpxmit children do, since they don't have the lock, we do.
#
do printtime ("begin", $$);
umask (022);
$SIG{'CHLD'} = 'handle_sigchld';
$SIG{'TERM'} = 'handle_exitsig';
$SIG{'HUP'} = 'handle_exitsig';
$SIG{'INT'} = 'handle_exitsig';
open (f, ">$tmplock") || die "Can't open temp lock file\n";
print f "$$\n";
close (f);
#
# If we're in repeat mode, grab the lock
#
if ($repeat) {
	if (do get_lock($repeatlock)) {
		unlink($tmplock);
		exit 0;
	}
}

#	Start up an nntpxmit for each host for which a lock can be gotten and
#	for which there is work.  Children are started asynchronously and the
#	parent waits for them later, removing their locks when they finish.
#	The locking mechanism is patterned after that of shlock in the NNTP
#	distribution.
spawnloop:
	do spawn_hosts();

if ($repeat && ! $exitreq) {
	$sleeping=1;
	sleep($repeat);
	$sleeping=0;
	if (! -e "no_xmit") {
		print stderr "Repeating....\n";
		goto spawnloop;
	}
}


#	Wait for nntpxmit children to finish
print stderr "Waiting for children....\n";

$SIG{'TERM'} = 'exit_cleanup';	# At this point, if we get an exit signal
$SIG{'HUP'} = 'exit_cleanup';	# just kill all the processes and get out
$SIG{'INT'} = 'exit_cleanup';	# as fast as you can.

while (($pid = wait) > 0) {
	do cleanup($pid);
}
unlink($tmplock);
do printtime ("end", $$);
if ($repeat) {
	unlink($repeatlock);	
}
exit 0;

#
# These are the signal handlers...
#
sub handle_sigchld
{
	$sigchld++;
	if ($sleeping) {
		$pid = wait;
		$sigchld--;
		do cleanup($pid) unless ($pid < 0);
	}
}

sub handle_exitsig
{
	$exitreq++;
	if ($sleeping) {
		# Wake up sleeping giant...
		kill "SIGALRM", $$;
	}
}

#
# This is called to cleanup upon receiving an exit signal.
# All we do is send a HUP signal to all of our children.
#
sub exit_cleanup
{
	local ($pid);

	print stderr "\nDoing cleanup.... Sending signal(s) to";
	foreach $pid (keys(lockname)) {
		print stderr " $pid";
		kill 1, $pid;
	}
	print stderr "\n";
}

#
# This is called to cleanup after we receive notification that a 
# particular child has died.  We remove the lock file for that host,
# note the fact that the child has died.
#
#	do cleanup($pid)
sub cleanup
{
	local( $pid ) = @_;
	local( $host);

	#print stderr "child: $i\n";
	unlink $lockname{$pid} unless $lockname{$pid} eq "";
	#print stderr "unlink", $lockname{$pid} , "\n";
	$host = $lockname{$pid};
	$host =~ s/NNTP_LOCK.//;
	$hostsbusy{$host} = 0;
	delete $lockname{$pid};
	do printtime ("end $host", $pid);
}

#
# This is called to log a particular event with a time.
#
# do printtime (string, pid);
sub printtime
{
	local ($s, $pid) = @_;
	local ($sec, $min, $hour, $day, $mon, $year);

	($sec, $min, $hour, $day, $mon, $year) = localtime (time);
	printf "%s: [%d] %s %02d/%02d/%02d %02d:%02d:%02d\n",
		$script, $pid, $s, $mon, $day, $year, $hour, $min, $sec;
}
#
# This is called to obtain a lock using a specified filename.  Returns 1 
# if it is unable to obtain the lock.  
#
# do get_lock($lock)
#
sub get_lock
{
	local ($lock) = @_;
	local ($locktime);

	# Try to lock the host by linking $tmphost to link to the standard
	# lock file name.  Since linking is atomic, this will succeed only
	# if the standard lock file doesn't already exist.  If the lock 
	# file *does* exist, read the pid from it and send a null signal 
	# to see if the process that created it is still alive - and remove 
	# it if not.  (This way dead locks don't hang up transmission for 
	# long and no explicit boot-time cleanup is necessary.)

	$locktime = 0;
	while (link("$tmplock", "$lock") == 0) {
		# couldn't link; see if the lock is valid and clobber 
		# it if so
		if (open (f, "$lock")) {
			$pid = <f>;
			chop($pid);
			close (f);
			if (($pid <=0) ||
			    (($kr = (kill(0, $pid)) == 0) && 
					(($err = $!) == $ESRCH))) {
				print stderr " lock_invalid($pid, $err)";
				unlink($lock);
			} else {
				print stderr " busy($pid, $kr, $err)\n";
				return(-1);
			}
		} else {
			print stderr " bad_link";
		}
		if ($locktime++ > 3) {
			# We should never get here.
			open(error, "/usr/lib/news/NNTPSEND_ERROR");
			($sec, $min, $hour, $day, $mon, $year)=localtime(time);
			printf error ("%02d/%02d/%02d %02d:%02d:%02d %s %s\n",
				$mon, $day, $year, $hour, $min, $sec,
				"Link lockup on", $link);
			close(error);
			return(-1);
		}
	}
	0;
}

#
# Spawn nntpxmits
#
sub spawn_hosts {
	hostloop:
	foreach $host (@hosts) {

		while ($sigchld) {
			$sigchld--;
			# Do some checking first, 
			# to clear out any dead hosts....
			$pid = wait;
			do cleanup($pid) unless ($pid < 0);
		}

		# Check to see if an exit was requested
		if ($exitreq) {
			do exit_cleanup();
			last hostloop;
		}
	
		if ($hostsbusy{$host} == 1) {
			printf stderr "$host skipped...\n";
			next hostloop;
		}
	
		$tmp = "$host.tmp";
		$send = "$host.nntp";
		$tmp_exists = -e $tmp; 
		$host_exists = -e $host; 
		$send_exists = -e $send;

		if (!($tmp_exists || $host_exists || $send_exists)) {
			# No files exist for that file, skip trying to lock it.
			next hostloop;
		}
		print stderr $host;

		$lock = "NNTP_LOCK.$host";

		if (do get_lock($lock)) {
			next hostloop;		# The host was locked
		}
		print stderr " process\n";

		# OK, the lock is created

		# If the .tmp file exists, append its contents to the 
		# .nntp file.  If the .nntp file doesn't exist, just 
		# rename the .tmp file to the .nntp file to save
		#  copying time.
		if ($tmp_exists) {
			if ($send_exists) {
				if (open (f, "$tmp")) {
					if (open (f2, ">>$send")) {
						print f2 while <f>;
						close (f2);
					}
					close (f);
					unlink $tmp;
				}
			} else {
				rename($tmp, $send);
			}		
		}
		# If the $host file exists, move it out of the way to 
		# $tmp and append it to $send.  If $send doesn't exist, 
		# just rename $host directly to $send to save the 
		# copying time.
		if ($host_exists) {
			if ($tmp_exists || $send_exists) {
				rename($host, $tmp);
				if (open (f, "$tmp")) {
					if (open (f2, ">>$send")) {
						print f2 while <f>;
						close (f2);
					}
					close (f);
					unlink $tmp;
				}
			} else {
				rename($host, $send);
			}
		}
		# Check to see if an exit was requested, before trying 
		# a nntpxmit
		if ($exitreq) {
			do exit_cleanup();
			unlink($lock);	# Unlock the lock; we're quitting
			last hostloop;
		}
		if (($pid = fork) == 0)	{	# child
			$xmitflags = ($debug ? "-d" : "");
			if ($quiet) {
				close(<stdout>);
				close(<stderr>);
				open(<stdout>, "/dev/null");
				open(<stderr>,"/dev/null");
			}
			chdir $spooldir;
			exec "$nntpxmit $xmitflags $host:$batchdir/$send";
			die "Can't exec $nntpxmit\n";
		}
		# parent
		if ($pid > 0) {
			do printtime ("begin $host", $pid);
			$hostsbusy{$host} = 1;
			$lockname{$pid} = $lock;
		} else {
			unlink($lock);
		}
		#
		# Stall to let the system load settle down
		#
		do stall();
	}

}

#
# This is called to stall spawning a host until the load settles down.
#
sub stall {
#
# Problem: this code will cause SIGCHLD's which screw up the accounting above.
#
#        $_ = `/usr/local/uptime`;
#        ($load1) = (/load average: (\d+.\d+),/i);
#     print "Stalling, with load $load1\n";
#     if ($load1 > 5.00) {
#             print "Load greater than 5.00, sleeping\n";
#             sleep 30;
#     }
#
# This is an alternative form of this routine which you can use instead if 
# necessary.
#
#     sleep 10;
}