#!/usr/bin/perl

use warnings;
use strict;

use Date::Calc;
use Socket;

package Net::Server::NNTP;

use base qw(Net::Server::Fork);

=head1 NAME

Net::Server::NNTP - The great new Net::Server::NNTP!

=head1 VERSION

Version 0.01

=cut

our $VERSION = '0.01';

=head1 SYNOPSIS

Quick summary of what the module does.

This module implements NNTP.  It is intended to be compliant with RFCs
3977, 5536, and 5537.

By default, this module doesn't actually store any news articles.  It
is intended that it will be sub-classed by a module that will implement
all of the hook methods to store and retrieve articles.

The networking services are handled by Net::Server, which this
module sub-classes using the Net::Server::MultiType module.
Therefore, the network configuration can be set with the options
as listed in Net::Server.

Net::Server data is in $server->{server}, as documented in the documentation
for Net::Server.  This module puts all of its configuration data
in $server->{nntp}.

By default, the server will read F</etc/newsd.conf> at start-up for
configuration options.

The default Net::Server personality used is Fork, but that can be changed by
setting the server_type configuration parameter (q.v.  Net::Server::MultiType).

NNTP specific parameters are:

 first_timeout specificies the timeout in seconds to receive an initial
 command from the server.

 timeout specifies the timeout in seconds for subsequent commands

Perhaps a little code snippet.

    use Net::Server::NNTP;

    my $foo = Net::Server::NNTP->new();
    ...

=cut 

our $article_re = qr/\<[^\s\>]+\@[^\s\>]+\>/; # rfc 1036 2.1.5
our $crlf = "\015\012"; # avoid local interpretation of \n

=head1 NNTP FUNCTIONS

=head1 STATE FUNCTIONS

=head1 STORAGE FUNCTIONS

=head1 INTERNAL FUNCTIONS

=head1 Session Administration Commands

These methods implement commands from section 5 of RFC 3977 and
corresponding commands from other RFCs.

=head2 greeting

=head2 capabilities

Handled internally by a coderef.  Returns the contents of %capabilities.

=head2 mode

Handles 'mode reader' (RFC 3977 5.3)

=cut

sub mode {
	my ($s, $arg) = @_;
	
	return $s->response(501) unless @_ > 1;

	if ($s->syntax($arg, '(?i)reader')) { # RFC 4644-2.3
		return $s->response(200,undef,$s->pathhost);
	}

	if ($s->syntax($arg, '(?i)stream')) { # RFC 4644-2.3
		return $s->response(203);
	}

	$s->response(501);
	return;
}

=head2 quit

=cut

sub quit {
	my ($s) = @_;
	return $s->response(501, 'too many arguments') if @_ > 1;
	$s->response(205);
	die 'client quit';
}

=head2 server_quit

	$s->server_quit($code, response);

=cut

sub server_quit {
	my ($s, $code, @args) = @_;
	$s->response($code, @args);
	die 'server quitting';
}

=head1 Article Posting and Retrieval

=head2 group

	$s->group('news.software.nntp');

Implements RFC 3977 6.1.1

=cut

sub group {
	my ($s, $g) = @_;
	my @row;

	return $s->response(501) unless @_ == 2;

	if (my ($estimate, $low, $high, $group) = @row = $s->groupinfo($g)) {
		$s->pointer(@row[3,1]);
		$s->article_number(undef) unless $estimate;
		$s->response(211,undef,@row);
	} else {
		$s->response(411);
	}
}

=head2 parse_grouprange

takes a range spec and gets a low and high, as against a given group

returns an empty list if the range spec doesn't parse.  The highwater
returned will be undef if the given group is invalid.

=cut

sub parse_grouprange {
	my ($s, $range, $group, $lowwater, $highwater) = @_;
	
	(undef, $lowwater, $highwater) = $s->groupinfo($group);

	return ($group, $lowwater, $highwater) if @_ == 1;

	my ($low, $r, $high) = $range =~ /(\d+)(-)?(\d+)?/;
	if (defined $high) {
		return ($group, $low, $high);
	} elsif (defined $r) {
		return ($group, $low, $highwater);
	} elsif (defined $low) {
		return ($group, $low, $low);
	}
	return ();
}

=head2 listgroup

=cut

sub listgroup {
	my ($s,$arg) = @_;

	my ($g, $range, @extraargs) = split(/\s+/, $arg);
	return $s->response(501) if @extraargs;
	
	$range = '1-' unless defined $range;
	$g = $s->selected_group unless defined $g;
	return $s->response(412) unless defined $g;

	my @grouprange = $s->parse_grouprange($range, $g);
	return $s->response(501) unless @grouprange;

	my @gi = $s->changegroup($g) if @grouprange;
	return $s->response(411) unless @gi;

	my @articles = $s->fetch_grouplist(@grouprange);

	$s->response(211, undef, @gi);
	$s->sendresults(@articles,'.');
}

=head2 last

=cut

sub last {
	my ($s) = @_;

	return $s->response(501) if @_ > 1;

	return $s->response(412) unless $s->selected_group;
	return $s->response(420) unless $s->article_number;

	my ($n,$id) = $s->prev_article();

	if ($n) {
		$s->article_number($n);
		$s->response(223, undef, $n, $id);
	} else {
		$s->response(422);
	}
}

=head2 next

Implements NNTP next (RFC 3977 6.1.4).  Moves the article pointer to the next
valid article.

=over 4

If the currently selected newsgroup is valid, the current article number MUST
be set to the next article in that newsgroup (that is, the lowest existing
article number greater than the current article number).  If successful, a
response indicating the new current article number and the message-id of that
article MUST be returned.  No article text is sent in response to this command.

If the current article number is already the last article of the newsgroup, a
421 response MUST be returned.  In all other aspects (apart, of course, from
the lack of 422 response), this command is identical to the LAST command
(Section 6.1.3).

=back

=cut

sub next {
	my ($s) = @_;

	return $s->response(501,'too many arguments') if @_ > 1;

	return $s->response(412) unless $s->selected_group;
	return $s->response(420) unless $s->article_number;

	my ($n,$id) = $s->next_article();

	if ($n) {
		$s->article_number($n);
		$s->response(223, undef, $n, $id);
	} else {
		$s->response(421);
	}
}

# rfc 3977 6.2.1

=head2 article

=cut

