Ticket #57: docheckgroups

File docheckgroups, 7.9 KB (added by eagle, 12 years ago)

Perl docheckgroups with scope support

Line 
1#! /usr/bin/perl
2##  $Revision: 1.9 $
3##  Script to execute checkgroups text; results to stdout.
4
5## Author: Lutz.Donnerhacke@Jena.Thur.De
6## 2000-05-03: file-locking and sanity checks (Urs Janssen <urs@tin.org>)
7## 2000-04-10: & in descriptions weren't quoted (Urs Janssen <urs@tin.org>)
8## 2000-04-01: Added scope support. (Sven Paulus <sven@nntp.de>)
9##             Removed 14 character limit. (Sven Paulus <sven@nntp.de>)
10## 1999-10-06: Fixed moderated bug. (Urs Janssen <urs@tin.org>)
11## 1999-07-05: Fixed moderated bug.
12## 1998-08-17: Added output of old descriptions.
13## 1998-08-12: first version
14
15##  =()<. @<_PATH_SHELLVARS>@>()=
16$pshellvars="/usr/lib/news/innshellvars";
17
18open(CONFIG,"<$pshellvars") || die "Can't read config: $!\n";
19while (<CONFIG>) {
20  chop;
21  if(($name,$val) = /^([A-Z]+)=(.+)$/) {
22    $val =~ s/\$\{([A-Z]+(-([^}]+))?)\}/$ENV{$1} || $3/eg;
23    $ENV{$name} = $val;
24  }
25}
26close(CONFIG);
27
28## wildmat(2)
29sub wildmat {
30  local($text,$pattern) = @_;
31
32  # escape regex metachars but not glob chars
33  $pattern =~ s:([.+^\${}|()\@\\]):\\$1:g;
34  # and wildcards to regex
35  $pattern =~ s/\*/.*/g;
36  $pattern =~ s/\?/.?/g;
37#  $pattern =~ s/^/^/;
38  $pattern =~ s/$/\$/;
39  return ($text =~ /$pattern/);
40}
41
42## scope match (@patterns is defined below, global array)
43sub match {
44  local($text) = @_;
45  $match = 0;
46
47  foreach $pattern (@patterns) {
48    if ($pattern =~ /^!(.*)/) {
49      $match &= !&wildmat($text,$1);
50    } else {
51      $match |= &wildmat($text,$pattern);
52    }
53  }
54  return $match;
55}
56
57##  Copy the article without headers, append local newsgroups.
58$header = 1;
59while (<STDIN>) {
60  chomp;
61  if ($header && /^$/) {
62    $header = 0;
63    $pattern = "*" unless defined $pattern;
64    @patterns = split(/,/,$pattern);
65    next;
66  }
67  if ($header && /^Control:\s+checkgroups\s+(.*)/i) {
68    @elements = split(/\s+/,$1);
69    foreach $a (@elements) {
70      last if ($a =~ /^#/);
71      $pattern .= "," if defined $pattern;
72      $pattern .= $a;
73      $pattern .= ".*" unless ($a =~ /[,\*]/);
74    }
75  }
76  next if $header;
77  last if (/^-- $/);
78  if(! /^\S+\.(\d+|\.all)(\s|\.)/i &&
79     /^(([^W_][-+\w]*)(\.[^W_][-+\w]*)+)\s+(\S.*)/) {
80    next unless &match($1);
81    $tlh{$2} = 1;
82    $newsgroups{$1} = $4;
83    $existing{$1} = 1;
84  } else {
85    $unparsable .= '# ' . $_ . "\n" if (! /^#/);
86  }
87}
88
89if($unparsable) {
90  print "# Entries violating common newsgroup conventions:\n";
91  print $unparsable;
92  print "\n";
93}
94
95## Additional groups in those hierarchies...
96if(-s $ENV{'LOCALGROUPS'}) {
97  open(LOCAL, '<'.$ENV{'LOCALGROUPS'});
98  while(<LOCAL>) {
99    chop;
100#   if(/^(([^.]+)\.\S+)\s+(\S.*)/) {
101    if(/^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s+(\S.*)/) {
102      next unless defined $tlh{$2};
103      next unless &match($1);
104      $newsgroups{$1} = $3;
105      $existing{$1} = 1;
106    }
107  }
108  close(LOCAL);
109}
110
111print "# To process this file pipe it though the following command:\n";
112print "#   ", $ENV{'SED'}, " '1,/^\$/d' | su news\n";
113
114print $ENV{'NEWSBIN'}, "/ctlinnd throttle Checkgroups-\$\$\n\n";
115
116#####B###################################################################
117# checking active
118########################################################################
119open(ACTIVE,'<'.$ENV{'ACTIVE'}) || die "Can't read active '".$ENV{'ACTIVE'}."'\n";
120while(<ACTIVE>) {
121#  if(($group, $tlh, $mode) = /^(([^.]+)\.\S+)\s\d+\s\d+\s([ynmx])/) {
122   if(($group, $tlh, $mode) = /^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s\d+\s\d+\s([ynmx])/) {
123    next unless $tlh{$tlh};
124    next unless &match($group);
125    push(@remove, $group), next unless $newsgroups{$group};
126    delete $existing{$group};
127#    if($newsgroups{$group} =~ / \(Moderated\)\s*/) {
128    if($newsgroups{$group} =~ /\(Moderated\)\s*/) { # don't require a sapce befor (Moderated) , as this will fail for tw.*
129      push(@mod, $group) if $mode eq 'y';
130    } else {
131      push(@unmod, $group) if $mode eq 'm';
132    }
133  }
134}
135close(ACTIVE);
136
137if($#remove >= 0) {
138  print "# The following newsgroups are non-standard.\n";
139  foreach $group (sort @remove) {
140    print $ENV{'NEWSBIN'}, '/ctlinnd rmgroup ', $group, "\n";
141  }
142  print "\n";
143}
144undef @remove;
145
146foreach $group (keys %existing) {
147  push @add, $group;
148}
149undef %existing;
150
151if($#add >= 0) {
152  print "# The following newsgroups were missing and should be added.\n";
153  foreach $group (sort @add) {
154    print $ENV{'NEWSBIN'}, '/ctlinnd newgroup ', $group, ' ';
155    $group =~ /^([^.])\.(.*)$/;
156    if($newsgroups{$group} =~ / \(Moderated\)\s*/) {
157      print 'm';
158    } else {
159      print 'y';
160    }
161    printf ("%s\n", (defined ($ENV{'FROM'}) ? $ENV{'FROM'} : ""));
162  }
163  print "\n";
164}
165undef @add;
166
167########################################################################
168# checking newsgroups
169########################################################################
170open(NEWSGROUPS,'<'.$ENV{'NEWSGROUPS'}) || die "Can't read newsgroups '".$ENV{'NEWSGROUPS'}."'\n";
171while(<NEWSGROUPS>) {
172  chop;
173  if(($group,$tlh,$description) = /^(([^W_][-+\w]*)(?:\.[^W_][-+\w]*)+)\s+(\S.*)$/) {
174    next unless defined $tlh{$tlh};
175    next unless &match($group);
176    if(defined $newsgroups{$group}) {
177      if($newsgroups{$group} ne $description) {
178        $sed .= "  # ${group} ${description}\n";
179        $newsgroups{$group} =~ s-/-\\/-g;
180        $newsgroups{$group} =~ s-&-\\&-g;
181        $sed .= "  /^${group}[ \t]/s/[ \t].*\$/\t".$newsgroups{$group}."/\n";
182      }
183    } else {
184      $sed .= "  /^${group}[ \t]/d\n";
185    }
186    delete $newsgroups{$group};
187  }
188}
189close(NEWSGROUPS);
190
191if(defined $sed) {
192  $printlock = 1;
193  print ". $pshellvars\n";
194  print "LOCK=\${LOCKS}/LOCK.newsgroups\n";
195  print "PID=\$\$\n";
196  print "TRY=0\n";
197  print "MAXTRY=60\n";
198  print "export LOCK MAXTRY PID LOGFILE TRY\n";
199  print "while [ \${TRY} -lt \${MAXTRY} ]; do\n";
200  print "\tshlock -p \${PID} -f \${LOCK} && break\n";
201  print "\tsleep 2\n";
202  print "\tTRY=`expr \${TRY} + 1`\n";
203  print "done\n";
204  print "test \${TRY} -lt \${MAXTRY} || {\n";
205  print "\techo \"Newgroup cannot update newsgroups.  Locked by\" `cat \${LOCK}` 1>&2\n";
206  print "\texit\n";
207  print "}\n\n";
208
209  print "# The following modifications on your newsgroups file are necessary.\n";
210  print $ENV{'SED'}, " '\n";
211  $sed =~ s/'/'\\''/g;
212  print $sed, " ' < ", $ENV{'NEWSGROUPS'}, ' > /tmp/$$',"\n";
213  print 'cp /tmp/$$ ', $ENV{'NEWSGROUPS'}, "\n";
214  print 'rm -f /tmp/$$',"\n\n";
215}
216
217foreach $group (sort keys %newsgroups) {
218  if (!defined($printlock)) {
219    $printlock=1;
220    print ". $pshellvars\n";
221    print "LOCK=\${LOCKS}/LOCK.newsgroups\n";
222    print "PID=\$\$\n";
223    print "TRY=0\n";
224    print "MAXTRY=60\n";
225    print "export LOCK MAXTRY PID LOGFILE TRY\n";
226    print "while [ \${TRY} -lt \${MAXTRY} ]; do\n";
227    print "\tshlock -p \${PID} -f \${LOCK} && break\n";
228    print "\tsleep 2\n";
229    print "\tTRY=`expr \${TRY} + 1`\n";
230    print "done\n";
231    print "test \${TRY} -lt \${MAXTRY} || {\n";
232    print "\techo \"Newgroup cannot update newsgroups.  Locked by\" `cat \${LOCK}` 1>&2\n";
233    print "\texit\n";
234    print "}\n\n";
235  }
236
237  $start = 1, print "# The following groups are missing in your newsgroups file.\n" unless defined $start;
238  $newsgroups{$group} =~ s-'-'\\''-g;
239  print "echo '",$group, "\t", $newsgroups{$group}, "' >>", $ENV{'NEWSGROUPS'}, "\n";
240}
241
242print "\n" if defined $start;
243
244print"rm -f \${TEMP} \${LOCK}\n\n" if (defined($printlock));
245
246########################################################################
247
248print $ENV{'NEWSBIN'}, "/ctlinnd go Checkgroups-\$\$\n";
249
250########################################################################
251# changegroup does not work on throttled servers.
252########################################################################
253
254if($#unmod >= 0) {
255  print "# The following groups are incorrectly marked as moderated.\n";
256  foreach $group (sort @unmod) {
257    print $ENV{'NEWSBIN'}, '/ctlinnd changegroup ', $group, " y\n";
258  }
259  print "\n";
260}
261undef @unmod;
262
263if($#mod >= 0) {
264  print "# The following groups are incorrectly marked as unmoderated.\n";
265  foreach $group (sort @mod) {
266    print $ENV{'NEWSBIN'}, '/ctlinnd changegroup ', $group, " m\n";
267  }
268  print "\n";
269}
270undef @mod;
271
272print "exit\n# end of script\n";