pd.if.org Git - newsd/blob - t/01_connectivity.t

   1 #!/usr/bin/perl
   2
   3 use Test::More tests => 14;
   4
   5 BEGIN { use_ok('Net::Cmd') }
   6 BEGIN { use_ok('Net::NNTP') }
   7
   8 my $c = Net::NNTP->new(Host => '127.0.0.1', Port => 20203, Reader => 0);
   9
  10 ok(defined $c, 'connected to localhost');
  11
  12 BAIL_OUT(q{can't connect to test server'}) unless $c;
  13
  14 sub Net::NNTP::issue {
  15         my ($c, @cmd) = @_;
  16         $c->command(@cmd);
  17         $c->response();
  18         return $c->code();
  19 }
  20
  21 sub Net::NNTP::test {
  22         my ($c, $valid, @cmd) = @_;
  23         $c->response();
  24         ok(grep {$c->code == $_} @$valid, "valid response for @$cmd = @$valid");
  25         return $c->code;
  26 }
  27
  28 # 3977:5.1.1 initial greeting must be 200 201 400 502
  29 my @valid = (200, 201, 400, 502);
  30 my $greeting = $c->code;
  31
  32 ok(grep {$c->code == $_} @valid, 'correct initial response from server');
  33
  34 unless ($greeting == 200 or $greeting = 201) {
  35         goto done;
  36 }
  37
  38 $c->command('CAPABILITIES');
  39 $c->response();
  40 is($c->code, 101, 'correct response to capabilities');
  41 $c->read_until_dot() if ($c->code == 101);
  42
  43 $c->command('capabilities');
  44 $c->response();
  45 is($c->code, 101, 'lower case capabilities ok');
  46 my $capabilities = $c->read_until_dot() if ($c->code == 101);
  47
  48 my %cap = ();
  49 my $twice = 0;
  50 foreach my $line (@$capabilities) {
  51         my ($capability, @arg) = split(/\s+/, $line);
  52         if (exists($cap{$capability})) {
  53                 $twice = 1;
  54         }
  55         $cap{$cap} = \@arg;
  56 }
  57
  58 ok($twice == 0, 'Capability listed twice (3977:5.2.2)');
  59
  60 $capabilities->[0] =~ /(VERSION) (\d+)(\r?)(\n)/;
  61
  62 is($1, 'VERSION', 'VERSION capability first');
  63 is($2, 2, 'Version 2 server');
  64
  65 unless ($2==2) {
  66         diag('can only test version 2 servers');
  67         goto quit;
  68 }
  69
  70 SKIP: {
  71         skip 'Net::Cmd strips \r, skipping \r\n testing', 2;
  72         is($3, "\r", 'Server terminated line with \r');
  73         is($4, "\n", 'Server terminated line with \n');
  74 }
  75
  76 is($c->issue('aninvalidcommand'), 500, 'responds with 500 to unknown command');
  77
  78 SKIP: {
  79         skip 'No LIST capability, skipping list tests', 1 unless $cap{'LIST'};
  80         is($c->issue('list aninvalidlist'), 501, 'responds with 501 to unknown list');
  81 }
  82
  83 # RFC 4644
  84 if ($cap{'STREAMING'}) {
  85         # check mode stream
  86 }
  87
  88 quit:
  89
  90 $c->command('QUIT');
  91 $c->response;
  92 is($c->code, 205, 'correct response to quit');
  93
  94 done:
  95 done_testing();
  96 exit 0;
  97
  98 sub checkcmd {
  99         my ($cmd, $args, $valid) = @_;
 100 }