line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Sietima::Role::SubscriberOnly::Moderate; |
2
|
2
|
|
|
2
|
|
1022
|
use Moo::Role; |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
10
|
|
3
|
2
|
|
|
2
|
|
584
|
use Sietima::Policy; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
10
|
|
4
|
2
|
|
|
2
|
|
11
|
use Email::Stuffer; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
49
|
|
5
|
2
|
|
|
2
|
|
9
|
use Email::MIME; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
49
|
|
6
|
2
|
|
|
2
|
|
9
|
use namespace::clean; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
9
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '1.0.5'; # VERSION |
9
|
|
|
|
|
|
|
# ABSTRACT: moderate messages from non-subscribers |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
with 'Sietima::Role::SubscriberOnly', |
13
|
|
|
|
|
|
|
'Sietima::Role::WithMailStore', |
14
|
|
|
|
|
|
|
'Sietima::Role::WithOwner'; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
|
17
|
4
|
|
|
4
|
1
|
10
|
sub munge_mail_from_non_subscriber ($self,$mail) { |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
7
|
|
18
|
4
|
|
|
|
|
33
|
my $id = $self->mail_store->store($mail,'moderation'); |
19
|
4
|
|
|
|
|
685
|
my $notice = Email::Stuffer |
20
|
|
|
|
|
|
|
->from($self->return_path->address) |
21
|
|
|
|
|
|
|
->to($self->owner->address) |
22
|
|
|
|
|
|
|
->subject("Message held for moderation - ".$mail->header_str('subject')) |
23
|
|
|
|
|
|
|
->text_body("Use id $id to refer to it") |
24
|
|
|
|
|
|
|
->attach( |
25
|
|
|
|
|
|
|
$mail->as_string, |
26
|
|
|
|
|
|
|
content_type => 'message/rfc822', |
27
|
|
|
|
|
|
|
# some clients, most notably Claws-Mail, seem to have |
28
|
|
|
|
|
|
|
# problems with encodings other than this |
29
|
|
|
|
|
|
|
encoding => '7bit', |
30
|
|
|
|
|
|
|
); |
31
|
4
|
|
|
|
|
13253
|
$self->transport->send($notice->email,{ |
32
|
|
|
|
|
|
|
from => $self->return_path, |
33
|
|
|
|
|
|
|
to => [ $self->owner ], |
34
|
|
|
|
|
|
|
}); |
35
|
4
|
|
|
|
|
11639
|
return; |
36
|
|
|
|
|
|
|
} |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
|
39
|
3
|
|
|
3
|
1
|
29391
|
sub resume ($self,$mail_id) { |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
5
|
|
40
|
3
|
|
|
|
|
17
|
my $mail = $self->mail_store->retrieve_by_id($mail_id); |
41
|
3
|
|
|
|
|
5
|
$self->ignoring_subscriberonly( |
42
|
3
|
|
|
3
|
|
6
|
sub($s) { $s->handle_mail($mail) }, |
|
3
|
|
|
|
|
19
|
|
|
3
|
|
|
|
|
6
|
|
43
|
3
|
|
|
|
|
1087
|
); |
44
|
3
|
|
|
|
|
24
|
$self->mail_store->remove($mail_id); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
|
48
|
1
|
|
|
1
|
1
|
15388
|
sub drop ($self,$mail_id) { |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
49
|
1
|
|
|
|
|
5
|
$self->mail_store->remove($mail_id); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
|
53
|
1
|
|
|
1
|
1
|
5288
|
sub list_mails_in_moderation_queue ($self,$runner,@) { |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
54
|
1
|
|
|
|
|
10
|
my $mails = $self->mail_store->retrieve_by_tags('moderation'); |
55
|
1
|
|
|
|
|
582
|
$runner->out(sprintf 'There are %d messages held for moderation:',scalar($mails->@*)); |
56
|
1
|
|
|
|
|
1018
|
for my $mail ($mails->@*) { |
57
|
|
|
|
|
|
|
$runner->out(sprintf '* %s %s "%s" (%s)', |
58
|
|
|
|
|
|
|
$mail->{id}, |
59
|
|
|
|
|
|
|
$mail->{mail}->header_str('From')//'<no from>', |
60
|
|
|
|
|
|
|
$mail->{mail}->header_str('Subject')//'<no subject>', |
61
|
1
|
|
50
|
|
|
7
|
$mail->{mail}->header_str('Date')//'<no date>', |
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
62
|
|
|
|
|
|
|
); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
1
|
|
|
1
|
1
|
1824
|
sub show_mail_from_moderation_queue ($self,$runner,@) { |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2
|
|
68
|
1
|
|
|
|
|
5
|
my $id = $runner->parameters->{'mail-id'}; |
69
|
1
|
|
|
|
|
5
|
my $mail = $self->mail_store->retrieve_by_id($id); |
70
|
1
|
|
|
|
|
386
|
$runner->out("Message $id:"); |
71
|
1
|
|
|
|
|
50
|
$runner->out($mail->as_string =~ s{\r\n}{\n}gr); |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
0
|
1
|
|
sub resume_mail_from_moderation_queue ($self,$runner,@) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
76
|
0
|
|
|
|
|
|
$self->resume($runner->parameters->{'mail-id'}); |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
|
80
|
0
|
|
|
0
|
1
|
|
sub drop_mail_from_moderation_queue ($self,$runner,@) { |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
$self->drop($runner->parameters->{'mail-id'}); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
around command_line_spec => sub ($orig,$self) { |
86
|
|
|
|
|
|
|
my $spec = $self->$orig(); |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
# this allows us to tab-complete identifiers from the shell! |
89
|
|
|
|
|
|
|
my $list_mail_ids = sub ($self,$runner,$args) { |
90
|
|
|
|
|
|
|
$self->mail_store->retrieve_ids_by_tags('moderation'); |
91
|
|
|
|
|
|
|
}; |
92
|
|
|
|
|
|
|
# a little factoring: $etc->($command_name) generates the spec for |
93
|
|
|
|
|
|
|
# sub-commands that require a mail id |
94
|
|
|
|
|
|
|
my $etc = sub($cmd) { |
95
|
|
|
|
|
|
|
return ( |
96
|
|
|
|
|
|
|
summary => "$cmd the given mail, currently held for moderation", |
97
|
|
|
|
|
|
|
parameters => [ |
98
|
|
|
|
|
|
|
{ |
99
|
|
|
|
|
|
|
name => 'mail-id', |
100
|
|
|
|
|
|
|
required => 1, |
101
|
|
|
|
|
|
|
summary => "id of the mail to $cmd", |
102
|
|
|
|
|
|
|
completion => { op => $list_mail_ids }, |
103
|
|
|
|
|
|
|
}, |
104
|
|
|
|
|
|
|
], |
105
|
|
|
|
|
|
|
); |
106
|
|
|
|
|
|
|
}; |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
$spec->{subcommands}{'list-held'} = { |
109
|
|
|
|
|
|
|
op => 'list_mails_in_moderation_queue', |
110
|
|
|
|
|
|
|
summary => 'list all mails currently held for moderation', |
111
|
|
|
|
|
|
|
}; |
112
|
|
|
|
|
|
|
$spec->{subcommands}{'show-held'} = { |
113
|
|
|
|
|
|
|
op => 'show_mail_from_moderation_queue', |
114
|
|
|
|
|
|
|
$etc->('show'), |
115
|
|
|
|
|
|
|
}; |
116
|
|
|
|
|
|
|
$spec->{subcommands}{'resume-held'} = { |
117
|
|
|
|
|
|
|
op => 'resume_mail_from_moderation_queue', |
118
|
|
|
|
|
|
|
$etc->('resume'), |
119
|
|
|
|
|
|
|
}; |
120
|
|
|
|
|
|
|
$spec->{subcommands}{'drop-held'} = { |
121
|
|
|
|
|
|
|
op => 'drop_mail_from_moderation_queue', |
122
|
|
|
|
|
|
|
$etc->('drop'), |
123
|
|
|
|
|
|
|
}; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
return $spec; |
126
|
|
|
|
|
|
|
}; |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
1; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
__END__ |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=pod |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
=encoding UTF-8 |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head1 NAME |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
Sietima::Role::SubscriberOnly::Moderate - moderate messages from non-subscribers |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=head1 VERSION |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
version 1.0.5 |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=head1 SYNOPSIS |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
my $sietima = Sietima->with_traits('SubscribersOnly::Moderate')->new({ |
147
|
|
|
|
|
|
|
%args, |
148
|
|
|
|
|
|
|
owner => 'listmaster@example.com', |
149
|
|
|
|
|
|
|
mail_store => { |
150
|
|
|
|
|
|
|
class => 'Sietima::MailStore::FS', |
151
|
|
|
|
|
|
|
root => '/tmp', |
152
|
|
|
|
|
|
|
}, |
153
|
|
|
|
|
|
|
}); |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 DESCRIPTION |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
A L<< C<Sietima> >> list with this role applied will accept incoming |
158
|
|
|
|
|
|
|
emails coming from non-subscribers, and store it for moderation. Each |
159
|
|
|
|
|
|
|
such email will be forwarded (as an attachment) to the list's owner. |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
The owner will the be able to delete the message, or allow it. |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
This is a "sub-role" of L<< |
164
|
|
|
|
|
|
|
C<SubscribersOnly>|Sietima::Role::SubscriberOnly >>, L<< |
165
|
|
|
|
|
|
|
C<WithMailStore>|Sietima::Role::WithMailStore >>, and L<< |
166
|
|
|
|
|
|
|
C<WithOwner>|Sietima::Role::WithOwner >>. |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head1 METHODS |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=head2 C<munge_mail_from_non_subscriber> |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
L<Stores|Sietima::MailStore/store> the email with the C<moderation> |
173
|
|
|
|
|
|
|
tag, and forwards it to the L<list |
174
|
|
|
|
|
|
|
owner|Sietima::Role::WithOwner/owner>. |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
=head2 C<resume> |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
$sietima->resume($mail_id); |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Given an identifier returned when L<storing|Sietima::MailStore/store> |
181
|
|
|
|
|
|
|
an email, this method retrieves the email and re-processes it via L<< |
182
|
|
|
|
|
|
|
C<ignoring_subscriberonly>|Sietima::Role::SubscriberOnly/ignoring_subscriberonly |
183
|
|
|
|
|
|
|
>>. This will make sure that the email is not caught again by the |
184
|
|
|
|
|
|
|
subscriber-only filter. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=head2 C<drop> |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
$sietima->drop($mail_id); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
Given an identifier returned when L<storing|Sietima::MailStore/store> |
191
|
|
|
|
|
|
|
an email, this method deletes the email from the store. |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head2 C<list_mails_in_moderation_queue> |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
$sietima->list_mails_in_moderation_queue($sietima_runner); |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
This method L<retrieves all the |
198
|
|
|
|
|
|
|
identifiers|Sietima::MailStore/retrieve_by_tags> of messages tagged |
199
|
|
|
|
|
|
|
C<moderation>, and L<prints them out|App::Spec::Runner/out> via the |
200
|
|
|
|
|
|
|
L<< C<Sietima::Runner> >> object. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
This method is usually invoked from the command line, see L<< |
203
|
|
|
|
|
|
|
/C<command_line_spec> >>. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 C<show_mail_from_moderation_queue> |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
$sietima->show_mail_from_moderation_queue($sietima_runner); |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
This method L<retrieves the email|Sietima::MailStore/retrieve_by_id> |
210
|
|
|
|
|
|
|
of the message requested from the command line, and L<prints it |
211
|
|
|
|
|
|
|
out|App::Spec::Runner/out> via the L<< C<Sietima::Runner> >> object. |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
This method is usually invoked from the command line, see L<< |
214
|
|
|
|
|
|
|
/C<command_line_spec> >>. |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
=head2 C<resume_mail_from_moderation_queue> |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
$sietima->resume_mail_from_moderation_queue($sietima_runner); |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
This method L<retrieves the email|Sietima::MailStore/retrieve_by_id> |
221
|
|
|
|
|
|
|
of the message requested from the command line, and L<resumes|/resume> |
222
|
|
|
|
|
|
|
it. |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
This method is usually invoked from the command line, see L<< |
225
|
|
|
|
|
|
|
/C<command_line_spec> >>. |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=head2 C<drop_mail_from_moderation_queue> |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
$sietima->drop_mail_from_moderation_queue($sietima_runner); |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
This method L<retrieves the email|Sietima::MailStore/retrieve_by_id> |
232
|
|
|
|
|
|
|
of the message requested from the command line, and L<drops|/drop> it. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
This method is usually invoked from the command line, see L<< |
235
|
|
|
|
|
|
|
/C<command_line_spec> >>. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=head1 MODIFIED METHODS |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head2 C<command_line_spec> |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
This method adds the following sub-commands for the command line: |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
=over |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item C<list-held> |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
$ sietima list-held |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Invokes the L<< /C<list_mails_in_moderation_queue> >> method, printing |
250
|
|
|
|
|
|
|
the identifiers of all messages held for moderation. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item C<show-held> |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
$ sietima show-held 32946p6eu7867 |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
Invokes the L<< /C<show_mail_from_moderation_queue> >> method, |
257
|
|
|
|
|
|
|
printing one message held for moderation; the identifier is expected |
258
|
|
|
|
|
|
|
as a positional parameter. |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
=item C<resume-held> |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
$ sietima resume-held 32946p6eu7867 |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Invokes the L<< /C<resume> >> method, causing the held message to be |
265
|
|
|
|
|
|
|
processed normally; the identifier is expected as a positional |
266
|
|
|
|
|
|
|
parameter. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=item C<drop-held> |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
$ sietima drop-held 32946p6eu7867 |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
Invokes the L<< /C<drop> >> method, removing the held message; the |
273
|
|
|
|
|
|
|
identifier is expected as a positional parameter. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=back |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
=head1 AUTHOR |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
Gianni Ceccarelli <dakkar@thenautilus.net> |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
This software is copyright (c) 2017 by Gianni Ceccarelli <dakkar@thenautilus.net>. |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
286
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=cut |