diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/git-http-backend.t | 116 | ||||
| -rw-r--r-- | t/nntpd-validate.t | 217 | ||||
| -rw-r--r-- | t/perf-msgview.t | 52 | ||||
| -rw-r--r-- | t/perf-nntpd.t | 111 | ||||
| -rw-r--r-- | t/perf-threading.t | 32 |
5 files changed, 0 insertions, 528 deletions
diff --git a/t/git-http-backend.t b/t/git-http-backend.t deleted file mode 100644 index a927d89e..00000000 --- a/t/git-http-backend.t +++ /dev/null @@ -1,116 +0,0 @@ -# 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/t/nntpd-validate.t b/t/nntpd-validate.t deleted file mode 100644 index 39108639..00000000 --- a/t/nntpd-validate.t +++ /dev/null @@ -1,217 +0,0 @@ -# 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/t/perf-msgview.t b/t/perf-msgview.t deleted file mode 100644 index 22d8ce20..00000000 --- a/t/perf-msgview.t +++ /dev/null @@ -1,52 +0,0 @@ -# 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/t/perf-nntpd.t b/t/perf-nntpd.t deleted file mode 100644 index 5a176e08..00000000 --- a/t/perf-nntpd.t +++ /dev/null @@ -1,111 +0,0 @@ -# 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/t/perf-threading.t b/t/perf-threading.t deleted file mode 100644 index 1038bda5..00000000 --- a/t/perf-threading.t +++ /dev/null @@ -1,32 +0,0 @@ -# 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(); |