view release on metacpan or  search on metacpan

MD5.xs  view on Meta::CPAN

    while (1) {
        c1 = *from++;
        *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(pTHX_ 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 conversion type (%d)", type);
        break;
    }
    return sv_2mortal(newSVpv(ret,len));
}

typedef PerlIO* InputStream;

MODULE = Digest::MD5   PACKAGE = Digest::MD5

PROTOTYPES: DISABLE

void
new(xclass)
        SV* xclass
    PREINIT:
        MD5_COMPAT_CTX* context;
    PPCODE:
        if (!SvROK(xclass)) {
            STRLEN my_na;
            const char *sclass = SvPV(xclass, my_na);
            New(55, context, 1, MD5_COMPAT_CTX);
            ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, sclass));
        } else {
            context = get_md5_ctx(aTHX_ xclass);
        }
        md5_init(context);
        XSRETURN(1);

void
addfile(self, fh)
    SV* self
    InputStream fh
    PREINIT:
        MD5_COMPAT_CTX* context = get_md5_ctx(aTHX_ self);
        STRLEN fill = context->Nl & 0x3F;
#ifdef USE_HEAP_INSTEAD_OF_STACK
        unsigned char* buffer;
#else
        unsigned char buffer[4096];
#endif
        int  n;
    CODE:
        if (fh) {
#ifdef USE_HEAP_INSTEAD_OF_STACK
            New(0, buffer, 4096, unsigned char);
            assert(buffer);
#endif
            if (fill) {
                /* The MD5Update() 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)
                    md5_update(context, buffer, n);
                else
                    XSRETURN(1);  /* self */
            }

            /* Process blocks until EOF or error */
            while ( (n = PerlIO_read(fh, buffer, sizeof(buffer))) > 0) {
                md5_update(context, buffer, n);
            }
#ifdef USE_HEAP_INSTEAD_OF_STACK
            Safefree(buffer);
#endif
            if (PerlIO_error(fh)) {
                croak("Reading from filehandle failed");
            }
        } else {
            croak("No filehandle passed");
        }
        XSRETURN(1);  /* self */

void
clone(self)
        SV* self
    PREINIT:
        MD5_COMPAT_CTX* cont = get_md5_ctx(aTHX_ self);
        const char *myname = sv_reftype(SvRV(self),TRUE);
        MD5_COMPAT_CTX* context;
    PPCODE:
        New(55, context, 1, MD5_COMPAT_CTX);
        ST(0) = sv_2mortal(new_md5_ctx(aTHX_ context, myname));
#if OPENSSL_VERSION_NUMBER >= 0x30000000L
        context->ctx = EVP_MD_CTX_new();
        if (context->ctx == NULL || !EVP_MD_CTX_copy_ex(context->ctx, cont->ctx)) {
            croak("Failed to clone MD5 context");
        }
        context->Nl = cont->Nl;
#else
        memcpy(context, cont, sizeof(MD5_COMPAT_CTX));
#endif
        XSRETURN(1);

void
DESTROY(context)
        MD5_COMPAT_CTX* context
    CODE:
        md5_free(context);
        Safefree(context);

void
add(self, ...)
        SV* self
    PREINIT:
        MD5_COMPAT_CTX* context = get_md5_ctx(aTHX_ self);
        int i;
        unsigned char *data;
        STRLEN len;
    PPCODE:
        for (i = 1; i < items; i++) {
            U32 had_utf8 = SvUTF8(ST(i));
            data = (unsigned char *)(SvPVbyte(ST(i), len));
            md5_update(context, data, len);
            if (had_utf8)
                sv_utf8_upgrade(ST(i));
        }
        XSRETURN(1);  /* self */

void
digest(context)
        MD5_COMPAT_CTX* context
    ALIAS:
        Digest::MD5::digest    = F_BIN
        Digest::MD5::hexdigest = F_HEX
        Digest::MD5::b64digest = F_B64
    PREINIT:
        unsigned char digeststr[16];
    PPCODE:
        md5_final(digeststr, context);
        md5_init(context);  /* In case it is reused */
        ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
        XSRETURN(1);

void
md5(...)
    ALIAS:
        Digest::MD5::md5        = F_BIN
        Digest::MD5::md5_hex    = F_HEX
        Digest::MD5::md5_base64 = F_B64
    PREINIT:
        MD5_COMPAT_CTX context;
        int i;
        unsigned char *data;
        STRLEN len;
        unsigned char digeststr[16];
    PPCODE:
        md5_init(&context);

        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));
                    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 *)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));
                    char *name;
                    if (SvOBJECT(sv) && (name = HvNAME(SvSTASH(sv)))
                                     && strEQ(name, "Digest::MD5"))
                        msg = "probably called as method";
                }
            }
            if (msg) {
                const char *f = (ix == F_BIN) ? "md5" :
                                (ix == F_HEX) ? "md5_hex" : "md5_base64";
                warn("&Digest::MD5::%s function %s", f, msg);
            }
        }

        for (i = 0; i < items; i++) {
            U32 had_utf8 = SvUTF8(ST(i));
            data = (unsigned char *)(SvPVbyte(ST(i), len));
            md5_update(&context, data, len);
            if (had_utf8)
                sv_utf8_upgrade(ST(i));
        }
        md5_final(digeststr, &context);
        md5_free(&context);
        ST(0) = make_mortal_sv(aTHX_ digeststr, ix);
        XSRETURN(1);