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:
parent
7ca4c4a7c2
commit
109e601f91
1 changed files with 32 additions and 15 deletions
47
signcontrol
47
signcontrol
|
@ -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";
|
||||||
|
|
Loading…
Reference in a new issue