#!/usr/local/bin/perl
#
# readnews-m (configured to read from U. Mannheim news server)
#
# readnews
#   Usenet newsgroup article header retriever.
#   Reads a Usenet newsgroup's article headers, via nntp, and displays 
#      a Web page with the results.
#   Works with the accompanying readmsg script, which reads an 
#      individual article given the newsgroup name and article number. 

#   Usage:
#   <a href="/cgi-bin/readnews?group.name">group.name</a>
#
#   or
#   <form method="POST" action="/cgi-bin/readnews">
#   <input size="40" name="newsgroup">
#   <input type="submit" value="Read / Find Newsgroup"><br>
#   <i>Read</i>: soc.culture.bengali<br>
#   <i>Browse</i>: soc.culture.b<br>
#   <i>Search</i>: food garden agri
#   </form>
#
#   This CGI script retrieves article headers in a Usenet newsgroup 
#   from the news server via NNTP, and displays them on the Web. It
#   prints links to read the individual articles with the separate
#   readmsg-s CGI script.
#
#   If the incoming string exactly matches a newsgroup name, readnews
#   retrieves the most recent article headers for the group, and prints
#   links to display older batches of article headers.
#
#   If no newsgroup name exactly matches, readnews searches the list
#   of newsgroups and returns any group names containing the entered
#   string(s), up to some maximum number of groups. It prints links to
#   retrieve the most recent article headers from each matching group.
#   It lists the matching groups in descending order by the number of 
#   strings matched.
#
# Extensively revised from Bob K.'s scnnews script for Seattle Community
# Network. Some of G. Heil's scnnews revisions may still be here.
# ($these $AND_THESE are unchanged, $TheseVariables are my changes)
#
# Rod Clark <bb615@scn.org>

# v 1.81
# February 6, 2001 -rsc
# - now uses Socket module for better socket compatibility

# v 1.8
# March 30, 1999 -rsc
# - reduced memory usage
# - revised search routines to speed them up a bit

# v 1.7
# July 28, 1998 -rsc
# - Allow multiple search strings in the form search box. List the
#  newsgroups that match all the words first, then those that match
#  some of the words, ranked by number of words matched.

# v 1.6
# July 25, 1998 -rsc
# - Checks via NNTP for an exact match with the entered string before
#   getting the group list to look for partial matches.
# - Reduces resource usage - no longer sorts groups alphabetically,
#   uses fewer memory arrays.
# - Sends an overt quit command to the news server.

# v 1.5
# July 21, 1998 -rsc
# - If the newsgroup name typed in the form input box isn't an exact
#   match, shows all group names containing the string typed, up to
#   some maximum number.
#   To do this, reads the list of groups from the active file.
#   If no active file, reads group list from news server via NNTP.

# v 1.4
# July 15, 1998 -rsc
# - If no query string, looks for a "newsgroup" variable, input from
#   a form that lets the user type in any newsgroup name.

# v 1.3a
# August 8, 1996 -rsc
# - Modified to present articles in several smaller batches
#   (reduces time formerly spent retrieving hundreds of headers,
#   and so increases performance).
# - Now highlights current batch of articles in prompt line.
#   Batch prompt line moved to bottom of page, for Lynx users.
# - Removed local article numbers (lines wrap less often on Lynx).

#---------------------------------------------------------------
# Configuration:
#---------------------------------------------------------------

# $ReadnewsName		= "readnews";
# $ReadmsgName		= "readmsg";

$ReadnewsName 	        = "readnews-m";
$ReadmsgName		= "readmsg-m";

$newshost               = "news.uni-mannheim.de";

# $ActiveFile             = "/usr/lib/news/active";
$ActiveFile             = "/web/usenet/mannheim/active-m.txt";

# If the active file above isn't available, and NNTP LIST is too slow
# (for a large number of newsgroups instead of a small number of local
# newsgroups) then you can set this to 0, to disable searching for 
# newsgroups.

$AllowPartialMatches    = 1;

# Uncomment one of these @GoodReferrer lines:
#    For using forms on one server:
@GoodReferrers          = ('scn.org');

