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
parent
828b42af28
commit
d72fb70d77
1 changed files with 74 additions and 71 deletions
145
signcontrol
145
signcontrol
|
|
@ -1,7 +1,11 @@
|
|||
#! /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>
|
||||
# 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
|
||||
# -- Added support for GnuPG.
|
||||
|
|
@ -38,6 +42,8 @@
|
|||
# -- skip minor pgp signature headers like "charset:" after "version:"
|
||||
# header and until the empty line that starts the base64 signature block.
|
||||
|
||||
use strict;
|
||||
|
||||
# CONFIGURATION
|
||||
|
||||
# PGP variables.
|
||||
|
|
@ -45,12 +51,12 @@
|
|||
# $pgp can be set to the path to GnuPG to use GnuPG instead. The program
|
||||
# name needs to end in gpg so that signcontrol knows GnuPG is being used.
|
||||
#
|
||||
# STORING YOUR PASS PHRASE IN A FILE IS A POTENTIAL SECURITY HOLE.
|
||||
# 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 DO use pgppassfile, it is possible that someone could steal
|
||||
# your passphrase either by gaining access to the file or by seeing
|
||||
# the environment of a running pgpverify program.
|
||||
# STORING YOUR PASSPHRASE IN A FILE IS A POTENTIAL SECURITY HOLE.
|
||||
# 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 DO use $pgppassfile, it is possible that someone could steal
|
||||
# your passphrase either by gaining access to the file or by seeing
|
||||
# the environment of a running pgpverify program.
|
||||
#
|
||||
# $pgplock is used because pgp does not guard itself against concurrent
|
||||
# read/write access to its randseed.bin file. A writable file is needed;
|
||||
|
|
@ -59,11 +65,11 @@
|
|||
# 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
|
||||
# this.
|
||||
$pgpsigner = 'INSERT_YOUR_PGP_USERID';
|
||||
$pgppassfile = ''; # file with pass phrase for $pgpsigner
|
||||
$pgp = "/usr/local/bin/pgp";
|
||||
$pgpheader = "X-PGP-Sig";
|
||||
$pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
|
||||
my $pgpsigner = 'INSERT_YOUR_PGP_USERID';
|
||||
my $pgppassfile = ''; # file with pass phrase for $pgpsigner
|
||||
my $pgp = "/usr/local/bin/pgp";
|
||||
my $pgpheader = "X-PGP-Sig";
|
||||
my $pgplock = (getpwuid($<))[7] . '/.pgp/config.txt';
|
||||
|
||||
# this program is strict about always wanting to be consistent about what
|
||||
# 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,
|
||||
# Newsgroups: is forced to be just the group being added/removed.
|
||||
# (but is taken as-is for checkgroups)
|
||||
my %force;
|
||||
$force{'Path'} = 'bounce-back';
|
||||
$force{'From'} = 'YOUR_ADDRESS_AND_NAME';
|
||||
$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
|
||||
# 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
|
||||
# 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.
|
||||
#
|
||||
# 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
|
||||
# distribution will go to with an iron fist.
|
||||
#
|
||||
my %use_or_add;
|
||||
# $use_or_add{'Reply-To'} = 'YOUR_REPLY_ADDRESS';
|
||||
# $use_or_add{'Oranization'} = 'YOUR_ORGANIZATION';
|
||||
# $use_or_add{'Distribution'} = 'MESSAGE_DISTRIBUTION';
|
||||
|
||||
# host for message-id; this could be determined automatically based on
|
||||
# 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
|
||||
# it. The following should always be signed:
|
||||
|
|
@ -109,12 +117,12 @@ $id_host = 'FULL_HOST_NAME';
|
|||
# Date -- guards against replay attacks.
|
||||
# From -- 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.
|
||||
# If it is a signed header, it is signed with an empty value.
|
||||
# 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
|
||||
# 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
|
||||
# is an error.
|
||||
# null headers are silently dropped.
|
||||
@orderheaders =
|
||||
my @orderheaders =
|
||||
('Path', 'From', 'Newsgroups', 'Subject', 'Control', 'Approved',
|
||||
'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
|
||||
# include no '|' for a single hierarchy (eg, "$hierarchies = 'uk';").
|
||||
|
||||
$hierarchies = 'HIERARCHIES';
|
||||
my $hierarchies = 'HIERARCHIES';
|
||||
|
||||
# the draft news article format standard says:
|
||||
# "subsequent components SHOULD begin with a letter"
|
||||
|
|
@ -150,18 +158,18 @@ $hierarchies = 'HIERARCHIES';
|
|||
# valid reasons to ignore it in unusual circumstances, but
|
||||
# this should be done only after careful study of the full
|
||||
# implications and a firm conclusion that it is necessary,
|
||||
# because there are serious disadvantages to doing so.
|
||||
# because there are serious disadvantages to doing so.
|
||||
# as opposed to "MUST" which means:
|
||||
# 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.newgroups does with comp.sys.3b1 and 17 other groups.
|
||||
|
||||
$start_component_with_letter = 'MUST';
|
||||
my $start_component_with_letter = 'MUST';
|
||||
|
||||
## END CONFIGURATION
|
||||
|
||||
use Fcntl qw(F_SETFD);
|
||||
use Fcntl qw(F_SETFD LOCK_EX);
|
||||
use FileHandle;
|
||||
use IPC::Open3 qw(open3);
|
||||
use POSIX qw(setlocale strftime LC_TIME);
|
||||
|
|
@ -171,18 +179,23 @@ $0 =~ s#^.*/##;
|
|||
|
||||
die "Usage: $0 < message\n" if @ARGV > 0;
|
||||
|
||||
my $LOCK;
|
||||
umask(0022); # flock needs a writable file, if we create it
|
||||
if ($pgp !~ /gpg$/) {
|
||||
open(LOCK, ">>$pgplock") || die "$0: open $lock: $!, exiting\n";
|
||||
flock(LOCK, 2); # block until locked
|
||||
open ($LOCK, '>>', $pgplock) || die "$0: open $pgplock: $!, exiting\n";
|
||||
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 = '';
|
||||
|
||||
&readhead;
|
||||
&readbody;
|
||||
setgrouppat();
|
||||
|
||||
readhead();
|
||||
readbody();
|
||||
|
||||
if ($die) {
|
||||
if ($group) {
|
||||
|
|
@ -193,23 +206,21 @@ if ($die) {
|
|||
die "$0: ERROR PROCESSING Subject: $header{'Subject'}\n", $die;
|
||||
} else {
|
||||
die $die;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
&signit;
|
||||
signit();
|
||||
|
||||
if ($pgp !~ /gpg$/) {
|
||||
close(LOCK) || warn "$0: close $lock: $!\n";
|
||||
close ($LOCK) || warn "$0: close $pgplock: $!\n";
|
||||
}
|
||||
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 ($eval);
|
||||
|
||||
# newsgroup name checks based on RFC 1036bis (not including encodings) rules:
|
||||
# "component MUST contain at least one letter"
|
||||
|
|
@ -238,29 +249,25 @@ setgrouppat
|
|||
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"
|
||||
if $hierarchy !~ /^$plain_component$/o;
|
||||
}
|
||||
|
||||
$eval = "\$_ = 'test'; /$grouppat/;";
|
||||
eval $eval;
|
||||
eval { 'test' =~ /$grouppat/ };
|
||||
die "$0: bad regexp for matching group names:\n $@" if $@;
|
||||
return;
|
||||
}
|
||||
|
||||
sub
|
||||
readhead
|
||||
sub readhead {
|
||||
my ($head, $label, $value);
|
||||
|
||||
{
|
||||
my($head, $label, $value);
|
||||
local($_, $/);
|
||||
|
||||
$/ = "";
|
||||
local $/ = "";
|
||||
$head = <STDIN>; # get the whole news header
|
||||
$die .= "$0: continuation lines in headers not allowed\n"
|
||||
if $head =~ s/\n[ \t]+/ /g; # rejoin continued lines
|
||||
|
||||
for (split(/\n/, $head)) {
|
||||
foreach (split /\n/, $head) {
|
||||
if (/^(\S+): (.*)/) {
|
||||
$label = $1;
|
||||
$value = $2;
|
||||
|
|
@ -317,17 +324,14 @@ readhead
|
|||
} else {
|
||||
$die .= "$0: can't verify message content; missing Control header\n";
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
sub
|
||||
readbody
|
||||
sub readbody {
|
||||
my ($status, $ngline, $fixline, $used, $desc, $mods);
|
||||
|
||||
{
|
||||
local($_, $/);
|
||||
local($status, $ngline, $fixline, $used, $desc, $mods);
|
||||
|
||||
undef $/;
|
||||
$body = $_ = <STDIN>;
|
||||
local $/ = undef;
|
||||
$body = <STDIN>; # slurp the rest of the article
|
||||
$header{'Lines'} = $body =~ tr/\n/\n/ if $body;
|
||||
|
||||
# the following tests are based on the structure of a
|
||||
|
|
@ -337,11 +341,11 @@ readbody
|
|||
if ($action eq 'new') {
|
||||
$status = $moderated ? 'a\smoderated' : 'an\sunmoderated';
|
||||
$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";
|
||||
$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) {
|
||||
$_ = $group;
|
||||
$desc = $1;
|
||||
|
|
@ -373,7 +377,7 @@ readbody
|
|||
|
||||
# checkgroups have structured bodies
|
||||
if ($action eq 'check') {
|
||||
for (split(/\n/, $body)) {
|
||||
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;
|
||||
|
|
@ -383,6 +387,7 @@ readbody
|
|||
$die .= "$0: $group line too long\n" if length(expand($_)) > 80;
|
||||
}
|
||||
}
|
||||
return;
|
||||
}
|
||||
|
||||
# Create a detached signature for the given data. The first argument
|
||||
|
|
@ -497,22 +502,19 @@ sub pgp_sign {
|
|||
}
|
||||
shift @signature;
|
||||
pop @signature;
|
||||
$signature = join ('', @signature);
|
||||
$signature = join '', @signature;
|
||||
chomp $signature;
|
||||
undef @ERROR;
|
||||
return wantarray ? ($signature, $version) : $signature;
|
||||
}
|
||||
|
||||
sub
|
||||
signit
|
||||
|
||||
{
|
||||
my($head, $header, $signheaders, $pgpflags, $pgpbegin, $pgpend);
|
||||
sub signit {
|
||||
my ($head, $signheaders);
|
||||
|
||||
# Form the message to be signed.
|
||||
$signheaders = join(",", @signheaders);
|
||||
$signheaders = join ",", @signheaders;
|
||||
$head = "X-Signed-Headers: $signheaders\n";
|
||||
foreach $header (@signheaders) {
|
||||
foreach my $header (@signheaders) {
|
||||
$head .= "$header: $header{$header}\n";
|
||||
}
|
||||
my $message = "$head\n$body";
|
||||
|
|
@ -521,15 +523,15 @@ signit
|
|||
my $passphrase;
|
||||
if ($pgppassfile && -f $pgppassfile) {
|
||||
$pgppassfile =~ s%^(\s)%./$1%;
|
||||
if (open (PGPPASS, "< $pgppassfile\0")) {
|
||||
$passphrase = <PGPPASS>;
|
||||
close PGPPASS;
|
||||
if (open my $PGPPASS, '<', $pgppassfile) {
|
||||
$passphrase = <$PGPPASS>;
|
||||
close $PGPPASS;
|
||||
chomp $passphrase;
|
||||
}
|
||||
}
|
||||
|
||||
# Sign the message, getting the signature and PGP version number.
|
||||
my ($signature, $version) = pgp_sign ($pgpsigner, $passphrase, $message);
|
||||
my ($signature, $version) = pgp_sign($pgpsigner, $passphrase, $message);
|
||||
unless ($signature) {
|
||||
die "@ERROR\n$0: could not generate signature\n";
|
||||
}
|
||||
|
|
@ -547,18 +549,19 @@ signit
|
|||
}
|
||||
|
||||
$head = '';
|
||||
foreach $header (@orderheaders) {
|
||||
foreach my $header (@orderheaders) {
|
||||
$head .= "$header: $header{$header}\n" if $header{$header};
|
||||
delete $header{$header};
|
||||
}
|
||||
|
||||
foreach $header (keys %header) {
|
||||
foreach my $header (keys %header) {
|
||||
die "$0: unexpected header $header left in header array\n";
|
||||
}
|
||||
|
||||
print STDOUT $head;
|
||||
print STDOUT "\n";
|
||||
print STDOUT $body;
|
||||
return;
|
||||
}
|
||||
|
||||
# Our lawyer told me to include the following. The upshot of it is that
|
||||
|
|
|
|||
Loading…
Reference in a new issue