Module-Signature
view release on metacpan or search on metacpan
lib/Module/Signature.pm view on Meta::CPAN
(my $sigtext = _read_sigfile($SIGNATURE)) or do {
warn "==> MALFORMED Signature file! <==\n";
return SIGNATURE_MALFORMED;
};
(my ($cipher_map) = _cipher_map($sigtext)) or do {
warn "==> MALFORMED Signature file! <==\n";
return SIGNATURE_MALFORMED;
};
(defined(my $plaintext = _mkdigest($cipher_map))) or do {
warn "==> UNKNOWN Cipher format! <==\n";
return CIPHER_UNKNOWN;
};
$rv = _verify($SIGNATURE, $sigtext, $plaintext);
if ($rv == SIGNATURE_OK) {
my ($mani, $file) = _fullcheck($args{skip});
if (@{$mani} or @{$file}) {
warn "==> MISMATCHED content between MANIFEST and distribution files! <==\n";
return MANIFEST_MISMATCH;
}
else {
warn "==> Signature verified OK! <==\n" if $Verbose;
}
}
elsif ($rv == SIGNATURE_BAD) {
warn "==> BAD/TAMPERED signature detected! <==\n";
}
elsif ($rv == SIGNATURE_MISMATCH) {
warn "==> MISMATCHED content between SIGNATURE and distribution files! <==\n";
}
return $rv;
}
sub _verify {
my $signature = shift || $SIGNATURE;
my $sigtext = shift || '';
my $plaintext = shift || '';
# Avoid loading modules from relative paths in @INC.
local @INC = grep { File::Spec->file_name_is_absolute($_) } @INC;
local $SIGNATURE = $signature if $signature ne $SIGNATURE;
if ($AutoKeyRetrieve and !$CanKeyRetrieve) {
if (!defined $CanKeyRetrieve) {
require IO::Socket::INET;
my $sock = IO::Socket::INET->new(
Timeout => $Timeout,
PeerAddr => "$KeyServer:$KeyServerPort",
);
$CanKeyRetrieve = ($sock ? 1 : 0);
$sock->shutdown(2) if $sock;
}
$AutoKeyRetrieve = $CanKeyRetrieve;
}
if (my $version = _has_gpg()) {
return _verify_gpg($sigtext, $plaintext, $version);
}
elsif (eval {require Crypt::OpenPGP; 1}) {
return _verify_crypt_openpgp($sigtext, $plaintext);
}
else {
warn "Cannot use GnuPG or Crypt::OpenPGP, please install either one first!\n";
return _compare($sigtext, $plaintext, CANNOT_VERIFY);
}
}
sub _has_gpg {
my $gpg = _which_gpg() or return;
`$gpg --version` =~ /GnuPG.*?(\S+)\s*$/m or return;
return $1;
}
sub _fullcheck {
my $skip = shift;
my @extra;
local $^W;
local $ExtUtils::Manifest::Quiet = 1;
my($mani, $file);
if( _legacy_extutils() ) {
my $_maniskip;
if ( _public_maniskip() ) {
$_maniskip = &ExtUtils::Manifest::maniskip;
} else {
$_maniskip = &ExtUtils::Manifest::_maniskip;
}
local *ExtUtils::Manifest::_maniskip = sub { sub {
return unless $skip;
my $ok = $_maniskip->(@_);
if ($ok ||= (!-e 'MANIFEST.SKIP' and _default_skip(@_))) {
print "Skipping $_\n" for @_;
push @extra, @_;
}
return $ok;
} };
($mani, $file) = ExtUtils::Manifest::fullcheck();
}
else {
my $_maniskip = &ExtUtils::Manifest::maniskip;
local *ExtUtils::Manifest::maniskip = sub { sub {
return unless $skip;
return $_maniskip->(@_);
} };
($mani, $file) = ExtUtils::Manifest::fullcheck();
}
foreach my $makefile ('Makefile', 'Build') {
warn "==> SKIPPED CHECKING '$_'!" .
(-e "$_.PL" && " (run $_.PL to ensure its integrity)") .
" <===\n" for grep $_ eq $makefile, @extra;
}
@{$mani} = grep {$_ ne 'SIGNATURE'} @{$mani};
warn "Not in MANIFEST: $_\n" for @{$file};
warn "No such file: $_\n" for @{$mani};
return ($mani, $file);
}
sub _legacy_extutils {
# ExtUtils::Manifest older than 1.58 does not handle MYMETA.
return (ExtUtils::Manifest->VERSION < 1.58);
}
sub _public_maniskip {
# ExtUtils::Manifest 1.54 onwards have public maniskip
return (ExtUtils::Manifest->VERSION > 1.53);
}
sub _default_skip {
local $_ = shift;
return 1 if /\bRCS\b/ or /\bCVS\b/ or /\B\.svn\b/ or /,v$/
or /^MANIFEST\.bak/ or /^Makefile$/ or /^blib\//
or /^MakeMaker-\d/ or /^pm_to_blib/ or /^blibdirs/
or /^_build\// or /^Build$/ or /^pmfiles\.dat/
or /^MYMETA\./
or /~$/ or /\.old$/ or /\#$/ or /^\.#/;
}
my $which_gpg;
sub _which_gpg {
# Cache it so we don't need to keep checking.
return $which_gpg if $which_gpg;
for my $gpg_bin ('gpg', 'gpg2', 'gnupg', 'gnupg2') {
my $version = `$gpg_bin --version 2>&1`;
if( $version && $version =~ /GnuPG/ ) {
$which_gpg = $gpg_bin;
return $which_gpg;
}
}
}
sub _verify_gpg {
my ($sigtext, $plaintext, $version) = @_;
local $SIGNATURE = Win32::GetShortPathName($SIGNATURE)
if defined &Win32::GetShortPathName and $SIGNATURE =~ /[^-\w.:~\\\/]/;
my $keyserver = _keyserver($version);
require File::Temp;
my $fh = File::Temp->new();
print $fh $sigtext || _read_sigfile($SIGNATURE);
close $fh;
my $gpg = _which_gpg();
my @quiet = $Verbose ? () : qw(-q --logger-fd=1);
my @cmd = (
$gpg, qw(--verify --batch --no-tty), @quiet, ($KeyServer ? (
"--keyserver=$keyserver",
($AutoKeyRetrieve and $version ge '1.0.7')
? '--keyserver-options=auto-key-retrieve'
: ()
) : ()), $fh->filename
);
my $output = '';
if( $Verbose ) {
warn "Executing @cmd\n";
system @cmd;
}
else {
my $cmd = join ' ', @cmd;
$output = `$cmd`;
}
unlink $fh->filename;
if( $? ) {
print STDERR $output;
}
elsif ($output =~ /((?: +[\dA-F]{4}){10,})/) {
warn "WARNING: This key is not certified with a trusted signature!\n";
warn "Primary key fingerprint:$1\n";
}
return SIGNATURE_BAD if ($? and $AutoKeyRetrieve);
return _compare($sigtext, $plaintext, (!$?) ? SIGNATURE_OK : CANNOT_VERIFY);
}
sub _keyserver {
my $version = shift;
my $scheme = 'x-hkp';
$scheme = 'hkp' if $version ge '1.2.0';
return "$scheme://$KeyServer:$KeyServerPort";
}
sub _verify_crypt_openpgp {
my ($sigtext, $plaintext) = @_;
require Crypt::OpenPGP;
my $pgp = Crypt::OpenPGP->new(
($KeyServer) ? ( KeyServer => $KeyServer, AutoKeyRetrieve => $AutoKeyRetrieve ) : (),
);
my $rv = $pgp->handle( Data => $sigtext )
or die $pgp->errstr;
return SIGNATURE_BAD if (!$rv->{Validity} and $AutoKeyRetrieve);
if ($rv->{Validity}) {
warn 'Signature made ', scalar localtime($rv->{Signature}->timestamp),
' using key ID ', substr(uc(unpack('H*', $rv->{Signature}->key_id)), -8), "\n",
"Good signature from \"$rv->{Validity}\"\n" if $Verbose;
}
else {
warn "Cannot verify signature; public key not found\n";
}
return _compare($sigtext, $plaintext, $rv->{Validity} ? SIGNATURE_OK : CANNOT_VERIFY);
lib/Module/Signature.pm view on Meta::CPAN
}
$signature .= $_;
return "$begin$signature" if $_ eq $end;
}
return;
}
sub _compare {
my ($str1, $str2, $ok) = @_;
# normalize all linebreaks
$str1 =~ s/^-----BEGIN PGP SIGNED MESSAGE-----\n(?:.+\n)*\n//;
$str1 =~ s/[^\S ]+/\n/g; $str2 =~ s/[^\S ]+/\n/g;
$str1 =~ s/-----BEGIN PGP SIGNATURE-----\n(?:.+\n)*$//;
return $ok if $str1 eq $str2;
if (eval { require Text::Diff; 1 }) {
warn "--- $SIGNATURE ".localtime((stat($SIGNATURE))[9])."\n";
warn '+++ (current) '.localtime()."\n";
warn Text::Diff::diff( \$str1, \$str2, { STYLE => 'Unified' } );
}
else {
my $diff_fh;
my $signature_fh;
open ($signature_fh, '<', $SIGNATURE) or die "Could not open $SIGNATURE: $!";
open ($diff_fh, '|-', "diff -u --strip-trailing-cr $SIGNATURE -")
or (warn "Could not call diff: $!", return SIGNATURE_MISMATCH);
while (<$signature_fh>) {
print $diff_fh $_ if (1 .. /^-----BEGIN PGP SIGNED MESSAGE-----/);
print $diff_fh if (/^Hash: / .. /^$/);
next if (1 .. /^-----BEGIN PGP SIGNATURE/);
print $diff_fh $str2, "-----BEGIN PGP SIGNATURE-----\n", $_ and last;
}
print $diff_fh (<$signature_fh>);
close $diff_fh;
}
return SIGNATURE_MISMATCH;
}
sub sign {
my %args = ( skip => 1, @_ );
my $overwrite = $args{overwrite};
my $plaintext = _mkdigest();
my ($mani, $file) = _fullcheck($args{skip});
if (@{$mani} or @{$file}) {
warn "==> MISMATCHED content between MANIFEST and the distribution! <==\n";
warn "==> Please correct your MANIFEST file and/or delete extra files. <==\n";
}
if (!$overwrite and -e $SIGNATURE and IO::Interactive::is_interactive()) {
local $/ = "\n";
print "$SIGNATURE already exists; overwrite [y/N]? ";
return unless <STDIN> =~ /[Yy]/;
}
if (my $version = _has_gpg()) {
_sign_gpg($SIGNATURE, $plaintext, $version);
}
elsif (eval {require Crypt::OpenPGP; 1}) {
_sign_crypt_openpgp($SIGNATURE, $plaintext);
}
else {
die 'Cannot use GnuPG or Crypt::OpenPGP, please install either one first!';
}
warn "==> SIGNATURE file created successfully. <==\n";
return SIGNATURE_OK;
}
sub _sign_gpg {
my ($sigfile, $plaintext, $version) = @_;
die "Could not write to $sigfile"
if -e $sigfile and (-d $sigfile or not -w $sigfile);
my $gpg = _which_gpg();
my $gpg_fh;
my $set_key = '';
$set_key = qq{--default-key "$AUTHOR"} if($AUTHOR);
open ($gpg_fh, '|-', "$gpg $set_key --clearsign --openpgp --personal-digest-preferences RIPEMD160 >> $sigfile.tmp")
or die "Could not call $gpg: $!";
print $gpg_fh $plaintext;
close $gpg_fh;
(-e "$sigfile.tmp" and -s "$sigfile.tmp") or do {
unlink "$sigfile.tmp";
die "Cannot find $sigfile.tmp, signing aborted.\n";
};
my $sigfile_tmp_fh;
open ($sigfile_tmp_fh, '<', "$sigfile.tmp") or die "Cannot open $sigfile.tmp: $!";
my $sigfile_fh;
open ($sigfile_fh, '>', $sigfile) or do {
unlink "$sigfile.tmp";
die "Could not write to $sigfile: $!";
};
print $sigfile_fh $Preamble;
print $sigfile_fh (<$sigfile_tmp_fh>);
close $sigfile_fh;
close $sigfile_tmp_fh;
unlink("$sigfile.tmp");
my $key_id;
my $key_name;
my @verify = `$gpg --batch --logger-fd 1 --verify $SIGNATURE`;
foreach (@verify) {
if (/key(?: ID)? ([0-9A-F]+)$/) {
$key_id = $1;
} elsif (/signature from "(.+)"(?: \[[a-z]+\])?$/) {
$key_name = $1;
}
}
my $found_name;
my $found_key;
if (defined $key_id && defined $key_name) {
my $keyserver = _keyserver($version);
foreach (`$gpg --output - --keyserver=$keyserver --recv-key '$key_id' 2>&1`) {
if (/^\(\d+\)/) {
$found_name = 0;
} elsif ($key_id) {
my $short_key_id = substr($key_id, (length($key_id) - 16));
if (/key \Q$short_key_id\E/) {
$found_key = 1;
last;
}
}
if (/\Q$key_name\E/) {
$found_name = 1;
next;
}
}
unless ($found_key) {
_warn_non_public_signature($key_name);
}
}
return 1;
}
sub _sign_crypt_openpgp {
my ($sigfile, $plaintext) = @_;
require Crypt::OpenPGP;
my $pgp = Crypt::OpenPGP->new;
my $ring = Crypt::OpenPGP::KeyRing->new(
Filename => $pgp->{cfg}->get('SecRing')
) or die $pgp->error(Crypt::OpenPGP::KeyRing->errstr);
my $uid = '';
$uid = $AUTHOR if($AUTHOR);
my $kb;
if ($uid) {
$kb = $ring->find_keyblock_by_uid($uid)
or die $pgp->error(qq{Can't find '$uid': } . $ring->errstr);
}
else {
$kb = $ring->find_keyblock_by_index(-1)
or die $pgp->error(q{Can't find last keyblock: } . $ring->errstr);
}
my $cert = $kb->signing_key;
$uid = $cert->uid($kb->primary_uid);
warn "Debug: acquiring signature from $uid\n" if $Debug;
my $signature = $pgp->sign(
Data => $plaintext,
Detach => 0,
Clearsign => 1,
Armour => 1,
Key => $cert,
PassphraseCallback => \&Crypt::OpenPGP::_default_passphrase_cb,
) or die $pgp->errstr;
my $sigfile_fh;
lib/Module/Signature.pm view on Meta::CPAN
use Module::Signature qw(sign verify SIGNATURE_OK);
sign();
sign(overwrite => 1); # overwrites without asking
# see the CONSTANTS section below
(verify() == SIGNATURE_OK) or die "failed!";
=head1 DESCRIPTION
B<Module::Signature> adds cryptographic authentications to CPAN
distributions, via the special F<SIGNATURE> file.
If you are a module user, all you have to do is to remember to run
C<cpansign -v> (or just C<cpansign>) before issuing C<perl Makefile.PL>
or C<perl Build.PL>; that will ensure the distribution has not been
tampered with.
Module authors can easily add the F<SIGNATURE> file to the distribution
tarball; see L</NOTES> below for how to do it as part of C<make dist>.
If you I<really> want to sign a distribution manually, simply add
C<SIGNATURE> to F<MANIFEST>, then type C<cpansign -s> immediately
before C<make dist>. Be sure to delete the F<SIGNATURE> file afterwards.
Please also see L</NOTES> about F<MANIFEST.SKIP> issues, especially if
you are using B<Module::Build> or writing your own F<MANIFEST.SKIP>.
Signatures made with Module::Signature prior to version 0.82 used the
SHA1 algorithm by default. SHA1 is now considered broken, and therefore
module authors are strongly encouraged to regenerate their F<SIGNATURE>
files. Users verifying old SHA1 signature files will receive a warning.
=head1 NAME
Module::Signature - Module signature file manipulation
=head1 DEPRECATION NOTICE
B<Module::Signature> has been deprecated because it does not provide
the user with the security assurance that its usage would imply.
Module authors, who have used B<Module::Signature>, have not always
replaced their keys before they expire. Depending on a user's
configuration it can cause issues with the installation of those modules.
In addition, since it was written, the key server infrastructure has changed
and the ability to securely find keys has greatly diminished.
Module authors should remove the SIGNATURE file when they upload new versions
to PAUSE. Module users should uninstall B<Module::Signature>.
=head1 VARIABLES
No package variables are exported by default.
=over 4
=item $Verbose
If true, Module::Signature will give information during processing including
gpg output. If false, Module::Signature will be as quiet as possible as
long as everything is working ok. Defaults to false.
=item $SIGNATURE
The filename for a distribution's signature file. Defaults to
C<SIGNATURE>.
=item $AUTHOR
The key ID used for signature. If empty/null/0, C<gpg>'s configured default ID,
or the most recently added key within the secret keyring for C<Crypt::OpenPGP>,
will be used for the signature.
=item $KeyServer
The OpenPGP key server for fetching the author's public key
(currently only implemented on C<gpg>, not C<Crypt::OpenPGP>).
May be set to a false value to prevent this module from
fetching public keys.
=item $KeyServerPort
The OpenPGP key server port, defaults to C<11371>.
=item $Timeout
Maximum time to wait to try to establish a link to the key server.
Defaults to C<3>.
=item $AutoKeyRetrieve
Whether to automatically fetch unknown keys from the key server.
Defaults to C<1>.
=item $Cipher
The default cipher used by the C<Digest> module to make signature
files. Defaults to C<SHA256>, but may be changed to other ciphers
via the C<MODULE_SIGNATURE_CIPHER> environment variable if the SHA256
cipher is undesirable for the user.
The cipher specified in the F<SIGNATURE> file's first entry will
be used to validate its integrity. For C<SHA256>, the user needs
to have any one of these modules installed: B<Digest::SHA>,
B<Digest::SHA256>, or B<Digest::SHA::PurePerl>.
=item $Preamble
The explanatory text written to newly generated F<SIGNATURE> files
before the actual entries.
=back
=head1 ENVIRONMENT
B<Module::Signature> honors these environment variables:
=over 4
=item MODULE_SIGNATURE_AUTHOR
Works like C<$AUTHOR>.
=item MODULE_SIGNATURE_CIPHER
Works like C<$Cipher>.
=item MODULE_SIGNATURE_VERBOSE
Works like C<$Verbose>.
=item MODULE_SIGNATURE_KEYSERVER
Works like C<$KeyServer>.
=item MODULE_SIGNATURE_KEYSERVERPORT
( run in 0.751 second using v1.01-cache-2.11-cpan-df04353d9ac )