r60290 - in /branches/upstream/libdata-uuid-libuuid-perl/current: Changes LibUUID.xs MANIFEST META.yml Makefile.PL SIGNATURE lib/Data/UUID/LibUUID.pm t/basic.t t/fork.t
ansgar-guest at users.alioth.debian.org
ansgar-guest at users.alioth.debian.org
Wed Jul 14 11:42:48 UTC 2010
Author: ansgar-guest
Date: Wed Jul 14 11:42:39 2010
New Revision: 60290
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=60290
Log:
[svn-upgrade] new version libdata-uuid-libuuid-perl (0.05)
Added:
branches/upstream/libdata-uuid-libuuid-perl/current/t/fork.t
Modified:
branches/upstream/libdata-uuid-libuuid-perl/current/Changes
branches/upstream/libdata-uuid-libuuid-perl/current/LibUUID.xs
branches/upstream/libdata-uuid-libuuid-perl/current/MANIFEST
branches/upstream/libdata-uuid-libuuid-perl/current/META.yml
branches/upstream/libdata-uuid-libuuid-perl/current/Makefile.PL
branches/upstream/libdata-uuid-libuuid-perl/current/SIGNATURE
branches/upstream/libdata-uuid-libuuid-perl/current/lib/Data/UUID/LibUUID.pm
branches/upstream/libdata-uuid-libuuid-perl/current/t/basic.t
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/Changes?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/Changes (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/Changes Wed Jul 14 11:42:39 2010
@@ -1,3 +1,18 @@
+0.05
+ - non dev release
+
+0.05_04
+ - fix broken test plan
+
+0.05_03
+ - Some platforms don't use time based UUID generation even when asked to
+
+0.05_02
+ - Attempt to reseed only on OSX for now
+
+0.05_01
+ - Attempt to reseed the random number generator at least on OSX
+
0.04
- Avoid using the non portable POPpx
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/LibUUID.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/LibUUID.xs?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/LibUUID.xs (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/LibUUID.xs Wed Jul 14 11:42:39 2010
@@ -9,8 +9,15 @@
#include <uuid/uuid.h>
-#define UUID_TYPE_DCE 2
-#define UUID_TYPE_TIME 1
+#ifdef PERL_DARWIN
+#define PID_CHECK pid_check()
+#include <stdlib.h>
+#else
+#define PID_CHECK
+#endif
+
+
+#define UUID_TYPE_TIME 2
#define UUID_TYPE_RANDOM 4
#define UUID_HEX_SIZE sizeof(uuid_t) * 2
@@ -47,8 +54,19 @@
/* FIXME uuid_time, uuid_type, uuid_variant are available in libuuid but not in
* darwin's uuid.h... consider exposing? */
+static pid_t last_pid = 0;
+
+inline STATIC void pid_check () {
+ if ( getpid() != last_pid ) {
+ last_pid = getpid();
+ arc4random_stir();
+ }
+}
+
/* generates a new UUID of a given version */
STATIC void new_uuid (IV version, uuid_t uuid) {
+ PID_CHECK;
+
switch (version) {
case UUID_TYPE_TIME:
uuid_generate_time(uuid);
@@ -56,8 +74,7 @@
case UUID_TYPE_RANDOM:
uuid_generate_random(uuid);
break;
- case UUID_TYPE_DCE:
- default:
+ ggdefault:
uuid_generate(uuid);
}
}
@@ -140,6 +157,8 @@
MODULE = Data::UUID::LibUUID PACKAGE = Data::UUID::LibUUID
PROTOTYPES: ENABLE
+BOOT:
+ last_pid = getpid();
SV*
uuid_eq(uu1_sv, uu2_sv)
@@ -176,7 +195,7 @@
new_uuid_binary(...)
PROTOTYPE: ;$
PREINIT:
- IV version = UUID_TYPE_DCE;
+ IV version = UUID_TYPE_TIME;
CODE:
dUUIDRETBUF;
@@ -190,7 +209,7 @@
PROTOTYPE: ;$
PREINIT:
uuid_t uuid;
- IV version = UUID_TYPE_DCE;
+ IV version = UUID_TYPE_TIME;
CODE:
dSTRRETBUF;
@@ -249,6 +268,7 @@
new_dce_uuid_binary(...)
CODE:
dUUIDRETBUF;
+ PID_CHECK;
uuid_generate(RETBUF);
OUTPUT: RETVAL
@@ -258,6 +278,7 @@
uuid_t uuid;
CODE:
dSTRRETBUF;
+ PID_CHECK;
uuid_generate(uuid);
uuid_unparse(uuid, RETBUF);
OUTPUT: RETVAL
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/MANIFEST?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/MANIFEST (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/MANIFEST Wed Jul 14 11:42:39 2010
@@ -9,5 +9,6 @@
ppport.h
t/basic.t
t/compat.t
+t/fork.t
META.yml Module meta-data (added by MakeMaker)
SIGNATURE Public-key signature (added by MakeMaker)
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/META.yml?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/META.yml (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/META.yml Wed Jul 14 11:42:39 2010
@@ -1,17 +1,25 @@
--- #YAML:1.0
-name: Data-UUID-LibUUID
-version: 0.04
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
- asa: 0
- MIME::Base64: 0
- Sub::Exporter: 0
- Test::More: 0
- Test::use::ok: 0
+name: Data-UUID-LibUUID
+version: 0.05
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ asa: 0
+ MIME::Base64: 0
+ Sub::Exporter: 0
+ Test::More: 0
+ Test::use::ok: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.56
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/Makefile.PL?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/Makefile.PL (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/Makefile.PL Wed Jul 14 11:42:39 2010
@@ -27,7 +27,7 @@
# Or CPAN::Reporter reports a failure
unlink("Makefile");
- exit 1;
+ exit 0; # not a fail
}
use File::Spec;
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/SIGNATURE?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/SIGNATURE (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/SIGNATURE Wed Jul 14 11:42:39 2010
@@ -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.62.
To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:
@@ -14,22 +14,23 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 4c69e341de1e7f60882a46701a5c147bc7cb8e39 Changes
-SHA1 1bee5dedcb8274f3b0808ecd1322acb3e0952bac LibUUID.xs
-SHA1 f10439a93d9237d88a8c7bfd3885922d3aaf7f50 MANIFEST
+SHA1 c8bf94d54b066531e4553e924b33c19b582bf1a5 Changes
+SHA1 101a211fa9ce4133ae9bca6c3488523789bc9e3c LibUUID.xs
+SHA1 ed6c4f57717b82e2eda3caac74c992c2361a144e MANIFEST
SHA1 71848a36b89aa4332d4f3e26388f6ecc02fe4267 MANIFEST.SKIP
-SHA1 70838e47983347693b3743b24ab4009e93f174c4 META.yml
-SHA1 eea3384867b991b9cea746b431439b6e126ae73c Makefile.PL
+SHA1 4b7b52ea635cc8fe746f429195d2adef69e8d00f META.yml
+SHA1 3ea2471565b6c4e77386cadd3ebffa19d12bd3d2 Makefile.PL
SHA1 137d832a046a3aebd9f2b8f645ff4009c1f6a848 hdr_check.h
-SHA1 2e65e11752d92ecd1675dbda7525d8d9d54c3f24 lib/Data/UUID/LibUUID.pm
+SHA1 44a30985d552b26f522572aee16204195908ad2b lib/Data/UUID/LibUUID.pm
SHA1 cc657ce59a19cfc4daa4a071545bf7873d827337 lib/Data/UUID/LibUUID/DataUUIDCompat.pm
SHA1 6f942a3aa4b7201650bbc0cc2a3b3b6ca3b6a14c ppport.h
-SHA1 f9c6d98d5affaad8c9eff5843b4cec33fa23f841 t/basic.t
+SHA1 c160cfa4e76929d52995be9efeff7ae96a1ba8ac t/basic.t
SHA1 fa272c9714cd59ee228b77f614e8267dad9729c9 t/compat.t
+SHA1 6ac7e4f126efc052af0cfe3f2aaa5b9e6b7d3a7c t/fork.t
-----BEGIN PGP SIGNATURE-----
-Version: GnuPG v1.4.7 (Darwin)
+Version: GnuPG/MacGPG2 v2.0.12 (Darwin)
-iD8DBQFIkElwVCwRwOvSdBgRAnljAKCiwhjlVsMrWhdWBtMtdCNxUCjugACcCRZB
-7rU1tiM73v1C+Fvcxhqvro4=
-=l09Q
+iEYEARECAAYFAkwx4aMACgkQVCwRwOvSdBiMTgCgpv/ZojFfATa1mkc5TtjnsO4u
+ioQAmgKX1duqHZ0gotlnFm7Ne2SIdk3A
+=c7s8
-----END PGP SIGNATURE-----
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/lib/Data/UUID/LibUUID.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/lib/Data/UUID/LibUUID.pm?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/lib/Data/UUID/LibUUID.pm (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/lib/Data/UUID/LibUUID.pm Wed Jul 14 11:42:39 2010
@@ -6,7 +6,9 @@
use vars qw($VERSION @ISA);
-$VERSION = '0.04';
+$VERSION = '0.05';
+
+use Time::HiRes ();
use Sub::Exporter -setup => {
exports => [qw(
@@ -17,6 +19,10 @@
uuid_eq uuid_compare
new_dce_uuid_string new_dce_uuid_binary
+
+ new_uuid_str new_uuid_bin new_dce_uuid_bin new_dce_uuid_str
+
+ ascending_ident
)],
groups => {
default => [qw(new_uuid_string new_uuid_binary uuid_eq)],
@@ -44,6 +50,36 @@
MIME::Base64::encode_base64(uuid_to_binary($_[0]), '');
}
+my ( $last_s, $last_us, $i ) = ( 0, 0 );
+sub ascending_ident {
+ my ( $s, $us ) = Time::HiRes::gettimeofday;
+
+ # usec is at most 20 bits (log 2 of 1 million), so we truncate the bottom 4
+ # and use only 16 bits, with 16 more bits for a counter. decent hardware
+ # can generate several of these per usec, bot not 65 thousand per 16 usecs =)
+
+ # without $i but with a full 20 bits identifiers would be merely
+ # monotonically increasing
+
+ my $trunc_us = $us >> 4;
+
+ if ( $last_us != $trunc_us or $last_s != $s ) {
+ # the timer has increased, we can reset the counter
+ $i = 0;
+ $last_us = $trunc_us;
+ $last_s = $s;
+ } else {
+ # increment the timer, but truncate it to 16 bits
+
+ # i've never seen it actually bigger than 2 so that gives a margin of
+ # about 5 orders of magnitude. Hopefully Moore's law doesn't get me ;-)
+
+ $i = $i+1 % 0xffff;
+ }
+
+ unpack("H*",pack("Nnn", $s, $trunc_us, $i)) . '-' . new_uuid_string();
+}
+
__PACKAGE__
__END__
@@ -52,7 +88,8 @@
=head1 NAME
-Data::UUID::LibUUID - F<uuid.h> based UUID generation (versions 1, 2 and 4)
+Data::UUID::LibUUID - F<uuid.h> based UUID generation (versions 2 and 4
+depending on platform)
=head1 SYNOPSIS
@@ -75,16 +112,21 @@
Returns a new UUID in string (dash separated hex) or binary (16 octets) format.
-C<$version> can be 1, 2, or 4 and defaults to 2.
+C<$version> can be either 2, or 4 and defaults to whatever the underlying
+implementation prefers.
Version 1 is timestamp/MAC based UUIDs, like L<Data::UUID> provides. They
reveal time and host information, so they may be considered a security risk.
Version 2 is described here
-L<http://www.opengroup.org/onlinepubs/9696989899/chap5.htm#tagcjh_08_02_01_01>
+L<http://www.opengroup.org/onlinepubs/9696989899/chap5.htm#tagcjh_08_02_01_01>.
+It is similar to version 1 but considered more secure.
Version 4 is based just on random data. This is not guaranteed to be high
-quality random data.
+quality random data, but usually is supposed to be.
+
+On MacOS X C<getpid> is called before UUID generation, to ensure UUIDs are
+unique accross forks. Behavior on other platforms may vary.
=item uuid_to_binary $str_or_bin
@@ -132,6 +174,21 @@
This allows the ID generation code to be subclassed, but still keeps the hassle
down to a minimum. DCE is UUID version two specification.
+=item ascending_ident
+
+Creates a lexically ascending identifier containing a UUID, high resolution
+timestamp, and a counter.
+
+This is not a UUID (it's longer), but if you can store variable length
+identifier (and exposing the system clock is not an issue) they can be used to
+create an identifier that is both universally unique, and lexically
+increasing.
+
+Note that while the identifiers are universally unique, there is no universal
+ordering (that would require synchronization), so identifiers generated on
+different machines or even different process/thread could have IDs which
+interleave.
+
=back
=head1 TODO
Modified: branches/upstream/libdata-uuid-libuuid-perl/current/t/basic.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/t/basic.t?rev=60290&op=diff
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/t/basic.t (original)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/t/basic.t Wed Jul 14 11:42:39 2010
@@ -2,7 +2,7 @@
use strict;
-use Test::More tests => 46;
+use Test::More tests => 47;
use ok 'Data::UUID::LibUUID' => ":all";
@@ -12,9 +12,10 @@
is( length(new_uuid_string($version)), 36, "new_uuid_string($version)" );
}
-my ( $t1, $t2 ) = map { unpack("N",new_uuid_binary(1)) } 1 .. 2;
+# doesn't pass on all platforms
+#my ( $t1, $t2 ) = map { unpack("N",new_uuid_binary(1)) } 1 .. 2;
-cmp_ok( $t1 - $t2, '<=', 1, "time based UUIDs have close prefix" );
+#cmp_ok( $t1 - $t2, '<=', 1, "time based UUIDs have close prefix" );
my $bin = new_uuid_binary();
is( length($bin), 16, "binary UUID" );
@@ -101,3 +102,18 @@
is( uuid_to_binary($base64), $bin, "uuid_to_binary(base64)");
}
+
+{
+ my @idents = map { ascending_ident } 1 .. 200;
+
+ is_deeply(
+ [ @idents ],
+ [ sort @idents ],
+ "identifiers are increasing",
+ );
+
+ my %seen;
+ my @uniq = grep { !$seen{$_}++ } map { substr($_, 0, 16) } @idents;
+
+ is( scalar(@uniq), scalar(@idents), "strictly increasing, not just monotonically" );
+}
Added: branches/upstream/libdata-uuid-libuuid-perl/current/t/fork.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-uuid-libuuid-perl/current/t/fork.t?rev=60290&op=file
==============================================================================
--- branches/upstream/libdata-uuid-libuuid-perl/current/t/fork.t (added)
+++ branches/upstream/libdata-uuid-libuuid-perl/current/t/fork.t Wed Jul 14 11:42:39 2010
@@ -1,0 +1,44 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+ use File::Spec;
+ if ( File::Spec->isa("File::Spec::Unix") ) {
+ plan 'no_plan';
+ } else {
+ plan skip_all => "not running on something UNIXish";
+ }
+}
+
+
+use ok 'Data::UUID::LibUUID' => ":all";
+
+for ( 1 .. 2 ) {
+ my @uuids;
+
+ foreach my $child ( 1 .. 3 ) {
+ my $pid = open my $handle, "-|";
+ die $! unless defined $pid;
+
+ if ( $pid ) {
+ push @uuids, <$handle>;
+ close $handle;
+ } else {
+ print new_uuid_string();
+ exit;
+ }
+ }
+
+ push @uuids, new_uuid_string();
+
+ while ( @uuids ) {
+ my $str = shift @uuids;
+ isnt( $str, $_ ) for @uuids;
+ }
+}
+
+
More information about the Pkg-perl-cvs-commits
mailing list