#    For using forms on any of several servers:
# @GoodReferrers  = ('yourdomain.com', 'another.com');

# these prompts appear on the header list page:
# $QuitPrompt = "<font size=\"-2\">To return to the menu, press the left arrow.</font>";
# $PostPrompt = "<font size=\"-2\">To post messages (if logged in) see the main SCN menu.</font>";

# This prompt appears on normal header listing screens, and on error 
# message screens (except "connection refused" errors):

$EmailPrompt            = "Questions about using this newsreader: ";
$EmailAddress           = "webmaster\@scn.org";

# These groups don't get the above prompt printed, because we don't want
# spurious mail from them.

$MaxArticlesPerBatch    = 30;
$MaxNumberOfBatches     = 20;
$MaxMatchingGroups      = 100;

# This prompt appears at the bottom of the page when a partial string
# generates more than $MaxMatchingGroups matches:
$TooManyMatchesPrompt   = "Too many matches - try a more specific search.";

# This prompt appears on error pages for forms submitted from other than
# allowed domains:
$DomainErrorTitle       = "Form Is Outside Domain";

# $debug               = 1;

#---------------------------------------------------------------
# You shouldn't need to set anything below this line.
#---------------------------------------------------------------

$port           = 119 unless $port;
$AF_INET        = 2;
$sockaddr       = 'S n a4 x8';
use Socket;

$DateLength     = 6; # "Jul 28"

#---------------------------------------------------------------
# End of configuration
#---------------------------------------------------------------

&PrintHeader;
if ($ENV{'QUERY_STRING'})
{
  $QueryString = $ENV{'QUERY_STRING'};
  # $CurrentBatch = 1 for most recent articles, 2 for next most recent...
  ($newsgroup, $CurrentBatch) = split (/=/, $QueryString, 2);
}
else
{
  &CheckReferrer;
  &ParseForm;
}
&PrintPageTop;
&ConnectToNewsServer;
if ($QueryString)
{
  &GetArticleHeaders;
}
else
{
  if (!$AllowPartialMatches)
  {
    &GetArticleHeaders;
  }
  else
  {
    $GroupStatus = &CheckGroupStatus;
    # if entered newsgroup name exactly matches a group
    if ($GroupStatus == 211)
    {
      &GetArticleHeaders;
    }
    else
    {
      &GetGroupList;
      &ScanGroupsForMatches;
      &ListMatchingGroups;
    }
  }
}
&QuitNewsServer;

exit 0;


#---------------------------------------------------------------
# subroutines
#---------------------------------------------------------------

sub CheckReferrer
{
  $Referrer = $ENV{'HTTP_REFERER'};
  $ReferrerOK = 0;
  if ($Referrer)
  {
    $NumGoodReferrers = @GoodReferrers;
    for ($Index = 0; $Index < $NumGoodReferrers; $Index++)
    {
      if ($Referrer =~ +$GoodReferrers[$Index]+i)
      {
        $ReferrerOK = 1;
      }
    }
  }
  else
  {
    $ReferrerOK = 1;
  }

  if (!$ReferrerOK)
  {
    &PrintErrorPageTop ($DomainErrorTitle);
    $ErrorMessage = "The form at <b>$Referrer</b> is outside our domain. Access is denied.";
    &PrintErrorFooter;
    exit;
  }
}


sub ParseForm
{
  &ReadParse;

  foreach $Part (@in)
  {
    ($Key, $Val) = split (/=/, $Part, 2);
    $Val = &CleanVariable ($Val);

    $Part = ($Key."=".$Val);
    push (@CleanIn, $Part);
  }
  @in = @CleanIn;

  $newsgroup = $in{'newsgroup'};

  # disallow most special chars
  if ($newsgroup =~ /[^a-zA-Z0-9-_+\.\@\$\?\=\| ]/)
  {
    &PrintPageTop;
    $ErrorMessage = "<b>invalid characters</b> in group name";
    &PrintErrorFooter;
    exit;
  }

  if (!$newsgroup)
  {
    &PrintPageTop;
    $ErrorMessage = "<b>No group specified</b>";
    &PrintErrorFooter;
    exit;
  }
}


