#!/usr/bin/perl -w
#
# Author: Jefferson Ogata (JO317) <ogata@pobox.com>
# Date: 2000/01/25
# Version: 0.4
#
# Please note that this program comes with NO WARRANTY WHATSOEVER. Your use
# of this program constitutes your complete acceptance of all liability for
# any damage or loss caused by the aforesaid use.
#
# You are free to use or redistribute this program as long as this header
# remains intact.
#
# If you have suggestions -- or better yet, bits of new code -- send them
# to me and I will deal with them when I have time. The latest version of
# this program may always be found at the URL
#
#     http://www.pobox.com/~ogata/webtools/nntp.pl
#
# This is an NNTP proxy server for Perl 5.004. It uses the IO::Socket and
# IO::Select classes. You may run it from inetd by adding to /etc/inetd.conf
# a line similar to:
#
# nntp	stream	tcp	nowait	nobody	/path/to/nntp.pl	nntp.pl news.example.com 119
#
# This program can act as an NNTP proxy on behalf of machines behind a
# firewall or NAT router. You may wish to do this for several reasons:
# - Put a robust TCP stack between clients and the real server. This may
#   help when server latency is high or you are suffering from packet loss
#   (see a doctor immediately).
# - Act as a firewall application proxy.
# - Take advantage of the XOVER overview caching this program can perform
#   to speed up browsing.
# This program also serves the purpose of keeping an NNTP connection from
# lying idle too long. It does so by issuing a DATE command at a configurable
# interval during inactive periods.
#
# Change history:
# 2000/01/25:
#   Implemented XOVER cache.
# 2000/01/24:
#   Implemented local address binding.
# 1999/09/16:
#   Implemented proxy HTTP connection.
# 1999/05/06:
#   Implemented header suppression and rewriting features.
# 1999/04/20:
#   Tiny cosmetic tweaks.

use strict;
use IO::Socket;
use IO::Select;
use IO::Handle;
use IO::File;
use Fcntl ':flock';
use DB_File;

my $me = $0;
$me =~ s/([^\/]*\/)//g;

my $verbosity = 0;
my $keepAlive;
my $logFile;
my $host;
my $service;
my $httpProxy;
my $localAddr;
my $newsrcFile;
my $xoverCache;

my @suppressHeaders;
my %headerRewrites;
my %bodyRewrites;