sub article {
	my ($s, @args) = @_;
	my ($a, $g, $n, $id);
	
	if (($id) = $s->syntax("@args", "($article_re)")) {
		($a) = $s->fetch_article($id);
		return $s->response(430) unless defined $a;
		$n = 0;
	} elsif (($n) = $s->syntax("@args", "(\\d+)")) {
		$g = $s->selected_group;
		return $s->response(412) unless defined $g;
		$s->log(4, "fetching $g ($n)");
		($a, $id) = $s->fetch_article($g,$n);
		return $s->response(423) unless defined $a;
		$s->article_number($n);
	} elsif (!@args) {
		($g, $n) = $s->pointer;
		return $s->response(412) unless defined $g;
		return $s->response(420) unless defined $n;
		$s->log(4, "fetching ($g $n)");
		($a,$id) = $s->fetch_article($g,$n);
		return $s->response(420) unless defined $a;
	} else {
		return $s->response(501);
	}

	$s->response(220,undef,$n,$id);
	$s->print($a);
}

# rfc 3977 6.2.2
=head2 head

=cut

sub head {
	my ($s, @args) = @_;
	my ($a, $g, $n, $id);
	
	if (($id) = ("@args" =~ "($article_re)")) {
		($a) = $s->fetch_head($id);
		return $s->response(430) unless defined $a;
		$n = 0;
	} elsif (($n) = $s->matches("@args", "(\\d+)")) {
		$g = $s->selected_group;
		return $s->response(412) unless defined $g;
		$s->log(4, "fetching $g ($n)");
		($a, $id) = $s->fetch_head($g,$n);
		return $s->response(423) unless defined $a;
		$s->article_number($n);
	} elsif (!@args) {
		($g, $n) = $s->pointer;
		$s->log(4, "fetching ($g $n)");
		return $s->response(412) unless defined $g;
		return $s->response(420) unless defined $n;
		($a, $id) = $s->fetch_head($g,$n);
		return $s->response(420) unless defined $a;
	} else {
		return $s->response(501);
	}

	$s->response(221,undef,$n,$id);
	$s->print($a);
}

# rfc 3977 6.2.3
=head2 body

=cut

sub body {
	my ($s, @args) = @_;
	my ($a, $g, $n, $id);
	
	if (($id) = $s->syntax("@args", "($article_re)")) {
		($a) = $s->fetch_body($id);
		return $s->response(430) unless defined $a;
		$n = 0;
	} elsif (($n) = $s->syntax("@args", "(\\d+)")) {
		$g = $s->selected_group;
		return $s->response(412) unless defined $g;
		$s->log(4, "fetching $g ($n)");
		($a, $id) = $s->fetch_body($g,$n);
		return $s->response(423) unless defined $a;
		$s->article_number($n);
	} elsif (!@args) {
		($g, $n) = $s->pointer;
		$s->log(4, "fetching ($g $n)");
		return $s->response(412) unless defined $g;
		return $s->response(420) unless defined $n;
		($a,$id) = $s->fetch_body($g,$n);
		return $s->response(420) unless defined $a;
	} else {
		return $s->response(501);
	}

	$s->response(222,undef,$n,$id);
	$s->print($a);
}

# rfc 3977 6.2.4
=head2 stat

=cut

sub stat {
	my ($s, @args) = @_;
	my ($a, $g, $n, $id);
	
	if (($id) = $s->syntax("@args", "($article_re)")) {
		$id = $s->fetch_stat($id);
		return $s->response(430) unless defined $id;
		$n = 0;
	} elsif (($n) = $s->syntax("@args", "(\\d+)")) {
		$g = $s->selected_group;
		return $s->response(412) unless defined $g;
		$s->log(4, "fetching $g ($n)");
		$id = $s->fetch_stat($g,$n);
		return $s->response(423) unless defined $id;
		$s->article_number($n);
	} elsif (!@args) {
		($g, $n) = $s->pointer;
		return $s->response(412) unless defined $g;
		return $s->response(420) unless defined $n;
		$s->log(4, "fetching ($g $n)");
		$id = $s->fetch_stat($g,$n);
		return $s->response(420) unless defined $id;
	} else {
		return $s->response(501);
	}

	$s->response(223,undef,$n,$id);
}

# rfc 3977 6.3.1
# rfc 5537 3.5

=head2 post

=cut

sub post {
	my ($s) = @_;
	my $posted = 0;

	# 5537-3.5-1 
	return $s->response(440) unless $s->permit_posting;

	my $rid = sprintf('<%s@%s>', Data::UUID->new()->create_str(),$s->pathhost);

	$s->response(340, 'Ok, recommended ID %s', $rid);

	my $a = $s->receive();
	return $s->response(441) unless $a;

	# 5537-3.5-2
	if (!defined($a->header('From'))
		or !defined($a->header('Newsgroups'))
		or !defined($a->header('Subject'))
		or defined($a->header('Injection-Info'))
		or defined($a->header('Xref'))
		or $a->header('Path') =~ /POSTED/
		or !$s->valid_syntax($a)
	) {
		# must reject 5537-3.5-2
		return $s->response(441);
	}

	# TODO 5537-3.5-2 SHOULD reject any proto-article that contains a
	# header field deprecated for Netnews
	# TODO deprecated fields: 

	# TODO policy reject NNTP-Posting-Host

	# 5537-3.5-5
	$a->ensure_header('Date', $s->system_ts());
	$a->ensure_header('Message-ID', $rid);

	#$a->ensure_header('Lines',$a->bodylines);

	# 5537-3.5-8 5537-3.5-9
	# store method will prepend the pathhost
	$a->ensure_header('Path','not-for-mail');

	# TODO 5537-3.5-10
	$a->header('Injection-Info', sprintf(q{posting-host = "%s"},
			$s->{nntp}{peername}));

	# TODO 5537-3.5-11

	eval {
		$posted = $s->store($a);
	};
	if ($@) {
		return $s->response(441);
	}
	if ($posted) {
		return $s->response(240,
		       	'article received ok, Message-ID %s', $a->messageid);
	} else {
		return $s->response(441);
	}
}

=head2 ihave (RFC 3977 6.3.2)

=cut

sub ihave {
	my ($s, $id) = @_;
	my $ok = 0;

	return $s->response(501) unless $id =~ /($article_re)/;
	return $s->response(435) if $s->fetch_stat($id);
	return $s->response(436) unless $s->permit_posting;

	$s->response(335);

	my $a = $s->receive();

	return $s->response(436) unless $a;

	eval {
		$ok = $s->store($a);
	};
	if ($@) {
		return $s->response(436);
	}
	$s->response($ok ? 235 : 437);
}

