}
#endif
-#ifndef PERL_VERSION
-# include <patchlevel.h>
-# if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL)))
-# include <could_not_find_Perl_patchlevel.h>
-# endif
-# define PERL_REVISION 5
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
#endif
-#if PERL_VERSION <= 4 && !defined(PL_dowarn)
- #define PL_dowarn dowarn
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
#endif
-#ifdef G_WARN_ON
- #define DOWARN (PL_dowarn & G_WARN_ON)
-#else
- #define DOWARN PL_dowarn
+#ifndef Newxz
+# define Newxz(v,n,t) Newz(0,v,n,t)
#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
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, mg) (SvMAGIC(sv) = (mg))
+#endif
+
+#ifndef sv_magicext
+# define sv_magicext(sv, obj, type, vtbl, name, namlen) \
+ THX_sv_magicext(aTHX_ sv, obj, type, vtbl, name, namlen)
+static MAGIC *THX_sv_magicext(pTHX_ SV *sv, SV *obj, int type,
+ MGVTBL const *vtbl, char const *name, I32 namlen)
+{
+ MAGIC *mg;
+ if (obj || namlen)
+ /* exceeded intended usage of this reserve implementation */
+ return NULL;
+ Newxz(mg, 1, MAGIC);
+ mg->mg_virtual = (MGVTBL*)vtbl;
+ mg->mg_type = type;
+ mg->mg_ptr = (char *)name;
+ mg->mg_len = -1;
+ (void) SvUPGRADE(sv, SVt_PVMG);
+ mg->mg_moremagic = SvMAGIC(sv);
+ SvMAGIC_set(sv, mg);
+ SvMAGICAL_off(sv);
+ mg_magical(sv);
+ return mg;
+}
#endif
-#ifndef dTHX
- #define pTHX_
- #define aTHX_
+#if PERL_VERSION < 8
+# undef SvPVbyte
+# define SvPVbyte(sv, lp) (sv_utf8_downgrade((sv), 0), SvPV((sv), (lp)))
#endif
/* Perl does not guarantee that U32 is exactly 32 bits. Some system
((U32)(*(s+3)) << 24))
#endif
-#define MD5_CTX_SIGNATURE 200003165
-
-/* This stucture keeps the current state of algorithm.
+/* This structure 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;
+#if defined(USE_ITHREADS) && defined(MGf_DUP)
+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
+
+#if defined(MGf_DUP) && defined(USE_ITHREADS)
+STATIC const MGVTBL vtbl_md5 = {
+ NULL, /* get */
+ NULL, /* set */
+ NULL, /* len */
+ NULL, /* clear */
+ NULL, /* free */
+ NULL, /* copy */
+ dup_md5_ctx, /* dup */
+ NULL /* local */
+};
+#else
+/* declare as 5 member, not normal 8 to save image space*/
+STATIC const struct {
+ int (*svt_get)(SV* sv, MAGIC* mg);
+ int (*svt_set)(SV* sv, MAGIC* mg);
+ U32 (*svt_len)(SV* sv, MAGIC* mg);
+ int (*svt_clear)(SV* sv, MAGIC* mg);
+ int (*svt_free)(SV* sv, MAGIC* mg);
+} vtbl_md5 = {
+ NULL, NULL, NULL, NULL, NULL
+};
+#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
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 == (const MGVTBL * const)&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, (const MGVTBL * const)&vtbl_md5, (const char *)context, 0);
+
+#if defined(USE_ITHREADS) && defined(MGf_DUP)
+ mg->mg_flags |= MGf_DUP;
+#endif
+
+ return obj;
+}
+
static char* hex_16(const unsigned char* from, char* to)
{
len = 22;
break;
default:
- croak("Bad convertion type (%d)", type);
+ croak("Bad conversion type (%d)", type);
break;
}
return sv_2mortal(newSVpv(ret,len));
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
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);
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 */
XSRETURN(1);
void
+context(ctx, ...)
+ MD5_CTX* ctx
+ PREINIT:
+ char out[16];
+ U32 w;
+ PPCODE:
+ if (items > 2) {
+ STRLEN len;
+ unsigned long blocks = SvUV(ST(1));
+ unsigned char *buf = (unsigned char *)(SvPV(ST(2), len));
+ ctx->A = buf[ 0] | (buf[ 1]<<8) | (buf[ 2]<<16) | (buf[ 3]<<24);
+ ctx->B = buf[ 4] | (buf[ 5]<<8) | (buf[ 6]<<16) | (buf[ 7]<<24);
+ ctx->C = buf[ 8] | (buf[ 9]<<8) | (buf[10]<<16) | (buf[11]<<24);
+ ctx->D = buf[12] | (buf[13]<<8) | (buf[14]<<16) | (buf[15]<<24);
+ ctx->bytes_low = blocks << 6;
+ ctx->bytes_high = blocks >> 26;
+ if (items == 4) {
+ buf = (unsigned char *)(SvPV(ST(3), len));
+ MD5Update(ctx, buf, len);
+ }
+ XSRETURN(1); /* ctx */
+ } else if (items != 1) {
+ XSRETURN(0);
+ }
+
+ w=ctx->A; out[ 0]=w; out[ 1]=(w>>8); out[ 2]=(w>>16); out[ 3]=(w>>24);
+ w=ctx->B; out[ 4]=w; out[ 5]=(w>>8); out[ 6]=(w>>16); out[ 7]=(w>>24);
+ w=ctx->C; out[ 8]=w; out[ 9]=(w>>8); out[10]=(w>>16); out[11]=(w>>24);
+ w=ctx->D; out[12]=w; out[13]=(w>>8); out[14]=(w>>16); out[15]=(w>>24);
+
+ EXTEND(SP, 3);
+ ST(0) = sv_2mortal(newSVuv(ctx->bytes_high << 26 |
+ ctx->bytes_low >> 6));
+ ST(1) = sv_2mortal(newSVpv(out, 16));
+ ST(2) = sv_2mortal(newSVpv((char *)ctx->buffer,
+ ctx->bytes_low & 0x3F));
+ XSRETURN(3);
+
+void
md5(...)
ALIAS:
Digest::MD5::md5 = F_BIN
PPCODE:
MD5Init(&ctx);
- if (DOWARN) {
- char *msg = 0;
+ if ((PL_dowarn & G_WARN_ON) || ckWARN(WARN_SYNTAX)) {
+ const char *msg = 0;
if (items == 1) {
if (SvROK(ST(0))) {
SV* sv = SvRV(ST(0));
- if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
+ char *name;
+ if (SvOBJECT(sv) && (name = HvNAME(SvSTASH(sv)))
+ && strEQ(name, "Digest::MD5"))
msg = "probably called as method";
else
msg = "called with reference argument";
}
}
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";
}
else if (SvROK(ST(0))) {
SV* sv = SvRV(ST(0));
- if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD5"))
+ char *name;
+ if (SvOBJECT(sv) && (name = HvNAME(SvSTASH(sv)))
+ && strEQ(name, "Digest::MD5"))
msg = "probably called as method";
}
}
}
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);
https://perl5.git.perl.org / perl5.git / blobdiff