/*============================================================================
 *
 * Decrypt/Decrypt.xs
 *
 * DESCRIPTION
 *   C and XS portions of Filter::Crypto::Decrypt module.
 *
 * COPYRIGHT
 *   Copyright (C) 2004-2009, 2012, 2014 Steve Hay.  All rights reserved.
 *
 * LICENCE
 *   This file is free software; you can redistribute it and/or modify it under
 *   the same terms as Perl itself, i.e. under the terms of either the GNU
 *   General Public License or the Artistic License, as specified in the LICENCE
 *   file.
 *
 *============================================================================*/

/*============================================================================
 * C CODE SECTION
 *============================================================================*/

#include "../CryptoCommon-c.inc"

#define FILTER_CRYPTO_FILTER_COUNT \
    (PL_rsfp_filters ? av_len(PL_rsfp_filters) : 0)

typedef enum {
    FILTER_CRYPTO_STATUS_NOT_STARTED,
    FILTER_CRYPTO_STATUS_STARTED,
    FILTER_CRYPTO_STATUS_FINISHED
} FILTER_CRYPTO_STATUS;

typedef struct {
    MAGIC *mg_ptr;
    FILTER_CRYPTO_CCTX *crypto_ctx;
    SV *encrypt_sv;
    SV *decrypt_sv;
    SV *encode_sv;
    int filter_count;
    FILTER_CRYPTO_STATUS filter_status;
} FILTER_CRYPTO_FCTX;

static I32 FilterCrypto_ReadBlock(pTHX_ int idx, SV *sv, int want_size);
static FILTER_CRYPTO_FCTX *FilterCrypto_FilterAlloc(pTHX);
static bool FilterCrypto_FilterInit(pTHX_ FILTER_CRYPTO_FCTX *ctx,
    FILTER_CRYPTO_MODE crypt_mode);
static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static bool FilterCrypto_FilterFinal(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static void FilterCrypto_FilterFree(pTHX_ FILTER_CRYPTO_FCTX *ctx);
static int FilterCrypto_FilterSvMgFree(pTHX_ SV *sv, MAGIC *mg);
static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len);
static bool FilterCrypto_IsDebugPerl(pTHX);
static const char *FilterCrypto_GetErrStr(pTHX);

/* Magic virtual table to have the filter context pointed to by the filter's SV
 * automatically freed when the SV is destroyed. */
static const MGVTBL FilterCrypto_FilterSvMgVTBL = {
    NULL,                           /* Get   */
    NULL,                           /* Set   */
    NULL,                           /* Len   */
    NULL,                           /* Clear */
    FilterCrypto_FilterSvMgFree     /* Free  */
};

/*
 * Function to read exactly want_size bytes (or up to want_size bytes if a read
 * error occurs or EOF is reached) from the specified filter into the given SV.
 * Returns the number of bytes written to the SV, or 0 if EOF was reached before
 * anything was written, or <0 on failure.
 */

static I32 FilterCrypto_ReadBlock(pTHX_ int idx, SV *sv, int want_size) {
    I32 n;
    I32 read_size;

    /* Initialize the number of bytes read to zero. */
    read_size = 0;

    while (1) {
        /* Check if we have read the required number of bytes yet. */
        if (read_size == want_size) {
#ifdef FILTER_CRYPTO_DEBUG_MODE
            FilterCrypto_HexDumpSV(aTHX_ sv,
                "Read %"IVdf" bytes from input stream", (IV)read_size
            );
#endif
            return read_size;
        }

        /* Attempt to read the remaining number of bytes still required. */
        n = FILTER_READ(idx, sv, want_size - read_size);

        /* Check for read errors or EOF. */
        if (n <= 0) {
#ifdef FILTER_CRYPTO_DEBUG_MODE
            FilterCrypto_HexDumpSV(aTHX_ sv,
                "Read %"IVdf" bytes from input stream (%s)",
                (IV)read_size, n < 0 ? "Got read error" : "Reached EOF"
            );
#endif

            if (n < 0)
                FilterCrypto_SetErrStr(aTHX_
                    "Read error on input stream (%"IVdf")\n", (IV)n
                );

            return read_size > 0 ? read_size : n;
        }

#if 0
        if (n < want_size)
            warn("(Read %"IVdf" bytes from input stream)\n", (IV)n);
#endif

        /* Increment read_size by the number of bytes just read. */
        read_size += n;
    }
}

