line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package News::Article::NoCeM; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
$VERSION = '0.08'; |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
# -*- Perl -*- Sat Dec 4 21:11:45 CST 2004 |
6
|
|
|
|
|
|
|
############################################################################# |
7
|
|
|
|
|
|
|
# Written by Yen-Ming Lee |
8
|
|
|
|
|
|
|
# Based on a module by Tim Skirvin , and relying almost |
9
|
|
|
|
|
|
|
# exclusively on the News::Article package written by Andrew Gierth |
10
|
|
|
|
|
|
|
# . Thanks, folks. |
11
|
|
|
|
|
|
|
# |
12
|
|
|
|
|
|
|
# Copyright 2004-2005 Yen-Ming Lee. Redistribution terms are in the |
13
|
|
|
|
|
|
|
# documentation, and I'm sure you can find them. |
14
|
|
|
|
|
|
|
############################################################################# |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 NAME |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
News::Article::NoCeM - a module to generate accurate nocem notices |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 SYNOPSIS |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
use News::Article::NoCeM; |
23
|
|
|
|
|
|
|
my $nocem = new News::Article::NoCeM(); |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
$nocem->hide($type, $spam); |
26
|
|
|
|
|
|
|
$nocem->make_notice($type, $name, $issuer, $group, $prefix); |
27
|
|
|
|
|
|
|
$nocem->sign($keyid, $passphrase); |
28
|
|
|
|
|
|
|
$nocem->issue($conn, $ihave); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
=head1 DESCRIPTION |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
Creates a nocem notice on the Usenet articles, which may be posted |
33
|
|
|
|
|
|
|
normally to hide the messages. |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
=head1 USAGE |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=over 2 |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=item use News::Article::NoCeM; |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=back |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
News::Article::NoCeM is class that inherits News::Article and adds four |
44
|
|
|
|
|
|
|
new functions: hide(), make_notice(), sign() and issue(), |
45
|
|
|
|
|
|
|
redefine to disable two functions: post() and ihave(). |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=cut |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
require 5; # Requires Perl 5 |
50
|
|
|
|
|
|
|
|
51
|
1
|
|
|
1
|
|
16177
|
use News::Article; |
|
1
|
|
|
|
|
32022
|
|
|
1
|
|
|
|
|
44
|
|
52
|
1
|
|
|
1
|
|
1163
|
use PGP::Sign; |
|
1
|
|
|
|
|
12192
|
|
|
1
|
|
|
|
|
52
|
|
53
|
1
|
|
|
1
|
|
9
|
use Exporter; |
|
1
|
|
|
|
|
7
|
|
|
1
|
|
|
|
|
25
|
|
54
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
25
|
|
55
|
|
|
|
|
|
|
|
56
|
1
|
|
|
1
|
|
4
|
use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION ); |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
759
|
|
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
@ISA = qw( Exporter News::Article ); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
=head2 Article Methods |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=over 4 |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
=item hide ( TYPE, ARTICLE, [ARTICLE, ...] ) |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
Hide one or more articles in the given C. C is an |
67
|
|
|
|
|
|
|
News::Article object that going to be hid. hide() will skip |
68
|
|
|
|
|
|
|
the articles without Newsgroup or Message-ID and skip the ones |
69
|
|
|
|
|
|
|
already hid. |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
hide() returns the number of the articles hid. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
=cut |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub hide |
76
|
|
|
|
|
|
|
{ |
77
|
1
|
|
|
1
|
1
|
32047
|
my $self = shift; |
78
|
1
|
|
|
|
|
3
|
my $type = shift; |
79
|
1
|
|
|
|
|
3
|
my @articles = @_; |
80
|
1
|
|
|
|
|
2
|
my $num; |
81
|
|
|
|
|
|
|
|
82
|
1
|
|
|
|
|
3
|
foreach my $article (@articles) |
83
|
|
|
|
|
|
|
{ |
84
|
1
|
|
|
|
|
13
|
my $newsgroups = $article->header('newsgroups'); |
85
|
1
|
|
|
|
|
306
|
my $message_id = $article->header('message-id'); |
86
|
1
|
50
|
33
|
|
|
15
|
next if !$newsgroups || !$message_id; |
87
|
1
|
50
|
|
|
|
7
|
next if $self->{'NoCeM'}->{$type}->{$message_id}; |
88
|
1
|
|
|
|
|
3
|
$self->{'NoCeM'}->{$type}->{$message_id} = $newsgroups; |
89
|
1
|
|
|
|
|
4
|
++$num; |
90
|
|
|
|
|
|
|
} |
91
|
1
|
|
|
|
|
5
|
return $num; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
push @EXPORT, qw( hide ); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=item post |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=item ihave |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
post() and ihave() is disabled in News::Article::NoCeM. |
100
|
|
|
|
|
|
|
Please use issue() instead. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub post |
105
|
|
|
|
|
|
|
{ |
106
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
107
|
0
|
|
|
|
|
0
|
die "You should use issue(conn, 0) instead of post() in " . ref($self) . "\n"; |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
push @EXPORT, qw( post ); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
sub ihave |
112
|
|
|
|
|
|
|
{ |
113
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
114
|
0
|
|
|
|
|
0
|
die "You should use issue(conn, 1) instead of ihave() in " . ref($self) . "\n"; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
push @EXPORT, qw( ihave ); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=item make_notice ( TYPE, NAME, GROUP, ISSUER, [ PREFIX ] ) |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Retrive articles marked by hide with C, and make a notice |
121
|
|
|
|
|
|
|
fot them. If there's only one type within a container, then the container |
122
|
|
|
|
|
|
|
itself can be a notice. C is the identifier of the issuer. C is |
123
|
|
|
|
|
|
|
the newsgroup the you will post nocem notice to. C is the email address |
124
|
|
|
|
|
|
|
of the issuer. C is the announcement before the nocem notice, which may |
125
|
|
|
|
|
|
|
explain the criteria of this notice, or where to find your public key for |
126
|
|
|
|
|
|
|
PGP verification. |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
make_notice() returns a News::Article::NoCeM object if success, and return undef |
129
|
|
|
|
|
|
|
if no article is hid. |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
=cut |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub make_notice |
134
|
|
|
|
|
|
|
{ |
135
|
1
|
|
|
1
|
1
|
47
|
my $self = shift; |
136
|
1
|
|
|
|
|
2
|
my $type = shift; |
137
|
1
|
|
|
|
|
2
|
my $name = shift; |
138
|
1
|
|
|
|
|
3
|
my $group = shift; |
139
|
1
|
|
|
|
|
2
|
my $issuer = shift; |
140
|
1
|
|
|
|
|
2
|
my $prefix = shift; |
141
|
|
|
|
|
|
|
|
142
|
1
|
|
|
|
|
2
|
my $now = time(); |
143
|
1
|
|
|
|
|
5
|
my $ncmid = "$name-$type.$now"; |
144
|
1
|
|
|
|
|
2
|
my $count = scalar keys %{ $self->{'NoCeM'}->{$type} }; |
|
1
|
|
|
|
|
4
|
|
145
|
|
|
|
|
|
|
|
146
|
1
|
50
|
|
|
|
4
|
return if !$count; |
147
|
|
|
|
|
|
|
|
148
|
1
|
|
|
|
|
16
|
$self->set_body(); |
149
|
1
|
|
|
|
|
571
|
$self->add_body($prefix); |
150
|
1
|
|
|
|
|
18
|
$self->add_body(""); |
151
|
1
|
|
|
|
|
16
|
$self->add_body("\@\@BEGIN NCM HEADERS |
152
|
|
|
|
|
|
|
Version: 0.9 |
153
|
|
|
|
|
|
|
Issuer: $issuer |
154
|
|
|
|
|
|
|
Type: $type |
155
|
|
|
|
|
|
|
Action: hide |
156
|
|
|
|
|
|
|
Count: $count |
157
|
|
|
|
|
|
|
Notice-ID: $ncmid |
158
|
|
|
|
|
|
|
\@\@BEGIN NCM BODY"); |
159
|
1
|
|
|
|
|
17
|
foreach my $msgid (keys %{ $self->{'NoCeM'}->{$type} }) |
|
1
|
|
|
|
|
5
|
|
160
|
|
|
|
|
|
|
{ |
161
|
1
|
|
|
|
|
6
|
my @groups = split(',', $self->{'NoCeM'}->{$type}->{$msgid}); |
162
|
1
|
|
|
|
|
5
|
$self->add_body("$msgid\t" . shift(@groups)); |
163
|
1
|
|
|
|
|
122
|
foreach my $g (@groups) { $self->add_body("\t$g"); } |
|
0
|
|
|
|
|
0
|
|
164
|
|
|
|
|
|
|
} |
165
|
1
|
|
|
|
|
6
|
$self->add_body("\@\@END NCM BODY"); |
166
|
1
|
|
|
|
|
20
|
$self->set_headers('Subject', "\@\@NCM $name-$type NoCeM notice $now"); |
167
|
1
|
|
|
|
|
17
|
$self->set_headers('Newsgroups', $group); |
168
|
1
|
|
|
|
|
16
|
$self->set_headers('From', $issuer); |
169
|
1
|
|
|
|
|
16
|
$self->set_headers('X-Issued-By', ref($self) . "-" . $VERSION); |
170
|
1
|
|
|
|
|
13
|
$self->set_headers('Path', "nocem!not-for-mail"); |
171
|
1
|
|
|
|
|
19
|
$self->add_date(); |
172
|
1
|
|
|
|
|
80
|
delete($self->{Headers}{'message-id'}); |
173
|
1
|
|
|
|
|
8
|
$self->add_message_id(); |
174
|
1
|
|
|
|
|
41
|
return $self; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
push @EXPORT, qw( make_notice ); |
177
|
|
|
|
|
|
|
|
178
|
|
|
|
|
|
|
=item sign ( KEYID, PASSPHRASE ) |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
Sign the content of the nocem notice with C and C. |
181
|
|
|
|
|
|
|
Please make sure that the issuer's public/secret keyring is ready. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
sign() returns a News::Article::NoCeM object if success, and return undef |
184
|
|
|
|
|
|
|
if no article is hid, or pgp_sign failed. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=cut |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
sub sign |
189
|
|
|
|
|
|
|
{ |
190
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
191
|
0
|
|
|
|
|
|
my $keyid = shift; |
192
|
0
|
|
|
|
|
|
my $passphrase = shift; |
193
|
|
|
|
|
|
|
|
194
|
0
|
0
|
|
|
|
|
return if !scalar(@{$self->body()}); |
|
0
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
|
196
|
0
|
|
|
|
|
|
my $body = join("\n", @{$self->body()}) . "\n"; |
|
0
|
|
|
|
|
|
|
197
|
0
|
|
|
|
|
|
my ($signature, $version) = pgp_sign($keyid, $passphrase, $body); |
198
|
|
|
|
|
|
|
|
199
|
0
|
0
|
|
|
|
|
return if !$signature; |
200
|
|
|
|
|
|
|
|
201
|
0
|
|
|
|
|
|
$self->set_body(); |
202
|
0
|
|
|
|
|
|
$self->add_body("-----BEGIN PGP SIGNED MESSAGE-----"); |
203
|
0
|
|
|
|
|
|
$self->add_body("Hash: SHA1"); |
204
|
0
|
|
|
|
|
|
$self->add_body(""); |
205
|
0
|
|
|
|
|
|
$self->add_body($body); |
206
|
0
|
|
|
|
|
|
$self->add_body(""); |
207
|
0
|
|
|
|
|
|
$self->add_body("-----BEGIN PGP SIGNATURE-----"); |
208
|
0
|
|
|
|
|
|
$self->add_body("Version: $version"); |
209
|
0
|
|
|
|
|
|
$self->add_body(""); |
210
|
0
|
|
|
|
|
|
$self->add_body($signature); |
211
|
0
|
|
|
|
|
|
$self->add_body("-----END PGP SIGNATURE-----"); |
212
|
|
|
|
|
|
|
|
213
|
0
|
|
|
|
|
|
return $self; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
push @EXPORT, qw( sign ); |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
=item issue ( [ CONN, IHAVE ] ) |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
Take optional C as a Net::NNTP object and issue the nocem notice. |
220
|
|
|
|
|
|
|
C indicates that call Net::NNTP::ihave() for submitting the notice, |
221
|
|
|
|
|
|
|
otherwise issue() will call News::Article::post() by default. |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
issue() return the result of News::Article::post() or issue(). |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=back |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
=cut |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub issue |
230
|
|
|
|
|
|
|
{ |
231
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
232
|
0
|
|
|
|
|
|
my $conn = shift; |
233
|
0
|
|
|
|
|
|
my $ihave = shift; |
234
|
|
|
|
|
|
|
|
235
|
0
|
0
|
|
|
|
|
return if !scalar(@{$self->body()}); |
|
0
|
|
|
|
|
|
|
236
|
0
|
0
|
|
|
|
|
return $ihave ? $self->SUPER::ihave($conn) : $self->SUPER::post($conn); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
push @EXPORT, qw( issue ); |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
=head1 NOTES |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
Standard article manipulation information can be read in the News::Article |
243
|
|
|
|
|
|
|
manpages. |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
NoCeM FAQ is available on the web at . |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head1 AUTHOR |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Written by Yen-Ming Lee , based on a module by |
250
|
|
|
|
|
|
|
Tim Skirvin . |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=head1 COPYRIGHT |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Copyright 2004-2005 by Yen-Ming Lee . |
255
|
|
|
|
|
|
|
This code may be redistributed under the same terms as Perl itself. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=cut |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
1; |