sub CleanVariable
{
  local ($CleanedVariable) = @_;

  $CleanedVariable =~ s/"/ /g;
  $CleanedVariable =~ s/&quot;/ /g;
  $CleanedVariable =~ s/&#34;/ /g;
  $CleanedVariable =~ s/%22/ /g;

  $CleanedVariable =~ s/</ /g;
  $CleanedVariable =~ s/&lt;/ /g;
  $CleanedVariable =~ s/&#60;/ /g;
  $CleanedVariable =~ s/%3C/ /g;
  $CleanedVariable =~ s/%3c/ /g;

  $CleanedVariable =~ s/>/ /g;
  $CleanedVariable =~ s/&gt;/ /g;
  $CleanedVariable =~ s/&#62;/ /g;
  $CleanedVariable =~ s/%3E/ /g;
  $CleanedVariable =~ s/%3e/ /g;

  $CleanedVariable =~ s/\n/ /g;
  $CleanedVariable =~ s/%0A;/ /g;
  $CleanedVariable =~ s/%0a;/ /g;
  $CleanedVariable =~ s/&#10;/ /g;

  $CleanedVariable =~ s/\r/ /g;
  $CleanedVariable =~ s/%0D;/ /g;
  $CleanedVariable =~ s/%0d;/ /g;

  $CleanedVariable =~ s/\t/ /g;
  $CleanedVariable =~ s/%09;/ /g;
  $CleanedVariable =~ s/&#09;/ /g;

  # collapse whitespace
  $CleanedVariable =~ s/\s+/ /g;

  # remove leading and trailing whitespace
  $CleanedVariable =~ s/^\s//g;
  $CleanedVariable =~ s/\s$//g;

  return ($CleanedVariable);
}


sub ConnectToNewsServer
{
  ($name, $aliases, $proto) = getprotobyname ('tcp');
  ($name, $aliases, $port) = getservbyname ($port, 'tcp')
    unless $port =~ /^\d+$/;

  if ($newshost =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/)
  {
    $thataddr = pack ('C4', $1, $2, $3, $4);
  }
  else
  {
    if ($newshost =~ /(\w+)(\.\w+)*/)
    {
      ($name, $aliases, $type, $len, $thataddr) = gethostbyname ($newshost);
    }
    else
    {
      $ErrorMessage = "<b>Error:</b> NNTP host not specified in proper format";
      &PrintErrorFooter;
      exit;
    }
  }

  $this = pack ($sockaddr, $AF_INET, 0, $thisaddr);
  $that = pack ($sockaddr, $AF_INET, $port, $thataddr);

  if (socket (S, $AF_INET, SOCK_STREAM, $proto))
  {
    if ($debug)
    {
      print "DEBUG: socket ok\n";
    }
  }
  else
  {
    $ErrorMessage = "<b> Error:</b> socket failed $1";
    &PrintErrorFooter;
    exit;
  }

  if (bind (S, $this))
  {
    if ($debug)
    {
      print "DEBUG: bind ok\n";
    }
  }
  else
  {
    $ErrorMessage = "<b>Error:</b> bind to $this failed $1";
    &PrintErrorFooter;
    exit;
  }

  if (connect (S, $that))
  {
    if ($debug)
    {
      print "DEBUG: Connect to $newshost ok\n";
    }
  }
  else
  {
    $ErrorMessage = "<b>Can't connect</b> to $newshost tcp/ip port $port. Error: $1";
    &PrintErrorFooter;
    exit;
  }

  # buffer the socket
  select (S);
  $| = 1;
  select (STDOUT);

  $InitialStatus = &CheckInitialServerStatus;
  if (($InitialStatus != 200) && ($InitialStatus != 201))
  {
    $ErrorMessage = "$newshost refused connection: status $status - <b>$rest</b>";
    &PrintErrorFooter;
    exit;
  }
}


