From 0b3129cd4bcc597c350803b06a72c72a07cc495a Mon Sep 17 00:00:00 2001
From: shikokuchuo <53399081+shikokuchuo@users.noreply.github.com>
Date: Wed, 11 Sep 2024 21:51:55 +0100
Subject: [PATCH] allow user interrupts

---
 R/server.R    |  7 ++++---
 man/server.Rd |  7 ++++---
 src/server.c  | 32 +++++++++++++-------------------
 3 files changed, 21 insertions(+), 25 deletions(-)

diff --git a/R/server.R b/R/server.R
index 062b1bd63..131aead96 100644
--- a/R/server.R
+++ b/R/server.R
@@ -32,12 +32,13 @@
 #'     string (if of the appropriate type), or otherwise a serialized R object,
 #'     which should be passed to \code{\link{unserialize}}.
 #'
-#'     Use only in a new session. Use \sQuote{ctrl + \\} to forcibly quit
-#'     when finished as the function blocks with no means of interruption.
-#'
 #'     If the expression could not be parsed or evaluated, the response will be
 #'     returned with a status code of 500 and a blank body.
 #'
+#'     User interrupts will only be processed after the next query has been
+#'     completed, hence return from the function may not be immediate. Use
+#'     \sQuote{ctrl + \\} to forcibly quit the entire R session if required.
+#'
 #' @return This function never returns.
 #'
 #' @examples
diff --git a/man/server.Rd b/man/server.Rd
index 5abcaf32a..c724480b5 100644
--- a/man/server.Rd
+++ b/man/server.Rd
@@ -26,11 +26,12 @@ Query the API with an HTTP client using the \sQuote{POST} method,
     string (if of the appropriate type), or otherwise a serialized R object,
     which should be passed to \code{\link{unserialize}}.
 
-    Use only in a new session. Use \sQuote{ctrl + \\} to forcibly quit
-    when finished as the function blocks with no means of interruption.
-
     If the expression could not be parsed or evaluated, the response will be
     returned with a status code of 500 and a blank body.
+
+    User interrupts will only be processed after the next query has been
+    completed, hence return from the function may not be immediate. Use
+    \sQuote{ctrl + \\} to forcibly quit the entire R session if required.
 }
 \examples{
 if (interactive()) {
diff --git a/src/server.c b/src/server.c
index f6bce6c22..2d793c7f8 100644
--- a/src/server.c
+++ b/src/server.c
@@ -243,25 +243,30 @@ void parse_eval_safe(void *data) {
   nano_parse_eval_res = R_ParseEvalString((const char *) data, R_GlobalEnv);
 }
 
-void inproc_server(const char* url) {
+SEXP rnng_rest_server(SEXP url) {
 
+  const char *addr[2] = {CHAR(STRING_ELT(url, 0)), "inproc://n-a-n-o-serv"};
+  nng_thread *thr;
   nng_socket s;
   nng_msg *msg;
   int xc;
 
-  if ((xc = nng_rep0_open(&s)) || (xc = nng_listen(s, url, NULL, 0)))
+  if ((xc = nng_thread_create(&thr, rest_start, (void *) addr)))
+    ERROR_OUT(xc);
+
+  if ((xc = nng_rep0_open(&s)) ||
+      (xc = nng_listen(s, addr[1], NULL, 0)))
     fatal("unable to set up inproc", xc);
 
   for (;;) {
+
     if ((xc = nng_recvmsg(s, &msg, 0)))
       fatal("inproc recvmsg", xc);
 
-    const char *body = nng_msg_body(msg);
-    nano_buf buf;
-
     nano_parse_eval_res = R_BlankScalarString;
-    R_ToplevelExec(parse_eval_safe, (void *) body);
+    R_ToplevelExec(parse_eval_safe, (void *) nng_msg_body(msg));
 
+    nano_buf buf;
     if (TYPEOF(nano_parse_eval_res) == STRSXP) {
       const char *string = NANO_STRING(nano_parse_eval_res);
       buf.buf = (unsigned char *) string;
@@ -274,20 +279,9 @@ void inproc_server(const char* url) {
     if ((xc = nng_sendmsg(s, msg, 0)))
       fatal("inproc sendmsg", xc);
 
-  }
+    R_CheckUserInterrupt();
 
-}
-
-SEXP rnng_rest_server(SEXP url) {
-
-  const char *addr[2] = {CHAR(STRING_ELT(url, 0)), "inproc://n-a-n-o-serv"};
-  nng_thread *thr;
-  int xc;
-
-  if ((xc = nng_thread_create(&thr, rest_start, (void *) addr)))
-    ERROR_OUT(xc);
-
-  inproc_server(addr[1]);
+  }
 
   nng_thread_destroy(thr);
   return R_NilValue;