/*
 * Function to allocate a new filter context.
 * Returns a pointer to the allocated structure.
 */

static FILTER_CRYPTO_FCTX *FilterCrypto_FilterAlloc(pTHX) {
    FILTER_CRYPTO_FCTX *ctx;

    /* Allocate the new filter context. */
    Newxz(ctx, 1, FILTER_CRYPTO_FCTX);

    /* Allocate the crypto context. */
    ctx->crypto_ctx = FilterCrypto_CryptoAlloc(aTHX);

    /* Allocate the encrypt, decrypt and encode buffers. */
    ctx->encrypt_sv = newSV(BUFSIZ);
    ctx->decrypt_sv = newSV(BUFSIZ);
    ctx->encode_sv = newSV(BUFSIZ * 2);
    SvPOK_only(ctx->encrypt_sv);
    SvPOK_only(ctx->decrypt_sv);
    SvPOK_only(ctx->encode_sv);

    return ctx;
}

/*
 * Function to initialize the given filter context in the given mode.
 * Returns a bool to indicate success or failure.
 */

static bool FilterCrypto_FilterInit(pTHX_ FILTER_CRYPTO_FCTX *ctx,
    FILTER_CRYPTO_MODE crypt_mode)
{
    /* Initialize the crypto context. */
    if (!FilterCrypto_CryptoInit(aTHX_ ctx->crypto_ctx, crypt_mode))
        return FALSE;

    /* Initialize the encrypt, decrypt and encode buffers. */
    FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);
    FilterCrypto_SvSetCUR(ctx->decrypt_sv, 0);
    FilterCrypto_SvSetCUR(ctx->encode_sv, 0);

    /* Initialize the filter count and status. */
    ctx->filter_count = FILTER_CRYPTO_FILTER_COUNT;
    ctx->filter_status = FILTER_CRYPTO_STATUS_NOT_STARTED;

    return TRUE;
}

/*
 * Function to update the given filter context with encrypted data given in an
 * SV within the filter context.  This data is not assumed to be
 * null-terminated, so the correct length must be set in SvCUR(ctx->encrypt_sv).
 * The decrypted output data will be written into an SV within the filter
 * context.
 * Returns a bool to indicate success or failure.
 */

static bool FilterCrypto_FilterUpdate(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
    return FilterCrypto_CryptoUpdate(aTHX_ ctx->crypto_ctx, ctx->encrypt_sv,
            ctx->decrypt_sv);
}

/*
 * Function to finalize the given filter context.  The decrypted output data
 * will be written into an SV within the filter context.
 * Returns a bool to indicate success or failure.
 */

static bool FilterCrypto_FilterFinal(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
    return FilterCrypto_CryptoFinal(aTHX_ ctx->crypto_ctx, ctx->decrypt_sv);
}

/*
 * Function to free the given filter context.
 */

static void FilterCrypto_FilterFree(pTHX_ FILTER_CRYPTO_FCTX *ctx) {
    /* Free the encode, decrypt and encrypt buffers by decrementing their
     * reference counts (to zero). */
    SvREFCNT_dec(ctx->encode_sv);
    SvREFCNT_dec(ctx->decrypt_sv);
    SvREFCNT_dec(ctx->encrypt_sv);

    /* Free the crypto context. */
    FilterCrypto_CryptoFree(aTHX_ ctx->crypto_ctx);
    ctx->crypto_ctx = NULL;

    /* Free the filter context. */
    Safefree(ctx);
    ctx = NULL;
}

