control/controlchan.in

   1 #! /usr/bin/perl -w
   2 require "/usr/local/news/lib/innshellvars.pl";
   3
   4 ##  $Id: controlchan.in 7591 2006-11-22 07:20:46Z eagle $
   5 ##
   6 ##  Channel feed program to route control messages to an appropriate handler.
   7 ##
   8 ##  Copyright 2001 by Marco d'Itri <md@linux.it>
   9 ##
  10 ##  Redistribution and use in source and binary forms, with or without
  11 ##  modification, are permitted provided that the following conditions
  12 ##  are met:
  13 ##
  14 ##   1. Redistributions of source code must retain the above copyright
  15 ##      notice, this list of conditions and the following disclaimer.
  16 ##
  17 ##   2. Redistributions in binary form must reproduce the above copyright
  18 ##      notice, this list of conditions and the following disclaimer in the
  19 ##      documentation and/or other materials provided with the distribution.
  20 ##
  21 ##  Give this program its own newsfeed.  Make sure that you've created
  22 ##  the newsgroup control.cancel so that you don't have to scan through
  23 ##  cancels, which this program won't process anyway.
  24 ##
  25 ##  Make a newsfeeds entry like this:
  26 ##
  27 ##  controlchan!\
  28 ##     :!*,control,control.*,!control.cancel\
  29 ##     :Tc,Wnsm\
  30 ##     :@prefix@/bin/controlchan
  31
  32 require 5.004_03;
  33 use strict;
  34
  35 delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
  36
  37 # globals
  38 my ($cachedctl, $curmsgid);
  39 my $lastctl = 0;
  40 my $use_syslog = 0;
  41 my $debug = 0;
  42
  43 # setup logging ###########################################################
  44 # do not log to syslog if stderr is connected to a console
  45 if (not -t 2) {
  46     eval { require INN::Syslog; import INN::Syslog; $use_syslog = 1; };
  47     eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1; }
  48         unless $use_syslog;
  49 }
  50
  51 if ($use_syslog) {
  52     eval "sub Sys::Syslog::_PATH_LOG { '/dev/log' }" if $^O eq 'dec_osf';
  53     Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf|freebsd|darwin/;
  54     openlog('controlchan', 'pid', $inn::syslog_facility);
  55 }
  56 logmsg('starting');
  57
  58 # load modules from the control directory #################################
  59 opendir(CTL, $inn::controlprogs)
  60     or logdie("Cannot open $inn::controlprogs: $!", 'crit');
  61 foreach (readdir CTL) {
  62     next if not /^([a-z\.]+\.pl)$/ or not -f "$inn::controlprogs/$_";
  63     eval { require "$inn::controlprogs/$1" };
  64     if ($@) {
  65         $@ =~ s/\n/  /g;
  66         logdie($@, 'crit');
  67     }
  68     logmsg("loaded $inn::controlprogs/$1", 'debug');
  69 }
  70 closedir CTL;
  71
  72 # main loop ###############################################################
  73 while (<STDIN>) {
  74     chop;
  75     my ($token, $sitepath, $msgid) = split(/\s+/, $_);
  76     next if not defined $token;
  77     $sitepath ||= '';
  78     $curmsgid = $msgid || '';
  79
  80     my $artfh = open_article($token);
  81     next if not defined $artfh;
  82
  83     # suck in headers and body, normalize the strange ones
  84     my (@headers, @body, %hdr);
  85     if (not parse_article($artfh, \@headers, \@body, \%hdr)) {
  86         close $artfh;
  87         next;
  88     }
  89     close $artfh or logdie('sm died with status ' . ($? >> 8));
  90
  91     next if not exists $hdr{control};
  92
  93     $curmsgid = $hdr{'message-id'};
  94     my $sender = cleanaddr($hdr{sender} || $hdr{from});
  95     my $replyto = cleanaddr($hdr{'reply-to'} || $hdr{from});
  96
  97     my (@progparams, $progname);
  98     if ($hdr{control} =~ /\s/) {
  99         $hdr{control} =~ /^(\S+)\s+(.+)?/;
 100         $progname = lc $1;
 101         @progparams = split(/\s+/, lc $2) if $2;
 102     } else {
 103         $progname = lc $hdr{control};
 104     }
 105
 106     next if $progname eq 'cancel';
 107
 108     if ($progname !~ /^([a-z]+)$/) {
 109         logmsg("Naughty control in article $curmsgid ($progname)");
 110         next;
 111     }
 112     $progname = $1;
 113
 114     # Do we want to process the message?  Let's check the permissions.
 115     my ($action, $logname, $newsgrouppats) =
 116         ctlperm($progname, $sender, $progparams[0],
 117                 $token, \@headers, \@body);
 118
 119     next if $action eq 'drop';
 120
 121     if ($action eq '_pgpfail') {
 122         my $type = '';
 123         if ($progname and $progname eq 'newgroup') {
 124             if ($progparams[1] and $progparams[1] eq 'moderated') {
 125                 $type = 'm ';
 126             } else {
 127                 $type = 'y ';
 128             }
 129         }
 130         logmsg("skipping $progname $type$sender"
 131             . "(pgpverify failed) in $curmsgid");
 132         next;
 133     }
 134
 135     # used by checkgroups. Convert from perl regexp to grep regexp.
 136     if (local $_ = $newsgrouppats) {
 137         s/\$\|/|/g;
 138         s/[^\\]\.[^*]/?/g;
 139         s/\$//;
 140         s/\.\*/*/g;
 141         s/\\([\$\+\.])/$1/g;
 142         $progparams[0] = $_;
 143     }
 144
 145     # find the appropriate module and call it
 146     my $subname = "control_$progname";
 147     my $subfind = \&$subname;
 148     if (not defined &$subfind) {
 149         if ($logname) {
 150             logger($logname, "Unknown control message by $sender",
 151                 \@headers, \@body);
 152         } else {
 153             logmsg("Unknown \"$progname\" control by $sender");
 154         }
 155         next;
 156     }
 157
 158     my $approved = $hdr{approved} ? 1 : 0;
 159     logmsg("$subname, " . join(' ', @progparams)
 160         . " $sender $replyto $token, $sitepath, $action"
 161         . ($logname ? "=$logname" : '') .", $approved");
 162
 163     &$subfind(\@progparams, $sender, $replyto, $sitepath,
 164         $action, $logname, $approved, \@headers, \@body);
 165 }
 166
 167 closelog() if $use_syslog;
 168 exit 0;
 169
 170 print $inn::most_logs.$inn::syslog_facility.$inn::mta.
 171     $inn::newsmaster.$inn::locks; # lint food
 172
 173 # misc functions ##########################################################
 174 sub parse_article {
 175     my ($artfh, $headers, $body, $hdr) = @_;
 176     my $h;
 177     my %uniquehdr = map { $_ => 1 }    qw(date followup-to from message-id
 178         newsgroups path reply-to subject sender);
 179
 180     while (<$artfh>) {
 181         s/\r?\n$//;
 182         last if /^$/;
 183         push @$headers, $_;
 184         if (/^(\S+):\s+(.+)/) {
 185             $h = lc $1;
 186             if (exists $hdr->{$h}) {
 187                 if (exists $uniquehdr{$h}) {
 188                     logmsg("Multiple $1 headers in article $curmsgid");
 189                     return 0;
 190                 }
 191                 $hdr->{$h} .= ' ' . $2;
 192             } else {
 193                 $hdr->{$h} = $2;
 194             }
 195             next;
 196         } elsif (/^\s+(.+)/) {
 197             if (defined $h) {
 198                 $hdr->{$h} .= ' ' . $1;
 199                 next;
 200             }
 201         }
 202         logmsg("Broken headers in article $curmsgid");
 203         return 0;
 204     }
 205
 206     # article is empty or does not exist
 207     return 0 if not @$headers;
 208
 209     chop (@$body = <$artfh>);
 210     return 1;
 211 }
 212
 213 # Strip a mail address, innd-style.
 214 sub cleanaddr {
 215     local $_ = shift;
 216     s/(\s+)?\(.*\)(\s+)?//g;
 217     s/.*<(.*)>.*/$1/;
 218     s/[^-a-zA-Z0-9+_.@%]/_/g;    # protect MTA
 219     s/^-/_/;                    # protect MTA
 220     return $_;
 221 }
 222
 223 # Read and cache control.ctl.
 224 sub readctlfile {
 225     my $mtime = (stat($inn::ctlfile))[9];
 226     return $cachedctl if $lastctl == $mtime;    # mtime has not changed.
 227     $lastctl = $mtime;
 228
 229     my @ctllist;
 230     open(CTLFILE, $inn::ctlfile)
 231         or logdie("Cannot open $inn::ctlfile: $!", 'crit');
 232     while (<CTLFILE>) {
 233         chop;
 234         # Not a comment or blank? Convert wildmat to regex
 235         next if not /^(\s+)?[^\#]/ or /^$/;
 236         if (not /:(?:doit|doifarg|drop|log|mail|verify-.*)(?:=.*)?$/) {
 237             s/.*://;
 238             logmsg("$_ is not a valid action for control.ctl", 'err');
 239             next;
 240         }
 241         # Convert to a : separated list of regexps
 242         s/^all:/*:/i;
 243         s/([\$\+\.])/\\$1/g;
 244         s/\*/.*/g;
 245         s/\?/./g;
 246         s/(.*)/^$1\$/;
 247         s/:/\$:^/g;
 248         s/\|/\$|^/g;
 249         push @ctllist, $_;
 250     }
 251     close CTLFILE;
 252
 253     logmsg('warning: control.ctl is empty!', 'err') if not @ctllist;
 254     return $cachedctl = [ reverse @ctllist ];
 255 }
 256
 257 # Parse a control message's permissions.
 258 sub ctlperm {
 259     my ($type, $sender, $newsgroup, $token, $headers, $body) = @_;
 260
 261     my $action = 'drop';    # default
 262     my ($logname, $hier);
 263
 264     # newgroup and rmgroup require newsgroup names; check explicitly for that
 265     # here and return drop if the newsgroup is missing (to avoid a bunch of
 266     # warnings from undefined values later on in permission checking).
 267     if ($type eq 'newgroup' or $type eq 'rmgroup') {
 268         unless ($newsgroup) {
 269             return ('drop', undef, undef);
 270         }
 271     }
 272
 273     my $ctllist = readctlfile();
 274     foreach (@$ctllist) {
 275         my @ctlline = split /:/;
 276         # 0: type  1: from@addr  2: group.*  3: action
 277         if ($type =~ /$ctlline[0]/ and $sender =~ /$ctlline[1]/i and
 278             ($type !~ /(?:new|rm)group/ or $newsgroup =~ /$ctlline[2]/)) {
 279             $action = $ctlline[3];
 280             $action =~ s/\^(.+)\$/$1/;
 281             $action =~ s/\\//g;
 282             $hier = $ctlline[2] if $type eq 'checkgroups';
 283             last;
 284         }
 285     }
 286
 287     ($action, $logname) = split(/=/, $action);
 288
 289     if ($action =~ /^verify-(.+)/) {
 290         my $keyowner = $1;
 291         if ($inn::pgpverify and $inn::pgpverify =~ /^(?:true|on|yes)$/i) {
 292             my $pgpresult = defined &local_pgpverify ?
 293                 local_pgpverify($token, $headers, $body) : pgpverify($token);
 294             if ($keyowner eq $pgpresult) {
 295                 $action = 'doit';
 296             } else {
 297                 $action = '_pgpfail';
 298             }
 299         } else {
 300             $action = 'mail';
 301         }
 302     }
 303
 304     return ($action, $logname, $hier);
 305 }
 306
 307 # Write stuff to a log or send mail to the news admin.
 308 sub logger {
 309     my ($logfile, $message, $headers, $body) = @_;
 310
 311     if ($logfile eq 'mail') {
 312         my $mail = sendmail($message);
 313         print $mail map { s/^~/~~/; "$_\n" } @$headers;
 314         print $mail "\n" . join ('', map { s/^~/~~/; "$_\n" } @$body)
 315             if $body;
 316         close $mail or logdie("Cannot send mail: $!");
 317         return;
 318     }
 319
 320     if ($logfile =~ /^([^.\/].*)/) {
 321         $logfile = $1;
 322     } else {
 323         logmsg("Invalid log file: $logfile", 'err');
 324         $logfile = 'control';
 325     }
 326
 327     $logfile = "$inn::most_logs/$logfile.log" unless $logfile =~ /^\//;
 328     my $lockfile = $logfile;
 329     $lockfile =~ s#.*/##;
 330     $lockfile = "$inn::locks/LOCK.$lockfile";
 331     shlock($lockfile);
 332
 333     open(LOGFILE, ">>$logfile") or logdie("Cannot open $logfile: $!");
 334     print LOGFILE "$message\n";
 335     foreach (@$headers, '', @$body, '') {
 336         print LOGFILE "    $_\n";
 337     }
 338     close LOGFILE;
 339     unlink $lockfile;
 340 }
 341
 342 # write to syslog or errlog
 343 sub logmsg {
 344     my ($msg, $lvl) = @_;
 345
 346     return if $lvl and $lvl eq 'debug' and not $debug;
 347     if ($use_syslog) {
 348         syslog($lvl || 'notice', '%s', $msg);
 349     } else {
 350         print STDERR (scalar localtime) . ": $msg\n";
 351     }
 352 }
 353
 354 # log a message and then die
 355 sub logdie {
 356     my ($msg, $lvl) = @_;
 357
 358     $msg .= " ($curmsgid)" if $curmsgid;
 359     logmsg($msg, $lvl || 'err');
 360     exit 1;
 361 }
 362
 363 # wrappers executing external programs ####################################
 364
 365 # Open an article appropriately to our storage method (or lack thereof).
 366 sub open_article {
 367     my $token = shift;
 368
 369     if ($token =~ /^\@.+\@$/) {
 370         my $pid = open(ART, '-|');
 371         logdie('Cannot fork: ' . $!) if $pid < 0;
 372         if ($pid == 0) {
 373             exec("$inn::newsbin/sm", '-q', $token) or
 374                 logdie("Cannot exec sm: $!");
 375         }
 376         return *ART;
 377     } else {
 378         return *ART if open(ART, $token);
 379         logmsg("Cannot open article $token: $!");
 380     }
 381     return undef;
 382 }
 383
 384 sub pgpverify {
 385     my $token = shift;
 386
 387     if ($token =~ /^\@.+\@$/) {
 388         open(PGPCHECK, "$inn::newsbin/sm -q $token "
 389             . "| $inn::newsbin/pgpverify |") or goto ERROR;
 390     } else {
 391         open(PGPCHECK, "$inn::newsbin/pgpverify < $token |") or goto ERROR;
 392     }
 393     my $pgpresult = <PGPCHECK>;
 394     close PGPCHECK or goto ERROR;
 395     $pgpresult ||= '';
 396     chop $pgpresult;
 397     return $pgpresult;
 398 ERROR:
 399     logmsg("pgpverify failed: $!", 'debug');
 400     return '';
 401 }
 402
 403 sub ctlinnd {
 404     my ($cmd, @args) = @_;
 405
 406     my $st = system("$inn::newsbin/ctlinnd", '-s', $cmd, @args);
 407     logdie('Cannot run ctlinnd: ' . $!) if $st == -1;
 408     logdie('ctlinnd returned status ' . ($st & 255)) if $st > 0;
 409 }
 410
 411 sub shlock {
 412     my $lockfile = shift;
 413
 414     my $locktry = 0;
 415     while ($locktry < 60) {
 416         if (system("$inn::newsbin/shlock", '-p', $$, '-f', $lockfile) == 0) {
 417             return 1;
 418         }
 419         $locktry++;
 420         sleep 2;
 421     }
 422
 423     my $lockreason;
 424     if (open(LOCKFILE, $lockfile)) {
 425         $lockreason = 'held by ' . (<LOCKFILE> || '?');
 426         close LOCKFILE;
 427     } else {
 428         $lockreason = $!;
 429     }
 430     logdie("Cannot get lock $lockfile: $lockreason");
 431     return undef;
 432 }
 433
 434 # If $body is not defined, returns a file handle which must be closed.
 435 # Don't forget checking the return value of close().
 436 # $addresses may be a scalar or a reference to a list of addresses.
 437 # If not defined, $inn::newsmaster is the default.
 438 # parts of this code stolen from innmail.pl
 439 sub sendmail {
 440     my ($subject, $addresses, $body) = @_;
 441     $addresses = [ $addresses || $inn::newsmaster ] if not ref $addresses;
 442     $subject ||= '(no subject)';
 443
 444     # fix up all addresses
 445     my @addrs = map { s#[^-a-zA-Z0-9+_.@%]##g; $_ } @$addresses;
 446
 447     my $sm = $inn::mta;
 448     if ($sm =~ /%s/) {
 449         $sm = sprintf($sm, join(' ', @addrs));
 450     } else {
 451         $sm .= ' ' . join(' ', @addrs);
 452     }
 453
 454     # fork and spawn the MTA whitout using the shell
 455     my $pid = open(MTA, '|-');
 456     logdie('Cannot fork: ' . $!) if $pid < 0;
 457     if ($pid == 0) {
 458         exec(split(/\s+/, $sm)) or logdie("Cannot exec $sm: $!");
 459     }
 460
 461     print MTA 'To: ' . join(",\n\t", @addrs) . "\nSubject: $subject\n\n";
 462     return *MTA if not defined $body;
 463     $body = join("\n", @$body) if ref $body eq 'ARRAY';
 464     print MTA $body . "\n";
 465     close MTA or logdie("Execution of $sm failed: $!");
 466     return 1;
 467 }