From 70356732191b6c40b95e6aec6b6a974303ac7d93 Mon Sep 17 00:00:00 2001 From: dakkar Date: Mon, 6 Feb 2017 21:37:21 +0000 Subject: more POD, factoring, better moderation-override --- lib/Sietima/Role/AvoidDups.pm | 7 +++ lib/Sietima/Role/Debounce.pm | 11 ++++- lib/Sietima/Role/Headers.pm | 9 ++++ lib/Sietima/Role/NoMail.pm | 7 +++ lib/Sietima/Role/ReplyTo.pm | 49 ++++++++++--------- lib/Sietima/Role/SubjectTag.pm | 40 ++++++++++++++++ lib/Sietima/Role/SubscriberOnly.pm | 73 +++++++++++++++++++++++++++++ lib/Sietima/Role/SubscriberOnly/Drop.pm | 29 ++++++++++++ lib/Sietima/Role/SubscriberOnly/Moderate.pm | 35 +++++++++++++- lib/Sietima/Role/WithAdmin.pm | 29 ++++++++++++ lib/Sietima/Role/WithMailStore.pm | 34 ++++++++++++++ lib/Sietima/Role/WithPostAddress.pm | 52 ++++++++++++++++++++ 12 files changed, 350 insertions(+), 25 deletions(-) create mode 100644 lib/Sietima/Role/WithPostAddress.pm (limited to 'lib/Sietima') diff --git a/lib/Sietima/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm index 964c413..ac633c0 100644 --- a/lib/Sietima/Role/AvoidDups.pm +++ b/lib/Sietima/Role/AvoidDups.pm @@ -19,6 +19,13 @@ message to a subscriber, if that subscriber is already mentioned in the C or C header fields, because they can be assumed to be already receiving the message directly from the sender. +=head1 MODIFIED METHODS + +=head2 C + +Filters out subscribers that L the +addresses in the C or C headers of the incoming email. + =cut around subscribers_to_send_to => sub ($orig,$self,$mail) { diff --git a/lib/Sietima/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm index 882d982..f949842 100644 --- a/lib/Sietima/Role/Debounce.pm +++ b/lib/Sietima/Role/Debounce.pm @@ -14,11 +14,20 @@ Sietima::Role::Debounce - avoid mail loops =head1 DESCRIPTION A L<< C >> list with this role applied will mark each message -with a C header, and will not handle any messages that +with a C header, and will not handle any messages that have that same header. This prevents messages bounced by other services from being looped between the mailing list and those other services. +=head1 MODIFIED MESSAGES + +=head2 C + +If the incoming email contains our C header, this +method will return an empty list (essentially dropping the message). + +Otherwise, the header is added, and the email is processed normally. + =cut my $been_there = 'X-Been-There'; diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm index f73db93..27f79fb 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -92,6 +92,15 @@ sub _add_headers_to($self,$message) { return; } +=head1 MODIFIED METHODS + +=head2 C + +This method adds list-management headers to each message returned by +the original method. + +=cut + around munge_mail => sub ($orig,$self,$mail) { my @messages = $self->$orig($mail); $self->_add_headers_to($_) for @messages; diff --git a/lib/Sietima/Role/NoMail.pm b/lib/Sietima/Role/NoMail.pm index 5f6dd77..7db58da 100644 --- a/lib/Sietima/Role/NoMail.pm +++ b/lib/Sietima/Role/NoMail.pm @@ -23,6 +23,13 @@ A L<< C >> list with this role applied will not send messages to subscribers that have the C preference set to a false value. +=head1 MODIFIED METHODS + +=head2 C + +Filters out subscribers that have the C preference set to +a false value. + =cut around subscribers_to_send_to => sub ($orig,$self,$mail) { diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index 5962451..c9de1a4 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -26,14 +26,21 @@ Sietima::Role::ReplyTo - munge the C header =head1 DESCRIPTION A L<< C >> list with this role applied will, on request, set -the C header to the value of the L<< /C >> -attribute. +the C header to the value of the L<< +C|Sietima::Role::WithPostAddress >> attribute. This behaviour can be selected both at the list level (with the L<< /C >> attribute) and at the subscriber level (with the C preference). By default, the C header is not touched. +This is a "sub-role" of L<< +C|Sietima::Role::WithPostAddress >>. + +=cut + +with 'Sietima::Role::WithPostAddress'; + =head1 ATTRIBUTES =head2 C @@ -51,23 +58,28 @@ has munge_reply_to => ( default => 0, ); -=head2 C +=head1 MODIFIED METHODS -An L<< C >> object, defaults to the value of the L<< -C|Sietima/return_path >> attribute. This is the address -that the mailing list receives messages at. +=head2 C -This role extends the L<< C|Sietima/list_addresses >> -method to include this address. +For each message returned by the original method, this method +partitions the subscribers, who are recipients of the message, +according to their C preference (or the L<< +/C >> attribute, if a subscriber does not have the +preference set). -=cut +If no recipients want the C header modified, this method +will just pass the message through. -has post_address => ( - is => 'lazy', - isa => Address, - coerce => AddressFromStr, -); -sub _build_post_address($self) { $self->return_path } +If all recipients want the C header modified, this method +will set the header, and pass the modified message. + +If some recipients want the C header modified, and some +don't, this method will clone the message, modify the header in one +copy, set the appropriate part of the recipients to each copy, and +pass both through. + +=cut around munge_mail => sub ($orig,$self,$mail) { my @messages = $self->$orig($mail); @@ -112,11 +124,4 @@ around munge_mail => sub ($orig,$self,$mail) { return @ret; }; -around list_addresses => sub ($orig,$self) { - return +{ - $self->$orig->%*, - post => $self->post_address, - }; -}; - 1; diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm index edaa598..75170d7 100644 --- a/lib/Sietima/Role/SubjectTag.pm +++ b/lib/Sietima/Role/SubjectTag.pm @@ -4,12 +4,52 @@ use Sietima::Policy; use Types::Standard qw(Str); use namespace::clean; +=head1 NAME + +Sietima::Role::SubjectTag - add a tag to messages' subjects + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('SubjectTag')->new({ + %args, + subject_tag => 'foo', + }); + +=head1 DESCRIPTION + +A L<< C >> list with this role applied will prepend the given +tag to every outgoing message's C header. + +=head1 ATTRIBUTES + +=head2 C + +Required string. This string, enclosed by square brackets, will be +prepended to the C header of outgoing messages. For example, +the code in the L would cause an incoming message with +subject "new stuff" to be sent out with subject "[foo] new stuff". + +If the incoming message's C header already contains the tag, +the header will not be modified. This prevents getting subjects like +"[foo] Re: [foo] Re: [foo] new stuff". + +=cut + has subject_tag => ( is => 'ro', isa => Str, required => 1, ); +=head1 MODIFIED METHODS + +=head2 C + +The subject of the incoming email is modified to add the tag (unless +it's already there). The email is then processed normally. + +=cut + around munge_mail => sub ($orig,$self,$mail) { my $tag = '['.$self->subject_tag.']'; my $subject = $mail->header_str('Subject'); diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index f01dadf..ff93076 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -3,12 +3,63 @@ use Moo::Role; use Sietima::Policy; use Email::Address; use List::AllUtils qw(any); +use Types::Standard qw(Object CodeRef); +use Type::Params qw(compile); use namespace::clean; +=head1 NAME + +Sietima::Role::SubscriberOnly - base role for "closed" lists + +=head1 SYNOPSIS + + package Sietima::Role::SubscriberOnly::MyPolicy; + use Moo::Role; + use Sietima::Policy; + + sub munge_mail_from_non_subscriber($self,$mail) { ... } + +=head1 DESCRIPTION + +This is a base role; in other words, it's not useable directly. + +This role should be used when defining policies for "closed" lists: +lists that accept messages from subscribers, but do something special +with messages from non-subscribers. + +See L<< C >> and L<< +C >> for useable roles. + +=head1 REQUIRED METHODS + +=head2 C + + sub munge_mail_from_non_subscriber($self,$mail) { ... } + +This method will be invoked from L<< C|Sietima/munge_mail +>> whenever an email is processed that does not come from one of the +list's subscribers. This method should return a (possibly empty) list +of L<< C >> objects, just like C. It can +also have side-effects, like forwarding the email to the owner of the +list. + +=cut + requires 'munge_mail_from_non_subscriber'; our $let_it_pass=0; +=head1 MODIFIED METHODS + +=head2 C + +If the incoming email's C header contains an address that +L any of the subscribers, the email +is processed normally. Otherwise, L<< +/C >> is invoked. + +=cut + around munge_mail => sub ($orig,$self,$mail) { my ($from) = Email::Address->parse( $mail->header_str('from') ); if ( $let_it_pass or @@ -20,4 +71,26 @@ around munge_mail => sub ($orig,$self,$mail) { } }; +=head1 METHODS + +=head2 C + + $sietima->ignoring_subscriberonly(sub($s) { + $s->handle_mail($mail); + }); + +This method provides a way to run Sietima ignoring the "subscriber +only" beaviour. Your coderef will be passed a Sietima object that will +behave exactly as the invocant of this method, minus this role's +modifications. + +=cut + +sub ignoring_subscriberonly($self,$code) { + state $check = compile(Object,CodeRef); $check->(@_); + + local $let_it_pass = 1; + return $code->($self); +} + 1; diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm index 2036c99..029889f 100644 --- a/lib/Sietima/Role/SubscriberOnly/Drop.pm +++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm @@ -3,8 +3,37 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; +=head1 NAME + +Sietima::Role::SubscriberOnly::Drop - drop messages from non-subscribers + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('SubscribersOnly::Drop')->new({ + %args, + }); + +=head1 DESCRIPTION + +A L<< C >> list with this role applied will silently discard +every incoming email that does not come from one of the list's +subscribers. + +This is a "sub-role" of L<< +C|Sietima::Role::SubscriberOnly >>. + +=cut + with 'Sietima::Role::SubscriberOnly'; +=head1 METHODS + +=head2 C + +Does nothing, returns an empty list. + +=cut + sub munge_mail_from_non_subscriber { } 1; diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index 158d18a..0c56040 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -5,6 +5,36 @@ use Email::Stuffer; use Email::MIME; use namespace::clean; +=head1 NAME + +Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ + %args, + admin => 'listmaster@example.com', + mail_store => { + class => 'Sietima::MailStore::FS', + root => '/tmp', + }, + }); + +=head1 DESCRIPTION + +A L<< C >> list with this role applied will accept incoming +emails coming from non-subscribers, and store it for moderation. Each +such email will be forwarded (as an attachment) to the list's admin. + +The admin will the be able to delete the message, or allow it. + +This is a "sub-role" of L<< +C|Sietima::Role::SubscriberOnly >>, L<< +C|Sietima::Role::WithMailStore >>, and L<< +C|Sietima::Role::WithAdmin >>. + +=cut + with 'Sietima::Role::SubscriberOnly', 'Sietima::Role::WithMailStore', 'Sietima::Role::WithAdmin'; @@ -30,8 +60,9 @@ sub munge_mail_from_non_subscriber ($self,$mail) { sub resume ($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); + $self->ignoring_subscriberonly( + sub($s) { $s->handle_mail($mail) }, + ); $self->mail_store->remove($mail_id); } diff --git a/lib/Sietima/Role/WithAdmin.pm b/lib/Sietima/Role/WithAdmin.pm index 8293621..2781bf8 100644 --- a/lib/Sietima/Role/WithAdmin.pm +++ b/lib/Sietima/Role/WithAdmin.pm @@ -4,6 +4,35 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; +=head1 NAME + +Sietima::Role::WithAdmin - role for lists with an owner / admin + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('WithAdmin')->new({ + %args, + admin => 'listmaster@example.com', + }); + +=head1 DESCRIPTION + +This role adds an L<< /C >> attribute, and exposes it via the +L<< C|Sietima/list_addresses >> method. + +On its own, this role is not very useful, but other roles (like L<< +C|Sietima::Role::SubscriberOnly::Moderate +>>) can have uses for an admin / owner address. + +=head1 ATTRIBUTES + +=head2 C + +Required instance of L<< C >>, coercible from a +string. This is the address of the owner / admin of the list. + +=cut + has admin => ( is => 'ro', isa => Address, diff --git a/lib/Sietima/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm index 58fa731..a2ae07c 100644 --- a/lib/Sietima/Role/WithMailStore.pm +++ b/lib/Sietima/Role/WithMailStore.pm @@ -4,6 +4,40 @@ use Sietima::Policy; use Sietima::Types qw(MailStore MailStoreFromHashRef); use namespace::clean; +=head1 NAME + +Sietima::Role::WithMailStore - role for lists with a store for messages + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('WithMailStore')->new({ + %args, + mail_store => { + class => 'Sietima::MailStore::FS', + root => '/tmp', + }, + }); + +=head1 DESCRIPTION + +This role adds a L<< /C >> attribute. + +On its own, this role is not very useful, but other roles (like L<< +C|Sietima::Role::SubscriberOnly::Moderate +>>) can have uses for an object that can persistently store messages. + +=head1 ATTRIBUTES + +=head2 C + +Required instance of an object that consumes the L<< +C >> role. Instead of passing an instance, you can +pass a hashref (like in the L): the C key provides +the class name, and the rest of the hash will be passed to its +constructor. + +=cut + has mail_store => ( is => 'ro', isa => MailStore, diff --git a/lib/Sietima/Role/WithPostAddress.pm b/lib/Sietima/Role/WithPostAddress.pm new file mode 100644 index 0000000..79507ab --- /dev/null +++ b/lib/Sietima/Role/WithPostAddress.pm @@ -0,0 +1,52 @@ +package Sietima::Role::WithPostAddress; +use Moo::Role; +use Sietima::Policy; +use Sietima::Types qw(Address AddressFromStr); +use namespace::clean; + +=head1 NAME + +Sietima::Role::WithPostAddress - role for lists with a posting address + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('WithPostAddress')->new({ + %args, + return_path => 'list-bounce@example.com', + post_address => 'list@example.com', + }); + +=head1 DESCRIPTION + +This role adds an L<< /C >> attribute, and exposes it +via the L<< C|Sietima/list_addresses >> method. + +On its own, this role is not very useful, but other roles (like L<< +C|Sietima::Role::ReplyTo >>) can have uses for a post +address. + +=head1 ATTRIBUTES + +=head2 C + +An L<< C >> object, defaults to the value of the L<< +C|Sietima/return_path >> attribute. This is the address +that the mailing list receives messages at. + +=cut + +has post_address => ( + is => 'lazy', + isa => Address, + coerce => AddressFromStr, +); +sub _build_post_address($self) { $self->return_path } + +around list_addresses => sub($orig,$self) { + return +{ + $self->$orig->%*, + post => $self->post_address, + }; +}; + +1; -- cgit v1.2.3