[news.software.nntp] Whereabout of perl version of nntpsend

bin@primate.wisc.edu (Brain in Neutral) (11/14/89)

From article <60@van-bc.UUCP>, by skl@van-bc.UUCP (Samuel Lam):
> A while ago someone posted a perl version of nntpsend which will
> talk to mutliple sites currently, and I didn't have the foresight
> to save a copy.  Could someone tell me where I could get a copy
> of this now?

#!/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", $$);