X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=.pc%2Fnocem-gpg-import%2Fcontrol%2Fperl-nocem.in;fp=.pc%2Fnocem-gpg-import%2Fcontrol%2Fperl-nocem.in;h=5630d12709db6851ca29be3642e323c828b7ad1a;hb=8f96ca50aa0f9edfd4cd9597dedeeaea07134f7f;hp=0000000000000000000000000000000000000000;hpb=d5b3cbfbd8f26b8b77ce3ce100a9c13c5a71c8f3;p=innduct.git

diff --git a/.pc/nocem-gpg-import/control/perl-nocem.in b/.pc/nocem-gpg-import/control/perl-nocem.in
new file mode 100644
index 0000000..5630d12
--- /dev/null
+++ b/.pc/nocem-gpg-import/control/perl-nocem.in
@@ -0,0 +1,629 @@
+#!/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