Allow R session tools to be optional

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mcptools
 Title: Model Context Protocol Servers and Clients
-Version: 0.1.1.9000
+Version: 0.1.1.9001
 Authors@R: c(
     person("Simon", "Couch", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-5676-5107")),

NEWS.md

@@ -1,5 +1,7 @@
 # mcptools (development version)
 
+`mcp_server()` gains argument `include_session_tools`, allowing users to opt-out of presenting R sessions tools to clients.
+
 # mcptools 0.1.1
 
 Addressed an issue in tests on `r-devel-linux-x86_64-fedora-clang`.

R/server.R

@@ -51,11 +51,8 @@
 #' Examples for Claude Code on WSL and Claude Desktop on Windows are shown
 #' at <https://github.com/posit-dev/mcptools/issues/41#issuecomment-3036617046>.
 #'
-#' @param tools A list of tools created with [ellmer::tool()] that will be
-#' available from the server or a file path to an .R file that, when sourced,
-#' will return a list of tools. Any list that could be passed to
-#' `Chat$set_tools()` can be passed here. By default, the package won't serve
-#' any tools other than those needed to communicate with interactive R sessions.
+#' @param include_session_tools Logical. Include the built-in session tools
+#' (`list_r_sessions`, `select_r_session`) that work with `mcp_session()`. Defaults to `TRUE`.
 #'
 #' @returns
 #' `mcp_server()` and `mcp_session()` are both called primarily for side-effects.
@@ -102,31 +99,43 @@
 #'
 #' @name server
 #' @export
-mcp_server <- function(tools = NULL) {
+mcp_server <- function(tools = NULL, ..., include_session_tools = TRUE) {
   # TODO: should this actually be a check for being called within Rscript or not?
   check_not_interactive()
-  set_server_tools(tools)
+  set_server_tools(tools, include_session_tools)
+
+  the$do_sessions <- isTRUE(include_session_tools)
 
   cv <- nanonext::cv()
+
   reader_socket <- nanonext::read_stdin()
   on.exit(nanonext::reap(reader_socket))
   nanonext::pipe_notify(reader_socket, cv, remove = TRUE, flag = TRUE)
-
-  the$server_socket <- nanonext::socket("poly")
-  on.exit(nanonext::reap(the$server_socket), add = TRUE)
-  nanonext::dial(the$server_socket, url = sprintf("%s%d", the$socket_url, 1L))
-
   client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
-  session <- nanonext::recv_aio(the$server_socket, mode = "string", cv = cv)
 
-  while (nanonext::wait(cv)) {
-    if (!nanonext::unresolved(session)) {
-      handle_message_from_session(session$data)
-      session <- nanonext::recv_aio(the$server_socket, mode = "string", cv = cv)
+  if (the$do_sessions) {
+    the$server_socket <- nanonext::socket("poly")
+    on.exit(nanonext::reap(the$server_socket), add = TRUE)
+    nanonext::dial(the$server_socket, url = sprintf("%s%d", the$socket_url, 1L))
+    session <- nanonext::recv_aio(the$server_socket, mode = "string", cv = cv)
+
+    while (nanonext::wait(cv)) {
+      if (!nanonext::unresolved(session)) {
+        handle_message_from_session(session$data)
+        session <-
+          nanonext::recv_aio(the$server_socket, mode = "string", cv = cv)
+      }
+      if (!nanonext::unresolved(client)) {
+        handle_message_from_client(client$data)
+        client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
+      }
     }
-    if (!nanonext::unresolved(client)) {
-      handle_message_from_client(client$data)
-      client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
+  } else {
+    while (nanonext::wait(cv)) {
+      if (!nanonext::unresolved(client)) {
+        handle_message_from_client(client$data)
+        client <- nanonext::recv_aio(reader_socket, mode = "string", cv = cv)
+      }
     }
   }
 }
@@ -178,10 +187,11 @@ handle_message_from_client <- function(line) {
   } else if (data$method == "tools/call") {
     tool_name <- data$params$name
     if (
-      # two tools provided by mcptools itself which must be executed in
-      # the server rather than a session (#18)
-      tool_name %in%
-        c("list_r_sessions", "select_r_session") ||
+      isFALSE(the$do_sessions) ||
+        # two tools provided by mcptools itself which must be executed in
+        # the server rather than a session (#18)
+        tool_name %in% c("list_r_sessions", "select_r_session") ||
+        # when session handling is disabled, never forward to sessions
         # with no sessions available, just execute tools in the server (#36)
         !nanonext::stat(the$server_socket, "pipes")
     ) {

R/tools.R

@@ -1,7 +1,16 @@
-set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
+set_server_tools <- function(
+  x,
+  include_session_tools = TRUE,
+  x_arg = caller_arg(x),
+  call = caller_env()
+) {
   if (is.null(x)) {
-    the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool))
-    return()
+    if (include_session_tools) {
+      the$server_tools <- c(list(list_r_sessions_tool, select_r_session_tool))
+      return()
+    } else {
+      cli::cli_abort("No tools selected to serve.", call = call)
+    }
   }
 
   # evaluate eagerly so that caller arg is correct if `looks_like_r_file()`
@@ -22,7 +31,11 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
     )
   }
 
-  if (!is_list(x) || !all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) {
+  if (!is.list(x)) {
+    x <- list(x)
+  }
+
+  if (!all(vapply(x, inherits, logical(1), "ellmer::ToolDef"))) {
     msg <-
       "{.arg {x_arg}} must be a list of tools created with {.fn ellmer::tool}
        or a .R file path that returns a list of ellmer tools when sourced."
@@ -39,19 +52,22 @@ set_server_tools <- function(x, x_arg = caller_arg(x), call = caller_env()) {
     )
   ) {
     cli::cli_abort(
-      "The tool names {.field list_r_sessions} and {.field select_r_session} are 
+      "The tool names {.field list_r_sessions} and {.field select_r_session} are
        reserved by {.pkg mcptools}.",
       call = call
     )
   }
 
-  the$server_tools <- c(
-    x,
-    list(
-      list_r_sessions_tool,
-      select_r_session_tool
+  if (include_session_tools) {
+    x <- c(
+      x,
+      list(
+        list_r_sessions_tool,
+        select_r_session_tool
+      )
     )
-  )
+  }
+  the$server_tools <- x
 }
 
 looks_like_r_file <- function(x) {