Digest-MD4
view release on metacpan or search on metacpan
*d++ = base64[c1>>2];
if (from == end) {
*d++ = base64[(c1 & 0x3) << 4];
break;
}
c2 = *from++;
c3 = *from++;
*d++ = base64[((c1 & 0x3) << 4) | ((c2 & 0xF0) >> 4)];
*d++ = base64[((c2 & 0xF) << 2) | ((c3 & 0xC0) >>6)];
*d++ = base64[c3 & 0x3F];
}
*d = '\0';
return to;
}
/* Formats */
#define F_BIN 0
#define F_HEX 1
#define F_B64 2
static SV* make_mortal_sv(const unsigned char *src, int type)
{
STRLEN len;
char result[33];
char *ret;
switch (type) {
case F_BIN:
ret = (char*)src;
len = 16;
break;
case F_HEX:
ret = hex_16(src, result);
len = 32;
break;
case F_B64:
ret = base64_16(src, result);
len = 22;
break;
default:
croak("Bad convertion type (%d)", type);
break;
}
return sv_2mortal(newSVpv(ret,len));
}
/********************************************************************/
typedef PerlIO* InputStream;
MODULE = Digest::MD4 PACKAGE = Digest::MD4
PROTOTYPES: DISABLE
void
new(xclass)
SV* xclass
PREINIT:
MD4_CTX* context;
PPCODE:
if (!SvROK(xclass)) {
STRLEN my_na;
char *sclass = SvPV(xclass, my_na);
New(55, context, 1, MD4_CTX);
context->signature = MD4_CTX_SIGNATURE;
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), sclass, (void*)context);
SvREADONLY_on(SvRV(ST(0)));
} else {
context = get_md4_ctx(xclass);
}
MD4Init(context);
XSRETURN(1);
void
clone(self)
SV* self
PREINIT:
MD4_CTX* cont = get_md4_ctx(self);
const char *myname = sv_reftype(SvRV(self),TRUE);
MD4_CTX* context;
PPCODE:
New(55, context, 1, MD4_CTX);
ST(0) = sv_newmortal();
sv_setref_pv(ST(0), myname , (void*)context);
SvREADONLY_on(SvRV(ST(0)));
memcpy(context,cont,sizeof(MD4_CTX));
XSRETURN(1);
void
DESTROY(context)
MD4_CTX* context
CODE:
Safefree(context);
void
add(self, ...)
SV* self
PREINIT:
MD4_CTX* context = get_md4_ctx(self);
int i;
unsigned char *data;
STRLEN len;
PPCODE:
for (i = 1; i < items; i++) {
data = (unsigned char *)(SvPVbyte(ST(i), len));
MD4Update(context, data, len);
}
XSRETURN(1); /* self */
void
addfile(self, fh)
SV* self
InputStream fh
PREINIT:
MD4_CTX* context = get_md4_ctx(self);
STRLEN fill = (context->count[0] >> 3) & 0x3F;
unsigned char buffer[4096];
int n;
CODE:
if (fh) {
if (fill) {
/* The MD4Update() function is faster if it can work with
* complete blocks. This will fill up any buffered block
* first.
*/
STRLEN missing = 64 - fill;
if ( (n = PerlIO_read(fh, buffer, missing)) > 0)
MD4Update(context, buffer, n);
else
XSRETURN(1); /* self */
}
/* Process blocks until EOF or error */
while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
MD4Update(context, buffer, n);
}
if (PerlIO_error(fh)) {
croak("Reading from filehandle failed");
}
}
else {
croak("No filehandle passed");
}
XSRETURN(1); /* self */
void
digest(context)
MD4_CTX* context
ALIAS:
Digest::MD4::digest = F_BIN
Digest::MD4::hexdigest = F_HEX
Digest::MD4::b64digest = F_B64
PREINIT:
unsigned char digeststr[16];
PPCODE:
MD4Final(digeststr, context);
MD4Init(context); /* In case it is reused */
ST(0) = make_mortal_sv(digeststr, ix);
XSRETURN(1);
void
md4(...)
ALIAS:
Digest::MD4::md4 = F_BIN
Digest::MD4::md4_hex = F_HEX
Digest::MD4::md4_base64 = F_B64
PREINIT:
MD4_CTX ctx;
int i;
unsigned char *data;
STRLEN len;
unsigned char digeststr[16];
PPCODE:
MD4Init(&ctx);
if (DOWARN) {
char *msg = 0;
if (items == 1) {
if (SvROK(ST(0))) {
SV* sv = SvRV(ST(0));
if (SvOBJECT(sv) && strEQ(HvNAME(SvSTASH(sv)), "Digest::MD4"))
msg = "probably called as method";
else
msg = "called with reference argument";
}
}
else if (items > 1) {
data = (unsigned char *)SvPVbyte(ST(0), len);
if (len == 11 && memEQ("Digest::MD4", data, 11)) {
msg = "probably called as class method";
}
}
if (msg) {
char *f = (ix == F_BIN) ? "md4" :
(ix == F_HEX) ? "md4_hex" : "md4_base64";
warn("&Digest::MD4::%s function %s", f, msg);
}
}
for (i = 0; i < items; i++) {
data = (unsigned char *)(SvPVbyte(ST(i), len));
MD4Update(&ctx, data, len);
}
MD4Final(digeststr, &ctx);
ST(0) = make_mortal_sv(digeststr, ix);
XSRETURN(1);
( run in 3.570 seconds using v1.01-cache-2.11-cpan-71847e10f99 )