while (defined ($_ = shift))
{
    if (s/^-//)
    {
	$verbosity += (s/v//g);

	while (s/([aklNprRsX])//)
	{
	    my $flag = $1;
	    my $arg = shift;
	    (defined ($arg))
		|| &usage (1, "missing argument to -$flag");
	    if ($flag eq 'a')
	    {
		($arg =~ /^[a-z\d\-\.]+$/)
		    || &usage (1, "invalid argument to -$flag");
		$localAddr = $arg;
	    }
	    elsif ($flag eq 'k')
	    {
		($arg =~ /^\d+$/)
		    || &usage (1, "non-numeric argument to -$flag");
		$keepAlive = $arg;
	    }
	    elsif ($flag eq 'l')
	    {
		$logFile = $arg;
	    }
	    elsif ($flag eq 'N')
	    {
		$newsrcFile = $arg;
	    }
	    elsif ($flag eq 'p')
	    {
		$httpProxy = $arg;
	    }
	    elsif (($flag eq 'r') || ($flag eq 'R'))
	    {
		($arg =~ /^([^=]+)=(.*)$/)
		    || &usage (1, "argument \"$arg\" to -$flag has invalid syntax");
		$headerRewrites{$1} = $2;
		if ($flag eq 'R')
		{
		    $bodyRewrites{$1} = $2;
		}
	    }
	    elsif ($flag eq 's')
	    {
		($arg =~ /^\w+/)
		    || &usage (1, "argument \"$arg\" to -$flag is not a header name");
		push (@suppressHeaders, $arg);
	    }
	    elsif ($flag eq 'X')
	    {
		$xoverCache = $arg;
	    }
	}

	&usage (0) if (/[h\?]+/);
	&usage (1, "unknown option \"-$_\"") if (length);
	next;
    }

    unless (defined ($host))
    {
	$host = $_;
	next;
    }
    unless (defined ($service))
    {
	$service = $_;
	next;
    }
    &usage (1, "too many arguments");
}

$service = 119 unless (defined ($service));

&usage (1) unless (defined ($host) && defined ($service));

my $port;

# Look up port number for service.
if ($service =~ /^\d+$/)
{
    $port = $service;
}
else
{
    $port = scalar (getservbyname ($service, 'tcp'));
    (defined ($port)) || &quit (qq{unknown service "$service".});
}

my $sock;

if (defined ($httpProxy))
{
    # Create a socket.
    $sock = new IO::Socket::INET->new (PeerAddr => $httpProxy, PeerPort => 80, LocalAddr => $localAddr, Proto => 'tcp');
    defined ($sock)
	|| &quit ("socket: $!");
    $sock->autoflush (1);

    # Ask proxy to make a connection for us.
    print $sock "CONNECT $host:$port\r\n";

    # Read proxy connection status.
    my $status = $sock->getline ();
    ($status =~ /^HTTP\/[\d\.]+\s(\d+)\s.*\r\n$/)
	|| &quit (qq{HTTP proxy doesn't speak our language.});
    ($1 == 200)
	|| &quit ("HTTP proxy connection failed with status $1.");

    # Skip rest of proxy header lines.
    while (defined ($_ = $sock->getline ()))
    {
	last if ($_ eq "\r\n");
    }
}
else
{
    # Create a socket.
    $sock = new IO::Socket::INET->new (PeerAddr => $host, PeerPort => $port, LocalAddr => $localAddr, Proto => 'tcp');
    defined ($sock)
	|| &quit ("socket: $!");
    $sock->autoflush (1);
}

select (STDOUT); $| = 1;

# Create a selector for STDIN.
my $sel = new IO::Select (\*STDIN);

#
# Here is the control structure.
#
# Keys are command.response. The command is the most recent command issued
# to the server (empty on initial connection). The response is a response
# code received from the server.
#
# Each value is an array of three flags. The first flag, download, indicates
# whether a text response follows, which we will need to download. The second
# flag, upload, indicates whether a text upload is expected. The third flag,
# readCommand, indicates whether we should read another command next, or try
# to read another response from the server. This is used to short-circuit the
# loop after the response to a quit command has been received. It could also
# be used in future protocol extensions (let's hope not).
#
my %nntp =
(
    '.200'		=> [0, 0, 1],	# Startup okay, posting allowed
    '.201'		=> [0, 0, 1],	# Startup okay, posting disallowed
    'article.220'	=> [1, 0, 1],	# Requested article follows
    'body.222'		=> [1, 0, 1],	# Requested article body follows
    'date.111'		=> [0, 0, 1],	# Date status
    'group.211'		=> [0, 0, 1],	# Group status
    'group.411'		=> [0, 0, 1],	# No such group
    'head.221'		=> [1, 0, 1],	# Requested article head follows
    'help.100'		=> [1, 0, 1],	# Help follows
    'ihave.335'		=> [0, 1, 1],	# Transmit article
    'last.223'		=> [0, 0, 1],	# Previous article status
    'last.422'		=> [0, 0, 1],	# No previous article
    'list.202'		=> [1, 0, 1],	# Extensions supported follow
    'list.215'		=> [1, 0, 1],	# Newsgroup list follows
    'listgroup.211'	=> [1, 0, 1],	# Article list follows
    'mode.200'		=> [0, 0, 1],	# Mode status, posting allowed.
    'mode.201'		=> [0, 0, 1],	# Mode status, posting disallowed
    'newgroups.231'	=> [1, 0, 1],	# New newsgroup list follows
    'newnews.230'	=> [1, 0, 1],	# New article list follows
    'next.223'		=> [0, 0, 1],	# Next article status
    'next.421'		=> [0, 0, 1],	# No next article
    'post.340'		=> [0, 1, 1],	# Transmit article to be posted
    'quit.205'		=> [1, 0, 0],	# Quitting
    'slave.202'		=> [0, 0, 1],	# Slave status noted
    'stat.223'		=> [0, 0, 1],	# Current status
    'stat.412'		=> [0, 0, 1],	# Not in a newsgroup
    'xgtitle.215'	=> [1, 0, 1],	# Descriptions follow
    'xgtitle.481'	=> [0, 0, 1],	# Descriptions unavailable
    'xhdr.221'		=> [1, 0, 1],	# Headers follow
    'xover.224'		=> [1, 0, 1],	# Overview data follows
);

my $command = '';
my $fullCommand = '';
my $currentGroup;
my $xover;
my %xover;
my $timedOut = 0;
my $suppressResponse = 0;
my $log;

if (defined ($logFile))
{
    $log = new IO::File ($logFile, "w");
    defined ($log)
	|| &quit ("open $logFile: $!");
    $log->autoflush (1);
}

CYCLE:
while (1)
{
RESPONSE:
    # Update arg0;
    &status ();

    # Read a command response from the server.
    last CYCLE unless (defined ($_ = $sock->getline ()));
    print $log $_ if (defined ($log));
    my $response = $_;

    # Make sure response is kosher.
s/^201/200/;
    goto RESPONSE unless (/^(\d{3})/);
    my $status = $1;

    # Send the response to the client.
    print unless ($suppressResponse || $timedOut);

    # Form a key to decide what to do next.
    my $key = $command . '.' . $status;

    # Get reaction to command.response.
    my ($download, $upload, $readCommand);
    if (exists $nntp{$key})
    {
	($download, $upload, $readCommand) = @{$nntp{$key}};
    }
    else
    {
	($download, $upload, $readCommand) = (0, 0, 1);
    }

    # More from server to follow.
    if ($download)
    {
	select (STDOUT); $| = 0;

	print $log "Download begins:\n" if (defined ($log) && ($verbosity > 0));

	&status ("downloading");

	my %data;
	my $count = 0;
	my $checkPoint = 1024;

	while (1)
	{
	    last CYCLE unless (defined ($_ = $sock->getline ()));
	    print $log $_ if (defined ($log));
	    print unless ($timedOut);
	    last if (($_ eq ".\r\n") || ($_ eq ".\n"));

	    # Handle xover download.
	    if (($key eq 'xover.224') && defined ($xover) && defined ($xover->{start}) && defined ($xover->{end}))
	    {
		if (/^(\d+)\s/)
		{
		    my $article = $1;

		    # Don't try to keep it if it's outside requested range.
		    if (($article < $xover->{start}) || ($article > $xover->{end}))
		    {
			print $log "warning: got $article outside range \[$xover->{start} .. $xover->{end}\]\n" if (defined ($log));
			next;
		    }

		    # Save the xover info.
		    $data{$article} = $_;

		    # If we've reached a checkpoint, update the cache.
		    if ((++$count) >= $checkPoint)
		    {
			# Write accumulated records and update summary.
			&xoverUpdate ($xover, $xover->{start}, $article, \%data);
			undef (%data);

			# Update range.
			$xover->{start} = $article + 1;

			$count = 0;
		    }
		}
	    }
	}

	if (($key eq 'xover.224') && defined ($xover) && defined ($xover->{start}) && defined ($xover->{end}))
	{
	    # Write any remaining xover records to cache and update summary.
	    &xoverUpdate ($xover, $xover->{start}, $xover->{end}, \%data);
	    undef (%data);

	    delete ($xover->{start});
	    delete ($xover->{end});
	}

	print $log "Download complete\n" if (defined ($log) && ($verbosity > 0));

	select (STDOUT); $| = 1;
    }

    # Clear timeout flag.
    $timedOut = 0;

    # More from client expected.
    if ($upload)
    {
	print $log "Upload begins:\n" if (defined ($log) && ($verbosity > 0));

	&status ("uploading");

	my $state = 'header';
UPLOAD:
	while (1)
	{
	    last CYCLE unless (defined ($_ = <STDIN>));
	    if (($_ eq ".\r\n") || ($_ eq ".\n"))
	    {
		print $log $_ if (defined ($log));
		print $sock $_;
		last;
	    }
	    else
	    {
		my $rewrites;
		if ($state eq 'header')
		{
		    if (($_ eq "\r\n") || ($_ eq "\n"))
		    {
			$state = 'body';
		    }
		    else
		    {
			my $s;
			foreach $s (@suppressHeaders)
			{
			    next UPLOAD if (/^$s:/);
			}
			$rewrites = \%headerRewrites;
		    }
		}
		else
		{
		    $rewrites = \%bodyRewrites;
		}
		my $r;
		foreach $r (keys (%{$rewrites}))
		{
		    my $w = $rewrites->{$r};
		    s/$r/$w/g;
		}
		print $log $_ if (defined ($log));
		print $sock $_;
	    }
	}
	print $log "Upload complete\n" if (defined ($log) && ($verbosity > 0));

	# That was a command right there. Get a response.
	next CYCLE;
    }

    # Short-circuit next command. Used for quit.
    next CYCLE unless ($readCommand);

    # If we switched groups, parse group info.
    if (($key eq 'group.211') && ($response =~ /^\d+\s+(\d+)\s+(\d+)\s+(\d+)\s+([\w\-][\w\-\.]+)/))
    {
	my ($articles, $first, $last, $group) = ($1, $2, $3, $4);
	$currentGroup = $group;

	# A note about xover databases:
	# The summary key contains a single character for every message accounted
	# for. This character can have the following values:
	#  : nothing is known about this article
	# 0: the article is defunct. No header is returned by the server.
	# 1: the article is active and we have a header line for it.
	# 
	# The newsrc info is kept in a separate string in memory, in which each
	# article has a single character. In this case, the values are:
	# 0: the article is marked unread.
	# 1: the article is marked read.
	# The newsrc summary string starts on the same article as the header
	# summary, which is stored in $xover{first}.

	# Open xover cache.
	if (defined ($xoverCache))
	{
	    # Close any open database.
	    if (defined ($xover))
	    {
		$xover->{db}->sync ();
		flock ($xover->{lockFile}, LOCK_UN);
		$xover->{lockFile}->close ();
		delete ($xover->{lockFile});

		# Close old database.
		delete ($xover->{db});
		untie (%xover);

		# Throw away newsrc info.
		delete ($xover->{newsrc});

		undef ($xover);
	    }

	    # Construct filename for database file and create directories.
	    my @subdir = split (/\./, $group);
	    my $subdir = $xoverCache;
	    while (1)
	    {
		unless (-d $subdir)
		{
		    mkdir ($subdir, 0777)
			|| &quit ("create cache directory $subdir: $!.");
		}
		last unless (scalar (@subdir));
		$subdir .= '/' . shift (@subdir);
	    }

	    $xover = +{
		dbName		=> "$subdir/.xover-btree.db",
		dbFormat	=> $DB_BTREE,
		db		=> undef,

		lockName	=> "$subdir/.xover-lock",
		lockFile	=> undef,
		locked		=> 0,

		modified	=> 0,

		rc		=> undef,
	    };

	    &status ("opening cache $xover->{dbName}");

	    # Open/create the database file.
	    print $log "Opening $xover->{dbName}\n" if (defined ($log));
	    $xover->{db} = tie (%xover, 'DB_File', $xover->{dbName}, O_CREAT|O_RDWR, 0666, $xover->{dbFormat})
		|| &quit ("tie $xover->{dbName}: $!");

	    # Get an exclusive lock.
	    &xoverLock ($xover);

	    # Remember if we change something.
	    my $changed = 0;

	    # Create summary info.
	    my $base;
	    my $summary;
	    if (exists ($xover{summary}) && exists ($xover{first}) && exists ($xover{last}))
	    {
		&status ("checking cache summary");

		# Get old summary .
		$base = $xover{first};
		$summary = $xover{summary};

		# Translate old-format summary.
		$changed = 1 if ($summary =~ y/dx/01/);

		# If our base is ahead of first article, adjust it.
		if ($base > $first)
		{
		    my $pad = ' ' x ($base - $first);
		    $summary = $pad . $summary;
		    $base = $first;
		    $changed = 1;
		}

		# If new first article is after old one, adjust summary.
		if ($first > $base)
		{
		    # Expire old xover info.
		    my $n;
		    my $x;
		    for ($n = $base, $x = 0; $n < $first; ++$n, ++$x)
		    {
			my $status = substr ($summary, $x, 1);
			if ($status eq '1')
			{
			    delete ($xover{$x});
			}
		    }
		    $summary = substr ($summary, $first - $base);
		    $changed = 1;
		}

		# Extend xover info.
		if ($last > $xover{last})
		{
		    $summary .= ' ' x ($last - $xover{last});
		    $changed = 1;
		}
	    }
	    else
	    {
		# Make up summary, since we ain't got none.
		$summary = ' ' x ($last - $first + 1);
		$changed = 1;
	    }

	    if ($changed)
	    {
		# Resave summary info.
		$xover{first} = $first;
		$xover{summary} = $summary;
		$xover{last} = $last;
		$xover->{modified} = 1;

		print $log "Resave summary: range \[$first .. $last\]\n" if (defined ($log) && ($verbosity > 1));
	    }

	    # Drop back to a shared lock on the database file.
	    &xoverUnlock ($xover);
	}
    }

COMMAND:
    $command = '';
    $fullCommand = '';
    &status ("read command");

    # Wait for something to be available on stdin.
    my @ready = $sel->can_read ($keepAlive);
    if (scalar (@ready))
    {
	# Read a command from the client.
	last CYCLE unless (defined ($_ = <STDIN>));
    }
    else
    {
	# Timeout and pretend a date command was issued.
	$timedOut = 1;
	$_ = "date\r\n";
	print $log "Timeout occurs\n" if (defined ($log) && ($verbosity > 0));
    }
    print $log $_ if (defined ($log));

    # Make sure command is kosher.
    goto COMMAND unless (/^\s*([\w\-]+)/);
    ($command = $1) =~ y/A-Z/a-z/;
    $fullCommand = $_;
    $fullCommand =~ s/[\r\n]*$//;
    $fullCommand =~ s/^(authinfo\s+\w+\s+).*/$1\*/i;

    # Don't suppress server response.
    $suppressResponse = 0;

    # Deliver xover from cache if possible.
    if ($command eq 'xover')
    {
	if (defined ($xover) && (/^\s*\w+\s+(\d+)\-(\d+)/))
	{
	    my ($first, $last) = ($1, $2);

	    my $rc = $xover->{rc};
	    if ((!defined ($rc)) && defined ($newsrcFile))
	    {
		&status ("checking newsrc $newsrcFile");

		# Read newsrc.
		my $rcFile = new IO::File ($newsrcFile, "r");
		if (defined ($rcFile))
		{
		    print $log "Searching for newsrc group line\n" if (defined ($log));

		    my $s;
		    while (defined ($s = $rcFile->getline ()))
		    {
			# Clean up lines and look for this group.
			$s =~ s/[\r\n]+$//;
			$s =~ s/#.*$//;
			$s =~ s/\s+$//;
			$s =~ s/^\s+//;
			next unless (length ($s));
			next unless ($s =~ s/^([\w\.\-]+)([:!])\s*//);
			my ($g, $status) = ($1, $2);
			next unless (($g eq $currentGroup) && ($status eq ':'));

			# Found it. Close newsrc file.
			$rcFile->close ();
			undef ($rcFile);

			print $log "Located group line for $currentGroup. Closed newsrc file.\n" if (defined ($log));

			# Now parse the read article defs.
			my $cursor = $first;
			my $rcSummary = '';
			while ($s =~ s/^([\d\-]+)//)
			{
			    my $range = $1;
			    my ($start, $end);
			    if ($range =~ /(\d+)\-(\d+)/)
			    {
				($start, $end) = ($1, $2);
			    }
			    else
			    {
				$start = $end = $range;
			    }
			    $start = $first if ($start < $first);
			    my $len = $end - $start + 1;
			    next if ($len <= 0);
			    $rcSummary .= '0' x ($start - $cursor);
			    $rcSummary .= '1' x $len;
			    $cursor = $end + 1;

			    $s =~ s/^,//;
			}
			--$cursor;

			print $log "newsrc summary: ${first}-$cursor $rcSummary\n" if (defined ($log) && ($verbosity > 1));

			$rc = $xover->{rc} = +{
			    summary	=> $rcSummary,
			    last	=> $cursor,
			};

			last;
		    }
		}
		else
		{
		    print $log "Unable to open newsrc file \"$newsrcFile\": $!" if (defined ($log));
		}
	    }

	    &status ("reading cache");

	    # Get an exclusive lock.
	    &xoverLock ($xover);

	    # Print our own response.
	    print "224 $first fields follow from cache\r\n";
	    print $log "224 $first fields follow from cache\r\n" if (defined ($log));
	    $suppressResponse = 1;

	    # Clip range to valid range for group.
	    $first = $xover{first} if ($first < $xover{first});
	    $last = $xover{last} if ($last > $xover{last});

	    # Deliver all summaries we have in cache contiguously from first
	    # requested article number.
	    my $base = $xover{first};
	    my $summary = $xover{summary};
	    my $n;
	    my $x;
	    for ($n = $first, $x = $first - $base; $n <= $last; ++$n, ++$x)
	    {
		my $status = substr ($summary, $x, 1);
		my $read = 0;
		$read = substr ($rc->{summary}, $x, 1) if (defined ($rc) && ($n <= $rc->{last}));

		# If we hit a gap, quit.
		last if ($status eq ' ');

		# If it's active and not read, print it.
		if ($status && !$read)
		{
		    print $xover{$n};
		}
	    }

	    # Release exclusive lock.
	    &xoverUnlock ($xover);

	    print $log "xover delivered ${first}-" . ($n - 1) . " from cache\n" if (defined ($log) && ($verbosity > 1) && ($n > $first));

	    # If we got them all, end and short circuit the command.
	    if ($n > $last)
	    {
		print ".\r\n";
		goto COMMAND;
	    }

	    # Set range for xover command.
	    $xover->{start} = $n;
	    $xover->{end} = $last;

	    # Make up an xover command to get the rest.
	    $_ = "xover ${n}-$last\r\n";
	    print $log "xover rewritten as $_" if (defined ($log) && ($verbosity > 1));
	}
    }
    elsif ($command eq 'xover-test')
    {
	if (defined ($xover) && (/^\s*[\w\-]+\s+(\d+)\-(\d+)/))
	{
	    my ($first, $last) = ($1, $2);

	    # Set range for xover command.
	    $xover->{start} = $first;
	    $xover->{end} = $last;

	    # Make up an xover command to get this range.
	    $_ = "xover ${first}-${last}\r\n";
	    $command = 'xover';
	    print $log "xover-test rewritten as $_" if (defined ($log) && ($verbosity > 1));
	}
    }

    # Send the command to the server.
    print $sock $_;
}

# Done. Final cleanup.
if (defined ($xover))
{
    # Release lock.
    &xoverDropLock ($xover);

    # Close the database.
    delete ($xover->{db});
    untie (%xover);

    undef ($xover);
}

exit (0);

# Add articles to xover cache.
sub xoverUpdate
{
    my $xover = shift;
    my $start = shift;
    my $end = shift;
    my $data = shift;	# Hash of new xover data.

    my $s = &status ("updating cache");

    # Get an exclusive lock.
    &xoverLock ($xover);

    my $first = $xover{first};
    my $last = $xover{last};
    my $summary = $xover{summary};
    my $changed = 0;

    # Make sure summary is long enough.
    if (length ($summary) < ($last - $first + 1))
    {
	$summary .= ' ' x ($last - $first + 1 - length ($summary));
	$changed = 1;
    }

    # Clip range to valid summary range.
    $start = $first if ($start < $first);
    $end = $last if ($end > $last);

    my $n;
    my $x;
    for ($n = $start, $x = $start - $first; $n <= $end; ++$n, ++$x)
    {
	if (exists ($data->{$n}))
	{
	    # A new record was received. Save it and mark it in summary.
	    substr ($summary, $x, 1) = '1';
	    $xover{$n} = $data->{$n};
	    $changed = 1;

	    print $log "Storing key $n\n" if (defined ($log) && ($verbosity > 1));
	}
	else
	{
	    # No new record received. Mark article defunct.
	    my $status = substr ($summary, $x, 1, '0');

	    # We already knew this. On to the next one.
	    next if ($status eq '0');

	    # Okay, did we have a current record?
	    if ($status eq '1')
	    {
		# Delete it from the cache.
		delete ($xover{$n});

		print $log "Deleting key $n\n" if (defined ($log) && ($verbosity > 1));
	    }

	    $changed = 1;
	}
    }

    if ($changed)
    {
	# Write new summary info.
	$xover{summary} = $summary;

	print $log "Resave summary: range \[$xover{first} .. $xover{last}\]\n" if (defined ($log) && ($verbosity > 1));

	$xover->{modified} = 1;
    }

    # Release lock.
    &xoverUnlock ($xover);

    &setStatus ($s);
}

# Get an exclusive lock on an xover cache lock file. If lock file is not yet
# open, open/create it.
sub xoverLock
{
    my $xover = shift;

    unless (defined ($xover->{lockFile}))
    {
	my $s = &status ("opening $xover->{lockName}");
	defined ($xover->{lockFile} = new IO::File ($xover->{lockName}, "w"))
	    || &quit ("open lock file $xover->{lockName}: $!");
	&setStatus ($s);
    }

    my $s = &status ("locking $xover->{lockName}");

    # Get an exclusive lock.
    print $log "Acquiring exclusive lock on $xover->{lockName}\n" if (defined ($log));
    flock ($xover->{lockFile}, LOCK_EX)
	|| &quit ("flock $xover->{lockName} LOCK_EX: $!.");
    print $log "Lock acquired.\n" if (defined ($log));

    # Remember that we did this.
    $xover->{locked} = 1;

    &setStatus ($s);
}

# Synchronize xover database and downgrade exclusive lock to shared lock.
sub xoverUnlock
{
    my $xover = shift;

    return unless (defined ($xover->{lockFile}) && defined ($xover->{locked}) && $xover->{locked});

    my $s = &status ("unlocking $xover->{lockFile}");

    # Synchronize the database.
    if (defined ($xover->{db}) && defined ($xover->{modified}) && $xover->{modified})
    {
	&status ("syncing cache");
	$xover->{db}->sync ();
	$xover->{modified} = 0;
    }

    # Release exclusive lock.
    &status ("unlocking $xover->{lockName}");
    print $log "Releasing exclusive lock on $xover->{lockName}\n" if (defined ($log));
    flock ($xover->{lockFile}, LOCK_UN)
	|| &quit ("flock $xover->{lockName} LOCK_UN: $!.");
    print $log "Lock released.\n" if (defined ($log));

    # Remember that we did this.
    $xover->{locked} = 0;

    &setStatus ($s);
}

# Synchronize xover database, release all locks on lock file and close the
# lock file.
sub xoverDropLock
{
    my $xover = shift;

    return unless (defined ($xover->{lockFile}));

    my $s = &status ("closing $xover->{lockFile}");

    # Unlock it.
    &xoverUnlock ($xover);

    # Close the lock file and forget about it.
    $xover->{lockFile}->close ();
    delete ($xover->{lockFile});
    delete ($xover->{locked});

    &setStatus ($s);
}

# Set argv[0] to a meaningful status.
sub status
{
    my $message = shift;
    my $s = "$me:";
    $s .= ' ' . $currentGroup if (defined ($currentGroup));
    $s .= ' (' . $fullCommand . ')' if (defined ($fullCommand) && length ($fullCommand));
    $s .= ' ' . $message if (defined ($message));
    return &setStatus ($s);
}

# Set argv[0] and return previous value.
sub setStatus
{
    my $old = $0;
    my $new = shift;
    $0 = $new;
    return $old;
}

sub quit
{
    print STDERR "$me: ", join ("\n", @_), "\n";
    exit (1);
}

sub usage
{
    my $exit = shift;

    print STDERR "$me: ", join ('', @_), ".\n\n" if ($exit && scalar (@_));
    print STDERR <<EOT;
usage: $me [-v] [-k nnn] host [port]

Make a proxy NNTP connection to host:port. If unspecified, the port number
defaults to 119. This program can keep an NNTP connection from idling, log
all traffic to a file, suppress message headers in postings, obfuscate your
email address to prevent it from being trolled by spammers, and build a
cache of XOVER-style overview information in your local filesystem to speed
up browsing. Options:
-a addr     Bind local endpoint to address before connecting. Handy when
            using as a firewall application proxy.
-k nnn      Send a dummy command every nnn seconds of idle time to keep the
            session active.
-l file     Log all traffic to file. With verbosity enabled, various events
            are also logged.
-p host     Make connection via HTTP proxy at host using CONNECT verb.
-s header   Suppress header in uploaded postings. Note that you can't
            suppress every header. The NNTP host will require certain
	    headers. You can use this to obfuscate certian information, in
	    particular the newsreader program you are using.
-r old=new  Rewrite occurrences of old to new in the headers of uploaded
            postings. You can use this to obfuscate your email address in
	    your posting headers.
-R old=new  Rewrite occurrences of old to new anywhere they occur in
            uploaded postings. You can use this to obfuscate your email
	    address throughout your postings.
-X dir      Build an XOVER cache in dir. One Berkeley btree database file
            is created for each newsgroup browsed. A directory structure is
	    created to keep the databases, with one directory for each
	    newsgroup. Each newsgroup directory also contains an empty lock
	    file used to synchronize access to the xover cache among
	    multiple processes.
-v          Verbosity. Add two for extra loquacity.
EOT

    exit (1);
}