sub GetGroupList
{
  if ((-e $ActiveFile) && (-r $ActiveFile) && !(-z $ActiveFile))
  {
    &GetGroupListFromActiveFile ($ActiveFile);
  }
  else
  {
    &GetGroupListFromNNTP;
  }
}


sub GetGroupListFromActiveFile
{
  local ($ThisListFile) = @_;

  if (!open (ACTIVE, "$ThisListFile"))
  {
    print "Can't read news active file: $ThisListFile\n";
    exit;
  }

  @ActiveLines = <ACTIVE>;
  close (ACTIVE);
  foreach $ActiveLine (@ActiveLines)
  {
    ($GroupName, $EndMessageNumber, $StartMessageNumber, $StatusCode)
    = split (/\s/, $ActiveLine, 4);

    if (($GroupName =~ /\S/)
    && ($GroupName !~ /^junk$/) && ($GroupName !~ /^control$/))
    {
      $NumberOfMessages = ($EndMessageNumber - $StartMessageNumber) + 1;
      if ($NumberOfMessages < 0)
      {
        $NumberOfMessages = 0;
      }
      push (@GroupLines, "$GroupName $NumberOfMessages");
    }
  }
}


sub GetGroupListFromNNTP
{
  $ListStatus = &CheckListStatus;
  if ($ListStatus != 215)
  {
    $ErrorMessage = "$ErrorMessage"."\n<b>Error:</b> List command rejected ($status)";
  }
  else
  {
    while (<S>)
    {
      last if ($_ eq ".\r\n");
      chop;
      chop;
      ($GroupName, $EndMessageNumber, $StartMessageNumber, $StatusCode)
      = split (/\s/, $_, 4);

      if (($GroupName =~ /\S/)
      && ($GroupName !~ /^junk$/) && ($GroupName !~ /^control$/))
      {
        $NumberOfMessages = ($EndMessageNumber - $StartMessageNumber) + 1;
        if ($NumberOfMessages < 0)
        {
          $NumberOfMessages = 0;
        }
        push (@GroupLines, "$GroupName $NumberOfMessages");
      }
    }
    if ($_ ne ".\r\n")
    {
      $ErrorMessage = "$ErrorMessage"."\n<a>Error:</b> Unexpected EOF on socket";
    }
  }
}


sub ScanGroupsForMatches
{
  # defeat unintentional pattern matching and whatnot
  $newsgroup =~ s/\+/\\+/g;
  $newsgroup =~ s/\./\\./g;
  $newsgroup =~ s/\?/\\?/g;
  $newsgroup =~ s/\$/\\\$/g;
  $newsgroup =~ s/\@/\\@/g;
  $newsgroup =~ s/\|/\\|/g;

  $SearchText = $newsgroup;
  @SearchWords = split (/ /, $SearchText);

  $NumberOfSearchWords = @SearchWords;
  $NumberOfGroups = @GroupLines;

  if ($NumberOfSearchWords == 1)
  {
    &SearchExactPhrase;
  }
  else
  {
    &SearchAndOr;
  }
}


sub SearchExactPhrase
{
  for ($Index = 0; (($Index < $NumberOfGroups) && ($MatchingLinesFound < $MaxMatchingGroups)); $Index++)
  {
    ($ThisGroup, $ThisNumberOfMessages)
    = split (/ /, $GroupLines[$Index], 2);

    if ($ThisGroup =~ /$SearchText/i)
    {
      push (@FoundLinesExact, $GroupLines[$Index]);
      $GroupLines[$Index] = "duplicate_line 0";
      $MatchingLinesFound++;
    }
  }
}


