Skip to content

Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
rpkyle merged 11 commits into from
Sep 4, 2020
Merged

Provide support for script and stylesheet attributes #226

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
abde5ae
:sparkles: initial support for attributes
Aug 26, 2020
0986fdb
:rotating_light: test for css/js attributes
Aug 26, 2020
b2ff7a1
refactor following comments
Aug 28, 2020
aa63335
:rotating_light: add tests
Aug 28, 2020
5f409ea
update CHANGELOG.md
Aug 28, 2020
3f4296a
:rotating_light: more tests
Aug 29, 2020
2a3fd5b
Merge branch 'dev' into 98-support-attributes
rpkyle Aug 29, 2020
0806ae1
fix src/href swap
Aug 29, 2020
b691f8c
Merge branch '98-support-attributes' of github.com:plotly/dashR into …
Aug 29, 2020
72e67c7
fix flaky test
Sep 1, 2020
9d6851e
handle internal script tags in test
Sep 3, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down
17 changes: 12 additions & 5 deletions R/dash.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
#' @param requests_pathname_prefix Character. A prefix applied to request endpoints
#' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
#' @param external_scripts List. An optional list of valid URLs from which
#' to serve JavaScript source for rendered pages.
#' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
#' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
#' as `integrity` and `crossorigin`.
#' @param external_stylesheets List. An optional list of valid URLs from which
#' to serve CSS for rendered pages.
#' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
#' with `href` (the URL) and optionally other `<link>` tag attributes such as
#' `rel`, `integrity` and `crossorigin`.
#' @param compress Logical. Whether to try to compress files and data served by Fiery.
#' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
#' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
self$config$external_stylesheets <- external_stylesheets
self$config$show_undo_redo <- show_undo_redo
self$config$update_title <- update_title


# ensure attributes are valid, if using a list within a list, elements are all named
assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

# ------------------------------------------------------------
# Initialize a route stack and register a static resource route
# ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

# collect CSS assets from dependencies
if (!(is.null(private$asset_map$css))) {
css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
local = TRUE,
local_path = private$asset_map$css,
prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
# collect JS assets from dependencies
#
if (!(is.null(private$asset_map$scripts))) {
scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
local = TRUE,
local_path = private$asset_map$scripts,
prefix = self$config$requests_pathname_prefix)
Expand Down
155 changes: 126 additions & 29 deletions R/utils.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
# as in Dash for Python
if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
if (!(is_local) & !(is.null(dep$src$href))) {
html <- generate_js_dist_html(href = dep$src$href)
html <- generate_js_dist_html(tagdata = dep$src$href)
} else {
script_mtime <- file.mtime(getDependencyPath(dep))
modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
"&m=",
modified)

html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
}
} else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
dep[["stylesheet"]],
sep="/"),
local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
"?v=",
dep$version)

html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
} else {
sheetpath <- paste0(dep[["src"]][["file"]],
dep[["stylesheet"]],
"?v=",
dep$version)

html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
}

} else {
sheetpath <- paste0(dep[["src"]][["file"]],
dep[["stylesheet"]])
html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
}
}
})
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
local = FALSE,
local_path = NULL,
prefix = NULL,
as_is = FALSE) {
attribs <- names(tagdata)
if (!(local)) {
if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
href,
perl=TRUE) || as_is) {
sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
tagdata,
perl=TRUE)) || as_is) {
if (is.list(tagdata))
glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
else
glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
}
else
stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
} else {
# strip leading slash from href if present
href <- sub("^/", "", href)
modified <- as.integer(file.mtime(local_path))
sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
prefix,
href,
modified)
# strip leading slash from href if present
if (is.list(tagdata)) {
tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
}
else {
tagdata <- sub("^/", "", tagdata)
glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
}
}
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
local = FALSE,
local_path = NULL,
prefix = NULL,
as_is = FALSE) {
attribs <- names(tagdata)
if (!(local)) {
if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
href,
perl=TRUE) || as_is) {
sprintf("<script src=\"%s\"></script>", href)
}
if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
tagdata,
perl=TRUE)) || as_is) {
if (is.list(tagdata))
glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
else
glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
}
else
stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
} else {
# strip leading slash from href if present
href <- sub("^/", "", href)
modified <- as.integer(file.mtime(local_path))
sprintf("<script src=\"%s%s?m=%s\"></script>",
prefix,
href,
modified)
# strip leading slash from href if present
if (is.list(tagdata)) {
tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
}
else {
tagdata <- sub("^/", "", tagdata)
glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
}
}
}

