#!@_PATH_PERL@
# $Id: controlchan.in,v 1.21.2.3 2000/01/25 03:58:42 kondou Exp $
# Copyright (c)1998 G.J. Andruk
###########################################################################
# controlchan - read a feed, sniff out control messages, and send them
# to the appropriate script.
#
# 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\
#    :@prefix@/bin/controlchan
#
###########################################################################

require 5.004;

use IPC::Open2; # Makes mailing easier.

$ENV{'PATH'} = '/bin:/usr/bin';
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

## *** Change this to be correct for your site. *** ##
require "@LIBDIR@/innshellvars.pl" ;
$inn::newslib = "@LIBDIR@"; # location of docheckgroups

# hackage for pre-2.0 INNs.
if (!$inn::pathhost) {
  $inn::pathhost = `$inn::newsbin/innconfval pathhost`;
  chomp $inn::pathhost;
}
@inn::mailcmd = split /\s+/, $inn::mailcmd; #for nonstandard mailers
my $use_syslog = 0;

## Comment out this line if you don't want to try to syslog
my $try_syslog = 1;


if ($try_syslog) {
  eval { require INN::Syslog; import INN::Syslog; $use_syslog = 1 };
  if (!$use_syslog) {
    eval { require Sys::Syslog; import Sys::Syslog; $use_syslog = 1 };
  }
}
if ($use_syslog) {
  if (defined &Sys::Syslog::setlogsock && $] >= 5.00403) {
    # we really need a common module to work all this junk out
    if ($^O eq "dec_osf") {
      sub Sys::Syslog::_PATH_LOG { "/dev/log" }
    }
    Sys::Syslog::setlogsock('unix') if $^O =~ /linux|dec_osf/;
  }
  openlog ('controlchan', 'pid', 'news');
}

logmsg ('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, $ArtFH,
    $sitepath, $newsgrouppats, $kid);

# If we have $newsbin/sm, this must be an INN 2.x installation.
# Otherwise, we'll fake it on older servers.
if (-e "$inn::newsbin/sm") {
  if ($inn::storageapi =~ /true|yes|on/i) {
    $SM = "$inn::newsbin/sm -q";
  } else {
    $SM = "cat";
  }
} 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.

# This stuff looks weird, but perl -T doesn't like globbing.  It's our
# private directory, we should be able to trust it.
opendir CTL, $inn::controlprogs or die ("can't open ctlprogs");
@ctlprogs=grep { /\.pl$/ && !/filter_(?:innd|nnrpd)|startup_innd/ &&
		   -f "$inn::controlprogs/$_" } readdir(CTL);
closedir CTL;
for (@ctlprogs) {
  if (/(^[a-z.]+$)/) {
    do "$inn::controlprogs/$1";
    logmsg ('notice', 'loaded $inn::controlprogs/%s', $1);
  }
}

