Segfault when attempting to parse uploaded xml file within Shiny Server

shiny
1

I am trying to parse an uploaded xml document with Shiny Server and the xml2 package, and I keep getting a segfault (memory not mapped). If I define an xml object within the shiny app and use the xml_text function, no problems. When running locally on Shiny, no problems. I also see the same error when using the XML package instead of the xml2 package-- leading me to believe there is something going on with the xml file upload process, leading to shiny server not being able to map/parse properly. I am certain there is a simple fix for this, but I am at my wits end. Any help is appreciated-- thanks!

Simplified shiny app that causes the error everytime:

library(shiny)
library(xml2)

ui <- fluidPage(
  fileInput("File", "Choose file"),
  tableOutput("Data")
)

server <- function(input, output, session) {
  Data <- eventReactive(input$File, {
    read_xml(input$File$datapath)
    
  })
  
  output$Data <- renderTable({
    head(xml_text(Data()))
  })
  
}

shinyApp(ui, server)

Error log when diving into the linux server:

*** caught segfault ***
address 0x3b00000000, cause 'memory not mapped'

Traceback:
 1: .Call(`_xml2_doc_parse_file`, path, encoding, as_html, options)
 2: doc_parse_file(con, encoding = encoding, as_html = as_html, options = option
s)
 3: read_xml.character(input$File$datapath)
 4: read_xml(input$File$datapath)
 5: eventReactiveHandler(...)
 6: ..stacktraceon..(eventReactiveHandler(...))
 7: handlerFunc()
 8: ..stacktraceon..(expr)
 9: contextFunc()
10: env$runWith(self, func)
11: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphE
nterContext(id)    on.exit(.graphExitContext(id), add = TRUE)    env$runWith(sel
f, func)})
12: ctx$run(function() {    ..stacktraceon..(expr)})
13: ..stacktraceoff..(ctx$run(function() {    ..stacktraceon..(expr)}))
14: isolate(handlerFunc())
15: `<reactive:eventReactive(input$File)>`(...)
16: .func()
17: withVisible(.func())
18: withCallingHandlers({    .error <<- FALSE    withVisible(.func())}, error = function(cond) {
    .value <<- cond    .error <<- TRUE    .visible <<- FALSE})
19: contextFunc()
20: env$runWith(self, func)
21: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphEnterContext(id)
   on.exit(.graphExitContext(id), add = TRUE)    env$runWith(self, func)})
22: ctx$run(function() {    result <- withCallingHandlers({        .error <<- FALSE        withV
isible(.func())    }, error = function(cond) {        .value <<- cond        .error <<- TRUE
    .visible <<- FALSE    })    .value <<- result$value    .visible <<- result$visible})
23: self$.updateValue()
24: ..stacktraceoff..(self$.updateValue())
25: Data()
26: xml_text(Data())
27: head(xml_text(Data()))
28: renderTable(...)
29: func()
30: origRenderFunc(...)
31: `output$Data`(...)
32: ..stacktraceon..(`output$Data`(...))
33: orig(name = name, shinysession = self)
34: func()
35: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact
= TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)
 }})
36: captureStackTraces(expr)
37: withCallingHandlers(captureStackTraces(expr), error = function(e) {    if (inherits(e, "shin
y.silent.error"))         return()    handle <- getOption("shiny.error")    if (is.function(hand
le))         handle()})
38: shinyCallingHandlers(func())
39: doTryCatch(return(expr), name, parentenv, handler)
40: tryCatchOne(expr, names, parentenv, handlers[[1L]])
41: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
42: doTryCatch(return(expr), name, parentenv, handler)
43: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parente
nv, handlers[[nh]])
44: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
45: doTryCatch(return(expr), name, parentenv, handler)
46: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parente
nv, handlers[[nh]])
47: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
48: doTryCatch(return(expr), name, parentenv, handler)
49: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parente
nv, handlers[[nh]])
50: tryCatchList(expr, classes, parentenv, handlers)
51: tryCatch(shinyCallingHandlers(func()), shiny.custom.error = function(cond) {    if (isTRUE(g
etOption("show.error.messages")))         printError(cond)    structure(list(), class = "try-err
or", condition = cond)}, shiny.output.cancel = function(cond) {    structure(list(), class = "ca
ncel-output")}, shiny.silent.error = function(cond) {    structure(list(), class = "try-error",
condition = cond)}, error = function(cond) {    if (isTRUE(getOption("show.error.messages")))
      printError(cond)    if (getOption("shiny.sanitize.errors", FALSE)) {        cond <- simple
Error(paste("An error has occurred. Check your",             "logs or contact the app author for
", "clarification."))    }    invisible(structure(list(), class = "try-error", condition = cond)
)}, finally = {    private$sendMessage(recalculating = list(name = name, status = "recalculated"
))})
52: observerFunc()
53: doTryCatch(return(expr), name, parentenv, handler)
54: tryCatchOne(expr, names, parentenv, handlers[[1L]])
55: tryCatchList(expr, classes, parentenv, handlers)
56: tryCatch(if (..stacktraceon) ..stacktraceon..(observerFunc()) else observerFunc(),     shiny
.silent.error = function(e) NULL)
57: contextFunc()
58: env$runWith(self, func)
59: withReactiveDomain(.domain, {    env <- .getReactiveEnvironment()    .graphEnterContext(id)
   on.exit(.graphExitContext(id), add = TRUE)    env$runWith(self, func)})
60: ctx$run(.func)
61: run()
62: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact
= TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)
 }})