=head2 pointer

=cut

sub pointer {
	my ($s, $g, $n) = (@_,undef,undef);

	if (@_ > 1) {
		$s->{nntp}{newsgroup} = $g;
		$s->{nntp}{number} = $n;
	}
	return wantarray ? ($s->{nntp}{newsgroup},$s->{nntp}{number}) : $s->{nntp}{newsgroup};
}

sub selected_group {
	my ($s, $g) = (@_, undef);
	if (@_ > 1) {
		$s->{nntp}{newsgroup} = $g;
	}
	return $s->{nntp}{newsgroup};
}

sub article_number {
	my ($s, $n) = (@_, undef);
	if (@_ > 1) {
		$s->{nntp}{number} = $n;
	}
	return $s->{nntp}{number};
}

our %capabilities = (
	READER	=> '',
	IHAVE	=> '',
	POST	=> '',
	NEWNEWS	=> '',
	HDR	=> '',
	'OVER MSGID'	=> '',
	'LIST ACTIVE NEWSGROUPS OVERVIEW.FMT ACTIVE.TIMES HEADERS'	=> '',
	STREAMING	=> '',
	IMPLEMENTATION	=> 'if.org newsd',
);

our %hdrs = (
	Lines	=> 'lines',
	Subject	=> 'subject',
	'Message-ID'	=> 'msgid',
	Date	=> 'date',
	From	=> 'from',
	References	=> 'references',
	Path	=> 'path',
	Newsgroups	=> 'newsgroups',
	':bytes'	=> 'bytes',
	':lines'	=> 'actuallines',
	'Xref'	=> 'local article numbers',
);
our @over = qw(Subject From Date Message-ID References :bytes :lines Xref);

our %cmd = ();

=head2 servertime

=cut

sub servertime {
	return sprintf('%04d%02d%02d%02d%02d%02d', Date::Calc::System_Clock());
}

our $keyword_re = '^[a-zA-Z][a-zA-Z0-9\.\-]{2}';

%cmd = (
	article	=> \&article, # reader 6.2.1
	authinfo	=> \&unsupported, # rfc 4643
	starttls	=> \&unsupported, # rfc 4642, IO::Socket::SSL->start
	body	=> \&body, # reader 6.2.3
	check	=> \&check, # rfc 4644 2.4
	takethis	=> \&takethis, # rfc 4644 2.5
	capabilities	=> sub { # mandatory 5.2
		my ($s, $arg) = @_;
		if (@_ > 1 && $arg !~ /^$keyword_re$/) {
			$s->response(501);
			return;
		}
		$s->response(101);
		$s->sendresults('VERSION 2', keys %capabilities,'.');
	},
	date	=> sub {  # reader 7.1
		my ($s) = @_;
		$s->response(111,undef, $s->servertime);
	},
	group	=> \&group, # reader 6.1.1
	hdr	=> \&hdr, # hdr 8.5
	xhdr	=> \&unimplemented,
	head	=> \&head, # mandatory 6.2.2
	help	=> sub { # mandatory 7.2
		my ($s) = @_;
		$s->response(100);
		$s->sendresults('The following commands are implemented',
			sort grep { $cmd{$_} != \&unimplemented
				&& $cmd{$_} != \&unsupported}
		       	keys %cmd,'.');
	}, 
	ihave	=> \&ihave, # ihave 6.3.2
	'last'	=> \&last, # reader 6.1.3
	list	=> \&list, # list 7.6.[13456], over 8.4
	listgroup	=> \&listgroup, # reader 6.1.2
	mode	=> \&mode, # mode-reader 5.3, 4644-2.3 mode stream
	newgroups	=> \&newgroups, # reader 7.3
	newnews	=> \&newnews, # newnews 7.4
	'next'	=> \&next, # reader 6.1.4
	over	=> \&over, # over 8.3
	xover	=> \&over, # we hope this is the same as over (it is, but the overview.fmt listing is different)
	post	=> \&post, # post 6.3.1
	quit	=> \&quit,
	'stat'	=> \&stat, # mandatory 6.2.4
	# slave is removed from the protocol
	# slave	=> sub {my ($s) = @_; $peer_is_slave = 1; $s->response(202)},
	'xadmin'	=> \&xadmin,
);

=head2 changegroup

=cut

sub changegroup {
	my ($s, $group) = @_;

	return () unless $group;

	my @row = $s->groupinfo($group);

	if (@row) {
		$s->pointer($group,$row[1]);
		return @row;
	}
	return ();
}

=head2 print

	$s->print(@args);

	delegated to IO::Socket->print()

=cut

sub print {
	my ($s, @args) = @_;
	$s->{server}{client}->print(@args);
}

=head2 sendresults

	$s->sendresults(@lines);

Sends each element of @lines followed by a crlf pair.
If an element of @lines is a reference, it is assumed to be
an arrayref and the elements thereof are joined with a space
and the resulting string is output.

=cut

sub sendresults {
	my ($s, @lines) = @_;
	$s->print(ref $_ ? join(' ', @$_) : $_, $crlf) for @lines;
}

# rfc 3977 7.4

=head2 newnews

=cut

sub newnews {
	my ($s, @args) = @_;

	my ($wildmat, $date, $time);

	return $s->response(501) unless ($wildmat, $date, $time) =
       	$s->syntax("@args", '(\S+)\s+(\\d{6}|\\d{8})\s+(\\d{6})(\s+GMT)?');

	my $ts = $s->parsetime($date,$time);
	return $s->response(501) unless defined $ts;

	my $regex = $s->wildmat_to_regex($wildmat);
	return $s->response(501) unless defined $regex;

	$s->log(2, "newnews wildmat = $regex");

	my @article_ids = $s->fetch_newnews($ts, $regex);

	$s->response(230);
	$s->sendresults(@article_ids,'.');
}

=head2 list

=cut

