From 2ef75fe7e45ef994a2f29769c35902591c04d321 Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Sat, 27 Jun 2020 20:27:10 +0200 Subject: [PATCH 1/2] Add noLD changes to changelog --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 042f173..6b7c087 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## Minor changes +* fixed tests on platform with no long-doubles ('noLD') * restored tests on 32bits machines * `spec_ID` extraction from Avantes exported files (`ttt` and `trt`) is now more robust, meaning it should work for more files. From 561daaa2c3352e373be57a5809a26395ed367e3e Mon Sep 17 00:00:00 2001 From: Hugo Gruson Date: Mon, 29 Jun 2020 10:18:23 +0200 Subject: [PATCH 2/2] Add code to verify procspec files --- R/parse_procspec.R | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/R/parse_procspec.R b/R/parse_procspec.R index 2126edd..0271ab8 100644 --- a/R/parse_procspec.R +++ b/R/parse_procspec.R @@ -4,6 +4,8 @@ #' #' #' @inheritParams lr_parse_generic +#' @param check Logical (defaults to `FALSE`). Should we check if the file has +#' been modified since its creation by the spectrometer? #' #' @inherit lr_parse_generic return details #' @@ -14,11 +16,11 @@ #' @examples #' lr_parse_procspec(system.file("testdata", "procspec_files", #' "OceanOptics_Linux.ProcSpec", -#' package = "lightr")) +#' package = "lightr"), check = TRUE) #' #' @export #' -lr_parse_procspec <- function(filename) { +lr_parse_procspec <- function(filename, check = FALSE) { # We let R find the suitable tmp folder to extract files tmp <- tempdir() @@ -32,6 +34,30 @@ lr_parse_procspec <- function(filename) { # Data files have the format ps_\d+.xml data_file <- grep(pattern = "ps_\\d+\\.xml", extracted_files, value = TRUE) + if (check) { + if (!requireNamespace("openssl")) { + warning("The openssl package is required for check = TRUE. ", + "Skipping integrity check...", call. = FALSE) + } else { + sig <- read_xml(grep(pattern = "OOISignatures\\.xml$", extracted_files, value = TRUE)) + saved_hash <- xml_text(xml_find_first(sig, ".//hashValue")) + saved_hash <- gsub(" ", "", saved_hash) + algo <- xml_text(xml_find_first(sig, ".//hashAlgorithm")) + if (algo == "SHA-512") { + actual_hash <- as.character(openssl::sha512(file(data_file))) + } else { + warning("Unknown hash in signature. Skipping.", call. = FALSE) + actual_hash <- saved_hash + } + if (actual_hash != saved_hash) { + stop( + "The file has been modified since its creation by the spectrometer. ", + "This can have serious consequences!\n", + "To bypass the warning, use 'check = FALSE'", call. = FALSE) + } + } + } + # OceanOptics softwares produce badly encoded characters. The only fix is to # strip them before feeding the xml file to read_xml. plain_text <- scan(data_file, what = character(), sep = "\n", quiet = TRUE)