From bfe7783fff0d2d85c4ace2519d1c0b39718c69c4 Mon Sep 17 00:00:00 2001
From: dakkar <dakkar@thenautilus.net>
Date: Tue, 28 Feb 2023 11:45:21 +0000
Subject: NoSpoof for DMARC compliance

---
 lib/Sietima/Role/NoSpoof.pm    | 41 +++++++++++++++++++++++++++++++++++++++++
 t/tests/sietima/role/nospoof.t | 25 +++++++++++++++++++++++++
 2 files changed, 66 insertions(+)
 create mode 100644 lib/Sietima/Role/NoSpoof.pm
 create mode 100644 t/tests/sietima/role/nospoof.t

diff --git a/lib/Sietima/Role/NoSpoof.pm b/lib/Sietima/Role/NoSpoof.pm
new file mode 100644
index 0000000..ba703cb
--- /dev/null
+++ b/lib/Sietima/Role/NoSpoof.pm
@@ -0,0 +1,41 @@
+package Sietima::Role::NoSpoof;
+use Moo::Role;
+use Sietima::Policy;
+use Email::Address;
+use namespace::clean;
+
+# VERSION
+# ABSTRACT: never sends out messages from subscribers' addresses
+
+=head1 SYNOPSIS
+
+  my $sietima = Sietima->with_traits('NoSpoof')->new(\%args);
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will replace the
+`From` address with its own L<<
+C<post_address>|Sietima::Role::WithPostAddress >> (this is a
+"sub-role" of L<< C<WithPostAddress>|Sietima::Role::WithPostAddress
+>>).
+
+This will make the list DMARC-compliant.
+
+=cut
+
+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'));
+
+    $from->address($sender);
+
+    $incoming_mail->header_str_set(
+        From => $from,
+    );
+
+    return $self->$orig($incoming_mail);
+};
+
+1;
diff --git a/t/tests/sietima/role/nospoof.t b/t/tests/sietima/role/nospoof.t
new file mode 100644
index 0000000..6f30635
--- /dev/null
+++ b/t/tests/sietima/role/nospoof.t
@@ -0,0 +1,25 @@
+#!perl
+use lib 't/lib';
+use Test::Sietima;
+
+my $s = make_sietima(
+    with_traits => ['NoSpoof'],
+    subscribers => [
+        'one@users.example.com',
+        'two@users.example.com',
+    ],
+);
+
+test_sending(
+    sietima => $s,
+    mail => {
+        from => 'a user <one@users.example.com>',
+    },
+    mails => [
+        object {
+            call [ header_str => 'from' ] => '"a user" <'.$s->return_path->address.'>';
+        },
+    ],
+);
+
+done_testing;
-- 
cgit v1.2.3