diff options
36 files changed, 743 insertions, 363 deletions
@@ -1,3 +1,19 @@ +1.1.3 2025-02-09 13:41:46+00:00 Europe/London + - NoSpoof / NoSpoof::DMARC will no longer rewrite "from" addresses + belonging to the same domain as the list itself + +1.1.2 2023-03-31 16:51:00+01:00 Europe/London + - new role NoSpoof::DMARC, which replaces the From only when needed + +1.1.1 2023-02-28 13:02:33+00:00 Europe/London + - documentation fixes + - simplified SubscriberOnly::Moderate + +1.1.0 2023-02-28 11:56:27+00:00 Europe/London + - require perl 5.36 + - new role NoSpoof for better DMARC compliance + - bumped all dependencies to latest + 1.0.5 2019-04-29 15:44:26+01:00 Europe/London - *really* make it work with App::Spec 0.005 @@ -1,4 +1,4 @@ -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. @@ -12,7 +12,7 @@ b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- -This software is Copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is Copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software, licensed under: @@ -270,110 +270,143 @@ necessary. Here a sample; alter the names: That's all there is to it! ---- The Artistic License 1.0 --- +--- The Perl Artistic License 1.0 --- -This software is Copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is Copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software, licensed under: - The Artistic License 1.0 + The Perl Artistic License 1.0 -The Artistic License -Preamble -The intent of this document is to state the conditions under which a Package -may be copied, such that the Copyright Holder maintains some semblance of -artistic control over the development of the package, while giving the users of -the package the right to use and distribute the Package in a more-or-less -customary fashion, plus the right to make reasonable modifications. + + + The "Artistic License" + + Preamble + +The intent of this document is to state the conditions under which a +Package may be copied, such that the Copyright Holder maintains some +semblance of artistic control over the development of the package, +while giving the users of the package the right to use and distribute +the Package in a more-or-less customary fashion, plus the right to make +reasonable modifications. Definitions: - - "Package" refers to the collection of files distributed by the Copyright - Holder, and derivatives of that collection of files created through - textual modification. - - "Standard Version" refers to such a Package if it has not been modified, - or has been modified in accordance with the wishes of the Copyright - Holder. - - "Copyright Holder" is whoever is named in the copyright or copyrights for - the package. - - "You" is you, if you're thinking about copying or distributing this Package. - - "Reasonable copying fee" is whatever you can justify on the basis of media - cost, duplication charges, time of people involved, and so on. (You will - not be required to justify it to the Copyright Holder, but only to the - computing community at large as a market that must bear the fee.) - - "Freely Available" means that no fee is charged for the item itself, though - there may be fees involved in handling the item. It also means that - recipients of the item may redistribute it under the same conditions they - received it. + "Package" refers to the collection of files distributed by the + Copyright Holder, and derivatives of that collection of files + created through textual modification. + + "Standard Version" refers to such a Package if it has not been + modified, or has been modified in accordance with the wishes + of the Copyright Holder as specified below. + + "Copyright Holder" is whoever is named in the copyright or + copyrights for the package. + + "You" is you, if you're thinking about copying or distributing + this Package. + + "Reasonable copying fee" is whatever you can justify on the + basis of media cost, duplication charges, time of people involved, + and so on. (You will not be required to justify it to the + Copyright Holder, but only to the computing community at large + as a market that must bear the fee.) + + "Freely Available" means that no fee is charged for the item + itself, though there may be fees involved in handling the item. + It also means that recipients of the item may redistribute it + under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. -2. You may apply bug fixes, portability fixes and other modifications derived -from the Public Domain or from the Copyright Holder. A Package modified in such -a way shall still be considered the Standard Version. +2. You may apply bug fixes, portability fixes and other modifications +derived from the Public Domain or from the Copyright Holder. A Package +modified in such a way shall still be considered the Standard Version. -3. You may otherwise modify your copy of this Package in any way, provided that -you insert a prominent notice in each changed file stating how and when you -changed that file, and provided that you do at least ONE of the following: +3. You may otherwise modify your copy of this Package in any way, provided +that you insert a prominent notice in each changed file stating how and +when you changed that file, and provided that you do at least ONE of the +following: - a) place your modifications in the Public Domain or otherwise make them - Freely Available, such as by posting said modifications to Usenet or an - equivalent medium, or placing the modifications on a major archive site - such as ftp.uu.net, or by allowing the Copyright Holder to include your - modifications in the Standard Version of the Package. + a) place your modifications in the Public Domain or otherwise make them + Freely Available, such as by posting said modifications to Usenet or + an equivalent medium, or placing the modifications on a major archive + site such as uunet.uu.net, or by allowing the Copyright Holder to include + your modifications in the Standard Version of the Package. - b) use the modified Package only within your corporation or organization. + b) use the modified Package only within your corporation or organization. - c) rename any non-standard executables so the names do not conflict with - standard executables, which must also be provided, and provide a separate - manual page for each non-standard executable that clearly documents how it - differs from the Standard Version. + c) rename any non-standard executables so the names do not conflict + with standard executables, which must also be provided, and provide + a separate manual page for each non-standard executable that clearly + documents how it differs from the Standard Version. - d) make other distribution arrangements with the Copyright Holder. + d) make other distribution arrangements with the Copyright Holder. -4. You may distribute the programs of this Package in object code or executable -form, provided that you do at least ONE of the following: +4. You may distribute the programs of this Package in object code or +executable form, provided that you do at least ONE of the following: - a) distribute a Standard Version of the executables and library files, - together with instructions (in the manual page or equivalent) on where to - get the Standard Version. + a) distribute a Standard Version of the executables and library files, + together with instructions (in the manual page or equivalent) on where + to get the Standard Version. - b) accompany the distribution with the machine-readable source of the Package - with your modifications. + b) accompany the distribution with the machine-readable source of + the Package with your modifications. - c) accompany any non-standard executables with their corresponding Standard - Version executables, giving the non-standard executables non-standard - names, and clearly documenting the differences in manual pages (or - equivalent), together with instructions on where to get the Standard - Version. + c) give non-standard executables non-standard names, and clearly + document the differences in manual pages (or equivalent), together + with instructions on where to get the Standard Version. - d) make other distribution arrangements with the Copyright Holder. + d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this -Package. You may charge any fee you choose for support of this Package. You -may not charge a fee for this Package itself. However, you may distribute this -Package in aggregate with other (possibly commercial) programs as part of a -larger (possibly commercial) software distribution provided that you do not -advertise this Package as a product of your own. - -6. The scripts and library files supplied as input to or produced as output -from the programs of this Package do not automatically fall under the copyright -of this Package, but belong to whomever generated them, and may be sold -commercially, and may be aggregated with this Package. - -7. C or perl subroutines supplied by you and linked into this Package shall not -be considered part of this Package. - -8. The name of the Copyright Holder may not be used to endorse or promote +Package. You may charge any fee you choose for support of this +Package. You may not charge a fee for this Package itself. However, +you may distribute this Package in aggregate with other (possibly +commercial) programs as part of a larger (possibly commercial) software +distribution provided that you do not advertise this Package as a +product of your own. You may embed this Package's interpreter within +an executable of yours (by linking); this shall be construed as a mere +form of aggregation, provided that the complete Standard Version of the +interpreter is so embedded. + +6. The scripts and library files supplied as input to or produced as +output from the programs of this Package do not automatically fall +under the copyright of this Package, but belong to whoever generated +them, and may be sold commercially, and may be aggregated with this +Package. If such scripts or library files are aggregated with this +Package via the so-called "undump" or "unexec" methods of producing a +binary executable image, then distribution of such an image shall +neither be construed as a distribution of this Package nor shall it +fall under the restrictions of Paragraphs 3 and 4, provided that you do +not represent such an executable image as a Standard Version of this +Package. + +7. C subroutines (or comparably compiled subroutines in other +languages) supplied by you and linked into this Package in order to +emulate subroutines and variables of the language defined by this +Package shall not be considered part of this Package, but are the +equivalent of input as in Paragraph 6, provided these subroutines do +not change the language in any way that would cause it to fail the +regression tests for the language. + +8. Aggregation of this Package with a commercial distribution is always +permitted provided that the use of this Package is embedded; that is, +when no overt attempt is made to make this Package's interfaces visible +to the end user of the commercial distribution. Such use shall not be +construed as a distribution of this Package. + +9. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. -9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED -WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF -MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. +10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -The End + The End @@ -1,4 +1,4 @@ -# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. +# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.032. Changes LICENSE MANIFEST @@ -19,6 +19,8 @@ lib/Sietima/Role/Debounce.pm lib/Sietima/Role/Headers.pm lib/Sietima/Role/ManualSubscription.pm lib/Sietima/Role/NoMail.pm +lib/Sietima/Role/NoSpoof.pm +lib/Sietima/Role/NoSpoof/DMARC.pm lib/Sietima/Role/ReplyTo.pm lib/Sietima/Role/SubjectTag.pm lib/Sietima/Role/SubscriberOnly.pm @@ -48,6 +50,8 @@ t/tests/sietima/role/debounce.t t/tests/sietima/role/headers.t t/tests/sietima/role/manualsubscription.t t/tests/sietima/role/nomail.t +t/tests/sietima/role/nospoof.t +t/tests/sietima/role/nospoof/dmarc.t t/tests/sietima/role/replyto.t t/tests/sietima/role/subject-tag.t t/tests/sietima/role/subscriberonly/drop.t @@ -4,7 +4,7 @@ "Gianni Ceccarelli <dakkar@thenautilus.net>" ], "dynamic_config" : 0, - "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", + "generated_by" : "Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], @@ -21,13 +21,13 @@ "prereqs" : { "configure" : { "requires" : { - "ExtUtils::MakeMaker" : "7.36" + "ExtUtils::MakeMaker" : "7.70" } }, "develop" : { "requires" : { - "Pod::Coverage::TrustPod" : "0.100005", - "Test::More" : "1.302164", + "Pod::Coverage::TrustPod" : "0.100006", + "Test::More" : "1.302209", "Test::NoTabs" : "2.02", "Test::Perl::Critic" : "1.04", "Test::Pod" : "1.52", @@ -36,43 +36,42 @@ }, "runtime" : { "requires" : { - "App::Spec" : "0.005", - "App::Spec::Run" : "0.005", - "Digest::SHA" : "6.02", - "Email::Address" : "1.912", - "Email::MIME" : "1.946", - "Email::Sender" : "1.300031", - "Email::Sender::Simple" : "1.300031", - "Email::Stuffer" : "0.017", - "List::AllUtils" : "0.15", - "Moo" : "2.003004", - "Moo::Role" : "2.003004", + "App::Spec" : "0.013", + "App::Spec::Run" : "0.013", + "Digest::SHA" : "6.04", + "Email::Address" : "1.913", + "Email::MIME" : "1.954", + "Email::Sender::Simple" : "2.601", + "Email::Stuffer" : "0.020", + "List::AllUtils" : "0.19", + "Mail::DMARC::PurePerl" : "1.20250203", + "Moo" : "2.005005", + "Moo::Role" : "2.005005", "MooX::Traits" : "0.005", - "Try::Tiny" : "0.30", - "Type::Library" : "1.004004", - "Type::Params" : "1.004004", - "Type::Utils" : "1.004004", + "Type::Library" : "2.006000", + "Type::Params" : "2.006000", + "Type::Utils" : "2.006000", "Types::Path::Tiny" : "0.006", - "Types::Standard" : "1.004004", - "Types::URI" : "0.006", - "experimental" : "0.020", - "feature" : "1.42", + "Types::Standard" : "2.006000", + "Types::URI" : "0.007", + "feature" : "1.89", "namespace::clean" : "0.27", - "perl" : "5.024", - "strict" : "1.11", - "warnings" : "1.36" + "perl" : "v5.36.0", + "strict" : "1.13", + "warnings" : "1.70" } }, "test" : { "requires" : { - "Data::Printer" : "0.40", - "Email::Sender::Transport::Test" : "1.300031", + "Data::Printer" : "1.002001", + "Email::Sender::Transport::Test" : "2.601", "Import::Into" : "1.002005", - "Path::Tiny" : "0.108", - "Test2::API" : "1.302164", - "Test2::V0" : "0.000120", - "URI" : "1.76", - "lib" : "0.63" + "Net::DNS::Resolver::Mock" : "1.20230216", + "Path::Tiny" : "0.146", + "Test2::API" : "1.302209", + "Test2::V0" : "1.302209", + "URI" : "5.31", + "lib" : "0.65" } } }, @@ -85,8 +84,9 @@ "web" : "https://www.thenautilus.net/cgit/Sietima" } }, - "version" : "1.0.5", - "x_generated_by_perl" : "v5.24.0", - "x_serialization_backend" : "Cpanel::JSON::XS version 4.11" + "version" : "1.1.3", + "x_generated_by_perl" : "v5.40.0", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.38", + "x_spdx_expression" : "Artistic-1.0-Perl OR GPL-1.0-or-later" } @@ -3,18 +3,19 @@ abstract: 'minimal mailing list manager' author: - 'Gianni Ceccarelli <dakkar@thenautilus.net>' build_requires: - Data::Printer: '0.40' - Email::Sender::Transport::Test: '1.300031' + Data::Printer: '1.002001' + Email::Sender::Transport::Test: '2.601' Import::Into: '1.002005' - Path::Tiny: '0.108' - Test2::API: '1.302164' - Test2::V0: '0.000120' - URI: '1.76' - lib: '0.63' + Net::DNS::Resolver::Mock: '1.20230216' + Path::Tiny: '0.146' + Test2::API: '1.302209' + Test2::V0: '1.302209' + URI: '5.31' + lib: '0.65' configure_requires: - ExtUtils::MakeMaker: '7.36' + ExtUtils::MakeMaker: '7.70' dynamic_config: 0 -generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' +generated_by: 'Dist::Zilla version 6.032, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -24,34 +25,33 @@ no_index: directory: - t/lib requires: - App::Spec: '0.005' - App::Spec::Run: '0.005' - Digest::SHA: '6.02' - Email::Address: '1.912' - Email::MIME: '1.946' - Email::Sender: '1.300031' - Email::Sender::Simple: '1.300031' - Email::Stuffer: '0.017' - List::AllUtils: '0.15' - Moo: '2.003004' - Moo::Role: '2.003004' + App::Spec: '0.013' + App::Spec::Run: '0.013' + Digest::SHA: '6.04' + Email::Address: '1.913' + Email::MIME: '1.954' + Email::Sender::Simple: '2.601' + Email::Stuffer: '0.020' + List::AllUtils: '0.19' + Mail::DMARC::PurePerl: '1.20250203' + Moo: '2.005005' + Moo::Role: '2.005005' MooX::Traits: '0.005' - Try::Tiny: '0.30' - Type::Library: '1.004004' - Type::Params: '1.004004' - Type::Utils: '1.004004' + Type::Library: '2.006000' + Type::Params: '2.006000' + Type::Utils: '2.006000' Types::Path::Tiny: '0.006' - Types::Standard: '1.004004' - Types::URI: '0.006' - experimental: '0.020' - feature: '1.42' + Types::Standard: '2.006000' + Types::URI: '0.007' + feature: '1.89' namespace::clean: '0.27' - perl: '5.024' - strict: '1.11' - warnings: '1.36' + perl: v5.36.0 + strict: '1.13' + warnings: '1.70' resources: homepage: https://www.thenautilus.net/SW/Sietima/ repository: https://www.thenautilus.net/cgit/Sietima -version: 1.0.5 -x_generated_by_perl: v5.24.0 -x_serialization_backend: 'YAML::Tiny version 1.73' +version: 1.1.3 +x_generated_by_perl: v5.40.0 +x_serialization_backend: 'YAML::Tiny version 1.74' +x_spdx_expression: 'Artistic-1.0-Perl OR GPL-1.0-or-later' diff --git a/Makefile.PL b/Makefile.PL index c8a3a78..16fb39e 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,8 +1,8 @@ -# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.032. use strict; use warnings; -use 5.024; +use 5.036000; use ExtUtils::MakeMaker 7.30; @@ -10,88 +10,86 @@ my %WriteMakefileArgs = ( "ABSTRACT" => "minimal mailing list manager", "AUTHOR" => "Gianni Ceccarelli <dakkar\@thenautilus.net>", "CONFIGURE_REQUIRES" => { - "ExtUtils::MakeMaker" => "7.36" + "ExtUtils::MakeMaker" => "7.70" }, "DISTNAME" => "Sietima", "LICENSE" => "perl", - "MIN_PERL_VERSION" => "5.024", + "MIN_PERL_VERSION" => "5.036000", "NAME" => "Sietima", "PREREQ_PM" => { - "App::Spec" => "0.005", - "App::Spec::Run" => "0.005", - "Digest::SHA" => "6.02", - "Email::Address" => "1.912", - "Email::MIME" => "1.946", - "Email::Sender" => "1.300031", - "Email::Sender::Simple" => "1.300031", - "Email::Stuffer" => "0.017", - "List::AllUtils" => "0.15", - "Moo" => "2.003004", - "Moo::Role" => "2.003004", + "App::Spec" => "0.013", + "App::Spec::Run" => "0.013", + "Digest::SHA" => "6.04", + "Email::Address" => "1.913", + "Email::MIME" => "1.954", + "Email::Sender::Simple" => "2.601", + "Email::Stuffer" => "0.020", + "List::AllUtils" => "0.19", + "Mail::DMARC::PurePerl" => "1.20250203", + "Moo" => "2.005005", + "Moo::Role" => "2.005005", "MooX::Traits" => "0.005", - "Try::Tiny" => "0.30", - "Type::Library" => "1.004004", - "Type::Params" => "1.004004", - "Type::Utils" => "1.004004", + "Type::Library" => "2.006000", + "Type::Params" => "2.006000", + "Type::Utils" => "2.006000", "Types::Path::Tiny" => "0.006", - "Types::Standard" => "1.004004", - "Types::URI" => "0.006", - "experimental" => "0.020", - "feature" => "1.42", + "Types::Standard" => "2.006000", + "Types::URI" => "0.007", + "feature" => "1.89", "namespace::clean" => "0.27", - "strict" => "1.11", - "warnings" => "1.36" + "strict" => "1.13", + "warnings" => "1.70" }, "TEST_REQUIRES" => { - "Data::Printer" => "0.40", - "Email::Sender::Transport::Test" => "1.300031", + "Data::Printer" => "1.002001", + "Email::Sender::Transport::Test" => "2.601", "Import::Into" => "1.002005", - "Path::Tiny" => "0.108", - "Test2::API" => "1.302164", - "Test2::V0" => "0.000120", - "URI" => "1.76", - "lib" => "0.63" + "Net::DNS::Resolver::Mock" => "1.20230216", + "Path::Tiny" => "0.146", + "Test2::API" => "1.302209", + "Test2::V0" => "1.302209", + "URI" => "5.31", + "lib" => "0.65" }, - "VERSION" => "1.0.5", + "VERSION" => "1.1.3", "test" => { - "TESTS" => "t/*.t t/tests/*.t t/tests/sietima/*.t t/tests/sietima/multi-role/*.t t/tests/sietima/role/*.t t/tests/sietima/role/subscriberonly/*.t" + "TESTS" => "t/*.t t/tests/*.t t/tests/sietima/*.t t/tests/sietima/multi-role/*.t t/tests/sietima/role/*.t t/tests/sietima/role/nospoof/*.t t/tests/sietima/role/subscriberonly/*.t" } ); my %FallbackPrereqs = ( - "App::Spec" => "0.005", - "App::Spec::Run" => "0.005", - "Data::Printer" => "0.40", - "Digest::SHA" => "6.02", - "Email::Address" => "1.912", - "Email::MIME" => "1.946", - "Email::Sender" => "1.300031", - "Email::Sender::Simple" => "1.300031", - "Email::Sender::Transport::Test" => "1.300031", - "Email::Stuffer" => "0.017", + "App::Spec" => "0.013", + "App::Spec::Run" => "0.013", + "Data::Printer" => "1.002001", + "Digest::SHA" => "6.04", + "Email::Address" => "1.913", + "Email::MIME" => "1.954", + "Email::Sender::Simple" => "2.601", + "Email::Sender::Transport::Test" => "2.601", + "Email::Stuffer" => "0.020", "Import::Into" => "1.002005", - "List::AllUtils" => "0.15", - "Moo" => "2.003004", - "Moo::Role" => "2.003004", + "List::AllUtils" => "0.19", + "Mail::DMARC::PurePerl" => "1.20250203", + "Moo" => "2.005005", + "Moo::Role" => "2.005005", "MooX::Traits" => "0.005", - "Path::Tiny" => "0.108", - "Test2::API" => "1.302164", - "Test2::V0" => "0.000120", - "Try::Tiny" => "0.30", - "Type::Library" => "1.004004", - "Type::Params" => "1.004004", - "Type::Utils" => "1.004004", + "Net::DNS::Resolver::Mock" => "1.20230216", + "Path::Tiny" => "0.146", + "Test2::API" => "1.302209", + "Test2::V0" => "1.302209", + "Type::Library" => "2.006000", + "Type::Params" => "2.006000", + "Type::Utils" => "2.006000", "Types::Path::Tiny" => "0.006", - "Types::Standard" => "1.004004", - "Types::URI" => "0.006", - "URI" => "1.76", - "experimental" => "0.020", - "feature" => "1.42", - "lib" => "0.63", + "Types::Standard" => "2.006000", + "Types::URI" => "0.007", + "URI" => "5.31", + "feature" => "1.89", + "lib" => "0.65", "namespace::clean" => "0.27", - "strict" => "1.11", - "warnings" => "1.36" + "strict" => "1.13", + "warnings" => "1.70" ); diff --git a/lib/Sietima.pm b/lib/Sietima.pm index a5d22d9..3152ac8 100644 --- a/lib/Sietima.pm +++ b/lib/Sietima.pm @@ -1,8 +1,8 @@ package Sietima; use Moo; use Sietima::Policy; -use Types::Standard qw(ArrayRef Object FileHandle Maybe); -use Type::Params qw(compile); +use Types::Standard qw(ArrayRef Object); +use Type::Params -sigs; use Sietima::Types qw(Address AddressFromStr EmailMIME Message Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef @@ -10,12 +10,11 @@ use Sietima::Types qw(Address AddressFromStr use Sietima::Message; use Sietima::Subscriber; use Email::Sender::Simple qw(); -use Email::Sender; use Email::Address; use namespace::clean; with 'MooX::Traits'; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: minimal mailing list manager @@ -58,9 +57,11 @@ sub handle_mail_from_stdin($self,@) { } +signature_for handle_mail => ( + method => Object, + positional => [ EmailMIME ], +); sub handle_mail($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - my (@outgoing_messages) = $self->munge_mail($incoming_mail); for my $outgoing_message (@outgoing_messages) { $self->send_message($outgoing_message); @@ -69,16 +70,20 @@ sub handle_mail($self,$incoming_mail) { } +signature_for subscribers_to_send_to => ( + method => Object, + positional => [ EmailMIME ], +); sub subscribers_to_send_to($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - return $self->subscribers; } +signature_for munge_mail => ( + method => Object, + positional => [ EmailMIME ], +); sub munge_mail($self,$incoming_mail) { - state $check = compile(Object,EmailMIME); $check->(@_); - return Sietima::Message->new({ mail => $incoming_mail, from => $self->return_path, @@ -87,9 +92,11 @@ sub munge_mail($self,$incoming_mail) { } +signature_for send_message => ( + method => Object, + positional => [ Message ], +); sub send_message($self,$outgoing_message) { - state $check = compile(Object,Message); $check->(@_); - my $envelope = $outgoing_message->envelope; if ($envelope->{to} && $envelope->{to}->@*) { $self->transport->send( @@ -138,7 +145,7 @@ Sietima - minimal mailing list manager =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -188,6 +195,10 @@ specifies that to (un)subscribe, people should write to the list owner avoids sending messages to subscribers who don't want them +=item L<< C<NoSpoof>|Sietima::Role::NoSpoof >> + +replaces the C<From> address with the list's own address + =item L<< C<ReplyTo>|Sietima::Role::ReplyTo >> optionally sets the C<Reply-To> header to the mailing list address @@ -231,7 +242,7 @@ empty array. Each item can be coerced from a string or a L<< C<Email::Address> >> instance, or a hashref of the form - { address => $string, %other_attributes } + { primary => $string, %other_attributes } The base Sietima class only uses the address of subscribers, but some roles use the other attributes (L<< C<NoMail>|Sietima::Role::NoMail @@ -343,7 +354,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/CmdLine.pm b/lib/Sietima/CmdLine.pm index a3a7583..68bc75c 100644 --- a/lib/Sietima/CmdLine.pm +++ b/lib/Sietima/CmdLine.pm @@ -8,7 +8,7 @@ use App::Spec; use Sietima::Runner; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: run Sietima as a command-line application @@ -83,7 +83,7 @@ Sietima::CmdLine - run Sietima as a command-line application =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -169,7 +169,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/HeaderURI.pm b/lib/Sietima/HeaderURI.pm index 323b075..9834f62 100644 --- a/lib/Sietima/HeaderURI.pm +++ b/lib/Sietima/HeaderURI.pm @@ -3,12 +3,12 @@ use Moo; use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr is_Address); use Types::Standard qw(Str is_Str ClassName HashRef Optional); -use Type::Params qw(compile); +use Type::Params -sigs; use Types::URI qw(Uri is_Uri); use Email::Address; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: annotated URI for list headers @@ -26,10 +26,7 @@ has comment => ( ); -sub _args_from_address { - my ($address, $query) = @_; - $query ||= {}; - +sub _args_from_address($address, $query={}) { my $uri = URI->new($address->address,'mailto'); $uri->query_form($query->%*); @@ -44,8 +41,7 @@ sub _args_from_address { }; } -around BUILDARGS => sub { - my ($orig, $class, @args) = @_; +around BUILDARGS => sub($orig, $class, @args) { if (@args != 1 or ref($args[0]) eq 'HASH' and $args[0]->{uri}) { return $class->$orig(@args); } @@ -66,21 +62,19 @@ around BUILDARGS => sub { }; -sub new_from_address { - state $check = compile( - ClassName, +signature_for new_from_address => ( + method => Str, + positional => [ Address->plus_coercions(AddressFromStr), Optional[HashRef], - ); - my ($class, $address, $query) = $check->(@_); - + ], +); +sub new_from_address($class, $address, $query={}) { return $class->new(_args_from_address($address,$query)); } -sub as_header_raw { - my ($self) = @_; - +sub as_header_raw($self) { my $str = sprintf '<%s>',$self->uri; if (my $c = $self->comment) { $str .= sprintf ' (%s)',$c; @@ -103,7 +97,7 @@ Sietima::HeaderURI - annotated URI for list headers =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -226,7 +220,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm index 543ff43..74d5ce4 100644 --- a/lib/Sietima/MailStore.pm +++ b/lib/Sietima/MailStore.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: interface for mail stores @@ -25,7 +25,7 @@ Sietima::MailStore - interface for mail stores =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 DESCRIPTION @@ -89,7 +89,7 @@ return an arrayref of hashrefs. For example: my $id2 = $ms->store($msg2,'t2'); my $id3 = $ms->store($msg3,'t1','t2'); - $ms->retrieve_ids_by_tags('t1') ==> [ + $ms->retrieve_by_tags('t1') ==> [ { id => $id3, mail => $msg3 }, { id => $id1, mail => $msg1 }, ] @@ -115,7 +115,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm index b829a0a..6479ea3 100644 --- a/lib/Sietima/MailStore/FS.pm +++ b/lib/Sietima/MailStore/FS.pm @@ -2,13 +2,13 @@ package Sietima::MailStore::FS; use Moo; use Sietima::Policy; use Types::Path::Tiny qw(Dir); -use Types::Standard qw(Object ArrayRef Str slurpy); -use Type::Params qw(compile); +use Types::Standard qw(Object ArrayRef Str Slurpy); +use Type::Params -sigs; use Sietima::Types qw(EmailMIME TagName); use Digest::SHA qw(sha1_hex); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: filesystem-backed email store @@ -32,23 +32,31 @@ sub BUILD($self,@) { } -sub store($self,$mail,@tags) { - state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$check->(@_); +signature_for store => ( + method => Object, + positional => [ + EmailMIME, + Slurpy[ArrayRef[TagName]], + ], +); +sub store($self,$mail,$tags) { my $str = $mail->as_string; my $id = sha1_hex($str); $self->_msgdir->child($id)->spew_raw($str); - $self->_tagdir->child($_)->append("$id\n") for @tags; + $self->_tagdir->child($_)->append("$id\n") for $tags->@*; return $id; } +signature_for retrieve_by_id => ( + method => Object, + positional => [ Str ], +); sub retrieve_by_id($self,$id) { - state $check = compile(Object,Str);$check->(@_); - my $msg_path = $self->_msgdir->child($id); return unless -e $msg_path; return Email::MIME->new($msg_path->slurp_raw); @@ -61,13 +69,17 @@ sub _tagged_by($self,$tag) { return $tag_file->lines({chomp=>1}); } -sub retrieve_ids_by_tags($self,@tags) { - state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_); - +signature_for retrieve_ids_by_tags => ( + method => Object, + positional => [ + Slurpy[ArrayRef[TagName]], + ], +); +sub retrieve_ids_by_tags($self,$tags) { # this maps: id -> how many of the given @tags it has my %msgs; - if (@tags) { - for my $tag (@tags) { + if ($tags->@*) { + for my $tag ($tags->@*) { $_++ for @msgs{$self->_tagged_by($tag)}; } } @@ -79,18 +91,22 @@ sub retrieve_ids_by_tags($self,@tags) { for my $id (keys %msgs) { # if this message id does not have all the required tags, we # won't return it - next unless $msgs{$id} == @tags; + next unless $msgs{$id} == $tags->@*; push @ret, $id; } return \@ret; } -sub retrieve_by_tags($self,@tags) { - state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_); - +signature_for retrieve_by_tags => ( + method => Object, + positional => [ + Slurpy[ArrayRef[TagName]], + ], +); +sub retrieve_by_tags($self,$tags) { my @ret; - for my $id ($self->retrieve_ids_by_tags(@tags)->@*) { + for my $id ($self->retrieve_ids_by_tags($tags->@*)->@*) { push @ret, { id => $id, mail => $self->retrieve_by_id($id), @@ -101,9 +117,11 @@ sub retrieve_by_tags($self,@tags) { } +signature_for remove => ( + method => Object, + positional => [ Str ], +); sub remove($self,$id) { - state $check = compile(Object,Str);$check->(@_); - for my $tag_file ($self->_tagdir->children) { $tag_file->edit_lines( sub { $_='' if /\A\Q$id\E\n?\z/ } ); } @@ -132,7 +150,7 @@ Sietima::MailStore::FS - filesystem-backed email store =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -167,7 +185,7 @@ group-writable and group-sticky, and owned by that group: my $id = $store->store($email_mime_object,@tags); Stores the given email message inside the L<store root|/root>, and -associates with the given tags. +associates it with the given tags. Returns a unique identifier for the stored message. If you store twice the same message (or two messages that stringify identically), you'll @@ -203,7 +221,7 @@ returns an empty arrayref. This method is similar to L<< /C<retrieve_ids_by_tags> >>, but it returns an arrayref of hashrefs like: - $store->retrieve_ids_by_tags('t1') ==> [ + $store->retrieve_by_tags('t1') ==> [ { id => $id1, mail => $msg1 }, { id => $id2, mail => $msg2 }, ] @@ -230,7 +248,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Message.pm b/lib/Sietima/Message.pm index d5d2b04..3ced3f5 100644 --- a/lib/Sietima/Message.pm +++ b/lib/Sietima/Message.pm @@ -10,7 +10,7 @@ use Sietima::Subscriber; use Email::MIME; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: an email message with an envelope @@ -64,7 +64,7 @@ Sietima::Message - an email message with an envelope =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -117,7 +117,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Policy.pm b/lib/Sietima/Policy.pm index 5ac4b6f..68d7666 100644 --- a/lib/Sietima/Policy.pm +++ b/lib/Sietima/Policy.pm @@ -1,11 +1,10 @@ package Sietima::Policy; -use 5.024; +use v5.36; use strict; use warnings; -use feature ':5.24'; -use experimental 'signatures'; +use feature ':5.36'; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: pragma for Sietima modules @@ -14,8 +13,7 @@ sub import { # so no need for import::into strict->import; warnings->import; - experimental->import('signatures'); - feature->import(':5.24'); + feature->import(':5.36'); return; } @@ -33,15 +31,14 @@ Sietima::Policy - pragma for Sietima modules =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS - use 5.024; + use v5.36; use strict; use warnings; - use feature ':5.24'; - use experimental 'signatures'; + use feature ':5.36'; or just: @@ -58,7 +55,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm index 3fe6182..10df404 100644 --- a/lib/Sietima/Role/AvoidDups.pm +++ b/lib/Sietima/Role/AvoidDups.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Email::Address; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: prevent people from receiving the same message multiple times @@ -39,7 +39,7 @@ Sietima::Role::AvoidDups - prevent people from receiving the same message multip =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -65,7 +65,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm index 129fcff..a1ee547 100644 --- a/lib/Sietima/Role/Debounce.pm +++ b/lib/Sietima/Role/Debounce.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: avoid mail loops @@ -36,7 +36,7 @@ Sietima::Role::Debounce - avoid mail loops =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -65,7 +65,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm index 2547b70..f6ad9af 100644 --- a/lib/Sietima/Role/Headers.pm +++ b/lib/Sietima/Role/Headers.pm @@ -1,14 +1,12 @@ package Sietima::Role::Headers; use Moo::Role; -use Try::Tiny; use Sietima::Policy; use Sietima::HeaderURI; -use Email::Address; use Types::Standard qw(Str); use Sietima::Types qw(HeaderUriFromThings); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: adds standard list-related headers to messages @@ -89,7 +87,7 @@ Sietima::Role::Headers - adds standard list-related headers to messages =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -174,7 +172,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/ManualSubscription.pm b/lib/Sietima/Role/ManualSubscription.pm index ebda9c9..0b86642 100644 --- a/lib/Sietima/Role/ManualSubscription.pm +++ b/lib/Sietima/Role/ManualSubscription.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::HeaderURI; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: adds standard list-related headers to messages with 'Sietima::Role::WithOwner'; @@ -41,7 +41,7 @@ Sietima::Role::ManualSubscription - adds standard list-related headers to messag =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -74,7 +74,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/NoMail.pm b/lib/Sietima/Role/NoMail.pm index 6d46a3d..160650a 100644 --- a/lib/Sietima/Role/NoMail.pm +++ b/lib/Sietima/Role/NoMail.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: don't send mail to those who don't want it @@ -28,7 +28,7 @@ Sietima::Role::NoMail - don't send mail to those who don't want it =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -59,7 +59,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/NoSpoof.pm b/lib/Sietima/Role/NoSpoof.pm new file mode 100644 index 0000000..e26bed9 --- /dev/null +++ b/lib/Sietima/Role/NoSpoof.pm @@ -0,0 +1,69 @@ +package Sietima::Role::NoSpoof; +use Moo::Role; +use Sietima::Policy; +use Email::Address; +use namespace::clean; + +our $VERSION = '1.1.3'; # VERSION +# ABSTRACT: never sends out messages from subscribers' addresses + + +with 'Sietima::Role::WithPostAddress'; + +around munge_mail => sub ($orig,$self,$incoming_mail) { + my $sender = $self->post_address->address; + my ($from) = Email::Address->parse($incoming_mail->header_str('From')); + + if ($from->host ne $self->post_address->host) { + $from->address($sender); + + $incoming_mail->header_str_set( + From => $from, + ); + } + + return $self->$orig($incoming_mail); +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::NoSpoof - never sends out messages from subscribers' addresses + +=head1 VERSION + +version 1.1.3 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('NoSpoof')->new(\%args); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will replace the +C<From> address with its own L<< +C<post_address>|Sietima::Role::WithPostAddress >> (this is a +"sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress +>>) I<if> the C<From> is on a different domain. + +This will make the list DMARC-compliant. + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Sietima/Role/NoSpoof/DMARC.pm b/lib/Sietima/Role/NoSpoof/DMARC.pm new file mode 100644 index 0000000..78e382a --- /dev/null +++ b/lib/Sietima/Role/NoSpoof/DMARC.pm @@ -0,0 +1,124 @@ +package Sietima::Role::NoSpoof::DMARC; +use Moo::Role; +use Sietima::Policy; +use Email::Address; +use Mail::DMARC::PurePerl; +use namespace::clean; + +our $VERSION = '1.1.3'; # VERSION +# ABSTRACT: send out messages from subscribers' addresses only if DMARC allows it + + +with 'Sietima::Role::WithPostAddress'; + +# mostly for testing +has dmarc_resolver => ( is => 'ro' ); + +around munge_mail => sub ($orig,$self,$incoming_mail) { + my $sender = $self->post_address->address; + my ($from) = Email::Address->parse($incoming_mail->header_str('From')); + my $from_domain = $from->host; + + if ($from_domain ne $self->post_address->host) { + my $dmarc = Mail::DMARC::PurePerl->new( + resolver => $self->dmarc_resolver, + ); + $dmarc->header_from($from_domain); + + if (my $policy = $dmarc->discover_policy) { + # sp applies to sub-domains, defaults to p; p applies to + # the domain itself, and is required + my $relevant_value = $dmarc->is_subdomain + ? ( $policy->sp // $policy->p ) + : $policy->p; + + if ($relevant_value ne 'none') { + $incoming_mail->header_str_set( + 'Original-From' => $from, + ); + + $from->address($sender); + + $incoming_mail->header_str_set( + From => $from, + ); + + return $self->$orig($incoming_mail); + } + } + } + + $incoming_mail->header_str_set( + Sender => $sender, + ) if $sender ne $from->address; + + return $self->$orig($incoming_mail); + +}; + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Sietima::Role::NoSpoof::DMARC - send out messages from subscribers' addresses only if DMARC allows it + +=head1 VERSION + +version 1.1.3 + +=head1 SYNOPSIS + + my $sietima = Sietima->with_traits('NoSpoof::DMARC')->new(\%args); + +=head1 DESCRIPTION + +A L<< C<Sietima> >> list with this role applied will replace the +C<From> address with its own L<< +C<post_address>|Sietima::Role::WithPostAddress >> (this is a +"sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress +>>) I<if> the C<From> is on a different domain and the originating +address's DMARC policy requires it. + +This will make the list DMARC-compliant while minimising the changes +to the messages. + +The original C<From> address will be preserved in the C<Original-From> +header, as required by RFC 5703. + +=head2 Some more details + +DMARC requires L<"identifier +alignment"|https://datatracker.ietf.org/doc/html/rfc7489#section-3.1>, +essentially the C<MAIL FROM> (envelope) and the header C<From> must +have the same domain (or at least belong to the same "organisational +domain", i.e. be both under a common non-top-level domain, roughly). + +Therefore, a mailing list that forwards a message sent from a +DMARC-enabled domain, I<must> rewrite the C<From> header, otherwise +the message will be discarded by recipient servers. If the originating +domain does not publish a DMARC policy (or publishes a C<none> +policy), the mailing list can leave the C<From> as is, but should add +a C<Sender> header with the list's own address. + +This role does exactly that. + +=for Pod::Coverage dmarc_resolver + +=head1 AUTHOR + +Gianni Ceccarelli <dakkar@thenautilus.net> + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm index f790842..ca1c6fc 100644 --- a/lib/Sietima/Role/ReplyTo.pm +++ b/lib/Sietima/Role/ReplyTo.pm @@ -2,11 +2,10 @@ package Sietima::Role::ReplyTo; use Moo::Role; use Sietima::Policy; use Types::Standard qw(Bool); -use Sietima::Types qw(Address AddressFromStr); use List::AllUtils qw(part); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: munge the C<Reply-To> header @@ -77,7 +76,7 @@ Sietima::Role::ReplyTo - munge the C<Reply-To> header =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -142,7 +141,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm index ac3f71c..04e9b1c 100644 --- a/lib/Sietima/Role/SubjectTag.pm +++ b/lib/Sietima/Role/SubjectTag.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Types::Standard qw(Str); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: add a tag to messages' subjects @@ -40,7 +40,7 @@ Sietima::Role::SubjectTag - add a tag to messages' subjects =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -80,7 +80,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm index 41002f3..5502def 100644 --- a/lib/Sietima/Role/SubscriberOnly.pm +++ b/lib/Sietima/Role/SubscriberOnly.pm @@ -4,10 +4,10 @@ use Sietima::Policy; use Email::Address; use List::AllUtils qw(any); use Types::Standard qw(Object CodeRef); -use Type::Params qw(compile); +use Type::Params -sigs; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: base role for "closed" lists @@ -28,9 +28,11 @@ around munge_mail => sub ($orig,$self,$mail) { }; +signature_for ignoring_subscriberonly => ( + method => Object, + positional => [ CodeRef ], +); sub ignoring_subscriberonly($self,$code) { - state $check = compile(Object,CodeRef); $check->(@_); - local $let_it_pass = 1; return $code->($self); } @@ -49,7 +51,7 @@ Sietima::Role::SubscriberOnly - base role for "closed" lists =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -79,9 +81,10 @@ C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles. This method will be invoked from L<< C<munge_mail>|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<Sietima::Message> >> objects, just like C<munge_mail>. It can -also have side-effects, like forwarding the email to the owner of the -list. +of L<< C<Sietima::Message> >> objects, just like C<munge_mail>, for +example to forward the email to the owner of the list. It can also +have side-effects, like storing a copy of the message to approve +later. =head1 METHODS @@ -111,7 +114,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/SubscriberOnly/Drop.pm b/lib/Sietima/Role/SubscriberOnly/Drop.pm index bfe7afb..8991043 100644 --- a/lib/Sietima/Role/SubscriberOnly/Drop.pm +++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm @@ -3,7 +3,7 @@ use Moo::Role; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: drop messages from non-subscribers @@ -26,7 +26,7 @@ Sietima::Role::SubscriberOnly::Drop - drop messages from non-subscribers =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -55,7 +55,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/SubscriberOnly/Moderate.pm b/lib/Sietima/Role/SubscriberOnly/Moderate.pm index ec7454a..c141ca0 100644 --- a/lib/Sietima/Role/SubscriberOnly/Moderate.pm +++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm @@ -2,10 +2,9 @@ package Sietima::Role::SubscriberOnly::Moderate; use Moo::Role; use Sietima::Policy; use Email::Stuffer; -use Email::MIME; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: moderate messages from non-subscribers @@ -28,11 +27,12 @@ sub munge_mail_from_non_subscriber ($self,$mail) { # problems with encodings other than this encoding => '7bit', ); - $self->transport->send($notice->email,{ + + return Sietima::Message->new({ + mail => $notice->email, from => $self->return_path, to => [ $self->owner ], }); - return; } @@ -139,7 +139,7 @@ Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -177,8 +177,9 @@ owner|Sietima::Role::WithOwner/owner>. $sietima->resume($mail_id); -Given an identifier returned when L<storing|Sietima::MailStore/store> -an email, this method retrieves the email and re-processes it via L<< +Given the identifier returned when +L<storing|Sietima::MailStore/store>-ing an email, this method +retrieves the email and re-processes it via L<< C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly >>. This will make sure that the email is not caught again by the subscriber-only filter. @@ -187,8 +188,9 @@ subscriber-only filter. $sietima->drop($mail_id); -Given an identifier returned when L<storing|Sietima::MailStore/store> -an email, this method deletes the email from the store. +Given the identifier returned when +L<storing|Sietima::MailStore/store>-ing an email, this method deletes +the email from the store. =head2 C<list_mails_in_moderation_queue> @@ -280,7 +282,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm index c0cf995..6b71a7a 100644 --- a/lib/Sietima/Role/WithMailStore.pm +++ b/lib/Sietima/Role/WithMailStore.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(MailStore MailStoreFromHashRef); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: role for lists with a store for messages @@ -29,7 +29,7 @@ Sietima::Role::WithMailStore - role for lists with a store for messages =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -65,7 +65,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/WithOwner.pm b/lib/Sietima/Role/WithOwner.pm index 1793381..69d8637 100644 --- a/lib/Sietima/Role/WithOwner.pm +++ b/lib/Sietima/Role/WithOwner.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: role for lists with an owner @@ -37,7 +37,7 @@ Sietima::Role::WithOwner - role for lists with an owner =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -74,7 +74,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Role/WithPostAddress.pm b/lib/Sietima/Role/WithPostAddress.pm index 0e22e52..e52b59e 100644 --- a/lib/Sietima/Role/WithPostAddress.pm +++ b/lib/Sietima/Role/WithPostAddress.pm @@ -4,7 +4,7 @@ use Sietima::Policy; use Sietima::Types qw(Address AddressFromStr); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: role for lists with a posting address @@ -36,7 +36,7 @@ Sietima::Role::WithPostAddress - role for lists with a posting address =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 SYNOPSIS @@ -69,7 +69,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Runner.pm b/lib/Sietima/Runner.pm index 58e73ef..be79e34 100644 --- a/lib/Sietima/Runner.pm +++ b/lib/Sietima/Runner.pm @@ -3,7 +3,7 @@ use Moo; use Sietima::Policy; use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: C<App::Spec::Run> for Sietima @@ -32,7 +32,7 @@ Sietima::Runner - C<App::Spec::Run> for Sietima =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 DESCRIPTION @@ -52,7 +52,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Subscriber.pm b/lib/Sietima/Subscriber.pm index b888efb..cbaf4c2 100644 --- a/lib/Sietima/Subscriber.pm +++ b/lib/Sietima/Subscriber.pm @@ -2,13 +2,13 @@ package Sietima::Subscriber; use Moo; use Sietima::Policy; use Types::Standard qw(ArrayRef HashRef Object); -use Type::Params qw(compile); +use Type::Params -sigs; use Sietima::Types qw(Address AddressFromStr); use Email::Address; use List::AllUtils qw(any); use namespace::clean; -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: a subscriber to a mailing list @@ -41,12 +41,11 @@ has prefs => ( ); -sub match { - # we can't use the sub signature here, because we need the - # coercion - state $check = compile(Object,Address->plus_coercions(AddressFromStr)); - my ($self,$addr) = $check->(@_); - +signature_for match => ( + method => Object, + positional => [ Address->plus_coercions(AddressFromStr) ], +); +sub match($self,$addr) { return any { $addr->address eq $_->address } $self->primary, $self->aliases->@*; } @@ -66,7 +65,7 @@ Sietima::Subscriber - a subscriber to a mailing list =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 DESCRIPTION @@ -127,7 +126,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm index b5e8398..7b98e39 100644 --- a/lib/Sietima/Types.pm +++ b/lib/Sietima/Types.pm @@ -13,7 +13,7 @@ use Type::Library Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef Transport MailStore MailStoreFromHashRef); -our $VERSION = '1.0.5'; # VERSION +our $VERSION = '1.1.3'; # VERSION # ABSTRACT: type library for Sietima @@ -85,7 +85,7 @@ Sietima::Types - type library for Sietima =head1 VERSION -version 1.0.5 +version 1.1.3 =head1 DESCRIPTION @@ -194,7 +194,7 @@ Gianni Ceccarelli <dakkar@thenautilus.net> =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. +This software is copyright (c) 2025 by Gianni Ceccarelli <dakkar@thenautilus.net>. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. diff --git a/perlcritic.rc b/perlcritic.rc index f060909..80ab046 100644 --- a/perlcritic.rc +++ b/perlcritic.rc @@ -410,7 +410,7 @@ severity = 1 [ValuesAndExpressions::ProhibitSpecialLiteralHeredocTerminator] # Don't use strings like `v1.4' or `1.4.5' when including other modules. -[ValuesAndExpressions::ProhibitVersionStrings] +[-ValuesAndExpressions::ProhibitVersionStrings] # Require $VERSION to be a constant rather than a computed value. [ValuesAndExpressions::RequireConstantVersion] diff --git a/t/author-no-tabs.t b/t/author-no-tabs.t index 169b4c9..7898f4b 100644 --- a/t/author-no-tabs.t +++ b/t/author-no-tabs.t @@ -27,6 +27,8 @@ my @files = ( 'lib/Sietima/Role/Headers.pm', 'lib/Sietima/Role/ManualSubscription.pm', 'lib/Sietima/Role/NoMail.pm', + 'lib/Sietima/Role/NoSpoof.pm', + 'lib/Sietima/Role/NoSpoof/DMARC.pm', 'lib/Sietima/Role/ReplyTo.pm', 'lib/Sietima/Role/SubjectTag.pm', 'lib/Sietima/Role/SubscriberOnly.pm', @@ -51,6 +53,8 @@ my @files = ( 't/tests/sietima/role/headers.t', 't/tests/sietima/role/manualsubscription.t', 't/tests/sietima/role/nomail.t', + 't/tests/sietima/role/nospoof.t', + 't/tests/sietima/role/nospoof/dmarc.t', 't/tests/sietima/role/replyto.t', 't/tests/sietima/role/subject-tag.t', 't/tests/sietima/role/subscriberonly/drop.t', diff --git a/t/author-pod-coverage.t b/t/author-pod-coverage.t index 243340f..09473df 100644 --- a/t/author-pod-coverage.t +++ b/t/author-pod-coverage.t @@ -8,7 +8,8 @@ BEGIN { } # This file was automatically generated by Dist::Zilla::Plugin::PodCoverageTests. - +use strict; +use warnings; use Test::Pod::Coverage 1.08; use Pod::Coverage::TrustPod; diff --git a/t/tests/sietima/role/nospoof.t b/t/tests/sietima/role/nospoof.t new file mode 100644 index 0000000..b0ec622 --- /dev/null +++ b/t/tests/sietima/role/nospoof.t @@ -0,0 +1,41 @@ +#!perl +use lib 't/lib'; +use Test::Sietima; + +my $s = make_sietima( + with_traits => ['NoSpoof'], + subscribers => [ + 'one@users.example.com', + 'two@users.example.com', + ], +); + +my $return_path = $s->return_path; +my $return_path_address = $return_path->address; +my $return_path_host = $return_path->host; + +test_sending( + sietima => $s, + mail => { + from => 'a user <one@users.example.com>', + }, + mails => [ + object { + call [ header_str => 'from' ] => qq{"a user" <$return_path_address>}; + }, + ], +); + +test_sending( + sietima => $s, + mail => { + from => qq{a user <one\@$return_path_host>}, + }, + mails => [ + object { + call [ header_str => 'from' ] => qq{"a user" <one\@$return_path_host>}; + }, + ], +); + +done_testing; diff --git a/t/tests/sietima/role/nospoof/dmarc.t b/t/tests/sietima/role/nospoof/dmarc.t new file mode 100644 index 0000000..620268b --- /dev/null +++ b/t/tests/sietima/role/nospoof/dmarc.t @@ -0,0 +1,69 @@ +#!perl +use lib 't/lib'; +use Test::Sietima; +use Net::DNS::Resolver::Mock; + +my $resolver = Net::DNS::Resolver::Mock->new(); + +my $s = make_sietima( + with_traits => ['NoSpoof::DMARC'], + subscribers => [ + 'one@users.example.com', + ], + dmarc_resolver => $resolver, +); + +sub test_rewriting($from) { + subtest "$from should rewrite" => sub { + test_sending( + sietima => $s, + mail => { + from => "a user <$from>", + }, + mails => [ + object { + call [ header_str => 'from' ] => '"a user" <'.$s->return_path->address.'>'; + call [ header_str => 'original-from' ] => qq{"a user" <$from>}; + }, + ], + ); + } +} + +sub test_no_rewriting($from) { + subtest "$from should not rewrite" => sub { + test_sending( + sietima => $s, + mail => { + from => "a user <$from>", + }, + mails => [ + object { + call [ header_str => 'sender' ] => $s->return_path->address; + call [ header_str => 'from' ] => qq{"a user" <$from>}; + }, + ], + ); + } +} + +$resolver->zonefile_parse(<<'EOZ'); +_dmarc.none-none-pol.com 3600 TXT "v=DMARC1; p=none; sp=none; rua=mailto:foo@example.com" +_dmarc.none-q-pol.com 3600 TXT "v=DMARC1; p=none; sp=quarantine; rua=mailto:foo@example.com" +_dmarc.q-q-pol.com 3600 TXT "v=DMARC1; p=quarantine; sp=quarantine; rua=mailto:foo@example.com" +EOZ + +test_no_rewriting 'foo@none-none-pol.com'; +test_no_rewriting 'foo@sub.none-none-pol.com'; + +test_no_rewriting 'foo@none-q-pol.com'; +test_rewriting 'foo@sub.none-q-pol.com'; + +test_rewriting 'foo@q-q-pol.com'; +test_rewriting 'foo@sub.q-q-pol.com'; + +test_no_rewriting 'foo@example.com'; + +test_no_rewriting 'foo@' . $s->post_address->host; + +done_testing; |