Exemple #1
0
PARROT_API
Parrot_Int
Parrot_api_string_free_exported_ascii(ARGIN(Parrot_PMC interp_pmc), ARGIN(char * const str))
{
    ASSERT_ARGS(Parrot_api_string_free_exported_ascii)
    EMBED_API_CALLIN(interp_pmc, interp);
    if (str != NULL)
        Parrot_str_free_cstring(str);
    EMBED_API_CALLOUT(interp_pmc, interp);
}
Exemple #2
0
void
Parrot_file_mkdir(PARROT_INTERP, ARGIN(STRING *path), INTVAL mode)
{
    char *c_str  = Parrot_str_to_platform_cstring(interp, path);
    int   result = mkdir(c_str, mode);

    Parrot_str_free_cstring(c_str);

    if (result)
        THROW("mkdir");
}
Exemple #3
0
void
Parrot_file_unlink(PARROT_INTERP, ARGIN(STRING *path))
{
    char *c_str  = Parrot_str_to_platform_cstring(interp, path);
    int   result = unlink(c_str);

    Parrot_str_free_cstring(c_str);

    if (result)
        THROW("unlink");
}
Exemple #4
0
STRING *
Parrot_getenv(PARROT_INTERP, ARGIN(STRING *str_name))
{
    char   * const name = Parrot_str_to_cstring(interp, str_name);
    const   DWORD size  = GetEnvironmentVariable(name, NULL, 0);
    char   *buffer      = NULL;
    STRING *retv;

    if (size == 0) {
        Parrot_str_free_cstring(name);
        return NULL;
    }
    buffer = (char *)mem_sys_allocate(size);
    GetEnvironmentVariable(name, buffer, size);
    Parrot_str_free_cstring(name);
    retv = Parrot_str_from_platform_cstring(interp, buffer);
    mem_sys_free(buffer);

    return retv;
}
Exemple #5
0
void
Parrot_setenv(PARROT_INTERP, STRING *str_name, STRING *str_value)
{
    char * const name  = Parrot_str_to_cstring(interp, str_name);
    char * const value = Parrot_str_to_cstring(interp, str_value);
    assert(name  != NULL);
    assert(value != NULL);

    {
        const int name_len  = strlen(name);
        const int value_len = strlen(value);

        {
            char * const envstring = (char * const)mem_internal_allocate(
                    name_len     /* name  */
                    + 1          /* '='   */
                    + value_len  /* value */
                    + 1);        /* string terminator */

            /* Save a bit of time, by using the fact we already have the
            lengths, avoiding strcat */
            strcpy(envstring, name);
            strcpy(envstring + name_len, "=");
            strcpy(envstring + name_len + 1, value);

            Parrot_str_free_cstring(name);
            Parrot_str_free_cstring(value);

            if (_putenv(envstring) == 0) {
                /* success */
                mem_sys_free(envstring);
            }
            else {
                mem_sys_free(envstring);
                Parrot_x_force_error_exit(interp, 1,
                    "Unable to set environment variable %s=%s",
                    name, value);
            }
        }
    }
}
Exemple #6
0
void
Parrot_file_unlink(PARROT_INTERP, ARGIN(STRING *path))
{
    char *c_str  = Parrot_str_to_encoded_cstring(interp, path,
                        Parrot_utf16_encoding_ptr);
    BOOL  result = DeleteFileW((LPWSTR)c_str);

    Parrot_str_free_cstring(c_str);

    if (!result)
        THROW("unlink");
}
Exemple #7
0
void
Parrot_file_rmdir(PARROT_INTERP, ARGIN(STRING *path))
{
    char *c_str  = Parrot_str_to_encoded_cstring(interp, path,
                        Parrot_utf16_encoding_ptr);
    BOOL  result = RemoveDirectoryW((LPWSTR)c_str);

    Parrot_str_free_cstring(c_str);

    if (!result)
        THROW("rmdir");
}
Exemple #8
0
void
Parrot_file_mkdir(PARROT_INTERP, ARGIN(STRING *path), INTVAL mode)
{
    char *c_str  = Parrot_str_to_encoded_cstring(interp, path,
                        Parrot_utf16_encoding_ptr);
    BOOL  result = CreateDirectoryW((LPWSTR)c_str, NULL);

    Parrot_str_free_cstring(c_str);

    if (!result)
        THROW("mkdir");
}
Exemple #9
0
INTVAL
Parrot_stat_info_intval(PARROT_INTERP, STRING *file, INTVAL thing)
{
    struct stat statbuf;

    /* Get the name of the file as something we can use */
    char * const filename = Parrot_str_to_cstring(interp, file);

    /* Everything needs the result of stat, so just go do it */
    const int status = stat(filename, &statbuf);
    Parrot_str_free_cstring(filename);
    return stat_common(interp, &statbuf, thing, status);
}
Exemple #10
0
/* This is called to do any cleanup of resources when an object gets
 * embedded inside another one. Never called on a top-level object. */
