summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSalvatore Bonaccorso <salvatore.bonaccorso@gmail.com>2010-06-07 08:40:45 +0000
committerSalvatore Bonaccorso <salvatore.bonaccorso@gmail.com>2010-06-07 08:40:45 +0000
commitd9e2f7d17462e6ccaa405881e64a84a6b8e601e5 (patch)
tree99b8b66c46fbc1f96319e84f543fed62e2a2123d
parent01170f24502ec2597e8800b5567a69d8550ca5fc (diff)
[svn-upgrade] new version libgnupg-interface-perl (0.42.002)
-rw-r--r--ChangeLog35
-rw-r--r--MANIFEST12
-rw-r--r--MANIFEST.SKIP2
-rw-r--r--META.yml4
-rw-r--r--SIGNATURE76
-rw-r--r--inc/Module/Install.pm183
-rw-r--r--inc/Module/Install/Base.pm2
-rw-r--r--inc/Module/Install/Can.pm2
-rw-r--r--inc/Module/Install/Fetch.pm2
-rw-r--r--inc/Module/Install/Makefile.pm189
-rw-r--r--inc/Module/Install/Metadata.pm168
-rw-r--r--inc/Module/Install/Win32.pm2
-rw-r--r--inc/Module/Install/WriteAll.pm7
-rw-r--r--lib/GnuPG/Fingerprint.pm11
-rw-r--r--lib/GnuPG/Interface.pm185
-rw-r--r--lib/GnuPG/Key.pm158
-rw-r--r--lib/GnuPG/Options.pm6
-rw-r--r--lib/GnuPG/PrimaryKey.pm44
-rw-r--r--lib/GnuPG/PublicKey.pm2
-rw-r--r--lib/GnuPG/Revoker.pm158
-rw-r--r--lib/GnuPG/Signature.pm94
-rw-r--r--lib/GnuPG/SubKey.pm31
-rw-r--r--lib/GnuPG/UserAttribute.pm119
-rw-r--r--lib/GnuPG/UserId.pm50
-rw-r--r--t/GnuPG/ComparableFingerprint.pm29
-rw-r--r--t/GnuPG/ComparableKey.pm57
-rw-r--r--t/GnuPG/ComparablePrimaryKey.pm52
-rw-r--r--t/GnuPG/ComparablePublicKey.pm22
-rw-r--r--t/GnuPG/ComparableSecretKey.pm22
-rw-r--r--t/GnuPG/ComparableSignature.pm41
-rw-r--r--t/GnuPG/ComparableSubKey.pm54
-rw-r--r--t/GnuPG/ComparableUserId.pm57
-rw-r--r--t/get_public_keys.t148
-rw-r--r--t/get_secret_keys.t21
-rwxr-xr-xtest/public-keys-sigs/1.out1
-rwxr-xr-xtest/public-keys-sigs/2.out1
-rw-r--r--test/pubring.gpgbin3315 -> 3418 bytes
-rwxr-xr-xtest/random_seedbin600 -> 0 bytes
-rw-r--r--test/secring.gpgbin1138 -> 1241 bytes
-rwxr-xr-xtest/trustdb.gpgbin1200 -> 0 bytes
40 files changed, 1409 insertions, 638 deletions
diff --git a/ChangeLog b/ChangeLog
index 46722fe..1addf00 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,38 @@
+0.42_02
+ Additional cleanups from dkg
+
+0.42_01 Mon May 10 10:50:49 EDT 2010
+ GnuPG::Revoker: improve docs, compare() should fail if the signature counts differ - dkg
+ Handle revoker packets (rvk) - dkg
+ Move compare() into GnuPG::Signature, got rid of t/GnuPG/ComparableSignature.pm - dkg
+ Move signature comparison into ComparableKey.pm instead of ComparableSubKey.pm - dkg
+ Move fingerprint comparison directly into GnuPG::Fingerprint - dkg
+ Change around some variable names for consistency's sake:
+ $current_key becomes $current_primary_key
+ $current_fingerprinted_key becomes $current_key -dkg
+ Fixed synopsis example in GnuPG::Signature pod - dkg
+ Allow for primary key to have per-key (useful for signatures of class 0x1f, see http://tools.ietf.org/html/rfc4880#section-5.2.1) - dkg
+ Add revocations to keys and user ids and user attributes - dkg
+ Add signature class and exportability to GnuPG::Signature - dkg
+ Introduced GnuPG::UserAttribute to handle uat packets - dkg
+ Actually check validity of signatures and report them - dkg
+ Support more than 1 signature over each subkey - dkg
+ Do not bother shipping test/random_seed - dkg
+ Fix copy method of GnuPG::Options.
+ The result of not checking for definedness here is to never copy the
+ meta_immutable value successfully (as that is true by default). This led
+ to a FTBFS (failure to build from source) when running non-interactively.
+
+ See also: http://bugs.debian.org/549743 - Tim Retout
+ Expose signature expiration times - dkg
+ Take advantage of --fixed-list-mode and report timestamps at 1Hz precision instead of daily precision - dkg
+ Always use --fixed-list-mode for consistency and better granularity of data - dkg
+ Unescape strings to handle User IDs with colons in them - dkg
+ Add usage_flags to keys - dkg
+ Several doc patches from Daniel Kahn Gillmor
+ Fix for documented typos reported by SYSMON Fixes rt.cpan.org#50377 - jesse
+ Fix POD errors - alexmv
+
0.42 Wed Sep 30 23:20:58 JST 2009
* Support for GPG2
diff --git a/MANIFEST b/MANIFEST
index e461ac1..14a2164 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -16,9 +16,11 @@ lib/GnuPG/Key.pm
lib/GnuPG/Options.pm
lib/GnuPG/PrimaryKey.pm
lib/GnuPG/PublicKey.pm
+lib/GnuPG/Revoker.pm
lib/GnuPG/SecretKey.pm
lib/GnuPG/Signature.pm
lib/GnuPG/SubKey.pm
+lib/GnuPG/UserAttribute.pm
lib/GnuPG/UserId.pm
Makefile.PL
MANIFEST This list of files
@@ -36,14 +38,6 @@ t/export_keys.t
t/Fingerprint.t
t/get_public_keys.t
t/get_secret_keys.t
-t/GnuPG/ComparableFingerprint.pm
-t/GnuPG/ComparableKey.pm
-t/GnuPG/ComparablePrimaryKey.pm
-t/GnuPG/ComparablePublicKey.pm
-t/GnuPG/ComparableSecretKey.pm
-t/GnuPG/ComparableSignature.pm
-t/GnuPG/ComparableSubKey.pm
-t/GnuPG/ComparableUserId.pm
t/import_keys.t
t/Interface.t
t/list_public_keys.t
@@ -75,7 +69,6 @@ test/public-keys/2.0.test
test/public-keys/2.1.test
test/public-keys/2.out
test/pubring.gpg
-test/random_seed
test/secret-keys/1.0.test
test/secret-keys/1.out
test/secret-keys/2.0.test
@@ -83,5 +76,4 @@ test/secret-keys/2.out
test/secring.gpg
test/signed.1.asc
test/temp
-test/trustdb.gpg
THANKS
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index ae36ac8..c4c77e7 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -10,3 +10,5 @@ pm_to_blib
.git/
.gitignore$
.shipit$
+test/random_seed$
+test/trustdb.gpg$
diff --git a/META.yml b/META.yml
index 455d341..f81aa65 100644
--- a/META.yml
+++ b/META.yml
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
+generated_by: 'Module::Install version 0.95'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -22,4 +22,4 @@ requires:
Any::Moose: 0.04
resources:
license: http://dev.perl.org/licenses/
-version: 0.42
+version: 0.42_02
diff --git a/SIGNATURE b/SIGNATURE
index 76ec205..766194c 100644
--- a/SIGNATURE
+++ b/SIGNATURE
@@ -1,5 +1,5 @@
This file contains message digests of all files listed in MANIFEST,
-signed via the Module::Signature module, version 0.55.
+signed via the Module::Signature module, version 0.63.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -15,43 +15,37 @@ not run its Makefile.PL or Build.PL.
Hash: SHA1
SHA1 187c2cfc1fc31d42c18d5b1653afa1a905bf266c COPYING
-SHA1 f251a3e5177b2672258b376fba43d30a9b7e84a7 ChangeLog
-SHA1 ed3a5d8cb2a7931578c48e84ad2a1191ec30c1e1 MANIFEST
-SHA1 13bf6b4540170c65244363d8b24b041180d66765 MANIFEST.SKIP
-SHA1 dcd64a562d9e46b041d268ec3853de54273ed8a3 META.yml
+SHA1 c345f9365ecc17136b8dcb98de52885176961027 ChangeLog
+SHA1 37e4d07c43f08f41a24fd1157ab530a4a06aab37 MANIFEST
+SHA1 0c5f7bda8a3ce57e27dcd7f32459d8b286f1339e MANIFEST.SKIP
+SHA1 102a7f79158371dd6b398493c86b8d6ab69ce508 META.yml
SHA1 92f709ea03b0b69509ad258553c82905b533d610 Makefile.PL
SHA1 d6e32c5128419cdbfe6e6f846ff7f64fc0adac2f NEWS
SHA1 1047dc54823b1321e939274dd261d8e40febee24 README
SHA1 df07bf5a2dd74ffe4b69dff3063f68879cf9e355 THANKS
-SHA1 fd5f3c4f0418efee3b9b16cf8c3902e8374909df inc/Module/Install.pm
-SHA1 7cd7c349afdf3f012e475507b1017bdfa796bfbd inc/Module/Install/Base.pm
-SHA1 ba186541bbf6439111f01fc70769cf24d22869bf inc/Module/Install/Can.pm
-SHA1 aaa50eca0d7751db7a4d953fac9bc72c6294e238 inc/Module/Install/Fetch.pm
-SHA1 3e83972921d54198d1246f7278f08664006cd65d inc/Module/Install/Makefile.pm
-SHA1 12bf1867955480d47d5171a9e9c6a96fabe0b58f inc/Module/Install/Metadata.pm
-SHA1 f7ee667e878bd2faf22ee9358a7b5a2cc8e91ba4 inc/Module/Install/Win32.pm
-SHA1 8ed29d6cf217e0977469575d788599cbfb53a5ca inc/Module/Install/WriteAll.pm
-SHA1 ab92e0f4a0cb79eeead245e792fa02baccafb4fe lib/GnuPG/Fingerprint.pm
+SHA1 1ebec4119486a032a5612a403e8d7b7be973e938 inc/Module/Install.pm
+SHA1 24038af925a69df41972971356ccce885b0fe2ad inc/Module/Install/Base.pm
+SHA1 8f96eddfef548c9328457fbb17a121631cda356b inc/Module/Install/Can.pm
+SHA1 ec29048e48edd9c9c55f9de7b773bd7c904335ad inc/Module/Install/Fetch.pm
+SHA1 0384525d85d51e99532e3ad8729d870113646d14 inc/Module/Install/Makefile.pm
+SHA1 38c657de4d91f5a60ff8e6c6f6a5547daf7c4ab2 inc/Module/Install/Metadata.pm
+SHA1 5c25f1104c0038041e3b93e0660c39171e4caf2b inc/Module/Install/Win32.pm
+SHA1 94d47349c803c4bd2a9230d25e4db0b6aaf1acd8 inc/Module/Install/WriteAll.pm
+SHA1 9a2b6c9e5434daf32bc2a3e15e25175fc49fd604 lib/GnuPG/Fingerprint.pm
SHA1 8852195e80823c93b6aed673e69433ae3ea46d26 lib/GnuPG/Handles.pm
SHA1 779e6a921fa104e8f16fd4a6d38f670074592811 lib/GnuPG/HashInit.pm
-SHA1 745384e607761a4eb3b758c330fd7c62148db066 lib/GnuPG/Interface.pm
-SHA1 2a0ccd5ef55b4f6dec5f7464c86e989674623ef1 lib/GnuPG/Key.pm
-SHA1 f233f9b250b603c5f1f056c85b5f034b3e4e1ef9 lib/GnuPG/Options.pm
-SHA1 f6cdea5f09b944e81a66a1f554db60c1b536d1d2 lib/GnuPG/PrimaryKey.pm
-SHA1 4473eeb91061fa09c2fe779ed2fb5c84bd7b4c05 lib/GnuPG/PublicKey.pm
+SHA1 6b2aa225b376440d97e2b8c205c3c7ce450ef1f3 lib/GnuPG/Interface.pm
+SHA1 bb75d45acb8268096348740e261812519b7258cb lib/GnuPG/Key.pm
+SHA1 697b1408b404e4dff0ae553646fb3c12f821fcd4 lib/GnuPG/Options.pm
+SHA1 5fbf442fc1586b88139508b838700b7a3992ced7 lib/GnuPG/PrimaryKey.pm
+SHA1 1cf3880965f6a600af7713252b42c624b748c493 lib/GnuPG/PublicKey.pm
+SHA1 1b0323f31492f4564b5983b8d7f1e99f8a794d6f lib/GnuPG/Revoker.pm
SHA1 1aa4521f22337b6a8d8c7980a97ea9f692528038 lib/GnuPG/SecretKey.pm
-SHA1 5e4721c2ba905a3e2e1583a540b72e0ffb5cd5e8 lib/GnuPG/Signature.pm
-SHA1 1cd30e5f429d1dbfb4b36ef3b3ab35013ca0a101 lib/GnuPG/SubKey.pm
-SHA1 298a897d30956e74a374f4e7d790680798811bf6 lib/GnuPG/UserId.pm
+SHA1 b7777eef0e5517d58f04ec06c942df24eca1724a lib/GnuPG/Signature.pm
+SHA1 91edc51255f9bf5882af027c0489d76f11894f4c lib/GnuPG/SubKey.pm
+SHA1 6d70018973ec4fd4b224b2eb7bf77b2b007f72b2 lib/GnuPG/UserAttribute.pm
+SHA1 145730a6ccc5d543a65ee25411bb6d8119dc8fce lib/GnuPG/UserId.pm
SHA1 367fdb308292a9c005afffef49ff9096a20a4da3 t/Fingerprint.t
-SHA1 501ac69701ce51b3dd98f7f82a3c19a4fba6c3bd t/GnuPG/ComparableFingerprint.pm
-SHA1 ac3e4f640c0b7ffc2e6cc1a9d08546927614a456 t/GnuPG/ComparableKey.pm
-SHA1 e6902641f0e3300f8ecebb6c0ce07c47cb8978a9 t/GnuPG/ComparablePrimaryKey.pm
-SHA1 bc0131cf790f60fe21de67435516a78a18e5694c t/GnuPG/ComparablePublicKey.pm
-SHA1 ecee8534433307382b885eb19d0c6a74f0896e9b t/GnuPG/ComparableSecretKey.pm
-SHA1 7c0828fc937021847b5f1e857c4dd086169ceb72 t/GnuPG/ComparableSignature.pm
-SHA1 11224faf53b09044aa119fe40c09553a3bf4a091 t/GnuPG/ComparableSubKey.pm
-SHA1 69961a5efc193745729505e317db48cccd728cf0 t/GnuPG/ComparableUserId.pm
SHA1 8791d014e4efd4cf11998386e1651cc4eb16dd26 t/Interface.t
SHA1 698ec633be083b7e762331f1a5106c1618c74dd3 t/MyTest.pm
SHA1 52114a082f32bdbf284eb968afe458866854996e t/MyTestSpecific.pm
@@ -62,8 +56,8 @@ SHA1 67364d69fda2826735c8e39d50ea81a80d529a6c t/detach_sign.t
SHA1 54d40d0d5233ad3097c5ca79032f38171334c7a4 t/encrypt.t
SHA1 eeb2c355817cf641ad9e90e90f01007efce29cbe t/encrypt_symmetrically.t
SHA1 a95b669219675ac2fadc8b5d3c49dcfd69609fe2 t/export_keys.t
-SHA1 f57e6d8b32fe81419244d3f38f5d9843ff0927c2 t/get_public_keys.t
-SHA1 43a2e400a6e38e7b64581d6863629de00e2752d9 t/get_secret_keys.t
+SHA1 889e4ea15ae0ddd169f03ee03307ece5f0debbe7 t/get_public_keys.t
+SHA1 fdca3db7bb332108d5a9011cb0f2c61f123c04fa t/get_secret_keys.t
SHA1 a0f7dfa3778defadaf3600a7cfd69bfd027fdad2 t/import_keys.t
SHA1 3355815cd188313a39116a661669ff92cebd701f t/list_public_keys.t
SHA1 2ccb69c8a216e7f6db9faa2d6127561aeaa8130c t/list_secret_keys.t
@@ -80,30 +74,28 @@ SHA1 4e1243bd22c66e76c2ba9eddc1f91394e57f9f83 test/passphrase
SHA1 59c0e6436b38645144d17ce11ac4aabfdd43e960 test/plain.1.txt
SHA1 7d94ea032bdbb0104c1dc73583ec64ade6294495 test/public-keys-sigs/1.0.test
SHA1 63d93054decf9ff6c2dc99eb03f131b55af4ee43 test/public-keys-sigs/1.1.test
-SHA1 f131ed203b88c35d78bf420b4739bd60fe9fa319 test/public-keys-sigs/1.out
+SHA1 a007df3963780784b12a31408bf7972c9686220f test/public-keys-sigs/1.out
SHA1 bd9892a93f802c68109b11b756f79f6b0292eb1a test/public-keys-sigs/2.0.test
SHA1 73d90696020a01753cda984262a2831dcc6ac0d7 test/public-keys-sigs/2.1.test
-SHA1 1537de3e2bccfb57b4c515fd6532cdbe9313096f test/public-keys-sigs/2.out
+SHA1 343df38fd93847e5646f84679fe50e277b0a12c5 test/public-keys-sigs/2.out
SHA1 82d483adc6d203c79856a70dd259370f6efdeef7 test/public-keys/1.0.test
SHA1 86056ad37b8bb67d55ac61b5d5a27ac4bbd1cceb test/public-keys/1.1.test
SHA1 18365fae169164b18e855861e74fa2a84031b53b test/public-keys/1.out
SHA1 a8e97a2439671dae0dd29a2404c321ccb686ba7a test/public-keys/2.0.test
SHA1 54d2c13bf3b73b7582edef091175dfe3763ddf59 test/public-keys/2.1.test
SHA1 18365fae169164b18e855861e74fa2a84031b53b test/public-keys/2.out
-SHA1 5fa3777416ba09b8a396113dce6ddbf6a73b4b74 test/pubring.gpg
-SHA1 734cbb6b69ba568151863cadcf5f50d2a410381a test/random_seed
+SHA1 4349906c08f65af3b13e7b441ac4dd2e637bfeae test/pubring.gpg
SHA1 e740841597775e3da265ec14e411ed0432bae5e2 test/secret-keys/1.0.test
SHA1 e740841597775e3da265ec14e411ed0432bae5e2 test/secret-keys/1.out
SHA1 3bd6135279f9ae23e32680707c6170910421e5de test/secret-keys/2.0.test
SHA1 d15fbde50ae625d033b9cb903a03596fe3cb7e2e test/secret-keys/2.out
-SHA1 4ae7541bb82abaef5573e61582c4dd4f96cc7f63 test/secring.gpg
+SHA1 9ce5508cd8cefadc4c9bf2842864b52e87b1826e test/secring.gpg
SHA1 981418a80bf7dab91b63608cfd1ddf5091f89ad7 test/signed.1.asc
SHA1 da39a3ee5e6b4b0d3255bfef95601890afd80709 test/temp
-SHA1 191d91c4fe445c5f2906468b90b95d288ea3b8c0 test/trustdb.gpg
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.9 (GNU/Linux)
+Version: GnuPG v1.4.10 (GNU/Linux)
-iEYEARECAAYFAkrDaVkACgkQEi9d9xCOQEaeSQCffdJ//p1WCHBl7VniJFbaktWN
-7TUAn2JGaeQBA3NLP6XqBeJdkLyFruA6
-=4iUK
+iEYEARECAAYFAkwK1YoACgkQEi9d9xCOQEZzAgCgzA6wvNJepwZz3GPjWwvMl+qz
+KOcAoJFkxAbN/T6n3VyNbscHwCUOOWJk
+=6wiz
-----END PGP SIGNATURE-----
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 51eda5d..bc055a9 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -19,6 +19,10 @@ package Module::Install;
use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+use FindBin;
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -28,7 +32,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.91';
+ $VERSION = '0.95';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -38,18 +42,25 @@ BEGIN {
}
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
@@ -61,26 +72,28 @@ not:
END_DIE
-
-
-
-
-# If the script that is loading Module::Install is from the future,
-# then make will detect this and cause it to re-run over and over
-# again. This is bad. Rather than taking action to touch it (which
-# is unreliable on some platforms and requires write permissions)
-# for now we should catch this and refuse to run.
-if ( -f $0 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # If the script that is loading Module::Install is from the future,
+ # then make will detect this and cause it to re-run over and over
+ # again. This is bad. Rather than taking action to touch it (which
+ # is unreliable on some platforms and requires write permissions)
+ # for now we should catch this and refuse to run.
+ if ( -f $0 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
@@ -89,15 +102,12 @@ This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
-}
-
-
-
+ }
-# Build.PL was formerly supported, but no longer is due to excessive
-# difficulty in implementing every single feature twice.
-if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
+ # Build.PL was formerly supported, but no longer is due to excessive
+ # difficulty in implementing every single feature twice.
+ if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
@@ -107,23 +117,36 @@ Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
+ #-------------------------------------------------------------
+ # To save some more typing in Module::Install installers, every...
+ # use inc::Module::Install
+ # ...also acts as an implicit use strict.
+ $^H |= strict::bits(qw(refs subs vars));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ require "$self->{path}/$self->{dispatch}.pm";
+ File::Path::mkpath("$self->{prefix}/$self->{author}");
+ $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
+ $self->{admin}->init;
+ @_ = ($class, _self => $self);
+ goto &{"$self->{name}::import"};
+ }
-# To save some more typing in Module::Install installers, every...
-# use inc::Module::Install
-# ...also acts as an implicit use strict.
-$^H |= strict::bits(qw(refs subs vars));
-
-
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{"$self->{file}"};
+ delete $INC{"$self->{path}.pm"};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -152,33 +175,6 @@ sub autoload {
};
}
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
-
- unless ( -f $self->{file} ) {
- require "$self->{path}/$self->{dispatch}.pm";
- File::Path::mkpath("$self->{prefix}/$self->{author}");
- $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
- $self->{admin}->init;
- @_ = ($class, _self => $self);
- goto &{"$self->{name}::import"};
- }
-
- *{"${who}::AUTOLOAD"} = $self->autoload;
- $self->preload;
-
- # Unregister loader and worker packages so subdirs can use them again
- delete $INC{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
@@ -348,17 +344,24 @@ sub _caller {
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _read {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '<', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "< $_[0]" ) or die "open($_[0]): $!";
- }
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
return $string;
}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
sub _readperl {
my $string = Module::Install::_read($_[0]);
@@ -379,18 +382,26 @@ sub _readpod {
return $string;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
sub _write {
local *FH;
- if ( $] >= 5.006 ) {
- open( FH, '>', $_[0] ) or die "open($_[0]): $!";
- } else {
- open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
}
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) {
print FH $_[$_] or die "print($_[0]): $!";
}
close FH or die "close($_[0]): $!";
}
+END_OLD
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
@@ -427,4 +438,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2009 Adam Kennedy.
+# Copyright 2008 - 2010 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 60a74d2..4224c4d 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index e65e4f6..c9f91d1 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 05f2079..c728bcd 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 98779db..431ec3f 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -7,7 +7,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -25,8 +25,8 @@ sub prompt {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -34,21 +34,110 @@ sub prompt {
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -107,6 +196,9 @@ sub tests_recursive {
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
+ if ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ File::Find::find( \&_wanted_t, 'xt' );
+ }
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
@@ -130,12 +222,13 @@ sub write {
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
- $self->build_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
+ $self->build_requires( 'ExtUtils::MakeMaker' => $v );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
$self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
}
@@ -143,59 +236,103 @@ sub write {
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ $DB::single = 1;
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
- # Merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
+ ($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
- # merge both kinds of requires into prereq_pm
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ delete $build_prereq->{$file}; #Delete from build prereqs only
}
}
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
- $args->{INSTALLDIRS} = $self->installdirs;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
+ if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
@@ -265,4 +402,4 @@ sub postamble {
__END__
-#line 394
+#line 531
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 653193d..162bde0 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
my @array_keys = qw{
keywords
+ author
};
+*authors = \&author;
+
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
@@ -230,6 +232,8 @@ sub all_from {
die("The path '$file' does not exist, or is not a file");
}
+ $self->{values}{all_from} = $file;
+
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
@@ -240,7 +244,7 @@ sub all_from {
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
+ $self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -385,11 +389,10 @@ sub name_from {
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -398,6 +401,16 @@ sub perl_version_from {
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -417,59 +430,116 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
-sub license_from {
- my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language) itself' => 'perl', 1,
- 'GNU general public license' => 'gpl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser general public license' => 'lgpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'GNU library general public license' => 'lgpl', 1,
- 'GNU library public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- $self->license($license);
- return 1;
- }
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:licen[cs]e|licensing)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /ixms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:copyrights?|legal)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /ixms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
+ 'under the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
}
}
+}
- warn "Cannot determine license info from $_[0]\n";
- return 'unknown';
+sub license_from {
+ my $self = shift;
+ if (my $license=_extract_license(Module::Install::_read($_[0]))) {
+ $self->license($license);
+ } else {
+ warn "Cannot determine license info from $_[0]\n";
+ return 'unknown';
+ }
}
sub _extract_bugtracker {
- my @links = $_[0] =~ m#L<(\Qhttp://rt.cpan.org/\E[^>]+)>#g;
+ my @links = $_[0] =~ m#L<(
+ \Qhttp://rt.cpan.org/\E[^>]+|
+ \Qhttp://github.com/\E[\w_]+/[\w_]+/issues|
+ \Qhttp://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
my %links;
@links{@links}=();
@links=keys %links;
@@ -485,7 +555,7 @@ sub bugtracker_from {
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index f2f99df..f55e166 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '0.95';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 12471e5..6b3bba7 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';;
+ $VERSION = '0.95';;
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -26,7 +26,10 @@ sub WriteAll {
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
diff --git a/lib/GnuPG/Fingerprint.pm b/lib/GnuPG/Fingerprint.pm
index 1335d30..871e02a 100644
--- a/lib/GnuPG/Fingerprint.pm
+++ b/lib/GnuPG/Fingerprint.pm
@@ -22,6 +22,12 @@ has as_hex_string => (
is => 'rw',
);
+sub compare {
+ my ($self, $other) = @_;
+ return 0 unless $other->isa('GnuPG::Fingerprint');
+ return $self->as_hex_string() eq $other->as_hex_string();
+}
+
# DEPRECATED
sub hex_data
{
@@ -63,6 +69,11 @@ initialization of data members.
=item hash_init( I<%args> ).
+=item compare( I<$other> )
+
+Returns non-zero only when this fingerprint is identical to the other
+GnuPG::Fingerprint.
+
=back
=head1 OBJECT DATA MEMBERS
diff --git a/lib/GnuPG/Interface.pm b/lib/GnuPG/Interface.pm
index 15588b4..01dbe92 100644
--- a/lib/GnuPG/Interface.pm
+++ b/lib/GnuPG/Interface.pm
@@ -23,10 +23,11 @@ use Fatal qw( open close pipe fcntl );
use Class::Struct;
use IO::Handle;
+use Math::BigInt try => 'GMP';
use GnuPG::Options;
use GnuPG::Handles;
-$VERSION = '0.42';
+$VERSION = '0.42_02';
has $_ => (
isa => 'Any',
@@ -335,6 +336,11 @@ sub my_fileno {
}
+sub unescape_string {
+ my($str) = splice(@_);
+ $str =~ s/\\x(..)/chr(hex($1))/eg;
+ return $str;
+}
###################################################################
@@ -360,7 +366,7 @@ sub get_public_keys_with_sigs ( $@ ) {
my ( $self, @key_ids ) = @_;
return $self->get_keys(
- commands => ['--list-sigs'],
+ commands => ['--check-sigs'],
command_args => [@key_ids],
);
}
@@ -373,8 +379,10 @@ sub get_keys {
$self->options($new_options);
$self->options->push_extra_args(
'--with-colons',
+ '--fixed-list-mode',
'--with-fingerprint',
'--with-fingerprint',
+ '--with-key-data',
);
my $stdin = IO::Handle->new();
@@ -391,16 +399,18 @@ sub get_keys {
);
my @returned_keys;
- my $current_key;
+ my $current_primary_key;
my $current_signed_item;
- my $current_fingerprinted_key;
+ my $current_key;
require GnuPG::PublicKey;
require GnuPG::SecretKey;
require GnuPG::SubKey;
require GnuPG::Fingerprint;
require GnuPG::UserId;
+ require GnuPG::UserAttribute;
require GnuPG::Signature;
+ require GnuPG::Revoker;
while (<$stdout>) {
my $line = $_;
@@ -411,70 +421,102 @@ sub get_keys {
my $record_type = $fields[0];
if ( $record_type eq 'pub' or $record_type eq 'sec' ) {
- push @returned_keys, $current_key
- if $current_key;
+ push @returned_keys, $current_primary_key
+ if $current_primary_key;
my (
$user_id_validity, $key_length, $algo_num, $hex_key_id,
- $creation_date_string, $expiration_date_string,
- $local_id, $owner_trust, $user_id_string
+ $creation_date, $expiration_date,
+ $local_id, $owner_trust, $user_id_string,
+ $sigclass, #unused
+ $usage_flags,
) = @fields[ 1 .. $#fields ];
+ # --fixed-list-mode uses epoch time for creation and expiration date strings.
+ # For backward compatibility, we convert them back using GMT;
+ my $expiration_date_string;
+ if ($expiration_date eq '') {
+ $expiration_date = undef;
+ } else {
+ $expiration_date_string = $self->_downrez_date($expiration_date);
+ }
+ my $creation_date_string = $self->_downrez_date($creation_date);
- # GnuPg 2.x uses epoch time for creation and expiration date strings.
- # For backward compatibility, we convert them back using GMT;
- $creation_date_string = $self->_downrez_gpg2_date($creation_date_string);
- $expiration_date_string = $self->_downrez_gpg2_date($expiration_date_string);
-
- $current_key = $current_fingerprinted_key
+ $current_primary_key = $current_key
= $record_type eq 'pub'
? GnuPG::PublicKey->new()
: GnuPG::SecretKey->new();
- $current_key->hash_init(
+ $current_primary_key->hash_init(
length => $key_length,
algo_num => $algo_num,
hex_id => $hex_key_id,
local_id => $local_id,
owner_trust => $owner_trust,
+ creation_date => $creation_date,
+ expiration_date => $expiration_date,
creation_date_string => $creation_date_string,
expiration_date_string => $expiration_date_string,
+ usage_flags => $usage_flags,
);
- $current_signed_item = GnuPG::UserId->new(
- validity => $user_id_validity,
- as_string => $user_id_string,
- );
-
- $current_key->push_user_ids($current_signed_item);
+ $current_signed_item = $current_primary_key;
}
elsif ( $record_type eq 'fpr' ) {
my $hex = $fields[9];
my $f = GnuPG::Fingerprint->new( as_hex_string => $hex );
- $current_fingerprinted_key->fingerprint($f);
+ $current_key->fingerprint($f);
}
- elsif ( $record_type eq 'sig' ) {
+ elsif ( $record_type eq 'sig' or
+ $record_type eq 'rev'
+ ) {
my (
+ $validity,
$algo_num, $hex_key_id,
- $signature_date_string, $user_id_string
- ) = @fields[ 3 .. 5, 9 ];
+ $signature_date,
+ $expiration_date,
+ $user_id_string,
+ $sig_type,
+ ) = @fields[ 1, 3 .. 6, 9, 10 ];
+
+ my $expiration_date_string;
+ if ($expiration_date eq '') {
+ $expiration_date = undef;
+ } else {
+ $expiration_date_string = $self->_downrez_date($expiration_date);
+ }
+ my $signature_date_string = $self->_downrez_date($signature_date);
+
+ my ($sig_class, $is_exportable);
+ if ($sig_type =~ /^([[:xdigit:]]{2})([xl])$/ ) {
+ $sig_class = hex($1);
+ $is_exportable = ('x' eq $2);
+ }
- $signature_date_string = $self->_downrez_gpg2_date($signature_date_string);
my $signature = GnuPG::Signature->new(
+ validity => $validity,
algo_num => $algo_num,
hex_id => $hex_key_id,
+ date => $signature_date,
date_string => $signature_date_string,
- user_id_string => $user_id_string,
+ expiration_date => $expiration_date,
+ expiration_date_string => $expiration_date_string,
+ user_id_string => unescape_string($user_id_string),
+ sig_class => $sig_class,
+ is_exportable => $is_exportable,
);
- if ( $current_signed_item->isa('GnuPG::UserId') ) {
+ if ( $current_signed_item->isa('GnuPG::Key') ||
+ $current_signed_item->isa('GnuPG::UserId') ||
+ $current_signed_item->isa('GnuPG::Revoker') ||
+ $current_signed_item->isa('GnuPG::UserAttribute')) {
+ if ($record_type eq 'sig') {
$current_signed_item->push_signatures($signature);
- }
- elsif ( $current_signed_item->isa('GnuPG::SubKey') ) {
- $current_signed_item->signature($signature);
- }
- else {
- warn "do not know how to handle signature line: $line\n";
+ } elsif ($record_type eq 'rev') {
+ $current_signed_item->push_revocations($signature);
+ }
+ } else {
+ warn "do not know how to handle signature line: $line\n";
}
}
elsif ( $record_type eq 'uid' ) {
@@ -482,32 +524,73 @@ sub get_keys {
$current_signed_item = GnuPG::UserId->new(
validity => $validity,
- as_string => $user_id_string,
+ as_string => unescape_string($user_id_string),
+ );
+
+ $current_primary_key->push_user_ids($current_signed_item);
+ }
+ elsif ( $record_type eq 'uat' ) {
+ my ( $validity, $subpacket ) = @fields[ 1, 9 ];
+
+ my ( $subpacket_count, $subpacket_total_size ) = split(/ /,$subpacket);
+
+ $current_signed_item = GnuPG::UserAttribute->new(
+ validity => $validity,
+ subpacket_count => $subpacket_count,
+ subpacket_total_size => $subpacket_total_size,
);
- $current_key->push_user_ids($current_signed_item);
+ $current_primary_key->push_user_attributes($current_signed_item);
}
elsif ( $record_type eq 'sub' or $record_type eq 'ssb' ) {
my (
$validity, $key_length, $algo_num, $hex_id,
- $creation_date_string, $expiration_date_string,
- $local_id
- ) = @fields[ 1 .. 7 ];
+ $creation_date, $expiration_date,
+ $local_id,
+ $dummy0, $dummy1, $dummy2, #unused
+ $usage_flags,
+ ) = @fields[ 1 .. 11 ];
+
+ my $expiration_date_string;
+ if ($expiration_date eq '') {
+ $expiration_date = undef;
+ } else {
+ $expiration_date_string = $self->_downrez_date($expiration_date);
+ }
+ my $creation_date_string = $self->_downrez_date($creation_date);
- $creation_date_string = $self->_downrez_gpg2_date($creation_date_string);
- $expiration_date_string = $self->_downrez_gpg2_date($expiration_date_string);
- $current_signed_item = $current_fingerprinted_key
+ $current_signed_item = $current_key
= GnuPG::SubKey->new(
validity => $validity,
length => $key_length,
algo_num => $algo_num,
hex_id => $hex_id,
+ creation_date => $creation_date,
+ expiration_date => $expiration_date,
creation_date_string => $creation_date_string,
expiration_date_string => $expiration_date_string,
local_id => $local_id,
+ usage_flags => $usage_flags,
);
- $current_key->push_subkeys($current_signed_item);
+ $current_primary_key->push_subkeys($current_signed_item);
+ }
+ elsif ($record_type eq 'rvk') {
+ my ($algo_num, $fpr, $class) = @fields[ 3,9,10 ];
+ my $rvk = GnuPG::Revoker->new(
+ fingerprint => GnuPG::Fingerprint->new( as_hex_string => $fpr ),
+ algo_num => ($algo_num + 0),
+ class => hex($class),
+ );
+ # pushing to either primary key or subkey, to handle
+ # designated revokers to the subkeys too:
+ $current_key->push_revokers($rvk);
+ # revokers should be bound to the key with signatures:
+ $current_signed_item = $rvk;
+ }
+ elsif ($record_type eq 'pkd') {
+ my ($pos, $size, $data) = @fields[ 1,2,3 ];
+ $current_key->pubkey_data->[$pos+0] = Math::BigInt->from_hex('0x'.$data);
}
elsif ( $record_type ne 'tru' ) {
warn "unknown record type $record_type";
@@ -516,15 +599,15 @@ sub get_keys {
waitpid $pid, 0;
- push @returned_keys, $current_key
- if $current_key;
+ push @returned_keys, $current_primary_key
+ if $current_primary_key;
$self->options($saved_options);
return @returned_keys;
}
-sub _downrez_gpg2_date {
+sub _downrez_date {
my $self = shift;
my $date = shift;
if ($date =~ /^\d+$/) {
@@ -1108,11 +1191,11 @@ The following setup can be done before any of the following examples:
my $pid = $gnupg->decrypt( handles => $handles );
# This passes in the passphrase
- print $passphrase_fd $passphrase;
- close $passphrase_fd;
+ print $passphrase_fh $passphrase;
+ close $passphrase_fh;
# this passes in the plaintext
- print $input $_ while <$cipher_file>
+ print $input $_ while <$cipher_file>;
# this closes the communication channel,
# indicating we are done
@@ -1136,13 +1219,13 @@ The following setup can be done before any of the following examples:
# and read from our input, because no input is needed!
my $handles = GnuPG::Handles->new();
- my @ids = [ 'ftobin', '0xABCD1234' ];
+ my @ids = ( 'ftobin', '0xABCD1234' );
# this time we need to specify something for
# command_args because --list-public-keys takes
# search ids as arguments
my $pid = $gnupg->list_public_keys( handles => $handles,
- command_args => [ @ids ] );
+ command_args => [ @ids ] );
waitpid $pid, 0;
diff --git a/lib/GnuPG/Key.pm b/lib/GnuPG/Key.pm
index 6cda91e..fbdda52 100644
--- a/lib/GnuPG/Key.pm
+++ b/lib/GnuPG/Key.pm
@@ -22,20 +22,108 @@ has [
algo_num
hex_id
hex_data
+ creation_date
+ expiration_date
creation_date_string
expiration_date_string
fingerprint
+ usage_flags
)
] => (
isa => 'Any',
is => 'rw',
);
+has [
+ qw(
+ signatures
+ revokers
+ revocations
+ pubkey_data
+ )] => (
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+);
+
+sub push_signatures {
+ my $self = shift;
+ push @{ $self->signatures }, @_;
+}
+
+sub push_revocations {
+ my $self = shift;
+ push @{ $self->revocations }, @_;
+}
+
+sub push_revokers {
+ my $self = shift;
+ push @{ $self->revokers }, @_;
+}
+
sub short_hex_id {
my ($self) = @_;
return substr $self->hex_id(), -8;
}
+sub compare {
+ my ($self, $other, $deep) = @_;
+
+ my @string_comparisons = qw(
+ length
+ algo_num
+ hex_id
+ creation_date
+ creation_date_string
+ usage_flags
+ );
+
+ my $field;
+ foreach $field (@string_comparisons) {
+ return 0 unless $self->$field eq $other->$field;
+ }
+
+ my @can_be_undef = qw(
+ hex_data
+ expiration_date
+ expiration_date_string
+ );
+ foreach $field (@can_be_undef) {
+ return 0 unless (defined $self->$field) == (defined $other->$field);
+ if (defined $self->$field) {
+ return 0 unless $self->$field eq $other->$field;
+ }
+ }
+ my @objs = qw(
+ fingerprint
+ );
+ foreach $field (@objs) {
+ return 0 unless $self->$field->compare($other->$field, $deep);
+ }
+
+ if (defined $deep && $deep) {
+ my @lists = qw(
+ signatures
+ revokers
+ revocations
+ );
+ my $i;
+ foreach my $list (@lists) {
+ return 0 unless @{$self->$list} == @{$other->$list};
+ for ( $i = 0; $i < scalar(@{$self->$list}); $i++ ) {
+ return 0
+ unless $self->$list->[$i]->compare($other->$list->[$i], $deep);
+ }
+ }
+
+ return 0 unless @{$self->pubkey_data} == @{$other->pubkey_data};
+ for ( $i = 0; $i < scalar(@{$self->pubkey_data}); $i++ ) {
+ return 0 unless (0 == $self->pubkey_data->[$i]->bcmp($other->pubkey_data->[$i]));
+ }
+ }
+ return 1;
+}
+
__PACKAGE__->meta->make_immutable;
1;
@@ -78,6 +166,12 @@ initialization of data members.
This returns the commonly-used short, 8 character short hex id
of the key.
+=item compare( I<$other>, I<$deep> )
+
+Returns non-zero only when this Key is identical to the other
+GnuPG::Key. If $deep is present and non-zero, the key's associated
+signatures, revocations, and revokers will also be compared.
+
=back
=head1 OBJECT DATA MEMBERS
@@ -92,9 +186,37 @@ Number of bits in the key.
They algorithm number that the Key is used for.
+=item usage flags
+
+The Key Usage flags associated with this key, represented as a string
+of lower-case letters. Possible values include: (a) authenticate, (c)
+certify, (e) encrypt, and (s) sign.
+
+A key may have any combination of them in any order. In addition to
+these letters, the primary key has uppercase versions of the letters
+to denote the _usable_ capabilities of the entire key, and a potential
+letter 'D' to indicate a disabled key.
+
+See "key capabilities" DETAILS from the GnuPG sources for more
+details.
+
=item hex_data
-The data of the key.
+The data of the key. WARNING: this seems to have never been
+instantiated, and should always be undef.
+
+=item pubkey_data
+
+A list of Math::BigInt objects that correspond to the public key
+material for the given key (this member is empty on secret keys).
+
+For DSA keys, the values are: prime (p), group order (q), group generator (g), y
+
+For RSA keys, the values are: modulus (n), exponent (e)
+
+For El Gamal keys, the values are: prime (p), group generator (g), y
+
+For more details, see: http://tools.ietf.org/html/rfc4880#page-42
=item hex_id
@@ -102,18 +224,50 @@ The long hex id of the key. This is not the fingerprint nor
the short hex id, which is 8 hex characters.
=item creation_date_string
+
=item expiration_date_string
-Formatted date of the key's creation and expiration.
+Formatted date of the key's creation and expiration. If the key has
+no expiration, expiration_date_string will return undef.
+
+=item creation_date
+
+=item expiration_date
+
+Date of the key's creation and expiration, stored as the number of
+seconds since midnight 1970-01-01 UTC. If the key has no expiration,
+expiration_date will return undef.
=item fingerprint
A GnuPG::Fingerprint object.
+=item signatures
+
+A list of GnuPG::Signature objects embodying the signatures on this
+key. For subkeys, the signatures are usually subkey-binding
+signatures. For primary keys, the signatures are statements about the
+key itself.
+
+=item revocations
+
+A list of revocations associated with this key, stored as
+GnuPG::Signature objects (since revocations are a type of
+certification as well). Note that a revocation of a primary key has a
+different semantic meaning than a revocation associated with a subkey.
+
+=item revokers
+
+A list of GnuPG::Revoker objects associated with this key, indicating
+other keys which are allowed to revoke certifications made by this
+key.
+
=back
=head1 SEE ALSO
L<GnuPG::Fingerprint>,
+L<GnuPG::Signature>,
+L<GnuPG::Revoker>,
=cut
diff --git a/lib/GnuPG/Options.pm b/lib/GnuPG/Options.pm
index d82a146..bbfd67a 100644
--- a/lib/GnuPG/Options.pm
+++ b/lib/GnuPG/Options.pm
@@ -97,7 +97,7 @@ sub copy {
foreach my $field ( BOOLEANS, SCALARS, LISTS ) {
my $value = $self->$field();
- next unless $value;
+ next unless defined $value;
$new->$field($value);
}
@@ -272,6 +272,8 @@ and then I<extra_args>, in that order.
=item recipients
+=back
+
These options correlate directly to many GnuPG options. For those that
are boolean to GnuPG, simply that argument is passed. For those
that are associated with a scalar, that scalar is passed passed
@@ -297,6 +299,8 @@ an object shall be prepended with I<_id(s)> if they only
take an id; otherwise assume an object of type GnuPG::Key
is required.
+=over 4
+
=item meta_pgp_5_compatible
If true, arguments are generated to try to be compatible with PGP 5.x.
diff --git a/lib/GnuPG/PrimaryKey.pm b/lib/GnuPG/PrimaryKey.pm
index d84bfa7..d36d0b9 100644
--- a/lib/GnuPG/PrimaryKey.pm
+++ b/lib/GnuPG/PrimaryKey.pm
@@ -18,7 +18,7 @@ use Any::Moose;
BEGIN { extends qw( GnuPG::Key ) }
-for my $list (qw(user_ids subkeys)) {
+for my $list (qw(user_ids subkeys user_attributes)) {
has $list => (
isa => 'ArrayRef',
is => 'rw',
@@ -38,6 +38,40 @@ has $_ => (
clearer => 'clear_' . $_,
) for qw( local_id owner_trust );
+
+sub compare {
+ my ($self, $other, $deep) = @_;
+
+ # not comparing local_id because it is meaningless in modern
+ # versions of GnuPG.
+ my @comparison_fields = qw (
+ owner_trust
+ );
+
+ foreach my $field (@comparison_fields) {
+ return 0 unless $self->$field eq $other->$field;
+ }
+
+ if (defined $deep && $deep) {
+ my @lists = qw(
+ user_ids
+ subkeys
+ user_attributes
+ );
+
+ foreach my $list (@lists) {
+ return 0 unless @{$self->$list} == @{$other->$list};
+ for ( my $i = 0; $i < scalar(@{$self->$list}); $i++ ) {
+ return 0
+ unless $self->$list->[$i]->compare($other->$list->[$i], 1);
+ }
+ }
+ }
+
+ return $self->SUPER::compare($other, $deep);
+}
+
+
__PACKAGE__->meta->make_immutable;
1;
@@ -78,13 +112,19 @@ in L<GnuPG::Key>.
A list of GnuPG::UserId objects associated with this key.
+=item user_attributes
+
+A list of GnuPG::UserAttribute objects associated with this key.
+
=item subkeys
A list of GnuPG::SubKey objects associated with this key.
=item local_id
-GnuPG's local id for the key.
+WARNING: DO NOT USE. This used to mean GnuPG's local id for the key,
+but modern versions of GnuPG do not produce it. Expect this to be the
+empty string or undef.
=item owner_trust
diff --git a/lib/GnuPG/PublicKey.pm b/lib/GnuPG/PublicKey.pm
index 723266f..69609b3 100644
--- a/lib/GnuPG/PublicKey.pm
+++ b/lib/GnuPG/PublicKey.pm
@@ -42,7 +42,7 @@ through various methods of GnuPG::Interface.
They embody various aspects of a GnuPG public key.
This package inherits data members and object methods
-from GnuPG::PrimaryKey, which is described here, but rather
+from GnuPG::PrimaryKey, which is not described here, but rather
in L<GnuPG::PrimaryKey>.
Currently, this package is functionally no different
diff --git a/lib/GnuPG/Revoker.pm b/lib/GnuPG/Revoker.pm
new file mode 100644
index 0000000..151a2f5
--- /dev/null
+++ b/lib/GnuPG/Revoker.pm
@@ -0,0 +1,158 @@
+# Revoker.pm
+# - providing an object-oriented approach to GnuPG key revokers
+#
+# Copyright (C) 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+# (derived from Signature.pm, Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>)
+#
+# This module is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+# $Id: Signature.pm,v 1.4 2001/08/21 13:31:50 ftobin Exp $
+#
+
+package GnuPG::Revoker;
+use Any::Moose;
+
+has [qw(
+ algo_num
+ class
+ )] => (
+ isa => 'Int',
+ is => 'rw',
+);
+
+has fingerprint => (
+ isa => 'GnuPG::Fingerprint',
+ is => 'rw',
+ );
+
+has signatures => (
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+);
+
+sub push_signatures {
+ my $self = shift;
+ push @{ $self->signatures }, @_;
+}
+
+sub is_sensitive {
+ my $self = shift;
+ return $self->class & 0x40;
+}
+
+sub compare {
+ my ( $self, $other, $deep ) = @_;
+
+ my @comparison_ints = qw( class algo_num );
+
+ foreach my $field ( @comparison_ints ) {
+ return 0 unless $self->$field() == $other->$field();
+ }
+
+ return 0 unless $self->fingerprint->compare($other->fingerprint);
+
+ # FIXME: is it actually wrong if the associated signatures come out
+ # in a different order on the two compared designated revokers?
+ if (defined $deep && $deep) {
+ return 0 unless @{$self->signatures} == @{$other->signatures};
+ for ( my $i = 0; $i < scalar(@{$self->signatures}); $i++ ) {
+ return 0
+ unless $self->signatures->[$i]->compare($other->signatures->[$i], 1);
+ }
+ }
+
+ return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+GnuPG::Revoker - GnuPG Key Revoker Objects
+
+=head1 SYNOPSIS
+
+ # assumes a GnuPG::PrimaryKey object in $key
+ my $revokerfpr = $key->revokers->[0]->fingerprint();
+
+=head1 DESCRIPTION
+
+GnuPG::Revoker objects are generally not instantiated on their own,
+but rather as part of GnuPG::Key objects. They represent a statement
+that another key is designated to revoke certifications made by the
+key in question.
+
+=head1 OBJECT METHODS
+
+=over 4
+
+=item new( I<%initialization_args> )
+
+This methods creates a new object. The optional arguments are
+initialization of data members.
+
+=item is_sensitive()
+
+Returns 0 if the revoker information can be freely distributed.
+If this is non-zero, the information should be treated as "sensitive".
+
+Please see http://tools.ietf.org/html/rfc4880#section-5.2.3.15 for
+more explanation.
+
+=item compare( I<$other>, I<$deep> )
+
+Returns non-zero only when this designated revoker is identical to the
+other GnuPG::Revoker. If $deep is present and non-zero, the revokers'
+signatures will also be compared.
+
+
+=back
+
+=head1 OBJECT DATA MEMBERS
+
+=over 4
+
+=item fingerprint
+
+A GnuPG::Fingerprint object indicating the fingerprint of the
+specified revoking key. (Note that this is *not* the fingerprint of
+the key whose signatures can be revoked by this revoker).
+
+=item algo_num
+
+The numeric identifier of the algorithm of the revoker's key.
+
+=item signatures
+
+A list of GnuPG::Signature objects which cryptographically bind the
+designated revoker to the primary key. If the material was
+instantiated using the *_with_sigs() functions from GnuPG::Interface,
+then a valid revoker designation should have a valid signature
+associated with it from the relevant key doing the designation (not
+from the revoker's key).
+
+Note that designated revoker certifications are themselves
+irrevocable, so there is no analogous list of revocations in a
+GnuPG::Revoker object.
+
+=back
+
+=head1 SEE ALSO
+
+L<GnuPG::Interface>,
+L<GnuPG::Fingerprint>,
+L<GnuPG::Key>,
+L<GnuPG::Signature>,
+L<http://tools.ietf.org/html/rfc4880#section-5.2.3.15>
+
+=cut
diff --git a/lib/GnuPG/Signature.pm b/lib/GnuPG/Signature.pm
index f492aec..c2ba189 100644
--- a/lib/GnuPG/Signature.pm
+++ b/lib/GnuPG/Signature.pm
@@ -16,11 +16,52 @@
package GnuPG::Signature;
use Any::Moose;
-has [qw( algo_num hex_id user_id_string date_string )] => (
+has [qw(
+ validity
+ algo_num
+ hex_id
+ user_id_string
+ date
+ date_string
+ expiration_date
+ expiration_date_string
+ sig_class
+ is_exportable
+ )] => (
isa => 'Any',
is => 'rw',
);
+sub is_valid {
+ my $self = shift;
+ return $self->validity eq '!';
+}
+
+sub compare {
+ my ($self, $other) = @_;
+
+ my @compared_fields = qw(
+ validity
+ algo_num
+ hex_id
+ date
+ date_string
+ sig_class
+ is_exportable
+ );
+
+ foreach my $field ( @compared_fields ) {
+ return 0 unless $self->$field eq $other->$field;
+ }
+ # check for expiration if present?
+ return 0 unless (defined $self->expiration_date) == (defined $other->expiration_date);
+ if (defined $self->expiration_date) {
+ return 0 unless (($self->expiration_date == $other->expiration_date) ||
+ ($self->expiration_date_string eq $other->expiration_date_string));
+ }
+ return 1;
+}
+
__PACKAGE__->meta->make_immutable;
1;
@@ -33,8 +74,8 @@ GnuPG::Signature - GnuPG Key Signature Objects
=head1 SYNOPSIS
- # assumes a GnuPG::SubKey object in $key
- my $signing_id = $key->signature->hex_id();
+ # assumes a GnuPG::Key or GnuPG::UserID or GnuPG::UserAttribute object in $signed
+ my $signing_id = $signed->signatures->[0]->hex_id();
=head1 DESCRIPTION
@@ -51,12 +92,31 @@ They embody various aspects of a GnuPG signature on a key.
This methods creates a new object. The optional arguments are
initialization of data members.
+=item is_valid()
+
+Returns 1 if GnuPG was able to cryptographically verify the signature,
+otherwise 0.
+
+=item compare( I<$other> )
+
+Returns non-zero only when this Signature is identical to the other
+GnuPG::Signature.
+
=back
=head1 OBJECT DATA MEMBERS
=over 4
+=item validity
+
+A character indicating the cryptographic validity of the key. GnuPG
+uses at least the following characters: "!" means valid, "-" means not
+valid, "?" means unknown (e.g. if the supposed signing key is not
+present in the local keyring), and "%" means an error occurred (e.g. a
+non-supported algorithm). See the documentation for --check-sigs in
+gpg(1).
+
=item algo_num
The number of the algorithm used for the signature.
@@ -70,10 +130,38 @@ The hex id of the signing key.
The first user id string on the key that made the signature.
This may not be defined if the signing key is not on the local keyring.
+=item sig_class
+
+Signature class. This is the numeric value of the class of signature.
+
+A table of possible classes of signatures and their numeric types can
+be found at http://tools.ietf.org/html/rfc4880#section-5.2.1
+
+=item is_exportable
+
+returns 0 for local-only signatures, non-zero for exportable
+signatures.
+
=item date_string
The formatted date the signature was performed on.
+=item date
+
+The date the signature was performed, represented as the number of
+seconds since midnight 1970-01-01 UTC.
+
+=item expiration_date_string
+
+The formatted date the signature will expire (signatures without
+expiration return undef).
+
+=item expiration_date
+
+The date the signature will expire, represented as the number of
+seconds since midnight 1970-01-01 UTC (signatures without expiration
+return undef)
+
=back
=head1 SEE ALSO
diff --git a/lib/GnuPG/SubKey.pm b/lib/GnuPG/SubKey.pm
index 4866b1d..1e5f606 100644
--- a/lib/GnuPG/SubKey.pm
+++ b/lib/GnuPG/SubKey.pm
@@ -15,13 +15,34 @@
package GnuPG::SubKey;
use Any::Moose;
+use Carp;
BEGIN { extends qw( GnuPG::Key ) }
-has [qw( validity owner_trust local_id signature )] => (
+has [qw( validity owner_trust local_id )] => (
isa => 'Any',
is => 'rw',
);
+# DEPRECATED!
+# return the last signature, if present. Or push in a new signature,
+# if one is supplied.
+sub signature {
+ my $self = shift;
+ my $argcount = @_;
+
+ if ($argcount) {
+ @{$self->signatures} = ();
+ $self->push_signatures(@_);
+ } else {
+ my $sigcount = @{$self->signatures};
+ if ($sigcount) {
+ return $self->signatures->[$sigcount-1];
+ } else {
+ return undef;
+ }
+ }
+}
+
__PACKAGE__->meta->make_immutable;
1;
@@ -70,8 +91,12 @@ See GnuPG's DETAILS file for details.
=item signature
-A GnuPG::Signature object holding the representation of the
-signature on this key.
+* DEPRECATED*
+
+A GnuPG::Signature object holding the representation of the signature
+on this key. Please use signatures (see L<GnuPG::Key>) instead of
+signature. Using signature, you will get an arbitrary signature from
+the set of available signatures.
=back
diff --git a/lib/GnuPG/UserAttribute.pm b/lib/GnuPG/UserAttribute.pm
new file mode 100644
index 0000000..22ffbd1
--- /dev/null
+++ b/lib/GnuPG/UserAttribute.pm
@@ -0,0 +1,119 @@
+# UserAttribute.pm
+# - providing an object-oriented approach to GnuPG user attributes
+#
+# Copyright (C) 2010 Daniel Kahn Gillmor <dkg@fifthhorseman.net>
+# (derived from UserId.pm, Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>)
+#
+# This module is free software; you can redistribute it and/or modify it
+# under the same terms as Perl itself.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+#
+# $Id: UserId.pm,v 1.7 2001/08/21 13:31:50 ftobin Exp $
+#
+
+package GnuPG::UserAttribute;
+use Any::Moose;
+
+has [qw( validity subpacket_count subpacket_total_size )] => (
+ isa => 'Any',
+ is => 'rw',
+);
+
+has signatures => (
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+);
+has revocations => (
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+);
+
+sub push_signatures {
+ my $self = shift;
+ push @{ $self->signatures }, @_;
+}
+sub push_revocations {
+ my $self = shift;
+ push @{ $self->revocations }, @_;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+GnuPG::UserAttribute - GnuPG User Attribute Objects
+
+=head1 SYNOPSIS
+
+ # assumes a GnuPG::PublicKey object in $publickey
+ my $jpgs_size = $publickey->user_attributes->[0]->subpacket_total_size();
+
+=head1 DESCRIPTION
+
+GnuPG::UserAttribute objects are generally not instantiated on their
+own, but rather as part of GnuPG::PublicKey or GnuPG::SecretKey
+objects.
+
+=head1 OBJECT METHODS
+
+=over 4
+
+=item new( I<%initialization_args> )
+
+This methods creates a new object. The optional arguments are
+initialization of data members;
+
+=back
+
+=head1 OBJECT DATA MEMBERS
+
+=over 4
+
+=item validity
+
+A scalar holding the value GnuPG reports for the calculated validity
+of the binding between this User Attribute packet and its associated
+primary key. See GnuPG's DETAILS file for details.
+
+=item subpacket_count
+
+A scalar holding the number of attribute subpackets. This is usually
+1, as most UATs seen in the wild contain a single image in JPEG
+format.
+
+=item subpacket_total_size
+
+A scalar holding the total byte count of all attribute subpackets.
+
+=item signatures
+
+A list of GnuPG::Signature objects embodying the signatures
+on this user attribute.
+
+=item revocations
+
+A list of revocations associated with this User Attribute, stored as
+GnuPG::Signature objects (since revocations are a type of
+certification as well).
+
+=back
+
+=head1 BUGS
+
+No useful information about the embedded attributes is provided yet.
+It would be nice to be able to get ahold of the raw JPEG material.
+
+=head1 SEE ALSO
+
+L<GnuPG::Signature>,
+
+=cut
diff --git a/lib/GnuPG/UserId.pm b/lib/GnuPG/UserId.pm
index ad37ea5..eef2da1 100644
--- a/lib/GnuPG/UserId.pm
+++ b/lib/GnuPG/UserId.pm
@@ -26,11 +26,49 @@ has signatures => (
is => 'rw',
default => sub { [] },
);
+has revocations => (
+ isa => 'ArrayRef',
+ is => 'rw',
+ default => sub { [] },
+);
sub push_signatures {
my $self = shift;
push @{ $self->signatures }, @_;
}
+sub push_revocations {
+ my $self = shift;
+ push @{ $self->revocations }, @_;
+}
+
+sub compare {
+ my ( $self, $other, $deep ) = @_;
+
+ my @comparison_ints = qw( validity as_string );
+
+ foreach my $field ( @comparison_ints ) {
+ return 0 unless $self->$field() eq $other->$field();
+ }
+
+ return 0 unless @{$self->signatures} == @{$other->signatures};
+ return 0 unless @{$self->revocations} == @{$other->revocations};
+
+ # FIXME: is it actually wrong if the associated signatures come out
+ # in a different order on the two compared designated revokers?
+ if (defined $deep && $deep) {
+ for ( my $i = 0; $i < scalar(@{$self->signatures}); $i++ ) {
+ return 0
+ unless $self->signatures->[$i]->compare($other->signatures->[$i], 1);
+ }
+ for ( my $i = 0; $i < scalar(@{$self->revocations}); $i++ ) {
+ return 0
+ unless $self->revocations->[$i]->compare($other->revocations->[$i], 1);
+ }
+ }
+
+ return 1;
+}
+
# DEPRECATED
sub user_id_string {
@@ -69,6 +107,12 @@ objects.
This methods creates a new object. The optional arguments are
initialization of data members;
+=item compare( I<$other>, I<$deep> )
+
+Returns non-zero only when this User ID is identical to the other
+GnuPG::UserID. If $deep is present and non-zero, the User ID's
+signatures and revocations will also be compared.
+
=back
=head1 OBJECT DATA MEMBERS
@@ -90,6 +134,12 @@ See GnuPG's DETAILS file for details.
A list of GnuPG::Signature objects embodying the signatures
on this user id.
+=item revocations
+
+A list of revocations associated with this User ID, stored as
+GnuPG::Signature objects (since revocations are a type of
+certification as well).
+
=back
=head1 SEE ALSO
diff --git a/t/GnuPG/ComparableFingerprint.pm b/t/GnuPG/ComparableFingerprint.pm
deleted file mode 100644
index 6a0632a..0000000
--- a/t/GnuPG/ComparableFingerprint.pm
+++ /dev/null
@@ -1,29 +0,0 @@
-# ComparableFingerprint.pm
-# - comparable GnuPG::Fingerprint
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableFingerprint.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableFingerprint;
-
-use strict;
-
-use base qw(GnuPG::Fingerprint );
-
-sub compare
-{
- my ( $self, $other ) = @_;
-
- return $self->as_hex_string() eq $other->as_hex_string();
-}
-
-1;
diff --git a/t/GnuPG/ComparableKey.pm b/t/GnuPG/ComparableKey.pm
deleted file mode 100644
index 0e3b5e1..0000000
--- a/t/GnuPG/ComparableKey.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-# ComparableKey.pm
-# - comparable GnuPG::Key
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableKey;
-
-use strict;
-use GnuPG::Fingerprint;
-
-use base qw( GnuPG::Key );
-
-sub compare
-{
- my ( $self, $other, $deep ) = @_;
-
- # expiration_date_string was taken out of the following
- # list because there is a bug in the listing of
- # expiration dates in 1.0.5
- my @comparison_fields
- = qw( length algo_num hex_id
- creation_date_string
- );
-
- foreach my $field ( @comparison_fields )
- {
- # don't test for definedness because
- # all fields should be defined
- return 0 unless $self->$field() eq $other->$field();
- }
-
- return $self->_deeply_compare( $other ) if $deep;
-
- return 1;
-}
-
-
-sub _deeply_compare
-{
- my ( $self, $other ) = @_;
- bless $self->fingerprint(), 'GnuPG::ComparableFingerprint';
-
- return ( $self->fingerprint->compare( $other->fingerprint() ) );
-}
-
-
-1;
diff --git a/t/GnuPG/ComparablePrimaryKey.pm b/t/GnuPG/ComparablePrimaryKey.pm
deleted file mode 100644
index 24f7d1f..0000000
--- a/t/GnuPG/ComparablePrimaryKey.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-# ComparablePrimaryKey.pm
-# - Comparable GnuPG::PrimaryKey
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparablePrimaryKey.pm,v 1.3 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparablePrimaryKey;
-
-use strict;
-use GnuPG::ComparableSubKey;
-
-use base qw( GnuPG::PrimaryKey GnuPG::ComparableKey );
-
-sub _deeply_compare
-{
- my ( $self, $other ) = @_;
-
- my @self_subkeys = $self->subkeys();
- my @other_subkeys = $other->subkeys();
-
- return 0 unless @self_subkeys == @other_subkeys;
-
- my $num_subkeys = @self_subkeys;
-
- for ( my $i = 0; $i < $num_subkeys; $i++ )
- {
- my $subkey1 = $self_subkeys[$i];
- my $subkey2 = $other_subkeys[$i];
-
- bless $subkey1, 'GnuPG::ComparableSubKey';
-
- return 0 unless $subkey1->compare( $subkey2, 1 );
- }
-
- # don't compare user id's because their ordering
- # is not necessarily deterministic
-
- $self->SUPER::_deeply_compare( $other );
-
- return 1;
-}
-
-1;
diff --git a/t/GnuPG/ComparablePublicKey.pm b/t/GnuPG/ComparablePublicKey.pm
deleted file mode 100644
index 2137850..0000000
--- a/t/GnuPG/ComparablePublicKey.pm
+++ /dev/null
@@ -1,22 +0,0 @@
-# ComparablePublicKey.pm
-# - Comparable GnuPG::PublicKeys
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparablePublicKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparablePublicKey;
-
-use strict;
-
-use base qw( GnuPG::PublicKey GnuPG::ComparablePrimaryKey );
-
-1;
diff --git a/t/GnuPG/ComparableSecretKey.pm b/t/GnuPG/ComparableSecretKey.pm
deleted file mode 100644
index 3f3858f..0000000
--- a/t/GnuPG/ComparableSecretKey.pm
+++ /dev/null
@@ -1,22 +0,0 @@
-# ComparableSecretKey.pm
-# - Comparable GnuPG::SecretKey
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableSecretKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableSecretKey;
-
-use strict;
-
-use base qw( GnuPG::SecretKey GnuPG::ComparablePrimaryKey );
-
-1;
diff --git a/t/GnuPG/ComparableSignature.pm b/t/GnuPG/ComparableSignature.pm
deleted file mode 100644
index d8e82f4..0000000
--- a/t/GnuPG/ComparableSignature.pm
+++ /dev/null
@@ -1,41 +0,0 @@
-# ComparableSignature.pm
-# - comparable GnuPG::Signature
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableSignature.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableSignature;
-
-use strict;
-
-use base qw( GnuPG::Signature );
-
-sub compare
-{
- my ( $self, $other ) = @_;
-
- my @compared_fields = qw( algo_num hex_id date_string );
-
- foreach my $field ( @compared_fields )
- {
- my $f1 = $self->$field();
- my $f2 = $other->$field();
-
- # don't test for definedness because
- # all fields should be defined
- return 0 unless $self->$field() eq $other->$field();
- }
-
- return 1;
-}
-
-1;
diff --git a/t/GnuPG/ComparableSubKey.pm b/t/GnuPG/ComparableSubKey.pm
deleted file mode 100644
index c6a6ef2..0000000
--- a/t/GnuPG/ComparableSubKey.pm
+++ /dev/null
@@ -1,54 +0,0 @@
-# ComparableSubKey.pm
-# - comparable GnuPG::SubKey
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableSubKey.pm,v 1.4 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableSubKey;
-
-use strict;
-use GnuPG::ComparableSignature;
-use GnuPG::ComparableFingerprint;
-
-use base qw( GnuPG::SubKey GnuPG::ComparableKey );
-
-sub compare
-{
- my ( $self, $other, $deep ) = @_;
-
- if ( $deep )
- {
- bless $self->signature, 'GnuPG::ComparableSignature'
- if $self->signature();
- bless $self->fingerprint, 'GnuPG::ComparableFingerprint'
- if $self->fingerprint();
-
- foreach my $field ( qw( signature fingerprint ) )
- {
- my $f1 = $self->$field();
- my $f2 = $other->$field();
-
- # if neither are filled in, don't compare this
- next if not $f1 or not $f2;
-
- # if one is filled in, but not the other
- # we say they are different
- return 0 if $f1 xor $f2;
-
- $f1->compare( $f2, 1 );
- }
- }
-
- return $self->SUPER::compare( $other, $deep )
-}
-
-1;
diff --git a/t/GnuPG/ComparableUserId.pm b/t/GnuPG/ComparableUserId.pm
deleted file mode 100644
index 11efc40..0000000
--- a/t/GnuPG/ComparableUserId.pm
+++ /dev/null
@@ -1,57 +0,0 @@
-# ComparableUserId.pm
-# - providing an object-oriented approach to GnuPG user ids
-#
-# Copyright (C) 2000 Frank J. Tobin <ftobin@cpan.org>
-#
-# This module is free software; you can redistribute it and/or modify it
-# under the same terms as Perl itself.
-#
-# This program is distributed in the hope that it will be useful,
-# but WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-#
-# $Id: ComparableUserId.pm,v 1.3 2001/09/14 12:34:36 ftobin Exp $
-#
-
-package GnuPG::ComparableUserId;
-
-use strict;
-
-use base qw( GnuPG::UserId );
-
-sub compare
-{
- my ( $self, $other, $deep ) = @_;
-
- return 0 unless $self->user_id_string() eq $other->user_id_string();
- return 0 unless $self->_deeply_compare( $other );
- return 1;
-}
-
-
-sub _deeply_compare
-{
- my ( $self, $other ) = @_;
-
- return 0 unless
- $self->rigorously_compare( $other );
-
- my @self_signatures = $self->signatures();
- my @other_signatures = $other->signatures();
-
- return 0 unless @self_signatures == @other_signatures;
-
- my $num_sigs = @self_signatures;
-
- for ( my $i = 0; $i < $num_sigs; $i++ )
- {
-
- return 0
- unless $self_signatures[$i]->compare( $other_signatures[$i], 1 );
- }
-
- return 1;
-}
-
-
-1;
diff --git a/t/get_public_keys.t b/t/get_public_keys.t
index 230c731..38661b7 100644
--- a/t/get_public_keys.t
+++ b/t/get_public_keys.t
@@ -10,8 +10,8 @@ use lib './t';
use MyTest;
use MyTestSpecific;
-use GnuPG::ComparablePublicKey;
-use GnuPG::ComparableSubKey;
+use GnuPG::PrimaryKey;
+use GnuPG::SubKey;
my ( $given_key, $handmade_key );
@@ -24,14 +24,27 @@ TEST
return 0 unless @returned_keys == 1;
$given_key = shift @returned_keys;
-
- $handmade_key = GnuPG::ComparablePublicKey->new
+
+ my $pubkey_data = [
+ Math::BigInt->from_hex('0x'.
+ '88FCAAA5BCDCD52084D46143F44ED1715A339794641158DE03AA2092AFD3174E3DCA2CB7DF2DDC6FEDF7C3620F5A8BDAD06713E6153F8748DD76CB97305F30CBA8F8801DB47FAC11EED725F55672CB9BDAD629178A677CBB089B3E8AE0D9A9AD7741697A35F2868C62D25670994A92D810480173DC24263EEA0F103A43C0B64B'),
+ Math::BigInt->from_hex('0x'.
+ '8F2A3842C70FF17660CBB78C78FC93F534AB9A17'),
+ Math::BigInt->from_hex('0x'.
+ '83E348C2AA65F56DE84E8FDCE6DA7B0991B1C75EC8CA446FA85869A43350907BFF36BE512385E8E7E095578BB2138C04E318495873218286DE2B8C86F36EA670135434967AC798EBA28581F709F0C6B696EB512D3E561E381A06E4B5239BCC655015F9A926C74E4B859B26EAD604F208A556511A76A40EDCD9C38E6BD82CCCB4'),
+ Math::BigInt->from_hex('0x'.
+ '80DE04C85E30C9D62C13F90CFF927A84A5A59D0900B3533D4D6193FEF8C5DAEF9FF8A7D5F76B244FBC17644F50D524E0B19CD3A4B5FC2D78DAECA3FE58FA1C1A64E6C7B96C4EE618173543163A72EF954DFD593E84342699096E9CA76578AC1DE3D893BCCD0BF470CEF625FAF816A0F503EF75C18C6173E35C8675AF919E5704')
+ ];
+
+ $handmade_key = GnuPG::PrimaryKey->new
( length => 1024,
algo_num => 17,
hex_id => '53AE596EF950DA9C',
+ creation_date => 949813093,
creation_date_string => '2000-02-06',
- expiration_date_string => '2002-02-05',
- owner_trust => 'f',
+ owner_trust => '-',
+ usage_flags => 'scaESCA',
+ pubkey_data => $pubkey_data,
);
$handmade_key->fingerprint
@@ -40,42 +53,149 @@ TEST
)
);
- my $initial_self_signature = GnuPG::Signature->new
- ( algo_num => 17,
+
+ my $uid0 = GnuPG::UserId->new( as_string => 'GnuPG test key (for testing purposes only)',
+ validity => '-');
+ $uid0->push_signatures(
+ GnuPG::Signature->new(
+ date => 1177086597,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'GnuPG test key (for testing purposes only)',
+ date_string => '2007-04-20',
+ hex_id => '53AE596EF950DA9C',
+ sig_class => 0x13,
+ validity => '!'),
+ GnuPG::Signature->new(
+ date => 953180097,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'Frank J. Tobin <ftobin@neverending.org>',
+ date_string => '2000-03-16',
+ hex_id => '56FFD10A260C4FA3',
+ sig_class => 0x10,
+ validity => '!'),
+ GnuPG::Signature->new(
+ date => 949813093,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'GnuPG test key (for testing purposes only)',
+ date_string => '2000-02-06',
+ hex_id => '53AE596EF950DA9C',
+ sig_class => 0x13,
+ validity => '!'));
+
+ my $uid1 = GnuPG::UserId->new( as_string => 'Foo Bar (1)',
+ validity => '-');
+ $uid1->push_signatures(
+ GnuPG::Signature->new(
+ date => 1177086330,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'GnuPG test key (for testing purposes only)',
+ date_string => '2007-04-20',
+ hex_id => '53AE596EF950DA9C',
+ sig_class => 0x13,
+ validity => '!'),
+ GnuPG::Signature->new(
+ date => 953180103,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'Frank J. Tobin <ftobin@neverending.org>',
+ date_string => '2000-03-16',
+ hex_id => '56FFD10A260C4FA3',
+ sig_class => 0x10,
+ validity => '!'),
+ GnuPG::Signature->new(
+ date => 953179891,
+ algo_num => 17,
+ is_exportable => 1,
+ user_id_string => 'GnuPG test key (for testing purposes only)',
+ date_string => '2000-03-16',
+ hex_id => '53AE596EF950DA9C',
+ sig_class => 0x13,
+ validity => '!'));
+
+
+
+ $handmade_key->push_user_ids($uid0, $uid1);
+
+ my $subkey_signature = GnuPG::Signature->new
+ ( validity => '!',
+ algo_num => 17,
hex_id => '53AE596EF950DA9C',
- date_string => '2000-02-06',
+ date => 1177086380,
+ date_string => '2007-04-20',
+ user_id_string => 'GnuPG test key (for testing purposes only)',
+ sig_class => 0x18,
+ is_exportable => 1,
);
my $uid2_signature = GnuPG::Signature->new
- ( algo_num => 17,
+ ( validity => '!',
+ algo_num => 17,
hex_id => '53AE596EF950DA9C',
+ date => 953179891,
date_string => '2000-03-16',
);
my $ftobin_signature = GnuPG::Signature->new
- ( algo_num => 17,
+ ( validity => '!',
+ algo_num => 17,
hex_id => '56FFD10A260C4FA3',
+ date => 953180097,
date_string => '2000-03-16',
);
+ my $designated_revoker_sig = GnuPG::Signature->new
+ ( validity => '!',
+ algo_num => 17,
+ hex_id => '53AE596EF950DA9C',
+ date => 978325209,
+ date_string => '2001-01-01',
+ sig_class => 0x1f,
+ is_exportable => 1
+ );
+
+ my $revoker = GnuPG::Revoker->new
+ ( algo_num => 17,
+ class => 0x80,
+ fingerprint => GnuPG::Fingerprint->new( as_hex_string =>
+ '4F863BBBA8166F0A340F600356FFD10A260C4FA3'),
+ );
+ $revoker->push_signatures($designated_revoker_sig);
+
+ my $subkey_pub_data = [
+ Math::BigInt->from_hex('0x'.
+ '8831982DADC4C5D05CBB01D9EAF612131DDC9C24CEA7246557679423FB0BA42F74D10D8E7F5564F6A4FB8837F8DC4A46571C19B122E6DF4B443D15197A6A22688863D0685FADB6E402316DAA9B560D1F915475364580A67E6DF0A727778A5CF3'),
+ Math::BigInt->from_hex('0x'.
+ '6'),
+ Math::BigInt->from_hex('0x'.
+ '2F3850FF130C6AC9AA0962720E86539626FAA9B67B33A74DFC0DE843FF3E90E43E2F379EE0182D914FA539CCCF5C83A20DB3A7C45E365B8A2A092E799A3DFF4AD8274EB977BAAF5B1AFB2ACB8D6F92454F01682F555565E73E56793C46EF7C3E')
+ ];
+
my $subkey = GnuPG::SubKey->new
( validity => 'u',
length => 768,
algo_num => 16,
hex_id => 'ADB99D9C2E854A6B',
+ creation_date => 949813119,
creation_date_string => '2000-02-06',
- expiration_date_string => '2002-02-05',
+ usage_flags => 'e',
+ pubkey_data => $subkey_pub_data,
);
+
$subkey->fingerprint
( GnuPG::Fingerprint->new( as_hex_string =>
'7466B7E98C4CCB64C2CE738BADB99D9C2E854A6B'
)
);
- $subkey->signature( $initial_self_signature );
+ $subkey->push_signatures( $subkey_signature );
$handmade_key->push_subkeys( $subkey );
+ $handmade_key->push_revokers( $revoker );
$handmade_key->compare( $given_key );
};
@@ -85,7 +205,7 @@ TEST
my $subkey1 = $given_key->subkeys()->[0];
my $subkey2 = $handmade_key->subkeys()->[0];
- bless $subkey1, 'GnuPG::ComparableSubKey';
+ bless $subkey1, 'GnuPG::SubKey';
my $equal = $subkey1->compare( $subkey2 );
diff --git a/t/get_secret_keys.t b/t/get_secret_keys.t
index a80c759..acfeaa2 100644
--- a/t/get_secret_keys.t
+++ b/t/get_secret_keys.t
@@ -10,7 +10,7 @@ use lib './t';
use MyTest;
use MyTestSpecific;
-use GnuPG::ComparableSecretKey;
+use GnuPG::PrimaryKey;
my ( $given_key, $handmade_key );
@@ -24,13 +24,14 @@ TEST
$given_key = shift @returned_keys;
- $handmade_key = GnuPG::ComparableSecretKey->new
+ $handmade_key = GnuPG::PrimaryKey->new
( length => 1024,
algo_num => 17,
hex_id => '53AE596EF950DA9C',
+ creation_date => 949813093,
creation_date_string => '2000-02-06',
- expiration_date_string => '2002-02-05',
- owner_trust => 'f',
+ owner_trust => '', # secret keys do not report ownertrust?
+ usage_flags => 'scaESCA',
);
$handmade_key->fingerprint
@@ -38,14 +39,22 @@ TEST
'93AFC4B1B0288A104996B44253AE596EF950DA9C',
)
);
-
+
+ $handmade_key->push_user_ids(
+ GnuPG::UserId->new( as_string => 'GnuPG test key (for testing purposes only)',
+ validity => ''), # secret keys do not report uid validity?
+ GnuPG::UserId->new( as_string => 'Foo Bar (1)',
+ validity => '')); # secret keys do not report uid validity?
+
+
my $subkey = GnuPG::SubKey->new
( validity => 'u',
length => 768,
algo_num => 16,
hex_id => 'ADB99D9C2E854A6B',
+ creation_date => 949813119,
creation_date_string => '2000-02-06',
- expiration_date_string => '2002-02-05',
+ usage_flags => 'e',
);
$subkey->fingerprint
diff --git a/test/public-keys-sigs/1.out b/test/public-keys-sigs/1.out
index f1e9d53..b1cb95c 100755
--- a/test/public-keys-sigs/1.out
+++ b/test/public-keys-sigs/1.out
@@ -1,6 +1,7 @@
test/pubring.gpg
----------------
pub 1024D/F950DA9C 2000-02-06
+sig R F950DA9C 2001-01-01 GnuPG test key (for testing purposes only)
uid GnuPG test key (for testing purposes only)
sig 3 F950DA9C 2007-04-20 GnuPG test key (for testing purposes only)
sig 260C4FA3 2000-03-16 Frank J. Tobin <ftobin@neverending.org>
diff --git a/test/public-keys-sigs/2.out b/test/public-keys-sigs/2.out
index cdf8cce..78fb9ed 100755
--- a/test/public-keys-sigs/2.out
+++ b/test/public-keys-sigs/2.out
@@ -1,4 +1,5 @@
pub 1024D/F950DA9C 2000-02-06
+sig R F950DA9C 2001-01-01 GnuPG test key (for testing purposes only)
uid GnuPG test key (for testing purposes only)
sig 3 F950DA9C 2007-04-20 GnuPG test key (for testing purposes only)
sig 260C4FA3 2000-03-16 Frank J. Tobin <ftobin@neverending.org>
diff --git a/test/pubring.gpg b/test/pubring.gpg
index c6d2276..60b008a 100644
--- a/test/pubring.gpg
+++ b/test/pubring.gpg
Binary files differ
diff --git a/test/random_seed b/test/random_seed
deleted file mode 100755
index f7a2233..0000000
--- a/test/random_seed
+++ /dev/null
Binary files differ
diff --git a/test/secring.gpg b/test/secring.gpg
index 391bd39..aa34674 100644
--- a/test/secring.gpg
+++ b/test/secring.gpg
Binary files differ
diff --git a/test/trustdb.gpg b/test/trustdb.gpg
deleted file mode 100755
index 92da441..0000000
--- a/test/trustdb.gpg
+++ /dev/null
Binary files differ