sub list {
	my ($s, $arg) = @_;
	my ($subcmd, @args);
	if (defined $arg) {
		($subcmd, @args) = split(/\s+/, $arg);
	}
	$subcmd = 'active' unless defined($subcmd); # 7.6.1.1
	$subcmd = lc($subcmd);
	my $q;
	my @results;

	if ($subcmd eq 'active') { # 7.6.3
		if (@args <= 1) {
			@results = $s->fetch_active(@args);
		} else {
			return $s->response(501);
		}
	}
	elsif ($subcmd eq 'active.times') { # 7.6.4
		if (@args <= 1) {
			@results = $s->fetch_activetimes(@args);
			return $s->response(503) unless ref $results[0];
		} else {
			return $s->response(501);
		}
	}
	# don't forget to update capabilities when this is implemented
	elsif ($subcmd eq 'distrib.pats') { # 7.6.5
		return $s->response(501) if @args;
		return $s->response(503);
		return;
	}
	elsif ($subcmd eq 'headers') { # 8.6
		# TODO ask the storage what it can do
		return $s->response(501) if @args;
		@results = keys %hdrs;
	}
	elsif ($subcmd eq 'newsgroups') { # 7.6.6
		if (@args <= 1) {
			@results = $s->fetch_activetimes(@args);
			return $s->response(503) unless ref $results[0];
		} else {
			return $s->response(501);
		}
	}
	elsif ($subcmd eq 'overview.fmt') { # 8.4
		return $s->response(501) if @args;
		# TODO use old xover format if it seems warranted
		@results = $s->fetch_overviewfmt();
		$s->response(215,'Order of fields in overview database.');
		$s->sendresults(@results,'.');
		return;
	} else {
		$s->response(501);
		return;
	}
	$s->response(215);
	$s->sendresults(@results,'.');
}

# command prep and check
# 'command' => {
# 	args	=> 'max args' or [min,max]
# 	check	=> [regexes to validate args against, if defined]
# 	fail	=> what to do if it fails
# 	func	=> command to pass args on to
# }
# sub command_check {
# 	my ($syntax, @args) = @_;
# }

# see rfc 3977 7.3.2 for description of format
=head2 parsetime

=cut

sub parsetime {
	my ($s,$date,$time) = @_;

	my $ts;
	if ($date =~ /^(\d\d)(\d\d)(\d\d)$/) {
		my $curyear = (localtime)[5]+1900;
		my $curcent = int ($curyear/100);
		my $yic = $curyear % 100;
		my $cent = $1 <= $yic ? $curcent : $curcent - 1;
		$ts = sprintf('%02d%02d-%02d-%02d', $cent,$1,$2,$3);
	} elsif ($date =~ /^(\d\d\d\d)(\d\d)(\d\d)$/) {
		$ts = sprintf('%04d-%02d-%02d', $1,$2,$3);
	} else {
		return undef;
	}
	if ($time =~ /^(\d\d)(\d\d)(\d\d)$/) {
		$ts = sprintf('%s %02d:%02d:%02d',$ts,$1,$2,$3);
	} else {
		return undef;
	}
	return $ts;
}


=head2 wildmat_to_re

=cut

sub wildmat_to_re {
        my ($wildmat) = @_;

        $wildmat =~ s/\./\\\./g;
        $wildmat =~ s/\?/\./g;
        $wildmat =~ s/\*/\.\*/g;
        return $wildmat;
}

=head2 wildmat_to_regex

=cut

sub wildmat_to_regex {
        my ($s, $wildmat) = @_;

        my @pats = split(/,/,$wildmat); # TODO look for escaped commas

        my $sql = '';
        # TODO special case '*' since it always matches

        while ($pats[0] =~ /^!/) { shift @pats } # init neg can't match

	my $negated;
        foreach (@pats) {
                $negated = s/^!//;
                my $like = wildmat_to_re($_);
		if (!$negated) {
			$sql .= '|' . $like;
		} else {
			$sql =~ s/^\|//;
			$sql = "(^(?!$like)($sql)\$)";
		}
        }
	$sql =~ s/^\|//;
	$sql = "^($sql)\$" unless $negated;
        return $sql;
}

=head2 checkargs

=cut

sub checkargs {
	my ($s, $args, @regex) = @_;
	my @args = @$args;

	for (0..$#regex) {
		my $re = $regex[$_];
		next unless defined $re;
		if ($args[$_] !~ /$re/) {
			$s->log(2, "Argument invalid: $args[$_] !~ /$re/");
			return 0;
		}
	}
	return 1;
}

=head2 syntax

Checks a string against a regex and returns the matches.
Logs if the syntax fails.

=cut

sub syntax {
	my ($s, $cmd, $re) = @_;
	my @match;
	
	if (@match = ($cmd =~ /^$re$/)) {
		return @match;
	}

	$s->log(3, "syntax fail: '$cmd' !~ /$re/");
	return ();
}

=head2 matches

Checks a string against a regex and returns the matches.

=cut

sub matches {
	my ($s, $cmd, $re) = @_;
	my @match;
	
	if (@match = ($cmd =~ /^$re$/)) {
		return @match;
	}

	return ();
}

=head2 newgroups

=cut

sub newgroups {
	my ($s, @args) = @_;
	my ($date, $time);

	return $s->response(501) unless ($date, $time) =
       	$s->syntax("@args", '(\\d{6}|\\d{8}) (\\d{6})( GMT)?');

	my $ts = $s->parsetime($date,$time);
	return $s->response(501) unless defined $ts;

	my @results = $s->fetch_newgroups($ts);

	$s->response(231);
	$s->sendresults(@results,'.');
}

# TODO access control?

=head2 permit_posting

=cut

sub permit_posting {
	return 1;
}


# rfc3977 8.3.2

=head2 over

Calls $s->fetch_overview

=cut

sub over {
	my ($s, $arg, @extra) = @_;
	my @headers;
	my ($id, $lo, $range, $hi);

	return $s->response(501) if @extra;

	if (!$arg) {
		# 3977-8.5.1 third form
		return $s->response(412) unless defined $s->selected_group;
		return $s->response(420) unless defined $s->article_number;
		@headers = $s->fetch_overview($s->pointer);
		return $s->response(420) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} elsif (($id) = $s->syntax($arg, "($article_re)")) {
		# 3977-8.5.1 first form
		@headers = $s->fetch_overview($id);
		return $s->response(430) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} elsif (($lo, $range, $hi) = $s->syntax($arg, '(\d+)(-)?(\d+)?')) {
		# 3977-8.5.1 second form
		return $s->response(423) if $hi < $lo;
		return $s->response(412) unless defined $s->selected_group;
		my @gi = $s->groupinfo();
		return $s->response(412) unless @gi;
		if (defined $hi) {
			@headers = $s->fetch_overview($gi[0], $lo, $hi);
		} elsif (defined $range) {
			@headers = $s->fetch_overview($gi[0], $lo, $gi[2]);
		} else {
			@headers = $s->fetch_overview($gi[0], $lo);
		}
		return $s->response(423) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} else {
		return $s->response(501);
	}

	$s->response(225);
	$s->sendresults(@headers, '.');
}

