Ticket #57: docheckgroups

#! /usr/bin/perl
##  $Revision: 1.9 $
##  Script to execute checkgroups text; results to stdout.

## Author: Lutz.Donnerhacke@Jena.Thur.De
## 2000-05-03: file-locking and sanity checks (Urs Janssen <urs@tin.org>)
## 2000-04-10: & in descriptions weren't quoted (Urs Janssen <urs@tin.org>)
## 2000-04-01: Added scope support. (Sven Paulus <sven@nntp.de>)
##             Removed 14 character limit. (Sven Paulus <sven@nntp.de>)
## 1999-10-06: Fixed moderated bug. (Urs Janssen <urs@tin.org>)
## 1999-07-05: Fixed moderated bug.
## 1998-08-17: Added output of old descriptions.
## 1998-08-12: first version

##  =()<. @<_PATH_SHELLVARS>@>()=
$pshellvars="/usr/lib/news/innshellvars";

open(CONFIG,"<$pshellvars") || die "Can't read config: $!\n";
while (<CONFIG>) {
  chop;
  if(($name,$val) = /^([A-Z]+)=(.+)$/) {
    $val =~ s/\$\{([A-Z]+(-([^}]+))?)\}/$ENV{$1} || $3/eg;
    $ENV{$name} = $val;
  }
}
close(CONFIG);

## wildmat(2)
sub wildmat {
  local($text,$pattern) = @_;

  # escape regex metachars but not glob chars
  $pattern =~ s:([.+^\${}|()\@\\]):\\$1:g;
  # and wildcards to regex
  $pattern =~ s/\*/.*/g;
  $pattern =~ s/\?/.?/g;
#  $pattern =~ s/^/^/;
  $pattern =~ s/$/\$/;
  return ($text =~ /$pattern/);
}

## scope match (@patterns is defined below, global array)
sub match {
  local($text) = @_;
  $match = 0;

  foreach $pattern (@patterns) {
    if ($pattern =~ /^!(.*)/) {
      $match &= !&wildmat($text,$1);
    } else {
      $match |= &wildmat($text,$pattern);
    }
  }
  return $match;
}

