1003 lines
36 KiB
Perl
Executable file
1003 lines
36 KiB
Perl
Executable file
#! /usr/bin/perl -w
|
|
# use lib '@LIBPERLDIR@'; use INN::Config;
|
|
# If running inside INN, uncomment the above and point to INN::Config.
|
|
#
|
|
# Written April 1996, <tale@isc.org> (David C Lawrence)
|
|
# Currently maintained by Russ Allbery <eagle@eyrie.org>
|
|
# Version 1.30, 2018-01-21
|
|
#
|
|
# sequoia-sq support written in December 2024 by
|
|
# Fabrizio Tarizzo <fabrizio@fabriziotarizzo.org>
|
|
#
|
|
# NOTICE TO INN MAINTAINERS: The version that is shipped with INN is the
|
|
# same as the version that I make available to the rest of the world
|
|
# (including non-INN sites), so please make all changes through me.
|
|
#
|
|
# This program requires Perl 5, probably at least about Perl 5.003 since
|
|
# that's when FileHandle was introduced. If you want to use this program
|
|
# and your Perl is too old, please contact me (eagle@eyrie.org) and tell
|
|
# me about it; I want to know what old versions of Perl are still used in
|
|
# practice.
|
|
#
|
|
# Changes from 1.29 -> 1.30
|
|
# -- Support for GnuPG's gpg binary (in addition to gpgv). gpg (from
|
|
# GnuPG 1.x before 1.4.20, and GnuPG 2.0.x) still validates signatures
|
|
# made with weak digest algorithms like MD5 whereas current versions
|
|
# of gpgv no longer do.
|
|
# -- This new release of pgpverify requires at least GnuPG 1.4.20 or 2.1.0.
|
|
# If you're using an older version of GnuPG, you have to keep using
|
|
# pgpverify 1.29.
|
|
#
|
|
# Changes from 1.28 -> 1.29
|
|
# -- Disambiguate numbered lists from description lists in POD to silent
|
|
# a pod2man warning.
|
|
# -- Add a --findid=<string> flag to explicitly search for <string> in the
|
|
# output from PGP's analysis of the message. In case the signature is
|
|
# valid but does not contain <string>, pgpverify exits with the new
|
|
# exit status 4.
|
|
#
|
|
# Changes from 1.27 -> 1.28
|
|
# -- Use the INN::Config Perl module instead of innshellvars.pl to
|
|
# accommodate the new build process of INN 2.5.
|
|
#
|
|
# Changes from 1.26 -> 1.27
|
|
# -- Default to pubring.gpg when trustedkeys.gpg is not found in the
|
|
# default key location, for backward compatibility.
|
|
#
|
|
# Changes from 1.25 -> 1.26
|
|
# -- Return the correct status code when the message isn't verified
|
|
# instead of always returning 255.
|
|
#
|
|
# Changes from 1.24 -> 1.25
|
|
# -- Fix the -test switch to actually do something.
|
|
# -- Improve date generation when logging to standard output.
|
|
#
|
|
# Changes from 1.23 -> 1.24
|
|
# -- Fix bug in the recognition of wire-format articles.
|
|
#
|
|
# Changes from 1.15 -> 1.23
|
|
# -- Bump version number to match CVS revision number.
|
|
# -- Replaced all signature verification code with code that uses detached
|
|
# signatures. Signatures generated by GnuPG couldn't be verified using
|
|
# attached signatures without adding a Hash: header, and this was the
|
|
# path of least resistance plus avoids munging problems in the future.
|
|
# Code taken from PGP::Sign.
|
|
#
|
|
# Changes from 1.14 -> 1.15
|
|
# -- Added POD documentation.
|
|
# -- Fixed the -test switch so that it works again.
|
|
# -- Dropped Perl 4 compatibility and reformatted. Now passes use strict.
|
|
#
|
|
# Changes from 1.13.1 -> 1.14
|
|
# -- Native support for GnuPG without the pgpgpg wrapper, using GnuPG's
|
|
# program interface by Marco d'Itri.
|
|
# -- Always use Sys::Syslog without any setlogsock call for Perl 5.6.0 or
|
|
# later, since Sys::Syslog in those versions of Perl uses the C library
|
|
# interface and is now portable.
|
|
# -- Default to expecting the key ring in $inn'newsetc/pgp if it exists.
|
|
# -- Fix a portability problem for Perl 4 introduced in 1.12.
|
|
#
|
|
# Changes from 1.13 -> 1.13.1
|
|
# -- Nothing functional, just moved the innshellvars.pl line to the head of
|
|
# the script, to accommodate the build process of INN.
|
|
#
|
|
# Changes from 1.12 -> 1.13
|
|
# -- Use INN's syslog_facility if available.
|
|
#
|
|
# Changes from 1.11 -> 1.12
|
|
# -- Support for GnuPG.
|
|
# -- Use /usr/ucb/logger, if present, instead of /usr/bin/logger (the latter
|
|
# of which, on Solaris at least, is some sort of brain damaged POSIX.2
|
|
# command which doesn't use syslog).
|
|
# -- Made syslog work for dec_osf (version 4, at least).
|
|
# -- Fixed up priority of '.' operator vs bitwise operators.
|
|
#
|
|
# Changes from 1.10 -> 1.11
|
|
# -- Code to log error messages to syslog.
|
|
# See $syslog and $syslog_method configurable variables.
|
|
# -- Configurably allow date stamp on stderr error messages.
|
|
# -- Added locking for multiple concurrent pgp instances.
|
|
# -- More clear error message if pgp exits abnormally.
|
|
# -- Identify PGP 5 "BAD signature" string.
|
|
# -- Minor diddling for INN (path to innshellvars.pl changed).
|
|
#
|
|
# Changes from 1.9 -> 1.10
|
|
# -- Minor diddling for INN 2.0: use $inn'pathtmp if it exists, and
|
|
# work with the new subst method to find innshellvars.pl.
|
|
# -- Do not truncate the tmp file when opening, in case it is really
|
|
# linked to another file.
|
|
#
|
|
# Changes from 1.8 -> 1.9
|
|
# -- Match 'Bad signature' pgp output to return exit status 3 by removing
|
|
# '^' in regexp matched on multiline string.
|
|
#
|
|
# Changes from 1.7 -> 1.8
|
|
# -- Ignore final dot-CRLF if article is in NNTP format.
|
|
#
|
|
# Changes from 1.6 -> 1.7
|
|
# -- Parse PGP 5.0 'good signature' lines.
|
|
# -- Allow -test switch; prints pgp input and output.
|
|
# -- Look for pgp in INN's innshellvars.pl.
|
|
# -- Changed regexp delimiters for stripping $0 to be compatible with old
|
|
# Perl.
|
|
#
|
|
# Changes from 1.5 -> 1.6
|
|
# -- Handle articles encoded in NNTP format ('.' starting line is doubled,
|
|
# \r\n at line end) by stripping NNTP encoding.
|
|
# -- Exit 255 with pointer to $HOME or $PGPPATH if pgp can't find key
|
|
# ring. (It probably doesn't match the necessary error message with
|
|
# ViaCrypt PGP.)
|
|
# -- Failures also report Message-ID so the article can be looked up to
|
|
# retry.
|
|
#
|
|
# Changes from 1.4 -> 1.5
|
|
# -- Force English language for 'Good signature from user' by passing
|
|
# +language=en on pgp command line, rather than setting the
|
|
# environment variable LANGUAGE to 'en'.
|
|
#
|
|
# Changes from 1.3 -> 1.4
|
|
# -- Now handles wrapped headers that have been unfolded.
|
|
# (Though I do believe news software oughtn't be unfolding them.)
|
|
# -- Checks to ensure that the temporary file is really a file, and
|
|
# not a link or some other weirdness.
|
|
|
|
# Path to sequoia binary. Requires a version that supports CLI 1.0.0
|
|
# $sq = '/usr/local/bin/sq';
|
|
|
|
# Set this if you want to support old signatures with MD5 and SHA-1
|
|
# digest algorithms and/or RSA < 2048 bits.
|
|
# See the `sq config inspect policy' command and the `--policy-as-of'
|
|
# flag in the sq manpage
|
|
# Please note that sequoia DOES NOT support PGP 2.x keys.
|
|
# $sq_policy_as_of = '19970101';
|
|
|
|
# Path to the GnuPG gpg binary, if you have GnuPG and don't want to use
|
|
# gpgv. This will be used in preference to gpgv and PGP. If you have INN
|
|
# and the script is able to successfully include your INN::Config module,
|
|
# the value of $INN::Config::gpg will override this. On a recent Debian
|
|
# variant, use /usr/bin/gpg1 (from the gnupg1 package) if you want to
|
|
# support old signatures with MD5 digest algorithms.
|
|
# $gpg = '/usr/local/bin/gpg';
|
|
|
|
# Path to the GnuPG gpgv binary, if you have GnuPG. If you do, this will
|
|
# be used in preference to PGP. For most current control messages, you
|
|
# need a version of GnuPG that can handle RSA signatures. If you have INN
|
|
# and the script is able to successfully include your INN::Config module,
|
|
# the value of $INN::Config::gpgv will override this.
|
|
# $gpgv = '/usr/local/bin/gpgv';
|
|
|
|
# Path to pgp binary; for PGP 5.0, set the path to the pgpv binary. If
|
|
# you have INN and the script is able to successfully include your
|
|
# INN::Config module, the value of $INN::Config::pgp will override this.
|
|
# $pgp = '/usr/local/bin/pgp';
|
|
|
|
# If you keep your keyring somewhere that is not the default used by pgp,
|
|
# uncomment the next line and set appropriately. If you have INN and the
|
|
# script is able to successfully include your INN::Config module, this
|
|
# will be set to $INN::Config::newsetc/pgp if that directory exists unless
|
|
# you set it explicitly. GnuPG will use a file named pubring.gpg in this
|
|
# directory.
|
|
# With sequoia, you can use a single keyring file or the absolute path
|
|
# to the sequoia home directory. See `--home' and `--signer-file' flags
|
|
# in sequoia man pages.
|
|
# $keyring = '/path/to/your/pgp/config';
|
|
|
|
# If you have INN and the script is able to successfully include your
|
|
# INN::Config module, the value of $INN::Config::pathtmp and
|
|
# $INN::Config::locks will override these.
|
|
$tmpdir = "/tmp";
|
|
$lockdir = $tmpdir;
|
|
|
|
# How should syslog be accessed?
|
|
#
|
|
# As it turns out, syslogging is very hard to do portably in versions of
|
|
# Perl prior to 5.6.0. Sys::Syslog should work without difficulty in
|
|
# 5.6.0 or later and will be used automatically for those versions of Perl
|
|
# (unless $syslog_method is ''). For earlier versions of Perl, 'inet' is
|
|
# all that's available up to version 5.004_03. If your syslog does not
|
|
# accept UDP log packets, such as when syslogd runs with the -l flag,
|
|
# 'inet' will not work. A value of 'unix' will try to contact syslogd
|
|
# directly over a Unix domain socket built entirely in Perl code (no
|
|
# subprocesses). If that is not working for you, and you have the
|
|
# 'logger' program on your system, set this variable to its full path name
|
|
# to have a subprocess contact syslogd. If the method is just "logger",
|
|
# the script will search some known directories for that program. If it
|
|
# can't be found & used, everything falls back on stderr logging.
|
|
#
|
|
# You can test the script's syslogging by running "pgpverify <
|
|
# /some/text/file" on a file that is not a valid news article. The
|
|
# "non-header at line #" error should be syslogged.
|
|
#
|
|
# $syslog_method = 'unix'; # Unix doman socket, Perl 5.004_03 or higher.
|
|
# $syslog_method = 'inet'; # UDP to port 514 of localhost.
|
|
# $syslog_method = ''; # Don't ever try to do syslogging.
|
|
$syslog_method = 'logger'; # Search for the logger program.
|
|
|
|
# The next two variables are the values to be used for syslog's facility
|
|
# and level to use, as would be found in syslog.conf. For various
|
|
# reasons, it is impossible to economically have the script figure out how
|
|
# to do syslogging correctly on the machine. If you have INN and the
|
|
# script is able to successfully include you INN::Config module, then
|
|
# the value of $INN::Config::syslog_facility will override this value of
|
|
# $syslog_facility; $syslog_level is unaffected.
|
|
$syslog_facility = 'news';
|
|
$syslog_level = 'err';
|
|
|
|
# Prepend the error message with a timestamp? This is only relevant if
|
|
# not syslogging, when errors go to stderr.
|
|
#
|
|
# $log_date = 0; # Zero means don't do it.
|
|
# $log_date = 1; # Non-zero means do it.
|
|
$log_date = -t STDOUT; # Do it if STDOUT is to a terminal.
|
|
|
|
# End of configuration section.
|
|
|
|
|
|
require 5;
|
|
|
|
use strict;
|
|
use vars qw($sq $sq_policy_as_of $gpg $gpgv $pgp $keyring $tmp $tmpdir $lockdir $syslog_method
|
|
$syslog_facility $syslog_level $log_date $findid $test $messageid);
|
|
|
|
use Fcntl qw(O_WRONLY O_CREAT O_EXCL);
|
|
use FileHandle;
|
|
use IPC::Open3 qw(open3);
|
|
use POSIX qw(strftime);
|
|
use Getopt::Long;
|
|
|
|
# Check the arguments passed to pgpverify.
|
|
# If a syntax error occurs, do not syslog it: such an error is almost
|
|
# certainly from someone running the script manually.
|
|
Getopt::Long::Configure('bundling_override');
|
|
GetOptions(
|
|
'test' => sub { $test = 1 },
|
|
'findid=s' => \$findid
|
|
) or die "Usage: $0 [--findid='string'] [--test] < message\n";
|
|
|
|
# Grab various defaults from INN::Config if running inside INN.
|
|
$sq = $INN::Config::sq if $INN::Config::sq;
|
|
$pgp = $INN::Config::pgp
|
|
if $INN::Config::pgp && $INN::Config::pgp ne "no-pgp-found-during-configure";
|
|
$gpgv = $INN::Config::gpgv if $INN::Config::gpgv;
|
|
$gpg = $INN::Config::gpg if $INN::Config::gpg;
|
|
$tmp = ($INN::Config::pathtmp ? $INN::Config::pathtmp : $tmpdir) . "/pgp$$";
|
|
$lockdir = $INN::Config::locks if $INN::Config::locks;
|
|
$syslog_facility = $INN::Config::syslog_facility if $INN::Config::syslog_facility;
|
|
if (! $keyring && $INN::Config::newsetc) {
|
|
$keyring = $INN::Config::newsetc . '/pgp' if -d $INN::Config::newsetc . '/pgp';
|
|
}
|
|
|
|
# Trim /path/to/prog to prog for error messages.
|
|
$0 =~ s%^.*/%%;
|
|
|
|
# Make sure that the signature verification program can be executed.
|
|
if ($sq) {
|
|
if (! -x $sq) {
|
|
&fail("$0: $sq: " . (-e _ ? "cannot execute" : "no such file") . "\n");
|
|
}
|
|
} elsif ($gpg) {
|
|
if (! -x $gpg) {
|
|
&fail("$0: $gpg: " . (-e _ ? "cannot execute" : "no such file") . "\n");
|
|
}
|
|
} elsif ($gpgv) {
|
|
if (! -x $gpgv) {
|
|
&fail("$0: $gpgv: " . (-e _ ? "cannot execute" : "no such file") . "\n");
|
|
}
|
|
} elsif (! -x $pgp) {
|
|
&fail("$0: $pgp: " . (-e _ ? "cannot execute" : "no such file") . "\n");
|
|
}
|
|
|
|
# Parse the article headers and generate the PGP message.
|
|
my ($nntp_format, $header, $dup) = &parse_header();
|
|
exit 1 unless $$header{'X-PGP-Sig'};
|
|
my ($message, $signature, $version)
|
|
= &generate_message($nntp_format, $header, $dup);
|
|
if ($test) {
|
|
print "-----MESSAGE-----\n$message\n-----END MESSAGE-----\n\n";
|
|
print "-----SIGNATURE-----\n$signature\n-----SIGNATURE-----\n\n";
|
|
}
|
|
|
|
# The call to pgp needs to be locked because it tries to both read and
|
|
# write a file named randseed.bin but doesn't do its own locking as it
|
|
# should, and the consequences of a multiprocess conflict is failure to
|
|
# verify.
|
|
my $lock;
|
|
unless ($sq or $gpg or $gpgv) {
|
|
$lock = "$lockdir/LOCK.$0";
|
|
until (&shlock($lock) > 0) {
|
|
sleep(2);
|
|
}
|
|
}
|
|
|
|
# Verify the message.
|
|
my ($ok, $signer) = pgp_verify($signature, $version, $message);
|
|
unless ($sq or $gpg or $gpgv) {
|
|
unlink ($lock) or &errmsg("$0: unlink $lock: $!\n");
|
|
}
|
|
print "$signer\n" if $signer;
|
|
unless ($ok == 0) {
|
|
&errmsg("$0: verification failed\n");
|
|
}
|
|
exit $ok;
|
|
|
|
|
|
# Parse the article headers and return a flag saying whether the message
|
|
# is in NNTP format and then two references to hashes. The first hash
|
|
# contains all the header/value pairs, and the second contains entries for
|
|
# every header that's duplicated. This is, by design, case-sensitive with
|
|
# regards to the headers it checks. It's also insistent about the
|
|
# colon-space rule.
|
|
sub parse_header {
|
|
my (%header, %dup, $label, $value, $nntp_format);
|
|
while (<>) {
|
|
# If the first header line ends with \r\n, this article is in the
|
|
# encoding it would be in during an NNTP session. Some article
|
|
# storage managers keep them this way for efficiency.
|
|
$nntp_format = /\r\n$/ if $. == 1;
|
|
s/\r?\n$//;
|
|
|
|
last if /^$/;
|
|
if (/^(\S+):[ \t](.+)/) {
|
|
($label, $value) = ($1, $2);
|
|
$dup{$label} = 1 if $header{$label};
|
|
$header{$label} = $value;
|
|
} elsif (/^\s/) {
|
|
&fail("$0: non-header at line $.: $_\n") unless $label;
|
|
$header{$label} .= "\n$_";
|
|
} else {
|
|
&fail("$0: non-header at line $.: $_\n");
|
|
}
|
|
}
|
|
$messageid = $header{'Message-ID'};
|
|
return ($nntp_format, \%header, \%dup);
|
|
}
|
|
|
|
# Generate the PGP message to verify. Takes a flag indicating wire
|
|
# format, the hash of headers and header duplicates returned by
|
|
# parse_header and returns a list of three elements. The first is the
|
|
# message to verify, the second is the signature, and the third is the
|
|
# version number.
|
|
sub generate_message {
|
|
my ($nntp_format, $header, $dup) = @_;
|
|
|
|
# The regexp below might be too strict about the structure of PGP
|
|
# signature lines.
|
|
|
|
# The $sep value means the separator between the radix64 signature lines
|
|
# can have any amount of spaces or tabs, but must have at least one
|
|
# space or tab; if there is a newline then the space or tab has to
|
|
# follow the newline. Any number of newlines can appear as long as each
|
|
# is followed by at least one space or tab. *phew*
|
|
my $sep = "[ \t]*(\n?[ \t]+)+";
|
|
|
|
# Match all of the characters in a radix64 string.
|
|
my $r64 = '[a-zA-Z0-9+/]';
|
|
|
|
local $_ = $$header{'X-PGP-Sig'};
|
|
&fail("$0: X-PGP-Sig not in expected format\n")
|
|
unless /^(\S+)$sep(\S+)(($sep$r64{64})+$sep$r64+=?=?$sep=$r64{4})$/;
|
|
|
|
my ($version, $signed_headers, $signature) = ($1, $3, $4);
|
|
$signature =~ s/$sep/\n/g;
|
|
$signature =~ s/^\s+//;
|
|
|
|
my $message = "X-Signed-Headers: $signed_headers\n";
|
|
my $label;
|
|
foreach $label (split(",", $signed_headers)) {
|
|
&fail("$0: duplicate signed $label header, can't verify\n")
|
|
if $$dup{$label};
|
|
$message .= "$label: ";
|
|
$message .= "$$header{$label}" if $$header{$label};
|
|
$message .= "\n";
|
|
}
|
|
$message .= "\n"; # end of headers
|
|
|
|
while (<>) { # read body lines
|
|
if ($nntp_format) {
|
|
# Check for end of article; some news servers (eg, Highwind's
|
|
# "Breeze") include the dot-CRLF of the NNTP protocol in the article
|
|
# data passed to this script.
|
|
last if $_ eq ".\r\n";
|
|
|
|
# Remove NNTP encoding.
|
|
s/^\.\./\./;
|
|
s/\r\n$/\n/;
|
|
}
|
|
$message .= $_;
|
|
}
|
|
|
|
# Strip off all trailing whitespaces for compatibility with the way that
|
|
# pgpverify used to work, using attached signatures.
|
|
$message =~ s/[ \t]+\n/\n/g;
|
|
|
|
return ($message, $signature, $version);
|
|
}
|
|
|
|
# Check a detached signature for given data. Takes a signature block (in
|
|
# the form of an ASCII-armored string with embedded newlines), a version
|
|
# number (which may be undef), and the message. We return an exit status
|
|
# and the key id if the signature is verified. 0 means good signature, 1
|
|
# means bad data, 2 means an unknown signer, 3 means a bad signature, and
|
|
# 4 means good signature without having found the argument given to the
|
|
# --findid flag.
|
|
# In the event of an error, we report with errmsg.
|
|
#
|
|
# This code is taken almost verbatim from PGP::Sign except for the code to
|
|
# figure out the PGP style.
|
|
sub pgp_verify {
|
|
my ($signature, $version, $message) = @_;
|
|
chomp $signature;
|
|
|
|
# Ignore SIGPIPE, since we're going to be talking to PGP.
|
|
local $SIG{PIPE} = 'IGNORE';
|
|
|
|
# Set the PGP style based on whether $gpg or $gpgv is set.
|
|
my $pgpstyle = ($sq || $gpg || $gpgv ? 'GPG' : 'PGP2');
|
|
|
|
# Because this is a detached signature, we actually need to save both
|
|
# the signature and the data to files and then run PGP on the signature
|
|
# file to make it verify the signature. Because this is a detached
|
|
# signature, though, we don't have to do any data mangling, which makes
|
|
# our lives much easier. It would be nice to do this without having to
|
|
# use temporary files, but I don't see any way to do so without running
|
|
# into mangling problems.
|
|
#
|
|
# PGP v5 *requires* there be some subheader or another. *sigh*. So we
|
|
# supply one if Version isn't given. :)
|
|
my $umask = umask 077;
|
|
my $filename = $tmpdir . '/pgp' . time . '.' . $$;
|
|
my $sigfile = new FileHandle "$filename.asc", O_WRONLY|O_EXCL|O_CREAT;
|
|
unless ($sigfile) {
|
|
&errmsg ("Unable to open temp file $filename.asc: $!\n");
|
|
return (255, undef);
|
|
}
|
|
if ($pgpstyle eq 'PGP2') {
|
|
print $sigfile "-----BEGIN PGP MESSAGE-----\n";
|
|
} else {
|
|
print $sigfile "-----BEGIN PGP SIGNATURE-----\n";
|
|
}
|
|
if (defined $version) {
|
|
print $sigfile "Version: $version\n";
|
|
} elsif ($pgpstyle ne 'GPG') {
|
|
print $sigfile "Comment: Use GnuPG; it's better :)\n";
|
|
}
|
|
print $sigfile "\n", $signature;
|
|
if ($pgpstyle eq 'PGP2') {
|
|
print $sigfile "\n-----END PGP MESSAGE-----\n";
|
|
} else {
|
|
print $sigfile "\n-----END PGP SIGNATURE-----\n";
|
|
}
|
|
close $sigfile;
|
|
|
|
# Signature saved. Now save the actual message.
|
|
my $datafile = new FileHandle "$filename", O_WRONLY|O_EXCL|O_CREAT;
|
|
unless ($datafile) {
|
|
&errmsg ("Unable to open temp file $filename: $!\n");
|
|
unlink "$filename.asc";
|
|
return (255, undef);
|
|
}
|
|
print $datafile $message;
|
|
close $datafile;
|
|
|
|
# Figure out what command line we'll be using.
|
|
my @command;
|
|
if ($sq) {
|
|
@command = ($sq, qw/verify --quiet/);
|
|
} elsif ($pgpstyle eq 'GPG') {
|
|
if ($gpg) {
|
|
@command = ($gpg, qw/--verify --allow-weak-digest-algos/);
|
|
push (@command, qw/--quiet --status-fd=1 --logger-fd=1/);
|
|
} else {
|
|
@command = ($gpgv, qw/--quiet --status-fd=1 --logger-fd=1/);
|
|
}
|
|
} else {
|
|
@command = ($pgp, '+batchmode', '+language=en');
|
|
}
|
|
|
|
# Now, call PGP to check the signature. Because we've written
|
|
# everything out to a file, this is actually fairly simple; all we need
|
|
# to do is grab stdout. PGP prints its banner information to stderr, so
|
|
# just ignore stderr. Set PGPPATH if desired.
|
|
#
|
|
# For GnuPG, use pubring.gpg if an explicit keyring was configured or
|
|
# found. Otherwise, use trustedkeys.gpg in the default keyring location
|
|
# if found and non-zero, or fall back on pubring.gpg. This is
|
|
# definitely not the logic that I would use if writing this from
|
|
# scratch, but it has the most backward compatibility.
|
|
local $ENV{PGPPATH} = $keyring if ($keyring && $pgpstyle ne 'GPG');
|
|
|
|
if ($sq) {
|
|
if ($keyring) {
|
|
if (-f $keyring) {
|
|
push (@command, "--signer-file=$keyring");
|
|
} elsif (-d $keyring) {
|
|
push (@command, "--home=$keyring");
|
|
}
|
|
}
|
|
if ($sq_policy_as_of) {
|
|
push (@command, "--policy-as-of=$sq_policy_as_of");
|
|
}
|
|
|
|
push (@command, "--signature-file=$filename.asc");
|
|
push (@command, $filename);
|
|
} else {
|
|
if ($pgpstyle eq 'GPG') {
|
|
if ($keyring) {
|
|
push (@command, "--keyring=$keyring/pubring.gpg");
|
|
} else {
|
|
my $home = $ENV{GNUPGHOME} || $ENV{HOME};
|
|
$home .= '/.gnupg' if $home;
|
|
if ($home && ! -s "$home/trustedkeys.gpg" && -f "$home/pubring.gpg") {
|
|
push (@command, "--keyring=pubring.gpg");
|
|
}
|
|
}
|
|
}
|
|
push (@command, "$filename.asc");
|
|
push (@command, $filename);
|
|
}
|
|
my $input = new FileHandle;
|
|
my $output = new FileHandle;
|
|
my $pid = eval { open3 ($input, $output, $output, @command) };
|
|
if ($@) {
|
|
&errmsg ($@);
|
|
&errmsg ("Execution of $command[0] failed.\n");
|
|
unlink ($filename, "$filename.asc");
|
|
return (255, undef);
|
|
}
|
|
close $input;
|
|
|
|
# Check for the message that gives us the key status and return the
|
|
# appropriate thing to our caller. This part is a zoo due to all of the
|
|
# different formats used. GPG has finally done the right thing and
|
|
# implemented a separate status stream with parseable data.
|
|
#
|
|
# MIT PGP 2.6.2 and PGP 6.5.2:
|
|
# Good signature from user "Russ Allbery <rra@stanford.edu>".
|
|
# ViaCrypt PGP 4.0:
|
|
# Good signature from user: Russ Allbery <rra@stanford.edu>
|
|
# PGP 5.0:
|
|
# Good signature made 1999-02-10 03:29 GMT by key:
|
|
# 1024 bits, Key ID 0AFC7476, Created 1999-02-10
|
|
# "Russ Allbery <rra@stanford.edu>"
|
|
# sequoia 1.0.0:
|
|
# Authenticated signature made by KEY_FINGERPRINT (USER_ID (authenticated))
|
|
#
|
|
# Also, PGP v2 prints out "Bad signature" while PGP v5 uses "BAD
|
|
# signature", and PGP v6 reverts back to "Bad signature".
|
|
local $_;
|
|
local $/ = '';
|
|
my $signer;
|
|
my $ok = 255;
|
|
while (<$output>) {
|
|
print if $test;
|
|
if ($sq) {
|
|
if (/Authenticated signature made by (\S+) \((.+)\s+.+\)/) {
|
|
$ok = 0;
|
|
$signer = $2;
|
|
} elsif (/missing certificate/) {
|
|
$ok = 2;
|
|
last;
|
|
} elsif (/Error/) {
|
|
# TODO check various error and edge cases
|
|
$ok = 3;
|
|
last;
|
|
}
|
|
} elsif ($pgpstyle eq 'GPG') {
|
|
if (/\[GNUPG:\]\s+GOODSIG\s+\S+\s+(\S+)/) {
|
|
$ok = 0;
|
|
$signer = $1;
|
|
} elsif (/\[GNUPG:\]\s+NODATA/ || /\[GNUPG:\]\s+UNEXPECTED/) {
|
|
$ok = 1;
|
|
last;
|
|
} elsif (/\[GNUPG:\]\s+NO_PUBKEY/) {
|
|
$ok = 2;
|
|
last;
|
|
} elsif (/\[GNUPG:\]\s+BADSIG\s+/) {
|
|
$ok = 3;
|
|
last;
|
|
}
|
|
} else {
|
|
if (/^Good signature from user(?::\s+(.*)|\s+\"(.*)\"\.)$/m) {
|
|
$signer = $+;
|
|
$ok = 0;
|
|
} elsif (/^Good signature made .* by key:\n.+\n\s+\"(.*)\"/m) {
|
|
$signer = $1;
|
|
$ok = 0;
|
|
} elsif (/^\S+: Good signature from \"(.*)\"/m) {
|
|
$signer = $1;
|
|
$ok = 0;
|
|
} elsif (/^(?:\S+: )?Bad signature /im) {
|
|
$ok = 3;
|
|
last;
|
|
}
|
|
}
|
|
# If the --findid flag is used, and the signature is good,
|
|
# override the value of the signer with the string specified in
|
|
# the --findid flag.
|
|
if (defined ($findid) and $ok eq 0) {
|
|
$signer = $findid if (/$findid/);
|
|
}
|
|
}
|
|
close $input;
|
|
waitpid ($pid, 0);
|
|
unlink ($filename, "$filename.asc");
|
|
umask $umask;
|
|
|
|
if (defined ($findid) and $ok eq 0 and $signer ne $findid) {
|
|
$ok = 4;
|
|
}
|
|
|
|
return ($ok, $signer || '');
|
|
}
|
|
|
|
# Log an error message, attempting syslog first based on $syslog_method
|
|
# and falling back on stderr.
|
|
sub errmsg {
|
|
my ($message) = @_;
|
|
$message =~ s/\n$//;
|
|
|
|
my $date = '';
|
|
if ($log_date) {
|
|
$date = strftime ('%Y-%m-%d %T ', localtime);
|
|
}
|
|
|
|
if ($syslog_method && $] >= 5.006) {
|
|
eval "use Sys::Syslog";
|
|
$syslog_method = 'internal';
|
|
}
|
|
|
|
if ($syslog_method eq "logger") {
|
|
my @loggers = ('/usr/ucb/logger', '/usr/bin/logger',
|
|
'/usr/local/bin/logger');
|
|
my $try;
|
|
foreach $try (@loggers) {
|
|
if (-x $try) {
|
|
$syslog_method = $try;
|
|
last;
|
|
}
|
|
}
|
|
$syslog_method = '' if $syslog_method eq 'logger';
|
|
}
|
|
|
|
if ($syslog_method ne '' && $syslog_method !~ m%/logger$%) {
|
|
eval "use Sys::Syslog";
|
|
}
|
|
|
|
if ($@ || $syslog_method eq '') {
|
|
warn $date, "$0: trying to use Perl's syslog: $@\n" if $@;
|
|
warn $date, $message, "\n";
|
|
warn $date, "... while processing $messageid\n"
|
|
if $messageid;
|
|
|
|
} else {
|
|
$message .= " processing $messageid"
|
|
if $messageid;
|
|
|
|
if ($syslog_method =~ m%/logger$%) {
|
|
unless (system($syslog_method, "-i", "-p",
|
|
"$syslog_facility.$syslog_level", $message) == 0) {
|
|
if ($? >> 8) {
|
|
warn $date, "$0: $syslog_method exited status ", $? >> 8, "\n";
|
|
} else {
|
|
warn $date, "$0: $syslog_method died on signal ", $? & 255, "\n";
|
|
}
|
|
$syslog_method = '';
|
|
&errmsg($message);
|
|
}
|
|
|
|
} else {
|
|
# setlogsock arrived in Perl 5.004_03 to enable Sys::Syslog to use a
|
|
# Unix domain socket to talk to syslogd, which is the only way to do
|
|
# it when syslog runs with the -l switch.
|
|
if ($syslog_method eq "unix") {
|
|
if ($^O eq "dec_osf" && $] >= 5) {
|
|
eval 'sub Sys::Syslog::_PATH_LOG { "/dev/log" }';
|
|
}
|
|
if ($] <= 5.00403 || ! eval "setlogsock('unix')") {
|
|
warn $date, "$0: cannot use syslog_method 'unix' on this system\n";
|
|
$syslog_method = '';
|
|
&errmsg($message);
|
|
return;
|
|
}
|
|
}
|
|
|
|
# Unfortunately, there is no way to definitively know in this
|
|
# program if the message was logged. I wish there were a way to
|
|
# send a message to stderr if and only if the syslog attempt failed.
|
|
&openlog($0, 'pid', $syslog_facility);
|
|
&syslog($syslog_level, $_[0]);
|
|
&closelog();
|
|
}
|
|
}
|
|
}
|
|
|
|
sub fail {
|
|
&errmsg($_[0]);
|
|
exit 255;
|
|
}
|
|
|
|
# Get a lock in essentially the same fashion as INN's shlock. return 1 on
|
|
# success, 0 for normal failure, -1 for abnormal failure. "normal
|
|
# failure" is that a lock is apparently in use by someone else.
|
|
sub shlock {
|
|
my ($file) = @_;
|
|
my ($ltmp, $pid);
|
|
|
|
unless (defined(&ENOENT)) {
|
|
eval "require POSIX qw(:errno_h)";
|
|
if ($@) {
|
|
# values taken from BSD/OS 3.1
|
|
sub ENOENT { 2 }
|
|
sub ESRCH { 3 }
|
|
sub EEXIST { 17 }
|
|
}
|
|
}
|
|
|
|
$ltmp = ($file =~ m%(.*/)%)[0] . "shlock$$";
|
|
|
|
# This should really attempt to use another temp name.
|
|
-e $ltmp && (unlink($ltmp) || return -1);
|
|
|
|
open(LTMP, ">$ltmp") || return -1;
|
|
print LTMP "$$\n" || (unlink($ltmp), return -1);
|
|
close(LTMP) || (unlink($ltmp), return -1);
|
|
|
|
if (!link($ltmp, $file)) {
|
|
if ($! == &EEXIST) {
|
|
if (open(LOCK, "<$file")) {
|
|
$pid = <LOCK>;
|
|
if ($pid =~ /^\d+$/ && (kill(0, $pid) == 1 || $! != &ESRCH)) {
|
|
unlink($ltmp);
|
|
return 0;
|
|
}
|
|
|
|
# OK, the pid in the lockfile is not a number or no longer exists.
|
|
close(LOCK); # silent failure is ok here
|
|
|
|
# Unlink failed.
|
|
if (unlink($file) != 1 && $! != &ENOENT) {
|
|
unlink($ltmp);
|
|
return 0;
|
|
}
|
|
|
|
# Check if open failed for reason other than file no longer present.
|
|
} elsif ($! != &ENOENT) {
|
|
unlink($ltmp);
|
|
return -1;
|
|
}
|
|
|
|
# Either this process unlinked the lockfile because it was bogus, or
|
|
# between this process's link() and open() the other process holding
|
|
# the lock unlinked it. This process can now try to acquire.
|
|
if (! link($ltmp, $file)) {
|
|
unlink($ltmp);
|
|
return $! == &EEXIST ? 0 : -1; # Maybe another proc grabbed the lock.
|
|
}
|
|
|
|
} else { # First attempt to link failed.
|
|
unlink($ltmp);
|
|
return 0;
|
|
}
|
|
}
|
|
unlink($ltmp);
|
|
return 1;
|
|
}
|
|
|
|
=head1 NAME
|
|
|
|
pgpverify - Cryptographically verify Usenet control messages
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
B<pgpverify> [B<--findid>=I<string>] [B<--test>] < I<message>
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The B<pgpverify> program reads (on standard input) a Usenet control
|
|
message that has been cryptographically signed using the B<signcontrol>
|
|
program (or some other program that produces a compatible format).
|
|
B<pgpverify> then uses a PGP implementation to determine who signed the
|
|
control message. If the control message has a valid signature,
|
|
B<pgpverify> prints (to stdout) the user ID of the key that signed the
|
|
message. Otherwise, it exits with a non-zero exit status.
|
|
|
|
If B<pgpverify> is installed as part of INN, it uses INN's configuration
|
|
to determine what signature verification program to use, how to log
|
|
errors, what temporary directory to use, and what keyring to use.
|
|
Otherwise, all of those parameters can be set by editing the beginning of
|
|
this script.
|
|
|
|
By default, when running as part of INN, B<pgpverify> expects the PGP key
|
|
ring to be found in I<pathetc>/pgp (as either F<pubring.pgp> or
|
|
F<pubring.gpg> depending on whether PGP or GnuPG is used to verify
|
|
signatures). If that directory doesn't exist, it will fall back on using
|
|
the default key ring, which is in a F<.pgp> or F<.gnupg> subdirectory of
|
|
the running user's home directory.
|
|
|
|
INN, when using GnuPG, configures B<pgpverify> to use B<gpg> or B<gpgv>, which
|
|
by default expects keys to be in a keyring named F<trustedkeys.gpg>, since it
|
|
doesn't implement trust checking directly. B<pgpverify> uses that file if
|
|
present but falls back to F<pubring.gpg> if it's not found. This bypasses
|
|
the trust model for checking keys, but is compatible with the way that
|
|
B<pgpverify> used to behave. Of course, if a keyring is found in
|
|
I<pathetc>/pgp or configured at the top of the script, that overrides all of
|
|
this behavior.
|
|
|
|
=head1 OPTIONS
|
|
|
|
=over 4
|
|
|
|
=item B<--findid>=I<string>
|
|
|
|
The B<--findid> flag causes B<pgpverify> to explicitly search for
|
|
I<string> in the output from PGP's analysis of the message. This option
|
|
is useful when several UIDs are defined on a single PGP key, and the
|
|
caller to B<pgpverify> needs checking whether a given one is defined on
|
|
this key. In case the signature is valid but does not contain I<string>,
|
|
B<pgpverify> exits with exit status 4.
|
|
|
|
=item B<--test>
|
|
|
|
The B<--test> flag causes B<pgpverify> to print out the input that it is
|
|
passing to PGP (which is a reconstructed version of the input that
|
|
supposedly created the control message) as well as the output from PGP's
|
|
analysis of the message.
|
|
|
|
=back
|
|
|
|
=head1 EXIT STATUS
|
|
|
|
B<pgpverify> may exit with the following statuses:
|
|
|
|
=over 4
|
|
|
|
=item 0Z<>
|
|
|
|
The control message had a good PGP signature.
|
|
|
|
=item 1Z<>
|
|
|
|
The control message had no PGP signature.
|
|
|
|
=item 2Z<>
|
|
|
|
The control message had an unknown PGP signature.
|
|
|
|
=item 3Z<>
|
|
|
|
The control message had a bad PGP signature.
|
|
|
|
=item 4Z<>
|
|
|
|
The control message had a good PGP signature but the argument given
|
|
to the B<--findid> flag had non been found in the output from PGP's
|
|
analysis of the message.
|
|
|
|
=item 255Z<>
|
|
|
|
A problem occurred not directly related to PGP analysis of signature.
|
|
|
|
=back
|
|
|
|
=head1 ENVIRONMENT
|
|
|
|
B<pgpverify> does not modify or otherwise alter the environment before
|
|
invoking the B<pgp>, B<gpgv> or B<gpg> program. It is the responsibility of
|
|
the person who installs B<pgpverify> to ensure that when B<pgp>, B<gpgv> or
|
|
B<gpg> runs, it has the ability to locate and read a PGP key file that
|
|
contains the PGP public keys for the appropriate Usenet hierarchy
|
|
administrators. B<pgpverify> can be pointed to an appropriate key ring by
|
|
editing variables at the beginning of this script.
|
|
|
|
=head1 NOTES
|
|
|
|
Historically, Usenet news server administrators have configured their news
|
|
servers to automatically honor Usenet control messages based on the
|
|
originator of the control messages and the hierarchies for which the
|
|
control messages applied. For example, in the past, David Lawrence always
|
|
issued control messages for the S<"Big 8"> hierarchies (comp, humanities,
|
|
misc, news, rec, sci, soc, talk). Usenet news administrators would
|
|
configure their news server software to automatically honor newgroup and
|
|
rmgroup control messages that originated from David Lawrence and applied
|
|
to any of the S<Big 8> hierarchies.
|
|
|
|
Unfortunately, Usenet news articles (including control messages) are
|
|
notoriously easy to forge. Soon, malicious users realized they could
|
|
create or remove (at least temporarily) any S<Big 8> newsgroup they wanted by
|
|
simply forging an appropriate control message in David Lawrence's name.
|
|
As Usenet became more widely used, forgeries became more common.
|
|
|
|
The B<pgpverify> program was designed to allow Usenet news administrators
|
|
to configure their servers to cryptographically verify control messages
|
|
before automatically acting on them. Under the B<pgpverify> system, a Usenet
|
|
hierarchy maintainer creates a PGP public/private key pair and
|
|
disseminates the public key. Whenever the hierarchy maintainer issues a
|
|
control message, he uses the B<signcontrol> program to sign the control
|
|
message with the PGP private key. Usenet news administrators configure
|
|
their news servers to run the B<pgpverify> program on the appropriate
|
|
control messages, and take action based on the PGP key User ID that signed
|
|
the control message, not the name and address that appear in the control
|
|
message's From: or Sender: headers.
|
|
|
|
Thus, appropriate use of the B<signcontrol> and B<pgpverify> programs
|
|
essentially eliminates the possibility of malicious users forging Usenet
|
|
control messages that sites will act upon, as such users would have to
|
|
obtain the PGP private key in order to forge a control message that would
|
|
pass the cryptographic verification step. If the hierarchy administrators
|
|
properly protect their PGP private keys, the only way a malicious user
|
|
could forge a validly-signed control message would be by breaking the
|
|
public key encryption algorithm, which (at least at this time) is believed
|
|
to be prohibitively difficult for PGP keys of a sufficient bit length.
|
|
|
|
=head1 HISTORY
|
|
|
|
B<pgpverify> was written by David C Lawrence <tale@isc.org>. Manual page
|
|
provided by James Ralston. It is currently maintained by Russ Allbery
|
|
<eagle@eyrie.org>.
|
|
|
|
=head1 COPYRIGHT AND LICENSE
|
|
|
|
David Lawrence wrote: "Our lawyer told me to include the following. The
|
|
upshot of it is that you can use the software for free as much as you
|
|
like."
|
|
|
|
Copyright (c) 1996 UUNET Technologies, Inc.
|
|
All rights reserved.
|
|
|
|
Redistribution and use in source and binary forms, with or without
|
|
modification, are permitted provided that the following conditions are
|
|
met:
|
|
|
|
=over 4
|
|
|
|
=item 1.
|
|
|
|
Redistributions of source code must retain the above copyright notice,
|
|
this list of conditions and the following disclaimer.
|
|
|
|
=item 2.
|
|
|
|
Redistributions in binary form must reproduce the above copyright notice,
|
|
this list of conditions and the following disclaimer in the documentation
|
|
and/or other materials provided with the distribution.
|
|
|
|
=item 3.
|
|
|
|
All advertising materials mentioning features or use of this software must
|
|
display the following acknowledgement:
|
|
|
|
This product includes software developed by UUNET Technologies, Inc.
|
|
|
|
=item 4.
|
|
|
|
The name of UUNET Technologies ("UUNET") may not be used to endorse or
|
|
promote products derived from this software without specific prior written
|
|
permission.
|
|
|
|
=back
|
|
|
|
THIS SOFTWARE IS PROVIDED BY UUNET "AS IS" AND ANY EXPRESS OR IMPLIED
|
|
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
|
|
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN
|
|
NO EVENT SHALL UUNET BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
|
|
TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
|
|
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
|
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
|
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
|
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
gpg(1), gpgv(1), pgp(1).
|
|
|
|
L<https://ftp.isc.org/pub/pgpcontrol/> is where the most recent versions of
|
|
B<signcontrol> and B<pgpverify> live, along with PGP public keys used for
|
|
hierarchy administration.
|
|
|
|
=cut
|
|
|
|
# Local variables:
|
|
# cperl-indent-level: 2
|
|
# fill-column: 74
|
|
# End:
|