I plan to polish it a bit and then submit it for inclusion in CURRENT. Any comments? It would benefit from a $inn:gpgv variable (which would be used by the new pgpverify too). -- ciao, Marco -- Attached file included as plaintext by Listar -- #!/usr/local/bin/perl -Tw #require '/news/lib/innshellvars.pl'; # XXX FIXME require '/etc/news/innshellvars.pl'; $inn::pathetc = '/etc/news'; $inn::pathlog = $inn::pathrun = $inn::pathtmp = '/tmp'; # XXX FIXME ############################################################################## # perl-nocem - a NoCeM-on-spool implementation for INN 2.x. # Copyright 2000 by Miquel van Smoorenburg # Copyright 2001 by Marco d'Itri # This program is licensed under the terms of the GNU General Public License. ############################################################################## use strict; # If you don't have this module just comment the following line. use Time::HiRes qw(time); my $keyring = $inn::pathetc . '/pgp/ncmring.gpg'; my $debug = 1; # XXX To be moved to a config file. sub local_want_cancel_id { my ($group, $hdrs) = @_; if ($hdrs->{issuer} =~ /SpamHippo/) { foreach (split(/,/, $group)) { return 0 if not /^alt\.(?:binar|sex)/; } } return 1; } # no user servicable parts below this line ################################### my $logfile = "$inn::pathlog/perl-nocem.log"; # global variables my ($working, $got_sighup, $got_sigterm, @ncmperm, $cancel); my $log_open = 0; my $nntp_open = 0; # initialization and main loop ############################################### # Look for the gpgv binary. foreach (split(/:/, $ENV{PATH}), qw(/usr/local/bin /opt/gnu/bin)) { if (-x "$_/gpgv") { $inn::gpgv = "$_/gpgv"; last; } } if (not $inn::gpgv) { logmsg('cannot find the gpgv binary', 'error'); 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 () { 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; # open the article and verify the notice my $artfh = open_article($token); return if not defined $artfh; my ($msgid, $nid, $nocems) = read_article($artfh); close $artfh; return unless $nocems; logmsg("Articles to cancel: " . join(' ', @$nocems), 'debug'); &$cancel($nocems); my $start = time; my $diff = (time - $start) || 0.01; my $nr = scalar @$nocems; logmsg(sprintf("cancel: $nid: done ($nr ids, %.5f s, %.1f/s)", $diff, $nr / $diff)); } # - Check if it is a PGP signed NoCeM notice # - See if we want it # - Then check PGP signature sub read_article { 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("NoCeM $msgid: missing $_ pseudo header", 'debug'); return; } return if not supported_nocem($msgid, \%hdrs); # decide if we want it. if (not want_nocem(\%hdrs)) { logmsg("NoCeM $msgid: unwanted ($hdrs{issuer}/$hdrs{type})"); #debug return; } # if ($hdrs{hierarchies} and not want_hier($hdrs{hierarchies})) { # logmsg("NoCeM $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: $!", 'error'); 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'}, \@nocems); } 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} =~ /\Q$issuer\E/) { return 1 if '*' eq $type or $hdrs->{type} eq $type; } } return 0; } sub supported_nocem { my ($msgid, $hdrs) = @_; if ($hdrs->{version} !~ /^0\.9[0-3]?$/) { logmsg("NoCeM $msgid: version $hdrs->{version} not supported", 'warn'); return 0; } if ($hdrs->{action} ne 'hide') { logmsg("NoCeM $msgid: unknown action $hdrs->{action}", '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: $!", 'error'); 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('', ); 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::gpg $pgpargs $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"), 'error'); } return 0; } # Read article. sub open_article { my $token = shift; if ($token =~ /^\@.+\@$/) { my $pid = open(ART, '-|'); if ($pid < 0) { logmsg('Cannot fork: ' . $!, 'error'); return undef; } if ($pid == 0) { exec("$inn::newsbin/sm", '-q', $token) or logmsg("Cannot exec sm: $!", 'error'); return undef; } return *ART; } else { return *ART if open(ART, $token); logmsg("Cannot open article $token: $!", 'error'); } 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) { exit 0; #XXX FIXME exec "$inn::pathbin/ctlinnd", '-s', '-t', '180', 'cancel', $msgid; exit 126; } # logmsg("cancel: $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), 'error'); } else { logmsg("Child $pid killed by signal " . ($? & 255), 'error'); } } } } sub cancel_nntp { my $ids = shift; my $r; if (not $nntp_open) { use Socket; if (not socket(NNTP, PF_UNIX, SOCK_STREAM, 0)) { logmsg("socket: $!", 'error'); goto ERR; } if (not connect(NNTP, sockaddr_un($inn::pathrun . '/nntpin'))) { logmsg("connect: $!", 'error'); goto ERR; } if (($r = ) !~ /^200 /) { $r =~ s/\r\n$//; logmsg("bad reply from server: $r", 'error'); goto ERR; } select NNTP; $| = 1; select STDOUT; print NNTP "MODE CANCEL\r\n"; if (($r = ) !~ /^284 /) { $r =~ s/\r\n$//; logmsg("MODE CANCEL not supported: $r", 'error'); goto ERR; } $nntp_open = 1; } foreach (@$ids) { print NNTP "$_\r\n"; if (($r = ) !~ /^289/) { $r =~ s/\r\n$//; logmsg("cannot cancel $_: $r", 'error'); } } return; ERR: logmsg('Switching to ctlinnd...'); cancel_ctlinnd($ids); $cancel = \&cancel_ctlinnd; } sub read_ctlfile { my $permfile = $inn::pathetc . '/nocem.ctl'; unless (open(CTLFILE, $permfile)) { logmsg("Cannot open $permfile: $!", 'error'); return 0; } while () { chop; s/^\s+//; s/\s+$//; next if /^#/ or /^$/; my ($issuer, $type) = split(/:/); $type =~ s/\s//g; push @ncmperm, "$issuer\001$_" foreach split(/,/, $type); } close CTLFILE; return 1; } sub logmsg { my ($msg, $lvl) = @_; $lvl ||= 'notice'; print "$lvl: $msg\n"; return; # XXX FIXME return if $lvl and $lvl eq 'debug' and not $debug; 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"; } 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; __END__ =head1 NAME perl-nocem - a NoCeM-on-spool implementation for INN 2.x =head1 SYNOPSIS Add to the newsfeeds file an entry like this one: nocem:!*,alt.nocem.misc,news.lists.filter\ :Tc,Wf,Ap:/usr/local/news/local/nocem-perl Import new keys with: gpg --keyring=/usr/local/news/etc/pgp/ncmring.pgp --import \ --allow-non-selfsigned-uid The nocem.ctl config file contains lines like: annihilator-1@erlenstar.demon.co.uk:* clewis@ferret:mmf,spam =head1 FILES /usr/local/news/etc/nocem.ctl =head1 BUGS The Subject header is not checked for the @@NCM string and there is no check for presence of the References header. The Newsgroups pseudo header is not checked, but this can be done in local_want_cancel_id(). =head1 AUTHORS Copyright 2000 by Miquel van Smoorenburg . Copyright 2001 by Marco d'Itri .