Add security assessment via {oysteR}

DESCRIPTION

@@ -3,7 +3,7 @@ Type: Package
 Title: Risk Metrics to Evaluating R Packages
 Description: Facilities for assessing R packages against a number of metrics to 
     help quantify their robustness.
-Version: 0.2.2
+Version: 0.2.2.9000
 Authors@R: c(
     person("R Validation Hub", role = c("aut"), email = "[email protected]"),
     person("Doug", "Kelkhoff", role = c("aut"), email = "[email protected]"),
@@ -14,6 +14,7 @@ Authors@R: c(
     person("Eric", "Milliman", role = c("aut")),
     person("Juliane", "Manitz", role = c("aut")),
     person("Mark", "Padgham", role = c("ctb")),
+    person("Andrew", "Borgman", role = c("aut")),
     person("PSI special interest group Application and Implementation of Methodologies in Statistics", role = c("cph")))
 URL: https://pharmar.github.io/riskmetric/, https://github.com/pharmaR/riskmetric
 BugReports: https://github.com/pharmaR/riskmetric/issues
@@ -44,7 +45,8 @@ Suggests:
     dplyr,
     testthat,
     webmockr,
-    jsonlite
+    jsonlite,
+    oysteR (>= 0.1.0)
 RoxygenNote: 7.2.3
 VignetteBuilder: knitr
 Config/testthat/edition: 3

NAMESPACE

@@ -42,6 +42,7 @@ S3method(assess_remote_checks,default)
 S3method(assess_remote_checks,pkg_bioc_remote)
 S3method(assess_remote_checks,pkg_cran_remote)
 S3method(assess_reverse_dependencies,default)
+S3method(assess_security,default)
 S3method(assess_size_codebase,default)
 S3method(assess_size_codebase,pkg_install)
 S3method(assess_size_codebase,pkg_source)
@@ -68,6 +69,7 @@ S3method(metric_score,pkg_metric_news_current)
 S3method(metric_score,pkg_metric_r_cmd_check)
 S3method(metric_score,pkg_metric_remote_checks)
 S3method(metric_score,pkg_metric_reverse_dependencies)
+S3method(metric_score,pkg_metric_security)
 S3method(metric_score,pkg_metric_size_codebase)
 S3method(names,pkg_ref)
 S3method(pillar_shaft,list_of_pkg_metric)
@@ -108,6 +110,7 @@ export(assess_news_current)
 export(assess_r_cmd_check)
 export(assess_remote_checks)
 export(assess_reverse_dependencies)
+export(assess_security)
 export(assess_size_codebase)
 export(assessment_error_as_warning)
 export(assessment_error_empty)
@@ -140,6 +143,7 @@ importFrom(pillar,new_pillar_shaft_simple)
 importFrom(pillar,pillar_shaft)
 importFrom(pillar,style_na)
 importFrom(pkgload,parse_ns_file)
+importFrom(stats,setNames)
 importFrom(tibble,as_tibble)
 importFrom(tibble,tibble)
 importFrom(tools,Rd_db)
@@ -154,6 +158,8 @@ importFrom(utils,available.packages)
 importFrom(utils,capture.output)
 importFrom(utils,getS3method)
 importFrom(utils,head)
+importFrom(utils,install.packages)
+importFrom(utils,menu)
 importFrom(utils,packageDescription)
 importFrom(utils,packageName)
 importFrom(utils,packageVersion)

R/assess_security.R

@@ -0,0 +1,55 @@
+#' Assess a package for known security vulnerabilities in the OSS Index
+#'
+#' @param x a \code{pkg_ref} package reference object
+#' @param ... additional arguments passed on to S3 methods, rarely used
+#' @return a \code{pkg_metric} containing Assess for any known security vulnerabilities in the OSS Index via oysteR
+#' @seealso \code{\link{metric_score.pkg_metric_security}}
+#'
+#' @importFrom utils install.packages menu
+#' @export
+assess_security <- function(x, ...) {
+
+  # checks whether a compatible version of oysteR is installed. prompts user to
+  # install or upgrade if needed when running interactively. an error is thrown
+  # in the event a valid oysteR package is not installed.
+  cf <- deparse(match.call()[[1]])
+  validate_suggests_install(pkg_name = "oysteR", calling_fn = cf)
+
+  UseMethod("assess_security")
+}
+
+attributes(assess_security)$column_name <- "security"
+attributes(assess_security)$label <-
+  "number of vulnerabilities detected in OSS Index"
+
+# set as a "Suggests" package to be excluded from all_assessments if the package
+# is not installed
+attributes(assess_security)$suggests <- !requireNamespace("oysteR", quietly = TRUE)
+attributes(assess_security)$suggests_pkg <- "oysteR"
+
+
+#' @export
+assess_security.default <- function(x, ...) {
+  pkg_metric_eval(class = "pkg_metric_security", {
+    x$security
+  })
+}
+
+
+#' Score a package for known security vulnerabilities in the OSS Index
+#'
+#' Coerce the count of reported vulnerabilities to a binary indicator.
+#'
+#' @eval roxygen_score_family("security", dontrun = TRUE)
+#' @return \code{NA} if no vulnerabilities are found, otherwise \code{0}
+#'
+#' @export
+metric_score.pkg_metric_security <- function(x, ...) {
+  if (x < 1) return(NA)
+  else return(0)
+}
+attributes(metric_score.pkg_metric_security)$label <-
+  "A binary indicator of whether a package has OSS Index listed vulnerabilities."
+
+
+

R/options.R

@@ -1,4 +1,5 @@
 riskmetric.options <- list(
   gitlab_api_host = "https://gitlab.com/api/v4",
-  github_api_host = "https://api.github.com"
+  github_api_host = "https://api.github.com",
+  skip_oysteR_install = FALSE
 )

R/pkg_assess.R

@@ -60,19 +60,34 @@ roxygen_assess_family_catalog <- function() {
     "}")
 }
 