# rfc3977 8.6.2
# TODO allow any header?

=head2 hdr

Implements 3977-8.5.1

Calls $s->fetch_headers.

=cut

sub hdr {
	my ($s, $args) = @_;

	my ($field, $arg) = split(/\s+/, $args);
	my ($id, $hi, $lo, $range);
	my @headers;

	if (!$arg) {
		# 3977-8.5.1 third form
		return $s->response(412) unless defined $s->selected_group;
		return $s->response(420) unless defined $s->article_number;
		@headers = $s->fetch_headers($field, $s->pointer);
		return $s->response(420) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} elsif (($id) = $s->syntax($arg, "($article_re)")) {
		# 3977-8.5.1 first form
		@headers = $s->fetch_headers($field, $id);
		return $s->response(430) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} elsif (($lo, $range, $hi) = $s->syntax($arg, '(\d+)(-)?(\d+)?')) {
		# 3977-8.5.1 second form
		return $s->response(423) if $hi < $lo;
		return $s->response(412) unless defined $s->selected_group;
		my @gi = $s->groupinfo();
		return $s->response(412) unless @gi;
		if (defined $hi) {
			@headers = $s->fetch_headers($field, $gi[0], $lo, $hi);
		} elsif (defined $range) {
			@headers = $s->fetch_headers($field, $gi[0], $lo, $gi[2]);
		} else {
			@headers = $s->fetch_headers($field, $gi[0], $lo);
		}
		return $s->response(423) unless @headers;
		return $s->response(503) if $headers[0] == undef;
	} else {
		return $s->response(501);
	}

	foreach (@headers) {
		$_->[1] =~ s/\r?\n//g;
		$_->[1] =~ s/\t/ /g;
	}

	$s->response(225);
	$s->sendresults(@headers, '.');
}

our %response = (
	100	=> 'help text follows',
	101	=> 'Capability list follows',
	111	=> '%s server date and time',

	200	=> 'server %s ready, posting allowed',
	201	=> 'server %s ready, posting prohibited',
	202	=> 'slave status noted',
	203	=> 'Streaming permitted',
	205	=> 'closing connection',
	211	=> '%d %d %d %s group selected',
	215	=> 'list of newsgroups follows',
	220	=> '%d %s article follows',
	221	=> '%d %s article headers follows',
	222	=> '%d %s article body follows',
	223	=> '%d %s article exists and selected',
	224	=> 'overview information follows',
	225	=> 'headers follow',
	230	=> 'list of new articles follows',
	231	=> 'list of new newsgroups follows',
	235	=> 'article transferred ok',
	238	=> '%s Send article to be transferred',
	239	=> '%s Article transferred OK',
	240	=> 'article received ok',

	335	=> 'send article to be transferred.  End with <CR-LF>.<CR-LF>',
	340	=> 'send article to be posted. End with <CR-LF>.<CR-LF>',

	400	=> 'service not available or no longer available',
	401	=> '%s server is in wrong mode; use indicated capability',
	403	=> 'internal fault preventing action being taken',
	411	=> 'no such newsgroup',
	412	=> 'no newsgroup selected',
	420	=> 'no current article has been selected',
	421	=> 'no next article in this group',
	422	=> 'no previous article in this group',
	423	=> 'no such article number in this group',
	430	=> 'no such article found',
	431	=> '%s Transfer not possible; try again later',
	435	=> 'article not wanted - do not send it',
	436	=> 'transfer failed - try again later',
	437	=> 'article rejected - do not try again',
	438	=> '%s Article not wanted',
	439	=> '%s Transfer rejected; do not retry',
	440	=> 'posting not allowed',
	441	=> 'posting failed',

	500	=> 'command not recognized',
	501	=> 'command syntax error',
	502	=> 'access restriction or permission denied',
	503	=> 'program fault - command not performed',
);

=head2 connect_to_storage

=cut

sub connect_to_storage {
	my ($s) = @_;
	
	return $s->{db} if defined $s->{db};

	# TODO use a config parameter optionally here
	my $dsn = $ENV{'DBI_DSN'};
	$dsn = qq{dbi:Pg:dbname=news} unless defined $dsn;
	$s->log(4, "connecting to $dsn");

	eval {
		$s->{db} = DBI->connect($dsn,'','',{AutoCommit => 0,RaiseError=>1});
		$s->log(4, "Can't connect to DB: $DBI::errstr") unless $s->{db};
	};
	if ($@) {
		$s->log(4, "Can't connect to DB: $DBI::errstr");
		die $@;
	}
	$s->log(4, "connected to $dsn");

	# TODO abort if can't connect
	$s->{db}->{PrintError} = 0;

	$s->{db}->do("set CLIENT_ENCODING to 'SQL_ASCII'");

	return;
}

=head2 Storage Access Functions

=cut

=head3 next($group)

Return the next article number in a group, undef if none.
Should return the number in a scalar context, number, articleid in
a list context.

=cut

=head2 log_stats

=cut

sub log_stats {
	my ($s) = @_;

	my ($rec, $ref, $rej, $postp) = 
	(
		$s->{nntp}{response}{239}
	       	+ $s->{nntp}{response}{235}
	       	+ $s->{nntp}{response}{240}, # received

		$s->{nntp}{response}{435},  # refused

		$s->{nntp}{response}{439}
	       	+ $s->{nntp}{response}{437}, # rejected

		$s->{nntp}{response}{436},  # postponed
	);

	$s->log(2, sprintf('%s received %d, refused %d, rejected %d, postponed %d', $s->client, $rec, $ref, $rej, $postp));

	$s->{nntp}{response}{$_} = 0 for keys %response;
}

=head2 clientfh

=cut

sub clientfh {
	my ($s) = @_;
	return $s->{server}{client};
}

=head2 client

=cut

sub client {
	my ($s) = @_;
	$s->{server}->{peeraddr} . ':' .$s->{server}->{peerport};
}

=head2 process_request

=cut

sub pre_fork_hook {
	my ($s) = @_;

	# we don't have the peeraddr set yet.
	#$s->log(2, 'forking for connection from %s', $s->{server}{client});

	return 1;
}