CHANITEM:
while (<STDIN>) {
  undef(@headers);
  undef(@progparams);
  undef(%hdrcount);
  undef(%hdrval);
  
  chomp;
  ($token, $sitepath, $msgid) = split(/\s+/, $_);
  $token = $inn::spool . '/' . $token if ! ($token =~ /^\@.+\@$/ || /^\//);  
  
  $ArtFH = open_article($token);
  next if (!defined($ArtFH));
  *ARTICLE = $ArtFH;
  
  # 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 (! @headers) {
    logmsg ('notice', 'No headers in article %s', $msgid);
    next CHANITEM;
  }
  
  $hdrcount{approved} = 0 if ! exists $hdrcount{approved};  
  
  # check for duplicate controls/supersedes; these are goof-ups or
  # denial-of-service attacks, don't process.
  if ($hdrcount{control} > 1) {
    logmsg ('notice', 'Multiple control headers in article %s', $msgid);
    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});
  
  $hdrval{Sender} = $hdrval{From} if ! defined($hdrval{Sender});  
  $hdrval{Sender} = CleanAddy($hdrval{Sender});
  $hdrval{'Reply-To'} = $hdrval{From} if ! defined($hdrval{'Reply-To'});  
  $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 !~ /(^[a-z]+$)/) {
    logmsg ('notice', 'Naughty control in article %s', $msgid);
  } else {
    $progname = $1;
  }
  
  ($action, $logname, $newsgrouppats) =
    split(/=/, ctlperm($progname, $hdrval{Sender}, $progparams[0], $token));
  
  # Do we want to process the message?  Let's check the permissions.
  $act_log = $action;
  $act_log .= "=" . $logname if $logname;  
  if ($newsgrouppats) {
    $newsgrouppats =~ s/\$\|/\|/g;
    $newsgrouppats =~ s/[^\\]\.[^*]/\?/g;
    $newsgrouppats =~ s/^(.*)\$/$1/g;
    $newsgrouppats =~ s/\.\*/*/g;
    $newsgrouppats =~ s/\\([\@\$\+\.])/$1/g;
  }
  
  #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)";
    
    logmsg ('err', '%s in %s', $errmsg, $msgid);
    #logger($token, $logname, $errmsg);
    next CHANITEM;
  }
  
  $subfind = "control_$progname";
  if (defined (&$subfind)) {	# It's a new-style control message.
    logmsg ('notice', '%s, %s %s %s %s, %s, %s, %s',
	    $subfind, join(" ", @progparams), $hdrval{Sender},
	    $hdrval{'Reply-To'}, $token, $sitepath, $act_log,
	    $hdrcount{approved});
    
    &$subfind (join(" ", @progparams), $hdrval{Sender},
	       $hdrval{'Reply-To'}, $token, $sitepath,
	       $act_log, $hdrcount{approved}, $newsgrouppats);
  } 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/.*\///;
	logmsg ('notice', 'Unknown "%s" control by %s',
		$progname, $hdrval{Sender});
      }
    }
  }
}
closelog() if ($use_syslog);


# Strip a mail address, innd-style.
sub CleanAddy {
  $_ = shift;
  s/(\s+)?\(.*\)(\s+)?//g;
  s/^.*<(.*)>.*$/$1/;
  s/[^-a-zA-Z0-9+_.@%]//g;	# protect /bin/mail
  s/^-//;			# protect /bin/mail    	 
  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/^all:/\*:/i;
      s/([\@\$\+\.])/\\$1/g;
      s/\*/.*/g;
      s/\?/./g;
      s/(.*)/^$1\$/;
      s/:/\$:^/g;
      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 ($controltype eq "checkgroups") {
	$action .= "=" if $action !~ /=/;  
	$action .= "=" . $ctlline[2];
      }
    }
  }
  
  if ($action =~ /^verify-(.+)/) {
    $keyowner = $1;
    if ((!$inn::want_pgpverify) &&
	(not $inn::pgpverify or $inn::pgpverify !~ /true|on|yes/i)) {
      $action = "mail";
    } else {
      $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 or send mail to the news admin.
#  Params:  (token, logfile, message)
sub logger {
  my $token = shift;
  my $logfile = shift;
  my $message = shift;
  my ($lockfile, $locktry, $lockpid);
  my $pid = $$;
  my $tempfile = "$inn::tmpdir/controlchan.$pid";
  
  if ($logfile =~ /(^[^.\/].*)/ ) {
    $logfile = $1;
  } else {
    $logfile = "control";
  }
  
  if ($logfile eq "mail") {
    $ArtFH = open_article($token);
    next if (!defined($ArtFH));
    *ARTICLE = $ArtFH;
    $kid = open2(\*R, \*MAIL, @inn::mailcmd, "-s", $message, $inn::newsmaster);
    for (<ARTICLE>) {
      print MAIL ("    ", $_);
    }
    close (ARTICLE);
    close R;
    close MAIL;
    waitpid($kid, 0);
    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";
    
    $ArtFH = open_article($token);
    next if (!defined($ArtFH));
    *ARTICLE = $ArtFH;
    
    for (<ARTICLE>) {
      print LOGFILE ("    ", $_);
    }
    print LOGFILE "\n";
    close (ARTICLE);
    close (LOGFILE);
    unlink $lockfile;
  } else {
    open LOCKFILE, $lockfile;
    $lockpid = <LOCKFILE>;
    close LOCKFILE;
    logmsg('err', 'Cannot get lock %s, held by %s',
	   $lockfile, $lockpid);
  }
}


# Open an article appropriately to our storage method (or lack thereof).
sub open_article {
  my $token = shift;
  local(*ART);
  
  my $fail = 0;
  if ($SM eq "cat") {
    $fail = 1 if (!open(ART,"<$token"));
  } else {
    $fail = 1 if (!open(ART, "$SM $token|"));
  }
  if ($fail) {
    logmsg ('notice', 'Cannot open article %s using method %s: %s',
	    $token, $SM, $!);
  }
  return(*ART);
}


# write to syslog or errlog
sub logmsg {
  my $lvl = shift;
  my $fmt = shift;
  
  if ($use_syslog) {
    syslog($lvl, $fmt, @_);
  } else {
    printf("%s: $fmt\n", scalar localtime, @_);
  }
}