/*
 * Function to free the filter context pointed to by the given MAGIC.
 * Note: This function's signature and return value are determined by the mgvtbl
 * structure in Perl.
 */

static int FilterCrypto_FilterSvMgFree(pTHX_ SV *sv, MAGIC *mg) {
    FILTER_CRYPTO_FCTX *ctx;

    if ((ctx = (FILTER_CRYPTO_FCTX *)(mg->mg_ptr)) && ctx->mg_ptr == mg) {
        FilterCrypto_FilterFree(aTHX_ ctx);
        ctx = NULL;
        mg->mg_ptr = NULL;
    }
    return 1;
}

/*
 * Function to perform the source code decryption filtering.  Data is first read
 * from the input stream into an encode buffer within the filter context
 * containing a plain ASCII encoding of the encrypted data, and then decoded
 * into an encrypt buffer within the filter context.  It is then decrypted into
 * a decrypt buffer within the filter context, and is finally written to the
 * output stream buffer (which is the buf_sv argument).
 * Returns the number of bytes written to the output stream buffer, or 0 if EOF
 * was reached before anything was written, or croak()s on failure.
 * The filter is deleted when the decryption is finished or an error occurs.
 * Note: This function's signature and return value are determined by the
 * Perl_filter_read() function in Perl.  There is a suggestion there that this
 * function should return <0 on failure, but if that were done then the parser
 * is not actually alerted to the failure (S_filter_gets() simply passes it the
 * NULL pointer in that case), so anything previously written to the output
 * stream buffer (and hence passed onto the parser) will be run without
 * informing the user that there is anything wrong.  Instead, as stated above,
 * we simply croak() on failure.  This is on the advice of Paul Marquess on the
 * "perl5-porters" mailing list, 13 Oct 2004.
 */

