Plack-App-MCCS
view release on metacpan or search on metacpan
local/lib/perl5/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);
local/lib/perl5/Module/Signature.pm view on Meta::CPAN
next;
}
$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 {
local (*D, *S);
open S, "< $SIGNATURE" or die "Could not open $SIGNATURE: $!";
open D, "| diff -u --strip-trailing-cr $SIGNATURE -"
or (warn "Could not call diff: $!", return SIGNATURE_MISMATCH);
while (<S>) {
print D $_ if (1 .. /^-----BEGIN PGP SIGNED MESSAGE-----/);
print D if (/^Hash: / .. /^$/);
next if (1 .. /^-----BEGIN PGP SIGNATURE/);
print D $str2, "-----BEGIN PGP SIGNATURE-----\n", $_ and last;
}
print D <S>;
close D;
}
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 -t STDIN) {
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();
local *D;
my $set_key = '';
$set_key = qq{--default-key "$AUTHOR"} if($AUTHOR);
open D, "| $gpg $set_key --clearsign --openpgp --personal-digest-preferences RIPEMD160 >> $sigfile.tmp"
or die "Could not call $gpg: $!";
print D $plaintext;
close D;
(-e "$sigfile.tmp" and -s "$sigfile.tmp") or do {
unlink "$sigfile.tmp";
die "Cannot find $sigfile.tmp, signing aborted.\n";
};
open D, "< $sigfile.tmp" or die "Cannot open $sigfile.tmp: $!";
open S, "> $sigfile" or do {
unlink "$sigfile.tmp";
die "Could not write to $sigfile: $!";
};
print S $Preamble;
print S <D>;
close S;
close D;
unlink("$sigfile.tmp");
my $key_id;
my $key_name;
# This doesn't work because the output from verify goes to STDERR.
# If I try to redirect it using "--logger-fd 1" it just hangs.
# WTF?
my @verify = `$gpg --batch --verify $SIGNATURE`;
while (@verify) {
if (/key ID ([0-9A-F]+)$/) {
$key_id = $1;
} elsif (/signature from "(.+)"$/) {
$key_name = $1;
}
}
my $found_name;
my $found_key;
if (defined $key_id && defined $key_name) {
my $keyserver = _keyserver($version);
while (`$gpg --batch --keyserver=$keyserver --search-keys '$key_name'`) {
if (/^\(\d+\)/) {
$found_name = 0;
} elsif ($found_name) {
if (/key \Q$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;
local *D;
open D, "> $sigfile" or die "Could not write to $sigfile: $!";
local/lib/perl5/Module/Signature.pm view on Meta::CPAN
=head1 SYNOPSIS
As a shell command:
% cpansign # verify an existing SIGNATURE, or
# make a new one if none exists
% cpansign sign # make signature; overwrites existing one
% cpansign -s # same thing
% cpansign verify # verify a signature
% cpansign -v # same thing
% cpansign -v --skip # ignore files in MANIFEST.SKIP
% cpansign help # display this documentation
% cpansign -h # same thing
In programs:
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 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.753 second using v1.01-cache-2.11-cpan-df04353d9ac )