From ebc3461ce2a71fe7fafff83726747ddea712bd31 Mon Sep 17 00:00:00 2001
From: Nathan Wagner <nw@hydaspes.if.org>
Date: Fri, 2 Dec 2011 01:43:47 -0500
Subject: [PATCH] Added test script.

---
 Makefile            |   5 +++
 newsd               |   6 +++
 schema.sql          |  17 ++++++--
 t/01_connectivity.t | 100 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 124 insertions(+), 4 deletions(-)
 create mode 100644 t/01_connectivity.t

diff --git a/Makefile b/Makefile
index 86cb338..5f4ae7e 100644
--- a/Makefile
+++ b/Makefile
@@ -42,7 +42,12 @@ testserver:
 	PERL5LIB=./Net-Server-NNTP/lib ./newsd conf_file=test.conf
 
 test:
+	-test -f newsd.pid && kill `cat newsd.pid`
+	rm -f news.log
+	PERL5LIB=./Net-Server-NNTP/lib ./newsd conf_file=test.conf
+	sleep 1
 	prove t/*.t
+	-test -f newsd.pid && kill `cat newsd.pid`
 
 schema:
 	(echo 'set role news;'; cat schema.sql) | $(PSQL) 
diff --git a/newsd b/newsd
index 2a93085..a84a5a3 100755
--- a/newsd
+++ b/newsd
@@ -5,4 +5,10 @@ use warnings;
 
 use Net::Server::NNTP::Postgres;
 
+use Carp;
+$SIG{ __DIE__ } = sub { Carp::confess( @_ ) };
+$SIG{ __WARN__ } = sub { Carp::cluck( @_ ) };
+
+$ENV{TZ} = 'UTC'; # for logging
+
 Net::Server::NNTP::Postgres->new()->run();
diff --git a/schema.sql b/schema.sql
index 826bc85..769f0e5 100644
--- a/schema.sql
+++ b/schema.sql
@@ -330,11 +330,19 @@ begin
 
 	begin
 		-- TODO improve this regular expression
-		NEW.expires = regexp_replace(header_value(header, 'Expires'),E'\\([^\\)]*\\)', ' ')::timestamptz;
+		NEW.expires = regexp_replace(header_value(NEW.header, 'Expires'),E'\\([^\\)]*\\)', ' ')::timestamptz;
 	exception
 		when OTHERS then NEW.expires = NULL;
 	end;
 
+	-- TODO if date is null?
+	begin
+		-- TODO improve this regular expression
+		NEW.date = regexp_replace(header_value(NEW.header, 'Date'),E'\\([^\\)]*\\)', ' ')::timestamptz;
+	exception
+		when OTHERS then NEW.date = NULL;
+	end;
+
 	if NEW.header is null then
 		raise exception 'null header b';
 	end if;
@@ -363,13 +371,14 @@ create or replace function xpost_trigger() returns trigger as $$
 declare
 	hiwater	integer;
 begin
-	select high + 1 from newsgroups where newsgroup = NEW.newsgroup
-	for update into hiwater;
+	update newsgroups set high = high + 1
+       	where newsgroup = NEW.newsgroup returning high into hiwater;
+
 	NEW.number := hiwater;
-	update newsgroups set high = high + 1 where newsgroup = NEW.newsgroup;
 	return NEW;
 end;
 $$ language 'plpgsql';
+
 create trigger highwater before insert on xpost
 	for each row execute procedure xpost_trigger();
 
diff --git a/t/01_connectivity.t b/t/01_connectivity.t
new file mode 100644
index 0000000..81c05b2
--- /dev/null
+++ b/t/01_connectivity.t
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use Test::More tests => 14; 
+
+BEGIN { use_ok('Net::Cmd') }
+BEGIN { use_ok('Net::NNTP') }
+
+my $c = Net::NNTP->new(Host => '127.0.0.1', Port => 20203, Reader => 0);
+
+ok(defined $c, 'connected to localhost');
+
+BAIL_OUT(q{can't connect to test server'}) unless $c;
+
+sub Net::NNTP::issue {
+	my ($c, @cmd) = @_;
+	$c->command(@cmd);
+	$c->response();
+	return $c->code();
+}
+
+sub Net::NNTP::test {
+	my ($c, $valid, @cmd) = @_;
+	$c->response();
+	ok(grep {$c->code == $_} @$valid, "valid response for @$cmd = @$valid");
+	return $c->code;
+}
+
+# 3977:5.1.1 initial greeting must be 200 201 400 502
+my @valid = (200, 201, 400, 502);
+my $greeting = $c->code;
+
+ok(grep {$c->code == $_} @valid, 'correct initial response from server');
+
+unless ($greeting == 200 or $greeting = 201) {
+	goto done;
+}
+
+$c->command('CAPABILITIES');
+$c->response();
+is($c->code, 101, 'correct response to capabilities');
+$c->read_until_dot() if ($c->code == 101);
+
+$c->command('capabilities');
+$c->response();
+is($c->code, 101, 'lower case capabilities ok');
+my $capabilities = $c->read_until_dot() if ($c->code == 101);
+
+my %cap = ();
+my $twice = 0;
+foreach my $line (@$capabilities) {
+	my ($capability, @arg) = split(/\s+/, $line);
+	if (exists($cap{$capability})) {
+		$twice = 1;
+	}
+	$cap{$cap} = \@arg;
+}
+
+ok($twice == 0, 'Capability listed twice (3977:5.2.2)');
+
+$capabilities->[0] =~ /(VERSION) (\d+)(\r?)(\n)/;
+
+is($1, 'VERSION', 'VERSION capability first');
+is($2, 2, 'Version 2 server');
+
+unless ($2==2) {
+	diag('can only test version 2 servers');
+	goto quit;
+}
+
+SKIP: {
+	skip 'Net::Cmd strips \r, skipping \r\n testing', 2;
+	is($3, "\r", 'Server terminated line with \r');
+	is($4, "\n", 'Server terminated line with \n');
+}
+
+is($c->issue('aninvalidcommand'), 500, 'responds with 500 to unknown command');
+
+SKIP: {
+	skip 'No LIST capability, skipping list tests', 1 unless $cap{'LIST'};
+	is($c->issue('list aninvalidlist'), 501, 'responds with 501 to unknown list');
+}
+
+# RFC 4644
+if ($cap{'STREAMING'}) {
+	# check mode stream
+}
+
+quit:
+
+$c->command('QUIT');
+$c->response;
+is($c->code, 205, 'correct response to quit');
+
+done:
+done_testing();
+exit 0;
+
+sub checkcmd {
+	my ($cmd, $args, $valid) = @_;
+}
-- 
2.40.0