+++ /dev/null
-#!/usr/bin/perl -w
-# fixscript will replace this line with require innshellvars.pl
-
-##############################################################################
-# perl-nocem - a NoCeM-on-spool implementation for INN 2.x.
-# Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>
-# Copyright 2001 by Marco d'Itri <md@linux.it>
-# This program is licensed under the terms of the GNU General Public License.
-#
-# List of changes:
-#
-# 2002: Patch by Steven M. Christey for untrusted printf input.
-# 2007: Patch by Christoph Biedl for checking a timeout.
-# Documentation improved by Jeffrey M. Vinocur (2002), Russ Allbery (2006)
-# and Julien Elie (2007).
-#
-##############################################################################
-
-require 5.00403;
-use strict;
-
-# XXX FIXME I haven't been able to load it only when installed.
-# If nobody can't fix it just ship the program with this line commented.
-#use Time::HiRes qw(time);
-
-my $keyring = $inn::pathetc . '/pgp/ncmring.gpg';
-
-# XXX To be moved to a config file.
-#sub local_want_cancel_id {
-# my ($group, $hdrs) = @_;
-#
-## Hippo has too many false positives to be useful outside of pr0n groups
-# if ($hdrs->{issuer} =~ /(?:Ultra|Spam)Hippo/) {
-# foreach (split(/,/, $group)) {
-# return 1 if /^alt\.(?:binar|sex)/;
-# }
-# return 0;
-# }
-# return 1;
-#}
-
-# no user serviceable parts below this line ###################################
-
-# global variables
-my ($working, $got_sighup, $got_sigterm, @ncmperm, $cancel);
-my $use_syslog = 0;
-my $log_open = 0;
-my $nntp_open = 0;
-my $last_cancel = 0;
-my $socket_timeout = $inn::peertimeout - 100;
-
-my $logfile = $inn::pathlog . '/perl-nocem.log';
-
-# initialization and main loop ###############################################
-
-eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; };
-
-if ($use_syslog) {
- eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf';
- Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf/;
- openlog('nocem', '', $inn::syslog_facility);
-}
-
-if (not $inn::gpgv) {
- logmsg('cannot find the gpgv binary', 'err');
- sleep 5;
- exit 1;
-}
-
-if ($inn::version and not $inn::version =~ /^INN 2\.[0123]\./) {
- $cancel = \&cancel_nntp;
-} else {
- $cancel = \&cancel_ctlinnd;
-}
-
-$SIG{HUP} = \&hup_handler;
-$SIG{INT} = \&term_handler;
-$SIG{TERM} = \&term_handler;
-$SIG{PIPE} = \&term_handler;
-
-logmsg('starting up');
-
-unless (read_ctlfile()) {
- sleep 5;
- exit 1;
-}
-
-while (<STDIN>) {
- chop;
- $working = 1;
- do_nocem($_);
- $working = 0;
- term_handler() if $got_sigterm;
- hup_handler() if $got_sighup;
-}
-
-logmsg('exiting because of EOF', 'debug');
-exit 0;
-
-##############################################################################
-
-# Process one NoCeM notice.
-sub do_nocem {
- my $token = shift;
- my $start = time;
-
- # open the article and verify the notice
- my $artfh = open_article($token);
- return if not defined $artfh;
- my ($msgid, $nid, $issuer, $nocems) = read_nocem($artfh);
- close $artfh;
- return unless $nocems;
-
- &$cancel($nocems);
- logmsg("Articles cancelled: " . join(' ', @$nocems), 'debug');
- my $diff = (time - $start) || 0.01;
- my $nr = scalar @$nocems;
- logmsg(sprintf("processed notice %s by %s (%d ids, %.5f s, %.1f/s)",
- $nid, $issuer, $nr, $diff, $nr / $diff));
-}
-
-# - Check if it is a PGP signed NoCeM notice
-# - See if we want it
-# - Then check PGP signature
-sub read_nocem {
- my $artfh = shift;
-
- # Examine the first 200 lines to see if it is a PGP signed NoCeM.
- my $ispgp = 0;
- my $isncm = 0;
- my $inhdr = 1;
- my $i = 0;
- my $body = '';
- my ($from, $msgid);
- while (<$artfh>) {
- last if $i++ > 200;
- s/\r\n$/\n/;
- if ($inhdr) {
- if (/^$/) {
- $inhdr = 0;
- } elsif (/^From:\s+(.*)\s*$/i) {
- $from = $1;
- } elsif (/^Message-ID:\s+(<.*>)/i) {
- $msgid = $1;
- }
- } else {
- $body .= $_;
- $ispgp = 1 if /^-----BEGIN PGP SIGNED MESSAGE-----/;
- if (/^\@\@BEGIN NCM HEADERS/) {
- $isncm = 1;
- last;
- }
- }
- }
-
- # must be a PGP signed NoCeM.
- if (not $ispgp) {
- logmsg("Article $msgid: not PGP signed", 'debug');
- return;
- }
- if (not $isncm) {
- logmsg("Article $msgid: not a NoCeM", 'debug');
- return;
- }
-
- # read the headers of this NoCeM, and check if it's supported.
- my %hdrs;
- while (<$artfh>) {
- s/\r\n/\n/;
- $body .= $_;
- last if /^\@\@BEGIN NCM BODY/;
- my ($key, $val) = /^([^:]+)\s*:\s*(.*)$/;
- $hdrs{lc $key} = $val;
- }
- foreach (qw(action issuer notice-id type version)) {
- next if $hdrs{$_};
- logmsg("Article $msgid: missing $_ pseudo header", 'debug');
- return;
- }
- return if not supported_nocem($msgid, \%hdrs);
-
- # decide if we want it.
- if (not want_nocem(\%hdrs)) {
- logmsg("Article $msgid: unwanted ($hdrs{issuer}/$hdrs{type})", 'debug');
- return;
- }
-# XXX want_hier() not implemented
-# if ($hdrs{hierarchies} and not want_hier($hdrs{hierarchies})) {
-# logmsg("Article $msgid: unwanted hierarchy ($hdrs{hierarchies})",
-# 'debug');
-# return;
-# }
-
- # We do want it, so read the entire article. Also copy it to
- # a temp file so that we can check the PGP signature when done.
- my $tmpfile = "$inn::pathtmp/nocem.$$";
- if (not open(OFD, ">$tmpfile")) {
- logmsg("cannot open temp file $tmpfile: $!", 'err');
- return;
- }
- print OFD $body;
- undef $body;
-
- # process NoCeM body.
- my $inbody = 1;
- my @nocems;
- my ($lastid, $lastgrp);
- while (<$artfh>) {
- s/\r\n$/\n/;
- print OFD;
- $inbody = 0 if /^\@\@END NCM BODY/;
- next if not $inbody or /^#/;
-
- my ($id, $grp) = /^(\S*)\s+(\S+)/;
- next if not $grp;
- if ($id) {
- push @nocems, $lastid
- if $lastid and want_cancel_id($lastgrp, \%hdrs);
- $lastid = $id;
- $lastgrp = $grp;
- } else {
- $lastgrp .= ',' . $grp;
- }
- }
- push @nocems, $lastid if $lastid and want_cancel_id($lastgrp, \%hdrs);
- close OFD;
-
- # at this point we need to verify the PGP signature.
- return if not @nocems;
- my $e = pgp_check($hdrs{issuer}, $msgid, $tmpfile);
- unlink $tmpfile;
- return if not $e;
-
- return ($msgid, $hdrs{'notice-id'}, $hdrs{issuer}, \@nocems);
-}
-
-# XXX not implemented: code to discard notices for groups we don't carry
-sub want_cancel_id {
- my ($group, $hdrs) = @_;
-
- return local_want_cancel_id(@_) if defined &local_want_cancel_id;
- 1;
-}
-
-# Do we actually want this NoCeM?
-sub want_nocem {
- my $hdrs = shift;
-
- foreach (@ncmperm) {
- my ($issuer, $type) = split(/\001/);
- if ($hdrs->{issuer} =~ /$issuer/i) {
- return 1 if '*' eq $type or lc $hdrs->{type} eq $type;
- }
- }
- return 0;
-}
-
-sub supported_nocem {
- my ($msgid, $hdrs) = @_;
-
- if ($hdrs->{version} !~ /^0\.9[0-9]?$/) {
- logmsg("Article $msgid: version $hdrs->{version} not supported",
- 'debug');
- return 0;
- }
- if ($hdrs->{action} ne 'hide') {
- logmsg("Article $msgid: action $hdrs->{action} not supported",
- 'debug');
- return 0;
- }
- return 1;
-}
-
-# Check the PGP signature on an article.
-sub pgp_check {
- my ($issuer, $msgid, $art) = @_;
-
- # fork and spawn a child
- my $pid = open(PFD, '-|');
- if (not defined $pid) {
- logmsg("pgp_check: cannot fork: $!", 'err');
- return 0;
- }
- if ($pid == 0) {
- open(STDERR, '>&STDOUT');
- exec($inn::gpgv, '--status-fd=1',
- $keyring ? '--keyring=' . $keyring : '', $art);
- exit 126;
- }
-
- # Read the result and check status code.
- local $_ = join('', <PFD>);
- my $status = 0;
- if (not close PFD) {
- if ($? >> 8) {
- $status = $? >> 8;
- } else {
- logmsg("Article $msgid: $inn::gpgv killed by signal " . ($? & 255));
- return 0;
- }
- }
-# logmsg("Command line was: $inn::gpgv --status-fd=1"
-# . ($keyring ? ' --keyring=' . $keyring : '') . " $art", 'debug');
-# logmsg("Full PGP output: >>>$_<<<", 'debug');
-
- if (/^\[GNUPG:\]\s+GOODSIG\s+\S+\s+(.*)/m) {
- return 1 if $1 =~ /\Q$issuer\E/;
- logmsg("Article $msgid: signed by $1 instead of $issuer");
- } elsif (/^\[GNUPG:\]\s+NO_PUBKEY\s+(\S+)/m) {
- logmsg("Article $msgid: $issuer (ID $1) not in keyring");
- } elsif (/^\[GNUPG:\]\s+BADSIG\s+\S+\s+(.*)/m) {
- logmsg("Article $msgid: bad signature from $1");
- } elsif (/^\[GNUPG:\]\s+BADARMOR/m or /^\[GNUPG:\]\s+UNEXPECTED/m) {
- logmsg("Article $msgid: malformed signature");
- } elsif (/^\[GNUPG:\]\s+ERRSIG\s+(\S+)/m) {
- # safety net: we get there if we don't know about some token
- logmsg("Article $msgid: unknown error (ID $1)");
- } else {
- # some other error we don't know about happened.
- # 126 is returned by the child if exec fails.
- s/ at \S+ line \d+\.\n$//; s/\n/_/;
- logmsg("Article $msgid: $inn::gpgv exited "
- . (($status == 126) ? "($_)" : "with status $status"), 'err');
- }
- return 0;
-}
-
-# Read article.
-sub open_article {
- my $token = shift;
-
- if ($token =~ /^\@.+\@$/) {
- my $pid = open(ART, '-|');
- if ($pid < 0) {
- logmsg('Cannot fork: ' . $!, 'err');
- return undef;
- }
- if ($pid == 0) {
- exec("$inn::newsbin/sm", '-q', $token) or
- logmsg("Cannot exec sm: $!", 'err');
- return undef;
- }
- return *ART;
- } else {
- return *ART if open(ART, $token);
- logmsg("Cannot open article $token: $!", 'err');
- }
- return undef;
-}
-
-# Cancel a number of Message-IDs. We use ctlinnd to do this,
-# and we run up to 15 of them at the same time (10 usually).
-sub cancel_ctlinnd {
- my @ids = @{$_[0]};
-
- while (@ids > 0) {
- my $max = @ids <= 15 ? @ids : 10;
- for (my $i = 1; $i <= $max; $i++) {
- my $msgid = shift @ids;
- my $pid;
- sleep 5 until (defined ($pid = fork));
- if ($pid == 0) {
- exec "$inn::pathbin/ctlinnd", '-s', '-t', '180',
- 'cancel', $msgid;
- exit 126;
- }
-# logmsg("cancelled: $msgid [$i/$max]", 'debug');
- }
- # Now wait for all children.
- while ((my $pid = wait) > 0) {
- next unless $?;
- if ($? >> 8) {
- logmsg("Child $pid died with status " . ($? >> 8), 'err');
- } else {
- logmsg("Child $pid killed by signal " . ($? & 255), 'err');
- }
- }
- }
-}
-
-sub cancel_nntp {
- my $ids = shift;
- my $r;
-
- if ($nntp_open and time - $socket_timeout > $last_cancel) {
- logmsg('Close socket for timeout');
- close (NNTP);
- $nntp_open = 0;
- }
- if (not $nntp_open) {
- use Socket;
- if (not socket(NNTP, PF_UNIX, SOCK_STREAM, 0)) {
- logmsg("socket: $!", 'err');
- goto ERR;
- }
- if (not connect(NNTP, sockaddr_un($inn::pathrun . '/nntpin'))) {
- logmsg("connect: $!", 'err');
- goto ERR;
- }
- if (($r = <NNTP>) !~ /^200 /) {
- $r =~ s/\r\n$//;
- logmsg("bad reply from server: $r", 'err');
- goto ERR;
- }
- select NNTP; $| = 1; select STDOUT;
- print NNTP "MODE CANCEL\r\n";
- if (($r = <NNTP>) !~ /^284 /) {
- $r =~ s/\r\n$//;
- logmsg("MODE CANCEL not supported: $r", 'err');
- goto ERR;
- }
- $nntp_open = 1;
- }
- foreach (@$ids) {
- print NNTP "$_\r\n";
- if (($r = <NNTP>) !~ /^289/) {
- $r =~ s/\r\n$//;
- logmsg("cannot cancel $_: $r", 'err');
- goto ERR;
- }
- }
- $last_cancel = time;
- return;
-
-ERR:
- # discard unusable socket
- close (NNTP);
- logmsg('Switching to ctlinnd...', 'err');
- cancel_ctlinnd($ids);
- $cancel = \&cancel_ctlinnd;
-}
-
-sub read_ctlfile {
- my $permfile = $inn::pathetc . '/nocem.ctl';
-
- unless (open(CTLFILE, $permfile)) {
- logmsg("Cannot open $permfile: $!", 'err');
- return 0;
- }
- while (<CTLFILE>) {
- chop;
- s/^\s+//; s/\s+$//;
- next if /^#/ or /^$/;
- my ($issuer, $type) = split(/:/, lc $_);
- logmsg("Cannot parse nocem.ctl line <<$_>>", 'err')
- if not $issuer and $type;
- $type =~ s/\s//g;
- push @ncmperm, "$issuer\001$_" foreach split(/,/, $type);
- }
- close CTLFILE;
- return 1;
-}
-
-sub logmsg {
- my ($msg, $lvl) = @_;
-
- if (not $use_syslog) {
- if ($log_open == 0) {
- open(LOG, ">>$logfile") or die "Cannot open log: $!";
- $log_open = 1;
- select LOG; $| = 1; select STDOUT;
- }
- $lvl ||= 'notice';
- print LOG "$lvl: $msg\n";
- return;
- }
- syslog($lvl || 'notice', '%s', $msg);
-}
-
-sub hup_handler {
- $got_sighup = 1;
- return if $working;
- close LOG;
- $log_open = 0;
-}
-
-sub term_handler {
- $got_sigterm = 1;
- return if $working;
- logmsg('exiting because of signal');
- exit 1;
-}
-
-# lint food
-print $inn::pathrun.$inn::pathlog.$inn::pathetc.$inn::newsbin.$inn::pathbin
- .$inn::pathtmp.$inn::peertimeout.$inn::syslog_facility;
-
-__END__
-
-=head1 NAME
-
-perl-nocem - A NoCeM-on-spool implementation for S<INN 2.x>
-
-=head1 SYNOPSIS
-
-perl-nocem
-
-=head1 DESCRIPTION
-
-NoCeM, which is pronounced I<No See 'Em>, is a protocol enabling
-authenticated third-parties to issue notices which can be used
-to cancel unwanted articles (like spam and articles in moderated
-newsgroups which were not approved by their moderators). It can
-also be used by readers as a I<third-party killfile>. It is
-intended to eventually replace the protocol for third-party cancel
-messages.
-
-B<perl-nocem> processes third-party, PGP-signed article cancellation
-notices. It is possible not to honour all NoCeM notices but only those
-which are sent by people whom you trust (that is to say if you trust
-the PGP key they use to sign their NoCeM notices). Indeed, it is up
-to you to decide whether you wish to honour their notices, depending
-on the criteria they use.
-
-Processing NoCeM notices is easy to set up:
-
-=over 4
-
-=item 1.
-
-Import the keys of the NoCeM issuers you trust in order to check
-the authenticity of their notices. You can do:
-
- gpg --no-default-keyring --primary-keyring <pathetc>/pgp/ncmring.gpg --import <key-file>
-
-where <pathetc> is the value of the I<pathetc> parameter set in F<inn.conf>
-and <key-file> the file containing the key(s) to import. The keyring
-must be located in I<pathetc>/pgp/ncmring.gpg (create the directory
-before using B<gpg>). For old PGP-generated keys, you may have to use
-B<--allow-non-selfsigned-uid> if they are not properly self-signed,
-but anyone creating a key really should self-sign the key. Current
-PGP implementations do this automatically.
-
-The keys of NoCeM issuers can be found in the web site of I<The NoCeM Registry>:
-L<http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html>. You can even
-download there a unique file which contains all the keys.
-
-=item 2.
-
-Create a F<nocem.ctl> config file in I<pathetc> indicating the NoCeM issuers
-and notices you want to follow. This permission file contains lines like:
-
- annihilator-1:*
- clewis@ferret.ocunix:mmf
- stephane@asynchrone:mmf,openproxy,spam
-
-This will remove all articles for which the issuer (first part of the line,
-before the colon C<:>) has issued NoCeM notices corresponding to the
-criteria specified after the colon.
-
-You will also find information about that on the web site of
-I<The NoCeM Registry>.
-
-=item 3.
-
-Add to the F<newsfeeds> file an entry like this one in order to feed
-B<perl-nocem> the NoCeM notices posted to alt.nocem.misc and
-news.lists.filters:
-
- nocem!\
- :!*,alt.nocem.misc,news.lists.filters\
- :Tc,Wf,Ap:<pathbin>/perl-nocem
-
-with the correct path to B<perl-nocem>, located in <pathbin>. Then, reload
-the F<newsfeeds> file (C<ctlinnd reload newsfeeds 'NoCeM channel feed'>).
-
-Note that you should at least carry news.lists.filters on your news
-server (or other newsgroups where NoCeM notices are sent) if you wish
-to process them.
-
-=item 4.
-
-Everything should now work. However, do not hesitate to manually test
-B<perl-nocem> with a NoCeM notice, using:
-
- grephistory '<Message-ID>' | perl-nocem
-
-Indeed, B<perl-nocem> expects tokens on its standard input, and
-B<grephistory> can easily give it the token of a known article,
-thanks to its Message-ID.
-
-=back
-
-When you have verified that everything works, you can eventually turn
-off regular spam cancels, if you want, not processing any longer
-cancels containing C<cyberspam> in the Path: header (see the
-I<refusecybercancels> parameter in F<inn.conf>).
-
-=head1 FILES
-
-=over 4
-
-=item I<pathbin>/perl-nocem
-
-The Perl script itself used to process NoCeM notices.
-
-=item I<pathetc>/nocem.ctl
-
-The configuration file which specifies the NoCeM notices to be processed.
-
-=item I<pathetc>/pgp/ncmring.gpg
-
-The keyring which contains the public keys of trusted NoCeM issuers.
-
-=back
-
-=head1 BUGS
-
-The Subject: header is not checked for the @@NCM string and there is no
-check for the presence of the References: header.
-
-The Newsgroups: pseudo header is not checked, but this can be done in
-local_want_cancel_id().
-
-The Hierarchies: header is ignored.
-
-=head1 HISTORY
-
-Copyright 2000 by Miquel van Smoorenburg <miquels@cistron.nl>.
-
-Copyright 2001 by Marco d'Itri <md@linux.it>.
-
-$Id: perl-nocem.in 7733 2008-04-06 09:16:20Z iulius $
-
-=head1 SEE ALSO
-
-gpgv(1), grephistory(1), inn.conf(5), newsfeeds(5), pgp(1).
-
-=cut
~ian / innduct.git / blobdiff