#!/usr/local/bin/perl
###########################################################################
# controlchan - read a feed, sniff out control messages, and send them to
# the appropriate script.
#
# updated Mon Aug 31 1998
#
# Give this program its own newsfeed.  Make sure that you've created the
# newsgroup control.cancel so that you don't have to scan through cancels,
# which this program won't process anyway.
#
# Make a newsfeeds entry like this:
#
# controlchan\
#    :!*,control,control.*,!control.cancel\
#    :Tc,Wnsm\
#    :/news/bin/controlchan
#
# And don't forget to comment out the dispatch stuff in art.c!
###########################################################################

require 5.004;

## *** Change this to be correct for your site. *** ##
require "/news/lib/innshellvars.pl" ;

$use_syslog = 0;
## Comment out this eval line if you don't want to try to syslog
eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };

if ($use_syslog) {
    openlog ('controlchan', 'pid', 'news');
    syslog ('notice', 'starting');
}

my $lastctl = 0;

my (@headers, %hdrcount, %hdrval, $msgid, $token, $progname, @progparams,
    $pathhost, @ctllist, $action, $logname, $act_log, $errmsg, @ctlprogs,
    $subfind, $SM, $keyowner, $pgpresult);

# If we have $newsbin/sm, this must be an INN 2.x installation.
# Otherwise, we'll plop in the cat command to fake it on older
# servers.  Sure it would be more efficient to open the article
# directly when it's possible, but I'm lazy.
if (-e "$inn::newsbin/sm") { $SM = "$inn::newsbin/sm -q" }
else { $SM = "cat" }

# Scan the control directory and load *.pl.  This will bring in the
# new-style control scripts.  For controlchan to use a perl control
# instead of falling back to the old shell system, it must be declared
# as a sub in the form control_xxx.  For example, if control_newgroup()
# exists, we will use that when encountering a newgroup control.  If
# control_newgroup() is undefined, we'll use the old shell version.
chdir $inn::controlprogs;
@ctlprogs = <*.pl>;
for (@ctlprogs) {
    next if (/filter_(?:innd|nnrpd)|startup_innd/); #thanks Jeremy
    s/^/$inn::controlprogs\//;
    do($_);
    syslog ('notice', 'loaded %s', $_) if ($use_syslog);
}