-
+#' Helper to determine if assessment depends on package in Suggests
+#'
+#' @param assess_obj An assessment function object
+#' @returns \code{TRUE} if the object does not have an attribute named
+#'   \code{"suggests"} and the negated attribute value if present
+not_suggests <- function(assess_obj) {
+  sg <- attr(assess_obj, "suggests")
+  ifelse(is.null(sg), yes = TRUE, no = !sg)
+}
 
 #' A default list of assessments to perform for each package
 #'
+#' @param include_suggests Logical indicating if assessments requiring
+#'    dependency packages listed in \code{Suggests} be included in the list of
+#'    assessments?
 #' @return a list of assess_* functions exported from riskmetric
 #'
 #' @importFrom utils packageName
 #' @export
-all_assessments <- function() {
+all_assessments <- function(include_suggests = FALSE) {
   fs <- grep("^assess_[^.]*$",
     getNamespaceExports(utils::packageName()),
     value = TRUE)
-  Map(getExportedValue, fs, ns = list(utils::packageName()))
+  fn_objs <- Map(getExportedValue, fs, ns = list(utils::packageName()))
+  if (!include_suggests) {
+    fn_objs <- Filter(not_suggests, fn_objs)
+  }
+  fn_objs
 }
 
 #' Get a specific set of assess_* functions for pkg_assess

R/pkg_ref_cache.R

@@ -122,7 +122,7 @@ available_pkg_ref_fields <- function(x) {
 #' @family package reference cache
 #'
 #' @rdname riskmetric_metadata_caching
-#' @keyworks internal
+#' @keywords internal
 #' @noRd
 pkg_ref_cache <- function(x, name, ..., .class = as.character(name)) {
   UseMethod("pkg_ref_cache", structure(list(), class = .class))

R/pkg_ref_cache_security.R

@@ -0,0 +1,32 @@
+#' Cache OSS Index results
+#'
+#' @inheritParams pkg_ref_cache
+#' @family package reference cache
+#' @return a \code{pkg_ref} object
+#' @keywords internal
+#' @noRd
+pkg_ref_cache.security <- function(x, ...) {
+  validate_suggests_install(
+    pkg_name = "oysteR",
+    calling_fn = deparse(match.call()[[1]])
+  )
+  UseMethod("pkg_ref_cache.security")
+}
+
+#' Check OSS Index lists any vulnerabilities for the package
+#'
+#' @inheritParams pkg_ref_cache
+#' @family package reference cache
+#' @return a \code{pkg_ref} object
+#' @keywords internal
+#' @noRd
+pkg_ref_cache.security.default <- function(x, ...) {
+  scan_results <- oysteR::audit(
+    pkg = x$name,
+    version = as.character(x$version),
+    type = "cran",
+    verbose = FALSE
+  )
+
+  return(sum(scan_results[["no_of_vulnerabilities"]]))
+}

R/utils_suggests.R

@@ -0,0 +1,41 @@
+#' Helper function to prompt to install a package if it is not present
+#'
+#' @keywords internal
+#'
+validate_suggests_install <- function(pkg_name, calling_fn) {
+  # check if package is installed
+  if (!requireNamespace(pkg_name, quietly = TRUE)) {
+    # if not, prompt for install
+    suggests_install_helper(pkg_name, calling_fn)
+  }
+}
+
+#' Helper function to guide user through install of a package
+#'
+#' @importFrom stats setNames
+#' @keywords internal
+#'
+suggests_install_helper <- function(pkg_name, calling_fn) {
+  op_nm <- sprintf("riskmetric.skip_%s_install", pkg_name)
+  if (interactive() & !getOption(op_nm)) {
+    inst_yn <- utils::menu(
+      choices = c("Yes", "No"),
+      title = sprintf(
+        "Running %s requires installation of the of the %s package.
+         Would you like to install this now?",
+        calling_fn, pkg_name
+      )
+    )
+
+    if (inst_yn == "1") {
+      utils::install.packages(pkg_name)
+    } else {
+      # if user skipped once, don't prompt again until session restarts
+      if (inst_yn == "2") do.call(options, as.list(setNames(TRUE, op_nm)))
+      stop(sprintf(
+        "%s not run. Please install the %s package if you wish to proceed.",
+        calling_fn, pkg_name
+      ))
+    }
+  }
+}