2 # fixscript will replace this line with require innshellvars.pl
4 ##############################################################################
5 # perl-nocem - a NoCeM-on-spool implementation for INN 2.x.
6 # Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>
7 # Copyright 2001 by Marco d'Itri <md@linux.it>
8 # This program is licensed under the terms of the GNU General Public License.
12 # 2002: Patch by Steven M. Christey for untrusted printf input.
13 # 2007: Patch by Christoph Biedl for checking a timeout.
14 # Documentation improved by Jeffrey M. Vinocur (2002), Russ Allbery (2006)
15 # and Julien Elie (2007).
17 ##############################################################################
22 # XXX FIXME I haven't been able to load it only when installed.
23 # If nobody can't fix it just ship the program with this line commented.
24 #use Time::HiRes qw(time);
26 my $keyring = $inn::pathetc . '/pgp/ncmring.gpg';
28 # XXX To be moved to a config file.
29 #sub local_want_cancel_id {
30 # my ($group, $hdrs) = @_;
32 ## Hippo has too many false positives to be useful outside of pr0n groups
33 # if ($hdrs->{issuer} =~ /(?:Ultra|Spam)Hippo/) {
34 # foreach (split(/,/, $group)) {
35 # return 1 if /^alt\.(?:binar|sex)/;
42 # no user serviceable parts below this line ###################################
45 my ($working, $got_sighup, $got_sigterm, @ncmperm, $cancel);
50 my $socket_timeout = $inn::peertimeout - 100;
52 my $logfile = $inn::pathlog . '/perl-nocem.log';
54 # initialization and main loop ###############################################
56 eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; };
59 eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf';
60 Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf/;
61 openlog('nocem', '', $inn::syslog_facility);
65 logmsg('cannot find the gpgv binary', 'err');
70 if ($inn::version and not $inn::version =~ /^INN 2\.[0123]\./) {
71 $cancel = \&cancel_nntp;
73 $cancel = \&cancel_ctlinnd;
76 $SIG{HUP} = \&hup_handler;
77 $SIG{INT} = \&term_handler;
78 $SIG{TERM} = \&term_handler;
79 $SIG{PIPE} = \&term_handler;
81 logmsg('starting up');
83 unless (read_ctlfile()) {
93 term_handler() if $got_sigterm;
94 hup_handler() if $got_sighup;
97 logmsg('exiting because of EOF', 'debug');
100 ##############################################################################
102 # Process one NoCeM notice.
107 # open the article and verify the notice
108 my $artfh = open_article($token);
109 return if not defined $artfh;
110 my ($msgid, $nid, $issuer, $nocems) = read_nocem($artfh);
112 return unless $nocems;
115 logmsg("Articles cancelled: " . join(' ', @$nocems), 'debug');
116 my $diff = (time - $start) || 0.01;
117 my $nr = scalar @$nocems;
118 logmsg(sprintf("processed notice %s by %s (%d ids, %.5f s, %.1f/s)",
119 $nid, $issuer, $nr, $diff, $nr / $diff));
122 # - Check if it is a PGP signed NoCeM notice
123 # - See if we want it
124 # - Then check PGP signature
128 # Examine the first 200 lines to see if it is a PGP signed NoCeM.
141 } elsif (/^From:\s+(.*)\s*$/i) {
143 } elsif (/^Message-ID:\s+(<.*>)/i) {
148 $ispgp = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----/;
149 if (/^\@\@BEGIN NCM HEADERS/) {
156 # must be a PGP signed NoCeM.
158 logmsg("Article $msgid: not PGP signed", 'debug');
162 logmsg("Article $msgid: not a NoCeM", 'debug');
166 # read the headers of this NoCeM, and check if it's supported.
171 last if /^\@\@BEGIN NCM BODY/;
172 my ($key, $val) = /^([^:]+)\s*:\s*(.*)$/;
173 $hdrs{lc $key} = $val;
175 foreach (qw(action issuer notice-id type version)) {
177 logmsg("Article $msgid: missing $_ pseudo header", 'debug');
180 return if not supported_nocem($msgid, \%hdrs);
182 # decide if we want it.
183 if (not want_nocem(\%hdrs)) {
184 logmsg("Article $msgid: unwanted ($hdrs{issuer}/$hdrs{type})", 'debug');
187 # XXX want_hier() not implemented
188 # if ($hdrs{hierarchies} and not want_hier($hdrs{hierarchies})) {
189 # logmsg("Article $msgid: unwanted hierarchy ($hdrs{hierarchies})",
194 # We do want it, so read the entire article. Also copy it to
195 # a temp file so that we can check the PGP signature when done.
196 my $tmpfile = "$inn::pathtmp/nocem.$$";
197 if (not open(OFD, ">$tmpfile")) {
198 logmsg("cannot open temp file $tmpfile: $!", 'err');
204 # process NoCeM body.
207 my ($lastid, $lastgrp);
211 $inbody = 0 if /^\@\@END NCM BODY/;
212 next if not $inbody or /^#/;
214 my ($id, $grp) = /^(\S*)\s+(\S+)/;
217 push @nocems, $lastid
218 if $lastid and want_cancel_id($lastgrp, \%hdrs);
222 $lastgrp .= ',' . $grp;
225 push @nocems, $lastid if $lastid and want_cancel_id($lastgrp, \%hdrs);
228 # at this point we need to verify the PGP signature.
229 return if not @nocems;
230 my $e = pgp_check($hdrs{issuer}, $msgid, $tmpfile);
234 return ($msgid, $hdrs{'notice-id'}, $hdrs{issuer}, \@nocems);
237 # XXX not implemented: code to discard notices for groups we don't carry
239 my ($group, $hdrs) = @_;
241 return local_want_cancel_id(@_) if defined &local_want_cancel_id;
245 # Do we actually want this NoCeM?
250 my ($issuer, $type) = split(/\001/);
251 if ($hdrs->{issuer} =~ /$issuer/i) {
252 return 1 if '*' eq $type or lc $hdrs->{type} eq $type;
258 sub supported_nocem {
259 my ($msgid, $hdrs) = @_;
261 if ($hdrs->{version} !~ /^0\.9[0-9]?$/) {
262 logmsg("Article $msgid: version $hdrs->{version} not supported",
266 if ($hdrs->{action} ne 'hide') {
267 logmsg("Article $msgid: action $hdrs->{action} not supported",
274 # Check the PGP signature on an article.
276 my ($issuer, $msgid, $art) = @_;
278 # fork and spawn a child
279 my $pid = open(PFD, '-|');
280 if (not defined $pid) {
281 logmsg("pgp_check: cannot fork: $!", 'err');
285 open(STDERR, '>&STDOUT');
286 exec($inn::gpgv, '--status-fd=1',
287 $keyring ? '--keyring=' . $keyring : '', $art);
291 # Read the result and check status code.
292 local $_ = join('', <PFD>);
298 logmsg("Article $msgid: $inn::gpgv killed by signal " . ($? & 255));
302 # logmsg("Command line was: $inn::gpgv --status-fd=1"
303 # . ($keyring ? ' --keyring=' . $keyring : '') . " $art", 'debug');
304 # logmsg("Full PGP output: >>>$_<<<", 'debug');
306 if (/^\[GNUPG:\]\s+GOODSIG\s+\S+\s+(.*)/m) {
307 return 1 if $1 =~ /\Q$issuer\E/;
308 logmsg("Article $msgid: signed by $1 instead of $issuer");
309 } elsif (/^\[GNUPG:\]\s+NO_PUBKEY\s+(\S+)/m) {
310 logmsg("Article $msgid: $issuer (ID $1) not in keyring");
311 } elsif (/^\[GNUPG:\]\s+BADSIG\s+\S+\s+(.*)/m) {
312 logmsg("Article $msgid: bad signature from $1");
313 } elsif (/^\[GNUPG:\]\s+BADARMOR/m or /^\[GNUPG:\]\s+UNEXPECTED/m) {
314 logmsg("Article $msgid: malformed signature");
315 } elsif (/^\[GNUPG:\]\s+ERRSIG\s+(\S+)/m) {
316 # safety net: we get there if we don't know about some token
317 logmsg("Article $msgid: unknown error (ID $1)");
319 # some other error we don't know about happened.
320 # 126 is returned by the child if exec fails.
321 s/ at \S+ line \d+\.\n$//; s/\n/_/;
322 logmsg("Article $msgid: $inn::gpgv exited "
323 . (($status == 126) ? "($_)" : "with status $status"), 'err');
332 if ($token =~ /^\@.+\@$/) {
333 my $pid = open(ART, '-|');
335 logmsg('Cannot fork: ' . $!, 'err');
339 exec("$inn::newsbin/sm", '-q', $token) or
340 logmsg("Cannot exec sm: $!", 'err');
345 return *ART if open(ART, $token);
346 logmsg("Cannot open article $token: $!", 'err');
351 # Cancel a number of Message-IDs. We use ctlinnd to do this,
352 # and we run up to 15 of them at the same time (10 usually).
357 my $max = @ids <= 15 ? @ids : 10;
358 for (my $i = 1; $i <= $max; $i++) {
359 my $msgid = shift @ids;
361 sleep 5 until (defined ($pid = fork));
363 exec "$inn::pathbin/ctlinnd", '-s', '-t', '180',
367 # logmsg("cancelled: $msgid [$i/$max]", 'debug');
369 # Now wait for all children.
370 while ((my $pid = wait) > 0) {
373 logmsg("Child $pid died with status " . ($? >> 8), 'err');
375 logmsg("Child $pid killed by signal " . ($? & 255), 'err');
385 if ($nntp_open and time - $socket_timeout > $last_cancel) {
386 logmsg('Close socket for timeout');
390 if (not $nntp_open) {
392 if (not socket(NNTP, PF_UNIX, SOCK_STREAM, 0)) {
393 logmsg("socket: $!", 'err');
396 if (not connect(NNTP, sockaddr_un($inn::pathrun . '/nntpin'))) {
397 logmsg("connect: $!", 'err');
400 if (($r = <NNTP>) !~ /^200 /) {
402 logmsg("bad reply from server: $r", 'err');
405 select NNTP; $| = 1; select STDOUT;
406 print NNTP "MODE CANCEL\r\n";
407 if (($r = <NNTP>) !~ /^284 /) {
409 logmsg("MODE CANCEL not supported: $r", 'err');
416 if (($r = <NNTP>) !~ /^289/) {
418 logmsg("cannot cancel $_: $r", 'err');
426 # discard unusable socket
428 logmsg('Switching to ctlinnd...', 'err');
429 cancel_ctlinnd($ids);
430 $cancel = \&cancel_ctlinnd;
434 my $permfile = $inn::pathetc . '/nocem.ctl';
436 unless (open(CTLFILE, $permfile)) {
437 logmsg("Cannot open $permfile: $!", 'err');
443 next if /^#/ or /^$/;
444 my ($issuer, $type) = split(/:/, lc $_);
445 logmsg("Cannot parse nocem.ctl line <<$_>>", 'err')
446 if not $issuer and $type;
448 push @ncmperm, "$issuer\001$_" foreach split(/,/, $type);
455 my ($msg, $lvl) = @_;
457 if (not $use_syslog) {
458 if ($log_open == 0) {
459 open(LOG, ">>$logfile") or die "Cannot open log: $!";
461 select LOG; $| = 1; select STDOUT;
464 print LOG "$lvl: $msg\n";
467 syslog($lvl || 'notice', '%s', $msg);
480 logmsg('exiting because of signal');
485 print $inn::pathrun.$inn::pathlog.$inn::pathetc.$inn::newsbin.$inn::pathbin
486 .$inn::pathtmp.$inn::peertimeout.$inn::syslog_facility;
492 perl-nocem - A NoCeM-on-spool implementation for S<INN 2.x>
500 NoCeM, which is pronounced I<No See 'Em>, is a protocol enabling
501 authenticated third-parties to issue notices which can be used
502 to cancel unwanted articles (like spam and articles in moderated
503 newsgroups which were not approved by their moderators). It can
504 also be used by readers as a I<third-party killfile>. It is
505 intended to eventually replace the protocol for third-party cancel
508 B<perl-nocem> processes third-party, PGP-signed article cancellation
509 notices. It is possible not to honour all NoCeM notices but only those
510 which are sent by people whom you trust (that is to say if you trust
511 the PGP key they use to sign their NoCeM notices). Indeed, it is up
512 to you to decide whether you wish to honour their notices, depending
513 on the criteria they use.
515 Processing NoCeM notices is easy to set up:
521 Import the keys of the NoCeM issuers you trust in order to check
522 the authenticity of their notices. You can do:
524 gpg --no-default-keyring --primary-keyring <pathetc>/pgp/ncmring.gpg --import <key-file>
526 where <pathetc> is the value of the I<pathetc> parameter set in F<inn.conf>
527 and <key-file> the file containing the key(s) to import. The keyring
528 must be located in I<pathetc>/pgp/ncmring.gpg (create the directory
529 before using B<gpg>). For old PGP-generated keys, you may have to use
530 B<--allow-non-selfsigned-uid> if they are not properly self-signed,
531 but anyone creating a key really should self-sign the key. Current
532 PGP implementations do this automatically.
534 The keys of NoCeM issuers can be found in the web site of I<The NoCeM Registry>:
535 L<http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html>. You can even
536 download there a unique file which contains all the keys.
540 Create a F<nocem.ctl> config file in I<pathetc> indicating the NoCeM issuers
541 and notices you want to follow. This permission file contains lines like:
544 clewis@ferret.ocunix:mmf
545 stephane@asynchrone:mmf,openproxy,spam
547 This will remove all articles for which the issuer (first part of the line,
548 before the colon C<:>) has issued NoCeM notices corresponding to the
549 criteria specified after the colon.
551 You will also find information about that on the web site of
552 I<The NoCeM Registry>.
556 Add to the F<newsfeeds> file an entry like this one in order to feed
557 B<perl-nocem> the NoCeM notices posted to alt.nocem.misc and
561 :!*,alt.nocem.misc,news.lists.filters\
562 :Tc,Wf,Ap:<pathbin>/perl-nocem
564 with the correct path to B<perl-nocem>, located in <pathbin>. Then, reload
565 the F<newsfeeds> file (C<ctlinnd reload newsfeeds 'NoCeM channel feed'>).
567 Note that you should at least carry news.lists.filters on your news
568 server (or other newsgroups where NoCeM notices are sent) if you wish
573 Everything should now work. However, do not hesitate to manually test
574 B<perl-nocem> with a NoCeM notice, using:
576 grephistory '<Message-ID>' | perl-nocem
578 Indeed, B<perl-nocem> expects tokens on its standard input, and
579 B<grephistory> can easily give it the token of a known article,
580 thanks to its Message-ID.
584 When you have verified that everything works, you can eventually turn
585 off regular spam cancels, if you want, not processing any longer
586 cancels containing C<cyberspam> in the Path: header (see the
587 I<refusecybercancels> parameter in F<inn.conf>).
593 =item I<pathbin>/perl-nocem
595 The Perl script itself used to process NoCeM notices.
597 =item I<pathetc>/nocem.ctl
599 The configuration file which specifies the NoCeM notices to be processed.
601 =item I<pathetc>/pgp/ncmring.gpg
603 The keyring which contains the public keys of trusted NoCeM issuers.
609 The Subject: header is not checked for the @@NCM string and there is no
610 check for the presence of the References: header.
612 The Newsgroups: pseudo header is not checked, but this can be done in
613 local_want_cancel_id().
615 The Hierarchies: header is ignored.
619 Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>.
621 Copyright 2001 by Marco d'Itri <md@linux.it>.
623 $Id: perl-nocem.in 7733 2008-04-06 09:16:20Z iulius $
627 gpgv(1), grephistory(1), inn.conf(5), newsfeeds(5), pgp(1).