/* loops through the import table of a DLL, if the target import func is found
  it will be replaced, if OldFunc not null, old func ptr will be placed in OldFunc
  on failure returns FALSE and error is in GLR */
static BOOL PatchIAT(pTHX_ PIMAGE_DOS_HEADER dosHeader, SV * ImportDllName,
    SV * ImportFunctionName, void ** oldFunc, void * newFunc){
#define APPRVA2ABS(x) ((DWORD_PTR)dosHeader + (DWORD_PTR)(x))
    if( dosHeader
    && !IsBadReadPtr(dosHeader, sizeof(*dosHeader))
    && dosHeader->e_magic == IMAGE_DOS_SIGNATURE){
        PIMAGE_NT_HEADERS ntHeader = (PIMAGE_NT_HEADERS)APPRVA2ABS(dosHeader->e_lfanew);
        if( ntHeader
        && !IsBadReadPtr(ntHeader, sizeof(*ntHeader))
        && ntHeader->Signature == IMAGE_NT_SIGNATURE
        //not a OBJ file, bug below if some of the entrys are not present?
        && ntHeader->FileHeader.SizeOfOptionalHeader >= sizeof(IMAGE_OPTIONAL_HEADER)
        && ntHeader->OptionalHeader.NumberOfRvaAndSizes >= IMAGE_DIRECTORY_ENTRY_IMPORT+1
        ){
            DWORD pDataDirImportRVA = ntHeader->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress;
            DWORD pDataDirImportSize = ntHeader->OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].Size;
            PIMAGE_IMPORT_DESCRIPTOR importDescriptor = (PIMAGE_IMPORT_DESCRIPTOR)APPRVA2ABS(pDataDirImportRVA);
            if(pDataDirImportSize
               && pDataDirImportRVA
               && !IsBadReadPtr(importDescriptor, pDataDirImportSize)){
STRLEN DllNameLen;
char * DllNameStr = SvPV(ImportDllName, DllNameLen);
while (importDescriptor->Name != 0){
    const char * const TargetDllNameStr = (char *)APPRVA2ABS(importDescriptor->Name);
    const int TargetDllNameLen = lstrlenA(TargetDllNameStr);
    Perl_warn(aTHX_ "app import dep dll name is %s\n", TargetDllNameStr);
    if(TargetDllNameLen == 0) goto NO_MORE_LIBS;
    if(TargetDllNameLen == DllNameLen
        && strnicmp(TargetDllNameStr, DllNameStr, TargetDllNameLen) == 0
        && importDescriptor->OriginalFirstThunk
        && importDescriptor->FirstThunk
    ){
        PIMAGE_THUNK_DATA OriginalFirstThunk = (PIMAGE_THUNK_DATA)APPRVA2ABS(importDescriptor->OriginalFirstThunk);
        void ** FirstThunk = (void**)APPRVA2ABS(importDescriptor->FirstThunk);
/*note only the first slice in the array is probed, they others should be valid if the 1st one is*/
        if(! IsBadReadPtr(OriginalFirstThunk, sizeof(IMAGE_THUNK_DATA))
           && ! IsBadReadPtr(FirstThunk, sizeof(void *))){
            STRLEN FunctionNameLen;
            char * FunctionNameStr = SvPV(ImportFunctionName, FunctionNameLen);
            while(OriginalFirstThunk->u1.ForwarderString != 0){
                PIMAGE_IMPORT_BY_NAME TargetImport = (PIMAGE_IMPORT_BY_NAME)APPRVA2ABS(OriginalFirstThunk->u1.ForwarderString);
                char * TargetFunctionNameStr = TargetImport->Name;
                int TargetFunctionNameLen = lstrlenA(TargetFunctionNameStr);
                Perl_warn(aTHX_ "app import dep func name is %s\n", TargetFunctionNameStr);
                if(TargetFunctionNameLen == FunctionNameLen
                   && memcmp(TargetFunctionNameStr, FunctionNameStr, TargetFunctionNameLen) == 0){
                    if(oldFunc) *oldFunc = *FirstThunk;
                    *FirstThunk = newFunc;
                    return TRUE;
                }
                OriginalFirstThunk++;
                FirstThunk++;
            }
        }
        SetLastError(ERROR_PROC_NOT_FOUND);
        goto ERROR;
    }
    importDescriptor++;
}
    NO_MORE_LIBS:
    SetLastError(ERROR_MOD_NOT_FOUND);
    goto ERROR;
}
}
}
    SetLastError(ERROR_BAD_EXE_FORMAT);
    ERROR:
    return FALSE;
#undef APPRVA2ABS
}

MODULE = Win32::API::Callback   PACKAGE = Win32::API::Callback::IATPatch

void
new(classSV, callback, HookDll, ImportDllName, ImportFunctionName)
    SV * classSV
    W32AC_T * callback
    SV * HookDll
    SV * ImportDllName
    SV * ImportFunctionName
PREINIT:
    PIMAGE_DOS_HEADER dosHeader;
    HV * returnHV;
    void * oldFunction;