static void gc_cleanup(PARROT_INTERP, STable *st, void *data) {
    NativeCallBody *body = (NativeCallBody *)data;
    UNUSED(interp);
    UNUSED(st);
    if (body->lib_name)
        Parrot_str_free_cstring(body->lib_name);
    if (body->lib_handle)
        dlFreeLibrary(body->lib_handle);
    if (body->arg_types)
        mem_sys_free(body->arg_types);
    if (body->arg_info)
        mem_sys_free(body->arg_info);
}
Exemple #11
0
PARROT_WARN_UNUSED_RESULT
INTVAL
Parrot_io_internal_getprotobyname(PARROT_INTERP, ARGIN(STRING *name))
{
    char            * const s        = Parrot_str_to_cstring(interp, name);
    struct protoent * const protoent = getprotobyname(s);

    Parrot_str_free_cstring(s);
    if (protoent)
        return protoent->p_proto;
    else
        return -1;
}
Exemple #12
0
INTVAL
Parrot_Run_OS_Command(PARROT_INTERP, STRING *command)
{
    DWORD status = 0;
    STARTUPINFO si;
    PROCESS_INFORMATION pi;
    char* const cmd   = (char *)mem_sys_allocate(command->strlen + 4);
    char* const shell = Parrot_getenv(interp, Parrot_str_new(interp, "ComSpec", strlen("ComSpec")));
    char* const cmdin = Parrot_str_to_cstring(interp, command);

    strcpy(cmd, "/c ");
    strcat(cmd, cmdin);
    Parrot_str_free_cstring(cmdin);

    memset(&si, 0, sizeof (si));
    si.cb = sizeof (si);
    memset(&pi, 0, sizeof (pi));

    /* Start the child process. */
    if (!CreateProcess(shell, cmd, NULL, NULL, TRUE, 0, NULL, NULL, &si, &pi))
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_NOSPAWN,
            "Can't spawn child process");

    WaitForSingleObject(pi.hProcess, INFINITE);

    if (!GetExitCodeProcess(pi.hProcess, &status)) {
        Parrot_warn(interp, PARROT_WARNINGS_PLATFORM_FLAG,
            "Process completed: Failed to get exit code.");
    }
    CloseHandle(pi.hProcess);
    CloseHandle(pi.hThread);
    Parrot_str_free_cstring(shell);
    mem_sys_free(cmd);

    /* Return exit code left shifted by 8 for POSIX emulation. */
    return status << 8;
}
Exemple #13
0
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
PMC *
Parrot_io_internal_getaddrinfo(PARROT_INTERP, ARGIN(STRING *addr), INTVAL port,
        INTVAL protocol, INTVAL fam, INTVAL passive)
{
#ifdef PARROT_HAS_IPV6
    PMC *array;

    struct addrinfo hints;
    struct addrinfo *ai, *walk;
    /* We need to pass the port as a string (because you could also use a
     * service specification from /etc/services). The highest port is 65535,
     * so we need 5 characters + trailing null-byte. */
    char portstr[6];
    int  ret;

    /* convert Parrot's family to system family */
    if (fam < 0
    ||  fam >= PIO_PF_MAX
    || (fam = pio_pf[fam]) < 0)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                "unsupported protocol family: %ld", fam);

    memset(&hints, 0, sizeof (struct addrinfo));
    if (passive)
        hints.ai_flags = AI_PASSIVE;

    hints.ai_family   = fam;
    hints.ai_protocol = protocol;

    snprintf(portstr, sizeof (portstr), "%ld", port);

    {
        /* Limited scope for the C string to prevent mistakes */
        char *s = STRING_IS_NULL(addr)
                ? (char *) NULL
                : Parrot_str_to_cstring(interp, addr);
        ret = getaddrinfo(s, portstr, &hints, &ai);

        Parrot_str_free_cstring(s);
    }

    if (ret != 0)
        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                "getaddrinfo failed: %Ss: %Ss", addr,
                Parrot_platform_strerror(interp, PIO_SOCK_ERRNO));

    array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);

    for (walk = ai; walk; walk = walk->ai_next) {
        PMC *sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
        Parrot_Sockaddr_attributes *sa_attrs = PARROT_SOCKADDR(sockaddr);

        sa_attrs->family   = walk->ai_family;
        sa_attrs->type     = walk->ai_socktype;
        sa_attrs->protocol = walk->ai_protocol;
        sa_attrs->len      = walk->ai_addrlen;
        sa_attrs->pointer  = Parrot_gc_allocate_memory_chunk(interp,
                                    walk->ai_addrlen);

        memcpy(sa_attrs->pointer, walk->ai_addr, walk->ai_addrlen);

        VTABLE_push_pmc(interp, array, sockaddr);
    }

    freeaddrinfo(ai);

    return array;

