X-Git-Url: https://pd.if.org/git/?p=newsd;a=blobdiff_plain;f=t%2F01_connectivity.t;fp=t%2F01_connectivity.t;h=81c05b23b0644c70e31ab6eff47f71b204ff1316;hp=0000000000000000000000000000000000000000;hb=ebc3461ce2a71fe7fafff83726747ddea712bd31;hpb=d1578c89c1be4a044e63c3413bac3c14de66094b

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) = @_;
+}