static I32 FilterCrypto_FilterDecrypt(pTHX_ int idx, SV *buf_sv, int max_len) {
    FILTER_CRYPTO_FCTX *ctx;
    SV *filter_sv = FILTER_DATA(idx);
    MAGIC *mg;
    I32 m;
    I32 n;
    I32 num_bytes;
    const unsigned char *out_ptr;
    const char *nl = "\n";
    char *p;

    /* Recover the filter context pointer that is held within the MAGIC of the
     * filter's SV, and verify that we have found the correct MAGIC. */
    if (!(mg = mg_find(filter_sv, PERL_MAGIC_ext))) {
        filter_del(FilterCrypto_FilterDecrypt);
        croak("Can't find MAGIC in decryption filter's SV");
    }
    if (!(ctx = (FILTER_CRYPTO_FCTX *)(mg->mg_ptr))) {
        filter_del(FilterCrypto_FilterDecrypt);
        croak("Found wrong MAGIC in decryption filter's SV: No valid mg_ptr");
    }
    if (ctx->mg_ptr != mg) {
        filter_del(FilterCrypto_FilterDecrypt);
        croak("Found wrong MAGIC in decryption filter's SV: Wrong mg_ptr "
              "\"signature\"");
    }

    /* Reinitialize the encode and encrypt buffers. */
    FilterCrypto_SvSetCUR(ctx->encode_sv, 0);
    FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);

    /* Check if this is the first time through. */
    if (ctx->filter_status == FILTER_CRYPTO_STATUS_NOT_STARTED) {
#ifdef FILTER_CRYPTO_DEBUG_MODE
        warn("Starting filter\n");
#endif

        /* Mild paranoia mode - ensure that no extra filters have been applied
         * on the same line as our filter. */
        if (FILTER_CRYPTO_FILTER_COUNT > ctx->filter_count) {
            filter_del(FilterCrypto_FilterDecrypt);
            croak("Can't run with extra filters");
        }

        ctx->filter_status = FILTER_CRYPTO_STATUS_STARTED;
    }

    while (1) {
        /* If there is anything currently in the decrypt buffer then write (part
         * of) it to the output stream buffer.  How much we write depends on
         * what perl has asked for. */
        if ((m = SvCUR(ctx->decrypt_sv)) > 0) {
            out_ptr = (const unsigned char *)SvPVX_const(ctx->decrypt_sv);

            if (max_len) {
                /* Perl has asked for a block of up to max_len bytes. */
                num_bytes = m > max_len ? max_len : m;

                sv_catpvn(buf_sv, out_ptr, num_bytes);

#ifdef FILTER_CRYPTO_DEBUG_MODE
                FilterCrypto_HexDump(aTHX_ out_ptr, num_bytes,
                    "Wrote block (%"IVdf" bytes) to output stream",
                    (IV)num_bytes
                );
#endif

                /* Chop the number of bytes that we have just written from the
                 * start of the decrypt buffer. */
                sv_chop(ctx->decrypt_sv, (char *)out_ptr + num_bytes);

                /* We have written up to max_len bytes to the output stream
                 * buffer as required, so return the size of that buffer. */
                return SvCUR(buf_sv);
            }
            else {
                /* Perl has asked for a complete line of source code.  We must
                 * not return here if the decrypt buffer does not hold at least
                 * one complete line because perl compiles each line as it is
                 * returned and hence would generate a syntax error if we have
                 * written only part of a line to the output stream buffer.
                 * Instead, we must carry on and read some more data from the
                 * input stream and have another go at completing the line the
                 * next time around. */
                if ((p = ninstr(out_ptr, out_ptr + m, nl, nl + 1))) {
                    /* There is a newline character in the decrypt buffer, so
                     * copy everything up to it to the output stream buffer. */
                    num_bytes = (unsigned char *)p - out_ptr + 1;

                    sv_catpvn(buf_sv, out_ptr, num_bytes);

#ifdef FILTER_CRYPTO_DEBUG_MODE
                    FilterCrypto_HexDump(aTHX_ out_ptr, num_bytes,
                        "Wrote line (%"IVdf" bytes) to output stream "
                        "(Reached EOL)", (IV)num_bytes
                    );
#endif

                    /* Chop the number of bytes that we have just written from
                     * the start of the decrypt buffer. */
                    sv_chop(ctx->decrypt_sv, (char *)out_ptr + num_bytes);

                    /* We have written a complete line to the output stream
                     * buffer as required, so return the size of that buffer. */
                    return SvCUR(buf_sv);
                }
                else {
                    /* There is no newline character in the decrypt buffer, so
                     * copy the whole buffer to the output stream buffer. */
                    num_bytes = m;

                    sv_catpvn(buf_sv, out_ptr, num_bytes);

#ifdef FILTER_CRYPTO_DEBUG_MODE
                    FilterCrypto_HexDump(aTHX_ out_ptr, num_bytes,
                        "Wrote line (%"IVdf" bytes) to output stream "
                        "(Not yet reached EOL)", (IV)num_bytes
                    );
#endif

                    /* Chop the number of bytes that we have just written from
                     * the start of the decrypt buffer. */
                    sv_chop(ctx->decrypt_sv, (char *)out_ptr + num_bytes);

                    /* We have not written a complete line to the output stream
                     * buffer as required, so carry on to try to read some more
                     * data from the input stream. */
                }
            }
        }

        /* If the filter status is finished then either return the size of the
         * output stream buffer if there is anything left in it (for example, an
         * incomplete line that could not be completed because the decrypted
         * source does not end with a newline), or otherwise delete the filter
         * and return zero for EOF. */
        if (ctx->filter_status == FILTER_CRYPTO_STATUS_FINISHED) {
            if (SvCUR(buf_sv)) {
                return SvCUR(buf_sv);
            }
            else {
#ifdef FILTER_CRYPTO_DEBUG_MODE
                warn("Deleting filter\n");
#endif

                filter_del(FilterCrypto_FilterDecrypt);
                return 0;
            }
        }

        /* Clear the decrypt buffer before we start decoding and decrypting data
         * read from the input stream into it and make sure the OOK flag is
         * turned off too in case it was set by the use of sv_chop() above.
         * (Zero the buffer's current length first to avoid the otherwise
         * wasteful copy of data back to the start of the buffer.) */
        FilterCrypto_SvSetCUR(ctx->decrypt_sv, 0);
        SvOOK_off(ctx->decrypt_sv);

        n = FilterCrypto_ReadBlock(aTHX_ idx + 1, ctx->encode_sv, BUFSIZ * 2);
        if (n > 0) {
            /* We have read a new block of data from the input stream into the
             * encode buffer, so set the length of the encode buffer and decode
             * it into the encrypt buffer. */
            FilterCrypto_SvSetCUR(ctx->encode_sv, n);
            if (!FilterCrypto_DecodeSV(aTHX_ ctx->encode_sv, ctx->encrypt_sv)) {
                filter_del(FilterCrypto_FilterDecrypt);
                croak("Can't continue decryption: %s",
                      FilterCrypto_GetErrStr(aTHX));
            }

            /* The decoding succeeded, so zero the encode buffer's length ready
             * for the next call to FilterCrypto_ReadBlock(). */
            FilterCrypto_SvSetCUR(ctx->encode_sv, 0);

            /* We have decoded a new block of data from the encode buffer into
             * the encrypt buffer, so decrypt it into the decrypt buffer. */
            if (!FilterCrypto_FilterUpdate(aTHX_ ctx)) {
                filter_del(FilterCrypto_FilterDecrypt);
                croak("Can't continue decryption: %s",
                      FilterCrypto_GetErrStr(aTHX));
            }

            /* The decryption succeeded, so zero the encrypt buffer's length
             * ready for the next call to FilterCrypto_ReadBlock(). */
            FilterCrypto_SvSetCUR(ctx->encrypt_sv, 0);
        }
        else if (n == 0) {
            /* We did not read any data from the input stream, and have now
             * reached EOF, so decrypt the final block into the decrypt
             * buffer. */
            if (!FilterCrypto_FilterFinal(aTHX_ ctx)) {
                filter_del(FilterCrypto_FilterDecrypt);
                croak("Can't complete decryption: %s",
                      FilterCrypto_GetErrStr(aTHX));
            }

            /* Set the filter status "finished" to remember that we have now
             * read all the data and finalized the crypt context, with the final
             * block written to the decrypt buffer.  All that remains to be done
             * is for that to be written to the output stream buffer. */
            ctx->filter_status = FILTER_CRYPTO_STATUS_FINISHED;
        }
        else {
            /* We had a read error. */
            filter_del(FilterCrypto_FilterDecrypt);
            croak("Can't continue decryption: %s",
                  FilterCrypto_GetErrStr(aTHX));
        }
    }
}

