t/all.t

   1 #!/usr/bin/perl -w
   2 # Copyright (C) 2013-2016 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 warnings;
   6 use Test::More;
   7 use File::Temp qw/tempdir/;
   8 use Email::MIME;
   9 # test all command-line interfaces at once
  10 my $mda = "blib/script/ssoma-mda";
  11 my $cli = "blib/script/ssoma";
  12 my $rm = "blib/script/ssoma-rm";
  13 my $tmp = tempdir('ssoma-all-XXXXXX', TMPDIR => 1, CLEANUP => 1);
  14 my $have_ipc_run = eval {
  15         require IPC::Run;
  16         import IPC::Run qw/run/;
  17         1;
  18 };
  19
  20 ok(-x $mda, "$mda is executable");
  21 ok(-x $cli, "$cli is executable");
  22
  23 {
  24         # instantiate new git repo
  25         my $git_dir = "$tmp/input.git";
  26         system(qw/git init -q --bare/, $git_dir) == 0 or
  27                 die "git init -q --bare $git_dir failed: $?\n";
  28         ok(-d $git_dir && -f "$git_dir/config", '$GIT_DIR exists and is bare');
  29
  30         # deliver the message
  31         my $mime = Email::MIME->new(<<'EOF');
  32 From: me@example.com
  33 To: u@example.com
  34 Message-ID: <666@example.com>
  35 Subject: zzz
  36
  37 OMFG
  38 EOF
  39         my $pid = open my $pipe, '|-';
  40         defined $pid or die "failed to pipe + fork: $!\n";
  41         if ($pid == 0) {
  42                 exec($mda, $git_dir);
  43                 die "exec failed: $!\n";
  44         }
  45         print $pipe $mime->as_string or die "print failed: $!\n";
  46         close $pipe or die "close pipe failed: $!\n";
  47         is($?, 0, "$mda exited successfully");
  48
  49         {
  50                 local $ENV{GIT_DIR} = $git_dir;
  51                 my @x = `git cat-file commit HEAD`;
  52                 chomp @x;
  53                 my @au = grep(/^author /, @x);
  54                 like($au[0], qr/\Aauthor me <me\@example\.com>/, "author set");
  55
  56                 is('zzz', $x[-1], "subject set");
  57         }
  58 }
  59
  60 {
  61         my $mbox = "$tmp/mbox";
  62         local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
  63         my $name = "test";
  64         my @cmd = ($cli, '-q', "add", $name, "$tmp/input.git", "mbox:$mbox");
  65         is(system(@cmd), 0, "add list with ssoma(1)");
  66
  67         {
  68                 use Ssoma::Git;
  69                 my $git_dir = "$ENV{SSOMA_HOME}/$name.git";
  70                 my $git = Ssoma::Git->new($git_dir);
  71                 my $cfg = $git->config_list("$git_dir/ssoma.state");
  72                 is(scalar keys %$cfg, 1, "only one key");
  73                 like($cfg->{"target.local.path"}, qr{\A/},
  74                      "target.local.path is absolute");
  75                 like($cfg->{"target.local.path"}, qr{\Q$mbox\E\z},
  76                      "target.local.path points to mbox");
  77
  78                 $cfg = $git->config_list("$git_dir/config");
  79                 is($cfg->{"core.bare"}, "true", "repo is bare");
  80         }
  81
  82         @cmd = ($cli, '-q', "sync");
  83         is(system(@cmd), 0, "sync list with ssoma(1)");
  84
  85         open(my $fh, '<', $mbox) or die "open $mbox: $!\n";
  86         my @lines = <$fh>;
  87         is(scalar grep(/^Subject: zzz/, @lines), 1, "email delivered");
  88         close $fh or die "close $mbox: $!\n";
  89 }
  90
  91 {
  92         # deliver an additional message
  93         my $mime = Email::MIME->new(<<'EOF');
  94 From: moi@example.com
  95 To: you@example.com
  96 Message-ID: <666666@example.com>
  97 Subject: xxx
  98
  99 OMFG
 100 EOF
 101         my $pid = open my $pipe, '|-';
 102         defined $pid or die "failed to pipe + fork: $!\n";
 103         if ($pid == 0) {
 104                 exec($mda, "$tmp/input.git");
 105                 die "exec failed: $!\n";
 106         }
 107         print $pipe $mime->as_string or die "print failed: $!\n";
 108         close $pipe or die "close pipe failed: $!\n";
 109         is($?, 0, "$mda exited successfully");
 110 }
 111
 112 # ensure new message is delivered
 113 {
 114         my $mbox = "$tmp/mbox";
 115         local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
 116         my $name = "test";
 117
 118         my @cmd = ($cli, '-q', "sync", $name);
 119         is(system(@cmd), 0, "sync $name list with ssoma(1)");
 120
 121         open(my $fh, '<', $mbox) or die "open $mbox: $!\n";
 122         my @lines = <$fh>;
 123         is(scalar grep(/^Subject: xxx/, @lines), 1, "email delivered");
 124         is(scalar grep(/^Subject: zzz/, @lines), 1, "email delivered");
 125         close $fh or die "close $mbox: $!\n";
 126 }
 127
 128 # ssoma cat functionality
 129 {
 130         local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
 131         my @full = `$cli cat \\<666\@example.com\\>`;
 132         my $from = shift @full;
 133         like($from, qr/^From /, "ssoma cat mbox has From_ line");
 134         is(scalar grep(/^Message-ID: <666\@example\.com>/, @full), 1,
 135            "correct message returned from ssoma cat");
 136         my @lazy = `$cli cat 666\@example.com`;
 137         $from = shift @lazy;
 138         like($from, qr/^From /, "ssoma cat (lazy) mbox has From_ line");
 139         is(join('', @lazy), join('', @full),
 140             "lazy ssoma cat invocation w/o <> works");
 141 }
 142
 143 # ssoma cat with a repo path
 144 {
 145         my @full = `$cli cat \\<666\@example.com\\> $tmp/input.git`;
 146         my $from = shift @full;
 147         like($from, qr/^From /, "ssoma cat mbox has From_ line");
 148         is(scalar grep(/^Message-ID: <666\@example\.com>/, @full), 1,
 149            "correct message returned from ssoma cat");
 150 }
 151
 152 # duplicate message delivered to MDA (for "ssoma cat" dup handling)
 153 {
 154         # deliver the message
 155         my $dup = Email::MIME->new(<<'EOF');
 156 From: me@example.com
 157 To: u@example.com
 158 Message-ID: <666@example.com>
 159 Subject: duplicate
 160
 161 EOF
 162         use Ssoma::MDA;
 163         use Ssoma::Git;
 164         Ssoma::MDA->new(Ssoma::Git->new("$tmp/input.git"))->deliver($dup);
 165 }
 166
 167 # test ssoma cat on a duplicate
 168 {
 169         my $mbox = "$tmp/mbox";
 170         local $ENV{SSOMA_HOME} = "$tmp/ssoma-home";
 171         my $name = "test";
 172         my @cmd = ($cli, "-q", "sync", $name);
 173         is(system(@cmd), 0, "sync $name with ssoma(1)");
 174
 175         my @both = `$cli cat \\<666\@example.com\\>`;
 176         is(scalar grep(/^Message-ID: <666\@example\.com>/, @both), 2,
 177            "correct messages returned from ssoma cat");
 178         is(scalar grep(/^From /, @both), 2,
 179            "From_ line from both messages returned from ssoma cat");
 180         my @s = sort grep(/^Subject: /, @both);
 181         my @x = ("Subject: duplicate\n", "Subject: zzz\n");
 182         is_deeply(\@s, \@x, "subjects are correct in mbox");
 183 }
 184
 185 # test ssoma-rm functionality
 186 {
 187         my $git_dir = "$tmp/input.git";
 188         my @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
 189         is(scalar @tree, 3, "three messages sitting in a tree");
 190
 191         # deliver the message to ssoma-rm
 192         my $mime = Email::MIME->new(<<'EOF');
 193 From: me@example.com
 194 To: u@example.com
 195 Message-ID: <666@example.com>
 196 Subject: zzz
 197
 198 OMFG
 199 EOF
 200         my $pid = open my $pipe, '|-';
 201         defined $pid or die "failed to pipe + fork: $!\n";
 202         if ($pid == 0) {
 203                 exec($rm, $git_dir);
 204                 die "exec failed: $!\n";
 205         }
 206         print $pipe $mime->as_string or die "print failed: $!\n";
 207         close $pipe or die "close pipe failed: $!\n";
 208         is($?, 0, "$rm exited successfully");
 209         @tree = `GIT_DIR=$git_dir git ls-tree -r HEAD`;
 210         is(scalar @tree, 2, "two messages sitting in a tree");
 211 }
 212
 213 # duplicate detection
 214 SKIP: {
 215         skip "IPC::Run not available", 2 unless $have_ipc_run;
 216         my $mime = Email::MIME->new(<<'EOF');
 217 From: moi@example.com
 218 To: you@example.com
 219 Message-ID: <666666@example.com>
 220 Subject: xxx
 221
 222 OMFG
 223 EOF
 224         $mime = $mime->as_string;
 225         my ($out, $err) = ("", "");
 226         run([$mda, "-1", "$tmp/input.git"], \$mime, \$out, \$err);
 227         isnt($?, 0, "$mda exited with failure");
 228         like($err, qr/CONFLICT/, "conflict message detected");
 229 }
 230
 231 done_testing();