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 \
525 --no-options --allow-non-selfsigned-uid --no-permission-warning \
526 --batch --import <key-file>
528 where <pathetc> is the value of the I<pathetc> parameter set in F<inn.conf>
529 and <key-file> the file containing the key(s) to import. The keyring
530 must be located in I<pathetc>/pgp/ncmring.gpg (create the directory
531 before using B<gpg>). For old PGP-generated keys, you may have to use
532 B<--allow-non-selfsigned-uid> if they are not properly self-signed,
533 but anyone creating a key really should self-sign the key. Current
534 PGP implementations do this automatically.
536 The keys of NoCeM issuers can be found in the web site of I<The NoCeM Registry>:
537 L<http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html>. You can even
538 download there a unique file which contains all the keys.
542 Create a F<nocem.ctl> config file in I<pathetc> indicating the NoCeM issuers
543 and notices you want to follow. This permission file contains lines like:
546 clewis@ferret.ocunix:mmf
547 stephane@asynchrone:mmf,openproxy,spam
549 This will remove all articles for which the issuer (first part of the line,
550 before the colon C<:>) has issued NoCeM notices corresponding to the
551 criteria specified after the colon.
553 You will also find information about that on the web site of
554 I<The NoCeM Registry>.
558 Add to the F<newsfeeds> file an entry like this one in order to feed
559 B<perl-nocem> the NoCeM notices posted to alt.nocem.misc and
563 :!*,alt.nocem.misc,news.lists.filters\
564 :Tc,Wf,Ap:<pathbin>/perl-nocem
566 with the correct path to B<perl-nocem>, located in <pathbin>. Then, reload
567 the F<newsfeeds> file (C<ctlinnd reload newsfeeds 'NoCeM channel feed'>).
569 Note that you should at least carry news.lists.filters on your news
570 server (or other newsgroups where NoCeM notices are sent) if you wish
575 Everything should now work. However, do not hesitate to manually test
576 B<perl-nocem> with a NoCeM notice, using:
578 grephistory '<Message-ID>' | perl-nocem
580 Indeed, B<perl-nocem> expects tokens on its standard input, and
581 B<grephistory> can easily give it the token of a known article,
582 thanks to its Message-ID.
586 When you have verified that everything works, you can eventually turn
587 off regular spam cancels, if you want, not processing any longer
588 cancels containing C<cyberspam> in the Path: header (see the
589 I<refusecybercancels> parameter in F<inn.conf>).
595 =item I<pathbin>/perl-nocem
597 The Perl script itself used to process NoCeM notices.
599 =item I<pathetc>/nocem.ctl
601 The configuration file which specifies the NoCeM notices to be processed.
603 =item I<pathetc>/pgp/ncmring.gpg
605 The keyring which contains the public keys of trusted NoCeM issuers.
611 The Subject: header is not checked for the @@NCM string and there is no
612 check for the presence of the References: header.
614 The Newsgroups: pseudo header is not checked, but this can be done in
615 local_want_cancel_id().
617 The Hierarchies: header is ignored.
621 Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>.
623 Copyright 2001 by Marco d'Itri <md@linux.it>.
625 $Id: perl-nocem.in 7733 2008-04-06 09:16:20Z iulius $
629 gpgv(1), grephistory(1), inn.conf(5), newsfeeds(5), pgp(1).