63: captureStackTraces(expr)
64: withCallingHandlers(captureStackTraces(expr), error = function(e) {    if (inherits(e, "shin
y.silent.error"))         return()    handle <- getOption("shiny.error")    if (is.function(hand
le))         handle()})
65: shinyCallingHandlers(run())
66: doTryCatch(return(expr), name, parentenv, handler)
67: tryCatchOne(expr, names, parentenv, handlers[[1L]])
68: tryCatchList(expr, classes, parentenv, handlers)
69: tryCatch({    if (!.destroyed)         shinyCallingHandlers(run())}, error = function(e) {
  printError(e)    if (!is.null(.domain)) {        .domain$unhandledError(e)    }})
70: flushCallback()
71: FUN(X[[i]], ...)
72: lapply(.flushCallbacks, function(flushCallback) {    flushCallback()})
73: ctx$executeFlushCallbacks()
74: .getReactiveEnvironment()$flush()
75: flushReact()
76: force(expr)
77: withRestoreContext(shinysession$restoreContext, {    msg$data <- applyInputHandlers(msg$data
)    switch(msg$method, init = {        serverFunc <- withReactiveDomain(NULL, serverFuncSource(
))        if (!identicalFunctionBodies(serverFunc, appvars$server)) {            appvars$server
<- serverFunc            if (!is.null(appvars$server)) {                attr(appvars$server, "sh
inyServerFunction") <- TRUE                registerDebugHook("server", appvars, "Server Function
")            }        }        if (.globals$showcaseOverride && exists(".clientdata_url_search"
,             where = msg$data)) {            mode <- showcaseModeOfQuerystring(msg$data$.client
data_url_search)            if (!is.null(mode)) shinysession$setShowcase(mode)        }        s
hinysession$manageInputs(msg$data)        if (!is.null(msg$data$.clientdata_singletons)) {
      shinysession$singletons <- strsplit(msg$data$.clientdata_singletons,                 ",")[
[1]]        }        local({            args <- argsForServerFunc(serverFunc, shinysession)
       withReactiveDomain(shinysession, {                do.call(wrapFunctionLabel(appvars$serve
r, "server",                   ..stacktraceon = TRUE), args)            })        })    }, updat
e = {        shinysession$manageInputs(msg$data)    }, shinysession$dispatch(msg))    shinysessi
on$manageHiddenOutputs()    if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID",
     ws$request)) {        shiny_stdout <- get(".shiny__stdout", globalenv())        writeLines(
paste("_n_flushReact ", get("HTTP_GUID", ws$request),             " @ ", sprintf("%.3f", as.nume
ric(Sys.time())), sep = ""),             con = shiny_stdout)        flush(shiny_stdout)        f
lushReact()        writeLines(paste("_x_flushReact ", get("HTTP_GUID", ws$request),
" @ ", sprintf("%.3f", as.numeric(Sys.time())), sep = ""),             con = shiny_stdout)
  flush(shiny_stdout)    }    else {        flushReact()    }    flushAllSessions()})