sub post_accept_hook {
	my ($s) = @_;

	# net server seems to log connections
	#$s->log(2, 'accepted connection from %s', $s->{server}{peeraddr});

	return 1;
}

sub request_denied_hook {
	my ($s) = @_;

	$s->log(2, 'denied connection from %s', $s->{server}{peeraddr});
}

sub process_request {
	my ($s) = @_;
	#$s->log(2,'%s: connected, log_level %d, server_type (%s)',$s->client, $s->{server}{log_level}, join(', ', @{$s->{server}{server_type}}));

	$s->connect_to_storage();

	$s->{nntp}{connecttime} = time;
	$s->{nntp}{response}{$_} = 0 for keys %response;

	my $peername = undef;
	# five seconds max to do reverse lookup, otherwise skip it
	# TODO i think Net::Server will do the reverse
	eval {
		local $SIG{ALRM} = sub { die "Timed Out!\n" };
		alarm(5);
		($peername) = gethostbyaddr(Socket::inet_aton($s->{server}->{peeraddr}), Socket::AF_INET());
	};
	if ($@) {
		$s->log(1, "Can't get peername for ".$s->{server}->{peeraddr} . ": $@");
		$peername = $s->{server}->{peeraddr};
	}
	$s->{nntp}{peername} = $peername;

	# parent will kill us with a term
	$SIG{TERM} = sub { $s->log_stats();exit 0 };

	eval {
		local $SIG{ALRM} = sub { die "Timed Out!\n" };
		alarm($s->{nntp}{first_timeout});
		$s->response($s->permit_posting()?200:201,undef,$s->pathhost);
		# TODO use a variable so subclassers can use not STDIN
		while (<>) {
			alarm(0);
			s/\r?\n$//;
			$s->log(3, '%s -> %s', $s->client, $_);
			my ($cmd, @args) = split(/\s+/, $_, 2);
			# TODO enforce maximum length?
			$cmd = lc($cmd);
			if (exists($cmd{$cmd})) {
				$s->{command} = $cmd;
				$cmd{$cmd}->($s, @args);
			} else {
				$s->log(4, "command not recognized '%s'", $cmd);
				$s->response(500);
			}
			alarm($s->{nntp}{timeout});
		}
		alarm(0);
	};
	if ($@=~/timed out/i) {
		$s->log(2, '%s: Timed Out.', $s->client);
	} elsif ($@ =~ /client quit/) {
		$s->log(2, '%s: client quit', $s->client);
	} elsif (defined($@) && length($@)) {
		$s->log(0, "$@\n");
	}
	$s->log(2, '%s: disconnecting', $s->client);
	$s->log_stats();
}

=head2 default_values

=cut

sub default_values {
	### add a single value option
	my $hn = Sys::Hostname::hostname();
	my @v = split(/\./, $hn);
	shift @v if @v > 2;
	unshift @v, 'news';
	$hn = join('.', @v);

	return {
		port => 119,
		log_level => 2, # this is default I think
		user => 'news',
		group => 'news',
		server_type	=> [qw(Fork)],
		setsid => 1,
		background	=> 1,
		log_file	=> 'Sys::Syslog',
		pid_file	=> '/var/run/news/newsd.pid',
		syslog_facility	=> 'news',
		syslog_ident	=> 'newsd',
		syslog_logopt	=> 'pid',
		conf_file	=> -r '/etc/newsd.conf' ? '/etc/newsd.conf' : undef,
		first_timeout	=> 30, # seconds to receive first command
		timeout		=> 900, # subsequent commands 15 min
		pathhost	=> $hn,
	};
}

# server  text, pathhost
# groupsync 604800 == weekly, use undef for no sync, or no active file
# activefile 
# newsgroups 

# localgroups     text default 'local.*',
# groups          text default '*'

# insert into configuration values ('localgroups','local.*');

=head2 options

=cut

sub options {
	my ($s, $oh) = @_;

	$s->log(1, 'options called');
	$s->{'nntp'} ||= {};

	my $opt	= $s->{'nntp'};

	### setup options in the parent classes
	$s->SUPER::options($oh);
	


	$oh->{'pathhost'} ||= \ $opt->{'pathhost'};

	$opt->{'activesync'} ||= 604800;
	$oh->{'activesync'} ||= \ $opt->{'activesync'};

	$opt->{'activefile'} ||= 'ftp://ftp.isc.org/pub/usenet/CONFIG/active.gz';
	$oh->{'activefile'} ||= \ $opt->{'activefile'};

	$opt->{'newsgroups'} ||= 'ftp://ftp.isc.org/pub/usenet/CONFIG/newsgroups.gz';
	$oh->{'newsgroups'} ||= \ $opt->{'newsgroups'};

	$opt->{'first_timeout'} ||= 120;
	$oh->{'first_timeout'} ||= \$ opt->{'first_timeout'};

	$opt->{'timeout'} ||= 900;
	$oh->{'timeout'} ||= \ $opt->{'timeout'};

	#$template->{'my_option'} = \ $prop->{'my_option'};
	
	### add a multi value option
	#$prop->{'an_arrayref_item'} ||= [];
	#$template->{'an_arrayref_item'} = $prop->{'an_arrayref_item'};
}

=head2 log

	$s->log($fmt, @args);

Overrides the Net::Server log method and always treats the first
argument as a format string.  We have to do this because Net::Server
treats the arguments differently depending on whether syslog is used.
Uses Perl's sprintf to do the formatting.

=cut

sub log {
	my ($s, $lvl, $fmt, @args) = @_;
	my $msg;
	
	if (@args) {
		$msg = sprintf($fmt, @args);
	} else {
		$msg = $fmt;
	}

	$s->SUPER::log($lvl, $msg);
}

=head2 response

=cut

sub response {
	my ($s, $code, $msg, @args) = @_;

	if (!defined($msg) && exists($response{$code})) {
		$msg = $response{$code};
	} elsif (!defined($msg)) {
		$s->log(1,"no message for response code $code");
		$msg = '';
	}
	my $line = sprintf "$code $msg", @args;

	$s->log(3,'%s <- %s', $s->client, $line);
	$s->{nntp}{response}{$code}++;

	$s->print($line,$crlf);
	return $code;
}

=head2 unimplemented

=cut

sub unimplemented {
	my ($s, @args) = @_;
	
	$s->log(2,'%s unimplemented command: %s', $s->client, join(' ', $s->{command}, @args));
	$s->response(500);
}

=head2 unsupported

=cut