sub SearchAndOr
{
  # *** NEW v1.8
  for ($GroupIndex = 0; (($GroupIndex < $NumberOfGroups) && ($MatchingLinesFoundWithAll < $MaxMatchingGroups)); $GroupIndex++)
  {
    ($ThisGroup, $ThisNumberOfMessages)
    = split (/ /, $GroupLines[$GroupIndex], 2);

    # *** NEW v1.8
    $MatchingWordsOnLine = 0;
    $WordIndex = 0;
    while ((!$MatchingWordsOnLine) && ($WordIndex < $NumberOfSearchWords))
    {
      if ($ThisGroup =~ /$SearchWords[$WordIndex]/i)
      {
	$MatchingWordsOnLine++;
      }
      $WordIndex++;
    }

    if ($MatchingWordsOnLine)
    {
      if ($MatchingWordsOnLine > 1)
      {
	push (@FoundLinesAnd, $GroupLines[$GroupIndex]);
	push (@FoundLinesAndQty, $MatchingWordsOnLine);
        if ($MatchingWordsOnLine == $NumberOfSearchWords)
        {
          $MatchingLinesFoundWithAll++;
        }
      }
      else
      {
	push (@FoundLinesOr, $GroupLines[$GroupIndex]);
      }
      $GroupLines[$GroupIndex] = "duplicate_line 0";
      $MatchingLinesFound++;
    }
  }

  $NumberOfFoundLinesAnd = @FoundLinesAnd;
  $NumberOfFoundLinesOr = @FoundLinesOr;
  # $NumberOfFoundLinesAndOr = $NumberOfFoundLinesAnd + $NumberOfFoundLinesOr;

  # rank by relevance
  if ($NumberOfFoundLinesAnd)
  {
    for ($QtyIndex = 2; $QtyIndex <= $NumberOfSearchWords; $QtyIndex++)
    {
      for ($AndIndex = 0; $AndIndex < $NumberOfFoundLinesAnd; $AndIndex++)
      {
	if ($FoundLinesAndQty[$AndIndex] == $QtyIndex)
	{
	  push (@RankedLinesAnd, $FoundLinesAnd[$AndIndex]);
	  push (@RankedLinesAndQty, $QtyIndex);
	}
      }
    }
    @FoundLinesAnd = @RankedLinesAnd;
    @FoundLinesAndQty = @RankedLinesAndQty;
  }
}


sub ListMatchingGroups
{
  if ($MatchingLinesFound == 0)
  {
    $ErrorMessage = "<b>no matching groups</b>";
    &PrintErrorFooter;
    exit;
  }

  if ($NumberOfSearchWords == 1)
  {
    &PrintMatchingGroupsExact;
  }
  else
  {
    &PrintMatchingGroupsAndOr;
  }

  if ($MatchingLinesFound >= $MaxMatchingGroups)
  {
    print "<p>\n";
    print "$TooManyMatchesPrompt\n";
  }
  &PrintPageFooter;
}


sub PrintMatchingGroupsExact
{
  foreach $FoundLine (@FoundLinesExact)
  {
    ($ThisGroup, $ThisNumberOfMessages) = split (/ /, $FoundLine);
    print "<a href=\"/scripts/$ReadnewsName?$ThisGroup\">$ThisGroup</a> $ThisNumberOfMessages<br>\n";
  }
}


sub PrintMatchingGroupsAndOr
{
  if ($NumberOfFoundLinesAnd)
  {
    for ($Index = 0; (($Index < $NumberOfFoundLinesAnd) && ($Index < $MaxMatchingGroups)); $Index++)
    {
      $FoundLine = $FoundLinesAnd[$Index];
      ($ThisGroup, $ThisNumberOfMessages) = split (/ /, $FoundLine);
      print "<a href=\"/scripts/$ReadnewsName?$ThisGroup\">$ThisGroup</a> $ThisNumberOfMessages<br>\n";
      $MatchesPrinted++;
    }
  
    if ($NumberOfFoundLinesOr)
    {
      print "<p>\n";
    }
  }

  for ($Index = 0; (($Index < $NumberOfFoundLinesOr) && ($MatchesPrinted < $MaxMatchingGroups)); $Index++)
  {
    $FoundLine = $FoundLinesOr[$Index];
    ($ThisGroup, $ThisNumberOfMessages) = split (/ /, $FoundLine);
    print "<a href=\"/scripts/$ReadnewsName?$ThisGroup\">$ThisGroup</a> $ThisNumberOfMessages<br>\n";
    $MatchesPrinted++;
  }
}


