cpan/libnet/t/nntp_ipv6.t

   1 #!perl
   2
   3 use 5.008001;
   4
   5 use strict;
   6 use warnings;
   7
   8 use Config;
   9 use File::Temp 'tempfile';
  10 use Net::NNTP;
  11 use Test::More;
  12
  13 my $debug = 0; # Net::NNTP->new( Debug => .. )
  14
  15 my $inet6class = Net::NNTP->can_inet6;
  16 plan skip_all => "no IPv6 support found in Net::NNTP" if ! $inet6class;
  17
  18 plan skip_all => "fork not supported on this platform"
  19   unless $Config::Config{d_fork} || $Config::Config{d_pseudofork} ||
  20     (($^O eq 'MSWin32' || $^O eq 'NetWare') and
  21      $Config::Config{useithreads} and
  22      $Config::Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
  23
  24 my $srv = $inet6class->new(
  25   LocalAddr => '::1',
  26   Listen => 10
  27 );
  28 plan skip_all => "cannot create listener on ::1: $!" if ! $srv;
  29 my $host = $srv->sockhost;
  30 my $port = $srv->sockport;
  31 note("server on $host port $port");
  32
  33 plan tests => 1;
  34
  35 defined( my $pid = fork()) or die "fork failed: $!";
  36 exit(nntp_server()) if ! $pid;
  37
  38 my $cl = Net::NNTP->new(Host => $host, Port => $port,, Debug => $debug);
  39 note("created Net::NNTP object");
  40 if (!$cl) {
  41   fail("IPv6 NNTP connect failed");
  42 } else {
  43   $cl->quit;
  44   pass("IPv6 success");
  45 }
  46 wait;
  47
  48 sub nntp_server {
  49   my $ssl = shift;
  50   my $cl = $srv->accept or die "accept failed: $!";
  51   print $cl "200 nntp.example.com\r\n";
  52   while (<$cl>) {
  53     my ($cmd,$arg) = m{^(\S+)(?: +(.*))?\r\n} or die $_;
  54     $cmd = uc($cmd);
  55     if ($cmd eq 'QUIT' ) {
  56       print $cl "205 bye\r\n";
  57       last;
  58     } elsif ( $cmd eq 'MODE' ) {
  59       print $cl "201 Posting denied\r\n";
  60     } else {
  61       diag("received unknown command: $cmd");
  62       print "500 unknown cmd\r\n";
  63     }
  64   }
  65   note("NNTP dialog done");
  66 }