sub unsupported {
	my ($s, @args) = @_;
	
	$s->log(2,'%s unsupported command: %s', $s->client, join(' ', @args));
	$s->log(2,'%s caller = ', $s->client, caller);
	$s->response(503);
}

# rfc 4644

=head2 check

=cut

sub check {
	my ($s, $id) = @_;
	my ($have) = $s->fetch_stat($id);
	if ($have) {
		$s->response(438, undef, $id);
		$s->log(3, 'already have article %s, rejecting', $have);
	} elsif ($s->{nntp}{'throttled'}) { # TODO some way to enter this state
		# TODO maybe a SIGUSR1
		$s->response(431, undef, $id);
	} else {
		$s->response(238, undef, $id);
	}
}

# rfc 4644 2.5

=head2 takethis

=cut

sub takethis {
	my ($s, $id) = @_;
	my $ok = 0;

	my $a = $s->receive();

	return $s->response(501) unless $id =~ /($article_re)/;

	if (!$a) {
		return $s->server_quit(400,"error in receiving article $id, failed to read");
	} elsif ($id ne $a->messageid()) {
		my $rid = $a->messageid();
		$s->log(1, "message id mismatch.  headers follow\n" . $a->{head});
		return $s->server_quit(400,"error in receiving article '$id', id mis-match = '$rid'");
	}
	eval {
		$ok = $s->store($a);
	};
	if ($@) {
		# rfc 4644 2.5.2
		$s->rollback();
		return $s->server_quit(400,"error in storing article $id");
	}
	if ($ok) {
		$s->response(239,undef,$id);
	} else {
		return $s->response(439,undef,$id);
	}
}

=head2 system_ts

	my $now = $s->system_ts();

Generates an RFC 5536 3.1.1 and RFC 5322 3.3 compliant date string, uses
GMT/UTC.  See L<"Date::Calc"/"Today_and_Now">

=cut

sub system_ts {
	my ($y, $m, $d, $hr, $min, $sec) = Date::Calc::Today_and_Now(1);

	return sprintf('%02d %s %04d %02d:%02d:%02d +0000', $d,
	       	substr(Date::Calc::Month_to_Text($m),0,3),
		$y, $hr, $min, $sec);
}

# TODO actually check against RFC 5536

=head2 valid_syntax

=cut

sub valid_syntax {
	my ($s, $a) = @_;

	my @headerfields = $a->head;
	my %counts;

	foreach (@headerfields) {
		my @headerlines = split(/\r?\n/, $_);
		return 0 unless $headerlines[0] =~ /^(\S+):.*\S/;
		$counts{lc($_)}++;
		foreach my $hl (@headerlines) {
			return 0 unless $hl =~ /\S/;
		}
	}

	for (@counts{qw|approved archive control distribution expires
			followup-to injection-date injection-info
			lines newsgroups organization path summary
			supersedes user-agent xref|}) {
		return 0 if (defined && $_ > 1);
	}

	return 1;
}

=head2 pathhost

=cut

sub pathhost {
	my ($s,$set) = @_;

	if (@_ > 1) {
		$s->{nntp}{pathhost} = $set;
	}

	return $s->{nntp}{pathhost};
}

=head2 read_until_dot

=cut

sub read_until_dot {
	my ($s, $fh) = @_;
	my $text = '';

	# TODO figure out why we can't read from $s->{server}{client}
	# different buffering?
	while (my $line = <>) {
		$s->log(5, $line);
		last if $line =~ /^\.\r?\n/;
		$text .= $line;
	}
	return $text;
}

=head2 readarticle

=cut

sub readarticle {
	my ($s,$fh) = @_;
	my $a = Net::Server::NNTP::Article->new;

	my $c = $s->read_until_dot($fh);
	
	($a->{head}, $a->{body}) = split(/\r?\n\r?\n/, $c, 2);
	$a->{head} .= "\r\n";

	# TODO check article for validity
	return $a;
}

=head2 receive
	
	my $a = $s->receive();

Receives an article in "wire" format (i.e. ending with a . on a line,
and initial . doubled).  Adds a path header if there isn't one, and adds
pathhost to the path header.

=cut

sub receive {
	my ($s) = @_;
	$s->log(5, 'Starting article receive');
	my $a = $s->readarticle($s->{server}{client});
	$s->log(5, 'Read article');
	$s->log(1, 'unable to read article for receive()') unless $a;
	return undef unless $a;

	$s->log(5, "got article: head: " . $a->{head});
	$s->log(6, "got article: body: " . $a->{body});

	$a->ensure_header('Path','not-for-mail');
	$a->add_to_path($s->pathhost);

	return $a;
}

=head2 process_moderated

=cut

sub process_moderated {
	my ($s, $a, $g) = @_;
	
	$s->junk($a);
	return 0;
}

sub fetch_moderator {
	my ($s, $g) = @_;
	return undef;
}

sub validate_approved {
	my ($s, $a) = @_;

	return 1;
}

=head3 store

store should store an article in the article database

arguments are a hashref with a head and body

return false if the article should be rejected, return true if the
article was accepted, die if there is an error

=cut

=head2 store

=cut

# see RFC 5537-5.1
sub process_control {
	my ($s, $a) = @_;
	$s->log(1, q{%s: ignoring control message '%s' (%s)}, $s->client,
		$a->control, join(',',$a->newsgroups));
	return 1;
}

sub store {
	my ($s, $a) = @_;
	return 0 unless $a;

	my $id = $a->messageid;
	return 0 if $s->fetch_stat($id);
	
	my @groups = $s->check_active($a->newsgroups);
	$s->log(3, 'no newsgroups header or no valid groups: %s', $a->newsgroups) unless @groups;
	return 0 unless @groups;

	$s->log(3, 'Checking for control messages');
	if (defined(my $cmsg = $a->control())) {
		return $s->process_control($a);
	}

	$s->log(3, 'Checking for moderated groups');
	if (my $modgroup = $s->moderated_group(@groups)) {
		if (!defined($a->approved)) {
			return $s->process_moderated($a, $modgroup);
		} elsif (!$s->validate_approved($a)) {
			$s->junk($a);
			return 0;
		}
	}

	return $s->store_article($a);
}

package Net::Server::NNTP::Article;
use Sys::Hostname qw();
use Data::UUID;

=head2 new

=cut

sub new {
	my ($pkg) = shift; 
	return bless {
		head => undef,
		body => undef,
		lines	=> undef,
		size	=> undef,
		@_
	}, $pkg;
}