sub GetArticleHeaders
{
  $GroupStatus = &CheckGroupStatus;
  if ($GroupStatus == 411)
  {
    $ErrorMessage = "<b>$newsgroup</b> does not exist on the news server";
    &PrintErrorFooter;
    exit;
  }
  elsif ($GroupStatus == 211)
  {
    # if group is empty
    if ($gmany == 0)
    {
      $ErrorMessage = "$newsgroup: <b>no articles found</b>";
      &PrintErrorFooter;
      exit;
    }

    if (!$CurrentBatch)
    {
      $CurrentBatch = 1;
    }
    &ComputeNumberOfBatches;
    $CurrentArticleNum = &ComputeStartAndEndArticles;
    $ArticleStatus = &CheckArticleStatus;
    if ($ArticleStatus != 223)
    {
      &FindNextValidArticle;
    }
    &ReadArticleHeaders;
    &PrintPageFooter;
  }
}


sub FindNextValidArticle
{
  while (($ArticleStatus != 223) && (!$EndOfArticles))
  {
    $ArticleStatus = &CheckNextArticleStatus;
  }
}


sub ComputeNumberOfBatches
{
  $NumberOfBatches = int ($gmany / $MaxArticlesPerBatch);
  if (($gmany % $MaxArticlesPerBatch) > 0)
  {
    $NumberOfBatches++;
  }

  if ($NumberOfBatches > $MaxNumberOfBatches)
  {
    $NumberOfBatches = $MaxNumberOfBatches;
    if (($glast - $gfirst) > ($MaxNumberOfBatches * $MaxArticlesPerBatch))
    {
      $gfirst = $glast - ($MaxNumberOfBatches * $MaxArticlesPerBatch);
    }
  }
}


sub ComputeStartAndEndArticles
{
  # if total articles are one screenful or less
  if ($gmany < $MaxArticlesPerBatch)
  {
    $EndArticleNum = $glast;
    $StartArticleNum = $gfirst;
  }
  else # total articles are more than one screenful
  {
    $EndArticleNum = $glast - ($MaxArticlesPerBatch * ($CurrentBatch - 1));
    # if current batch is partial (earliest) screenful of articles
    if (($EndArticleNum - $gfirst) < $MaxArticlesPerBatch)
    {
      $StartArticleNum = $gfirst;
    }
    else # current batch is a full screenful of articles
    {
      $StartArticleNum = ($EndArticleNum - $MaxArticlesPerBatch) + 1;
    }
  }
  return ($StartArticleNum);
}


sub ReadArticleHeaders
{
  $EndOfArticles = 0;
  while (($CurrentArticleNum <= $EndArticleNum) && (!$EndOfArticles))
  {
    if ($ArticleStatus == 223) # article OK
    {
      $HeadStatus = &CheckHeadStatus;
      if ($HeadStatus == 221)
      {
        &BuildArticleHeaderLine;
      }
    }
    $ArticleStatus = &CheckNextArticleStatus;
  }
  &PrintBatchOfHeaders;
  &PrintBatchPromptLine;
}


sub BuildArticleHeaderLine
{
  # read first line of text
  $_ = <S>;

  # loop until encounter lone period at start of line
  # (.^J ends text in NNTP)
  $date = $from = $subject = "";
  while (!/^\.[^\.].*$/)
  {
    # remove trailing CR LF (^M ^J)
    chop;
    chop;
    # get article header
    $line = $_."\n";
    # restore line feed LF (^J) to end of line

    if ($line =~ /^Subject: (.*)$/)
    {
      $subject = $1;
      $subject = &EntifyVariable ($subject);
    }
    elsif ($line =~ /^From: .*(\(.*\)).*$/)
    {
      $from = $1;
      $from = &EntifyVariable ($from);
    }
    elsif ($line =~ /^Date: \w+, (\d+) (\w+).*$/)
    {
      $date = "$2 $1";
      $date = &EntifyVariable ($date);
    }

    # read next line of header
    $_ = <S>;
  }

  # build article header line to display
  if (!$date)
  {
    $date = "___ __";
  }
  $ArticleHeaderLine = "\<tt>".$date;
  # if "Mth N" instead of "Mth NN"
  if (length ($date) < $DateLength)
  {
    $ArticleHeaderLine = $ArticleHeaderLine."_ ";
  }
  else
  {
    $ArticleHeaderLine = $ArticleHeaderLine." ";
  }
  $ArticleHeaderLine = $ArticleHeaderLine."</tt><a href=\"/scripts/$ReadmsgName?$newsgroup,$ArticleNum\">";
  $ArticleHeaderLine = $ArticleHeaderLine."$subject</a> $from<br>\n";

  push (@BatchHeaderLines, $ArticleHeaderLine);
}


