use R_TopLevelExec() for server error handling

R/server.R

@@ -35,16 +35,16 @@
 #'     Use only in a new session. Use \sQuote{ctrl + \\} to forcibly quit
 #'     when finished as the function blocks with no means of interruption.
 #'
-#'     Currently still experimental as the server lacks error handling. Sending
-#'     an invalid R expression will cause the server to quit.
+#'     If the expression could not be parsed or evaluated, the response will be
+#'     returned with a status code of 500 and a blank body.
 #'
 #' @return This function never returns.
 #'
 #' @examples
 #' if (interactive()) {
 #'
 #' # run server in a new session:
-#' # Rscript -e 'nanonext::server()'
+#' # Rscript -e 'nanonext::server("http://127.0.0.1:5555/api/rest")'
 #'
 #' # query using curl:
 #' # curl -X POST http://127.0.0.1:5555/api/rest -d 'format(Sys.time())'
@@ -55,6 +55,13 @@
 #'   data = "format(Sys.time())"
 #' )
 #'
+#' # error will return status of 500
+#' ncurl(
+#'   "http://127.0.0.1:5555/api/rest",
+#'   method = "POST",
+#'   data = "not_valid()"
+#' )
+#'
 #' res <- ncurl(
 #'   "http://127.0.0.1:5555/api/rest",
 #'   convert = FALSE,

src/server.c

@@ -237,6 +237,12 @@ void rest_start(void *arg) {
 
 }
 
+SEXP nano_eval_res;
+
+void parse_eval_safe(void *data) {
+  nano_eval_res = R_ParseEvalString((const char *) data, R_GlobalEnv);
+}
+
 void inproc_server(const char* url) {
 
   nng_socket s;
@@ -246,22 +252,27 @@ void inproc_server(const char* url) {
   if ((xc = nng_rep0_open(&s)) || (xc = nng_listen(s, url, NULL, 0)))
     fatal("unable to set up inproc", xc);
 
+  nano_eval_res = R_BlankScalarString;
+
   for (;;) {
     if ((xc = nng_recvmsg(s, &msg, 0)))
       fatal("inproc recvmsg", xc);
 
     const char *body = nng_msg_body(msg);
     nano_buf buf;
-    SEXP res = R_ParseEvalString(body, R_GlobalEnv);
-    if (TYPEOF(res) == STRSXP) {
-      const char *string = NANO_STRING(res);
+
+    R_ToplevelExec(parse_eval_safe, (void *) body);
+
+    if (TYPEOF(nano_eval_res) == STRSXP) {
+      const char *string = NANO_STRING(nano_eval_res);
       buf.buf = (unsigned char *) string;
       buf.cur = strlen(string);
     } else {
-      nano_serialize(&buf, res, R_NilValue);
+      nano_serialize(&buf, nano_eval_res, R_NilValue);
     }
     nng_msg_clear(msg);
     nng_msg_append(msg, buf.buf, buf.cur);
+    nano_eval_res = R_BlankScalarString;
     if ((xc = nng_sendmsg(s, msg, 0)))
       fatal("inproc sendmsg", xc);