]> Sergey Matveev's repositories - public-inbox.git/blob - t/netd.t
lei_mirror: eliminate circular references
[public-inbox.git] / 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;