aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/Sietima/MailStore.pm9
-rw-r--r--lib/Sietima/Role/SubscriberOnly.pm5
-rw-r--r--lib/Sietima/Role/SubscriberOnly/Drop.pm3
-rw-r--r--lib/Sietima/Role/SubscriberOnly/Moderate.pm39
-rw-r--r--lib/Sietima/Role/WithAdmin.pm16
-rw-r--r--lib/Sietima/Role/WithMailStore.pm15
-rw-r--r--lib/Sietima/Types.pm3
-rw-r--r--t/lib/Test/Sietima.pm3
-rw-r--r--t/lib/Test/Sietima/MailStore.pm56
-rw-r--r--t/tests/sietima/role/subscriberonly/moderate.t92
10 files changed, 239 insertions, 2 deletions
diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm
new file mode 100644
index 0000000..2d2b1a7
--- /dev/null
+++ b/lib/Sietima/MailStore.pm
@@ -0,0 +1,9 @@
+package Sietima::MailStore;
+use strict;
+use warnings;
+use 5.020;
+use Moo::Role;
+
+requires 'store','retrieve_by_tags','retrieve_by_id';
+
+1;
diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm
index 4dcb66c..98c02a6 100644
--- a/lib/Sietima/Role/SubscriberOnly.pm
+++ b/lib/Sietima/Role/SubscriberOnly.pm
@@ -6,13 +6,16 @@ use namespace::clean;
requires 'munge_mail_from_non_subscriber';
+our $let_it_pass=0;
+
around munge_mail => sub {
my ($orig,$self,$mail) = @_;
my $from = (Email::Address->parse(
$mail->header_str('from'),
))[0]->address;
- if ( any { $_->address eq $from } @{$self->subscribers} ) {
+ if ( $let_it_pass or
+ any { $_->address eq $from } @{$self->subscribers} ) {
$self->$orig($mail);
}
else {
diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm
index 91354e5..8db062f 100644
--- a/lib/Sietima/Role/SubscriberOnly/Drop.pm
+++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm
@@ -1,4 +1,7 @@
package Sietima::Role::SubscriberOnly::Drop;
+use strict;
+use warnings;
+use 5.020;
use Moo::Role;
use namespace::clean;
diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
new file mode 100644
index 0000000..107a843
--- /dev/null
+++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
@@ -0,0 +1,39 @@
+package Sietima::Role::SubscriberOnly::Moderate;
+use strict;
+use warnings;
+use 5.020;
+use Moo::Role;
+use Email::Stuffer;
+use Email::MIME;
+use namespace::clean;
+
+with 'Sietima::Role::SubscriberOnly',
+ 'Sietima::Role::WithMailStore',
+ 'Sietima::Role::WithAdmin';
+
+sub munge_mail_from_non_subscriber {
+ my ($self,$mail) = @_;
+
+ my $id = $self->mail_store->store($mail,'moderation');
+ my $notice = Email::Stuffer
+ ->from($self->return_path)
+ ->to($self->admin)
+ ->subject("Message held for moderation - ".$mail->header_str('subject'))
+ ->text_body("Use id $id to refer to it")
+ ->attach($mail->as_string, content_type => 'message/rfc822');
+ $self->transport->send($notice->email,{
+ from => $self->return_path,
+ to => [ $self->admin ],
+ });
+ return;
+}
+
+sub resume {
+ my ($self,$mail_id) = @_;
+
+ my $mail = $self->mail_store->retrieve_by_id($mail_id);
+ local $Sietima::Role::SubscriberOnly::let_it_pass=1;
+ $self->handle_mail($mail);
+}
+
+1;
diff --git a/lib/Sietima/Role/WithAdmin.pm b/lib/Sietima/Role/WithAdmin.pm
new file mode 100644
index 0000000..08bf0d2
--- /dev/null
+++ b/lib/Sietima/Role/WithAdmin.pm
@@ -0,0 +1,16 @@
+package Sietima::Role::WithAdmin;
+use strict;
+use warnings;
+use 5.020;
+use Moo::Role;
+use Sietima::Types qw(Address AddressFromStr);
+use namespace::clean;
+
+has admin => (
+ is => 'ro',
+ isa => Address,
+ required => 1,
+ coerce => AddressFromStr,
+);
+
+1;
diff --git a/lib/Sietima/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm
new file mode 100644
index 0000000..abee4e2
--- /dev/null
+++ b/lib/Sietima/Role/WithMailStore.pm
@@ -0,0 +1,15 @@
+package Sietima::Role::WithMailStore;
+use strict;
+use warnings;
+use 5.020;
+use Moo::Role;
+use Sietima::Types qw(MailStore);
+use namespace::clean;
+
+has mail_store => (
+ is => 'ro',
+ isa => MailStore,
+ required => 1,
+);
+
+1;
diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm
index 95d1f88..af3e1c0 100644
--- a/lib/Sietima/Types.pm
+++ b/lib/Sietima/Types.pm
@@ -10,10 +10,11 @@ use Type::Library
-declare => qw(Address AddressFromStr
EmailMIME Message
Subscriber SubscriberFromAddress SubscriberFromStr
- Transport);
+ Transport MailStore);
class_type EmailMIME, { class => 'Email::MIME' };
role_type Transport, { role => 'Email::Sender::Transport' };
+role_type MailStore, { role => 'Sietima::MailStore' };
class_type Address, { class => 'Email::Address' };
declare_coercion AddressFromStr,
diff --git a/t/lib/Test/Sietima.pm b/t/lib/Test/Sietima.pm
index 0b80e42..0661786 100644
--- a/t/lib/Test/Sietima.pm
+++ b/t/lib/Test/Sietima.pm
@@ -16,6 +16,8 @@ sub import {
my $target = caller;
Test2::Bundle::Extended->import::into($target);
Test2::Plugin::DieOnFail->import::into($target);
+ Data::Printer->import::into($target);
+
for my $function (qw(transport make_sietima make_mail
deliveries_are test_sending)) {
no strict 'refs';
@@ -52,6 +54,7 @@ sub make_mail {
Email::Stuffer
->from($args{from}||'someone@users.example.com')
->to($args{to}||$return_path)
+ ->subject($args{subject}||'Test Message')
->text_body($args{body}||'some simple message')
->email;
}
diff --git a/t/lib/Test/Sietima/MailStore.pm b/t/lib/Test/Sietima/MailStore.pm
new file mode 100644
index 0000000..abf4435
--- /dev/null
+++ b/t/lib/Test/Sietima/MailStore.pm
@@ -0,0 +1,56 @@
+package Test::Sietima::MailStore;
+use strict;
+use warnings;
+use 5.020;
+use Moo;
+use List::AllUtils qw(all);
+use namespace::clean;
+
+with 'Sietima::MailStore';
+
+has _mails => (
+ is => 'rw',
+ default => sub { +[] },
+);
+
+sub clear { shift->_mails([]) }
+
+sub store {
+ my ($self,$mail,@tags) = @_;
+
+ my $id = time();
+ push @{$self->_mails}, {
+ id => $id,
+ mail => $mail->as_string,
+ tags => { map {$_ => 1;} @tags, },
+ };
+ return $id;
+}
+
+sub retrieve_by_tags {
+ my ($self,@tags) = @_;
+
+ my @ret;
+ for my $m (@{$self->_mails}) {
+ next unless all { $m->{tags}{$_} } @tags;
+ push @ret, {
+ %{$m}{id},
+ mail => Email::MIME->new($m->{mail})
+ };
+ }
+
+ return \@ret;
+}
+
+sub retrieve_by_id {
+ my ($self,$id) = @_;
+
+ for my $m (@{$self->_mails}) {
+ next unless $m->{id} eq $id;
+ return Email::MIME->new($m->{mail});
+ }
+
+ return;
+}
+
+1;
diff --git a/t/tests/sietima/role/subscriberonly/moderate.t b/t/tests/sietima/role/subscriberonly/moderate.t
new file mode 100644
index 0000000..c76e69b
--- /dev/null
+++ b/t/tests/sietima/role/subscriberonly/moderate.t
@@ -0,0 +1,92 @@
+#!perl
+use strict;
+use warnings;
+use 5.020;
+use lib 't/lib';
+use Test::Sietima;
+use Test::Sietima::MailStore;
+
+my @subscriber_addresses = (
+ 'one@users.example.com',
+ 'two@users.example.com',
+);
+my $admin = 'admin@lists.example.com';
+my $ms = Test::Sietima::MailStore->new();
+my $s = make_sietima(
+ with_traits => ['SubscriberOnly::Moderate'],
+ subscribers => [@subscriber_addresses],
+ admin => $admin,
+ mail_store => $ms,
+);
+
+subtest 'from subscriber' => sub {
+ $ms->clear;
+ test_sending(
+ sietima => $s,
+ mail => { from=>'one@users.example.com' },
+ );
+ is(
+ $ms->retrieve_by_tags('moderation'),
+ [],
+ 'no mails held for moderation',
+ );
+};
+
+subtest 'from non-subscriber' => sub {
+ $ms->clear;
+ test_sending(
+ sietima => $s,
+ mail => { from=>'someone@users.example.com' },
+ to => [$admin],
+ );
+
+
+ my @deliveries = transport->deliveries;
+ is(
+ \@deliveries,
+ [
+ hash {
+ field email => object {
+ call [cast=>'Email::MIME'] => object {
+ call [header_str => 'subject'] => match qr{\bheld for moderation\b};
+ call_list parts => [
+ object {
+ call body => match qr{Use id \S+ to refer to it};
+ },
+ object {
+ call sub {Email::MIME->new(shift->body)} => object {
+ call [header_str => 'subject'] => 'Test Message';
+ };
+ },
+ ];
+ };
+ };
+ },
+ ],
+ 'the original mail should be attached',
+ np @deliveries,
+ );
+
+ is(
+ my $to_moderate = $ms->retrieve_by_tags('moderation'),
+ [
+ {
+ id => T(),
+ mail => object {
+ call [header_str => 'from'] => 'someone@users.example.com';
+ call [header_str => 'to'] => $s->return_path->address,
+ },
+ },
+ ],
+ 'mails was held for moderation',
+ );
+
+ transport->clear_deliveries;
+ my $msg_id = $to_moderate->[0]->{id};
+ $s->resume($msg_id);
+ deliveries_are(
+ to => \@subscriber_addresses,
+ );
+};
+
+done_testing;
generated by cgit v1.2.3 (git 2.46.0) at 2025-05-03 23:59:15 +0000