sub PrintBatchOfHeaders
{
  foreach $BatchHeaderLine (@BatchHeaderLines)
  {
    print "$BatchHeaderLine";
  }
}


sub EntifyVariable
{
  local ($ToEntify) = @_;

  $ToEntify =~ s/</&lt;/g;
  $ToEntify =~ s/>/&gt;/g;
  $ToEntify =~ s/"/&quot;/g;

  return ($ToEntify);
}


#----------------------------------------------------------------
# send NNTP commands to news server
#----------------------------------------------------------------

sub CheckInitialServerStatus
{
  # read server status
  $_ = <S>;
  ($status, $rest) = split (/ /, $_, 2);

  if ($status == 200 || $status == 201)
  {
    # 200 server ready - posting allowed
    # 201 server ready - no posting allowed
    # otherwise there has been a problem

    if ($debug)
    {
      if ($status == 200)
      {
        print "DEBUG: status = $status (posting allowed)\n";
      }
      elsif ($status == 201)
      {
        print "DEBUG: status = $status (no posting)\n";
      }
    }
  }
  return ($status);
}


sub CheckListStatus
{
  print S "LIST\n";
  # read reply
  $_ = <S>;
  ($status, $rest) = split (/ /, $_, 2);
  return ($status);
}


sub CheckGroupStatus
{
  print S "GROUP $newsgroup\n";
  # read reply
  $_ = <S>;
  ($status, $gmany, $gfirst, $glast, $gname) = split (/ /, $_, 5);
  return ($status);
}


sub CheckArticleStatus
{
  print S "STAT $CurrentArticleNum\n";
  # read reply
  $_ = <S>;
  ($status, $ArticleNum, $ArticleID, $rest) = split (/ /, $_, 4);
  return ($status);
}


sub CheckHeadStatus
{
  print S "HEAD\n";
  # read reply
  $_ = <S>;
  ($status, $ArticleNum, $ArticleID, $rest) = split (/ /, $_, 4);
  return ($status);
}


sub CheckNextArticleStatus
{
  # send next article command to NNTP server
  print S "NEXT\n";

  # retrieve reply
  $_ = <S>;

  ($status, $ArticleNum, $ArticleID, $rest) = split (/ /, $_, 4);

  if ($status == 223) # article OK
  {
    $CurrentArticleNum = $ArticleNum;
  }
  elsif (($status == 420) || ($status == 423) || ($status == 430))
  {
    # at the moment, don't do anything with these
  }
  elsif ($status == 421) # no next article in group
  {
    $EndOfArticles = 1;
  }
  else # unexpected response
  {
    $EndOfArticles = 1;
  }
  return ($status);
}


sub QuitNewsServer
{
  print S "QUIT\n";
  $_ = <S>;

  ($status, $StatusMessage) = split (/ /, $_, 2);

  if ($status != 205)
  {
    $ErrorMessage = "news server status=$status: $StatusMessage\n";
    &PrintErrorFooter;
    exit 1;
  }
  return ($status);
}


#----------------------------------------------------------------
# print Web pages
#----------------------------------------------------------------

sub PrintPageTop
{
  print <<ENDPRINT;

<html>
<head>
<title>$newsgroup</title>
</head>
<body background="/images/tan.gif" bgcolor="#FFFFE4">

<center>
<h2>$newsgroup</h2>
</center>
<!-- $QuitPrompt<br> -->
<!-- $PostPrompt -->
<hr>

ENDPRINT
}


