From 62d37bf083493a0d8ff9c936e0183377500f804a Mon Sep 17 00:00:00 2001 From: Florian Ragwitz Date: Sun, 26 Sep 2010 00:34:14 +0200 Subject: [PATCH] Upgrade Digest::MD5 from version 2.40 to 2.50 --- MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Digest-MD5/Changes | 20 +++++++ cpan/Digest-MD5/MD5.pm | 2 +- cpan/Digest-MD5/MD5.xs | 143 +++++++++++++++++++++++--------------------- cpan/Digest-MD5/Makefile.PL | 5 +- cpan/Digest-MD5/README | 2 +- cpan/Digest-MD5/t/files.t | 8 +-- cpan/Digest-MD5/t/threads.t | 24 ++++++++ cpan/Digest-MD5/t/utf8.t | 20 ++++++- pod/perldelta.pod | 6 ++ 11 files changed, 155 insertions(+), 78 deletions(-) create mode 100644 cpan/Digest-MD5/t/threads.t diff --git a/MANIFEST b/MANIFEST index c16eaf5..d1be5fe 100644 --- a/MANIFEST +++ b/MANIFEST @@ -608,6 +608,7 @@ cpan/Digest-MD5/t/bits.t See if Digest::MD5 extension works cpan/Digest-MD5/t/clone.t See if Digest::MD5 extension works cpan/Digest-MD5/t/files.t See if Digest::MD5 extension works cpan/Digest-MD5/t/md5-aaa.t See if Digest::MD5 extension works +cpan/Digest-MD5/t/threads.t See if Digest::MD5 extension works cpan/Digest-MD5/t/utf8.t See if Digest::MD5 extension works cpan/Digest-MD5/typemap Digest::MD5 extension cpan/Digest-SHA/Changes Digest::SHA changes diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index de6d64b..f50c19f 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -475,7 +475,7 @@ use File::Glob qw(:case); 'Digest::MD5' => { 'MAINTAINER' => 'gaas', - 'DISTRIBUTION' => 'GAAS/Digest-MD5-2.40.tar.gz', + 'DISTRIBUTION' => 'GAAS/Digest-MD5-2.50.tar.gz', 'FILES' => q[cpan/Digest-MD5], 'EXCLUDED' => [ qw{rfc1321.txt} ], 'UPSTREAM' => "cpan", diff --git a/cpan/Digest-MD5/Changes b/cpan/Digest-MD5/Changes index 756716c..10e98b7 100644 --- a/cpan/Digest-MD5/Changes +++ b/cpan/Digest-MD5/Changes @@ -1,3 +1,23 @@ +2010-09-25 Gisle Aas + + Release 2.50 + + Chris 'BinGOs' Williams (1): + Amended tests to work with perl core. + + Florian Ragwitz (3): + Attach context pointers using sv magic + Add failing test for thread cloning + Clone MD5 contexts on thread cloning + + Gisle Aas (1): + perl-5.6 no longer supported + + Jesse Vincent (1): + Preserve utf8ness of argument [RT#44927] + + + 2010-07-03 Gisle Aas Release 2.40 diff --git a/cpan/Digest-MD5/MD5.pm b/cpan/Digest-MD5/MD5.pm index ca17ad4..978eefa 100644 --- a/cpan/Digest-MD5/MD5.pm +++ b/cpan/Digest-MD5/MD5.pm @@ -3,7 +3,7 @@ package Digest::MD5; use strict; use vars qw($VERSION @ISA @EXPORT_OK); -$VERSION = '2.40'; +$VERSION = '2.50'; require Exporter; *import = \&Exporter::import; diff --git a/cpan/Digest-MD5/MD5.xs b/cpan/Digest-MD5/MD5.xs index 89e39d2..ac36b05 100644 --- a/cpan/Digest-MD5/MD5.xs +++ b/cpan/Digest-MD5/MD5.xs @@ -43,50 +43,6 @@ extern "C" { } #endif -#ifndef PERL_VERSION -# include -# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) -# include -# endif -# define PERL_REVISION 5 -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION -#endif - -#if PERL_VERSION <= 4 && !defined(PL_dowarn) - #define PL_dowarn dowarn -#endif - -#ifdef G_WARN_ON - #define DOWARN (PL_dowarn & G_WARN_ON) -#else - #define DOWARN PL_dowarn -#endif - -#ifdef SvPVbyte - #if PERL_REVISION == 5 && PERL_VERSION < 7 - /* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */ - #undef SvPVbyte - #define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp)) - - static char * - my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp) - { - sv_utf8_downgrade(sv,0); - return SvPV(sv,*lp); - } - #endif -#else - #define SvPVbyte SvPV -#endif - -#ifndef dTHX - #define pTHX_ - #define aTHX_ -#endif - /* Perl does not guarantee that U32 is exactly 32 bits. Some system * has no integral type with exactly 32 bits. For instance, A Cray has * short, int and long all at 64 bits so we need to apply this macro @@ -133,18 +89,48 @@ static void u2s(U32 u, U8* s) ((U32)(*(s+3)) << 24)) #endif -#define MD5_CTX_SIGNATURE 200003165 - /* This stucture keeps the current state of algorithm. */ typedef struct { - U32 signature; /* safer cast in get_md5_ctx() */ U32 A, B, C, D; /* current digest */ U32 bytes_low; /* counts bytes in message */ U32 bytes_high; /* turn it into a 64-bit counter */ U8 buffer[128]; /* collect complete 64 byte blocks */ } MD5_CTX; +#ifdef USE_ITHREADS +STATIC int dup_md5_ctx(pTHX_ MAGIC *mg, CLONE_PARAMS *params) +{ + MD5_CTX *new_ctx; + PERL_UNUSED_VAR(params); + New(55, new_ctx, 1, MD5_CTX); + memcpy(new_ctx, mg->mg_ptr, sizeof(MD5_CTX)); + mg->mg_ptr = (char *)new_ctx; + return 0; +} +#endif + +STATIC MGVTBL vtbl_md5 = { + NULL, /* get */ + NULL, /* set */ + NULL, /* len */ + NULL, /* clear */ + NULL, /* free */ +#ifdef MGf_COPY + NULL, /* copy */ +#endif +#ifdef MGf_DUP +# ifdef USE_ITHREADS + dup_md5_ctx, +# else + NULL, /* dup */ +# endif +#endif +#ifdef MGf_LOCAL + NULL /* local */ +#endif +}; + /* Padding is added at the end of the message in order to fill a * complete 64 byte block (- 8 bytes for the message length). The @@ -466,19 +452,43 @@ MD5Final(U8* digest, MD5_CTX *ctx) static MD5_CTX* get_md5_ctx(pTHX_ SV* sv) { - if (SvROK(sv)) { - sv = SvRV(sv); - if (SvIOK(sv)) { - MD5_CTX* ctx = INT2PTR(MD5_CTX*, SvIV(sv)); - if (ctx && ctx->signature == MD5_CTX_SIGNATURE) { - return ctx; - } - } + MAGIC *mg; + + if (!sv_derived_from(sv, "Digest::MD5")) + croak("Not a reference to a Digest::MD5 object"); + + for (mg = SvMAGIC(SvRV(sv)); mg; mg = mg->mg_moremagic) { + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &vtbl_md5) { + return (MD5_CTX *)mg->mg_ptr; + } } - croak("Not a reference to a Digest::MD5 object"); + + croak("Failed to get MD5_CTX pointer"); return (MD5_CTX*)0; /* some compilers insist on a return value */ } +static SV * new_md5_ctx(pTHX_ MD5_CTX *context, const char *klass) +{ + SV *sv = newSV(0); + SV *obj = newRV_noinc(sv); +#ifdef USE_ITHREADS + MAGIC *mg; +#endif + + sv_bless(obj, gv_stashpv(klass, 0)); + +#ifdef USE_ITHREADS + mg = +#endif + sv_magicext(sv, NULL, PERL_MAGIC_ext, &vtbl_md5, (void *)context, 0); + +#ifdef USE_ITHREADS + mg->mg_flags |= MGf_DUP; +#endif + + return obj; +} + static char* hex_16(const unsigned char* from, char* to) { @@ -568,16 +578,13 @@ new(xclass) PPCODE: if (!SvROK(xclass)) { STRLEN my_na; - char *sclass = SvPV(xclass, my_na); + const char *sclass = SvPV(xclass, my_na); New(55, context, 1, MD5_CTX); - context->signature = MD5_CTX_SIGNATURE; - ST(0) = sv_newmortal(); - sv_setref_pv(ST(0), sclass, (void*)context); - SvREADONLY_on(SvRV(ST(0))); + ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, sclass)); } else { context = get_md5_ctx(aTHX_ xclass); } - MD5Init(context); + MD5Init(context); XSRETURN(1); void @@ -589,9 +596,7 @@ clone(self) MD5_CTX* context; PPCODE: New(55, context, 1, MD5_CTX); - ST(0) = sv_newmortal(); - sv_setref_pv(ST(0), myname , (void*)context); - SvREADONLY_on(SvRV(ST(0))); + ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, myname)); memcpy(context,cont,sizeof(MD5_CTX)); XSRETURN(1); @@ -611,8 +616,10 @@ add(self, ...) STRLEN len; PPCODE: for (i = 1; i < items; i++) { + U32 had_utf8 = SvUTF8(ST(i)); data = (unsigned char *)(SvPVbyte(ST(i), len)); MD5Update(context, data, len); + if (had_utf8) sv_utf8_upgrade(ST(i)); } XSRETURN(1); /* self */ @@ -693,7 +700,7 @@ md5(...) PPCODE: MD5Init(&ctx); - if (DOWARN) { + if (PL_dowarn & G_WARN_ON) { const char *msg = 0; if (items == 1) { if (SvROK(ST(0))) { @@ -705,7 +712,7 @@ md5(...) } } else if (items > 1) { - data = (unsigned char *)SvPVbyte(ST(0), len); + data = (unsigned char *)SvPV(ST(0), len); if (len == 11 && memEQ("Digest::MD5", data, 11)) { msg = "probably called as class method"; } @@ -723,8 +730,10 @@ md5(...) } for (i = 0; i < items; i++) { + U32 had_utf8 = SvUTF8(ST(i)); data = (unsigned char *)(SvPVbyte(ST(i), len)); MD5Update(&ctx, data, len); + if (had_utf8) sv_utf8_upgrade(ST(i)); } MD5Final(digeststr, &ctx); ST(0) = make_mortal_sv(aTHX_ digeststr, ix); diff --git a/cpan/Digest-MD5/Makefile.PL b/cpan/Digest-MD5/Makefile.PL index f8fd182..69b2ed0 100644 --- a/cpan/Digest-MD5/Makefile.PL +++ b/cpan/Digest-MD5/Makefile.PL @@ -16,7 +16,6 @@ if ($^O eq 'VMS') { } } -push(@extra, 'INSTALLDIRS' => 'perl') if $] >= 5.008; WriteMakefile( 'NAME' => 'Digest::MD5', @@ -24,7 +23,7 @@ WriteMakefile( 'ABSTRACT' => 'Perl interface to the MD-5 algorithm', 'AUTHOR' => 'Gisle Aas ', 'LICENSE' => 'perl', - 'MIN_PERL_VERSION' => 5.006, + 'MIN_PERL_VERSION' => 5.008, 'PREREQ_PM' => { 'File::Spec' => 0, 'Digest::base' => '1.00', 'XSLoader' => 0, @@ -32,8 +31,8 @@ WriteMakefile( 'META_MERGE' => { repository => 'http://github.com/gisle/digest-md5', }, + 'INSTALLDIRS' => 'perl', @extra, - 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, ); diff --git a/cpan/Digest-MD5/README b/cpan/Digest-MD5/README index 3c48079..45c3658 100644 --- a/cpan/Digest-MD5/README +++ b/cpan/Digest-MD5/README @@ -4,7 +4,7 @@ algorithm takes as input a message of arbitrary length and produces as output a 128-bit "fingerprint" or "message digest" of the input. MD5 is described in RFC 1321. -You will need perl version 5.6 or better to install this module. +You will need perl version 5.8 or better to install this module. Copyright 1998-2003 Gisle Aas. Copyright 1995-1996 Neil Winton. diff --git a/cpan/Digest-MD5/t/files.t b/cpan/Digest-MD5/t/files.t index 54cf4f4..854e76f 100644 --- a/cpan/Digest-MD5/t/files.t +++ b/cpan/Digest-MD5/t/files.t @@ -13,15 +13,15 @@ use Digest::MD5 qw(md5 md5_hex md5_base64); my $EXPECT; if (ord "A" == 193) { # EBCDIC $EXPECT = < 'Perl compiled without ithreads' + unless $Config{useithreads}; + plan tests => 2; +} + +use threads; +use Digest::MD5; + +my $module = 'Digest::MD5'; + +my $obj = $module->new; +$obj->add("foo"); +my $tdigest = threads->create(sub { $obj->add("bar"); $obj->hexdigest })->join; + +isnt $obj->clone->hexdigest, $tdigest, "unshared object unaffected by the thread"; + +$obj->add("bar"); +is $obj->clone->hexdigest, $tdigest; diff --git a/cpan/Digest-MD5/t/utf8.t b/cpan/Digest-MD5/t/utf8.t index 6cf68b7..cb53f57 100644 --- a/cpan/Digest-MD5/t/utf8.t +++ b/cpan/Digest-MD5/t/utf8.t @@ -7,7 +7,7 @@ BEGIN { } } -print "1..3\n"; +print "1..5\n"; use strict; use Digest::MD5 qw(md5_hex); @@ -33,3 +33,21 @@ print "ok 2\n"; # reference print "not " unless md5_hex("foo\xFF") eq $exp; print "ok 3\n"; + +# autopromotion +if ($] >= 5.007003) { + +my $unistring = "Oslo.pm har sosialt medlemsmøte onsdag 1. April 2008, klokken 18:30. Vi treffes på Marhaba Café, Keysersgate 1."; + +require Encode; +$unistring = Encode::decode_utf8($unistring); +print "not " if ( not utf8::is_utf8($unistring)); +print "ok 4\n"; + +md5_hex($unistring, ""); +print "not " if ( not utf8::is_utf8($unistring)); +print "ok 5\n" + +} else { + print "ok 4 # SKIP Your perl is too old to properly test unicode semantics\nok 5 # SKIP No, really\n"; +} diff --git a/pod/perldelta.pod b/pod/perldelta.pod index f1663c3..8bd549b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -169,6 +169,12 @@ XXX =item * +C has been upgraded from version 2.40 to 2.50. + +It is now safe to use this module in combination with threads. + +=item * + C has been upgraded from version 1.02 to 1.03. It allows patterns containing literal parentheses (they no longer need to -- 1.8.3.1