control/perl-nocem.in

   1 #!/usr/bin/perl -w
   2 # fixscript will replace this line with require innshellvars.pl
   3
   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.
   9 #
  10 # List of changes:
  11 #
  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).
  16 #
  17 ##############################################################################
  18
  19 require 5.00403;
  20 use strict;
  21
  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);
  25
  26 my $keyring = $inn::pathetc . '/pgp/ncmring.gpg';
  27
  28 # XXX To be moved to a config file.
  29 #sub local_want_cancel_id {
  30 #    my ($group, $hdrs) = @_;
  31 #
  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)/;
  36 #        }
  37 #        return 0;
  38 #    }
  39 #    return 1;
  40 #}
  41
  42 # no user serviceable parts below this line ###################################
  43
  44 # global variables
  45 my ($working, $got_sighup, $got_sigterm, @ncmperm, $cancel);
  46 my $use_syslog = 0;
  47 my $log_open = 0;
  48 my $nntp_open = 0;
  49 my $last_cancel = 0;
  50 my $socket_timeout = $inn::peertimeout - 100;
  51
  52 my $logfile = $inn::pathlog . '/perl-nocem.log';
  53
  54 # initialization and main loop ###############################################
  55
  56 eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; };
  57
  58 if ($use_syslog) {
  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);
  62 }
  63
  64 if (not $inn::gpgv) {
  65     logmsg('cannot find the gpgv binary', 'err');
  66     sleep 5;
  67     exit 1;
  68 }
  69
  70 if ($inn::version and not $inn::version =~ /^INN 2\.[0123]\./) {
  71     $cancel = \&cancel_nntp;
  72 } else {
  73     $cancel = \&cancel_ctlinnd;
  74 }
  75
  76 $SIG{HUP}  = \&hup_handler;
  77 $SIG{INT}  = \&term_handler;
  78 $SIG{TERM} = \&term_handler;
  79 $SIG{PIPE} = \&term_handler;
  80
  81 logmsg('starting up');
  82
  83 unless (read_ctlfile()) {
  84     sleep 5;
  85     exit 1;
  86 }
  87
  88 while (<STDIN>) {
  89     chop;
  90     $working = 1;
  91     do_nocem($_);
  92     $working = 0;
  93     term_handler() if $got_sigterm;
  94     hup_handler() if $got_sighup;
  95 }
  96
  97 logmsg('exiting because of EOF', 'debug');
  98 exit 0;
  99
 100 ##############################################################################
 101
 102 # Process one NoCeM notice.
 103 sub do_nocem {
 104     my $token = shift;
 105     my $start = time;
 106
 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);
 111     close $artfh;
 112     return unless $nocems;
 113
 114     &$cancel($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));
 120 }
 121
 122 # - Check if it is a PGP signed NoCeM notice
 123 # - See if we want it
 124 # - Then check PGP signature
 125 sub read_nocem {
 126     my $artfh = shift;
 127
 128     # Examine the first 200 lines to see if it is a PGP signed NoCeM.
 129     my $ispgp = 0;
 130     my $isncm = 0;
 131     my $inhdr = 1;
 132     my $i = 0;
 133     my $body = '';
 134     my ($from, $msgid);
 135     while (<$artfh>) {
 136         last if $i++ > 200;
 137         s/\r\n$/\n/;
 138         if ($inhdr) {
 139             if (/^$/) {
 140                 $inhdr = 0;
 141             } elsif (/^From:\s+(.*)\s*$/i) {
 142                 $from =  $1;
 143             } elsif (/^Message-ID:\s+(<.*>)/i) {
 144                 $msgid = $1;
 145             }
 146         } else {
 147             $body .= $_;
 148             $ispgp = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----/;
 149             if (/^\@\@BEGIN NCM HEADERS/) {
 150                 $isncm = 1;
 151                 last;
 152             }
 153         }
 154     }
 155
 156     # must be a PGP signed NoCeM.
 157     if (not $ispgp) {
 158         logmsg("Article $msgid: not PGP signed", 'debug');
 159         return;
 160     }
 161     if (not $isncm) {
 162         logmsg("Article $msgid: not a NoCeM", 'debug');
 163         return;
 164     }
 165
 166     # read the headers of this NoCeM, and check if it's supported.
 167     my %hdrs;
 168     while (<$artfh>) {
 169         s/\r\n/\n/;
 170         $body .= $_;
 171         last if /^\@\@BEGIN NCM BODY/;
 172         my ($key, $val) = /^([^:]+)\s*:\s*(.*)$/;
 173         $hdrs{lc $key} = $val;
 174     }
 175     foreach (qw(action issuer notice-id type version)) {
 176         next if $hdrs{$_};
 177         logmsg("Article $msgid: missing $_ pseudo header", 'debug');
 178         return;
 179     }
 180     return if not supported_nocem($msgid, \%hdrs);
 181
 182     # decide if we want it.
 183     if (not want_nocem(\%hdrs)) {
 184         logmsg("Article $msgid: unwanted ($hdrs{issuer}/$hdrs{type})", 'debug');
 185         return;
 186     }
 187 # XXX want_hier() not implemented
 188 #    if ($hdrs{hierarchies} and not want_hier($hdrs{hierarchies})) {
 189 #        logmsg("Article $msgid: unwanted hierarchy ($hdrs{hierarchies})",
 190 #            'debug');
 191 #        return;
 192 #    }
 193
 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');
 199         return;
 200     }
 201     print OFD $body;
 202     undef $body;
 203
 204     # process NoCeM body.
 205     my $inbody = 1;
 206     my @nocems;
 207     my ($lastid, $lastgrp);
 208     while (<$artfh>) {
 209         s/\r\n$/\n/;
 210         print OFD;
 211         $inbody = 0 if /^\@\@END NCM BODY/;
 212         next if not $inbody or /^#/;
 213
 214         my ($id, $grp) = /^(\S*)\s+(\S+)/;
 215         next if not $grp;
 216         if ($id) {
 217             push @nocems, $lastid
 218                 if $lastid and want_cancel_id($lastgrp, \%hdrs);
 219             $lastid = $id;
 220             $lastgrp = $grp;
 221         } else {
 222             $lastgrp .= ',' . $grp;
 223         }
 224     }
 225     push @nocems, $lastid if $lastid and want_cancel_id($lastgrp, \%hdrs);
 226     close OFD;
 227
 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);
 231     unlink $tmpfile;
 232     return if not $e;
 233
 234     return ($msgid, $hdrs{'notice-id'}, $hdrs{issuer}, \@nocems);
 235 }
 236
 237 # XXX not implemented: code to discard notices for groups we don't carry
 238 sub want_cancel_id {
 239     my ($group, $hdrs) = @_;
 240
 241     return local_want_cancel_id(@_) if defined &local_want_cancel_id;
 242     1;
 243 }
 244
 245 # Do we actually want this NoCeM?
 246 sub want_nocem {
 247     my $hdrs = shift;
 248
 249     foreach (@ncmperm) {
 250         my ($issuer, $type) = split(/\001/);
 251         if ($hdrs->{issuer} =~ /$issuer/i) {
 252             return 1 if '*' eq $type or lc $hdrs->{type} eq $type;
 253         }
 254     }
 255     return 0;
 256 }
 257
 258 sub supported_nocem {
 259     my ($msgid, $hdrs) = @_;
 260
 261     if ($hdrs->{version} !~ /^0\.9[0-9]?$/) {
 262         logmsg("Article $msgid: version $hdrs->{version} not supported",
 263             'debug');
 264         return 0;
 265     }
 266     if ($hdrs->{action} ne 'hide') {
 267         logmsg("Article $msgid: action $hdrs->{action} not supported",
 268             'debug');
 269         return 0;
 270     }
 271     return 1;
 272 }
 273
 274 # Check the PGP signature on an article.
 275 sub pgp_check {
 276     my ($issuer, $msgid, $art) = @_;
 277
 278     # fork and spawn a child
 279     my $pid = open(PFD, '-|');
 280     if (not defined $pid) {
 281         logmsg("pgp_check: cannot fork: $!", 'err');
 282         return 0;
 283     }
 284     if ($pid == 0) {
 285         open(STDERR, '>&STDOUT');
 286         exec($inn::gpgv, '--status-fd=1',
 287             $keyring ? '--keyring=' . $keyring : '', $art);
 288         exit 126;
 289     }
 290
 291     # Read the result and check status code.
 292     local $_ = join('', <PFD>);
 293     my $status = 0;
 294     if (not close PFD) {
 295         if ($? >> 8) {
 296             $status = $? >> 8;
 297         } else {
 298             logmsg("Article $msgid: $inn::gpgv killed by signal " . ($? & 255));
 299             return 0;
 300         }
 301     }
 302 #    logmsg("Command line was: $inn::gpgv --status-fd=1"
 303 #         . ($keyring ? ' --keyring=' . $keyring : '') . " $art", 'debug');
 304 #    logmsg("Full PGP output: >>>$_<<<", 'debug');
 305
 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)");
 318     } else {
 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');
 324     }
 325     return 0;
 326 }
 327
 328 # Read article.
 329 sub open_article {
 330     my $token = shift;
 331
 332     if ($token =~ /^\@.+\@$/) {
 333         my $pid = open(ART, '-|');
 334         if ($pid < 0) {
 335             logmsg('Cannot fork: ' . $!, 'err');
 336             return undef;
 337         }
 338         if ($pid == 0) {
 339             exec("$inn::newsbin/sm", '-q', $token) or
 340                 logmsg("Cannot exec sm: $!", 'err');
 341             return undef;
 342         }
 343         return *ART;
 344     } else {
 345         return *ART if open(ART, $token);
 346         logmsg("Cannot open article $token: $!", 'err');
 347     }
 348     return undef;
 349 }
 350
 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).
 353 sub cancel_ctlinnd {
 354     my @ids = @{$_[0]};
 355
 356     while (@ids > 0) {
 357         my $max = @ids <= 15 ? @ids : 10;
 358         for (my $i = 1; $i <= $max; $i++) {
 359             my $msgid = shift @ids;
 360             my $pid;
 361             sleep 5 until (defined ($pid = fork));
 362             if ($pid == 0) {
 363                 exec "$inn::pathbin/ctlinnd", '-s', '-t', '180',
 364                     'cancel', $msgid;
 365                 exit 126;
 366             }
 367 #            logmsg("cancelled: $msgid [$i/$max]", 'debug');
 368         }
 369         #    Now wait for all children.
 370         while ((my $pid = wait) > 0) {
 371             next unless $?;
 372             if ($? >> 8) {
 373                 logmsg("Child $pid died with status " . ($? >> 8), 'err');
 374             } else {
 375                 logmsg("Child $pid killed by signal " . ($? & 255), 'err');
 376             }
 377         }
 378     }
 379 }
 380
 381 sub cancel_nntp {
 382     my $ids = shift;
 383     my $r;
 384
 385     if ($nntp_open and time - $socket_timeout > $last_cancel) {
 386         logmsg('Close socket for timeout');
 387         close (NNTP);
 388         $nntp_open = 0;
 389     }
 390     if (not $nntp_open) {
 391         use Socket;
 392         if (not socket(NNTP, PF_UNIX, SOCK_STREAM, 0)) {
 393             logmsg("socket: $!", 'err');
 394             goto ERR;
 395         }
 396         if (not connect(NNTP, sockaddr_un($inn::pathrun . '/nntpin'))) {
 397             logmsg("connect: $!", 'err');
 398             goto ERR;
 399         }
 400         if (($r = <NNTP>) !~ /^200 /) {
 401             $r =~ s/\r\n$//;
 402             logmsg("bad reply from server: $r", 'err');
 403             goto ERR;
 404         }
 405         select NNTP; $| = 1; select STDOUT;
 406         print NNTP "MODE CANCEL\r\n";
 407         if (($r = <NNTP>) !~ /^284 /) {
 408             $r =~ s/\r\n$//;
 409             logmsg("MODE CANCEL not supported: $r", 'err');
 410             goto ERR;
 411         }
 412         $nntp_open = 1;
 413     }
 414     foreach (@$ids) {
 415         print NNTP "$_\r\n";
 416         if (($r = <NNTP>) !~ /^289/) {
 417             $r =~ s/\r\n$//;
 418             logmsg("cannot cancel $_: $r", 'err');
 419             goto ERR;
 420         }
 421     }
 422     $last_cancel = time;
 423     return;
 424
 425 ERR:
 426     # discard unusable socket
 427     close (NNTP);
 428     logmsg('Switching to ctlinnd...', 'err');
 429     cancel_ctlinnd($ids);
 430     $cancel = \&cancel_ctlinnd;
 431 }
 432
 433 sub read_ctlfile {
 434     my $permfile = $inn::pathetc . '/nocem.ctl';
 435
 436     unless (open(CTLFILE, $permfile)) {
 437         logmsg("Cannot open $permfile: $!", 'err');
 438         return 0;
 439     }
 440     while (<CTLFILE>) {
 441         chop;
 442         s/^\s+//; s/\s+$//;
 443         next if /^#/ or /^$/;
 444         my ($issuer, $type) = split(/:/, lc $_);
 445         logmsg("Cannot parse nocem.ctl line <<$_>>", 'err')
 446             if not $issuer and $type;
 447         $type =~ s/\s//g;
 448         push @ncmperm, "$issuer\001$_" foreach split(/,/, $type);
 449     }
 450     close CTLFILE;
 451     return 1;
 452 }
 453
 454 sub logmsg {
 455     my ($msg, $lvl) = @_;
 456
 457     if (not $use_syslog) {
 458         if ($log_open == 0) {
 459             open(LOG, ">>$logfile") or die "Cannot open log: $!";
 460             $log_open = 1;
 461             select LOG; $| = 1; select STDOUT;
 462         }
 463         $lvl ||= 'notice';
 464         print LOG "$lvl: $msg\n";
 465         return;
 466     }
 467     syslog($lvl || 'notice', '%s', $msg);
 468 }
 469
 470 sub hup_handler {
 471     $got_sighup = 1;
 472     return if $working;
 473     close LOG;
 474     $log_open = 0;
 475 }
 476
 477 sub term_handler {
 478     $got_sigterm = 1;
 479     return if $working;
 480     logmsg('exiting because of signal');
 481     exit 1;
 482 }
 483
 484 # lint food
 485 print $inn::pathrun.$inn::pathlog.$inn::pathetc.$inn::newsbin.$inn::pathbin
 486     .$inn::pathtmp.$inn::peertimeout.$inn::syslog_facility;
 487
 488 __END__
 489
 490 =head1 NAME
 491
 492 perl-nocem - A NoCeM-on-spool implementation for S<INN 2.x>
 493
 494 =head1 SYNOPSIS
 495
 496 perl-nocem
 497
 498 =head1 DESCRIPTION
 499
 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
 506 messages.
 507
 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.
 514
 515 Processing NoCeM notices is easy to set up:
 516
 517 =over 4
 518
 519 =item 1.
 520
 521 Import the keys of the NoCeM issuers you trust in order to check
 522 the authenticity of their notices.  You can do:
 523
 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>
 527
 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.
 535
 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.
 539
 540 =item 2.
 541
 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:
 544
 545     annihilator-1:*
 546     clewis@ferret.ocunix:mmf
 547     stephane@asynchrone:mmf,openproxy,spam
 548
 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.
 552
 553 You will also find information about that on the web site of
 554 I<The NoCeM Registry>.
 555
 556 =item 3.
 557
 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
 560 news.lists.filters:
 561
 562     nocem!\
 563         :!*,alt.nocem.misc,news.lists.filters\
 564         :Tc,Wf,Ap:<pathbin>/perl-nocem
 565
 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'>).
 568
 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
 571 to process them.
 572
 573 =item 4.
 574
 575 Everything should now work.  However, do not hesitate to manually test
 576 B<perl-nocem> with a NoCeM notice, using:
 577
 578     grephistory '<Message-ID>' | perl-nocem
 579
 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.
 583
 584 =back
 585
 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>).
 590
 591 =head1 FILES
 592
 593 =over 4
 594
 595 =item I<pathbin>/perl-nocem
 596
 597 The Perl script itself used to process NoCeM notices.
 598
 599 =item I<pathetc>/nocem.ctl
 600
 601 The configuration file which specifies the NoCeM notices to be processed.
 602
 603 =item I<pathetc>/pgp/ncmring.gpg
 604
 605 The keyring which contains the public keys of trusted NoCeM issuers.
 606
 607 =back
 608
 609 =head1 BUGS
 610
 611 The Subject: header is not checked for the @@NCM string and there is no
 612 check for the presence of the References: header.
 613
 614 The Newsgroups: pseudo header is not checked, but this can be done in
 615 local_want_cancel_id().
 616
 617 The Hierarchies: header is ignored.
 618
 619 =head1 HISTORY
 620
 621 Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>.
 622
 623 Copyright 2001 by Marco d'Itri <md@linux.it>.
 624
 625 $Id: perl-nocem.in 7733 2008-04-06 09:16:20Z iulius $
 626
 627 =head1 SEE ALSO
 628
 629 gpgv(1), grephistory(1), inn.conf(5), newsfeeds(5), pgp(1).
 630
 631 =cut