root/t/20archive-store.t

use strict;

BEGIN { chdir 't' if -d 't' }
use lib '../lib';

use Test::More tests => 32;
use File::Path;
use File::Basename;
use Test::File;
use Test::File::Contents;
use Test::Output;

use Lancelot::DB;
use Lancelot::Template;
use Lancelot::Message;
use Lancelot::Log;

sub copy_msg {
    return Lancelot::Message->new($_[0]->as_string);
}

BEGIN { use_ok('Lancelot::Module::archive_store'); }

my ($listname) = 'pl-testlist@example.com';

rmtree("$ENV{HOME}/.pl/$listname", 0);

my $db = new Lancelot::DB $listname, { create => 1 };
$db->set_config('list.name', 'Pl-testlist');

my $msg = Lancelot::Message->new('From: hugo@example.com
To: pl-testlist@example.net
Subject: Test

This is a test.
');

# Don't archive messages from non-subscribers.

$db->set_config('mail.policy.subscribersonly', 1);
$msg->set_flag('nonsubscriber', 1);
my $result;
Lancelot::Log::init "";
stderr_like(sub { $result=Lancelot::Module::archive_store::execute($db, $msg);},
            qr/not archiving message because of subscriber-only policy/,
            "nonsubscriber archive_store STDERR output");
is($result, "", "nonsubscriber archive_store result OK");
ok(! -e "$ENV{HOME}/.pl/$listname/archive", "no archive directory created");
Lancelot::Log::init "NONE:";

# Basic archive test with defaults

$db->set_config('mail.policy.subscribersonly', 1);

$db->delete_configs('archive.directory'); # should be "archive"
$db->delete_configs('archive.dirmode');   # should be 0755
$msg = Lancelot::Message->new('From: hugo@example.com
To: pl-testlist@example.net
Subject: Test

This is a test.
');
$msg->set_flag("number", $db->increment_parameter("message"));
$msg->set_flag('nonsubscriber', 0);
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "subscriber archive_store result OK");
my $adir = "$ENV{HOME}/.pl/$listname/archive";
ok(-d $adir, "archive directory created");
file_mode_is($adir, 0755, "archive directory mode is 0755");
my $msgn = $msg->get_flag("number");
my $fname = sprintf "$adir/%u/%02u", int($msgn/100), $msgn % 100;
file_exists_ok($fname, "archive file created");
file_readable_ok($fname, "archive file is readable");
file_contents_is($fname, 'From: hugo@example.com
To: pl-testlist@example.net
Subject: Test

This is a test.
', "archive file correct contents");

# Set a message number if necessary

$msg = Lancelot::Message->new('From: hugo@example.com
To: pl-testlist@example.net
Subject: Test

This is a test.
');
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($msg->get_flag("number"), $msgn + 1, "message number was incremented");
$msgn = $msg->get_flag("number");
$fname = sprintf "$adir/%u/%02u", int($msgn/100), $msgn % 100;
file_exists_ok($fname, "second archive file created");


# different archive.directory

$db->set_config('archive.directory', 'other-archive');
$msg = Lancelot::Message->new('From: hugo@example.com
To: pl-testlist@example.net
Subject: Test

This is a test.
');
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "archive.directory test result");
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
ok(-d $adir, "archive directory created");
file_mode_is($adir, 0755, "archive directory mode is 0755");
$msgn = $msg->get_flag("number");
$fname = sprintf "$adir/%u/%02u", int($msgn/100), $msgn % 100;
file_exists_ok($fname, "archive.directory test file created");

# different archive.dirmode
rmtree($adir, 0);
$db->set_config('archive.dirmode', '488'); # 0750
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "archive.dirmode test result");
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
ok(-d $adir, "archive directory created");
file_mode_is($adir, 0750, "archive directory mode is 0750");

# different archive.dirmode in octal
rmtree($adir, 0);
$db->set_config('archive.dirmode', '0700');
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "octal archive.dirmode test result");
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
ok(-d $adir, "archive directory created");
file_mode_is($adir, 0700, "archive directory mode is 0700");

# absolute pathname for archive directory
rmtree($adir, 0);
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
$db->set_config('archive.directory', $adir);
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "absolute pathname archive.directory test result");
ok(-d $adir, "archive directory created");

# archive directory impossible to create
rmtree($adir, 0);
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
chmod 0111, dirname($adir);
$db->set_config('archive.directory', $adir);
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "uncreatable archive.directory test result");
chmod 0755, dirname($adir);
file_not_exists_ok($adir, "archive directory not created");

# archive file impossible to create
rmtree($adir, 0);
$adir = "$ENV{HOME}/.pl/$listname/other-archive";
mkpath "$adir/0", 0;
chmod 0111, "$adir/0";
$db->set_config('archive.directory', $adir);
$result = Lancelot::Module::archive_store::execute($db, $msg);
is($result, "", "uncreatable archive file test result");
$msgn = $msg->get_flag("number");
$fname = sprintf "$adir/%u/%02u", int($msgn/100), $msgn % 100;
chmod 0755, "$adir/0";
file_not_exists_ok($fname,
                   "unwritable archive.directory test file not created");

# archive mail from subscriber
rmtree($adir, 0);
$db->set_config('mail.policy.subscribersonly', 0);
foreach my $nonsub (0, 1) {
    my $msgc = copy_msg($msg);
    $msgc->set_flag('nonsubscriber', $nonsub);
    $result = Lancelot::Module::archive_store::execute($db, $msgc);
    is($result, "", "nonsubscriber archive_store result OK ($nonsub)");
    $msgn = $msgc->get_flag("number");
    $fname = sprintf "$adir/%u/%02u", int($msgn/100), $msgn % 100;
    file_exists_ok($fname, "nonsubscriber archive file created ($nonsub)");
}