#!/usr/bin/perl
#
# $Id: access_nntp,v 1.7 1994/08/03 07:17:26 jeff Exp jeff $
#
# written by Jeff Gilbreth, June 20 1994.
#
# socket code taken from `urlsnarf', written by Allen Condit.
#
#
# This PERL filter accepts specialized HTTP requests from Chimera
# on stdin and converts them into NNTP requests to the local server.
# The program then formats the results into an HTTP response sent to
# stdout, and exits.
#
#
#
#
#
# Copyright 1994 by Jeff Gilbreth.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted,
# provided that the above copyright notice appear in all copies and that
# both that copyright notice and this permission notice appear in
# supporting documentation, and that the name of Jeff Gilbreth not be
# used in advertising or publicity pertaining to distribution of the
# software without specific, written prior permission. Jeff Gilbreth
# makes no representations about the suitability of this software for
# any purpose.  It is provided "as is" without express or implied
# warranty.
# 
# JEFF GILBRETH DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
# EVENT SHALL JEFF GILBRETH BE LIABLE FOR ANY SPECIAL, INDIRECT OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
# USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
#
#
#
#	$Log: access_nntp,v $
# Revision 1.7  1994/08/03  07:17:26  jeff
# added the log
#
# $Id: news.pl 1.0 1995/01/03 19:05:15 michael Exp michael $
#
# Rewritten in Parts by Michael Kellen, February 1995
#
# MICHAEL KELLEN DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE,
# INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO
# EVENT SHALL MICHAEL KELLEN BE LIABLE FOR ANY SPECIAL, INDIRECT OR
# CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF
# USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
# OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
# PERFORMANCE OF THIS SOFTWARE.
#
# Major OverHaul1995/01/03   michael kellen  <kellen@physics.montana.edu>
#
#          Fancy HTML Formatting Added
#          Message ID access recognized
#          Built-in Post/Reply Forms Added (stubs for postto.pl and mailto.pl)
#          Overviews Files Used Instead of Headers for Group List




# make a call to the option handler...
#
require 'getopts.pl';
&Getopts ('hsrn:');


$prog = `basename $0`;
chop $prog;