##  Copy the article without headers, append local newsgroups.
$header = 1;
while (<STDIN>) {
  chomp;
  if ($header && /^$/) {
    $header = 0;
    $pattern = "*" unless defined $pattern;
    @patterns = split(/,/,$pattern);
    next;
  }
  if ($header && /^Control:\s+checkgroups\s+(.*)/i) {
    @elements = split(/\s+/,$1);
    foreach $a (@elements) {
      last if ($a =~ /^#/);
      $pattern .= "," if defined $pattern;
      $pattern .= $a;
      $pattern .= ".*" unless ($a =~ /[,\*]/);
    }
  }
  next if $header;
  last if (/^-- $/);
  if(! /^\S+\.(\d+|\.all)(\s|\.)/i &&
     /^(([^W_][-+\w]*)(\.[^W_][-+\w]*)+)\s+(\S.*)/) {
    next unless &match($1);
    $tlh{$2} = 1;
    $newsgroups{$1} = $4;
    $existing{$1} = 1;
  } else {
    $unparsable .= '# ' . $_ . "\n" if (! /^#/);
  }
}

if($unparsable) {
  print "# Entries violating common newsgroup conventions:\n";
  print $unparsable;
  print "\n";
}

## Additional groups in those hierarchies...
if(-s $ENV{'LOCALGROUPS'}) {
  open(LOCAL, '<'.$ENV{'LOCALGROUPS'});
  while(<LOCAL>) {
    chop;
#   if(/^(([^.]+)\.\S+)\s+(\S.*)/) {
    if(/^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s+(\S.*)/) {
      next unless defined $tlh{$2};
      next unless &match($1);
      $newsgroups{$1} = $3;
      $existing{$1} = 1;
    }
  }
  close(LOCAL);
}

print "# To process this file pipe it though the following command:\n";
print "#   ", $ENV{'SED'}, " '1,/^\$/d' | su news\n";

print $ENV{'NEWSBIN'}, "/ctlinnd throttle Checkgroups-\$\$\n\n";

#####B###################################################################
# checking active
########################################################################
open(ACTIVE,'<'.$ENV{'ACTIVE'}) || die "Can't read active '".$ENV{'ACTIVE'}."'\n";
while(<ACTIVE>) {
#  if(($group, $tlh, $mode) = /^(([^.]+)\.\S+)\s\d+\s\d+\s([ynmx])/) {
   if(($group, $tlh, $mode) = /^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s\d+\s\d+\s([ynmx])/) {
    next unless $tlh{$tlh};
    next unless &match($group);
    push(@remove, $group), next unless $newsgroups{$group};
    delete $existing{$group};
#    if($newsgroups{$group} =~ / \(Moderated\)\s*/) {
    if($newsgroups{$group} =~ /\(Moderated\)\s*/) { # don't require a sapce befor (Moderated) , as this will fail for tw.*
      push(@mod, $group) if $mode eq 'y';
    } else {
      push(@unmod, $group) if $mode eq 'm';
    }
  }
}
close(ACTIVE);

if($#remove >= 0) {
  print "# The following newsgroups are non-standard.\n";
  foreach $group (sort @remove) {
    print $ENV{'NEWSBIN'}, '/ctlinnd rmgroup ', $group, "\n";
  }
  print "\n";
}
undef @remove;

foreach $group (keys %existing) {
  push @add, $group;
}
undef %existing;

if($#add >= 0) {
  print "# The following newsgroups were missing and should be added.\n";
  foreach $group (sort @add) {
    print $ENV{'NEWSBIN'}, '/ctlinnd newgroup ', $group, ' ';
    $group =~ /^([^.])\.(.*)$/;
    if($newsgroups{$group} =~ / \(Moderated\)\s*/) {
      print 'm';
    } else {
      print 'y';
    }
    printf ("%s\n", (defined ($ENV{'FROM'}) ? $ENV{'FROM'} : ""));
  }
  print "\n";
}
undef @add;

########################################################################
# checking newsgroups
########################################################################
open(NEWSGROUPS,'<'.$ENV{'NEWSGROUPS'}) || die "Can't read newsgroups '".$ENV{'NEWSGROUPS'}."'\n";
while(<NEWSGROUPS>) {
  chop;
  if(($group,$tlh,$description) = /^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s+(\S.*)$/) {
    next unless defined $tlh{$tlh};
    next unless &match($group);
    if(defined $newsgroups{$group}) {
      if($newsgroups{$group} ne $description) {
        $sed .= "  # ${group} ${description}\n";
        $newsgroups{$group} =~ s-/-\\/-g;
        $newsgroups{$group} =~ s-&-\\&-g;
        $sed .= "  /^${group}[ \t]/s/[ \t].*\$/\t".$newsgroups{$group}."/\n";
      }
    } else {
      $sed .= "  /^${group}[ \t]/d\n";
    }
    delete $newsgroups{$group};
  }
}
close(NEWSGROUPS);

if(defined $sed) {
  $printlock = 1;
  print ". $pshellvars\n";
  print "LOCK=\${LOCKS}/LOCK.newsgroups\n";
  print "PID=\$\$\n";
  print "TRY=0\n";
  print "MAXTRY=60\n";
  print "export LOCK MAXTRY PID LOGFILE TRY\n";
  print "while [ \${TRY} -lt \${MAXTRY} ]; do\n";
  print "\tshlock -p \${PID} -f \${LOCK} && break\n";
  print "\tsleep 2\n";
  print "\tTRY=`expr \${TRY} + 1`\n";
  print "done\n";
  print "test \${TRY} -lt \${MAXTRY} || {\n";
  print "\techo \"Newgroup cannot update newsgroups.  Locked by\" `cat \${LOCK}` 1>&2\n";
  print "\texit\n";
  print "}\n\n";

  print "# The following modifications on your newsgroups file are necessary.\n";
  print $ENV{'SED'}, " '\n";
  $sed =~ s/'/'\\''/g;
  print $sed, " ' < ", $ENV{'NEWSGROUPS'}, ' > /tmp/$$',"\n";
  print 'cp /tmp/$$ ', $ENV{'NEWSGROUPS'}, "\n";
  print 'rm -f /tmp/$$',"\n\n";
}

foreach $group (sort keys %newsgroups) {
  if (!defined($printlock)) {
    $printlock=1;
    print ". $pshellvars\n";
    print "LOCK=\${LOCKS}/LOCK.newsgroups\n";
    print "PID=\$\$\n";
    print "TRY=0\n";
    print "MAXTRY=60\n";
    print "export LOCK MAXTRY PID LOGFILE TRY\n";
    print "while [ \${TRY} -lt \${MAXTRY} ]; do\n";
    print "\tshlock -p \${PID} -f \${LOCK} && break\n";
    print "\tsleep 2\n";
    print "\tTRY=`expr \${TRY} + 1`\n";
    print "done\n";
    print "test \${TRY} -lt \${MAXTRY} || {\n";
    print "\techo \"Newgroup cannot update newsgroups.  Locked by\" `cat \${LOCK}` 1>&2\n";
    print "\texit\n";
    print "}\n\n";
  }

  $start = 1, print "# The following groups are missing in your newsgroups file.\n" unless defined $start;
  $newsgroups{$group} =~ s-'-'\\''-g;
  print "echo '",$group, "\t", $newsgroups{$group}, "' >>", $ENV{'NEWSGROUPS'}, "\n";
}

print "\n" if defined $start;

print"rm -f \${TEMP} \${LOCK}\n\n" if (defined($printlock));

########################################################################

print $ENV{'NEWSBIN'}, "/ctlinnd go Checkgroups-\$\$\n";

########################################################################
# changegroup does not work on throttled servers.
########################################################################

if($#unmod >= 0) {
  print "# The following groups are incorrectly marked as moderated.\n";
  foreach $group (sort @unmod) {
    print $ENV{'NEWSBIN'}, '/ctlinnd changegroup ', $group, " y\n";
  }
  print "\n";
}
undef @unmod;

if($#mod >= 0) {
  print "# The following groups are incorrectly marked as unmoderated.\n";
  foreach $group (sort @mod) {
    print $ENV{'NEWSBIN'}, '/ctlinnd changegroup ', $group, " m\n";
  }
  print "\n";
}
undef @mod;

print "exit\n# end of script\n";