roughconsensusandrunningcode/pgpcontrol
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
1 changed files with 32 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
signcontrol
View file

@ -1,7 +1,13 @@
#!/usr/local/bin/perl5 -w
# 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:
# -- skip minor pgp signature headers like "charset:" after "version:" header
# 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
# MUST is preferred, but might not be acceptable if you have legacy
# 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';
@ -232,18 +238,17 @@ readbody
$body = $_ = <STDIN>;
$header{'Lines'} = $body =~ tr/\n/\n/;
return unless $group;
# 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
# leave the newsgroups line and moderators checks
if ($action eq 'new') {
$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/;
my $intro = "For your newsgroups file:\n";
$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) {
$_ = $group;
$desc = $1;
@ -254,25 +259,37 @@ readbody
$desc =~ s/ \(Moderated\)//i;
$desc =~ s/\s+$//;
$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 .= ' (Moderated)' if $moderated;
$body =~ s/^(For your newsgroups file:\n)(.+)/$1$fixline/i;
$body =~ s/^$intro(.+)/$intro$fixline/mi;
} else {
$die .= "$0: newsgroup line not formatted correctly\n";
$die .= "$0: $group newsgroup line not formatted correctly\n";
}
if ($moderated) {
$die .= "$0: Group submission address not formatted correctly\n"
# moderator checks are disabled; some sites were trying to automatically
# 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;
$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;
}
}
# rmgroups have freeform bodies
# checkgroups have structured bodies, but I have not coded this for lack
# of time. i probably should do it.
# checkgroups have structured bodies
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
@ -316,7 +333,7 @@ signit
$pgpbegin = "-----BEGIN PGP SIGNATURE-----";
$/ = "$pgpbegin\n";
$_ = <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
unlink($tmp) || warn "$0: unlink $tmp: $!\n";