t/all.t

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