PPCODE:
    SvGETMAGIC(HookDll);
    if(SvPOK(HookDll)){
        dosHeader = (PIMAGE_DOS_HEADER) GetModuleHandle(SvPV_nomg_nolen(HookDll));
        if(!dosHeader) goto ERROR;
    }
    else{ dosHeader = (PIMAGE_DOS_HEADER) SvIV_nomg(HookDll);}
    if(!PatchIAT(aTHX_ dosHeader, ImportDllName, ImportFunctionName,
        &oldFunction, (void *)SvUVX(*hv_fetch(callback, "code", sizeof("code")-1, 0)))){
        ERROR:
        PUSHs(&PL_sv_undef);
        PUTBACK;
        return;
    }
    returnHV = newHV();
    //save the hmod, not dll str name, other dlls with same name might have been
    //loaded in the meantime/sxs/etc
    hv_store(returnHV,  "HookDllHmod",          sizeof("HookDllHmod")-1,
                        newSVuv((UV)dosHeader), 0);
    hv_store(returnHV,  "OrigFunc",             sizeof("OrigFunc")-1,
                        newSVuv((UV)oldFunction) ,  0);
    hv_store(returnHV,  "ImportDllName",        sizeof("ImportDllName")-1,
                        newSVsv(ImportDllName), 0);
    hv_store(returnHV,  "ImportFunctionName",   sizeof("ImportFunctionName")-1,
                        newSVsv(ImportFunctionName), 0);
    hv_store(returnHV,  "callback",             sizeof("callback")-1,
                        newRV_inc((SV*)callback),    0);
    mPUSHs(sv_bless(newRV_noinc((SV*)returnHV),
                    gv_stashsv(classSV,0)
                    )
           );


void
Unpatch(...)
PREINIT:
    I32 flagvar = 1; /*no param default is to restore*/
    SV * OrigFuncSV;
    void * OrigFunc;
    HV * self;
PPCODE:
    if (items < 1 || items > 2)
       croak_xs_usage(cv, "self [, flag=true]");
    else if(items == 2){
        flagvar = sv_true(ST(1));
    }
    {SV * TmpRV = ST(0);
    if (SvROK(TmpRV) && sv_derived_from(TmpRV, "Win32::API::Callback::IATPatch")) {
        self = (HV*)SvRV(TmpRV);
    }
    else
        Perl_croak(aTHX_ "%s: %s is not of type %s",
            "Win32::API::Callback::IATPatch::Unpatch",
            "self", "Win32::API::Callback::IATPatch");};
    OrigFuncSV = *hv_fetch(self, "OrigFunc", sizeof("OrigFunc")-1, 0);
    if(flagvar){
    if(OrigFunc = (void *)SvUVX(OrigFuncSV)){
        if(!PatchIAT(aTHX_
            (PIMAGE_DOS_HEADER)SvUVX(*hv_fetch(self, "HookDllHmod", sizeof("HookDllHmod")-1, 0)),
            *hv_fetch(self, "ImportDllName", sizeof("ImportDllName")-1, 0),
            *hv_fetch(self, "ImportFunctionName", sizeof("ImportFunctionName")-1, 0),
            NULL,       OrigFunc
        )){
            goto FAILED;
        }
        else goto SUCCESS;
    }
    else SetLastError(ERROR_NO_MORE_ITEMS);
    }
    else{ //flag is false, never restore original function
    SUCCESS:
        sv_setuv(OrigFuncSV, 0);
        PUSHs(&PL_sv_yes);
        PUTBACK;
        return;
    }
    FAILED:
    PUSHs(&PL_sv_undef);

void
DESTROY(self)
    SV * self
PREINIT:
    SV * retsv;
PPCODE:
    PUSHMARK(SP);
    PUSHs(self);
    PUSHs(&PL_sv_yes);
    PUTBACK;
    XS_Win32__API__Callback__IATPatch_Unpatch(aTHX_ cv); /*the cv is wrong with this hack*/
    //call_pv("Win32::API::Callback::IATPatch::Unpatch", 0);
    retsv = POPs;
    if(!sv_true(retsv) /*ERROR_NO_MORE_ITEMS means it was already unpatched*/
       && GetLastError() != ERROR_NO_MORE_ITEMS){
        croak("%s: Failed to unpatch DLL, error number %u ",
              "Win32::API::Callback::IATPatch::DESTROY", GetLastError());
    }

# GetOriginalFunction is reserved for future
# GetOriginalFunction should return a fully working Win32::API obj that calls
# the original function, the prototype should be obtained automatically from the
# Win32::API::Callback obj

void
GetOriginalFunctionPtr(self)
W32ACIATP_T * self
PPCODE:
    mPUSHs(newSVsv(*hv_fetch(self, "OrigFunc", sizeof("OrigFunc")-1, 0)));


void
CLONE_SKIP(...)
PPCODE:
/* Prevent double unpatching from a fork. I dont think it makes sense to clone
  IATPatches, there is only one DLL per process. You can't have 2 different
  patches on it and have 2 different hooks expect to work based on the calling
  psuedo process. Well you could have a aTHX based dispatcher that will look up
  the correct weak ref ::Callback HV to use each time the PerlCallback() is
  called, but that is s alot of work for little gain. Currently the HV * of
  the ::Callback is hard coded into the ASM callback, and that HV * is interp
  specific.
*/
    XPUSHs(&PL_sv_yes);