#else /* PARROT_HAS_IPV6 */

    const char *host;
    char *cstring;
    int   success;
    PMC  *sockaddr;
    PMC  *array;

    const size_t addr_len = sizeof (struct sockaddr_in);
    struct sockaddr_in *sa;

    Parrot_Sockaddr_attributes *sa_attrs;

    sa       = (struct sockaddr_in *)Parrot_gc_allocate_memory_chunk(interp,
                                            addr_len);
    sockaddr = Parrot_pmc_new(interp, enum_class_Sockaddr);
    sa_attrs = PARROT_SOCKADDR(sockaddr);

    sa_attrs->family   = PF_INET;
    sa_attrs->type     = 0;
    sa_attrs->protocol = 0;
    sa_attrs->len      = addr_len;
    sa_attrs->pointer  = sa;

    if (STRING_IS_NULL(addr)) {
        cstring = NULL;
        host    = "127.0.0.1";
    }
    else {
        cstring = Parrot_str_to_cstring(interp, addr);
        host    = cstring;
    }

#  ifdef _WIN32
    sa->sin_addr.S_un.S_addr = inet_addr(host);
    success = sa->sin_addr.S_un.S_addr != -1;
#  else
#    ifdef PARROT_DEF_INET_ATON
    success = inet_aton(host, &sa->sin_addr) != 0;
#    else
    /* positive retval is success */
    success = inet_pton(PF_INET, host, &sa->sin_addr) > 0;
#    endif
#  endif

    if (!success) {
        /* Maybe it is a hostname, try to lookup */
        /* XXX Check PIO option before doing a name lookup,
         * it may have been toggled off.
         */
        const struct hostent * const he = gethostbyname(host);

        if (!he) {
            if (cstring)
                Parrot_str_free_cstring(cstring);
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
                    "getaddrinfo failed: %s", host);
        }

        memcpy((char*)&sa->sin_addr, he->h_addr, sizeof (sa->sin_addr));
    }

    if (cstring)
        Parrot_str_free_cstring(cstring);

    sa->sin_family = PF_INET;
    sa->sin_port = htons(port);

    array = Parrot_pmc_new(interp, enum_class_ResizablePMCArray);
    VTABLE_push_pmc(interp, array, sockaddr);

    return array;
