rud.is

Rumors of my demise have been (almost) greatly exaggerated.

Folks have probably noticed that #52Vis has stalled, as has most blogging, package & Twitter activity. I came down with a nasty bout of bronchitis after attending rOpenSci Unconf 16 (there were _so_ many people hacking [the sick kind] up a storm in SFO!) and then managed to get pneumonia (which I’m still working through) so any and all awake time has gone to work, class and fam. However, #52Vis winds back up this week, a new R endeavor will be revealed and hopefully I’ll be done with getting ill until Fall.

Getting ill does have some advantages. I completely forgot about renewing SSL/TLS certificates on some (official – yikes!) sites I help manage and decided to have that not be “a thing” moving forward with some help from R. Specifically, I decided to use the `openssl` and `flexdashboard` packages to accomplish my monitoring goals. I’m probably not the only one who needs to care about SSL/TLS certificate renewals so my illness-born-invention is presented below for anyone else to use or mod.

### Flexing flexdashboard muscles

If you haven’t heard about [`flexdashboard`](http://rstudio.github.io/flexdashboard/) then you should visit that link before continuing. It’s an emerging package from the fine folks over at RStudio that makes it super-easy to create quick and pretty dashboards. You can look [at the examples](http://rstudio.github.io/flexdashboard/examples.html) if you want proof. Here’s how `flexdashboard` fit into my goals. I wanted a way to:

– provide a character vector of hosts and ports (you can run SSL/TLS on any port and for many types of services)
– retrieve the certificates at those endpoints
– compare the expiration date to the current date
– provided a dashboard-like view of the state of those certificates, ordered from soonest-expiring to longest-expiring and color-coded (to make it easier to see the certs of impending DOOM)

I immediately thought of `flexdashboard` but my hopes were quickly dashed when all attempts to provide a list of `valueBox()` elements (as I could with `htmlwidgets` in R markdown documents) failed to deliver the desired result of a scrolling, responsive set of boxes.

My workaround was to have an R script create a `flexdashboard` R markdown document on the fly then call `rmarkdown::render()` to generate the final HTML page. Rather than bore you with a tiny view of the sites I work with, I decided to scrape the list of R CRAN mirrors that are SSL/TLS-enabled and present them via this rube goldberg contraption as the show-and-tell example.

The annotated code is below and in [this gist](https://gist.github.com/hrbrmstr/910af8ddc6371572aa4414b77ae86c6a).

library(rvest)
library(urltools)
library(rmarkdown)

# Some Rmd template setup -----------------------------------------------------------

preamble <- '---
title: "CRAN Mirrors Certificate Expiration Dashboard (Days left from %s)"
output:
  flexdashboard::flex_dashboard:
    orientation: rows
    vertical_layout: scroll
---
```{r setup, include=FALSE}
library(flexdashboard)
library(openssl)
library(purrr)
library(dplyr)
library(scales)
'

after_data <- '

dsc <- safely(download_ssl_cert);

expires_delta <- function(site) {

  site_info <- strsplit(site, ":")[[1]]
  port <- as.numeric(site_info[2])

  chain_res <- dsc(site_info[1], port)
  if (!is.null(chain_res$result)) {

    chain <- chain_res$result

    valid_from <- as.Date(as.POSIXct(as.list(chain[[1]])$validity[1],
                                     "%b %d %H:%M:%S %Y", tz="GMT"))
    expires_on <- as.Date(as.POSIXct(as.list(chain[[1]])$validity[2],
                                     "%b %d %H:%M:%S %Y", tz="GMT"))

    data_frame(site=site_info[1],
               valid_from=valid_from,
               expires_on=expires_on,
               cert_valid_length=expires_on-valid_from,
               days_left_from_valid=expires_on - valid_from,
               days_left_from_today=expires_on - Sys.Date(),
               days_left_from_today_lab=comma(expires_on - Sys.Date()),
               color="primary",
               color=ifelse(days_left_from_today<=15, "danger", color),
               color=ifelse(days_left_from_today>15 & days_left_from_today<60, "warning", color))

  } else {

    data_frame(site=site_info[1],
               valid_from=NA,
               expires_on=NA,
               cert_valid_length=NA,
               days_left_from_valid=NA,
               days_left_from_today=NA,
               days_left_from_today_lab="Host unreachable",
               color="info")

  }

}

ssl_df <- arrange(map_df(sites, expires_delta), days_left_from_today)
```

'

# Get a list of all https-enabled CRAN mirrors --------------------------------------

pg <- read_html("https://cran.r-project.org/mirrors.html")
sites <- sprintf("%s:443", domain(html_attr(html_nodes(pg, "td > a[href^='https:']"), "href")))

# Capture this vector for use in the R markdown template ----------------------------

setup_data <- capture.output(dput(sites))

# Create a temporary Rmd file -------------------------------------------------------

dashfile <- tempfile(fileext=".Rmd")

# Write out the initial template bits we've been making -----------------------------

cat(sprintf(preamble, Sys.Date()), "sites <- ", setup_data, after_data, file=dashfile)

# 5 valueBoxes per row seems like a good # ----------------------------------------

max_vbox_per_row <- 5

n_dashrows <- ceiling(length(sites)/max_vbox_per_row)

# Generate a valueBox() per site, making rows every max_vbox_per_row ----------------

for (i in 1:length(sites)) {

  if (((i-1) %% max_vbox_per_row) == 0) {
    cat('
Row
-------------------------------------

', file=dashfile, append=TRUE)
  }

  cat(sprintf("\n### %s\n```{r}\n", gsub(":.*$", "", sites[i])), file=dashfile, append=TRUE)
  cat(sprintf('valueBox(ssl_df[%d, "days_left_from_today_lab"], icon="fa-lock", color=ssl_df[%d, "color"])\n```\n', i, i),
      file=dashfile, append=TRUE)
}

# Temporary html file (you prbly want this more readily available -------------------

dir <- tempfile()
dir.create(dir)
dash_html <- file.path(dir, "sslexpires.html")

# Render the dashboard --------------------------------------------------------------

rmarkdown::render(dashfile, output_file=dash_html)

# View in RStudio -------------------------------------------------------------------

rstudioapi::viewer(dash_html)

# Clean up --------------------------------------------------------------------------

unlink(dashfile)

You can see the output below and can use [this link](/projects/sslexpires.html) to bust the iframe.

You can use different values for the color thresholds or use a different visual display altogether. The `flexdashboard` package works with virtually any widget or static R visualization. You should also look at the frame-busted version and shrink the browser window (or view it on a mobile phone) to see the responsive nature of the framework.

I’m pretty sure the CRAN R mirror that is displaying an error is due to my accessing it via the resolved IPv6 address (I run IPV6 at home and have an IPv6 internet connection) vs the IPv4 address it’s probably actually listening on.

Keep an eye out for #52vis news and the new R project I hinted at in the intro.