=head2 head

=cut

sub head {
	my ($a) = @_;
	return wantarray ? split($a->{head}, /\r?\n(?!\s)/) : $a->{head};
}

=head2 body

=cut

sub body {
	my ($a) = @_;
	return wantarray ? split($a->{body}, /\r?\n(?!\s)/) : $a->{body};
}

=head2 raw

=cut

sub raw {
	my ($a) = @_;
	return $a->{head} . "\r\n", $a->{body};
}

=head2 bodylines

=cut

sub bodylines {
	my ($a) = @_;
	return $a->{body} =~ tr/\n/\n/;
}

=head2 headlines

=cut

sub headlines {
	my ($a) = @_;
	return $a->{head} =~ tr/\n/\n/;
}

=head2 size

=cut

sub size {
	my ($a) = @_;
	return length($a->{head}) + length($a->{body}) + 2;
}

=head2 writehead

=cut

sub writehead {
	my ($a,$fh,@trailers) = @_;
	print $fh $a-{head};
	print $_ for @trailers;
}

=head2 writebody

=cut

sub writebody {
	my ($a,$fh,@trailers) = @_;
	print $fh $a-{body};
	print $_ for @trailers;
}

=head2 write

=cut

sub write {
	my ($a,$fh,@trailers) = @_;
	print $fh $a->{head}, "\r\n", $a->{body};
	print $_,"\r\n" for @trailers;
}

=head2 read_until_dot

=cut

sub read_until_dot {
	my ($a, $fh) = @_;
	my $text = '';

	while (my $line = <$fh>) {
		last if $line =~ /^\.\r?\n/;
		$text .= $line;
	}
	return $text;
}

=head2 read

=cut

sub read {
	my ($a,$fh) = @_;
	$a = $a->new unless ref $a;

	my $c = $a->read_until_dot($fh);
	
	($a->{head}, $a->{body}) = split(/\r?\n\r?\n/, $c, 2);
	$a->{head} .= "\r\n";

	return $a;
}

=head2 headers

=cut

sub headers {
	my ($a,@want);
	return map { $a->header($_) } @want;
}

# looks like headers are case insensitive.  see rfc 2822
=head2 header

=cut

sub header {
        my ($a, $want, $set) = @_;
        my $h = $a->{head};

        if (@_ > 2) {
                $set =~ s/\r?\n?$//;

                if ($a->{head} =~ /^((?i)\Q$want\E)\s*:/msx) {
                $a->{head}
                  =~ s/^((?i)\Q$want\E)\s*:\s?(.+?)$ \r?\n(?!\s)/$1: $set\r\n/msx;
                } else {
                        $a->{head} .= "$want: $set\r\n";
                }
                return $set;
        }

        $a->{head}
        =~ /^((?i)\Q$want\E)\s*:\s?(.+?)$ \r?\n(?!\s)/msx;

        return undef unless defined $2;

        $set = $2;
        $set =~ s/\r?\n?$//;

        return $set;
}

=head3 number(@groups) returns number from the Xref header

=cut

=head2 number

=cut

sub number {
	my ($a,@groups) = @_;

	my $xref = $a->header('Xref');
	return unless defined($xref);
	my %numbers = split /\S+|:/, $xref;
	return @numbers{@groups};
}

=head2 ensure_header

=cut

sub ensure_header {
	my ($a,$h,$c) = @_;

	$a->header($h,$c) unless defined($a->header($h));
	return $a->header($h);
}

# generate an RFC 5536 3.1.1 and RFC 5322 3.3 compliant date string
=head2 system_ts

=cut

sub system_ts {
	my ($y, $m, $d, $hr, $min, $sec) = Date::Calc::Today_and_Now(1);

	return sprintf('%02d %s %04d %02d:%02d:%02d +0000', $d,
	       	substr(Date::Calc::Month_to_Text($m),0,3),
		$y, $hr, $min, $sec);
		
}

=head2 generate_id

=cut

sub generate_id {
	my ($a, $host) = @_;
	$host ||= Sys::Hostname::hostname();
	return '<'.Data::UUID->new()->create_str().'@'.$host.'>';
}

# see 5536
our @required_headers = qw(From Date Newsgroups Subject Message-ID Path);
our @opt_headers = qw(Approved Archive Control Distribution Expires
Followup-To Injection-Date Injection-Info Organization References Summary
Supersedes User-Agent Xref);

=head2 messageid

=cut

sub messageid {
	my ($a,@args) = @_;
	$a->header('Message-ID',@args);
}

=head2 path

=cut

sub path {
	my ($a,@args) = @_;
	my $p = $a->header('Path',@args);
	return wantarray ? split(/\!/,$p) : $p;
}

# TODO could do a bit less work here if a scalar is wanted

=head2 newsgroups

=cut

sub newsgroups {
	my ($a,@set) = @_;

	if (@set) {
		$a->header('Newsgroups',join(',',@set));
	} else {
		@set = split(/\s*,\s*/,$a->header('Newsgroups'));
	}

	return wantarray ? @set : join(',',@set);
}

# TODO make sure we ignore the RFC's requirements on approved headers
# If you don't know why, then don't change this

=head2 approved

=cut

sub approved {
	my ($a,@app) = @_;
	$a->header('Approved',@app);
}

=head2 control

=cut

sub control {
	my ($a,@arg) = @_;
	$a->header('Control',@arg);
}

=head2 add_to_path

=cut

sub add_to_path {
	my ($a,$path) = @_;
	$path = Sys::Hostname::hostname() unless defined($path);

	$a->header('Path',"$path!". $a->header('Path'));
}

=head1 AUTHOR

Nathan Wagner, C<< <nw at hydaspes.if.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-server-nntp
at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net::Server::NNTP>.
I will be notified, and then you'll automatically be notified of
progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::Server::NNTP


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net::Server::NNTP>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net::Server::NNTP>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net::Server::NNTP>

=item * Search CPAN

L<http://search.cpan.org/dist/Net::Server::NNTP>

=back

=head1 SEE ALSO

	L<Net::Server>

	L<Net::Server::MultiType>

=head1 ACKNOWLEDGEMENTS

Urs Janssen, maintainer of the tin newsreader, helped with this module by
providing a series of prompt and detailed bug reports on the NNTP
implementation.

=head1 COPYRIGHT & LICENSE

Written entirely from scratch by Nathan Wagner and released into the
public domain.

=cut

1; # End of Net::Server::NNTP


__END__