view release on metacpan or  search on metacpan

myldr/boot.c  view on Meta::CPAN

        }

        if (c == L'"')
            *q++ = L'\\';                /* escape the following quote */
        *q++ = c;
        p++;
    }

    *q++ = L'"';                         /* closing quote */
    *q++ = L'\0';

    return dst;
}

void spawn_perl(const char *argv0, const char *my_perl, const char *stmpdir)
{
    typedef BOOL (WINAPI *pALLOW)(DWORD);
    HINSTANCE hinstLib;
    pALLOW ProcAdd;
#ifndef ASFW_ANY
#define ASFW_ANY -1
#endif
    LPWSTR *w_argv;
    LPWSTR w_my_perl;
    int w_argc, i, len, rc;

    hinstLib = LoadLibrary("user32");
    if (hinstLib != NULL) {
        ProcAdd = (pALLOW) GetProcAddress(hinstLib, "AllowSetForegroundWindow");
        if (ProcAdd != NULL)
        {
            (ProcAdd)(ASFW_ANY);
        }
    }

    w_argv = CommandLineToArgvW(GetCommandLineW(), &w_argc);
    if (w_argv == NULL)
        par_die("%s: GetCommandLineW or CommandLineToArgvW failed: $^E=%u", 
                argv0, GetLastError());

    /* convert my_perl from local codepage to UTF-16 */
    len = MultiByteToWideChar(CP_THREAD_ACP, 0, my_perl, -1, NULL, 0);
    if (len == 0)
        par_die("%s: failed to convert string to UTF-16: $^E=%u", 
                argv0, GetLastError());
    w_my_perl = malloc(len * sizeof(wchar_t));        /* len includes trailing NUL */
    len = MultiByteToWideChar(CP_THREAD_ACP, 0, my_perl, -1, w_my_perl, len);
    w_argv[0] = w_my_perl;

    for (i = 0; i < w_argc; i++)
    {
        len = wcslen(w_argv[i]);
        if (len == 0 
            || w_argv[i][len-1] == L'\\'
            || wcspbrk(w_argv[i], L" \t\n\r\v\""))
        {
            w_argv[i] = shell_quote_wide(w_argv[i]);
        }
    }    

    par_setenv("PAR_SPAWNED", "1");

    rc = _wspawnvp(P_WAIT, w_my_perl, (const wchar_t* const*)w_argv);
    
    free(w_my_perl);
    LocalFree(w_argv);

    par_cleanup(stmpdir);
    exit(rc);
}
#endif

char pp_version_info[] = "@(#) Packed by PAR::Packer " stringify(PAR_PACKER_VERSION);

/* the contents of this string (in the executable myldr/boot)
 * will be patched by script/par.pl if option "--clean" is used with pp
 */

int main ( int argc, char **argv, char **env )
{
    int rc;
    char *stmpdir;
    embedded_file_t *emb_file;
    char *my_file;
    char *my_perl;
    char *my_prog;

    par_init_env();

    stmpdir = par_mktmpdir( argv );
    if ( !stmpdir ) par_die("");        /* error message has already been printed */

    rc = my_mkdir(stmpdir, 0700);
    if ( rc == -1 && errno != EEXIST) {
	par_die("%s: creation of private cache subdirectory %s failed (errno= %i)\n", 
            argv[0], stmpdir, errno);
    }

    /* extract embedded_files[0] (i.e. the custom Perl interpreter) 
     * into stmpdir (but under the same basename as argv[0]) */
    my_prog = par_findprog(argv[0], par_getenv("PATH"));

#ifdef __MACH__
    {
        /* Detect if FAT binary */
        FILE *obj_file = fopen(my_prog, "rb");
        uint32_t magic = read_magic(obj_file, 0);
        fclose(obj_file);

        if (magic == FAT_CIGAM || magic == FAT_MAGIC) 
        {
            /* Create separate dir for extracted thin binary*/
            char *ftmpdir = malloc(strlen(stmpdir) + 5 + 1);
            sprintf(ftmpdir, "%s%s", stmpdir, "/thin");
            sanitise_tmp(ftmpdir);
            rc = my_mkdir(ftmpdir, 0700);
            if (rc == -1 && errno != EEXIST)
                par_die("%s: creation of cache subdirectory "
                        "for extracted macOS thin binary %s failed (errno= %i)\n", 
                        argv[0], ftmpdir, errno);