#endif /* PARROT_HAS_IPV6 */
}
Exemple #14
0
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC*
Parrot_make_cb(PARROT_INTERP, ARGMOD(PMC* sub), ARGIN(PMC* user_data),
        ARGIN(STRING *cb_signature))
{
    ASSERT_ARGS(Parrot_make_cb)
    PMC *cb, *cb_sig;
    int type = 0;
    STRING *sc;
    char * const signature = Parrot_str_to_cstring(interp, cb_signature);
    /*
     * we stuff all the information into the user_data PMC and pass that
     * on to the external sub
     */
    PMC * const interp_pmc = VTABLE_get_pmc_keyed_int(interp, interp->iglobals,
            (INTVAL) IGLOBALS_INTERPRETER);

    /* be sure __LINE__ is consistent */
    sc = CONST_STRING(interp, "_interpreter");
    VTABLE_setprop(interp, user_data, sc, interp_pmc);
    sc = CONST_STRING(interp, "_sub");
    VTABLE_setprop(interp, user_data, sc, sub);
    /* only ASCII signatures are supported */
    if (strlen(signature) == 3) {
        /* Callback return type ignored */

        if (signature[1] == 'U') {
            type = 'D';
        }
        else {
            if (signature[2] == 'U') {
                type = 'C';
            }
        }
    }
    Parrot_str_free_cstring(signature);
    if (type != 'C' && type != 'D')
        Parrot_ex_throw_from_c_args(interp, NULL, 1,
            "unhandled signature '%Ss' in make_cb", cb_signature);

    cb_sig = Parrot_pmc_new(interp, enum_class_String);
    VTABLE_set_string_native(interp, cb_sig, cb_signature);
    sc = CONST_STRING(interp, "_signature");
    VTABLE_setprop(interp, user_data, sc, cb_sig);
    /*
     * We are going to be passing the user_data PMC to external code, but
     * it may go out of scope until the callback is called -- we don't know
     * for certain as we don't know when the callback will be called.
     * Therefore, to prevent the PMC from being destroyed by a GC sweep,
     * we need to anchor it.
     *
     */
    Parrot_pmc_gc_register(interp, user_data);

    /*
     * Finally, the external lib awaits a function pointer.
     * Create a PMC that points to Parrot_callback_C (or _D);
     * it can be passed on with signature 'p'.
     */
    cb = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
    /*
     * Currently, we handle only 2 types:
     * _C ... user_data is 2nd parameter
     * _D ... user_data is 1st parameter
     */
    if (type == 'C')
        VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_C));
    else
        VTABLE_set_pointer(interp, cb, F2DPTR(Parrot_callback_D));
    Parrot_pmc_gc_register(interp, cb);

    return cb;
}
Exemple #15
0
PARROT_EXPORT
void
Parrot_run_callback(PARROT_INTERP,
        ARGMOD(PMC* user_data), ARGIN(char* external_data))
{
    ASSERT_ARGS(Parrot_run_callback)
    PMC     *signature;
    PMC     *sub;
    STRING  *sig_str;
    char    *p;
    char     ch;
    char    *sig_cstr;
    char     pasm_sig[5];
    INTVAL   i_param;
    PMC     *p_param;
    void    *param = NULL;      /* avoid -Ox warning */
    STRING  *sc;

    sc        = CONST_STRING(interp, "_sub");
    sub       = VTABLE_getprop(interp, user_data, sc);
    sc        = CONST_STRING(interp, "_signature");
    signature = VTABLE_getprop(interp, user_data, sc);

    sig_str   = VTABLE_get_string(interp, signature);
    sig_cstr  = Parrot_str_to_cstring(interp, sig_str);
    p         = sig_cstr;
    ++p;     /* Skip return type */

    pasm_sig[0] = 'P';
    if (*p == 'U') /* user_data Z in pdd16 */
        ++p;       /* p is now type of external data */
    switch (*p) {
      case 'v':
        pasm_sig[1] = 'v';
        break;
      case 'l':
        i_param = (INTVAL)(long) external_data;
        goto case_I;
      case 'i':
        i_param = (INTVAL)(int)(long) external_data;
        goto case_I;
      case 's':
        i_param = (INTVAL)(short)(long) external_data;
        goto case_I;
      case 'c':
        i_param = (INTVAL)(char)(long)external_data;
case_I:
        pasm_sig[1] = 'I';
        param = (void*) i_param;
        break;
      case 'p':
        /* created a UnManagedStruct */
        p_param = Parrot_pmc_new(interp, enum_class_UnManagedStruct);
        VTABLE_set_pointer(interp, p_param, external_data);
        pasm_sig[1] = 'P';
        param = (void*) p_param;
        break;
      case 't':
        pasm_sig[1] = 'S';
        param = Parrot_str_new(interp, external_data, 0);
        break;
      default:
        ch = *p;
        Parrot_str_free_cstring(sig_cstr);
        Parrot_ex_throw_from_c_args(interp, NULL, 1,
                "unhandled signature char '%c' in run_cb", ch);
    }
    Parrot_str_free_cstring(sig_cstr);
    pasm_sig[2] = '-';
    pasm_sig[3] = '>';  /* no return value supported yet */
    pasm_sig[4] = '\0';
    Parrot_ext_call(interp, sub, pasm_sig, user_data, param);
}