diff options
| -rw-r--r-- | TODO.md | 9 | ||||
| -rw-r--r-- | lib/Sietima.pm | 6 | ||||
| -rw-r--r-- | lib/Sietima/Role/Headers.pm | 59 | ||||
| -rw-r--r-- | lib/Sietima/Role/WithAdmin.pm | 7 | ||||
| -rw-r--r-- | t/tests/sietima/role/headers.t | 56 |
5 files changed, 128 insertions, 9 deletions
@@ -4,12 +4,3 @@ * append to plain text single part * or add a plain text (or HTML?) part if multi-part * how do we deal with signed messages? -* list headers - * RFC 2919 `List-Id: $name <$post-address=~s/@/./>` - * RFC 2369 - * `List-Help: <mailto:$admin>` (if can `->admin`) - * `List-Owner: <mailto:$admin>` (if can `->admin`) - * `List-Unsubscribe: <mailto:$unsub_address>` (if we can (un)subscribe) - * `List-Subscribe: <mailto:$sub_address>` (if we can (un)subscribe) - * `List-Post: <mailto:$post_address>` - * `List-Archive: NO` (configurable) diff --git a/lib/Sietima.pm b/lib/Sietima.pm index 2a3c80b..6a7a83e 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -23,6 +23,12 @@ has return_path => ( coerce => AddressFromStr, ); +sub list_addresses($self) { + return +{ + return_path => $self->return_path, + }; +} + my $subscribers_array = ArrayRef[ Subscriber->plus_coercions( SubscriberFromAddress, diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm new file mode 100644 index 0000000..3a91c6f --- /dev/null +++ b/lib/Sietima/Role/Headers.pm @@ -0,0 +1,59 @@ +package Sietima::Role::Headers; +use Moo::Role; +use Try::Tiny; +use Sietima::Policy; +use Types::Standard qw(Str); +use namespace::clean; + +has name => ( + isa => Str, + is => 'ro', + required => 0, +); + +sub _add_headers_to($self,$message) { + my $addresses = $self->list_addresses; + my $mail = $message->mail; + + # see RFC 2919 "List-Id: A Structured Field and Namespace for the + # Identification of Mailing Lists" + my $return_path = delete $addresses->{return_path}; + if (my $name = $self->name) { + $mail->header_str_set( + 'List-Id', + sprintf '%s <%s>', $name,$return_path->address =~ s{\@}{.}r, + ); + } + + # little renaming + $addresses->{owner} = delete $addresses->{admin}; + + # if nobody declared a "post" address, let's guess it's the same + # as the address we send from + $addresses->{post} //= $return_path; + + for my $name (sort keys $addresses->%*) { + my $header_name = 'List-' . ucfirst($name =~ s{[^[:alnum:]]+}{-}gr); + my $address = $addresses->{$name}; + + # if it's not an Email::Address obect, we'll just take it as a + # string: it could be a non-mailto URI, see RFC 2369 "The Use + # of URLs as Meta-Syntax for Core Mail List Commands and their + # Transport through Message Header Fields" + + $mail->header_str_set( + $header_name => try { + sprintf '<mailto:%s>',$address->address + } catch { "$address" }, + ); + } + return; +} + +around munge_mail => sub ($orig,$self,$mail) { + my @messages = $self->$orig($mail); + $self->_add_headers_to($_) for @messages; + return @messages; +}; + +1; diff --git a/lib/Sietima/Role/WithAdmin.pm b/lib/Sietima/Role/WithAdmin.pm index 49b0f51..8293621 100644 --- a/lib/Sietima/Role/WithAdmin.pm +++ b/lib/Sietima/Role/WithAdmin.pm @@ -11,4 +11,11 @@ has admin => ( coerce => AddressFromStr, ); +around list_addresses => sub($orig,$self) { + return +{ + $self->$orig->%*, + admin => $self->admin, + }; +}; + 1; diff --git a/t/tests/sietima/role/headers.t b/t/tests/sietima/role/headers.t new file mode 100644 index 0000000..7b3e4b7 --- /dev/null +++ b/t/tests/sietima/role/headers.t @@ -0,0 +1,56 @@ +#!perl +use lib 't/lib'; +use Test::Sietima; + +package Sietima::Role::ForTesting { + use Moo::Role; + use Sietima::Policy; + use Sietima::Types qw(AddressFromStr); + + around list_addresses => sub($orig,$self) { + return { + $self->$orig->%*, + test1 => AddressFromStr->coerce('name <someone@example.com>'), + 'test+2' => 'http://test.example.com', + }; + }; +}; + +my $s = make_sietima( + with_traits => ['Headers','WithAdmin','ForTesting'], + name => 'test-list', + admin => 'admin@example.com', + subscribers => [ + 'one@users.example.com', + 'two@users.example.com', + ], +); + +subtest 'list headers should be added' => sub { + test_sending( + sietima => $s, + mails => [ + object { + call sub { +{ shift->header_str_pairs } } => hash { + field 'List-Id' => 'test-list <sietima-test.list.example.com>'; + field 'List-Owner' => '<mailto:admin@example.com>'; + field 'List-Post' => '<mailto:sietima-test@list.example.com>'; + field 'List-Test1' => '<mailto:someone@example.com>'; + field 'List-Test-2' => 'http://test.example.com'; + + field 'Date' => D(); + field 'MIME-Version' => D(); + field 'Content-Type' => D(); + field 'Content-Transfer-Encoding' => D(); + field 'From' => 'someone@users.example.com'; + field 'To' => 'sietima-test@list.example.com'; + field 'Subject' => 'Test Message'; + + end; + }; + }, + ], + ); +}; + +done_testing; |