Version 1.4. Added checkgroups checking. Added group name in several

error messages (for help w/batch processing).  Disabled moderator address
checking.  Adjusted newsgroups line (ie, tabbing fixed), now correctly
substituted into control message.
This commit is contained in:
David Lawrence 1998-09-03 22:29:51 +00:00
parent 7ca4c4a7c2
commit 109e601f91

View file

@ -1,7 +1,13 @@
#!/usr/local/bin/perl5 -w #!/usr/local/bin/perl5 -w
# written April 1996, tale@isc.org (David C Lawrence) # written April 1996, tale@isc.org (David C Lawrence)
# Version 1.3 # Version 1.4
# #
# Changes from 1.3 to 1.4:
# -- added checkgroups checking
# -- added group name in several error messages (for help w/batch processing)
# -- disabled moderator address checking
# -- adjusted newsgroups line (ie, tabbing fixed) now correctly substituted
# into control message.
# Changes from 1.2.3 to 1.3: # Changes from 1.2.3 to 1.3:
# -- skip minor pgp signature headers like "charset:" after "version:" header # -- skip minor pgp signature headers like "charset:" after "version:" header
# and until the empty line that starts the base64 signature block # and until the empty line that starts the base64 signature block
@ -90,7 +96,7 @@ $hierarchies = 'HIERARCHIES';
# means that the item is an absolute requirement of the specification # means that the item is an absolute requirement of the specification
# MUST is preferred, but might not be acceptable if you have legacy # MUST is preferred, but might not be acceptable if you have legacy
# newsgroups that have name components that begin with a letter, like # newsgroups that have name components that begin with a letter, like
# news.announce.newgrups does with comp.sys.3b1 and 17 other groups. # news.announce.newgroups does with comp.sys.3b1 and 17 other groups.
$start_component_with_letter = 'MUST'; $start_component_with_letter = 'MUST';
@ -232,18 +238,17 @@ readbody
$body = $_ = <STDIN>; $body = $_ = <STDIN>;
$header{'Lines'} = $body =~ tr/\n/\n/; $header{'Lines'} = $body =~ tr/\n/\n/;
return unless $group;
# the following tests are based on the structure of a news.announce.newgroups # the following tests are based on the structure of a news.announce.newgroups
# newgroup message; even if you comment out the "first line" test, please # newgroup message; even if you comment out the "first line" test, please
# leave the newsgroups line and moderators checks # leave the newsgroups line and moderators checks
if ($action eq 'new') { if ($action eq 'new') {
$status = $moderated ? 'a\smoderated' : 'an\sunmoderated'; $status = $moderated ? 'a\smoderated' : 'an\sunmoderated';
$die .= "$0: nonstandard first line in body\n" $die .= "$0: nonstandard first line in body for $group\n"
if ! /^\Q$group\E\sis\s$status\snewsgroup\b/; if ! /^\Q$group\E\sis\s$status\snewsgroup\b/;
my $intro = "For your newsgroups file:\n";
$ngline = $ngline =
(/^For your newsgroups file:\n\Q$group\E[ \t]+(.+)\n(\n|\Z(?!\n))/mi)[0]; (/^$intro\Q$group\E[ \t]+(.+)\n(\n|\Z(?!\n))/mi)[0];
if ($ngline) { if ($ngline) {
$_ = $group; $_ = $group;
$desc = $1; $desc = $1;
@ -254,25 +259,37 @@ readbody
$desc =~ s/ \(Moderated\)//i; $desc =~ s/ \(Moderated\)//i;
$desc =~ s/\s+$//; $desc =~ s/\s+$//;
$desc =~ s/\w$/$&./; $desc =~ s/\w$/$&./;
$die .= "$0: $_ description too long\n" if $used + length($desc) > 80; $die .= "$0: $group description too long\n" if $used + length($desc) > 80;
$fixline .= $desc; $fixline .= $desc;
$fixline .= ' (Moderated)' if $moderated; $fixline .= ' (Moderated)' if $moderated;
$body =~ s/^(For your newsgroups file:\n)(.+)/$1$fixline/i; $body =~ s/^$intro(.+)/$intro$fixline/mi;
} else { } else {
$die .= "$0: newsgroup line not formatted correctly\n"; $die .= "$0: $group newsgroup line not formatted correctly\n";
} }
if ($moderated) { # moderator checks are disabled; some sites were trying to automatically
$die .= "$0: Group submission address not formatted correctly\n" # maintain aliases based on this, which is bad policy.
if (0 && $moderated) {
$die .= "$0: $group submission address not formatted correctly\n"
if $body !~ /\nGroup submission address: ?\S+@\S+\.\S+\n/m; if $body !~ /\nGroup submission address: ?\S+@\S+\.\S+\n/m;
$mods = "( |\n[ \t]+)\\([^)]+\\)\n\n"; $mods = "( |\n[ \t]+)\\([^)]+\\)\n\n";
$die .= "$0: Moderator contact address not formatted correctly\n" $die .= "$0: $group contact address not formatted correctly\n"
if $body !~ /\nModerator contact address: ?\S+@\S+\.\S+$mods/m; if $body !~ /\nModerator contact address: ?\S+@\S+\.\S+$mods/m;
} }
} }
# rmgroups have freeform bodies # rmgroups have freeform bodies
# checkgroups have structured bodies, but I have not coded this for lack # checkgroups have structured bodies
# of time. i probably should do it. if ($action eq 'check') {
for (split(/\n/, $body)) {
my ($group, $description) = /^(\S+)\t+(.+)/;
$die .= "$0: no group:\n $_\n" unless $group;
$die .= "$0: no description:\n $_\n" unless $description;
$die .= "$0: bad group name \"$group\"\n" if $group !~ /^$grouppat$/;
$die .= "$0: tab in description\n" if $description =~ /\t/;
s/ \(Moderated\)$//;
$die .= "$0: $group line too long\n" if length(expand($_)) > 80;
}
}
} }
sub sub
@ -316,7 +333,7 @@ signit
$pgpbegin = "-----BEGIN PGP SIGNATURE-----"; $pgpbegin = "-----BEGIN PGP SIGNATURE-----";
$/ = "$pgpbegin\n"; $/ = "$pgpbegin\n";
$_ = <FH>; # read to signature, discard $_ = <FH>; # read to signature, discard
die "$0: $pgpbegin not found\n" unless /\Q$pgpbegin\E$/; die "$0: $pgpbegin not found in $_\n" unless /\Q$pgpbegin\E$/;
# make sure the temp file goes away even if we die now # make sure the temp file goes away even if we die now
unlink($tmp) || warn "$0: unlink $tmp: $!\n"; unlink($tmp) || warn "$0: unlink $tmp: $!\n";