t/netd.t

   1 #!perl -w
   2 # Copyright (C) all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use v5.12;
   5 use Socket qw(IPPROTO_TCP SOL_SOCKET);
   6 use PublicInbox::TestCommon;
   7 # IO::Poll and Net::NNTP are part of the standard library, but
   8 # distros may split them off...
   9 require_mods(qw(-imapd IO::Socket::SSL Mail::IMAPClient IO::Poll Net::NNTP));
  10 my $imap_client = 'Mail::IMAPClient';
  11 $imap_client->can('starttls') or
  12         plan skip_all => 'Mail::IMAPClient does not support TLS';
  13 Net::NNTP->can('starttls') or
  14         plan skip_all => 'Net::NNTP does not support TLS';
  15 my $cert = 'certs/server-cert.pem';
  16 my $key = 'certs/server-key.pem';
  17 unless (-r $key && -r $cert) {
  18         plan skip_all =>
  19                 "certs/ missing for $0, run $^X ./create-certs.perl in certs/";
  20 }
  21 use_ok 'PublicInbox::TLS';
  22 use_ok 'IO::Socket::SSL';
  23 require_git('2.6');
  24
  25 my ($tmpdir, $for_destroy) = tmpdir();
  26 my $err = "$tmpdir/stderr.log";
  27 my $out = "$tmpdir/stdout.log";
  28 my $pi_config;
  29 my $group = 'test-netd';
  30 my $addr = $group . '@example.com';
  31
  32 # ensure we have free, low-numbered contiguous FDs from 3.. FD inheritance
  33 my @pad_pipes;
  34 for (1..3) {
  35         pipe(my ($r, $w)) or xbail "pipe: $!";
  36         push @pad_pipes, $r, $w;
  37 };
  38 my %srv = map { $_ => tcp_server() } qw(imap nntp imaps nntps);
  39 my $ibx = create_inbox 'netd', version => 2,
  40                         -primary_address => $addr, indexlevel => 'basic', sub {
  41         my ($im, $ibx) = @_;
  42         $im->add(eml_load('t/data/0001.patch')) or BAIL_OUT '->add';
  43         $pi_config = "$ibx->{inboxdir}/pi_config";
  44         open my $fh, '>', $pi_config or BAIL_OUT "open: $!";
  45         print $fh <<EOF or BAIL_OUT "print: $!";
  46 [publicinbox "netd"]
  47         inboxdir = $ibx->{inboxdir}
  48         address = $addr
  49         indexlevel = basic
  50         newsgroup = $group
  51 EOF
  52         close $fh or BAIL_OUT "close: $!\n";
  53 };
  54 $pi_config //= "$ibx->{inboxdir}/pi_config";
  55 my @args = ("--cert=$cert", "--key=$key");
  56 my $rdr = {};
  57 my $fd = 3;
  58 while (my ($k, $v) = each %srv) {
  59         push @args, "-l$k://".tcp_host_port($v);
  60         $rdr->{$fd++} = $v;
  61 }
  62 my $cmd = [ '-netd', '-W0', @args, "--stdout=$out", "--stderr=$err" ];
  63 my $env = { PI_CONFIG => $pi_config };
  64 my $td = start_script($cmd, $env, $rdr);
  65 @pad_pipes = ();
  66 undef $rdr;
  67 my %o = (
  68         SSL_hostname => 'server.local',
  69         SSL_verifycn_name => 'server.local',
  70         SSL_verify_mode => SSL_VERIFY_PEER(),
  71         SSL_ca_file => 'certs/test-ca.pem',
  72 );
  73 {
  74         my $c = tcp_connect($srv{imap});
  75         my $msg = <$c>;
  76         like($msg, qr/IMAP4rev1/, 'connected to IMAP');
  77 }
  78 {
  79         my $c = tcp_connect($srv{nntp});
  80         my $msg = <$c>;
  81         like($msg, qr/^201 .*? ready - post via email/, 'connected to NNTP');
  82 }
  83
  84 # TODO: more tests
  85 done_testing;