/*
 * Function to determine whether the perl running it is a DEBUGGING build.  This
 * is tested by trying out the "hash dump" debugging feature, which should usurp
 * the built-in values() function if and only if this is a DEBUGGING perl, thus
 * providing a more reliable (though clearly still not infallible) indicator
 * than inspecting the contents of Config.pm.
 *
 * Thanks to Nicholas Clark for this trick.
 */

static bool FilterCrypto_IsDebugPerl(pTHX) {
    return SvTRUE(eval_pv(
        "local $^D = 8192; my %h = (1 => 2); (values %h)[0] == 2 ? 0 : 1", 0
    ));
}

/*
 * Function to get the Perl module's $ErrStr variable.
 */

static const char *FilterCrypto_GetErrStr(pTHX) {
    /* Get the Perl module's $ErrStr variable and return the string in it. */
    return SvPV_nolen_const(get_sv(filter_crypto_errstr_var, TRUE));
}

/*============================================================================*/

MODULE = Filter::Crypto::Decrypt PACKAGE = Filter::Crypto::Decrypt     

#===============================================================================
# XS CODE SECTION
#===============================================================================

PROTOTYPES:   ENABLE
VERSIONCHECK: ENABLE

INCLUDE: ../CryptoCommon-xs.inc

BOOT:
{
#ifndef FILTER_CRYPTO_DEBUG_MODE
    /* C compile-time check that this not a DEBUGGING perl.
     * i.e. built with -DDEBUGGING. */
#  ifdef DEBUGGING
#    error Do not build with DEBUGGING perl!
#  endif

    /* Check that we are not running with DEBUGGING flags enabled.
     * e.g. perl -Dp <script>
     * Do this check before the check for a DEBUGGING perl below because that
     * check currently seems to always trigger this check to fail even though
     * its alteration of $^D is local()ized. */
    if (PL_debug)
        croak("Can't run with DEBUGGING flags");

    /* Check that we are not running under a DEBUGGING perl.
     * i.e. built with -DDEBUGGING. */
    if (FilterCrypto_IsDebugPerl(aTHX))
        croak("Can't run with DEBUGGING perl");

    /* Check that we are not running with the Perl debugger enabled.
     * e.g. perl -d:ptkdb <script> */
    if (PL_perldb)
        croak("Can't run with Perl debugger");

    /* Check that we are not running with the Perl compiler backend enabled.
     * e.g. perl -MO=Deparse <script> */
#  ifndef FILTER_CRYPTO_UNSAFE_MODE
    if (get_sv("B::VERSION", FALSE))
        croak("Can't run with Perl compiler backend");
#  endif
#endif
}