assertValidExternals <- function(scripts, stylesheets) {
allowed_js_attribs <- c("async",
"crossorigin",
"defer",
"integrity",
"nomodule",
"nonce",
"referrerpolicy",
"src",
"type",
"charset",
"language")

allowed_css_attribs <- c("as",
"crossorigin",
"disabled",
"href",
"hreflang",
"importance",
"integrity",
"media",
"referrerpolicy",
"rel",
"sizes",
"title",
"type",
"methods",
"prefetch",
"target",
"charset",
"rev")
script_attributes <- character()
stylesheet_attributes <- character()

for (item in scripts) {
if (is.list(item)) {
if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
item,
perl=TRUE))))
stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
if (any(names(item) == ""))
stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
script_attributes <- c(script_attributes, names(item))
}
else {
if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
item,
perl=TRUE))
stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
script_attributes <- c(script_attributes, character(0))
}
}

for (item in stylesheets) {
if (is.list(item)) {
if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
item,
perl=TRUE))))
stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
if (any(names(item) == ""))
stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
stylesheet_attributes <- c(stylesheet_attributes, names(item))
}
else {
if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
item,
perl=TRUE))
stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
stylesheet_attributes <- c(stylesheet_attributes, character(0))
}
}

invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
}
invisible(TRUE)
}

