static void __attribute__((constructor)) init(void)
{
char handle[128];
find_or_make_array_variable("DLHANDLES", 3);
// RTLD_NEXT and RTLD_DEFAULT are special handles for dlsym. These are
// stored as strings rather than integers, as otherwise they can
// be interpreted as flags (they are small negative integers cast to
// void*).
snprintf(handle, sizeof handle, "%p", RTLD_NEXT);
bind_variable("RTLD_NEXT", handle, 0);
snprintf(handle, sizeof handle, "%p", RTLD_DEFAULT);
bind_variable("RTLD_DEFAULT", handle, 0);
}
/* Perform the same operation as bind_variable, but with VALUE being a
* number, not a string. */
SHELL_VAR *
mpibash_bind_variable_number (const char *name, long value, int flags)
{
char numstr[25]; /* String version of VALUE */
sprintf (numstr, "%ld", value);
return bind_variable (name, numstr, flags);
}
// Usage:
//
// dlsym $RTLD_DEFAULT "errno"
//
static int get_symbol_address(WORD_LIST *list)
{
int opt;
void *handle;
void *symbol;
char *resultname;
char retval[256];
resultname = "DLRETVAL";
reset_internal_getopt();
// $ dlcall [-n name]
while ((opt = internal_getopt(list, "n:")) != -1) {
switch (opt) {
case 'n':
resultname = list_optarg;
break;
default:
builtin_usage();
return EX_USAGE;
}
}
// Skip past any options.
if ((list = loptend) == NULL || list->next == NULL) {
builtin_usage();
return EX_USAGE;
}
if (check_parse_ulong(list->word->word, (void *) &handle) == 0) {
builtin_warning("handle %s %p is not well-formed", list->word->word, handle);
return EX_USAGE;
}
if (!(symbol = dlsym(handle, list->next->word->word))) {
builtin_warning("failed to resolve symbol %s, %s", list->next->word->word, dlerror());
return EXECUTION_FAILURE;
}
snprintf(retval, sizeof retval, "pointer:%p", symbol);
fprintf(stderr, "%s\n", retval);
bind_variable(resultname, retval, 0);
return EXECUTION_SUCCESS;
}
void
attach_os_thread(init_thread_data *scribble)
{
os_thread_t os = pthread_self();
odxprint(misc, "attach_os_thread: attaching to %p", os);
struct thread *th = create_thread_struct(NIL);
block_deferrable_signals(&scribble->oldset);
th->no_tls_value_marker = NO_TLS_VALUE_MARKER_WIDETAG;
/* We don't actually want a pthread_attr here, but rather than add
* `if's to the post-mostem, let's just keep that code happy by
* keeping it initialized: */
pthread_attr_init(th->os_attr);
#ifndef LISP_FEATURE_WIN32
/* On windows, arch_os_thread_init will take care of finding the
* stack. */
void *stack_addr;
size_t stack_size;
#ifdef LISP_FEATURE_OPENBSD
stack_t stack;
pthread_stackseg_np(os, &stack);
stack_size = stack.ss_size;
stack_addr = (void*)((size_t)stack.ss_sp - stack_size);
#elif defined LISP_FEATURE_SUNOS
stack_t stack;
thr_stksegment(&stack);
stack_size = stack.ss_size;
stack_addr = (void*)((size_t)stack.ss_sp - stack_size);
#elif defined(LISP_FEATURE_DARWIN)
stack_addr = pthread_get_stackaddr_np(os);
stack_size = pthread_get_stacksize_np(os);
#else
pthread_attr_t attr;
#ifdef LISP_FEATURE_FREEBSD
pthread_attr_get_np(os, &attr);
#else
int pthread_getattr_np(pthread_t, pthread_attr_t *);
pthread_getattr_np(os, &attr);
#endif
pthread_attr_getstack(&attr, &stack_addr, &stack_size);
#endif
th->control_stack_start = stack_addr;
th->control_stack_end = (void *) (((uintptr_t) stack_addr) + stack_size);
#endif
init_new_thread(th, scribble, 0);
/* We will be calling into Lisp soon, and the functions being called
* recklessly ignore the comment in target-thread which says that we
* must be careful to not cause GC while initializing a new thread.
* Since we first need to create a fresh thread object, it's really
* tempting to just perform such unsafe allocation though. So let's
* at least try to suppress GC before consing, and hope that it
* works: */
bind_variable(GC_INHIBIT, T, th);
uword_t stacksize
= (uword_t) th->control_stack_end - (uword_t) th->control_stack_start;
odxprint(misc, "attach_os_thread: attached %p as %p (0x%lx bytes stack)",
os, th, (long) stacksize);
}
// Usage:
//
// dlcall $RTLD_DEFAULT "printf" "hello %s %u %c" $USER 123 int:10
//
static int call_foreign_function(WORD_LIST *list)
{
unsigned nargs;
int opt;
ffi_cif cif;
ffi_type **argtypes;
ffi_type *rettype;
void **values;
void *handle;
void *func;
char *prefix;
char *format;
char *resultname;
nargs = 0;
argtypes = NULL;
values = NULL;
format = NULL;
prefix = NULL;
rettype = &ffi_type_void;
resultname = "DLRETVAL";
reset_internal_getopt();
// $ dlcall [-a abi] [-r type] [-n name]
while ((opt = internal_getopt(list, "a:r:n:")) != -1) {
switch (opt) {
case 'a':
builtin_warning("FIXME: only abi %u is currently supported", FFI_DEFAULT_ABI);
return 1;
break;
case 'r':
if (decode_type_prefix(prefix = list_optarg, NULL, &rettype, NULL, &format) != true) {
builtin_warning("failed to parse return type");
return 1;
}
break;
case 'n':
resultname = list_optarg;
break;
default:
builtin_usage();
return 1;
}
}
// Skip past any options.
if ((list = loptend) == NULL || list->next == NULL) {
builtin_usage();
return 1;
}
if (check_parse_ulong(list->word->word, (void *) &handle) == 0) {
builtin_warning("handle %s %p is not well-formed", list->word->word, handle);
return 1;
}
if (!(func = dlsym(handle, list->next->word->word))) {
builtin_warning("failed to resolve symbol %s, %s", list->next->word->word, dlerror());
return 1;
}
// Skip to optional parameters
list = list->next->next;
while (list) {
argtypes = realloc(argtypes, (nargs + 1) * sizeof(ffi_type *));
values = realloc(values, (nargs + 1) * sizeof(void *));
if (decode_primitive_type(list->word->word, &values[nargs], &argtypes[nargs]) != true) {
builtin_error("failed to decode type from parameter %s", list->word->word);
goto error;
}
nargs++;
list = list->next;
}
if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, rettype, argtypes) == FFI_OK) {
char *retval;
void *rc = alloca(rettype->size);
// Do the call.
ffi_call(&cif, func, rc, values);
// Print the result.
if (format) {
switch (rettype->size) {
case 1: asprintf(&retval, format, *(uint8_t *) rc); break;
case 2: asprintf(&retval, format, *(uint16_t *) rc); break;
case 4: asprintf(&retval, format, *(uint32_t *) rc, *(float *) rc); break;
case 8: asprintf(&retval, format, *(uint64_t *) rc, *(double *) rc); break;
case 16: asprintf(&retval, format, *(long double *) rc); break;
default:
builtin_error("cannot handle size %lu", rettype->size);
abort();
}
fprintf(stderr, "%s\n", retval);
bind_variable(resultname, retval, 0);
free(retval);
}
}
for (unsigned i = 0; i < nargs; i++)
free(values[i]);
free(values);
free(argtypes);
return 0;
error:
for (unsigned i = 0; i < nargs; i++)
free(values[i]);
free(values);
free(argtypes);
return 1;
}
// Usage:
//
// dlcall "printf" "hello %s %u %c" $USER 123 int:10
//
static int call_foreign_function(WORD_LIST *list)
{
unsigned nargs;
unsigned i;
int opt;
ffi_cif cif;
ffi_type **argtypes;
ffi_type *rettype;
void **values;
void *handle;
void *func;
char *prefix;
char *format;
char *resultname;
nargs = 0;
argtypes = NULL;
values = NULL;
format = NULL;
prefix = NULL;
rettype = &ffi_type_void;
resultname = "DLRETVAL";
handle = RTLD_DEFAULT;
reset_internal_getopt();
// $ dlcall [-a abi] [-r type] [-n name] [-h handle] symbol args...
while ((opt = internal_getopt(list, "h:a:r:n:")) != -1) {
switch (opt) {
case 'a':
builtin_warning("FIXME: only abi %u is currently supported", FFI_DEFAULT_ABI);
return 1;
break;
case 'r':
if (decode_type_prefix(prefix = list_optarg, NULL, &rettype, NULL, &format) != true) {
builtin_warning("failed to parse return type");
return 1;
}
break;
case 'n':
resultname = list_optarg;
break;
case 'h':
if (check_parse_ulong(list_optarg, (void *) &handle) == 0) {
builtin_warning("handle %s %p is not well-formed", list_optarg, handle);
return EXECUTION_FAILURE;
}
break;
default:
builtin_usage();
return EX_USAGE;
}
}
// Skip past any options.
if ((list = loptend) == NULL) {
builtin_usage();
return EX_USAGE;
}
if (!(func = dlsym(handle, list->word->word))) {
builtin_warning("failed to resolve symbol %s, %s", list->word->word, dlerror());
return 1;
}
// Skip to optional parameters
list = list->next;
while (list) {
argtypes = realloc(argtypes, (nargs + 1) * sizeof(ffi_type *));
values = realloc(values, (nargs + 1) * sizeof(void *));
if (decode_primitive_type(list->word->word, &values[nargs], &argtypes[nargs]) != true) {
builtin_error("failed to decode type from parameter %s", list->word->word);
goto error;
}
nargs++;
list = list->next;
}
if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, nargs, rettype, argtypes) == FFI_OK) {
char *retval;
void *rc = alloca(rettype->size);
// Do the call.
ffi_call(&cif, func, rc, values);
// Decode the result.
if (format) {
retval = encode_primitive_type(format, rettype, rc);
// If this is an interactive shell, print the output.
if (interactive_shell) {
fprintf(stderr, "%s\n", retval);
}
// Save the result to the requested location.
bind_variable(resultname, retval, 0);
// Bash maintains it's own copy of this string, so we can throw it away.
free(retval);
}
}
for (i = 0; i < nargs; i++)
free(values[i]);
free(values);
free(argtypes);
return 0;
error:
for (i = 0; i < nargs; i++)
free(values[i]);
free(values);
free(argtypes);
return 1;
}
// Usage:
//
// dlsym $RTLD_DEFAULT "errno"
//
static int get_symbol_address(WORD_LIST *list)
{
int opt;
void *handle;
void *symbol;
char *resultname;
char *format;
char *retval;
ffi_type *rettype;
handle = RTLD_DEFAULT;
resultname = "DLRETVAL";
rettype = NULL;
reset_internal_getopt();
// $ dlsym [-n name] [-h handle] symbol
while ((opt = internal_getopt(list, "d:h:n:")) != -1) {
switch (opt) {
case 'd':
if (decode_type_prefix(list_optarg, NULL, &rettype, NULL, &format) != true) {
builtin_warning("failed to parse dereference type");
return 1;
}
break;
case 'n':
resultname = list_optarg;
break;
case 'h':
if (check_parse_ulong(list_optarg, (void *) &handle) == 0) {
builtin_warning("handle %s %p is not well-formed", list_optarg, handle);
return EXECUTION_FAILURE;
}
break;
default:
builtin_usage();
return EX_USAGE;
}
}
// Skip past any options.
if ((list = loptend) == NULL) {
builtin_usage();
return EX_USAGE;
}
if (!(symbol = dlsym(handle, list->word->word))) {
builtin_warning("failed to resolve symbol %s, %s", list->word->word, dlerror());
return EXECUTION_FAILURE;
}
if (rettype == NULL) {
asprintf(&retval, "pointer:%p", symbol);
} else {
retval = encode_primitive_type(format, rettype, symbol);
}
if (interactive_shell) {
fprintf(stderr, "%s\n", retval);
}
bind_variable(resultname, retval, 0);
free(retval);
return EXECUTION_SUCCESS;
}
/* The function implementing the builtin. It uses internal_getopt to
parse options. It is the same as getopt(3), but it takes a pointer
to a WORD_LIST.
If the builtin takes no options, call no_options(list) before doing
anything else. If it returns a non-zero value, your builtin should
immediately return EX_USAGE.
A builtin command returns EXECUTION_SUCCESS for success and
EXECUTION_FAILURE to indicate failure. */
int
readrec_builtin (WORD_LIST *list)
{
SHELL_VAR *var;
rec_parser_t parser;
rec_record_t record;
no_options (list);
/* Create a librec parser to operate on the standard input and try
to read a record. If there is a parse error then report it and
fail. */
parser = rec_parser_new (stdin, "stdin");
if (!parser)
return EXECUTION_FAILURE;
if (!rec_parse_record (parser, &record))
{
return EXECUTION_FAILURE;
}
{
size_t record_str_size = 0;
char *record_str = NULL;
char *record_str_dequoted = NULL;
rec_writer_t writer = rec_writer_new_str (&record_str, &record_str_size);
if (!writer || !rec_write_record (writer, record))
return EXIT_FAILURE;
rec_writer_destroy (writer);
/* Set the REPLY_REC environment variable to the read record. */
record_str_dequoted = dequote_string (record_str);
var = bind_variable ("REPLY_REC", record_str_dequoted, 0);
VUNSETATTR (var, att_invisible);
xfree (record_str_dequoted);
/* Set the environment variables for the fields. */
{
rec_field_t field = NULL;
rec_mset_iterator_t iter = rec_mset_iterator (rec_record_mset (record));
// rec_record_reset_marks (record);
while (rec_mset_iterator_next (&iter, MSET_FIELD, (const void **) &field, NULL))
{
char *var_name = rec_field_name (field);
size_t num_fields = rec_record_get_num_fields_by_name (record, var_name);
// if (rec_record_field_mark (record, field))
// continue;
#if defined ARRAY_VARS
if (num_fields > 1)
{
/* In case several fields share the same field name, create
an array variable containing all the values. */
size_t i = 0;
for (; i < num_fields; i++)
{
// rec_record_mark_field (record, field, true);
field = rec_record_get_field_by_name (record, var_name, i);
var = bind_array_variable (var_name, i, rec_field_value (field), 0);
VUNSETATTR (var, att_invisible);
}
}
else
{
/* Bind a normal variable. */
char *var_value = rec_field_value (field);
var = bind_variable (var_name, var_value, 0);
VUNSETATTR (var, att_invisible);
}
#endif /* ARRAY_VARS */
}
rec_mset_iterator_free (&iter);
}
}
return EXECUTION_SUCCESS;
}
static int generate_native_callback(WORD_LIST *list)
{
int nargs;
void *callback;
ffi_cif *cif;
ffi_closure *closure;
ffi_type **argtypes;
ffi_type *rettype;
char **proto;
char *resultname = "DLRETVAL";
char opt;
reset_internal_getopt();
// $ dlcall [-a abi] [-r type] [-n name]
while ((opt = internal_getopt(list, "a:r:n:")) != -1) {
switch (opt) {
case 'n':
resultname = list_optarg;
break;
default:
builtin_usage();
return EX_USAGE;
}
}
// Skip past any options.
if ((list = loptend) == NULL || !list->next) {
builtin_usage();
return EX_USAGE;
}
closure = ffi_closure_alloc(sizeof(ffi_closure), &callback);
cif = malloc(sizeof(ffi_cif));
argtypes = NULL;
proto = malloc(sizeof(char *));
proto[0] = strdup(list->word->word);
nargs = 0;
list = list->next;
// Second parameter must be the return type
if (decode_type_prefix(list->word->word,
NULL,
&rettype,
NULL,
NULL) != true) {
builtin_warning("couldnt parse the return type %s", list->word->word);
return EXECUTION_FAILURE;
}
// Skip past return type
list = list->next;
while (list) {
argtypes = realloc(argtypes, (nargs + 1) * sizeof(ffi_type *));
proto = realloc(proto, (nargs + 1 + 1) * sizeof(char *));
if (decode_type_prefix(list->word->word, NULL, &argtypes[nargs], NULL, &proto[nargs+1]) != true) {
builtin_error("failed to decode type from parameter %s", list->word->word);
goto error;
}
list = list->next;
nargs++;
}
if (ffi_prep_cif(cif, FFI_DEFAULT_ABI, nargs, rettype, argtypes) == FFI_OK) {
// Initialize the closure.
if (ffi_prep_closure_loc(closure, cif, execute_bash_trampoline, proto, callback) == FFI_OK) {
char retval[1024];
snprintf(retval, sizeof retval, "pointer:%p", callback);
fprintf(stderr, "%s\n", retval);
bind_variable(resultname, retval, 0);
}
}
//free(argtypes);
return 0;
error:
//free(argtypes);
return 1;
}
