]> Sergey Matveev's repositories - public-inbox.git/blob - xt/nntpd-validate.t
cmd_ipc4: retry sendmsg on ENOBUFS/ENOMEM/ETOOMANYREFS
[public-inbox.git] / xt / nntpd-validate.t
1 # Copyright (C) 2019-2021 all contributors <meta@public-inbox.org>
2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
3
4 # Integration test to validate compression.
5 use strict;
6 use warnings;
7 use Test::More;
8 use Symbol qw(gensym);
9 use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC);
10 use POSIX qw(_exit);
11 use PublicInbox::TestCommon;
12 my $inbox_dir = $ENV{GIANT_INBOX_DIR};
13 plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inbox_dir;
14 my $mid = $ENV{TEST_MID};
15
16 # Net::NNTP is part of the standard library, but distros may split it off...
17 require_mods(qw(DBD::SQLite Net::NNTP Compress::Raw::Zlib));
18 my $test_compress = Net::NNTP->can('compress');
19 if (!$test_compress) {
20         diag 'Your Net::NNTP does not yet support compression';
21         diag 'See: https://rt.cpan.org/Ticket/Display.html?id=129967';
22 }
23 my $test_tls = $ENV{TEST_SKIP_TLS} ? 0 : eval { require IO::Socket::SSL };
24 my $cert = 'certs/server-cert.pem';
25 my $key = 'certs/server-key.pem';
26 if ($test_tls && !-r $key || !-r $cert) {
27         plan skip_all => "certs/ missing for $0, run $^X ./certs/create-certs.perl";
28 }
29 my ($tmpdir, $ftd) = tmpdir();
30 $File::Temp::KEEP_ALL = !!$ENV{TEST_KEEP_TMP};
31 my (%OPT, $td, $host_port, $group);
32 my $batch = 1000;
33 if (($ENV{NNTP_TEST_URL} // '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) {
34         ($host_port, $group) = ($1, $2);
35         $host_port .= ":119" unless index($host_port, ':') > 0;
36 } else {
37         make_local_server();
38 }
39 my $test_article = $ENV{TEST_ARTICLE} // 0;
40 my $test_xover = $ENV{TEST_XOVER} // 1;
41
42 if ($test_tls) {
43         my $nntp = Net::NNTP->new($host_port, %OPT);
44         ok($nntp->starttls, 'STARTTLS works');
45         ok($nntp->compress, 'COMPRESS works') if $test_compress;
46         ok($nntp->quit, 'QUIT after starttls OK');
47 }
48 if ($test_compress) {
49         my $nntp = Net::NNTP->new($host_port, %OPT);
50         ok($nntp->compress, 'COMPRESS works');
51         ok($nntp->quit, 'QUIT after compress OK');
52 }
53
54 sub do_get_all {
55         my ($methods) = @_;
56         my $desc = join(',', @$methods);
57         my $t0 = clock_gettime(CLOCK_MONOTONIC);
58         my $dig = Digest::SHA->new(1);
59         my $digfh = gensym;
60         my $tmpfh;
61         if ($File::Temp::KEEP_ALL) {
62                 open $tmpfh, '>', "$tmpdir/$desc.raw" or die $!;
63         }
64         my $tmp = { dig => $dig, tmpfh => $tmpfh };
65         tie *$digfh, 'DigestPipe', $tmp;
66         my $nntp = Net::NNTP->new($host_port, %OPT);
67         $nntp->article("<$mid>", $digfh) if $mid;
68         foreach my $m (@$methods) {
69                 my $res = $nntp->$m;
70                 print STDERR "# $m got $res ($desc)\n" if !$res;
71         }
72         $nntp->article("<$mid>", $digfh) if $mid;
73         my ($num, $first, $last) = $nntp->group($group);
74         unless (defined $num && defined $first && defined $last) {
75                 warn "Invalid group\n";
76                 return undef;
77         }
78         my $i;
79         for ($i = $first; $i < $last; $i += $batch) {
80                 my $j = $i + $batch - 1;
81                 $j = $last if $j > $last;
82                 if ($test_xover) {
83                         my $xover = $nntp->xover("$i-$j");
84                         for my $n (sort { $a <=> $b } keys %$xover) {
85                                 my $line = join("\t", @{$xover->{$n}});
86                                 $line =~ tr/\r//d;
87                                 $dig->add("$n\t".$line);
88                         }
89                 }
90                 if ($test_article) {
91                         for my $n ($i..$j) {
92                                 $nntp->article($n, $digfh) and next;
93                                 next if $nntp->code == 423;
94                                 my $res = $nntp->code.' '.  $nntp->message;
95
96                                 $res =~ tr/\r\n//d;
97                                 print STDERR "# Article $n ($desc): $res\n";
98                         }
99                 }
100         }
101
102         # hacky bytes_read thing added to Net::NNTP for testing:
103         my $bytes_read = '';
104         if ($nntp->can('bytes_read')) {
105                 $bytes_read .= ' '.$nntp->bytes_read.'b';
106         }
107         my $q = $nntp->quit;
108         print STDERR "# quit failed: ".$nntp->code."\n" if !$q;
109         my $elapsed = sprintf('%0.3f', clock_gettime(CLOCK_MONOTONIC) - $t0);
110         my $res = $dig->hexdigest;
111         print STDERR "# $desc - $res (${elapsed}s)$bytes_read\n";
112         $res;
113 }
114 my @tests = ([]);
115 push @tests, [ 'compress' ] if $test_compress;
116 push @tests, [ 'starttls' ] if $test_tls;
117 push @tests, [ 'starttls', 'compress' ] if $test_tls && $test_compress;
118 my (@keys, %thr, %res);
119 for my $m (@tests) {
120         my $key = join(',', @$m);
121         push @keys, $key;
122         pipe(my ($r, $w)) or die;
123         my $pid = fork;
124         if ($pid == 0) {
125                 close $r or die;
126                 my $res = do_get_all($m);
127                 print $w $res or die;
128                 $w->flush;
129                 _exit(0);
130         }
131         close $w or die;
132         $thr{$key} = [ $pid, $r ];
133 }
134 for my $key (@keys) {
135         my ($pid, $r) = @{delete $thr{$key}};
136         local $/;
137         $res{$key} = <$r>;
138         defined $res{$key} or die "nothing for $key";
139         my $w = waitpid($pid, 0);
140         defined($w) or die;
141         $w == $pid or die "waitpid($pid) != $w)";
142         is($?, 0, "`$key' exited successfully")
143 }
144
145 my $plain = $res{''};
146 ok($plain, "plain got $plain");
147 is($res{$_}, $plain, "$_ matches '' result") for @keys;
148
149 done_testing();
150
151 sub make_local_server {
152         require PublicInbox::Inbox;
153         $group = 'inbox.test.perf.nntpd';
154         my $ibx = { inboxdir => $inbox_dir, newsgroup => $group };
155         $ibx = PublicInbox::Inbox->new($ibx);
156         my $pi_config = "$tmpdir/config";
157         {
158                 open my $fh, '>', $pi_config or die "open($pi_config): $!";
159                 print $fh <<"" or die "print $pi_config: $!";
160 [publicinbox "test"]
161         newsgroup = $group
162         inboxdir = $inbox_dir
163         address = test\@example.com
164
165                 close $fh or die "close($pi_config): $!";
166         }
167         my ($out, $err) = ("$tmpdir/out", "$tmpdir/err");
168         for ($out, $err) {
169                 open my $fh, '>', $_ or die "truncate: $!";
170         }
171         my $sock = tcp_server();
172         $host_port = tcp_host_port($sock);
173
174         # not using multiple workers, here, since we want to increase
175         # the chance of tripping concurrency bugs within PublicInbox/NNTP*.pm
176         my $cmd = [ '-nntpd', "--stdout=$out", "--stderr=$err", '-W0' ];
177         push @$cmd, "-lnntp://$host_port";
178         if ($test_tls) {
179                 push @$cmd, "--cert=$cert", "--key=$key";
180                 %OPT = (
181                         SSL_hostname => 'server.local',
182                         SSL_verifycn_name => 'server.local',
183                         SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(),
184                         SSL_ca_file => 'certs/test-ca.pem',
185                 );
186         }
187         print STDERR "# CMD ". join(' ', @$cmd). "\n";
188         my $env = { PI_CONFIG => $pi_config };
189         $td = start_script($cmd, $env, { 3 => $sock });
190 }
191
192 package DigestPipe;
193 use strict;
194 use warnings;
195
196 sub TIEHANDLE {
197         my ($class, $self) = @_;
198         bless $self, $class;
199 }
200
201 sub PRINT {
202         my $self = shift;
203         my $data = join('', @_);
204         # Net::NNTP emit different line-endings depending on TLS or not...:
205         $data =~ tr/\r//d;
206         $self->{dig}->add($data);
207         if (my $tmpfh = $self->{tmpfh}) {
208                 print $tmpfh $data;
209         }
210         1;
211 }
212 1;