generate_meta_tags <- function(metas) {
has_ie_compat <- any(vapply(metas, function(x)
x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down
8 changes: 6 additions & 2 deletions man/Dash.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
, 'i'); if (__m === '*' || __re.test(location.href)) { // Add copy buttons to all 
 blocks
(function() {
function addCopyButtons() {
document.querySelectorAll('pre code').forEach(function(codeBlock) {
if (codeBlock.parentElement.hasAttribute('data-copy-added')) return;
codeBlock.parentElement.setAttribute('data-copy-added', 'true');
var btn = document.createElement('button');
btn.textContent = 'Copy';
btn.style.cssText = 'position:absolute;top:4px;right:4px;padding:2px 8px;font-size:11px;background:#4ecdc4;border:none;border-radius:4px;color:#1a1a2e;cursor:pointer;opacity:0.7;transition:opacity 0.2s;';
btn.onmouseover = function() { this.style.opacity = '1'; };
btn.onmouseout = function() { this.style.opacity = '0.7'; };
btn.onclick = function() {
navigator.clipboard.writeText(codeBlock.textContent).then(function() {
btn.textContent = 'Copied!';
setTimeout(function() { btn.textContent = 'Copy'; }, 1500);
});
};
codeBlock.parentElement.style.position = 'relative';
codeBlock.parentElement.appendChild(btn);
});
}
addCopyButtons();
// Re-run on dynamic content
var observer = new MutationObserver(addCopyButtons);
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:Add Copy Buttons to Code Blocks]', __e); }
})();
(function(){
try {
var __m = "github.com";
var __re = new RegExp('^' + "github\\.com" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Force GitHub README to respect dark mode
(function() {
var style = document.createElement('style');
style.textContent = '
.markdown-body {
color-scheme: dark light;
}
.markdown-body pre { background: #161b22 !important; }
.markdown-body code { background: rgba(110, 118, 129, 0.4) !important; }
.markdown-body table th, .markdown-body table td { border-color: #30363d !important; }
.markdown-body img { background: #0d1117; }
.markdown-body blockquote { border-left-color: #8b949e; }
.markdown-body hr { border-color: #30363d; }
';
document.head.appendChild(style);
})();
}
} catch(__e) { console.warn('[Userscript:GitHub Dark Mode README Fix]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Highlight search terms from Google/DuckDuckGo/Bing referrer
(function() {
var ref = document.referrer;
var terms = [];
if (ref.includes('google.com') || ref.includes('duckduckgo.com') || ref.includes('bing.com')) {
var url = new URL(ref);
var q = url.searchParams.get('q') || url.searchParams.get('p');
if (q) {
terms = q.split(/\s+/).filter(function(t) { return t.length > 2; });
}
}
if (terms.length === 0) return;
var style = document.createElement('style');
style.textContent = '.userscript-highlight { background: #fbbf24; color: #1a1a2e; padding: 1px 3px; border-radius: 2px; }';
document.head.appendChild(style);
function highlight(node) {
if (node.nodeType === 3) { // text node
var text = node.textContent;
var found = false;
terms.forEach(function(term) {
var regex = new RegExp('(' + term.replace(/[.*+?^${}()|[\]\\]/g, '\\') + ')', 'gi');
if (regex.test(text)) {
found = true;
var frag = document.createDocumentFragment();
var parts = text.split(regex);
parts.forEach(function(part, i) {
if (i % 2 === 0) {
frag.appendChild(document.createTextNode(part));
} else {
var span = document.createElement('span');
span.className = 'userscript-highlight';
span.textContent = part;
frag.appendChild(span);
}
});
node.parentNode.replaceChild(frag, node);
}
});
} else if (node.nodeType === 1 && node.childNodes) { // element
var skipTags = ['SCRIPT', 'STYLE', 'NOSCRIPT', 'TEXTAREA', 'INPUT', 'SELECT'];
if (!skipTags.includes(node.tagName)) {
Array.from(node.childNodes).forEach(highlight);
}
}
}
highlight(document.body);
// Re-highlight on dynamic content
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(m) {
m.addedNodes.forEach(function(node) {
if (node.nodeType === 1 || node.nodeType === 3) highlight(node);
});
});
});
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:Highlight Search Terms]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Strip utm_, fbclid, gclid, etc. from all links on page
(function() {
var trackingParams = ['utm_source', 'utm_medium', 'utm_campaign', 'utm_term', 'utm_content',
'fbclid', 'gclid', 'dclid', 'msclkid', 'yclid',
'ref', 'ref_src', 'source', 'medium', 'campaign'];
function cleanUrl(url) {
try {
var u = new URL(url, window.location.origin);
var changed = false;
trackingParams.forEach(function(p) {
if (u.searchParams.has(p)) {
u.searchParams.delete(p);
changed = true;
}
});
return changed ? u.toString() : url;
} catch (e) {
return url;
}
}
function cleanLinks() {
document.querySelectorAll('a[href]').forEach(function(a) {
var clean = cleanUrl(a.href);
if (clean !== a.href) a.href = clean;
});
}
cleanLinks();
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(m) {
m.addedNodes.forEach(function(node) {
if (node.nodeType === 1) {
if (node.tagName === 'A') cleanLinks();
node.querySelectorAll('a[href]').forEach(function(a) {
var clean = cleanUrl(a.href);
if (clean !== a.href) a.href = clean;
});
}
});
});
});
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:Remove Tracking Parameters from Links]', __e); }
})();
(function(){
try {
var __m = "youtube.com";
var __re = new RegExp('^' + "youtube\\.com" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Auto-enable theater mode on YouTube
(function() {
function tryTheater() {
var btn = document.querySelector('button[aria-label="Theater mode"], ytd-player #player button[title="Theater mode"]');
if (btn && !btn.classList.contains('activated')) {
btn.click();
}
}
// Try immediately
tryTheater();
// Try after navigation (SPA)
var lastUrl = location.href;
setInterval(function() {
if (location.href !== lastUrl) {
lastUrl = location.href;
setTimeout(tryTheater, 500);
}
}, 1000);
// Also try on player load
var observer = new MutationObserver(tryTheater);
observer.observe(document.body, { childList: true, subtree: true });
})();
}
} catch(__e) { console.warn('[Userscript:YouTube Theater Mode Default]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Remove or un-stick sticky/fixed headers that block content
(function() {
function unstick() {
document.querySelectorAll('header, nav, [role="banner"], .header, .navbar, .sticky, .fixed-top, [style*="position: fixed"], [style*="position:sticky"]').forEach(function(el) {
if (el.style.position === 'fixed' || el.style.position === 'sticky' || getComputedStyle(el).position === 'fixed' || getComputedStyle(el).position === 'sticky') {
el.style.position = 'static';
el.style.top = 'auto';
el.style.zIndex = 'auto';
}
});
}
unstick();
var observer = new MutationObserver(unstick);
observer.observe(document.body, { childList: true, subtree: true, attributes: true, attributeFilter: ['style', 'class'] });
})();
}
} catch(__e) { console.warn('[Userscript:Kill Sticky Headers]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
// Universal Dark Mode - works on any site
(function() {
var enabled = true;
function applyDarkMode() {
if (!enabled) return;
// Create style element if it doesn't exist
var style = document.getElementById('universal-dark-mode-style');
if (!style) {
style = document.createElement('style');
style.id = 'universal-dark-mode-style';
document.head.appendChild(style);
}
// Dark mode CSS - inverts colors but preserves images/video
style.textContent = '
/* Invert everything except media */
html {
filter: invert(1) hue-rotate(180deg) !important;
background: #1a1a2e !important;
}
/* Restore images, videos, iframes, canvas */
img, video, iframe, canvas, svg, picture, [style*="background-image"] {
filter: invert(1) hue-rotate(180deg) !important;
}
/* Preserve specific elements that should not be inverted */
.no-dark-mode, .no-dark-mode *,
[data-theme="light"], [data-theme="light"],
.ace_editor, .ace_editor *,
.CodeMirror, .CodeMirror *,
.monaco-editor, .monaco-editor *,
.markdown-body pre, .markdown-body pre *,
.highlight, .highlight *,
pre code, pre code * {
filter: none !important;
}
/* Fix common UI elements */
.modal, .popup, .dropdown-menu, .tooltip, .popover {
filter: invert(1) hue-rotate(180deg) !important;
background: #2d2d44 !important;
border-color: #444 !important;
}
/* Scrollbars */
::-webkit-scrollbar { background: #1a1a2e !important; }
::-webkit-scrollbar-thumb { background: #444 !important; }
::-webkit-scrollbar-thumb:hover { background: #555 !important; }
/* Selection */
::selection { background: #4ecdc4 !important; color: #1a1a2e !important; }
::-moz-selection { background: #4ecdc4 !important; color: #1a1a2e !important; }
';
}
function removeDarkMode() {
var style = document.getElementById('universal-dark-mode-style');
if (style) style.remove();
}
// Toggle with Alt+Shift+D
document.addEventListener('keydown', function(e) {
if (e.altKey && e.shiftKey && e.key === 'D') {
e.preventDefault();
enabled = !enabled;
if (enabled) {
applyDarkMode();
console.log('[Universal Dark Mode] Enabled');
} else {
removeDarkMode();
console.log('[Universal Dark Mode] Disabled');
}
}
});
// Apply on load
applyDarkMode();
// Re-apply on dynamic content
var observer = new MutationObserver(function(mutations) {
if (enabled && !document.getElementById('universal-dark-mode-style')) {
applyDarkMode();
}
});
observer.observe(document.head, { childList: true });
console.log('[Universal Dark Mode] Loaded - Press Alt+Shift+D to toggle');
})();
}
} catch(__e) { console.warn('[Userscript:Universal Dark Mode]', __e); }
})();
})();
Provide support for script and stylesheet attributes by rpkyle · Pull Request #226 · plotly/dashR · GitHub
Skip to content
Provide support for script and stylesheet attributes#226

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Merged

rpkyle
merged 11 commits into

from

Sep 4, 2020
 Merged


Provide support for script and stylesheet attributes
#226
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


11 commits


Select commit
Hold shift + click to select a range
abde5ae

:sparkles: initial support for attributes

Aug 26, 2020
0986fdb

:rotating_light: test for css/js attributes

Aug 26, 2020
b2ff7a1

refactor following comments

Aug 28, 2020
aa63335

:rotating_light: add tests

Aug 28, 2020
5f409ea

update CHANGELOG.md

Aug 28, 2020
3f4296a

:rotating_light: more tests

Aug 29, 2020
2a3fd5b

Merge branch 'dev' into 98-support-attributes


rpkyle Aug 29, 2020
0806ae1

fix src/href swap

Aug 29, 2020
b691f8c

Merge branch '98-support-attributes' of github.com:plotly/dashR into …

Aug 29, 2020
72e67c7

fix flaky test

Sep 1, 2020
9d6851e

handle internal script tags in test

Sep 3, 2020

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
CHANGELOG.md

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -4,6 +4,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).

## [Unreleased]
### Added
- Support for setting attributes on `external_scripts` and `external_stylesheets`, and validation for the parameters passed (attributes are verified, and elements that are lists themselves must be named). [#226](https://github.com/plotly/dashR/pull/226)
- Dash for R now supports user-defined routes and redirects via the `app$server_route` and `app$redirect` methods. [#225](https://github.com/plotly/dashR/pull/225)

## [0.7.1] - 2020-07-30
Expand Down

17 changes: 12 additions & 5 deletions
R/dash.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -45,9 +45,13 @@ Dash <- R6::R6Class(
 #' @param requests_pathname_prefix Character. A prefix applied to request endpoints
 #' made by Dash's front-end. Environment variable is `DASH_REQUESTS_PATHNAME_PREFIX`.
 #' @param external_scripts List. An optional list of valid URLs from which
 #' to serve JavaScript source for rendered pages.
 #' to serve JavaScript source for rendered pages. Each entry can be a string (the URL)
 #' or a list with `src` (the URL) and optionally other `<script>` tag attributes such
 #' as `integrity` and `crossorigin`.
 #' @param external_stylesheets List. An optional list of valid URLs from which
 #' to serve CSS for rendered pages.
 #' to serve CSS for rendered pages. Each entry can be a string (the URL) or a list
 #' with `href` (the URL) and optionally other `<link>` tag attributes such as 
 #' `rel`, `integrity` and `crossorigin`.
 #' @param compress Logical. Whether to try to compress files and data served by Fiery.
 #' By default, `brotli` is attempted first, then `gzip`, then the `deflate` algorithm,
 #' before falling back to `identity`.
Expand DownExpand Up@@ -103,7 +107,10 @@ Dash <- R6::R6Class(
 self$config$external_stylesheets <- external_stylesheets
 self$config$show_undo_redo <- show_undo_redo
 self$config$update_title <- update_title


 # ensure attributes are valid, if using a list within a list, elements are all named
 assertValidExternals(scripts = external_scripts, stylesheets = external_stylesheets)

 # ------------------------------------------------------------
 # Initialize a route stack and register a static resource route
 # ------------------------------------------------------------
Expand DownExpand Up@@ -1736,7 +1743,7 @@ Dash <- R6::R6Class(

 # collect CSS assets from dependencies
 if (!(is.null(private$asset_map$css))) {
 css_assets <- generate_css_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$css)),
 css_assets <- generate_css_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$css)),
 local = TRUE,
 local_path = private$asset_map$css,
 prefix = self$config$requests_pathname_prefix)
Expand All@@ -1754,7 +1761,7 @@ Dash <- R6::R6Class(
 # collect JS assets from dependencies
 #
 if (!(is.null(private$asset_map$scripts))) {
 scripts_assets <- generate_js_dist_html(href = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 scripts_assets <- generate_js_dist_html(tagdata = paste0(private$assets_url_path, names(private$asset_map$scripts)),
 local = TRUE,
 local_path = private$asset_map$scripts,
 prefix = self$config$requests_pathname_prefix)
Expand Down

155 changes: 126 additions & 29 deletions
R/utils.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -157,7 +157,7 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 # as in Dash for Python
 if ("script" %in% names(dep) && tools::file_ext(dep[["script"]]) != "map") {
 if (!(is_local) & !(is.null(dep$src$href))) {
 html <- generate_js_dist_html(href = dep$src$href)
 html <- generate_js_dist_html(tagdata = dep$src$href)
 } else {
 script_mtime <- file.mtime(getDependencyPath(dep))
 modtime <- as.integer(script_mtime)
Expand All@@ -172,10 +172,10 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "&m=",
 modified)

 html <- generate_js_dist_html(href = dep[["script"]], as_is = TRUE)
 html <- generate_js_dist_html(tagdata = dep[["script"]], as_is = TRUE)
 }
 } else if (!(is_local) & "stylesheet" %in% names(dep) & src == "href") {
 html <- generate_css_dist_html(href = paste(dep[["src"]][["href"]],
 html <- generate_css_dist_html(tagdata = paste(dep[["src"]][["href"]],
 dep[["stylesheet"]],
 sep="/"),
 local = FALSE)
Expand All@@ -192,20 +192,20 @@ render_dependencies <- function(dependencies, local = TRUE, prefix=NULL) {
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]],
 "?v=",
 dep$version)

 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }

 } else {
 sheetpath <- paste0(dep[["src"]][["file"]],
 dep[["stylesheet"]])
 html <- generate_css_dist_html(href = sheetpath, as_is = TRUE)
 html <- generate_css_dist_html(tagdata = sheetpath, as_is = TRUE)
 }
 }
 })
Expand DownExpand Up@@ -536,54 +536,151 @@ get_mimetype <- function(filename) {
 empty = "application/octet-stream"))
}

generate_css_dist_html <- function(href,
generate_css_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<link href=\"%s\" rel=\"stylesheet\">", href)
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), ' rel="stylesheet">')
 else
 glue::glue('<link ', glue::glue('href="{tagdata}"'), ' rel="stylesheet">')
 }
 else
 stop(sprintf("Invalid URL supplied in external_stylesheets. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<link href=\"%s%s?m=%s\" rel=\"stylesheet\">",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$href <- paste0(prefix, sub("^/", "", tagdata$href))
 glue::glue('<link ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), ' rel="stylesheet">')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<link ', glue::glue('href="{prefix}{tagdata}?m={modified}"'), ' rel="stylesheet">')
 }
 }
}

generate_js_dist_html <- function(href,

generate_js_dist_html <- function(tagdata,
 local = FALSE,
 local_path = NULL,
 prefix = NULL,
 as_is = FALSE) {
 attribs <- names(tagdata)
 if (!(local)) {
 if (grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 href,
 perl=TRUE) || as_is) {
 sprintf("<script src=\"%s\"></script>", href)
 }
 if (any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 tagdata,
 perl=TRUE)) || as_is) {
 if (is.list(tagdata))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}"'), sep=" "), '></script>')
 else
 glue::glue('<script ', glue::glue('src="{tagdata}"'), '></script>')
 }
 else
 stop(sprintf("Invalid URL supplied. Please check the syntax used for this parameter."), call. = FALSE)
 } else {
 # strip leading slash from href if present
 href <- sub("^/", "", href)
 modified <- as.integer(file.mtime(local_path))
 sprintf("<script src=\"%s%s?m=%s\"></script>",
 prefix,
 href,
 modified)
 # strip leading slash from href if present
 if (is.list(tagdata)) {
 tagdata$src <- paste0(prefix, sub("^/", "", tagdata$src))
 glue::glue('<script ', glue::glue_collapse(glue::glue('{attribs}="{tagdata}?m={modified}"'), sep=" "), '></script>')
 }
 else {
 tagdata <- sub("^/", "", tagdata)
 glue::glue('<script ', glue::glue('src="{prefix}{tagdata}?m={modified}"'), '></script>')
 }
 }
}

