$Module::Signature::VERSION
=
'0.89'
;
use
5.005;
use
vars
qw($VERSION $SIGNATURE @ISA @EXPORT_OK)
;
use
vars
qw($Preamble $Cipher $Debug $Verbose $Timeout $AUTHOR)
;
use
vars
qw($KeyServer $KeyServerPort $AutoKeyRetrieve $CanKeyRetrieve)
;
use
vars
qw($LegacySigFile)
;
@EXPORT_OK
= (
qw(sign verify)
,
qw($SIGNATURE $AUTHOR $KeyServer $Cipher $Preamble)
,
(
grep
{ /^[A-Z_]+_[A-Z_]+$/ }
keys
%Module::Signature::
),
);
@ISA
=
'Exporter'
;
$AUTHOR
=
$ENV
{MODULE_SIGNATURE_AUTHOR};
$SIGNATURE
=
'SIGNATURE'
;
$Timeout
=
$ENV
{MODULE_SIGNATURE_TIMEOUT} || 3;
$Verbose
=
$ENV
{MODULE_SIGNATURE_VERBOSE} || 0;
$KeyServer
=
$ENV
{MODULE_SIGNATURE_KEYSERVER} ||
'keyserver.ubuntu.com'
;
$KeyServerPort
=
$ENV
{MODULE_SIGNATURE_KEYSERVERPORT} ||
'11371'
;
$Cipher
=
$ENV
{MODULE_SIGNATURE_CIPHER} ||
'SHA256'
;
$Preamble
= <<
"."
;
This file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version
$VERSION
.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
% cpansign -v
It will check
each
file
's integrity, as well as the signature'
s
validity. If
"==> Signature verified OK! <=="
is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.
.
$AutoKeyRetrieve
= 1;
$CanKeyRetrieve
=
undef
;
$LegacySigFile
= 0;
sub
_cipher_map {
my
(
$sigtext
) =
@_
;
my
@lines
=
split
/\015?\012/,
$sigtext
;
my
%map
;
for
my
$line
(
@lines
) {
last
if
$line
eq
'-----BEGIN PGP SIGNATURE-----'
;
next
if
$line
=~ /^---/ ..
$line
eq
''
;
my
(
$cipher
,
$digest
,
$file
) =
split
" "
,
$line
, 3;
return
unless
defined
$file
;
$map
{
$file
} = [
$cipher
,
$digest
];
}
return
\
%map
;
}
sub
verify {
my
%args
= (
skip
=>
$ENV
{TEST_SIGNATURE},
@_
);
my
$rv
;
(-r
$SIGNATURE
) or
do
{
warn
"==> MISSING Signature file! <==\n"
;
return
SIGNATURE_MISSING;
};
(
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
||
''
;
local
@INC
=
grep
{ File::Spec->file_name_is_absolute(
$_
) }
@INC
;
local
$SIGNATURE
=
$signature
if
$signature
ne
$SIGNATURE
;
if
(
$AutoKeyRetrieve
and !
$CanKeyRetrieve
) {
if
(!
defined
$CanKeyRetrieve
) {
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
);
}
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 {
return
(ExtUtils::Manifest->VERSION < 1.58);
}
sub
_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 /\
}
my
$which_gpg
;
sub
_which_gpg {
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
);
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
) =
@_
;
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);
}
sub
_read_sigfile {
my
$sigfile
=
shift
;
my
$signature
=
''
;
my
$well_formed
;
local
*D
;
open
D,
"< $sigfile"
or
die
"Could not open $sigfile: $!"
;
if
($] >= 5.006 and <D> =~ /\r/) {
close
D;
open
D,
'<'
,
$sigfile
or
die
"Could not open $sigfile: $!"
;
binmode
D,
':crlf'
;
}
else
{
close
D;
open
D,
"< $sigfile"
or
die
"Could not open $sigfile: $!"
;
}
my
$begin
=
"-----BEGIN PGP SIGNED MESSAGE-----\n"
;
my
$end
=
"-----END PGP SIGNATURE-----\n"
;
my
$found
= 0;
while
(<D>) {
if
(1 .. (
$_
eq
$begin
)) {
if
(!
$found
and /signed via the Module::Signature module, version ([0-9\.]+)\./) {
$found
= 1;
if
(
eval
{
require
version; version->parse($1) < version->parse(
"0.82"
) }) {
$LegacySigFile
= 1;
warn
"Old $SIGNATURE detected. Please inform the module author to regenerate "
.
"$SIGNATURE using Module::Signature version 0.82 or newer.\n"
;
}
}
next
;
}
$signature
.=
$_
;
return
"$begin$signature"
if
$_
eq
$end
;
}
return
;
}
sub
_compare {
my
(
$str1
,
$str2
,
$ok
) =
@_
;
$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
;
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
);
}
_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
;
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
) =
@_
;
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: $!"
;
print
D
$Preamble
;
print
D
$signature
;
close
D;
my
$server
= Crypt::OpenPGP::KeyServer->new(
Server
=>
$KeyServer
);
unless
(
$server
->find_keyblock_by_keyid(
$cert
->key_id)) {
_warn_non_public_signature(
$uid
);
}
return
1;
}
sub
_warn_non_public_signature {
my
$uid
=
shift
;
warn
<<"EOF"
You have signed this distribution with a key ($uid) that cannot be
found on the public key server at $KeyServer.
This will probably cause signature verification to fail if your module
is distributed on CPAN.
EOF
}
sub
_mkdigest {
my
$digest
= _mkdigest_files(
@_
) or
return
;
my
$plaintext
=
''
;
foreach
my
$file
(
sort
keys
%$digest
) {
next
if
$file
eq
$SIGNATURE
;
$plaintext
.=
"@{$digest->{$file}} $file\n"
;
}
return
$plaintext
;
}
sub
_digest_object {
my
(
$algorithm
) =
@_
;
local
@INC
=
grep
{ File::Spec->file_name_is_absolute(
$_
) }
@INC
;
my
(
$base
,
$variant
) = (
$algorithm
=~ /^([_a-zA-Z]+)([0-9]+)$/g)
or
die
"Malformed algorithm name: $algorithm (should match /\\w+\\d+/)"
;
my
$obj
=
eval
{ Digest->new(
$algorithm
) } ||
eval
{
require
"Digest/$base.pm"
;
"Digest::$base"
->new(
$variant
)
} ||
eval
{
require
"Digest/$algorithm.pm"
;
"Digest::$algorithm"
->new
} ||
eval
{
require
"Digest/$base/PurePerl.pm"
;
"Digest::$base\::PurePerl"
->new(
$variant
)
} ||
eval
{
require
"Digest/$algorithm/PurePerl.pm"
;
"Digest::$algorithm\::PurePerl"
->new
} or
do
{
eval
{
warn
"Unknown cipher: $algorithm, please install Digest::$base, Digest::$base$variant, or Digest::$base\::PurePerl\n"
;
} and
return
} or
do
{
warn
"Unknown cipher: $algorithm, please install Digest::$algorithm\n"
;
return
;
};
$obj
;
}
sub
_mkdigest_files {
my
$verify_map
=
shift
;
my
$dosnames
= (
defined
(
&Dos::UseLFN
) && Dos::UseLFN()==0);
my
$read
= ExtUtils::Manifest::maniread() || {};
my
$found
= ExtUtils::Manifest::manifind();
my
(
%digest
) = ();
my
(
$default_obj
) = _digest_object(
$Cipher
);
FILE:
foreach
my
$file
(
sort
keys
%$read
){
next
FILE
if
$file
eq
$SIGNATURE
;
my
(
$obj
,
$this_cipher
,
$this_hexdigest
,
$verify_digest
);
if
(
$verify_map
) {
if
(
my
$vmf
=
$verify_map
->{
$file
}) {
(
$this_cipher
,
$verify_digest
) =
@$vmf
;
if
(
$this_cipher
eq
$Cipher
) {
$obj
=
$default_obj
;
}
else
{
$obj
= _digest_object(
$this_cipher
);
}
}
else
{
$this_cipher
=
$Cipher
;
$obj
=
$default_obj
;
}
}
else
{
$this_cipher
=
$Cipher
;
$obj
=
$default_obj
;
}
warn
"Debug: collecting digest from $file\n"
if
$Debug
;
if
(
$dosnames
){
$file
=
lc
$file
;
$file
=~ s!(\.(\w|-)+)!
substr
($1,0,4)!ge;
$file
=~ s!((\w|-)+)!
substr
($1,0,8)!ge;
}
unless
(
exists
$found
->{
$file
} ) {
warn
"No such file: $file\n"
if
$Verbose
;
}
else
{
local
*F
;
open
F,
"< $file"
or
die
"Cannot open $file for reading: $!"
;
if
(
$LegacySigFile
) {
if
(-B
$file
) {
binmode
(F);
$obj
->addfile(
*F
);
$this_hexdigest
=
$obj
->hexdigest;
}
else
{
local
$/;
binmode
(F);
my
$input
= <F>;
VERIFYLOOP:
for
my
$eol
(
""
,
"\015\012"
,
"\012"
) {
my
$lax_input
=
$input
;
if
(!
length
$eol
) {
}
else
{
my
@lines
=
split
/
$eol
/,
$input
, -1;
if
(
grep
/[\015\012]/,
@lines
) {
}
else
{
my
$other_eol
=
$eol
eq
"\012"
?
"\015\012"
:
"\012"
;
$lax_input
=
join
$other_eol
,
@lines
;
}
}
$obj
->add(
$lax_input
);
$this_hexdigest
=
$obj
->hexdigest;
if
(
$verify_digest
) {
if
(
$this_hexdigest
eq
$verify_digest
) {
last
VERIFYLOOP;
}
$obj
->
reset
;
}
else
{
last
VERIFYLOOP;
}
}
}
}
else
{
binmode
(F, ((-B
$file
) ?
':raw'
:
':crlf'
));
$obj
->addfile(
*F
);
$this_hexdigest
=
$obj
->hexdigest;
}
$digest
{
$file
} = [
$this_cipher
,
$this_hexdigest
];
$obj
->
reset
;
}
}
return
\
%digest
;
}
1;