Incorporate signcontrol changes made in INN

- Add use strict and explicitly import LOCK_EX.
- Fix error reporting around lock files with PGP.
- Fix coding style in subs to be more idiomatic.
This commit is contained in:
Russ Allbery 2016-10-17 16:05:38 -07:00
parent 828b42af28
commit d72fb70d77

View file

@ -1,7 +1,11 @@
#! /usr/bin/perl -w #! /usr/bin/perl -w
# written April 1996, tale@isc.org (David C Lawrence) # written April 1996, <tale@isc.org> (David C Lawrence)
# Currently maintained by Russ Allbery <eagle@eyrie.org> # Currently maintained by Russ Allbery <eagle@eyrie.org>
# Version 1.8, 2003-07-06 # Version 1.9, 2016-10-17
#
# Changes from 1.8 -> 1.9
# -- Add use strict and explicitly import LOCK_EX.
# -- Fix error reporting around lock files with PGP.
# #
# Changes from 1.6 -> 1.8 # Changes from 1.6 -> 1.8
# -- Added support for GnuPG. # -- Added support for GnuPG.
@ -38,6 +42,8 @@
# -- skip minor pgp signature headers like "charset:" after "version:" # -- skip minor pgp signature headers like "charset:" after "version:"
# header and until the empty line that starts the base64 signature block. # header and until the empty line that starts the base64 signature block.
use strict;
# CONFIGURATION # CONFIGURATION
# PGP variables. # PGP variables.
@ -46,9 +52,9 @@
# name needs to end in gpg so that signcontrol knows GnuPG is being used. # name needs to end in gpg so that signcontrol knows GnuPG is being used.
# #
# STORING YOUR PASSPHRASE IN A FILE IS A POTENTIAL SECURITY HOLE. # STORING YOUR PASSPHRASE IN A FILE IS A POTENTIAL SECURITY HOLE.
# make sure you know what you're doing if you do it. # Make sure you know what you're doing if you do it.
# if you don't use pgppassfile, you can only use this script interactively. # If you don't use $pgppassfile, you can only use this script interactively.
# if you DO use pgppassfile, it is possible that someone could steal # If you DO use $pgppassfile, it is possible that someone could steal
# your passphrase either by gaining access to the file or by seeing # your passphrase either by gaining access to the file or by seeing
# the environment of a running pgpverify program. # the environment of a running pgpverify program.
# #
@ -59,11 +65,11 @@
# work to lock against other instances of signcontrol, not all pgp uses. # work to lock against other instances of signcontrol, not all pgp uses.
# $pgplock is not used if $pgp ends in 'gpg' since GnuPG doesn't need # $pgplock is not used if $pgp ends in 'gpg' since GnuPG doesn't need
# this. # this.
$pgpsigner = 'INSERT_YOUR_PGP_USERID'; my $pgpsigner = 'INSERT_YOUR_PGP_USERID';
$pgppassfile = ''; # file with pass phrase for $pgpsigner my $pgppassfile = ''; # file with pass phrase for $pgpsigner
$pgp = "/usr/local/bin/pgp"; my $pgp = "/usr/local/bin/pgp";
$pgpheader = "X-PGP-Sig"; my $pgpheader = "X-PGP-Sig";
$pgplock = (getpwuid($<))[7] . '/.pgp/config.txt'; my $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
# this program is strict about always wanting to be consistent about what # this program is strict about always wanting to be consistent about what
# headers appear in the control messages. the defaults for the # headers appear in the control messages. the defaults for the
@ -74,6 +80,7 @@ $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
# Subject: is forced to be the Control header prepending by "cmsg". also, # Subject: is forced to be the Control header prepending by "cmsg". also,
# Newsgroups: is forced to be just the group being added/removed. # Newsgroups: is forced to be just the group being added/removed.
# (but is taken as-is for checkgroups) # (but is taken as-is for checkgroups)
my %force;
$force{'Path'} = 'bounce-back'; $force{'Path'} = 'bounce-back';
$force{'From'} = 'YOUR_ADDRESS_AND_NAME'; $force{'From'} = 'YOUR_ADDRESS_AND_NAME';
$force{'Approved'} = 'ADDRESS_FOR_Approved_HEADER'; $force{'Approved'} = 'ADDRESS_FOR_Approved_HEADER';
@ -85,7 +92,7 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
# created with the given value. None are enabled by default, because they # created with the given value. None are enabled by default, because they
# should not be necessary. Setting one to a null string will pass through # should not be necessary. Setting one to a null string will pass through
# any instance of it found in the input, but not generate one if it is # any instance of it found in the input, but not generate one if it is
# missing. If you set any $default{} variables, you must also put it in # missing. If you set any $use_or_add{} variables, you must also put it in
# @orderheaders below. # @orderheaders below.
# #
# Note that Distribution nearly never works correctly, so use it only if # Note that Distribution nearly never works correctly, so use it only if
@ -93,13 +100,14 @@ $force{'X-Info'}='ftp://ftp.isc.org/pub/pgpcontrol/README.html'
# you intend. This normally means that you control all servers the # you intend. This normally means that you control all servers the
# distribution will go to with an iron fist. # distribution will go to with an iron fist.
# #
my %use_or_add;
# $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS'; # $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS';
# $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION'; # $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION';
# $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION'; # $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION';
# host for message-id; this could be determined automatically based on # host for message-id; this could be determined automatically based on
# where it is run, but consistency is the goal here # where it is run, but consistency is the goal here
$id_host = 'FULL_HOST_NAME'; my $id_host = 'FULL_HOST_NAME';
# headers to sign. Sender is included because non-PGP authentication uses # headers to sign. Sender is included because non-PGP authentication uses
# it. The following should always be signed: # it. The following should always be signed:
@ -109,12 +117,12 @@ $id_host = 'FULL_HOST_NAME';
# Date -- guards against replay attacks. # Date -- guards against replay attacks.
# From -- used by news systems as part of authenticating the message. # From -- used by news systems as part of authenticating the message.
# Sender -- used by news systems as part of authenticating the message. # Sender -- used by news systems as part of authenticating the message.
@signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender'); my @signheaders = ('Subject', 'Control', 'Message-ID', 'Date', 'From', 'Sender');
# headers to remove from real headers of final message. # headers to remove from real headers of final message.
# If it is a signed header, it is signed with an empty value. # If it is a signed header, it is signed with an empty value.
# set to () if you do not want any headers removed. # set to () if you do not want any headers removed.
@ignoreheaders = ('Sender'); my @ignoreheaders = ('Sender');
# headers that will appear in final message, and their order of # headers that will appear in final message, and their order of
# appearance. all _must_ be set, either in input or via the $force{} and # appearance. all _must_ be set, either in input or via the $force{} and
@ -130,7 +138,7 @@ $id_host = 'FULL_HOST_NAME';
# any non-null header in the input but not in @orderheaders or @ignoreheaders # any non-null header in the input but not in @orderheaders or @ignoreheaders
# is an error. # is an error.
# null headers are silently dropped. # null headers are silently dropped.
@orderheaders = my @orderheaders =
('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved', ('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved',
'Message-ID', 'Date', 'Lines', 'X-Info', $pgpheader); 'Message-ID', 'Date', 'Lines', 'X-Info', $pgpheader);
@ -141,7 +149,7 @@ $id_host = 'FULL_HOST_NAME';
# set to match only hierarchies you will use it on # set to match only hierarchies you will use it on
# include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';"). # include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';").
$hierarchies = 'HIERARCHIES'; my $hierarchies = 'HIERARCHIES';
# the draft news article format standard says: # the draft news article format standard says:
# "subsequent components SHOULD begin with a letter" # "subsequent components SHOULD begin with a letter"
@ -157,11 +165,11 @@ $hierarchies = 'HIERARCHIES';
# newsgroups that have name components that begin with a letter, like # newsgroups that have name components that begin with a letter, like
# news.announce.newgroups 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'; my $start_component_with_letter = 'MUST';
## END CONFIGURATION ## END CONFIGURATION
use Fcntl qw(F_SETFD); use Fcntl qw(F_SETFD LOCK_EX);
use FileHandle; use FileHandle;
use IPC::Open3 qw(open3); use IPC::Open3 qw(open3);
use POSIX qw(setlocale strftime LC_TIME); use POSIX qw(setlocale strftime LC_TIME);
@ -171,18 +179,23 @@ $0 =~ s#^.*/##;
die "Usage: $0 < message\n" if @ARGV > 0; die "Usage: $0 < message\n" if @ARGV > 0;
my $LOCK;
umask(0022); # flock needs a writable file, if we create it umask(0022); # flock needs a writable file, if we create it
if ($pgp !~ /gpg$/) { if ($pgp !~ /gpg$/) {
open(LOCK, ">>$pgplock") || die "$0: open $lock: $!, exiting\n"; open ($LOCK, '>>', $pgplock) || die "$0: open $pgplock: $!, exiting\n";
flock(LOCK, 2); # block until locked flock ($LOCK, LOCK_EX); # block until locked
} }
&setgrouppat; my ($die, $group, $action, $grouppat, %header, $moderated, $body, @ERROR);
# Initialize the $die variable here (we use it to concatenate possible
# error messages during the run of the following functions).
$die = ''; $die = '';
&readhead; setgrouppat();
&readbody;
readhead();
readbody();
if ($die) { if ($die) {
if ($group) { if ($group) {
@ -196,20 +209,18 @@ if ($die) {
} }
} }
&signit; signit();
if ($pgp !~ /gpg$/) { if ($pgp !~ /gpg$/) {
close(LOCK) || warn "$0: close $lock: $!\n"; close ($LOCK) || warn "$0: close $pgplock: $!\n";
} }
exit 0; exit 0;
sub
setgrouppat
{
my ($hierarchy, $plain_component, $no_component); sub setgrouppat {
my ($plain_component, $no_component);
my ($must_start_letter, $should_start_letter); my ($must_start_letter, $should_start_letter);
my ($eval);
# newsgroup name checks based on RFC 1036bis (not including encodings) rules: # newsgroup name checks based on RFC 1036bis (not including encodings) rules:
# "component MUST contain at least one letter" # "component MUST contain at least one letter"
@ -238,29 +249,25 @@ setgrouppat
die "$0: unknown value configured for \$start_component_with_letter\n"; die "$0: unknown value configured for \$start_component_with_letter\n";
} }
foreach $hierarchy (split(/\|/, $hierarchies)) { foreach my $hierarchy (split /\|/, $hierarchies) {
die "$0: hierarchy name $hierarchy not standards-compliant\n" die "$0: hierarchy name $hierarchy not standards-compliant\n"
if $hierarchy !~ /^$plain_component$/o; if $hierarchy !~ /^$plain_component$/o;
} }
$eval = "\$_ = 'test'; /$grouppat/;"; eval { 'test' =~ /$grouppat/ };
eval $eval;
die "$0: bad regexp for matching group names:\n $@" if $@; die "$0: bad regexp for matching group names:\n $@" if $@;
return;
} }
sub sub readhead {
readhead
{
my ($head, $label, $value); my ($head, $label, $value);
local($_, $/);
$/ = ""; local $/ = "";
$head = <STDIN>; # get the whole news header $head = <STDIN>; # get the whole news header
$die .= "$0: continuation lines in headers not allowed\n" $die .= "$0: continuation lines in headers not allowed\n"
if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines
for (split(/\n/, $head)) { foreach (split /\n/, $head) {
if (/^(\S+): (.*)/) { if (/^(\S+): (.*)/) {
$label = $1; $label = $1;
$value = $2; $value = $2;
@ -317,17 +324,14 @@ readhead
} else { } else {
$die .= "$0: can't verify message content; missing Control header\n"; $die .= "$0: can't verify message content; missing Control header\n";
} }
return;
} }
sub sub readbody {
readbody my ($status, $ngline, $fixline, $used, $desc, $mods);
{ local $/ = undef;
local($_, $/); $body = <STDIN>; # slurp the rest of the article
local($status, $ngline, $fixline, $used, $desc, $mods);
undef $/;
$body = $_ = <STDIN>;
$header{'Lines'} = $body =~ tr/\n/\n/ if $body; $header{'Lines'} = $body =~ tr/\n/\n/ if $body;
# the following tests are based on the structure of a # the following tests are based on the structure of a
@ -337,11 +341,11 @@ readbody
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 for $group\n" $die .= "$0: nonstandard first line in body for $group\n"
if ! /^\Q$group\E\sis\s$status\snewsgroup\b/; if $body !~ /^\Q$group\E\sis\s$status\snewsgroup\b/;
my $intro = "For your newsgroups file:\n"; my $intro = "For your newsgroups file:\n";
$ngline = $ngline =
(/^$intro\Q$group\E[ \t]+(.+)\n(\n|\Z(?!\n))/mi)[0]; ($body =~ /^$intro\Q$group\E[ \t]+(.+)\n(\n|\Z(?!\n))/mi)[0];
if ($ngline) { if ($ngline) {
$_ = $group; $_ = $group;
$desc = $1; $desc = $1;
@ -373,7 +377,7 @@ readbody
# checkgroups have structured bodies # checkgroups have structured bodies
if ($action eq 'check') { if ($action eq 'check') {
for (split(/\n/, $body)) { for (split /\n/, $body) {
my ($group, $description) = /^(\S+)\t+(.+)/; my ($group, $description) = /^(\S+)\t+(.+)/;
$die .= "$0: no group:\n $_\n" unless $group; $die .= "$0: no group:\n $_\n" unless $group;
$die .= "$0: no description:\n $_\n" unless $description; $die .= "$0: no description:\n $_\n" unless $description;
@ -383,6 +387,7 @@ readbody
$die .= "$0: $group line too long\n" if length(expand($_)) > 80; $die .= "$0: $group line too long\n" if length(expand($_)) > 80;
} }
} }
return;
} }
# Create a detached signature for the given data. The first argument # Create a detached signature for the given data. The first argument
@ -497,22 +502,19 @@ sub pgp_sign {
} }
shift @signature; shift @signature;
pop @signature; pop @signature;
$signature = join ('', @signature); $signature = join '', @signature;
chomp $signature; chomp $signature;
undef @ERROR; undef @ERROR;
return wantarray ? ($signature, $version) : $signature; return wantarray ? ($signature, $version) : $signature;
} }
sub sub signit {
signit my ($head, $signheaders);
{
my($head, $header, $signheaders, $pgpflags, $pgpbegin, $pgpend);
# Form the message to be signed. # Form the message to be signed.
$signheaders = join(",", @signheaders); $signheaders = join ",", @signheaders;
$head = "X-Signed-Headers: $signheaders\n"; $head = "X-Signed-Headers: $signheaders\n";
foreach $header (@signheaders) { foreach my $header (@signheaders) {
$head .= "$header: $header{$header}\n"; $head .= "$header: $header{$header}\n";
} }
my $message = "$head\n$body"; my $message = "$head\n$body";
@ -521,9 +523,9 @@ signit
my $passphrase; my $passphrase;
if ($pgppassfile && -f $pgppassfile) { if ($pgppassfile && -f $pgppassfile) {
$pgppassfile =~ s%^(\s)%./$1%; $pgppassfile =~ s%^(\s)%./$1%;
if (open (PGPPASS, "< $pgppassfile\0")) { if (open my $PGPPASS, '<', $pgppassfile) {
$passphrase = <PGPPASS>; $passphrase = <$PGPPASS>;
close PGPPASS; close $PGPPASS;
chomp $passphrase; chomp $passphrase;
} }
} }
@ -547,18 +549,19 @@ signit
} }
$head = ''; $head = '';
foreach $header (@orderheaders) { foreach my $header (@orderheaders) {
$head .= "$header: $header{$header}\n" if $header{$header}; $head .= "$header: $header{$header}\n" if $header{$header};
delete $header{$header}; delete $header{$header};
} }
foreach $header (keys %header) { foreach my $header (keys %header) {
die "$0: unexpected header $header left in header array\n"; die "$0: unexpected header $header left in header array\n";
} }
print STDOUT $head; print STDOUT $head;
print STDOUT "\n"; print STDOUT "\n";
print STDOUT $body; print STDOUT $body;
return;
} }
# Our lawyer told me to include the following. The upshot of it is that # Our lawyer told me to include the following. The upshot of it is that