CHANITEM:
while (<STDIN>) {
    undef(@headers);
    undef(%hdrcount);
    undef(%hdrval);

    chomp;
    ($token, $sitepath, $msgid) = split(/\s+/, $_);
    if (! ($token =~ /^\@.+\@$/ || /^\//)) {
        $token = $inn::spool . '/' . $token;
    }

    open(ARTICLE, "$SM $token|");

    # suck in headers, normalize the strange ones.
    GETHEADERS:
    while (<ARTICLE>) {
        chomp;
        s/\s+$//;
        last GETHEADERS if $_ =~ /^$/;
        s/^Also-Control:/Control:/i;
        s/^Supersedes:/Control: cancel/i;
        push @headers, $_;
        s/:.+//;
        $hdrcount{lc($_)}++;
    }
    close ARTICLE;

    # warn on failed header retrieval?
if (1) {
    if (! @headers) {
	if ($use_syslog) {
	    syslog ('notice', 'No headers in article %s', $msgid);
	}
	else {
	    print(scalar localtime, ": No headers in article $msgid\n");
	}
        next CHANITEM;
    }
} # (0/1)

    if (! exists $hdrcount{approved}) { $hdrcount{approved} = 0 }

    # check for duplicate controls/supersedes; these are goof-ups or
    # denial-of-service attacks, don't process.
    if ($hdrcount{control} > 1) {
	if ($use_syslog) {
	    syslog ('notice', 'Multiple control headers in article %s', $msgid);
	}
	else {
	    print scalar localtime,
		   ": Multiple control headers in article $msgid\n";
	}
        next CHANITEM;
    }

    # Dig out useful headers.  If duplicates, use the first found.
    # Innd should have weeded out some of this but the paranoia can't hurt.
    for (@headers) {
	my $hdr = $_;
	for ("Sender", "From", "Reply-To", "Control", "Subject") {
            if (($hdr =~ /^$_:/i) && (! defined($hdrval{$_}))) {
                $hdrval{$_} = $hdr;
                $hdrval{$_} =~ s/^[^:]*:\s+//;
            }
        }
    }

    if ((!defined $hdrval{Control}) && ($hdrval{Subject} =~ /^cmsg\s+(.+)/)) {
        $hdrval{Control} = $1;
        $hdrcount{control} = 1;
    }

    next CHANITEM if (! exists $hdrcount{control});

    if (! defined($hdrval{Sender})) {
        $hdrval{Sender} = $hdrval{From};
    }
    $hdrval{Sender} = CleanAddy($hdrval{Sender});

    if (! defined($hdrval{'Reply-To'})) {
        $hdrval{'Reply-To'} = $hdrval{From}
    }
    $hdrval{'Reply-To'} = CleanAddy($hdrval{'Reply-To'});

    $hdrval{Control} =~ s/\s+/ /g;

    if ($hdrval{Control} =~ /\s/) {
        $hdrval{Control} =~ /^(\S+)(\s+)?(.+)?/;
        $progname = lc($1);
        @progparams = split(/\s+/, lc($3));
    }
    else { $progname = lc($hdrval{Control}) }

    next CHANITEM if ($progname =~ /^(cancel)$/);

    if ($progname =~ /[^\w\d]/) {
	if ($use_syslog) {
	    syslog ('notice', 'Naughty control in article %s', $msgid);
	}
	else {
	    print scalar localtime,
		   ": Naughty control in article $msgid\n";
	}
    }

    # Do we want to process the message?  Let's check the permissions.
    ($action, $logname) = split(/=/, ctlperm($progname,
            $hdrval{Sender}, $progparams[0], $token));
    $act_log = $action;
    if ($logname) { $act_log .= "=" . $logname }

    #print(scalar localtime,
    #       ": $progname:$hdrval{Sender}:@progparams:$action=$logname\n");

    if ($action eq "drop") {
        next CHANITEM
    }
    elsif ($action =~ /^_pgp/) {
        $errmsg = "skipping $progname ";
        if ($progparams[0] eq "newgroup") {
            if ($progparams[1] eq "moderated") { $errmsg .= "m " }
            else { $errmsg .= "y " }
        }
        $errmsg .= $hdrval{Sender} . " (pgpverify failed)";

	if ($use_syslog) {
	    syslog ('err', '%s in %s', $errmsg, $msgid);
	}
	else { print scalar localtime, ": $errmsg in $msgid\n" }
        #logger($token, $logname, $errmsg);
	next CHANITEM;
    }

    $subfind = "control_$progname";
    if (defined (&$subfind)) {	# It's a new-style control message.
        if ($use_syslog) {
	    syslog ('notice', '%s, %s %s %s %s, %s, %s, %s',
		    $subfind, join(" ", @progparams), $hdrval{Sender},
		    $hdrval{'Reply-To'}, $token, $sitepath, $act_log,
		    $hdrcount{approved});
	}
	else {
	    print scalar localtime, ": $subfind, ", join(" ", @progparams),
	    ", $hdrval{Sender}, $hdrval{'Reply-To'}, $token, ",
	    "$sitepath, $act_log, $hdrcount{approved}\n";
	}
        &$subfind (join(" ", @progparams), $hdrval{Sender},
	           $hdrval{'Reply-To'}, $token, $sitepath,
	           $act_log, $hdrcount{approved});
    }
    else {                      # old style
        $progname = $inn::controlprogs . '/' . $progname ;
    	if (-e $progname) {
            system("'$progname' '$hdrval{Sender}' " .
                   "'$hdrval{'Reply-To'}' '$token' '$sitepath'");
        }
        else {                  # This replaces the 'default' script.
            if ($logname) {
                logger($token, $logname,
                       "Unknown control message by $hdrval{Sender}");
            }
            else {
            	$progname =~ s/.*\///;
		if ($use_syslog) {
		    syslog ('notice', 'Unknown "%s" control by %s',
			    $progname, $hdrval{Sender});
		}
		else {
		    print(scalar localtime,
		        ": Unknown \"$progname\" control by " .
		        "$hdrval{Sender}\n");
		}
            }
        }
    }
}

closelog() if ($use_syslog);


# Strip a mail address, innd-style.
sub CleanAddy {
        $_ = shift;
        s/(\s+)?\(.*\)(\s+)?//g;
        s/^.*<(.*)>.*$/$1/;
        return $_;
}


# Read control.ctl and put it into @ctllist.
#  Params:  none
#  Returns: none
sub readctlfile {
    my @ctlstat = stat($inn::ctlfile);
    return if ($lastctl == $ctlstat[9]); # mtime hasn't changed.

    undef(@ctllist);
    open(CTLFILE, "<$inn::ctlfile") || die;
    while (<CTLFILE>) {
        chomp;
        # Not a comment or blank? Convert wildmat to regex
        if (/^(\s+)?[^#]/ && ! (/^$/)) {
            s/([\@\$\+\.])/\\$1/g;
            s/\*/.*/g;
            s/\?/./g;
            s/(.*)/^$1\$/;
            s/:/\$:^/g;
            push(@ctllist, $_);
            #print $_,"\n";
        }
    }
    close(CTLFILE);
    $lastctl = $ctlstat[9];
}


# Parse a control message's permissions.
#   Params:  (controltype, sender, newsgroup, token)
#   Returns: action
sub ctlperm {
    my $controltype = shift;
    my $sender = shift;
    my $newsgroup = shift;
    my $token = shift;

    my $action = "drop";

    my @ctlline;

    readctlfile();

    for (@ctllist) {
        @ctlline = split(/:/);
        if ((($controltype =~ /$ctlline[0]/) && ($sender =~ /$ctlline[1]/)) &&
               (($controltype !~ /^(newgroup|rmgroup)$/) ||
                   ($newsgroup =~ $ctlline[2]))) {
            $action = $ctlline[3];
            $action =~ s/.(.+)./$1/;
            $action =~ s/\\//g;
        }
    }

    if ($action =~ /^verify-(.+)/) {
        #print "PGP\n";
	$keyowner = $1;
	$keyowner =~ s/=.+//;
	open(PGPCHECK, "$SM $token|$inn::newsbin/pgpverify|");
	$pgpresult = <PGPCHECK>;
	close PGPCHECK;
	chomp $pgpresult;
        if ($keyowner eq $pgpresult) { $action =~ s/^[^=]+/doit/ }
        else { $action =~ s/^[^=]+/_pgpfail/ }
    }
    return($action);
}

# Write stuff to a log.
#  Params:  (token, logfile, message)
sub logger {
    my $token = shift;
    my $logfile = shift;
    my $message = shift;
    my ($lockfile, $locktry, $lockpid);
    my $pid = $$;

    if ($logfile eq "mail") {
        open(LOGFILE,
	     "|$inn::mailcmd -s '$message' $inn::newsmaster");
        open(ARTICLE, "$SM $token|");
        for (<ARTICLE>) { print LOGFILE ("    ", $_) }
        close (ARTICLE);
        close (LOGFILE);
        return;
    }
    elsif ($logfile !~ /\//) { $logfile = "$inn::most_logs/$logfile.log" }

    my $shlock = "$inn::newsbin/shlock";

    $inn::locks = $inn::locks;
    $lockfile = $logfile;
    $lockfile =~ s/.*\///;
    $lockfile = "$inn::locks/LOCK." . $lockfile;

    # We want to make sure the log is ours.  Use shlock so as not
    # to confuse other programs.
    $locktry = 0;
    GETLOGLOCK: while ($locktry < 60) {
        if (system("$shlock -p $pid -f $lockfile")) {
            $locktry++;
            sleep(2);
        }
        else {
            $locktry = -1;
            last GETLOGLOCK;
        }
    }

    if ($locktry < 0) {        # we got the lock
        open(LOGFILE, ">>$logfile");
        print LOGFILE $message,"\n";
        open(ARTICLE, "$SM $token|");
        for (<ARTICLE>) { print LOGFILE ("    ", $_) }
	print LOGFILE "\n";
        close (ARTICLE);
        close (LOGFILE);
        unlink $lockfile;
    }
    else {
        open LOCKFILE, $lockfile;
        $lockpid = <LOCKFILE>;
        close LOCKFILE;
	if ($use_syslog) {
	    syslog ('err', 'Cannot get lock %s, held by %s',
		    $lockfile, $lockpid);
	}
	else { print "Cannot get lock $lockfile, held by: $lockpid\n" }
    }
}
