Skip to content

Instantly share code, notes, and snippets.

@DavisVaughan
Last active September 20, 2024 09:38
Show Gist options
  • Save DavisVaughan/294b6934ae1f291634534ac952dcfa02 to your computer and use it in GitHub Desktop.
Save DavisVaughan/294b6934ae1f291634534ac952dcfa02 to your computer and use it in GitHub Desktop.
r-print-value-from-c
#include <R_ext/Parse.h>
const char* r_print_value(SEXP x) {
// Assign `x` into the global environment under the name `.debug`
Rf_defineVar(Rf_install(".debug"), x, R_GlobalEnv);
// This is the R code that we want to run to print `.debug` and then capture all its printed output
const char* command = "paste0(capture.output(print(.debug)), collapse = '\n')";
SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));
// Parse that command into an actual R expression we can evaluate
// (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
// but we know we only expect to get exactly 1 expression back)
ParseStatus status;
SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
if (status != PARSE_OK) {
Rf_error("failed");
}
if (Rf_xlength(expressions) != 1) {
Rf_error("expected a single expression");
}
SEXP command_expr = VECTOR_ELT(expressions, 0);
// Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
SEXP output = Rf_eval(command_expr, R_GlobalEnv);
R_PreserveObject(output);
// We expect the result to be a character vector of length 1 containing the captured output
SEXP elt = STRING_ELT(output, 0);
const char* v_elt = CHAR(elt);
UNPROTECT(2);
return v_elt;
}
@DavisVaughan
Copy link
Author

DavisVaughan commented Sep 19, 2024

another thought, arbitrary code execution in the R_CurrentEnv() (assuming it worked correctly) - i.e. call r_execute_and_capture("1 + 1")

const char* r_execute_and_capture(const char* x) {
  char command[500];
  snprintf(command, 500, "base::paste0(utils::capture.output(base::print(%s)), collapse = '\n')", x);
  SEXP command_sexp = PROTECT(Rf_allocVector(STRSXP, 1));
  SET_STRING_ELT(command_sexp, 0, Rf_mkCharCE(command, CE_UTF8));

  // Parse that command into an actual R expression we can evaluate
  // (This is a little fiddly because `R_ParseVector()` returns a vector of expressions,
  // but we know we only expect to get exactly 1 expression back)
  ParseStatus status;
  SEXP expressions = PROTECT(R_ParseVector(command_sexp, -1, &status, R_NilValue));
  if (status != PARSE_OK) {
    Rf_error("failed");
  }
  if (Rf_xlength(expressions) != 1) {
    Rf_error("expected a single expression");
  }
  SEXP command_expr = VECTOR_ELT(expressions, 0);

  // Ok, now evaluate the R code `command` from above in the global env, where `.debug` exists
  // TODO: Want to eval this in a try catch so errors dont propagate to the R console
  SEXP output = Rf_eval(command_expr, R_GetCurrentEnv());
  R_PreserveObject(output);

  // We expect the result to be a character vector of length 1 containing the captured output
  SEXP elt = STRING_ELT(output, 0);
  const char* v_elt = CHAR(elt);

  UNPROTECT(2);
  return v_elt;
}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment