1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
#' @include globals.R
NULL
reactLogHandler <- function(req) {
if (! rLog$isLogging()) {
if (
identical(req$PATH_INFO, "/reactlog/mark") ||
identical(req$PATH_INFO, "/reactlog")
) {
# is not logging, but is a reactlog path...
return(
httpResponse(
# Not Implemented
# - The server either does not recognize the request method, or it lacks the ability to fulfil the request.
status = 501,
content_type = "text/plain; charset=utf-8",
content = "To enable reactlog, set the following option before running the application: \n\noptions(shiny.reactlog = TRUE)"
)
)
} else {
# continue on like normal
return(NULL)
}
}
if (identical(req$PATH_INFO, "/reactlog/mark")) {
sessionToken <- parseQueryString(req$QUERY_STRING)$s
shinysession <- appsByToken$get(sessionToken)
# log time
withReactiveDomain(shinysession, {
rLog$userMark(getDefaultReactiveDomain())
})
return(httpResponse(
status = 200,
content = "marked",
content_type = "text/plain"
))
} else if (identical(req$PATH_INFO, "/reactlog")){
sessionToken <- parseQueryString(req$QUERY_STRING)$s
# `renderReactLog` will check/throw if reactlog doesn't exist
reactlogFile <- renderReactlog(sessionToken)
return(httpResponse(
status = 200,
content = list(
file = reactlogFile,
owned = TRUE
)
))
} else {
# continue on like normal
return(NULL)
}
}
sessionHandler <- function(req) {
path <- req$PATH_INFO
if (is.null(path))
return(NULL)
matches <- regmatches(path, regexec('^(/session/([0-9a-f]+))(/.*)$', path))
if (length(matches[[1]]) == 0)
return(NULL)
session <- matches[[1]][3]
subpath <- matches[[1]][4]
shinysession <- appsByToken$get(session)
if (is.null(shinysession))
return(NULL)
subreq <- as.environment(as.list(req, all.names=TRUE))
subreq$PATH_INFO <- subpath
subreq$SCRIPT_NAME <- paste(subreq$SCRIPT_NAME, matches[[1]][2], sep='')
withReactiveDomain(shinysession, {
shinysession$handleRequest(subreq)
})
}
|