78: withReactiveDomain(shinysession, {    if (is.character(msg))         msg <- charToRaw(msg)
  traceOption <- getOption("shiny.trace", FALSE)    if (isTRUE(traceOption) || traceOption == "r
ecv") {        if (binary)             message("RECV ", "$$binary data$$")        else message("
RECV ", rawToChar(msg))    }    if (isEmptyMessage(msg))         return()    msg <- decodeMessag
e(msg)    if (is.null(shinysession$restoreContext)) {        bookmarkStore <- getShinyOption("bo
okmarkStore", default = "disable")        if (bookmarkStore == "disable") {            shinysess
ion$restoreContext <- RestoreContext$new()        }        else {            shinysession$restor
eContext <- RestoreContext$new(msg$data$.clientdata_url_search)        }    }    withRestoreCont
ext(shinysession$restoreContext, {        msg$data <- applyInputHandlers(msg$data)        switch
(msg$method, init = {            serverFunc <- withReactiveDomain(NULL, serverFuncSource())
       if (!identicalFunctionBodies(serverFunc, appvars$server)) {                appvars$server
 <- serverFunc                if (!is.null(appvars$server)) {                  attr(appvars$serv
er, "shinyServerFunction") <- TRUE                  registerDebugHook("server", appvars, "Server
 Function")                }            }            if (.globals$showcaseOverride && exists(".c
lientdata_url_search",                 where = msg$data)) {                mode <- showcaseModeO
fQuerystring(msg$data$.clientdata_url_search)                if (!is.null(mode)) shinysession$se
tShowcase(mode)            }            shinysession$manageInputs(msg$data)            if (!is.n
ull(msg$data$.clientdata_singletons)) {                shinysession$singletons <- strsplit(msg$d
ata$.clientdata_singletons,                   ",")[[1]]            }            local({
       args <- argsForServerFunc(serverFunc, shinysession)                withReactiveDomain(shi
nysession, {                  do.call(wrapFunctionLabel(appvars$server, "server",
      ..stacktraceon = TRUE), args)                })            })        }, update = {
    shinysession$manageInputs(msg$data)        }, shinysession$dispatch(msg))        shinysessio
n$manageHiddenOutputs()        if (exists(".shiny__stdout", globalenv()) && exists("HTTP_GUID",
            ws$request)) {            shiny_stdout <- get(".shiny__stdout", globalenv())
    writeLines(paste("_n_flushReact ", get("HTTP_GUID",                 ws$request), " @ ", spri
ntf("%.3f", as.numeric(Sys.time())),                 sep = ""), con = shiny_stdout)            f
lush(shiny_stdout)            flushReact()            writeLines(paste("_x_flushReact ", get("HT
TP_GUID",                 ws$request), " @ ", sprintf("%.3f", as.numeric(Sys.time())),
       sep = ""), con = shiny_stdout)            flush(shiny_stdout)        }        else {
       flushReact()        }        flushAllSessions()    })})
79: messageHandler(binary, msg)
80: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact
= TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)
 }})
81: captureStackTraces(expr)
82: withCallingHandlers(captureStackTraces(expr), error = function(cond) {    if (inherits(cond,
 "shiny.silent.error"))         return()    if (isTRUE(getOption("show.error.messages"))) {
   printError(cond, full = full, offset = offset)    }})