&Usage() if ($#ARGV != -1);
&Usage() if $opt_h;




#
# some defaults
#
$USER = "$ENV{'USER'}";                      # user name
$NAME = "$ENV{'NAME'}";			     # Full Name
$HOME = "$ENV{'HOME'}";                      # Home directory
($HOSTNAME) = gethostbyname("$ENV{'HOSTNAME'}");

$quotechar = "$ENV{'QUOTECHAR'}";
$quotechar = ">"			if (!$quotechar);

$servername ="$ENV{'NNTPSERVER'}";
$servername = "usenet.coe.montana.edu"		if (!$servername);

$orgname = "$ENV{'NEWSORG'}";
$orgname = "$ENV{'ORGANIZATION'}"	if (!$orgname);
$orgname = "MSU Physics Department"	if (!$orgname);

$history_file = "$HOME/.access_nntp_rc";
$newsrc = "$HOME/.newsrc";



#     No Need to Edit Below Here
#
($name, $aliases, $port, $proto) = getservbyname("nntp", "tcp");
$version = "1.0";
$filename = "/";
$protocol = "nntp";
$return_code = 200;
$return_string = "OK";
$content_type = "text/html";

if (defined $opt_n) {
	$servername = $opt_n;
}



&ProcessHTTPRequest;
&GetHistory   if ($opt_r);
&MakeNNTPRequest;
&FormatData;
&ReturnHTTPData;



if ($opt_r && defined %history) {
	dbmclose (%history);
}



exit 0;



#
# INPUT routine
#

sub ProcessHTTPRequest {

	# format of input - headers may be in any order, or not present or blank
	#
	#  BLAH URI HTTP/1.0
	#  User-Agent: chimera/1.64
	#  Accept: *.*
	#	URI: nntp://host/newsgroup/article#
	#	X-protocol: nntp
	#	X-hostname: host
	#	X-port: port
	#	X-filename: /newsgroup/article[?action]
	#	message [optional]
	#	[blank line]


	chop ($http = <STDIN>);

	($http_cmd, $http_uri, $http_id) = split (/\s+/, $http, 3);

	($http_name, $http_version) = split (/\//, $http_id);

	if ($http_name ne "HTTP") {

		&HTTPError ("protocol \"$http_name\" not accepted\n");
	}

	if ($http_version != $version) {

		&HTTPError ("invalid HTTP protocol version: $http_version\n");
	}


	while (<STDIN>) {

		chop ($type = $_);


		# check for the blank line that terminates input
		#
		if ($type eq "") {

			last;
		}


		# check for non-field lines 
		#
		if ($type !~ /^[\w-]+\s*:/) {

			$MESSAGE .= $_;
			next;
		}

		# must be a field line. parse name and value
		#
		($type_name, $type_value) = split (/\s*:\s*/, $type, 2);

		if ($type_name eq "X-hostname") {

			next if (!$type_value);

			$servername = $type_value;
		}

		elsif ($type_name eq "URI") {

			($uri_proto, $uri_path) = split (/\s*:\s*/, $type_value);

			if ($uri_proto ne "news") {

				&HTTPError ("protocol \"$uri_proto\" not accepted for URIs\n");
			}

		}

		elsif ($type_name eq "X-port") {

			next if ($type_value eq "0");

			$port = $type_value;
		}

		elsif ($type_name eq "X-filename") {

			next if ($type_value eq "" || $type_value eq "/");

			$filename = $type_value;
		}

		elsif ($type_name eq "X-protocol") {

			$protocol = $type_value;
		}

		else {

			push (@unknown_fields, $type_name);
		}
	}

	($filename,$action) = split( '\?', $filename, 2);

	if ($filename =~ /@/ ) {
                $temp = $filename;
                while ($temp =~ s/\/*([^\/]+)// ) {

                        push (@newspath, $1);
                }

                $articleID = shift(@newspath) if (@newspath >= 1);
	} else {

                $temp = $filename;
                while ($temp =~ s/\/*([^\/]+)// ) {

                        push (@newspath, $1);
                }

                $group = shift(@newspath) if (@newspath >= 1);
                $article = shift(@newspath) if (@newspath >= 1);
        }

	$post = "Y"		if ($action =~ /post/);
	$mail = "Y"		if ($action =~ /mail/);
	$include = "Y"		if ($action =~ /include/);
	$new = "Y"		if ($action =~ /new/);


	0;
}

#
# LOOKUP routine
#

sub MakeNNTPRequest {

	$server = $servername;

	# connect to the server
	#
	local($sockaddr,$here,$there,$response,$tries) = ("Snc4x8");
	$here  = pack($sockaddr, 2, 0, &getaddress("localhost"));
	$there = pack($sockaddr, 2, $port, &getaddress($server));
	&HTTPError ("socket: $!") if (!socket(N,2,1,6));
	&HTTPError ("connect($servername:$port): $!") if (!connect(N,$there));
	select(N);       $| = 1;                # make unbuffered
	select(STDOUT);

	# check the response to the initial connection
	#
	$accept = <N>;
	($accept_code, $accept_string) = split (/\s+/, $accept, 2);
	if ($accept_code >=300) {
	
		&HTTPError
		("initial connect problem: $accept_code $accept_string");
	}








        if (defined $articleID) {

                # article requested by MessageID
                #
		if ($articleID =~ /^\//) {
			$articleID =~ s|^/||;
		}
		$response_string = &SubRequest ("STAT <$articleID>");

		($response_code, $response_string) = &CondSubRequest ("LAST");

		if ($response_code < 300) {
			($prev_article) = split (' ', $response_string);
		}

		$response_string = &SubRequest ("STAT <$articleID>");

		($response_code, $response_string) = &CondSubRequest ("NEXT");

		if ($response_code < 300) {
			($next_article) = split (' ', $response_string);
		}
		$response_string = &SubRequest ("ARTICLE <$articleID>");

	} elsif (defined $group) {

		# request info on the desired group
		#
		$response_string = &SubRequest ("GROUP $group");


		# process the group info
		#
		($grp_amount, $grp_start, $grp_end) = 
			split (' ', $response_string);

		if (defined $article) {

			# first, we make the desired article the
			# current one. then we get the numbers 
			# of the previous and next articles.
			#
			# after all that, we then get the desired article
			#
			$response_string = &SubRequest ("STAT $article");

			($response_code, $response_string) = 
				&CondSubRequest ("LAST");

			if ($response_code < 300) {
				($prev_article) = split (' ', $response_string);
			}

			$response_string = &SubRequest ("STAT $article");

			($response_code, $response_string) = 
				&CondSubRequest ("NEXT");

			if ($response_code < 300) {
				($next_article) = split (' ', $response_string);
			}
			
			$request = "ARTICLE $article";
		} else {

			# get the list of articles
			#
 			$request = "XOVER ${grp_start}-${grp_end}";
		}

		# make the article request
		#
		$response_string = &SubRequest ("$request");


	} else {

		# no group specified, get the WHOLE list
		#
		$response_string = &SubRequest ("LIST");

	}

	# grab the data provided. look for the end-marker 
	# line with a single period 
	#
	$line = <N>;
	while ($line !~ /^\./) {

		$DATA .= $line;
		$line = <N>;
	}

	# close the nntp connection
	#
	print N "QUIT\n";

	0;
}






# this little routine sends requests to the nntp server
# and checks the response code for errors. if it is 
# successful, we only need the $response_string
#
sub SubRequest {

	local ($request) = @_;
	local ($response, $response_code, $response_string);

	print N "$request\n";
	chop ($response = <N>);
	($response_code, $response_string) = split (' ', $response, 2);
	if ($response_code >= 300) {

		&HTTPError
		("bad request: \"$request\": $response_code ",
		"$response_string");
	}

	$response_string;
}



# this little routine sends requests to the nntp server
# and checks the response code for errors. if it is 
# successful, we should get the $response_code, for 
# further checking of codes, and the $response_string.
#
sub CondSubRequest {

	local ($request) = @_;
	local ($response, $response_code, $response_string);

	print N "$request\n";
	chop ($response = <N>);
	($response_code, $response_string) = split (' ', $response, 2);
	if ($response_code >= 300 && $response_code < 400) {

		&HTTPError
		("bad request: \"$request\": $response_code ",
		"$response_string");
	}

	($response_code, $response_string);
}

sub FillHeader {
	$sigfile = "$ENV{'SIGNATURE'}";
	$sigfile = "$HOME/.signature"	if (!$sigfile);
	if ( -r $sigfile ) {
		open (SIG, $sigfile);
		while(<SIG>) {
			$signature .= $_;
		}
		close(SIG);
	}

	$REPLYTO = "$ENV{'REPLYTO'}";                # Any valid Reply-To value
	
	if ( $post eq "Y" ) {
		$head = "$ENV{'NEWSHEADER'}";
		if (!$head) {
        		$head  = "Newsgroups: %n\n";
        		$head .= "Subject: %s\n";
        		$head .= "From: %N <%L@%H>\n";
        		$head .= "Organization: %o\n"           if ($orgname);
        		$head .= "Followups-To: $followups\n"   if ($followups);
        		$head .= "Keywords: \n";
        		$head .= "References: %R\n";
        		$head .= "Reply-To: $REPLYTO\n"	        if ($REPLYTO);
        		$head .= "Cc: \n\n";
		}
		$attrib = "$ENV{'ATTRIB'}";
		if (!$attrib) {
        		$attrib = "In %i, %f said:\n";
		}
	} elsif ( $mail eq "Y" ) {
		$head = "$ENV{'MAILHEADER'}";
		if (!$head) {
        		$head .= "To: %f\n";
        		$head .= "Subject: %s\n";
        		$head .= "From: %N <%L@%H>\n";
        		$head .= "Organization: %o\n"     if ($orgname);
        		$head .= "Keywords: \n";
        		$head .= "References: %R\n";
        		$head .= "Reply-To: $REPLYTO\n"	  if ($REPLYTO);
        		$head .= "Cc: \n\n";
		}
		$attrib = "$ENV{'YOUSAID'}";
		if (!$yousaid) {
        		$attrib = "In %i, you said:\n";
		}
	}


	($messageID) = $HEAD =~ /\nMessage-ID: <([^>]*)>/;
	($refs) = $HEAD =~ /\nReferences: ([^\n]*)/;
	$refs =~ s/
//;
	$refs .= " <$messageID>";

        $head =~ s/%C/$group/		if ( $head =~ /%C/);
        $head =~ s/%n/$groups/		if ( $head =~ /%n/);
        $head =~ s/%s/$subject/		if ( $head =~ /%s/);
        $head =~ s/%R/$refs/		if ( $head =~ /%R/);
        $head =~ s/%o/$orgname/		if ( $head =~ /%o/);
        $head =~ s/%N/$NAME/		if ( $head =~ /%N/);
        $head =~ s/%L/$USER/		if ( $head =~ /%L/);
        $head =~ s/%H/$HOSTNAME/	if ( $head =~ /%H/);
        $head =~ s/%f/$author/		if ( $head =~ /%f/);
        $head =~ s/%i/<$messageID>/	if ( $head =~ /%i/);

	$head =~ s/</&lt;/g;
	$head =~ s/>/&gt;/g;

        $attrib =~ s/%C/$group/		if ( $attrib =~ /%C/);
        $attrib =~ s/%n/$groups/	if ( $attrib =~ /%n/);
        $attrib =~ s/%s/$subject/	if ( $attrib =~ /%s/);
        $attrib =~ s/%R/$refs/		if ( $attrib =~ /%R/);
        $attrib =~ s/%o/$orgname/	if ( $attrib =~ /%o/);
        $attrib =~ s/%N/$NAME/		if ( $attrib =~ /%N/);
        $attrib =~ s/%L/$USER/		if ( $attrib =~ /%L/);
        $attrib =~ s/%H/$HOSTNAME/	if ( $attrib =~ /%H/);
        $attrib =~ s/%f/$author/	if ( $attrib =~ /%f/);
        $attrib =~ s/%i/<$messageID>/	if ( $attrib =~ /%i/);

	$BODY = "$attrib\n$BODY"	if ( $include eq "Y" );

}


sub FancyFormatArticle {
	@ArtLines = split( /\n/, $DATA);

	$HEAD = "";
	$BODY = "";

	while (@ArtLines > 0) {
		$thisline = shift(@ArtLines) . "\n";
		if ( $thisline !~ /^[A-Z+]/) {
			last;
		}
		$HEAD .= $thisline ;
	}
	while (@ArtLines > 0) {
		$thisline = shift(@ArtLines);
		if ( $include eq "Y" ) {
			chop $thisline;
			$BODY .= "$quotechar$thisline\n";
		} elsif ( !$action ) {
			$thisline .= "\n";
			$thisline =~ s|^([>:\|]+)([^\n]*)|$1<I>$2</I>|;
			$thisline =~ s|<|&lt;|g;
			$thisline =~ s|>|&gt;|g;
			$thisline =~ s|&lt;(/*I)&gt;|<$1>|g;
			$BODY .= $thisline ;
		}
	}

	($subject) = $HEAD =~ /Subject: ([^\n]*)/;
	$subject =~ s/
//;

	($messageID) = $HEAD =~ /\nMessage-ID: ([^\n]*)/;
	$messageID =~ s/
//;
	$messageID =~ s/>//;
	$messageID =~ s/<//;

	if ($HEAD =~ /\nReply-To: ([^\n]*)/) {
		$author = $1;
	} elsif ($HEAD =~ /From: ([^\n]*)/) {
		$author = $1;
	} elsif ($HEAD =~ /Sender: ([^\n]*)/) {
		$author = $1;
	}
	$author =~ s/
//;
	if ($author =~ /([^<]*)<([^>]*)>/) {
		$from = "$2";
	} elsif ($author =~ /([^(]*)\(([^)]*)\)/ ) {
		$from = "$1";
	} elsif ($author =~ /([^@]*@.*)/ ) {
		$from = "$1";
	}


	($group) = $HEAD =~ /Newsgroups: ([^,\n]*)/;
	$group =~ s/
//;
	($groups) = $HEAD =~ /Newsgroups: ([^\n]*)/;
	$groups =~ s/
//;

	($refs) = $HEAD =~ /References: ([^\n]*)/;

	if ( $action ) {
		$subject =~ s/(Re: )//g;
		$subject = "Re: $subject";

		# Personal bias ... crossposts set to followup to ONE GROUP
		# ONLY.  Can be edited, but requires intentional crossposting.
		$followup = $group	if ($group ne $groups);

		&FillHeader;

		$NEWDATA = "<TITLE>";
		$NEWDATA .= "Posting to $group"		if ( $post eq "Y" );
		$NEWDATA .= "Mailing to $author"	if ( $mail eq "Y" );
		$NEWDATA .= "</TITLE><BODY>\n";

		$NEWDATA .= "<FORM METHOD=POST ACTION=";
		$NEWDATA .= "postto://$servername/$group>\n"  if ( $post eq "Y" );
		$NEWDATA .= "mailto:$from>\n"		    if ( $mail eq "Y" );

		$NEWDATA .= "<TEXTAREA NAME=HEAD ROWS=4 COLS=78>";
		$NEWDATA .= "$head</TEXTAREA>\n";

		$NEWDATA .= "<TEXTAREA NAME=BODY ROWS=15 COLS=78>";
		$NEWDATA .= "$BODY</TEXTAREA>\n";

		$NEWDATA .= "<HR>\n";
		$NEWDATA .= "<TEXTAREA NAME=SIG ROWS=4 COLS=78>";
		$NEWDATA .= "$signature</TEXTAREA>\n";
		$NEWDATA .= "<INPUT TYPE=checkbox NAME=SIGN CHECKED>";
		$NEWDATA .= " Append Signature ";

		$NEWDATA .= "<input TYPE=submit VALUE=";
		$NEWDATA .= "Post>"	if ( $post eq "Y" );
		$NEWDATA .= "Mail>"	if ( $mail eq "Y" );

		$NEWDATA .= "<input TYPE=reset VALUE=Reset><HR></form>";

	} else {
		$subject =~ s/>/&gt;/;
		$subject =~ s/</&lt;/;

		if ($HEAD =~ /Date: ([^\n]*)/) {
			$date = "<I>Date: $1</I><BR>\n";
			$date =~ s/
//;
		}

		if ($HEAD =~ /Organi[sz]ation: ([^\n]*)/) {
			$org = "<B>Organization:</B> $1<BR>\n";
			$org =~ s/
//;
		}

		if ($author =~ /([^<]*)<([^>]*)>/) {
			$author = "$1 <a href=mailto:$2>&lt;$2&gt;</a>";
		} elsif ($author =~ /([^(]*)\(([^)]*)\)/ ) {
			$author = "$2 <a href=mailto:$1>&lt;$1&gt;</a>";
		} elsif ($author =~ /([^@]*@.*)/ ) {
			$author = "<a href=mailto:$1>&lt;$1&gt;</a>";
        	}
		$author = "<B>Author:</B> $author<BR>\n";

		@GroupList = split ( /,|\n/ , $groups );
		$groups = "";
		while (@GroupList > 0) {
			$thisline = shift(@GroupList);
			$groups .= "<a href=news:/$thisline>[$thisline]</a>";
		}
		if ($HEAD =~ /References: ([^\n]*)/) {
			$refs = $1 ;
			$refs =~ s/<|>|
//g;
			@GroupList = split ( /,|\s|\n/ , $refs );
			$refs = "<B>References:</B> ";
			while (@GroupList > 0) {
				$thisline = shift(@GroupList);
				$refs .= "<a href=news:/$thisline>" 
						. "&lt;$thisline&gt;</a>";
			}
			$refs .= "<BR>\n";
		}

		$HEAD =~ s/</&lt;/g;
		$HEAD =~ s/>/&gt;/g;

		$BODY =~ s|&lt;URL:([a-z][^&]*)&gt;|<a href=$1>&lt;URL:$1&gt;</a>|g;
		$BODY =~ s|&lt;([^@\s]*@[^&\s]*)&gt;|<a href=mailto:$1>&lt;$1&gt</a>|g;
		$BODY =~ s|[^=:](http:[^\s\n]*)|<a href=$1>&lt;$1&gt;</a>|g;
		$BODY =~ s|[^=:](gopher:[^\s\n]*)|<a href=$1>&lt;$1&gt;</a>|g;
		$BODY =~ s|[^=:](ftp:[^\s\n]*)|<a href=$1>&lt;$1&gt;</a>|g;

		$BODY =~ s|\n--[\s-]*\n|\n<HR>\n|g;
		$BODY =~ s|article &lt;([^\s&]*)&gt;|<a href=news:/$1>&lt;$1&gt</a>|g;

		$NEWDATA .= "<title>$subject</title>\n" ;
		$NEWDATA .= "<H3>$groups</H3>\n$date";
		$NEWDATA .= "<H1>$subject</H1>\n" ;
		$NEWDATA .= "$author$org$refs";
		$NEWDATA .= "<COMMENT \n$HEAD\n>" ;
		$NEWDATA .= "<HR><pre>\n$BODY\n</pre>\n" ;

		$NEWDATA .= " [<a href=\"$curr_url/$prev_article\"><b> PREV </b></a>] " 
					if (defined $prev_article);
	
		$NEWDATA .= " [<a href=\"$curr_url/$next_article\"><b> NEXT </b></a>] "
					if (defined $next_article);
		$NEWDATA .= "<HR>\n";

		$NEWDATA .= " [<a href=\"news:/$messageID?post+include\">" 
				. "<b> POST+INCLUDE </b></a>] ";
		$NEWDATA .= " [<a href=\"news:/$messageID?post\">" 
				. "<b> POST </b></a>] ";
		$NEWDATA .= " [<a href=postto://$server/$group>" 
				. "<b> NEW THREAD </b></a>] ";
		$NEWDATA .= " [<a href=\"news:/$messageID?mail\">" 
				. "<b> MAIL </b></a>] ";
		$NEWDATA .= " [<a href=\"news:/$messageID?mail+include\">" 
				. "<b> MAIL+INCLUDE </b></a>] ";

		$NEWDATA .= "\n\n";

	}

}



sub FormatData {

	if ( defined $articleID) {
		$curr_url = "$protocol:$articleID";
		&FancyFormatArticle;

	} elsif (defined $group) {

		if (defined $article) {

			$curr_url = "$protocol:/$group";
			&FancyFormatArticle;

		} else {

			$curr_url = "$protocol:$filename";


			&FilterArticles()	if ($opt_r);

			&SortBySubject()	if ($opt_s);


			$NEWDATA .= "<title>NEWSGROUP $group</title>";

			$NEWDATA .= " [<a href=\"$protocol:/\">" .
				"<b> ALL GROUPS </b></a>]\n";

			$NEWDATA .= "<h1>$group</h1>\n";

			$NEWDATA .= "<i>sorted by subject</i>\n"  if ($opt_s);

			$NEWDATA .= "<BR> [<a href=postto://$server/$group>" 
				. "<b> START NEW THREAD </b></a>] <HR>\n";

			$NEWDATA .= "<ul>\n";

			
			@data_array = split (/\n/, $DATA);

			foreach $l (@data_array) {

#				($article_id, $article_subj) = 
#					split (' ', $l, 2);

# uncomment if using Overviews instead
 				($article_id, $article_subj, $author, $info) =
 					split ('\t', $l, 4);

				if ( $author =~ /\S+@\S+\s+\(([^)]+)/ ) {
					$author = $1;
				} elsif ( $author =~ /([^<]+)</ ) {
					$author = $1;
				}

				$article_subj =~ s/</&lt;/g ;
				$article_subj =~ s/>/&gt;/g ;

				$NEWDATA .= 

# uncomment the next line and comment out the line following
# if you want the article subjects to be the links
#
#					"<li> $article_id ".
					"<li> ". 

					"<a href=\"$curr_url/$article_id\">".

# uncomment the next line and comment out the line following
# if you want the article subjects to be the links
#
					"$article_subj</a>";
#					"$article_id</a> $article_subj";

# uncomment if using overviews to display author
#
 				$NEWDATA .= " [$author] ";

				$NEWDATA .= "\n";

			}

			$NEWDATA .= "</ul>\n";
			$NEWDATA .= "<HR> [<a href=postto://$server/$group>" 
				. "<b> START NEW THREAD </b></a>] <BR>\n";
		}

	} else {

		$curr_url = "$protocol:";
		
		# give the page a heading
		#
		$NEWDATA .= "<title>NEWS from $servername</title>\n";
		$NEWDATA .= "<h2>NEWS <b>from</b> <i>$servername</i></h2>\n";

		# start the listing of groups
		#
		$NEWDATA .= "<ul>\n";

		@data_array = split (/\n/, $DATA);

		foreach $l (sort @data_array) {

			($group_name, $group_n1, $group_n2, $group_flag) = 
				split (' ', $l, 4);


			$NEWDATA .= 
				"<li> ". 
				"<a href=\"$curr_url/$group_name\">".
				"$group_name</a>\n";

		}

		$NEWDATA .= "</ul>\n";
	}

	$DATA = $NEWDATA if (defined $NEWDATA);
}







#
# an article filter
#

sub
FilterArticles {

	local (@list, %article_array, $l, $id, $range, $low, 
		$high, $entry, $FILTER_DATA);

	@list = split (',', $history{$group});

	foreach $l (split (/\n/, $DATA)) {

		($id, $entry) = split (' ', $l, 2);
		$article_array{$id} = $entry;
	}

	while ($range = shift (@list)) {

		($low, $high) = split ('-', $range);
		$high = $low if ($high eq "");

		for ($id = $low; $id <= $high; $id++) {

			if ($article_array{$id} ne "") {

				$article_array{$id} = "";
			}
		}
	}
	foreach $id (sort keys (%article_array)) {

		$FILTER_DATA .= "$id $article_array{$id}\n"
			if ($article_array{$id} ne "");
	}
	$DATA = $FILTER_DATA;

	0;
}










#
# a simple article sorter
#

sub
SortBySubject {

	local(@skeys, @data);
	@data = split(/\n/, $DATA);
	foreach $l (@data) {

		chop ($l);

		($id, $subject) = split(' ', $l, 2);
		$RE = "";
		if ($subject =~ s/^(Re: )//) {
			$RE = $1;
		}

		push(@skeys, $subject);
	}

	sub byskeys { 
		if($skeys[$a] eq $skeys[$b]) { $a <=> $b; }
		else { $skeys[$a] cmp $skeys[$b]; }
	}

	@sortdata = @data[sort byskeys $[..$#data];


	$DATA = join("\n", @sortdata);
}













#
# OUTPUT routine
#
sub ReturnHTTPData {

	# format of output:
	#
	# HTTP/1.0 200 OK
	# Content-type: text/html
	# Content-length: 12345
	#
	# DATA
	#

	$content_length = length ($DATA);

	print STDOUT "HTTP/$version $return_code $return_string\n";
	print STDOUT "Content-type: $content_type\n";
	print STDOUT "Content-length: $content_length\n";
	print STDOUT "\n";

	print STDOUT "$DATA";

	print STDOUT "\n";

	0;
}





sub Usage {
	
	print STDERR "Usage:\t$prog [-n <nntp server>]\n\n";
	print STDERR "\tThis PERL filter accepts specialized\n";
	print STDERR "\tHTTP requests from Chimera on stdin\n";
	print STDERR "\tand converts them into NNTP requests\n";
	print STDERR "\tto the local server. The program then\n";
	print STDERR "\tformats the results into an HTTP response\n";
	print STDERR "\tsent to stdout, and exits.\n";

	exit 1;
}




# a little routine that translates a 
# machine name into its address
#

sub getaddress {

	local($host) = @_;
	local(@ary);
	@ary = gethostbyname($host);
	return(unpack("C4",$ary[4]));
}




sub HTTPError {

	local(@string) = @_;
	local($message); 

	$message .= "\n" .
		"<h1>ERROR</h1>\n" .
		"<b>news:</b> " .
		join ('', @string) . 
		"\n\n";

	$content_length = length($message);

	print STDOUT "HTTP/$version $return_code  $return_string\n";
	print STDOUT "Content-type: text/html\n";
	print STDOUT "Content-length: $content_length\n";

	print STDOUT "$message";

	exit 1;
}


#---------------------------------------------------------------------------
#
#
#---------------------------------------------------------------------------

#
# a .newsrc clone
#

sub
GetHistory {

	local($key, $entry);

	if (! dbmopen (%history, $history_file, undef)) {

		dbmopen (%history, $history_file, 0600);

		if (open (RC, "<$newsrc")) {

			print STDERR "creating history file from '$newsrc'.\n"; 

			while (<RC>) {

				chop;

				($key, $entry) = split(/[!:]\s*/, $_, 2);
				print STDERR "[$key] -> {$entry}\n";

				$history{$key} = $entry;
			}

		} else {

			warn
			"unreadable '$newsrc': $!.  starting from scratch...\n";
		}
	}
}