sub PrintErrorPageTop
{
  # call this only to precede error output before $newsgroup is defined
  local ($PrintErrorPageTopTitle) = @_;

  print <<ENDPRINT;

<html>
<head>
<title>$PrintErrorPageTopTitle</title>
</head>
<body background="/images/tan.gif" bgcolor="#FFFFE4">

<center>
<h2>$PrintErrorPageTopTitle</h2>
</center>
<hr>

ENDPRINT
}


sub PrintBatchPromptLine
{
  if ($NumberOfBatches > 1)
  {
    print "<hr>\n";
    print "<center>\n";
    if ($CurrentBatch == 1)
    {
      print "<b>(Latest)</b> \n";
    }
    else
    {
      print "<a href=\"/scripts/$ReadnewsName?$newsgroup\">Latest</a> \n";
    }

    if ($NumberOfBatches > 2)
    {
      for ($Batch = 2; $Batch < $NumberOfBatches; $Batch++)
      {
        if ($CurrentBatch == $Batch)
        {
          print "<b>($Batch)</b> \n";
        }
        else
        {
          print "<a href=\"/scripts/$ReadnewsName?$newsgroup=$Batch\">$Batch</a> \n";
        }
      }
    }
    if ($CurrentBatch == $NumberOfBatches)
    {
      print "<b>(Earliest)</b>\n";
    }
    else
    {
      print "<a href=\"/scripts/$ReadnewsName?$newsgroup=$NumberOfBatches\">Earliest</a>\n";
    }
    print "</center>\n";
  }
}


sub PrintErrorFooter
{
  print <<ENDPRINT;

<center>$ErrorMessage</center>

ENDPRINT

&PrintPageFooter;
}


sub PrintPageFooter
{
  print <<ENDPRINT;

<hr>

<font size="-1">
$EmailPrompt<a href="mailto:$EmailAddress">$EmailAddress</a>
</font>

</body>
</html>

ENDPRINT
}


#=====================================================================
# GENERAL PURPOSE (BOILERPLATE) ROUTINES
#=====================================================================

# from cgi-lib.pl v1.14
# http://cgi-lib.stanford.edu/cgi-lib/

# Perl Routines to Manipulate CGI input
#
# Copyright (c) 1995 Steven E. Brenner
# Permission granted to use and modify this library so long as the
# copyright above is maintained, modifications are documented, and
# credit is given for any use of the library.

# modifications: -rsc
# - near the end of ReadParse, escaped backslash in
#      $in{$key} .= "\0" if (defined($in{$key}));
#   to $in{$key} .= "\\0" if (defined($in{$key}));
# - limited hex characters to a-f, A_F and 0-9 after % in hex
#      to ASCII conversion statements, instead of %any-character

sub ReadParse
{
  local (*in) = @_ if @_;
  local ($i, $key, $val);

  # Read in text
  if (&MethGet)
  {
    $in = $ENV{'QUERY_STRING'};
  }
  elsif (&MethPost)
  {
    read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
  }

  @in = split(/[&;]/,$in);

  foreach $i (0 .. $#in)
  {
    # Convert plusses to spaces
    $in[$i] =~ s/\+/ /g;

    # Split into key and value
    # splits on the first =
    ($key, $val) = split(/=/,$in[$i],2);

    # convert hex values (e.g. %0A) to ASCII characters
    # $key =~ s/%(..)/pack("c",hex($1))/ge;
    # $val =~ s/%(..)/pack("c",hex($1))/ge;
    $key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
    $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;

    # Associate key and value
    # \0 is the multiple separator
    $in{$key} .= "\\0" if (defined($in{$key}));
    $in{$key} .= $val;
  }
  return scalar(@in);
}

sub MethGet
# true if this cgi call was using the GET request, false otherwise
{
  return ($ENV{'REQUEST_METHOD'} eq "GET");
}

sub MethPost
# true if this cgi call was using the POST request, false otherwise
{
  return ($ENV{'REQUEST_METHOD'} eq "POST");
}

sub PrintHeader
{
  print "Content-type: text/html\n\n";
  return;
}