assertValidExternals <- function(scripts, stylesheets) {
 allowed_js_attribs <- c("async",
 "crossorigin",
 "defer",
 "integrity",
 "nomodule",
 "nonce",
 "referrerpolicy",
 "src",
 "type",
 "charset",
 "language")

 allowed_css_attribs <- c("as",
 "crossorigin",
 "disabled",
 "href",
 "hreflang",
 "importance",
 "integrity",
 "media",
 "referrerpolicy",
 "rel",
 "sizes",
 "title",
 "type",
 "methods",
 "prefetch",
 "target",
 "charset",
 "rev")
 script_attributes <- character()
 stylesheet_attributes <- character()

 for (item in scripts) {
 if (is.list(item)) {
 if (!"src" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 script_attributes <- c(script_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_scripts. Please sure no 'src' entries are missing or malformed.", call. = FALSE)
 script_attributes <- c(script_attributes, character(0))
 }
 }

 for (item in stylesheets) {
 if (is.list(item)) {
 if (!"href" %in% names(item) || !(any(grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 if (any(names(item) == ""))
 stop("Please verify that all attributes are named elements when specifying URLs for scripts and stylesheets.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, names(item))
 }
 else {
 if (!grepl("^(?:http(s)?:\\/\\/)?[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+$",
 item,
 perl=TRUE))
 stop("A valid URL must be included with every entry in external_stylesheets. Please sure no 'href' entries are missing or malformed.", call. = FALSE)
 stylesheet_attributes <- c(stylesheet_attributes, character(0))
 }
 }

 invalid_script_attributes <- setdiff(script_attributes, allowed_js_attribs)
 invalid_stylesheet_attributes <- setdiff(stylesheet_attributes, allowed_css_attribs)

 if (length(invalid_script_attributes) > 0 || length(invalid_stylesheet_attributes) > 0) {
 stop(sprintf("The following script or stylesheet attributes are invalid: %s.",
 paste0(c(invalid_script_attributes, invalid_stylesheet_attributes), collapse=", ")), call. = FALSE)
 }
 invisible(TRUE)
 }

generate_meta_tags <- function(metas) {
 has_ie_compat <- any(vapply(metas, function(x)
 x$name == "http-equiv" && x$content == "X-UA-Compatible",
Expand Down

8 changes: 6 additions & 2 deletions
man/Dash.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading