diff options
Diffstat (limited to 'xt')
| -rw-r--r-- | xt/git-http-backend.t | 116 | ||||
| -rw-r--r-- | xt/nntpd-validate.t | 217 | ||||
| -rw-r--r-- | xt/perf-msgview.t | 52 | ||||
| -rw-r--r-- | xt/perf-nntpd.t | 111 | ||||
| -rw-r--r-- | xt/perf-threading.t | 32 |
5 files changed, 528 insertions, 0 deletions
diff --git a/xt/git-http-backend.t b/xt/git-http-backend.t new file mode 100644 index 00000000..a927d89e --- /dev/null +++ b/xt/git-http-backend.t @@ -0,0 +1,116 @@ +# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# +# Ensure buffering behavior in -httpd doesn't cause runaway memory use +# or data corruption +use strict; +use warnings; +use Test::More; +use POSIX qw(setsid); +require './t/common.perl'; + +my $git_dir = $ENV{GIANT_GIT_DIR}; +plan 'skip_all' => 'GIANT_GIT_DIR not defined' unless $git_dir; +foreach my $mod (qw(BSD::Resource + Plack::Util Plack::Builder + HTTP::Date HTTP::Status Net::HTTP)) { + eval "require $mod"; + plan skip_all => "$mod missing for git-http-backend.t" if $@; +} +my $psgi = "./t/git-http-backend.psgi"; +my ($tmpdir, $for_destroy) = tmpdir(); +my $err = "$tmpdir/stderr.log"; +my $out = "$tmpdir/stdout.log"; +my $sock = tcp_server(); +my $host = $sock->sockhost; +my $port = $sock->sockport; +my $td; + +my $get_maxrss = sub { + my $http = Net::HTTP->new(Host => "$host:$port"); + ok($http, 'Net::HTTP object created for maxrss'); + $http->write_request(GET => '/'); + my ($code, $mess, %h) = $http->read_response_headers; + is($code, 200, 'success reading maxrss'); + my $n = $http->read_entity_body(my $buf, 256); + ok(defined $n, 'read response body'); + like($buf, qr/\A\d+\n\z/, 'got memory response'); + ok(int($buf) > 0, 'got non-zero memory response'); + int($buf); +}; + +{ + ok($sock, 'sock created'); + my $cmd = [ '-httpd', '-W0', "--stdout=$out", "--stderr=$err", $psgi ]; + $td = start_script($cmd, undef, { 3 => $sock }); +} +my $mem_a = $get_maxrss->(); + +SKIP: { + my $max = 0; + my $pack; + my $glob = "$git_dir/objects/pack/pack-*.pack"; + foreach my $f (glob($glob)) { + my $n = -s $f; + if ($n > $max) { + $max = $n; + $pack = $f; + } + } + skip "no packs found in $git_dir" unless defined $pack; + if ($pack !~ m!(/objects/pack/pack-[a-f0-9]{40}.pack)\z!) { + skip "bad pack name: $pack"; + } + my $url = $1; + my $http = Net::HTTP->new(Host => "$host:$port"); + ok($http, 'Net::HTTP object created'); + $http->write_request(GET => $url); + my ($code, $mess, %h) = $http->read_response_headers; + is(200, $code, 'got 200 success for pack'); + is($max, $h{'Content-Length'}, 'got expected Content-Length for pack'); + + # no $http->read_entity_body, here, since we want to force buffering + foreach my $i (1..3) { + sleep 1; + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after $i seconds"; + ok($diff < 1024, 'no bloating caused by slow dumb client'); + } +} + +{ + my $c = fork; + if ($c == 0) { + setsid(); + exec qw(git clone -q --mirror), "http://$host:$port/", + "$tmpdir/mirror.git"; + die "Failed start git clone: $!\n"; + } + select(undef, undef, undef, 0.1); + foreach my $i (1..10) { + is(1, kill('STOP', -$c), 'signaled clone STOP'); + sleep 1; + ok(kill('CONT', -$c), 'continued clone'); + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after $i seconds"; + ok($diff < 2048, 'no bloating caused by slow smart client'); + } + ok(kill('CONT', -$c), 'continued clone'); + is($c, waitpid($c, 0), 'reaped wayward slow clone'); + is($?, 0, 'clone did not error out'); + note 'clone done, fsck-ing clone result...'; + is(0, system("git", "--git-dir=$tmpdir/mirror.git", + qw(fsck --no-progress)), + 'fsck did not report corruption'); + + my $diff = $get_maxrss->() - $mem_a; + note "${diff}K memory increase after smart clone"; + ok($diff < 2048, 'no bloating caused by slow smart client'); +} + +{ + ok($td->kill, 'killed httpd'); + $td->join; +} + +done_testing(); diff --git a/xt/nntpd-validate.t b/xt/nntpd-validate.t new file mode 100644 index 00000000..39108639 --- /dev/null +++ b/xt/nntpd-validate.t @@ -0,0 +1,217 @@ +# Copyright (C) 2019 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> + +# Integration test to validate compression. +use strict; +use warnings; +use Test::More; +use Symbol qw(gensym); +use Time::HiRes qw(clock_gettime CLOCK_MONOTONIC); +use POSIX qw(_exit); +my $inbox_dir = $ENV{GIANT_INBOX_DIR}; +plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inbox_dir; +my $mid = $ENV{TEST_MID}; + +# Net::NNTP is part of the standard library, but distros may split it off... +foreach my $mod (qw(DBD::SQLite Net::NNTP Compress::Raw::Zlib)) { + eval "require $mod"; + plan skip_all => "$mod missing for $0" if $@; +} + +my $test_compress = Net::NNTP->can('compress'); +if (!$test_compress) { + diag 'Your Net::NNTP does not yet support compression'; + diag 'See: https://rt.cpan.org/Ticket/Display.html?id=129967'; +} +my $test_tls = $ENV{TEST_SKIP_TLS} ? 0 : eval { require IO::Socket::SSL }; +my $cert = 'certs/server-cert.pem'; +my $key = 'certs/server-key.pem'; +if ($test_tls && !-r $key || !-r $cert) { + plan skip_all => "certs/ missing for $0, run $^X ./certs/create-certs.perl"; +} +require './t/common.perl'; +my ($tmpdir, $ftd) = tmpdir(); +$File::Temp::KEEP_ALL = !!$ENV{TEST_KEEP_TMP}; +my (%OPT, $td, $host_port, $group); +my $batch = 1000; +if (($ENV{NNTP_TEST_URL} // '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { + ($host_port, $group) = ($1, $2); + $host_port .= ":119" unless index($host_port, ':') > 0; +} else { + make_local_server(); +} +my $test_article = $ENV{TEST_ARTICLE} // 0; +my $test_xover = $ENV{TEST_XOVER} // 1; + +if ($test_tls) { + my $nntp = Net::NNTP->new($host_port, %OPT); + ok($nntp->starttls, 'STARTTLS works'); + ok($nntp->compress, 'COMPRESS works') if $test_compress; + ok($nntp->quit, 'QUIT after starttls OK'); +} +if ($test_compress) { + my $nntp = Net::NNTP->new($host_port, %OPT); + ok($nntp->compress, 'COMPRESS works'); + ok($nntp->quit, 'QUIT after compress OK'); +} + +sub do_get_all { + my ($methods) = @_; + my $desc = join(',', @$methods); + my $t0 = clock_gettime(CLOCK_MONOTONIC); + my $dig = Digest::SHA->new(1); + my $digfh = gensym; + my $tmpfh; + if ($File::Temp::KEEP_ALL) { + open $tmpfh, '>', "$tmpdir/$desc.raw" or die $!; + } + my $tmp = { dig => $dig, tmpfh => $tmpfh }; + tie *$digfh, 'DigestPipe', $tmp; + my $nntp = Net::NNTP->new($host_port, %OPT); + $nntp->article("<$mid>", $digfh) if $mid; + foreach my $m (@$methods) { + my $res = $nntp->$m; + print STDERR "# $m got $res ($desc)\n" if !$res; + } + $nntp->article("<$mid>", $digfh) if $mid; + my ($num, $first, $last) = $nntp->group($group); + unless (defined $num && defined $first && defined $last) { + warn "Invalid group\n"; + return undef; + } + my $i; + for ($i = $first; $i < $last; $i += $batch) { + my $j = $i + $batch - 1; + $j = $last if $j > $last; + if ($test_xover) { + my $xover = $nntp->xover("$i-$j"); + for my $n (sort { $a <=> $b } keys %$xover) { + my $line = join("\t", @{$xover->{$n}}); + $line =~ tr/\r//d; + $dig->add("$n\t".$line); + } + } + if ($test_article) { + for my $n ($i..$j) { + $nntp->article($n, $digfh) and next; + next if $nntp->code == 423; + my $res = $nntp->code.' '. $nntp->message; + + $res =~ tr/\r\n//d; + print STDERR "# Article $n ($desc): $res\n"; + } + } + } + + # hacky bytes_read thing added to Net::NNTP for testing: + my $bytes_read = ''; + if ($nntp->can('bytes_read')) { + $bytes_read .= ' '.$nntp->bytes_read.'b'; + } + my $q = $nntp->quit; + print STDERR "# quit failed: ".$nntp->code."\n" if !$q; + my $elapsed = sprintf('%0.3f', clock_gettime(CLOCK_MONOTONIC) - $t0); + my $res = $dig->hexdigest; + print STDERR "# $desc - $res (${elapsed}s)$bytes_read\n"; + $res; +} +my @tests = ([]); +push @tests, [ 'compress' ] if $test_compress; +push @tests, [ 'starttls' ] if $test_tls; +push @tests, [ 'starttls', 'compress' ] if $test_tls && $test_compress; +my (@keys, %thr, %res); +for my $m (@tests) { + my $key = join(',', @$m); + push @keys, $key; + pipe(my ($r, $w)) or die; + my $pid = fork; + if ($pid == 0) { + close $r or die; + my $res = do_get_all($m); + print $w $res or die; + $w->flush; + _exit(0); + } + close $w or die; + $thr{$key} = [ $pid, $r ]; +} +for my $key (@keys) { + my ($pid, $r) = @{delete $thr{$key}}; + local $/; + $res{$key} = <$r>; + defined $res{$key} or die "nothing for $key"; + my $w = waitpid($pid, 0); + defined($w) or die; + $w == $pid or die "waitpid($pid) != $w)"; + is($?, 0, "`$key' exited successfully") +} + +my $plain = $res{''}; +ok($plain, "plain got $plain"); +is($res{$_}, $plain, "$_ matches '' result") for @keys; + +done_testing(); + +sub make_local_server { + require PublicInbox::Inbox; + $group = 'inbox.test.perf.nntpd'; + my $ibx = { inboxdir => $inbox_dir, newsgroup => $group }; + $ibx = PublicInbox::Inbox->new($ibx); + my $pi_config = "$tmpdir/config"; + { + open my $fh, '>', $pi_config or die "open($pi_config): $!"; + print $fh <<"" or die "print $pi_config: $!"; +[publicinbox "test"] + newsgroup = $group + inboxdir = $inbox_dir + address = test\@example.com + + close $fh or die "close($pi_config): $!"; + } + my ($out, $err) = ("$tmpdir/out", "$tmpdir/err"); + for ($out, $err) { + open my $fh, '>', $_ or die "truncate: $!"; + } + my $sock = tcp_server(); + ok($sock, 'sock created'); + $host_port = $sock->sockhost . ':' . $sock->sockport; + + # not using multiple workers, here, since we want to increase + # the chance of tripping concurrency bugs within PublicInbox/NNTP*.pm + my $cmd = [ '-nntpd', "--stdout=$out", "--stderr=$err", '-W0' ]; + push @$cmd, "-lnntp://$host_port"; + if ($test_tls) { + push @$cmd, "--cert=$cert", "--key=$key"; + %OPT = ( + SSL_hostname => 'server.local', + SSL_verifycn_name => 'server.local', + SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_PEER(), + SSL_ca_file => 'certs/test-ca.pem', + ); + } + print STDERR "# CMD ". join(' ', @$cmd). "\n"; + my $env = { PI_CONFIG => $pi_config }; + $td = start_script($cmd, $env, { 3 => $sock }); +} + +package DigestPipe; +use strict; +use warnings; + +sub TIEHANDLE { + my ($class, $self) = @_; + bless $self, $class; +} + +sub PRINT { + my $self = shift; + my $data = join('', @_); + # Net::NNTP emit different line-endings depending on TLS or not...: + $data =~ tr/\r//d; + $self->{dig}->add($data); + if (my $tmpfh = $self->{tmpfh}) { + print $tmpfh $data; + } + 1; +} +1; diff --git a/xt/perf-msgview.t b/xt/perf-msgview.t new file mode 100644 index 00000000..22d8ce20 --- /dev/null +++ b/xt/perf-msgview.t @@ -0,0 +1,52 @@ +# Copyright (C) 2019 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Benchmark qw(:all); +use PublicInbox::Inbox; +use PublicInbox::View; +require './t/common.perl'; + +my $inboxdir = $ENV{GIANT_INBOX_DIR} // $ENV{GIANT_PI_DIR}; +plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; + +my @cat = qw(cat-file --buffer --batch-check --batch-all-objects); +if (require_git(2.19, 1)) { + push @cat, '--unordered'; +} else { + warn +"git <2.19, cat-file lacks --unordered, locality suffers\n"; +} + +use_ok 'Plack::Util'; +my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir, name => 'name' }); +my $git = $ibx->git; +my $fh = $git->popen(@cat); +my $vec = ''; +vec($vec, fileno($fh), 1) = 1; +select($vec, undef, undef, 60) or die "timed out waiting for --batch-check"; + +my $ctx = { + env => { HTTP_HOST => 'example.com', 'psgi.url_scheme' => 'https' }, + -inbox => $ibx, + www => Plack::Util::inline_object(style => sub {''}), +}; +my ($str, $mime, $res, $cmt, $type); +my $n = 0; +my $t = timeit(1, sub { + while (<$fh>) { + ($cmt, $type) = split / /; + next if $type ne 'blob'; + ++$n; + $str = $git->cat_file($cmt); + $mime = PublicInbox::MIME->new($str); + $res = PublicInbox::View::msg_html($ctx, $mime); + $res = $res->[2]; + while (defined($res->getline)) {} + $res->close; + } +}); +diag 'msg_html took '.timestr($t)." for $n messages"; +ok 1; +done_testing(); diff --git a/xt/perf-nntpd.t b/xt/perf-nntpd.t new file mode 100644 index 00000000..5a176e08 --- /dev/null +++ b/xt/perf-nntpd.t @@ -0,0 +1,111 @@ +# Copyright (C) 2018-2019 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +use strict; +use warnings; +use Test::More; +use Benchmark qw(:all :hireswallclock); +use PublicInbox::Inbox; +use Net::NNTP; +my $inboxdir = $ENV{GIANT_INBOX_DIR} // $ENV{GIANT_PI_DIR}; +plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless defined($inboxdir); +eval { require PublicInbox::Search }; +my ($host_port, $group, %opts, $s, $td, $tmp_obj); +require './t/common.perl'; + +if (($ENV{NNTP_TEST_URL} || '') =~ m!\Anntp://([^/]+)/([^/]+)\z!) { + ($host_port, $group) = ($1, $2); + $host_port .= ":119" unless index($host_port, ':') > 0; +} else { + $group = 'inbox.test.perf.nntpd'; + my $ibx = { inboxdir => $inboxdir, newsgroup => $group }; + $ibx = PublicInbox::Inbox->new($ibx); + my $tmpdir; + ($tmpdir, $tmp_obj) = tmpdir(); + + my $pi_config = "$tmpdir/config"; + { + open my $fh, '>', $pi_config or die "open($pi_config): $!"; + print $fh <<"" or die "print $pi_config: $!"; +[publicinbox "test"] + newsgroup = $group + inboxdir = $inboxdir + address = test\@example.com + + close $fh or die "close($pi_config): $!"; + } + + my $sock = tcp_server(); + ok($sock, 'sock created'); + my $cmd = [ '-nntpd', '-W0' ]; + $td = start_script($cmd, { PI_CONFIG => $pi_config }, { 3 => $sock }); + $host_port = $sock->sockhost . ':' . $sock->sockport; +} +%opts = ( + PeerAddr => $host_port, + Proto => 'tcp', + Timeout => 1, +); +$s = IO::Socket::INET->new(%opts); +$s->autoflush(1); +my $buf = $s->getline; +like($buf, qr/\A201 .* ready - post via email\r\n/s, 'got greeting'); + +my $t = timeit(10, sub { + ok($s->print("GROUP $group\r\n"), 'changed group'); + $buf = $s->getline; +}); +diag 'GROUP took: ' . timestr($t); + +my ($tot, $min, $max) = ($buf =~ /\A211 (\d+) (\d+) (\d+) /); +ok($tot && $min && $max, 'got GROUP response'); +my $nr = $max - $min; +my $nmax = 50000; +my $nmin = $max - $nmax; +$nmin = $min if $nmin < $min; +my $res; +my $spec = "$nmin-$max"; +my $n; + +sub read_until_dot ($) { + my $n = 0; + do { + $buf = $s->getline; + ++$n + } until $buf eq ".\r\n"; + $n; +} + +$t = timeit(1, sub { + $s->print("XOVER $spec\r\n"); + $n = read_until_dot($s); +}); +diag 'xover took: ' . timestr($t) . " for $n"; + +$t = timeit(1, sub { + $s->print("HDR From $spec\r\n"); + $n = read_until_dot($s); + +}); +diag "XHDR From ". timestr($t) . " for $n"; + +my $date = $ENV{NEWNEWS_DATE}; +unless ($date) { + my (undef, undef, undef, $d, $m, $y) = gmtime(time - 30 * 86400); + $date = sprintf('%04u%02u%02u', $y + 1900, $m + 1, $d); + diag "NEWNEWS_DATE undefined, using $date"; +} +$t = timeit(1, sub { + $s->print("NEWNEWS * $date 000000 GMT\r\n"); + $n = read_until_dot($s); +}); +diag 'newnews took: ' . timestr($t) . " for $n"; + +if ($s) { + $s->print("QUIT\r\n"); + $s->getline; +} + + +done_testing(); + +1; diff --git a/xt/perf-threading.t b/xt/perf-threading.t new file mode 100644 index 00000000..1038bda5 --- /dev/null +++ b/xt/perf-threading.t @@ -0,0 +1,32 @@ +# Copyright (C) 2016-2019 all contributors <meta@public-inbox.org> +# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt> +# +# real-world testing of search threading +use strict; +use warnings; +use Test::More; +use Benchmark qw(:all); +use PublicInbox::Inbox; +my $inboxdir = $ENV{GIANT_INBOX_DIR} // $ENV{GIANT_PI_DIR}; +plan skip_all => "GIANT_INBOX_DIR not defined for $0" unless $inboxdir; +my $ibx = PublicInbox::Inbox->new({ inboxdir => $inboxdir }); +eval { require PublicInbox::Search }; +my $srch = $ibx->search; +plan skip_all => "$inboxdir not configured for search $0 $@" unless $srch; + +require PublicInbox::View; + +my $msgs; +my $elapsed = timeit(1, sub { + $msgs = $srch->{over_ro}->recent({limit => 200000}); +}); +my $n = scalar(@$msgs); +ok($n, 'got some messages'); +diag "enquire: ".timestr($elapsed)." for $n"; + +$elapsed = timeit(1, sub { + PublicInbox::View::thread_results({-inbox => $ibx}, $msgs); +}); +diag "thread_results ".timestr($elapsed); + +done_testing(); |