# Import function, automatically called by perl when processing the
# "use Filter::Crypto::Decrypt;" line, to initialize the decryption filter's
# context.

void
import(module, ...)
    PROTOTYPE: $;@

    INPUT:
        SV *module;

    CODE:
    {
        FILTER_CRYPTO_FCTX *ctx;
        SV *filter_sv;
        MAGIC *mg;

        /* Allocate and initialize (in decrypt mode) a filter context. */
        ctx = FilterCrypto_FilterAlloc(aTHX);
        if (!FilterCrypto_FilterInit(aTHX_ ctx, FILTER_CRYPTO_MODE_DECRYPT)) {
            FilterCrypto_FilterFree(aTHX_ ctx);
            ctx = NULL;
            croak("Can't start decryption: %s", FilterCrypto_GetErrStr(aTHX));
        }

        /* Allocate a new SV storing a pointer to the filter context.  Make the
         * SV magical so that the filter context that it stores a pointer to can
         * be automatically freed when the SV is destroyed, and store the
         * pointer within the MAGIC (specifically, as the mg_ptr member) so that
         * it cannot be messed with.
         * Pass 0 as the length of the mg_ptr member-to-be so that it is stored
         * as-is, rather than a savepvn() copy of it being stored. */
        filter_sv = newSV(0);
        if (!(mg = sv_magicext(filter_sv, (SV *)NULL, PERL_MAGIC_ext,
                (MGVTBL *)&FilterCrypto_FilterSvMgVTBL, (char *)ctx, 0)))
        {
            FilterCrypto_FilterFree(aTHX_ ctx);
            ctx = NULL;
            croak("Can't add MAGIC to decryption filter's SV");
        }

        /* Store a pointer back to the MAGIC within the filter context structure
         * itself so that we can verify later that we have retrieved the correct
         * MAGIC from the SV since multiple MAGICs, even of the same type, can
         * be added to a single SV. */
        ctx->mg_ptr = mg;

        /* Add the new SV, together with our FilterCrypto_FilterDecrypt()
         * function, as a new source code filter.  In this way, each filter gets
         * its own decryption context.  This is necessary to avoid clashes
         * between filters that run interleaved, for example, the case of one
         * file require()ing another where both need filtering. */
        filter_add(FilterCrypto_FilterDecrypt, filter_sv);

        /* Increment the filter count to account for our new filter. */
        ctx->filter_count += 1;
    }

#===============================================================================