83: withLogErrors(messageHandler(binary, msg))
84: handler(binary, message)
85: doTryCatch(return(expr), name, parentenv, handler)
86: tryCatchOne(expr, names, parentenv, handlers[[1L]])
87: tryCatchList(expr, classes, parentenv, handlers)
88: tryCatch(expr, error = function(e) {    call <- conditionCall(e)    if (!is.null(call)) {
     if (identical(call[[1L]], quote(doTryCatch)))             call <- sys.call(-4L)        dcal
l <- deparse(call)[1L]        prefix <- paste("Error in", dcall, ": ")        LONG <- 75L
 msg <- conditionMessage(e)        sm <- strsplit(msg, "\n")[[1L]]        w <- 14L + nchar(dcall
, type = "w") + nchar(sm[1L], type = "w")        if (is.na(w))             w <- 14L + nchar(dcal
l, type = "b") + nchar(sm[1L],                 type = "b")        if (w > LONG)             pref
ix <- paste0(prefix, "\n  ")    }    else prefix <- "Error : "    msg <- paste0(prefix, conditio
nMessage(e), "\n")    .Internal(seterrmessage(msg[1L]))    if (!silent && identical(getOption("s
how.error.messages"),         TRUE)) {        cat(msg, file = outFile)        .Internal(printDef
erredWarnings())    }    invisible(structure(msg, class = "try-error", condition = e))})
89: try(handler(binary, message))
90: (function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle)]]$.m
essageCallbacks) {        result <- try(handler(binary, message))        if (inherits(result, "t
ry-error")) {            .wsconns[[as.character(handle)]]$close()            return()        }
  }})("75427280", FALSE, "{\"method\":\"uploadEnd\",\"args\":[\"d1c9e805d125c4009e9a54fa\",\"Fil
e\"],\"tag\":1}")
91: evalq((function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle
)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inherits(resu
lt, "try-error")) {            .wsconns[[as.character(handle)]]$close()            return()
   }    }})("75427280", FALSE, "{\"method\":\"uploadEnd\",\"args\":[\"d1c9e805d125c4009e9a54fa\"
,\"File\"],\"tag\":1}"),     <environment>)
92: evalq((function (handle, binary, message) {    for (handler in .wsconns[[as.character(handle
)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inherits(resu
lt, "try-error")) {            .wsconns[[as.character(handle)]]$close()            return()
   }    }})("75427280", FALSE, "{\"method\":\"uploadEnd\",\"args\":[\"d1c9e805d125c4009e9a54fa\"
,\"File\"],\"tag\":1}"),     <environment>)
93: doTryCatch(return(expr), name, parentenv, handler)
94: tryCatchOne(expr, names, parentenv, handlers[[1L]])
95: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
96: doTryCatch(return(expr), name, parentenv, handler)
97: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]),     names[nh], parente
nv, handlers[[nh]])
98: tryCatchList(expr, classes, parentenv, handlers)
99: tryCatch(evalq((function (handle, binary, message) {    for (handler in .wsconns[[as.charact
er(handle)]]$.messageCallbacks) {        result <- try(handler(binary, message))        if (inhe
rits(result, "try-error")) {            .wsconns[[as.character(handle)]]$close()            retu
rn()        }    }})("75427280", FALSE, "{\"method\":\"uploadEnd\",\"args\":[\"d1c9e805d125c4009
e9a54fa\",\"File\"],\"tag\":1}"),     <environment>), error = function (x) x, interrupt = functi
on (x) x)
100: .Call("httpuv_run", PACKAGE = "httpuv", timeoutMillis)
101: run(timeoutMs)
102: service(timeout)
103: serviceApp()
104: withCallingHandlers(expr, error = function(e) {    if (is.null(attr(e, "stack.trace", exact
 = TRUE))) {        calls <- sys.calls()        attr(e, "stack.trace") <- calls        stop(e)
  }})
105: captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {        serviceApp()
       Sys.sleep(0.001)    }})
106: ..stacktraceoff..(captureStackTraces({    scheduleFlush()    while (!.globals$stopped) {
     serviceApp()        Sys.sleep(0.001)    }}))
107: runApp(Sys.getenv("SHINY_APP"), port = port, launch.browser = FALSE)
An irrecoverable exception occurred. R is aborting now ...
-bash: line 1:  9860 Segmentation fault      (core dumped) R --no-save --slave -f \/opt\/shiny-s
erver\/R\/SockJSAdapter\.R

No error when defining the xml object within the server side of the Shiny app

library(shiny)
library(xml2)


ui <- fluidPage(
  fileInput("File", "Choose file"),
  tableOutput("Data")
)

server <- function(input, output, session) {
  Data <- eventReactive(input$File, {
    # read_xml(input$File$datapath)
    read_xml("<p>Hello World!</p>")
  })
  
  
  output$Data <- renderTable({
    head(xml_text(Data()))
  })
  
}

shinyApp(ui, server)
2

We've seen cases where people have segfaults when they upgrade their version of R on Linux but continue to use packages that were installed with the older version of R. This article explains how to diagnose the problem and solve it:
http://shiny.rstudio.com/articles/upgrade-R.html

3

Great! Thanks for pointing me in the right direction-- Ill check out the link you forwarded and report back shortly.

4

Hi Winston,
I checked out the installed packages and base R (all 3.4.2), but it looks like I am still getting the same memory not mapped segfault. I can use the xml2 package when an xml object is defined in the code (so it seems the xml2 package is okay), but when I upload an xml file via Shiny (FileInput) that is when I get the segfault. Any advice would be much appreciated-- thanks!

5

Sorry I did not reply earlier. The Shiny application typically runs as a user like shiny, or perhaps as your user on the system. Did you make sure that all the packages were upgraded for the user that the Shiny application runs as?

6

Hi Winston,
Yes, I upgraded all packages on the Linux server. I actually have moved on from this-- instead of uploading an XML file I tweaked my script to accept .xlsx files and I am using the readxl package with no issues. I am still curious why I am having issues with .XML files though.... Thanks for your help!

-brad