[news.software.nntp] nntpsend in perl

bin@primate.wisc.edu (Brain in Neutral) (09/19/89)

Here's an nntpsend that's written in perl.  It differs from the nntp 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


#!/usr/local/perl

#	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 ] host ...
#	or	nntpsend [ -d ] -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).

#	-d, if given, must precede other arguments

#	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.

$script = $0;			# script name
$script =~ s|^.*/||;		# get basename

@hosts = ();
@lockname = ();

$batchdir = "/usr/spool/batch";
$libdir = "/usr/lib/news";
$nntpxmit = "$libdir/nntpxmit";
$debug = 0;

# 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;
}


#	Process flags and figure out which hosts to send to.

if ($#ARGV >= 0 && $ARGV[0] eq "-d")
{
	$debug = 1;
	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));
	}
}

do printtime ("begin", $$);

chdir ($batchdir) || die "Can't cd to $batchdir\n";

umask (022);

#	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.

foreach $host (@hosts)
{
	print stderr $host, "\n";

	$tmplock = "lock$$";
	$lock = "NNTP_LOCK.$host";
	$tmp = "$host.tmp";
	$send = "$host.nntp";

	# Try to make lock file.  Create a lock file with a unique name, then
	# try 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.)

	if (!open (f, ">$tmplock"))
	{
		print stderr "Can't open temp lock file\n";
		next;
	}
	print f "$$\n";	# write pid into lock
	close (f);
	if (link ("$tmplock", "$lock") == 0)	# couldn't link
	{
		print stderr "host $host busy\n";
		unlink $tmplock;

		# see if the lock is valid and clobber it if so

		if (open (f, "$lock"))
		{
			$_ = <f>;
			close (f);
			chop;
			if ((kill 0, $_) == 0)
			{
				print stderr "lock $lock invalid, removing\n";
				unlink $lock;
			}
		}
		next;
	}
	print stderr "link succeeded\n";
	unlink $tmplock;

	# OK, the lock is created

	$savelock = 0;

	if (-e $tmp)		# cat $tmp >> $send; rm $tmp
	{
		if (open (f, "$tmp"))
		{
			if (open (f2, ">>$send"))
			{
				print f2 while $_ = <f>;
				close (f2);
			}
			close (f);
			unlink $tmp;
		}
	}
	rename ($host, ! -e $send ? $send : $tmp) unless ! -e $host;
	if (-e $send)
	{
		if (($pid = fork) == 0)	# child
		{
			$xmitflags = ($debug ? "-d" : "");
			do printtime ("begin $host", $$);
			exec "$nntpxmit $xmitflags $host:$send";
			die "Can't exec $nntpxmit\n";
		}
		# parent
		$savelock = 1 unless $pid < 0;
	}
	$savelock ? $lockname{$pid} = $lock : unlink $lock;
}

#	Wait for nntpxmit children to finish

while (($pid = wait) > 0)
{
	#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.//;
	do printtime ("end $host", $pid);
}

do printtime ("end", $$);

bin@primate.wisc.edu (Brain in Neutral) (09/19/89)

In article <773@uakari.primate.wisc.edu>, bin@primate.wisc.edu (Brain in Neutral) writes:
> Here's an nntpsend that's written in perl.  It differs from the nntp that's

Make that "It differs from the nntpsend that's...."