[R] Store and retrieve R objects from a password protected file on disk

store7z.R

# Store and retrieve R objects from password protected a file on disk

# ***************
#    Purpose
# ***************
#
# Store R objects into password protected 7z file
# Read them into a R environment

# ***************
#  Requirements
# ***************
#
# linux machine, 7zip, R(3.2.3) packages `magrittr`, `assertthat`

# function pack_ro ----
#
# packs specified objects with names specified by objectNames(character
# vector) into a file on path(preferably does not end with "/").
# Name and password are written to R terminal.
#
pack_ro <- function(objectNames
                    , path = getwd()
                    , pwdLength = 20L){
  # assertions ----
  require("assertthat", quietly = TRUE, warn.conflicts = FALSE)
  require("magrittr", quietly = TRUE, warn.conflicts = FALSE)
  assert_that(class(objectNames) == "character")
  assert_that(file_test("-d", path))
  assert_that(is.writeable(path))
  assert_that(is.count(pwdLength))
  assert_that(all(vapply(objectNames, exists, logical(1))))
  
  # create password ----
  pwd <- paste(sample(c(letters
                        , as.character(0:9)
                        , LETTERS), pwdLength, replace = TRUE)
               , collapse = ""
               , sep = "")
  
  # save objects to a file and compress ----
  tStamp <- Sys.time() %>% gsub(":","_",.) %>% gsub(" ","_",.)
  pathToSave <- file.path(path
                          , paste("pack", "-", tStamp, ".Rda"
                                  , collapse = ""
                                  , sep = ""))
  save(list = objectNames
       , file = pathToSave)
  comTo7z <- paste0("cd "
                    , path
                    , " ; "
                    , "7z a -mx0 -mhe -ms=on -p"
                    , pwd
                    , " "
                    , paste("pack", "-", tStamp, ".7z"
                            , collapse = ""
                            , sep = "")
                    , " "
                    , paste("pack", "-", tStamp, ".Rda"
                            , collapse = ""
                            , sep = ""))
  # no error check on 7z's response
  system(comTo7z, wait = TRUE, ignore.stdout = TRUE)
  
  # clean-up and message ----
  unlink(pathToSave)
 
  pathMsg <- gsub("Rda","7z",pathToSave)

  shaCommand <- paste("shasum ", pathMsg)
  shaString <- system(shaCommand, intern = TRUE) %>% 
                 strsplit(split = " ") %>% 
                   `[[`(1) %>% 
                     `[[`(1)

  resVec        <- c(pwd, pathMsg, shaString)
  names(resVec) <- c("password", "filename", "sha")
  return(resVec)
}

# function unpack_ro ----
#
# unpacks and loads R objects from 7z file into specified R environment.
#
unpack_ro <- function(fileName
                      , pwd
                      , sha
                      , env = globalenv()
                      , destroy7zFile = TRUE){
  # assertions ----
  require("magrittr")
  require("assertthat")
  assert_that(is.string(fileName))
  assert_that(file_test("-f", fileName))
  assert_that(!missing(pwd) && is.string(pwd))
  assert_that(!missing(sha) && is.string(sha))
  assert_that(is.environment(env))
  assert_that(is.flag(destroy7zFile))
  shaCommand <- paste0("shasum ", normalizePath(fileName))
  shaVal <- system(shaCommand, intern = TRUE) %>% 
            strsplit(split = " ") %>% 
            `[[`(1) %>% 
            `[[`(1)
  if (sha!= shaVal) {stop("(unpack_ro)sha value mismatch")}
  
  # extract----
  comTo7z <- paste0("cd "
                    , dirname(fileName)
                    , " ; "
                    , "7z e -p"
                    , pwd
                    , " "
                    , basename(fileName))
  system(comTo7z, wait = TRUE, ignore.stdout = TRUE)
  if (destroy7zFile) {unlink(fileName)}
  
  # load objects into R ----
  old <- ls(envir = env)
  load(gsub("7z","Rda", fileName), envir = env)
  unlink(gsub("7z","Rda", fileName))
  new <- ls(envir = env)
  
  # message about new objects ----
  do.call("message", list(c("Objects added: "
                            , paste(setdiff(new, old), collapse = " "))))
}