t/psgi_v2.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 strict;
   5 use v5.10.1;
   6 use PublicInbox::TestCommon;
   7 use IO::Uncompress::Gunzip qw(gunzip);
   8 require_git(2.6);
   9 use PublicInbox::Eml;
  10 use PublicInbox::Config;
  11 use PublicInbox::MID qw(mids);
  12 require_mods(qw(DBD::SQLite Xapian HTTP::Request::Common Plack::Test
  13                 URI::Escape Plack::Builder HTTP::Date));
  14 use_ok($_) for (qw(HTTP::Request::Common Plack::Test));
  15 use_ok 'PublicInbox::WWW';
  16 my ($tmpdir, $for_destroy) = tmpdir();
  17 my $enc_dup = 'ref-20150309094050.GO3427@x1.example';
  18
  19 my $dibx = create_inbox 'v2-dup', version => 2, indexlevel => 'medium',
  20                         tmpdir => "$tmpdir/dup", sub {
  21         my ($im, $ibx) = @_;
  22         my $common = <<"";
  23 Date: Mon, 9 Mar 2015 09:40:50 +0000
  24 From: x\@example.com
  25 To: y\@example.com
  26 Subject: re
  27 Message-ID: <$enc_dup>
  28 MIME-Version: 1.0
  29
  30         $im->add(PublicInbox::Eml->new($common.<<EOM)) or BAIL_OUT;
  31 Content-Type: text/plain; charset=utf-8
  32 Content-Disposition: inline
  33 Content-Transfer-Encoding: 8bit
  34
  35 cr_mismatch
  36 pipe \x{e2}\x{94}\x{82} or not
  37 EOM
  38         $im->add(PublicInbox::Eml->new($common.<<EOM)) or BAIL_OUT;
  39 Content-Type: text/plain; charset="windows-1252"
  40 Content-Transfer-Encoding: quoted-printable
  41
  42 cr_mismatch\r
  43 pipe =E2=94=82 or not
  44 EOM
  45 };
  46
  47 my $eml = PublicInbox::Eml->new(<<'EOF');
  48 From oldbug-pre-a0c07cba0e5d8b6a Fri Oct  2 00:00:00 1993
  49 From: a@example.com
  50 To: test@example.com
  51 Subject: this is a subject
  52 Message-ID: <a-mid@b>
  53 Date: Fri, 02 Oct 1993 00:00:00 +0000
  54 Content-Type: text/plain; charset=iso-8859-1
  55
  56 hello world
  57 EOF
  58 my $new_mid;
  59 my $ibx = create_inbox 'v2-1', version => 2, indexlevel => 'medium',
  60                         tmpdir => "$tmpdir/v2", sub {
  61         my ($im, $ibx) = @_;
  62         $im->add($eml) or BAIL_OUT;
  63         $eml->body_set("hello world!\n");
  64         my @warn;
  65         local $SIG{__WARN__} = sub { push @warn, @_ };
  66         $eml->header_set(Date => 'Fri, 02 Oct 1993 00:01:00 +0000');
  67         $im->add($eml) or BAIL_OUT;
  68         is(scalar(@warn), 1, 'got one warning');
  69         my $mids = mids($eml->header_obj);
  70         $new_mid = $mids->[1];
  71         open my $fh, '>', "$ibx->{inboxdir}/new_mid" or BAIL_OUT;
  72         print $fh $new_mid or BAIL_OUT;
  73         close $fh or BAIL_OUT;
  74 };
  75 $new_mid //= do {
  76         open my $fh, '<', "$ibx->{inboxdir}/new_mid" or BAIL_OUT;
  77         local $/;
  78         <$fh>;
  79 };
  80
  81 my $m2t = create_inbox 'mid2tid-1', version => 2, indexlevel => 'medium', sub {
  82         my ($im, $ibx) = @_;
  83         for my $n (1..3) {
  84                 $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add';
  85 Date: Fri, 02 Oct 1993 00:0$n:00 +0000
  86 Message-ID: <t\@$n>
  87 Subject: tid $n
  88 From: x\@example.com
  89 References: <a-mid\@b>
  90
  91 $n
  92 EOM
  93                 $im->add(PublicInbox::Eml->new(<<EOM)) or xbail 'add';
  94 Date: Fri, 02 Oct 1993 00:0$n:00 +0000
  95 Message-ID: <ut\@$n>
  96 Subject: unrelated tid $n
  97 From: x\@example.com
  98 References: <b-mid\@b>
  99
 100 EOM
 101         }
 102 };
 103
 104 my $test_lei_q_threadid = sub {
 105         my ($u) = @_;
 106         test_lei(sub {
 107                 lei_ok qw(q -f text --only), $u, qw(-T t@1 s:unrelated);
 108                 is $lei_out, '', 'no results on unrelated thread';
 109                 lei_ok qw(q -f text --only), $u, qw(-T t@1 dt:19931002000300..);
 110                 my @m = ($lei_out =~ m!^Message-ID: <([^>]+)>\n!gms);
 111                 is_deeply \@m, ['t@3'], 'got expected result from -T MSGID';
 112         });
 113 };
 114
 115 $test_lei_q_threadid->($m2t->{inboxdir});
 116
 117 my $cfgpath = "$ibx->{inboxdir}/pi_config";
 118 {
 119         open my $fh, '>', $cfgpath or BAIL_OUT $!;
 120         print $fh <<EOF or BAIL_OUT $!;
 121 [publicinbox "v2test"]
 122         inboxdir = $ibx->{inboxdir}
 123         address = $ibx->{-primary_address}
 124 [publicinbox "dup"]
 125         inboxdir = $dibx->{inboxdir}
 126         address = $dibx->{-primary_address}
 127 [publicinbox "m2t"]
 128         inboxdir = $m2t->{inboxdir}
 129         address = $m2t->{-primary_address}
 130 EOF
 131         close $fh or BAIL_OUT;
 132 }
 133
 134 my $msg = $ibx->msg_by_mid('a-mid@b');
 135 like($$msg, qr/\AFrom oldbug/s,
 136         '"From_" line stored to test old bug workaround');
 137 my $cfg = PublicInbox::Config->new($cfgpath);
 138 my $www = PublicInbox::WWW->new($cfg);
 139 my ($res, $raw, @from_);
 140 my $client0 = sub {
 141         my ($cb) = @_;
 142         $res = $cb->(GET('/v2test/description'));
 143         like($res->content, qr!\$INBOX_DIR/description missing!,
 144                 'got v2 description missing message');
 145         $res = $cb->(GET('/v2test/a-mid@b/raw'));
 146         is($res->header('Content-Type'), 'text/plain; charset=iso-8859-1',
 147                 'charset from message used');
 148         $raw = $res->content;
 149         unlike($raw, qr/^From oldbug/sm, 'buggy "From_" line omitted');
 150         like($raw, qr/^hello world$/m, 'got first message');
 151         like($raw, qr/^hello world!$/m, 'got second message');
 152         @from_ = ($raw =~ m/^From /mg);
 153         is(scalar(@from_), 2, 'two From_ lines');
 154
 155         $res = $cb->(GET("/v2test/$new_mid/raw"));
 156         $raw = $res->content;
 157         like($raw, qr/^hello world!$/m, 'second message with new Message-Id');
 158         @from_ = ($raw =~ m/^From /mg);
 159         is(scalar(@from_), 1, 'only one From_ line');
 160
 161         # Atom feed should sort by Date: (if Received is missing)
 162         $res = $cb->(GET('/v2test/new.atom'));
 163         my @bodies = ($res->content =~ />(hello [^<]+)</mg);
 164         is_deeply(\@bodies, [ "hello world!\n", "hello world\n" ],
 165                 'Atom ordering is chronological');
 166
 167         # new.html should sort by Date:, too (if Received is missing)
 168         $res = $cb->(GET('/v2test/new.html'));
 169         @bodies = ($res->content =~ /^(hello [^<]+)$/mg);
 170         is_deeply(\@bodies, [ "hello world!\n", "hello world\n" ],
 171                 'new.html ordering is chronological');
 172
 173         $res = $cb->(GET('/v2test/new.atom'));
 174         my @dates = ($res->content =~ m!title><updated>([^<]+)</updated>!g);
 175         is_deeply(\@dates, [ "1993-10-02T00:01:00Z", "1993-10-02T00:00:00Z" ],
 176                 'Date headers made it through');
 177 };
 178 test_psgi(sub { $www->call(@_) }, $client0);
 179 my $env = { TMPDIR => $tmpdir, PI_CONFIG => $cfgpath };
 180 test_httpd($env, $client0, 9);
 181
 182 $eml->header_set('Message-ID', 'a-mid@b');
 183 $eml->body_set("hello ghosts\n");
 184 my $im = $ibx->importer(0);
 185 {
 186         my @warn;
 187         local $SIG{__WARN__} = sub { push @warn, @_ };
 188         ok($im->add($eml), 'added 3rd duplicate-but-different message');
 189         is(scalar(@warn), 1, 'got another warning');
 190         like($warn[0], qr/mismatched/, 'warned about mismatched messages');
 191 }
 192 my $mids = mids($eml->header_obj);
 193 my $third = $mids->[-1];
 194 $im->done;
 195
 196 my $client1 = sub {
 197         my ($cb) = @_;
 198         $res = $cb->(GET('/v2test/_/text/config/raw'));
 199         my $lm = $res->header('Last-Modified');
 200         ok($lm, 'Last-Modified set w/ ->mm');
 201         $lm = HTTP::Date::str2time($lm);
 202         is($lm, $ibx->mm->created_at,
 203                 'Last-Modified for text/config/raw matches ->created_at');
 204         delete $ibx->{mm};
 205
 206         $res = $cb->(GET("/v2test/$third/raw"));
 207         $raw = $res->content;
 208         like($raw, qr/^hello ghosts$/m, 'got third message');
 209         @from_ = ($raw =~ m/^From /mg);
 210         is(scalar(@from_), 1, 'one From_ line');
 211
 212         $res = $cb->(GET('/v2test/a-mid@b/raw'));
 213         $raw = $res->content;
 214         like($raw, qr/^hello world$/m, 'got first message');
 215         like($raw, qr/^hello world!$/m, 'got second message');
 216         like($raw, qr/^hello ghosts$/m, 'got third message');
 217         @from_ = ($raw =~ m/^From /mg);
 218         is(scalar(@from_), 3, 'three From_ lines');
 219         $cfg->each_inbox(sub { $_[0]->search->reopen });
 220
 221         SKIP: {
 222                 my ($in, $out, $status);
 223                 my $req = GET('/v2test/a-mid@b/raw');
 224                 $req->header('Accept-Encoding' => 'gzip');
 225                 $res = $cb->($req);
 226                 is($res->header('Content-Encoding'), 'gzip', 'gzip encoding');
 227                 $in = $res->content;
 228                 gunzip(\$in => \$out);
 229                 is($out, $raw, 'gzip response matches');
 230
 231                 $res = $cb->(GET('/v2test/a-mid@b/t.mbox.gz'));
 232                 $in = $res->content;
 233                 $status = gunzip(\$in => \$out);
 234                 unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted');
 235                 like($out, qr/^hello world$/m, 'got first in t.mbox.gz');
 236                 like($out, qr/^hello world!$/m, 'got second in t.mbox.gz');
 237                 like($out, qr/^hello ghosts$/m, 'got third in t.mbox.gz');
 238                 @from_ = ($out =~ m/^From /mg);
 239                 is(scalar(@from_), 3, 'three From_ lines in t.mbox.gz');
 240
 241                 # search interface
 242                 $res = $cb->(POST('/v2test/?q=m:a-mid@b&x=m'));
 243                 $in = $res->content;
 244                 $status = gunzip(\$in => \$out);
 245                 unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted');
 246                 like($out, qr/^hello world$/m, 'got first in mbox POST');
 247                 like($out, qr/^hello world!$/m, 'got second in mbox POST');
 248                 like($out, qr/^hello ghosts$/m, 'got third in mbox POST');
 249                 @from_ = ($out =~ m/^From /mg);
 250                 is(scalar(@from_), 3, 'three From_ lines in mbox POST');
 251
 252                 # all.mbox.gz interface
 253                 $res = $cb->(GET('/v2test/all.mbox.gz'));
 254                 $in = $res->content;
 255                 $status = gunzip(\$in => \$out);
 256                 unlike($out, qr/^From oldbug/sm, 'buggy "From_" line omitted');
 257                 like($out, qr/^hello world$/m, 'got first in all.mbox');
 258                 like($out, qr/^hello world!$/m, 'got second in all.mbox');
 259                 like($out, qr/^hello ghosts$/m, 'got third in all.mbox');
 260                 @from_ = ($out =~ m/^From /mg);
 261                 is(scalar(@from_), 3, 'three From_ lines in all.mbox');
 262         };
 263
 264         $res = $cb->(GET('/v2test/?q=m:a-mid@b&x=t'));
 265         is($res->code, 200, 'success with threaded search');
 266         my $raw = $res->content;
 267         ok($raw =~ s/\A.*>Results 1-3 of 3\b//s, 'got all results');
 268         my @over = ($raw =~ m/\d{4}-\d+-\d+\s+\d+:\d+ +(?:\d+\% )?(.+)$/gm);
 269         is_deeply(\@over, [ '<a', '` <a', '` <a' ], 'threaded messages show up');
 270
 271         $res = $cb->(GET('/v2test/?q=m:a-mid@b&x=A'));
 272         is($res->code, 200, 'success with Atom search');
 273         SKIP: {
 274                 require_mods(qw(XML::TreePP), 2);
 275                 my $t = XML::TreePP->new->parse($res->content);
 276                 like($t->{feed}->{-xmlns}, qr/\bAtom\b/,
 277                         'looks like an an Atom feed');
 278                 is(scalar @{$t->{feed}->{entry}}, 3, 'parsed three entries');
 279         };
 280
 281         local $SIG{__WARN__} = 'DEFAULT';
 282         $res = $cb->(GET('/v2test/a-mid@b/'));
 283         $raw = $res->content;
 284         like($raw, qr/WARNING: multiple messages have this Message-ID/,
 285                 'warned about duplicate Message-IDs');
 286         like($raw, qr/^hello world$/m, 'got first message');
 287         like($raw, qr/^hello world!$/m, 'got second message');
 288         like($raw, qr/^hello ghosts$/m, 'got third message');
 289         @from_ = ($raw =~ m/>From: /mg);
 290         is(scalar(@from_), 3, 'three From: lines');
 291         foreach my $mid ('a-mid@b', $new_mid, $third) {
 292                 like($raw, qr!>\Q$mid\E</a>!s, "Message-ID $mid shown");
 293         }
 294         like($raw, qr/\b3\+ messages\b/, 'thread overview shown');
 295
 296         $res = $cb->(GET("/dup/$enc_dup/d/"));
 297         is($res->code, 200, '/d/ (diff) endpoint works');
 298         $raw = $res->content;
 299         like($raw, qr!</span> cr_mismatch\n!s,
 300                 'cr_mismatch is only diff context');
 301         like($raw, qr!>\-pipe !s, 'pipe diff del line');
 302         like($raw, qr!>\+pipe !s, 'pipe diff ins line');
 303         unlike $raw, qr/No newline at end of file/;
 304 };
 305
 306 test_psgi(sub { $www->call(@_) }, $client1);
 307 test_httpd($env, $client1, 38);
 308
 309 {
 310         my $exp = [ qw(<a-mid@b> <reuse@mid>) ];
 311         $eml->header_set('Message-Id', @$exp);
 312         $eml->header_set('Subject', '4th dupe');
 313         local $SIG{__WARN__} = sub {};
 314         ok($im->add($eml), 'added one message');
 315         $im->done;
 316         my @h = $eml->header('Message-ID');
 317         is_deeply($exp, \@h, 'reused existing Message-ID');
 318         $cfg->each_inbox(sub { $_[0]->search->reopen });
 319 }
 320
 321 my $client2 = sub {
 322         my ($cb) = @_;
 323         my $res = $cb->(GET('/v2test/new.atom'));
 324         my @ids = ($res->content =~ m!<id>urn:uuid:([^<]+)</id>!sg);
 325         my %ids;
 326         $ids{$_}++ for @ids;
 327         is_deeply([qw(1 1 1 1)], [values %ids], 'feed ids unique');
 328
 329         $res = $cb->(GET('/v2test/reuse@mid/T/'));
 330         $raw = $res->content;
 331         like($raw, qr/\b4\+ messages\b/, 'thread overview shown with /T/');
 332         my @over = ($raw =~ m/^\d{4}-\d+-\d+\s+\d+:\d+ (.+)$/gm);
 333         is_deeply(\@over, [ '<a', '` <a', '` <a', '` <a' ],
 334                 'duplicate messages share the same root');
 335
 336         $res = $cb->(GET('/v2test/reuse@mid/t/'));
 337         $raw = $res->content;
 338         like($raw, qr/\b4\+ messages\b/, 'thread overview shown with /t/');
 339
 340         $res = $cb->(GET('/v2test/0/info/refs'));
 341         is($res->code, 200, 'got info refs for dumb clones');
 342         $res = $cb->(GET('/v2test/0.git/info/refs'));
 343         is($res->code, 200, 'got info refs for dumb clones w/ .git suffix');
 344         $res = $cb->(GET('/v2test/info/refs'));
 345         is($res->code, 404, 'v2 git URL w/o shard fails');
 346 };
 347
 348 test_psgi(sub { $www->call(@_) }, $client2);
 349 test_httpd($env, $client2, 8);
 350 {
 351         # ensure conflicted attachments can be resolved
 352         local $SIG{__WARN__} = sub {};
 353         foreach my $body (qw(old new)) {
 354                 $im->add(eml_load "t/psgi_v2-$body.eml") or BAIL_OUT;
 355         }
 356         $im->done;
 357 }
 358 $cfg->each_inbox(sub { $_[0]->search->reopen });
 359
 360 my $client3 = sub {
 361         my ($cb) = @_;
 362         my $res = $cb->(GET('/v2test/a@dup/'));
 363         my @links = ($res->content =~ m!"\.\./([^/]+/2-attach\.txt)\"!g);
 364         is(scalar(@links), 2, 'both attachment links exist');
 365         isnt($links[0], $links[1], 'attachment links are different');
 366         {
 367                 my $old = $cb->(GET('/v2test/' . $links[0]));
 368                 my $new = $cb->(GET('/v2test/' . $links[1]));
 369                 is($old->content, 'old', 'got expected old content');
 370                 is($new->content, 'new', 'got expected new content');
 371         }
 372         $res = $cb->(GET('/v2test/?t=1970'.'01'.'01'.'000000'));
 373         is($res->code, 404, '404 for out-of-range t= param');
 374         my @warn = ();
 375         local $SIG{__WARN__} = sub { push @warn, @_ };
 376         $res = $cb->(GET('/v2test/?t=1970'.'01'.'01'));
 377         is_deeply(\@warn, [], 'no warnings on YYYYMMDD only');
 378
 379         $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000300..&x=m"));
 380         is($res->code, 200, 'got 200 on mid2tid query');
 381         gunzip(\(my $in = $res->content) => \(my $out));
 382         my @m = ($out =~ m!^Message-ID: <([^>]+)>\n!gms);
 383         is_deeply(\@m, ['t@3'], 'only got latest result from query');
 384
 385         $res = $cb->(POST("/m2t/t\@1/?q=dt:19931002000400..&x=m"));
 386         is($res->code, 404, '404 on out-of-range mid2tid query');
 387
 388         $res = $cb->(POST("/m2t/t\@1/?q=s:unrelated&x=m"));
 389         is($res->code, 404, '404 on cross-thread search');
 390
 391         my $rmt = $ENV{PLACK_TEST_EXTERNALSERVER_URI};
 392         $rmt and $test_lei_q_threadid->("$rmt/m2t/");
 393 };
 394 test_psgi(sub { $www->call(@_) }, $client3);
 395 test_httpd($env, $client3, 4);
 396
 397 done_testing;