aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Sietima.pm330
-rw-r--r--lib/Sietima/CmdLine.pm150
-rw-r--r--lib/Sietima/MailStore.pm98
-rw-r--r--lib/Sietima/MailStore/FS.pm107
-rw-r--r--lib/Sietima/Message.pm103
-rw-r--r--lib/Sietima/Policy.pm41
-rw-r--r--lib/Sietima/Role/AvoidDups.pm48
-rw-r--r--lib/Sietima/Role/Debounce.pm48
-rw-r--r--lib/Sietima/Role/Headers.pm107
-rw-r--r--lib/Sietima/Role/NoMail.pm42
-rw-r--r--lib/Sietima/Role/ReplyTo.pm127
-rw-r--r--lib/Sietima/Role/SubjectTag.pm64
-rw-r--r--lib/Sietima/Role/SubscriberOnly.pm96
-rw-r--r--lib/Sietima/Role/SubscriberOnly/Drop.pm39
-rw-r--r--lib/Sietima/Role/SubscriberOnly/Moderate.pm242
-rw-r--r--lib/Sietima/Role/WithMailStore.pm48
-rw-r--r--lib/Sietima/Role/WithOwner.pm50
-rw-r--r--lib/Sietima/Role/WithPostAddress.pm52
-rw-r--r--lib/Sietima/Runner.pm33
-rw-r--r--lib/Sietima/Subscriber.pm114
-rw-r--r--lib/Sietima/Types.pm178
21 files changed, 2117 insertions, 0 deletions
diff --git a/lib/Sietima.pm b/lib/Sietima.pm
new file mode 100644
index 0000000..6cdf404
--- /dev/null
+++ b/lib/Sietima.pm
@@ -0,0 +1,330 @@
+package Sietima;
+use Moo;
+use Sietima::Policy;
+use Types::Standard qw(ArrayRef Object FileHandle Maybe);
+use Type::Params qw(compile);
+use Sietima::Types qw(Address AddressFromStr
+ EmailMIME Message
+ Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef
+ Transport);
+use Sietima::Message;
+use Sietima::Subscriber;
+use Email::Sender::Simple qw();
+use Email::Sender;
+use Email::Address;
+use namespace::clean;
+
+with 'MooX::Traits';
+
+=head1 NAME
+
+Sietima - minimal mailing list manager
+
+=head1 SYNOPSIS
+
+ use Sietima;
+
+ Sietima->new({
+ return_path => 'the-list@the-domain.tld',
+ subscribers => [ 'person@some.were', @etc ],
+ })->handle_mail_from_stdin;
+
+=head1 DESCRIPTION
+
+Sietima is a minimal mailing list manager written in modern Perl. It
+aims to be the spiritual successor of L<Siesta>.
+
+The base C<Sietima> class does very little: it just puts the email
+message from C<STDIN> into a new envelope using L<< /C<return_path> >>
+as sender and all the L<< /C<subscribers> >> addresses as recipients,
+and sends it.
+
+Additional behaviour is provided via traits / roles. This class
+consumes L<< C<MooX::Traits> >> to simplify composing roles:
+
+ Sietima->with_traits(qw(AvoidDups NoMail))->new(\%args);
+
+These are the traits provided with the default distribution:
+
+=over
+
+=item L<< C<AvoidDups>|Sietima::Role::AvoidDups >>
+
+prevents the sender from receiving copies of their own messages
+
+=item L<< C<Debounce>|Sietima::Role::Debounce >>
+
+avoids mail-loops using a C<X-Been-There> header
+
+=item L<< C<Headers>|Sietima::Role::Headers >>
+
+adds C<List-*> headers to all outgoing messages
+
+=item L<< C<NoMail>|Sietima::Role::NoMail >>
+
+avoids sending messages to subscribers who don't want them
+
+=item L<< C<ReplyTo>|Sietima::Role::ReplyTo >>
+
+optionally sets the C<Reply-To> header to the mailing list address
+
+=item L<< C<SubjectTag>|Sietima::Role::SubjectTag >>
+
+prepends a C<[tag]> to the subject header of outgoing messages that
+aren't already tagged
+
+=item L<< C<SubscriberOnly::Drop>|Sietima::Role::SubscriberOnly::Drop >>
+
+silently drops all messages coming from addresses not subscribed to
+the list
+
+=item L<< C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate >>
+
+holds messages coming from addresses not subscribed to the list for
+moderation, and provides commands to manage the moderation queue
+
+=back
+
+The only "configuration mechanism" currently supported is to
+initialise a C<Sietima> object in your driver script, passing all the
+needed values to the constructor. L<< C<Sietima::CmdLine> >> is the
+recommended way of doing that: it adds command-line parsing capability
+to Sietima.
+
+=head1 ATTRIBUTES
+
+=head2 C<return_path>
+
+A L<< C<Email::Address> >> instance, coerced from string if
+necessary. This is the address that Sietima will send messages
+I<from>.
+
+=cut
+
+has return_path => (
+ isa => Address,
+ is => 'ro',
+ required => 1,
+ coerce => AddressFromStr,
+);
+
+=head2 C<subscribers>
+
+An array-ref of L<< C<Sietima::Subscriber> >> objects, defaults to the
+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 }
+
+The base Sietima class only uses the address of subscribers, but some
+roles use the other attributes (L<< C<NoMail>|Sietima::Role::NoMail
+>>, for example, uses the C<prefs> attribute, and L<<
+C<SubscriberOnly> >> uses C<aliases> via L<<
+C<match>|Sietima::Subscriber/match >>)
+
+=cut
+
+my $subscribers_array = ArrayRef[
+ Subscriber->plus_coercions(
+ SubscriberFromAddress,
+ SubscriberFromStr,
+ SubscriberFromHashRef,
+ )
+];
+has subscribers => (
+ isa => $subscribers_array,
+ is => 'lazy',
+ coerce => $subscribers_array->coercion,
+);
+sub _build_subscribers { +[] }
+
+=head2 C<transport>
+
+A L<< C<Email::Sender::Transport> >> instance, which will be used to
+send messages. If not passed in, Sietima uses L<<
+C<Email::Sender::Simple> >>'s L<<
+C<default_transport>|Email::Sender::Simple/default_transport >>.
+
+=cut
+
+has transport => (
+ isa => Transport,
+ is => 'lazy',
+);
+sub _build_transport { Email::Sender::Simple->default_transport }
+
+=head1 METHODS
+
+=head2 C<handle_mail_from_stdin>
+
+ $sietima->handle_mail_from_stdin();
+
+This is the main entry-point when Sietima is invoked from a MTA. It
+will parse a L<< C<Email::MIME> >> object out of the standard input,
+then pass it to L<< /C<handle_mail> >> for processing.
+
+=cut
+
+sub handle_mail_from_stdin($self,@) {
+ my $mail_text = do { local $/; <> };
+ # we're hoping that, since we probably got called from an MTA/MDA,
+ # STDIN contains a well-formed email message, addressed to us
+ my $incoming_mail = Email::MIME->new(\$mail_text);
+ return $self->handle_mail($incoming_mail);
+}
+
+=head2 C<handle_mail>
+
+ $sietima->handle_mail($email_mime);
+
+Main driver method: converts the given email message into a list of
+L<< C<Sietima::Message> >> objects by calling L<< /C<munge_mail> >>,
+then sends each of them by calling L<< /C<send_message> >>.
+
+=cut
+
+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);
+ }
+ return;
+}
+
+=head2 C<subscribers_to_send_to>
+
+ my $subscribers_aref = $sietima->subscribers_to_send_to($email_mime);
+
+Returns an array-ref of L<< C<Sietima::Subscriber> >> objects that
+should receive copies of the given email message.
+
+In this base class, it just returns the value of the L<<
+/C<subscribers> >> attribute. Roles such as L<<
+C<AvoidDups>|Sietima::Role::AvoidDups >> modify this method to exclude
+some subscribers.
+
+=cut
+
+sub subscribers_to_send_to($self,$incoming_mail) {
+ state $check = compile(Object,EmailMIME); $check->(@_);
+
+ return $self->subscribers;
+}
+
+=head2 C<munge_mail>
+
+ my @messages = $sietima->munge_mail($email_mime);
+
+Returns a list of L<< C<Sietima::Message> >> objects representing the
+messages to send to subscribers, based on the given email message.
+
+In this base class, this method returns a single instance to send to
+all L<< /C<subscribers_to_send_to> >>, containing exactly the given
+email message.
+
+Roles such as L<< C<SubjectTag>|Sietima::Role::SubjectTag >> modify
+this method to alter the message.
+
+=cut
+
+sub munge_mail($self,$incoming_mail) {
+ state $check = compile(Object,EmailMIME); $check->(@_);
+
+ return Sietima::Message->new({
+ mail => $incoming_mail,
+ from => $self->return_path,
+ to => $self->subscribers_to_send_to($incoming_mail),
+ });
+}
+
+=head2 C<send_message>
+
+ $sietima->send_message($sietima_message);
+
+Sends the given L<< C<Sietima::Message> >> object via the L<<
+/C<transport> >>, but only if the message's
+L<envelope|Sietima::Message/envelope> specifies some recipients.
+
+=cut
+
+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(
+ $outgoing_message->mail,
+ $envelope,
+ );
+ }
+
+ return;
+}
+
+sub _trait_namespace { 'Sietima::Role' }
+
+=head2 C<list_addresses>
+
+ my $addresses_href = $sietima->list_addresses;
+
+Returns a hashref of L<< C<Email::Address> >> instances or strings,
+that declare various addresses related to this list.
+
+This base class declares only the L<< /C<return_path> >>, and does not
+use this method at all.
+
+The L<< C<Headers>|Sietima::Role::Headers >> role uses this to
+populate the various C<List-*> headers.
+
+=cut
+
+sub list_addresses($self) {
+ return +{
+ return_path => $self->return_path,
+ };
+}
+
+=head2 C<command_line_spec>
+
+ my $app_spec_data = $sietima->command_line_spec;
+
+Returns a hashref describing the command line processing for L<<
+C<App::Spec> >>. L<< C<Sietima::CmdLine> >> uses this to build the
+command line parser.
+
+This base class declares a single sub-command:
+
+=over
+
+=item C<send>
+
+Invokes the L<< /C<handle_mail_from_stdin> >> method.
+
+For example, in a C<.qmail> file:
+
+ |/path/to/sietima send
+
+=back
+
+Roles can extend this to provide additional sub-commands and options.
+
+=cut
+
+sub command_line_spec($self) {
+ return {
+ name => 'sietima',
+ title => 'a simple mailing list manager',
+ subcommands => {
+ send => {
+ op => 'handle_mail_from_stdin',
+ summary => 'send email from STDIN',
+ },
+ },
+ };
+}
+
+1;
diff --git a/lib/Sietima/CmdLine.pm b/lib/Sietima/CmdLine.pm
new file mode 100644
index 0000000..ee054d5
--- /dev/null
+++ b/lib/Sietima/CmdLine.pm
@@ -0,0 +1,150 @@
+package Sietima::CmdLine;
+use Moo;
+use Sietima::Policy;
+use Sietima::Types qw(SietimaObj);
+use Types::Standard qw(HashRef);
+use Sietima;
+use App::Spec;
+use Sietima::Runner;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::CmdLine - run Sietima as a command-line application
+
+=head1 SYNOPSIS
+
+ use Sietima::CmdLine;
+
+ Sietima::CmdLine->new({
+ traits => [qw(SubjectTag)],
+ args => {
+ return_path => 'list@example.net',
+ subject_tag => 'Test',
+ subscribers => \@addresses,
+ })->run;
+
+=head1 DESCRIPTION
+
+This class simplifies the creation of a L<< C<Sietima> >> object, and
+uses L<< C<App::Spec> >> to provide a command-line interface to it.
+
+=head1 ATTRIBUTES
+
+=head2 C<sietima>
+
+Required, an instance of L<< C<Sietima> >>. You can either construct
+it yourself, or use the L<simplified building provided by the
+constructor|/new>.
+
+=cut
+
+has sietima => (
+ is => 'ro',
+ required => 1,
+ isa => SietimaObj,
+);
+
+=head2 C<extra_spec>
+
+Optional hashref. Used inside L<< /C<app_spec> >>. If you're not
+familiar with L<< C<App::Spec> >>, you probably don't want to touch
+this.
+
+=cut
+
+has extra_spec => (
+ is => 'ro',
+ isa => HashRef,
+ default => sub { +{} },
+);
+
+=head1 METHODS
+
+=head2 C<new>
+
+ my $cmdline = Sietima::CmdLine->new({
+ sietima => Sietima->with_traits(qw(SubjectTag))->new({
+ return_path => 'list@example.net',
+ subject_tag => 'Test',
+ subscribers => \@addresses,
+ }),
+ });
+
+ my $cmdline = Sietima::CmdLine->new({
+ traits => [qw(SubjectTag)],
+ args => {
+ return_path => 'list@example.net',
+ subject_tag => 'Test',
+ subscribers => \@addresses,
+ });
+
+The constructor. In alternative to passing a L<< C<Sietima> >>
+instance, you can pass C<traits> and C<args>, and the instance will be
+built for you. The two calls above are equivalent.
+
+=cut
+
+sub BUILDARGS($class,@args) {
+ my $args = $class->next::method(@args);
+ $args->{sietima} //= do {
+ my $traits = delete $args->{traits} // [];
+ my $constructor_args = delete $args->{args} // {};
+ Sietima->with_traits($traits->@*)->new($constructor_args);
+ };
+ return $args;
+}
+
+=head2 C<app_spec>
+
+Returns an instance of L<< C<App::Spec> >>, built from the
+specification returned by calling L<<
+C<command_line_spec>|Sietima/command_line_spec >> on the L<<
+/C<sietima> >> object, modified by the L<< /C<extra_spec> >>. This
+method, and the C<extra_spec> attribute, are probably only interesting
+to people who are doing weird extensions.
+
+=cut
+
+has app_spec => (
+ is => 'lazy',
+ init_arg => undef,
+);
+
+sub _build_app_spec($self) {
+ my $spec_data = $self->sietima->command_line_spec();
+
+ return App::Spec->read({
+ $spec_data->%*,
+ $self->extra_spec->%*,
+ });
+}
+
+=head2 C<runner>
+
+Returns an instance of L<< C<Sietima::Runner> >>, built from the L<<
+/C<app_spec> >>.
+
+=head2 C<run>
+
+Delegates to the L<< /C<runner> >>'s L<< C<run>|App::Spec::Run/run >> method.
+
+Parser the command line arguments from C<@ARGV> and executes the
+appropriate action.
+
+=cut
+
+has runner => (
+ is => 'lazy',
+ init_arg => undef,
+ handles => [qw(run)],
+);
+
+sub _build_runner($self) {
+ return Sietima::Runner->new({
+ spec => $self->app_spec,
+ cmd => $self->sietima,
+ });
+}
+
+1;
diff --git a/lib/Sietima/MailStore.pm b/lib/Sietima/MailStore.pm
new file mode 100644
index 0000000..5e9aa82
--- /dev/null
+++ b/lib/Sietima/MailStore.pm
@@ -0,0 +1,98 @@
+package Sietima::MailStore;
+use Moo::Role;
+use Sietima::Policy;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::MailStore - interface for mail stores
+
+=head1 DESCRPITON
+
+This role defines the interface that all mail stores must adhere
+to. It does not provide any implementation.
+
+=head1 REQUIRED METHODS
+
+=head2 C<store>
+
+ my $id = $ms->store($email_mime_object,@tags);
+
+Must persistently store the given email message (as an L<<
+C<Email::Simple>> object or similar), associating it with the gives
+tags (which must be strings). Must returns a unique identifier for the
+stored message. It is acceptable if identical messages are
+indistinguishable by the storage.
+
+=head2 C<retrieve_by_id>
+
+ my $email_mime_object = $ms->retrieve_by_id($id);
+
+Given an identifier returned by L<< /C<store> >>, this method must
+return the email message (as an L<< C<Email::Simple> >> or L<<
+C<Email::MIME> >> object).
+
+If the message has been deleted, or the identifier is not recognised,
+this method must return C<undef> in scalar context.
+
+=head2 C<retrieve_ids_by_tags>
+
+ my @ids = $ms->retrieve_ids_by_tags(@tags)->@*;
+
+Given a list of tags (which must be strings), this method must return
+an arrayref containing the identifiers of all (and only) the messages
+that were stored associated with (at least) all those tags. The order
+of the returned identifiers is not important.
+
+If there are no messages associated with the given tags, this method
+must return an empty arrayref.
+
+For example:
+
+ my $id1 = $ms->store($msg1,'t1');
+ my $id2 = $ms->store($msg2,'t2');
+ my $id3 = $ms->store($msg3,'t1','t2');
+
+ $ms->retrieve_ids_by_tags('t1') ==> [ $id3, $id1 ]
+ $ms->retrieve_ids_by_tags('t2') ==> [ $id2, $id3 ]
+ $ms->retrieve_ids_by_tags('t1','t2') ==> [ $id3 ]
+ $ms->retrieve_ids_by_tags('t3') ==> [ ]
+
+=head2 C<retrieve_by_tags>
+
+ my @email_mime_objects = $ms->retrieve_by_tags(@tags)->@*;
+
+This method is similar to L<< /C<retrieve_ids_by_tags> >>, but it must
+return an arrayref of hashrefs. For example:
+
+ my $id1 = $ms->store($msg1,'t1');
+ my $id2 = $ms->store($msg2,'t2');
+ my $id3 = $ms->store($msg3,'t1','t2');
+
+ $ms->retrieve_ids_by_tags('t1') ==> [
+ { id => $id3, mail => $msg3 },
+ { id => $id1, mail => $msg1 },
+ ]
+
+=head2 C<remove>
+
+ $ms->remove($id);
+
+This method must remove the message corresponding to the given
+identifier from the persistent storage. Removing a non-existent
+message must succeed, and do nothing.
+
+=head2 C<clear>
+
+ $ms->clear();
+
+This method must remove all messages from the persistent
+storage. Clearing a empty store must succeed, and do nothing.
+
+=cut
+
+requires 'store',
+ 'retrieve_ids_by_tags','retrieve_by_tags','retrieve_by_id',
+ 'remove','clear';
+
+1;
diff --git a/lib/Sietima/MailStore/FS.pm b/lib/Sietima/MailStore/FS.pm
new file mode 100644
index 0000000..e4dfc4d
--- /dev/null
+++ b/lib/Sietima/MailStore/FS.pm
@@ -0,0 +1,107 @@
+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 Sietima::Types qw(EmailMIME TagName);
+use Digest::SHA qw(sha1_hex);
+use namespace::clean;
+
+with 'Sietima::MailStore';
+
+has root => (
+ is => 'ro',
+ required => 1,
+ isa => Dir,
+ coerce => 1,
+);
+
+has [qw(_tagdir _msgdir)] => ( is => 'lazy' );
+sub _build__tagdir($self) { $self->root->child('tags') }
+sub _build__msgdir($self) { $self->root->child('msgs') }
+
+sub BUILD($self,@) {
+ $self->$_->mkpath for qw(_tagdir _msgdir);
+ return;
+}
+
+sub clear($self) {
+ do { $self->$_->remove_tree;$self->$_->mkpath } for qw(_tagdir _msgdir);
+ return;
+}
+
+sub store($self,$mail,@tags) {
+ state $check = compile(Object,EmailMIME,slurpy ArrayRef[TagName]);$check->(@_);
+
+ 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;
+
+ return $id;
+}
+
+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);
+}
+
+sub _tagged_by($self,$tag) {
+ my $tag_file = $self->_tagdir->child($tag);
+ return unless -e $tag_file;
+ return $tag_file->lines({chomp=>1});
+}
+
+sub retrieve_ids_by_tags($self,@tags) {
+ state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
+
+ my %msgs;
+ if (@tags) {
+ for my $tag (@tags) {
+ $_++ for @msgs{$self->_tagged_by($tag)};
+ }
+ }
+ else {
+ $msgs{$_->basename}=0 for $self->_msgdir->children;
+ }
+
+ my @ret;
+ for my $id (keys %msgs) {
+ next unless $msgs{$id} == @tags;
+ push @ret, $id;
+ }
+ return \@ret;
+}
+
+sub retrieve_by_tags($self,@tags) {
+ state $check = compile(Object,slurpy ArrayRef[TagName]);$check->(@_);
+
+ my @ret;
+ for my $id ($self->retrieve_ids_by_tags(@tags)->@*) {
+ push @ret, {
+ id => $id,
+ mail => $self->retrieve_by_id($id),
+ };
+ }
+
+ return \@ret;
+}
+
+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/ } );
+ }
+ $self->_msgdir->child($id)->remove;
+
+ return;
+}
+
+1;
diff --git a/lib/Sietima/Message.pm b/lib/Sietima/Message.pm
new file mode 100644
index 0000000..181575f
--- /dev/null
+++ b/lib/Sietima/Message.pm
@@ -0,0 +1,103 @@
+package Sietima::Message;
+use Moo;
+use Sietima::Policy;
+use Types::Standard qw(ArrayRef Object);
+use Sietima::Types qw(Address AddressFromStr
+ Subscriber SubscriberFromAddress SubscriberFromStr
+ EmailMIME);
+use Email::Address;
+use Sietima::Subscriber;
+use Email::MIME;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Message - an email message with an envelope
+
+=head1 SYNOPSIS
+
+ use Sietima::Message;
+
+ my $msg = Sietima::Message->new({
+ mail => $email_mime_object,
+ from => 'sender@example.com',
+ to => [ 'recipient@example.com', 'also@example.com' ],
+ });
+
+=head1 DESCRPITON
+
+This class pairs a L<< C<Email::MIME> >> object with its
+envelope. Objects of this class are usually generated by L<<
+C<Sietima::munge_mail>|Sietima/munge_mail >>, and consumed by L<<
+C<Sietima::send_message>|Sietima/send_message >>.
+
+=head1 ATTRIBUTES
+
+All attributes are read-only and required.
+
+=head2 C<mail>
+
+An L<< C<Email::MIME> >> object, representing the message.
+
+=cut
+
+has mail => (
+ is => 'ro',
+ isa => EmailMIME,
+ required => 1,
+);
+
+=head2 C<from>
+
+An L<< C<Email::Address> >> object, coercible from a string,
+representing the sender.
+
+=cut
+
+has from => (
+ is => 'ro',
+ isa => Address,
+ coerce => AddressFromStr,
+ required => 1,
+);
+
+=head2 C<to>
+
+An arrayref of L<< C<Sietima::Subscriber> >> objects, each coercible
+from a string or an L<< C<Email::Address> >> object, representing the
+recipients.
+
+=cut
+
+my $subscriber_array = ArrayRef[
+ Subscriber->plus_coercions(
+ SubscriberFromStr,
+ SubscriberFromAddress,
+ )
+];
+has to => (
+ isa => $subscriber_array,
+ is => 'ro',
+ coerce => $subscriber_array->coercion,
+ required => 1,
+);
+
+=head1 METHODS
+
+=head2 C<envelope>
+
+ my %envelope = $message->envelope->%*;
+
+Returns a hashref with envelope data, suitable for use with L<<
+C<Email::Sender::Transport::send>|Email::Sender::Transport/send >>.
+
+=cut
+
+sub envelope ($self) {
+ return {
+ from => $self->from,
+ to => [ map { $_->address } $self->to->@* ],
+ }
+}
+
+1;
diff --git a/lib/Sietima/Policy.pm b/lib/Sietima/Policy.pm
new file mode 100644
index 0000000..686a4cd
--- /dev/null
+++ b/lib/Sietima/Policy.pm
@@ -0,0 +1,41 @@
+package Sietima::Policy;
+use 5.024;
+use strict;
+use warnings;
+use feature ':5.24';
+use experimental 'signatures';
+
+=head1 NAME
+
+Sietima::Policy - pragma for Sietima modules
+
+=head1 SYNOPSIS
+
+ use 5.024;
+ use strict;
+ use warnings;
+ use feature ':5.24';
+ use experimental 'signatures';
+
+or just:
+
+ use Sietima::Policy;
+
+=head1 DESCRPITON
+
+This module imports the pragmas shown in the L</synopsis>. All Sietima
+modules use it.
+
+=cut
+
+sub import {
+ # These affect the currently compiling scope,
+ # so no need for import::into
+ strict->import;
+ warnings->import;
+ experimental->import('signatures');
+ feature->import(':5.24');
+ return;
+}
+
+1;
diff --git a/lib/Sietima/Role/AvoidDups.pm b/lib/Sietima/Role/AvoidDups.pm
new file mode 100644
index 0000000..ac633c0
--- /dev/null
+++ b/lib/Sietima/Role/AvoidDups.pm
@@ -0,0 +1,48 @@
+package Sietima::Role::AvoidDups;
+use Moo::Role;
+use Sietima::Policy;
+use Email::Address;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::AvoidDups - prevent people from receiving the same message multiple times
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('AvoidDups')->new(\%args);
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will not send a
+message to a subscriber, if that subscriber is already mentioned in
+the C<To:> or C<Cc:> header fields, because they can be assumed to be
+already receiving the message directly from the sender.
+
+=head1 MODIFIED METHODS
+
+=head2 C<subscribers_to_send_to>
+
+Filters out subscribers that L<match|Sietima::Subscriber/match> the
+addresses in the C<To:> or C<Cc:> headers of the incoming email.
+
+=cut
+
+around subscribers_to_send_to => sub ($orig,$self,$mail) {
+ my @already_receiving = map {
+ Email::Address->parse($_)
+ } $mail->header_str('to'),$mail->header_str('cc');
+
+ my %already_receiving = map {
+ $_->address => 1
+ } @already_receiving;
+
+ return [
+ grep {
+ not $already_receiving{$_->address}
+ }
+ $self->$orig($mail)->@*,
+ ];
+};
+
+1;
diff --git a/lib/Sietima/Role/Debounce.pm b/lib/Sietima/Role/Debounce.pm
new file mode 100644
index 0000000..39ef936
--- /dev/null
+++ b/lib/Sietima/Role/Debounce.pm
@@ -0,0 +1,48 @@
+package Sietima::Role::Debounce;
+use Moo::Role;
+use Sietima::Policy;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::Debounce - avoid mail loops
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('Debounce')->new(\%args);
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will mark each message
+with a C<X-Been-There:> 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 METHODS
+
+=head2 C<munge_mail>
+
+If the incoming email contains our C<X-Been-There:> 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';
+
+around munge_mail => sub ($orig,$self,$incoming_mail) {
+ my $return_path = $self->return_path->address;
+ if (my $there = $incoming_mail->header_str($been_there)) {
+ return if $there =~ m{\b\Q$return_path\E\b};
+ }
+
+ $incoming_mail->header_str_set(
+ $been_there => $return_path,
+ );
+
+ return $self->$orig($incoming_mail);
+};
+
+1;
diff --git a/lib/Sietima/Role/Headers.pm b/lib/Sietima/Role/Headers.pm
new file mode 100644
index 0000000..166b355
--- /dev/null
+++ b/lib/Sietima/Role/Headers.pm
@@ -0,0 +1,107 @@
+package Sietima::Role::Headers;
+use Moo::Role;
+use Try::Tiny;
+use Sietima::Policy;
+use Types::Standard qw(Str);
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::Headers - adds standard list-related headers to messages
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('Headers')->new({
+ %args,
+ name => $name_of_the_list,
+ });
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will add, to each
+outgoing message, the set of headers defined in RFC 2919 and RFC 2369.
+
+This role uses the L<< C<list_addresses>|Sietima/list_addresses >>
+method to determine what headers to add.
+
+If the C<name> attribute is set, a C<List-Id:> header will be added,
+with a value built out of the name and the C<<
+$self->list_addresses->{return_path} >> value (which is normally the
+same as the L<< C<return_path>|Sietima/return_path >> attribute).
+
+Other C<List-*:> headers are built from the other values in the
+C<list_addresses> hashref. Those values can either be L<<
+C<Email::Address> >> objects (in which case the header will have a
+C<mailto:> URI as value) or strings (which will be used literally for
+the value of the header).
+
+=head1 ATTRIBUTES
+
+=head2 C<name>
+
+Optional string, the name of the mailing list. If this attribute is
+set, a C<List-Id:> header will be added, with a value built out of the
+name and the C<< $self->list_addresses->{return_path} >> value (which
+is normally the same as the L<< C<return_path>|Sietima/return_path >>
+attribute).
+
+=cut
+
+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,
+ );
+ }
+
+ # 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;
+}
+
+=head1 MODIFIED METHODS
+
+=head2 C<munge_mail>
+
+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;
+ return @messages;
+};
+
+1;
diff --git a/lib/Sietima/Role/NoMail.pm b/lib/Sietima/Role/NoMail.pm
new file mode 100644
index 0000000..7db58da
--- /dev/null
+++ b/lib/Sietima/Role/NoMail.pm
@@ -0,0 +1,42 @@
+package Sietima::Role::NoMail;
+use Moo::Role;
+use Sietima::Policy;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::NoMail - don't send mail to those who don't want it
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('NoMail')->new({
+ %args,
+ subscribers => [
+ { primary => 'write-only@example.com', prefs => { wants_mail => 0 } },
+ @other_subscribers,
+ ],
+ });
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will not send messages
+to subscribers that have the C<wants_mail> preference set to a false
+value.
+
+=head1 MODIFIED METHODS
+
+=head2 C<subscribers_to_send_to>
+
+Filters out subscribers that have the C<wants_mail> preference set to
+a false value.
+
+=cut
+
+around subscribers_to_send_to => sub ($orig,$self,$mail) {
+ return [
+ grep { $_->prefs->{wants_mail} // 1 }
+ $self->$orig($mail)->@*,
+ ];
+};
+
+1;
diff --git a/lib/Sietima/Role/ReplyTo.pm b/lib/Sietima/Role/ReplyTo.pm
new file mode 100644
index 0000000..c9de1a4
--- /dev/null
+++ b/lib/Sietima/Role/ReplyTo.pm
@@ -0,0 +1,127 @@
+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;
+
+=head1 NAME
+
+Sietima::Role::ReplyTo - munge the C<Reply-To> header
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('ReplyTo')->new({
+ %args,
+ return_path => 'list-bounce@example.com',
+ munge_reply_to => 1,
+ post_address => 'list@example.com',
+ subscribers => [
+ { primary => 'special@example.com', prefs => { munge_reply_to => 0 } },
+ @other_subscribers,
+ ],
+ });
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> list with this role applied will, on request, set
+the C<Reply-To:> header to the value of the L<<
+C<post_address>|Sietima::Role::WithPostAddress >> attribute.
+
+This behaviour can be selected both at the list level (with the L<<
+/C<munge_reply_to> >> attribute) and at the subscriber level (with the
+C<munge_reply_to> preference). By default, the C<Reply-To:> header is
+not touched.
+
+This is a "sub-role" of L<<
+C<WithPostAddress>|Sietima::Role::WithPostAddress >>.
+
+=cut
+
+with 'Sietima::Role::WithPostAddress';
+
+=head1 ATTRIBUTES
+
+=head2 C<munge_reply_to>
+
+Optional boolean, defaults to false. If set to a true value, all
+messages will have their C<Reply-To:> header set to the value of the
+L<< /C<post_address> >> attribute. This setting can be overridden by
+individual subscribers with the C<munge_reply_to> preference.
+
+=cut
+
+has munge_reply_to => (
+ is => 'ro',
+ isa => Bool,
+ default => 0,
+);
+
+=head1 MODIFIED METHODS
+
+=head2 C<munge_mail>
+
+For each message returned by the original method, this method
+partitions the subscribers, who are recipients of the message,
+according to their C<munge_reply_to> preference (or the L<<
+/C<munge_reply_to> >> attribute, if a subscriber does not have the
+preference set).
+
+If no recipients want the C<Reply-To:> header modified, this method
+will just pass the message through.
+
+If all recipients want the C<Reply-To:> header modified, this method
+will set the header, and pass the modified message.
+
+If some recipients want the C<Reply-To:> 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);
+ my @ret;
+ for my $m (@messages) {
+ my ($leave,$munge) = part {
+ my $m = $_->prefs->{munge_reply_to};
+ defined $m ? (
+ $m ? 1 : 0
+ ) : ( $self->munge_reply_to ? 1 : 0 )
+ } $m->to->@*;
+
+ if (not ($munge and $munge->@*)) {
+ # nothing to do
+ push @ret,$m;
+ }
+ elsif (not ($leave and $leave->@*)) {
+ # all these recipients want munging
+ $m->mail->header_str_set('Reply-To',$self->post_address->address);
+ push @ret,$m;
+ }
+ else {
+ # some want it, some don't: create two different messages
+ my $leave_message = Sietima::Message->new({
+ mail => $m->mail,
+ from => $m->from,
+ to => $leave,
+ });
+
+ my $munged_mail = Email::MIME->new($m->mail->as_string);
+ $munged_mail->header_str_set('Reply-To',$self->post_address->address);
+
+ my $munged_message = Sietima::Message->new({
+ mail => $munged_mail,
+ from => $m->from,
+ to => $munge,
+ });
+
+ push @ret,$leave_message,$munged_message;
+ }
+ }
+ return @ret;
+};
+
+1;
diff --git a/lib/Sietima/Role/SubjectTag.pm b/lib/Sietima/Role/SubjectTag.pm
new file mode 100644
index 0000000..75170d7
--- /dev/null
+++ b/lib/Sietima/Role/SubjectTag.pm
@@ -0,0 +1,64 @@
+package Sietima::Role::SubjectTag;
+use Moo::Role;
+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<Sietima> >> list with this role applied will prepend the given
+tag to every outgoing message's C<Subject:> header.
+
+=head1 ATTRIBUTES
+
+=head2 C<subject_tag>
+
+Required string. This string, enclosed by square brackets, will be
+prepended to the C<Subject:> header of outgoing messages. For example,
+the code in the L</synopsis> would cause an incoming message with
+subject "new stuff" to be sent out with subject "[foo] new stuff".
+
+If the incoming message's C<Subject:> 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<munge_mail>
+
+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');
+ unless ($subject =~ m{\Q$tag\E}) {
+ $mail->header_str_set(
+ Subject => "$tag $subject",
+ );
+ }
+ return $self->$orig($mail);
+};
+
+1;
diff --git a/lib/Sietima/Role/SubscriberOnly.pm b/lib/Sietima/Role/SubscriberOnly.pm
new file mode 100644
index 0000000..ff93076
--- /dev/null
+++ b/lib/Sietima/Role/SubscriberOnly.pm
@@ -0,0 +1,96 @@
+package Sietima::Role::SubscriberOnly;
+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<Sietima::Role::SubscriberOnly::Drop> >> and L<<
+C<Sietima::Role::SubscriberOnly::Moderate> >> for useable roles.
+
+=head1 REQUIRED METHODS
+
+=head2 C<munge_mail_from_non_subscriber>
+
+ sub munge_mail_from_non_subscriber($self,$mail) { ... }
+
+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.
+
+=cut
+
+requires 'munge_mail_from_non_subscriber';
+
+our $let_it_pass=0;
+
+=head1 MODIFIED METHODS
+
+=head2 C<munge_mail>
+
+If the incoming email's C<From:> header contains an address that
+L<matches|Sietima::Subscriber/match> any of the subscribers, the email
+is processed normally. Otherwise, L<<
+/C<munge_mail_from_non_subscriber> >> is invoked.
+
+=cut
+
+around munge_mail => sub ($orig,$self,$mail) {
+ my ($from) = Email::Address->parse( $mail->header_str('from') );
+ if ( $let_it_pass or
+ any { $_->match($from) } $self->subscribers->@* ) {
+ $self->$orig($mail);
+ }
+ else {
+ $self->munge_mail_from_non_subscriber($mail);
+ }
+};
+
+=head1 METHODS
+
+=head2 C<ignoring_subscriberonly>
+
+ $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
new file mode 100644
index 0000000..029889f
--- /dev/null
+++ b/lib/Sietima/Role/SubscriberOnly/Drop.pm
@@ -0,0 +1,39 @@
+package Sietima::Role::SubscriberOnly::Drop;
+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<Sietima> >> 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<SubscribersOnly>|Sietima::Role::SubscriberOnly >>.
+
+=cut
+
+with 'Sietima::Role::SubscriberOnly';
+
+=head1 METHODS
+
+=head2 C<munge_mail_from_non_subscriber>
+
+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
new file mode 100644
index 0000000..750e4be
--- /dev/null
+++ b/lib/Sietima/Role/SubscriberOnly/Moderate.pm
@@ -0,0 +1,242 @@
+package Sietima::Role::SubscriberOnly::Moderate;
+use Moo::Role;
+use Sietima::Policy;
+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,
+ owner => 'listmaster@example.com',
+ mail_store => {
+ class => 'Sietima::MailStore::FS',
+ root => '/tmp',
+ },
+ });
+
+=head1 DESCRIPTION
+
+A L<< C<Sietima> >> 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 owner.
+
+The owner will the be able to delete the message, or allow it.
+
+This is a "sub-role" of L<<
+C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>, L<<
+C<WithMailStore>|Sietima::Role::WithMailStore >>, and L<<
+C<WithOwner>|Sietima::Role::WithOwner >>.
+
+=cut
+
+with 'Sietima::Role::SubscriberOnly',
+ 'Sietima::Role::WithMailStore',
+ 'Sietima::Role::WithOwner';
+
+=head1 METHODS
+
+=head2 C<munge_mail_from_non_subscriber>
+
+L<Stores|Sietima::MailStore/store> the email with the C<moderation>
+tag, and forwards it to the L<list
+owner|Sietima::Role::WithOwner/owner>.
+
+=cut
+
+sub munge_mail_from_non_subscriber ($self,$mail) {
+ my $id = $self->mail_store->store($mail,'moderation');
+ my $notice = Email::Stuffer
+ ->from($self->return_path->address)
+ ->to($self->owner->address)
+ ->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',
+ # some clients, most notably Claws-Mail, seem to have
+ # problems with encodings other than this
+ encoding => '7bit',
+ );
+ $self->transport->send($notice->email,{
+ from => $self->return_path,
+ to => [ $self->owner ],
+ });
+ return;
+}
+
+=head2 C<resume>
+
+ $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<<
+C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly
+>>. This will make sure that the email is not caught again by the
+subscriber-only filter.
+
+=cut
+
+sub resume ($self,$mail_id) {
+ my $mail = $self->mail_store->retrieve_by_id($mail_id);
+ $self->ignoring_subscriberonly(
+ sub($s) { $s->handle_mail($mail) },
+ );
+ $self->mail_store->remove($mail_id);
+}
+
+=head2 C<drop>
+
+ $sietima->drop($mail_id);
+
+Given an identifier returned when L<storing|Sietima::MailStore/store>
+an email, this method deletes the email from the store.
+
+=cut
+
+sub drop ($self,$mail_id) {
+ $self->mail_store->remove($mail_id);
+}
+
+=head2 C<list_mails_in_moderation_queue>
+
+ $sietima->list_mails_in_moderation_queue($sietima_runner);
+
+This method L<retrieves all the
+identifiers|Sietima::MailStore/retrieve_by_tags> of messages tagged
+C<moderation>, and L<prints them out|App::Spec::Runner/out> via the
+L<< C<Sietima::Runner> >> object.
+
+This method is usually invoked from the command line, see L<<
+/C<command_line_spec> >>.
+
+=cut
+
+sub list_mails_in_moderation_queue ($self,$runner,@) {
+ my $mails = $self->mail_store->retrieve_by_tags('moderation');
+ $runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*));
+ for my $mail ($mails->@*) {
+ $runner->out(sprintf '* %s %s "%s" (%s)',
+ $mail->{id},
+ $mail->{mail}->header_str('From')//'<no from>',
+ $mail->{mail}->header_str('Subject')//'<no subject>',
+ $mail->{mail}->header_str('Date')//'<no date>',
+ );
+ }
+}
+
+=head2 C<show_mail_from_moderation_queue>
+
+ $sietima->show_mail_from_moderation_queue($sietima_runner);
+
+This method L<retrieves the email|Sietima::MailStore/retrieve_by_id>
+of the message requested from the command line, and L<prints it
+out|App::Spec::Runner/out> via the L<< C<Sietima::Runner> >> object.
+
+This method is usually invoked from the command line, see L<<
+/C<command_line_spec> >>.
+
+=cut
+
+sub show_mail_from_moderation_queue ($self,$runner,@) {
+ my $id = $runner->parameters->{'mail-id'};
+ my $mail = $self->mail_store->retrieve_by_id($id);
+ $runner->out("Message $id:");
+ $runner->out($mail->as_string =~ s{\r\n}{\n}gr);
+}
+
+=head1 MODIFIED METHODS
+
+=head2 C<command_line_spec>
+
+This method adds the following sub-commands for the command line:
+
+=over
+
+=item C<list-held>
+
+ $ sietima list-held
+
+Invokes the L<< /C<list_mails_in_moderation_queue> >> method, printing
+the identifiers of all messages held for moderation.
+
+=item C<show-held>
+
+ $ sietima show-held 32946p6eu7867
+
+Invokes the L<< /C<show_mail_from_moderation_queue> >> method,
+printing one message held for moderation; the identifier is expected
+as a positional parameter.
+
+=item C<resume-held>
+
+ $ sietima resume-held 32946p6eu7867
+
+Invokes the L<< /C<resume> >> method, causing the held message to be
+processed normally; the identifier is expected as a positional
+parameter.
+
+=item C<drop-held>
+
+ $ sietima drop-held 32946p6eu7867
+
+Invokes the L<< /C<drop> >> method, removing the held message; the
+identifier is expected as a positional parameter.
+
+=back
+
+=cut
+
+around command_line_spec => sub ($orig,$self) {
+ my $spec = $self->$orig();
+
+ # this allows us to tab-complete identifiers from the shell!
+ my $list_mail_ids = sub ($self,$runner,$args) {
+ $self->mail_store->retrieve_ids_by_tags('moderation');
+ };
+ # a little factoring: $etc->($command_name) generates the spec for
+ # sub-commands that require a mail id
+ my $etc = sub($cmd) {
+ return (
+ summary => "$cmd the given mail, currently held for moderation",
+ parameters => [
+ {
+ name => 'mail-id',
+ required => 1,
+ summary => "id of the mail to $cmd",
+ completion => { op => $list_mail_ids },
+ },
+ ],
+ );
+ };
+
+ $spec->{subcommands}{'list-held'} = {
+ op => 'list_mails_in_moderation_queue',
+ summary => 'list all mails currently held for moderation',
+ };
+ $spec->{subcommands}{'show-held'} = {
+ op => 'show_mail_from_moderation_queue',
+ $etc->('show'),
+ };
+ $spec->{subcommands}{'resume-held'} = {
+ op => sub ($self,$runner,$args) {
+ $self->resume($runner->parameters->{'mail-id'});
+ },
+ $etc->('resume'),
+ };
+ $spec->{subcommands}{'drop-held'} = {
+ op => sub ($self,$runner,$args) {
+ $self->drop($runner->parameters->{'mail-id'});
+ },
+ $etc->('drop'),
+ };
+
+ return $spec;
+};
+
+1;
diff --git a/lib/Sietima/Role/WithMailStore.pm b/lib/Sietima/Role/WithMailStore.pm
new file mode 100644
index 0000000..a2ae07c
--- /dev/null
+++ b/lib/Sietima/Role/WithMailStore.pm
@@ -0,0 +1,48 @@
+package Sietima::Role::WithMailStore;
+use Moo::Role;
+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<mail_store> >> attribute.
+
+On its own, this role is not very useful, but other roles (like L<<
+C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate
+>>) can have uses for an object that can persistently store messages.
+
+=head1 ATTRIBUTES
+
+=head2 C<mail_store>
+
+Required instance of an object that consumes the L<<
+C<Sietima::MailStore> >> role. Instead of passing an instance, you can
+pass a hashref (like in the L</synopsis>): the C<class> 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,
+ required => 1,
+ coerce => MailStoreFromHashRef,
+);
+
+1;
diff --git a/lib/Sietima/Role/WithOwner.pm b/lib/Sietima/Role/WithOwner.pm
new file mode 100644
index 0000000..dccb904
--- /dev/null
+++ b/lib/Sietima/Role/WithOwner.pm
@@ -0,0 +1,50 @@
+package Sietima::Role::WithOwner;
+use Moo::Role;
+use Sietima::Policy;
+use Sietima::Types qw(Address AddressFromStr);
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Role::WithOwner - role for lists with an owner
+
+=head1 SYNOPSIS
+
+ my $sietima = Sietima->with_traits('WithOwner')->new({
+ %args,
+ owner => 'listmaster@example.com',
+ });
+
+=head1 DESCRIPTION
+
+This role adds an L<< /C<owner> >> attribute, and exposes it via the
+L<< C<list_addresses>|Sietima/list_addresses >> method.
+
+On its own, this role is not very useful, but other roles (like L<<
+C<SubscriberOnly::Moderate>|Sietima::Role::SubscriberOnly::Moderate
+>>) can have uses for an owner address.
+
+=head1 ATTRIBUTES
+
+=head2 C<owner>
+
+Required instance of L<< C<Email::Address> >>, coercible from a
+string. This is the address of the owner of the list.
+
+=cut
+
+has owner => (
+ is => 'ro',
+ isa => Address,
+ required => 1,
+ coerce => AddressFromStr,
+);
+
+around list_addresses => sub($orig,$self) {
+ return +{
+ $self->$orig->%*,
+ owner => $self->owner,
+ };
+};
+
+1;
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<post_address> >> attribute, and exposes it
+via the L<< C<list_addresses>|Sietima/list_addresses >> method.
+
+On its own, this role is not very useful, but other roles (like L<<
+C<ReplyTo>|Sietima::Role::ReplyTo >>) can have uses for a post
+address.
+
+=head1 ATTRIBUTES
+
+=head2 C<post_address>
+
+An L<< C<Email::Address> >> object, defaults to the value of the L<<
+C<return_path>|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;
diff --git a/lib/Sietima/Runner.pm b/lib/Sietima/Runner.pm
new file mode 100644
index 0000000..64e23eb
--- /dev/null
+++ b/lib/Sietima/Runner.pm
@@ -0,0 +1,33 @@
+package Sietima::Runner;
+use Moo;
+use Sietima::Policy;
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Runner
+
+=head1 DESCRIPTION
+
+You should never need to care about this class, it's used internally
+by L<< C<Sietima::CmdLine> >>.
+
+This is a subclass of L<< C<App::Spec::Run> >> that uses directly
+itself to execute the built-in commands, instead of delegating to the
+C<cmd> object (in our case, a C<Sietima> instance) which would
+delegate back via L<< C<App::Spec::Run::Cmd> >>.
+
+=cut
+
+extends 'App::Spec::Run';
+
+sub run_op($self,$op,$args=[]) {
+ if ($op =~ /^cmd_/) {
+ $self->$op($args);
+ }
+ else {
+ $self->cmd->$op($self,$args);
+ }
+}
+
+1;
diff --git a/lib/Sietima/Subscriber.pm b/lib/Sietima/Subscriber.pm
new file mode 100644
index 0000000..96c7d3b
--- /dev/null
+++ b/lib/Sietima/Subscriber.pm
@@ -0,0 +1,114 @@
+package Sietima::Subscriber;
+use Moo;
+use Sietima::Policy;
+use Types::Standard qw(ArrayRef HashRef Object);
+use Type::Params qw(compile);
+use Sietima::Types qw(Address AddressFromStr);
+use Email::Address;
+use List::AllUtils qw(any);
+use namespace::clean;
+
+=head1 NAME
+
+Sietima::Subscriber - a subscriber to a mailing list
+
+=head1 DESCRIPTION
+
+This class holds the primary email address for a mailing list
+subscriber, together with possible aliases and preferences.
+
+=head1 ATTRIBUTES
+
+All attributes are read-only.
+
+=head2 C<primary>
+
+Required L<< C<Email::Address> >> object, coercible from a string.
+
+This is the primary address for the subscriber, the one where they
+will receive messages from the mailing list.
+
+=cut
+
+has primary => (
+ isa => Address,
+ is => 'ro',
+ required => 1,
+ coerce => AddressFromStr,
+ handles => [qw(address name original)],
+);
+
+=head2 C<aliases>
+
+Arrayref of L<< C<Email::Address> >> objects, each coercible from a
+string. Defaults to an empty arrayref.
+
+These are secondary addresses that the subscriber may write
+from. Subscriber-only mailing lists should accept messages from any of
+these addresses as if they were from the primary. The L<< /C<match> >>
+simplifies that task.
+
+=cut
+
+my $address_array = ArrayRef[
+ Address->plus_coercions(
+ AddressFromStr
+ )
+];
+has aliases => (
+ isa => $address_array,
+ is => 'lazy',
+ coerce => $address_array->coercion,
+);
+sub _build_aliases { +[] }
+
+=head2 C<prefs>
+
+A hashref. Various preferences that may be interpreted by Sietima
+roles. Defaults to an empty hashref.
+
+=cut
+
+has prefs => (
+ isa => HashRef,
+ is => 'ro',
+ default => sub { +{} },
+);
+
+=head1 METHODS
+
+=head2 C<match>
+
+ if ($subscriber->match($address)) { ... }
+
+Given a L<< C<Email::Address> >> object (or a string), this method
+returns true if the address is equivalent to the
+L</primary> or any of the L</aliases>.
+
+This method should be used to determine whether an address belongs to
+a subscriber.
+
+=cut
+
+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->(@_);
+
+ return any { $addr->address eq $_->address }
+ $self->primary, $self->aliases->@*;
+}
+
+=head2 C<address>
+
+=head2 C<name>
+
+=head2 C<original>
+
+These methods delegate to L<< C<Email::Address> >>'s methods of the
+same name, invoked on the L<primary address|/primary>.
+
+=cut
+
+1;
diff --git a/lib/Sietima/Types.pm b/lib/Sietima/Types.pm
new file mode 100644
index 0000000..1c75b1f
--- /dev/null
+++ b/lib/Sietima/Types.pm
@@ -0,0 +1,178 @@
+package Sietima::Types;
+use Sietima::Policy;
+use Type::Utils -all;
+use Types::Standard qw(Str HashRef);
+use namespace::clean;
+use Type::Library
+ -base,
+ -declare => qw(SietimaObj
+ Address AddressFromStr
+ TagName
+ EmailMIME Message
+ Subscriber SubscriberFromAddress SubscriberFromStr SubscriberFromHashRef
+ Transport MailStore MailStoreFromHashRef);
+
+=head1 NAME
+
+Sietima::Types - type library for Sietima
+
+=head1 DESCRIPTION
+
+This module is a L<< C<Type::Library> >>. It declares a few type
+constraints nad coercions.
+
+=head1 TYPES
+
+=head2 C<SietimaObj>
+
+An instance of L<< C<Sietima> >>.
+
+=cut
+
+class_type SietimaObj, { class => 'Sietima' };
+
+=head2 C<EmailMIME>
+
+An instance of L<< C<Email::MIME> >>.
+
+=cut
+
+class_type EmailMIME, { class => 'Email::MIME' };
+
+=head2 C<Transport>
+
+An object that consumes the role L<< C<Email::Sender::Transport> >>.
+
+=cut
+
+role_type Transport, { role => 'Email::Sender::Transport' };
+
+=head2 C<MailStore>
+
+An object that consumes the role L<< C<Sietima::MailStore> >>.
+
+Coercions:
+
+=over
+
+=item C<MailStoreFromHashRef>
+
+ has store => ( isa => MailStore->plus_coercions(MailStoreFromHashRef) );
+
+Using this coercion, a hashref of the form:
+
+ {
+ class => 'Some::Store::Class',
+ %constructor_args,
+ }
+
+will be converted into an instance of C<Some::Store::Class> built with
+the C<%constructor_args>.
+
+=back
+
+=cut
+
+role_type MailStore, { role => 'Sietima::MailStore' };
+
+declare_coercion MailStoreFromHashRef,
+ to_type MailStore, from HashRef,
+ q{ require Module::Runtime;
+ Module::Runtime::use_module(delete $_->{class})->new($_);
+ };
+
+=head2 C<Address>
+
+An instance of L<< C<Email::Address> >>.
+
+Coercions:
+
+=over
+
+=item C<AddressFromStr>
+
+ has address => ( isa => Address->plus_coercions(AddressFromStr) );
+
+Using this coercion, a string will be parsed into an L<<
+C<Email::Address> >>. If the string contains more than one address,
+only the first one will be used.
+
+=back
+
+=cut
+
+class_type Address, { class => 'Email::Address' };
+declare_coercion AddressFromStr,
+ to_type Address, from Str,
+ q{ (Email::Address->parse($_))[0] };
+
+=head2 C<TagName>
+
+A string composed exclusively of "word" (C</\w/>) characters. Used by
+L<mail stores|Sietima::MailStore> to tag messages.
+
+=cut
+
+declare TagName, as Str,
+ where { /\A\w+\z/ },
+ inline_as sub($constraint,$varname,@){
+ $constraint->parent->inline_check($varname)
+ .qq{ && ($varname =~/\\A\\w+\\z/) };
+ };
+
+=head2 C<Message>
+
+An instance of L<< C<Sietima::Message> >>.
+
+=cut
+
+class_type Message, { class => 'Sietima::Message' };
+
+=head2 C<Subscriber>
+
+An instance of L<< C<Sietima::Subscriber> >>.
+
+Coercions:
+
+=over
+
+=item C<SubscriberFromAddress>
+
+ has sub => ( isa => Subscriber->plus_coercions(SubscriberFromAddress) );
+
+Using this coercion, an L<< C<Email::Address> >> will be converted
+into a subscriber that has that address as its primary.
+
+=item C<SubscriberFromStr>
+
+ has sub => ( isa => Subscriber->plus_coercions(SubscriberFromStr) );
+
+Using this coercion, a string will be converted into a subscriber that
+has the first address parsed from that string as its primary.
+
+=item C<SubscriberFromHashRef>
+
+ has sub => ( isa => Subscriber->plus_coercions(SubscriberFromHashRef) );
+
+Using this coercion, a hashref will be converted into a subscriber by
+passing it to the constructor.
+
+=back
+
+=cut
+
+class_type Subscriber, { class => 'Sietima::Subscriber' };
+
+declare_coercion SubscriberFromAddress,
+ to_type Subscriber, from Address,
+ q{ Sietima::Subscriber->new(primary=>$_) };
+
+declare_coercion SubscriberFromStr,
+ to_type Subscriber, from Str,
+ q{ Sietima::Subscriber->new(primary=>(Email::Address->parse($_))[0]) };
+
+declare_coercion SubscriberFromHashRef,
+ to_type Subscriber, from HashRef,
+ q{ Sietima::Subscriber->new($_) };
+
+1;
generated by cgit v1.2.3 (git 2.46.0) at 2025-05-04 12:33:48 +0000