ps_string() cross-platform correction for time drift

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ps
 Title: List, Query, Manipulate System Processes
-Version: 1.9.1.9001
+Version: 1.9.1.9002
 Authors@R: c(
     person("Jay", "Loden", role = "aut"),
     person("Dave", "Daeschler", role = "aut"),

R/string.R

@@ -1,7 +1,7 @@
 #' Encode a `ps_handle` as a short string
 #'
 #' A convenient format for passing between processes, naming semaphores, or
-#' using as a directory/file name. Will always be 14 alphanumeric characters,
+#' using as a directory/file name. Will always be 12 alphanumeric characters,
 #' with the first character guarantied to be a letter. Encodes the pid and
 #' creation time for a process.
 #'
@@ -18,57 +18,65 @@
 
 ps_string <- function(p = ps_handle()) {
   assert_ps_handle(p)
-  ps__str_encode(ps_pid(p), ps_create_time(p))
+  ps__str_encode(p)
 }
 
 
-ps__str_encode <- function(process_id, time) {
-  whole_secs <- as.integer(time)
-  micro_secs <- as.numeric(time) %% 1 * 1000000
+ps__str_encode <- function(p) {
 
   # Assumptions:
-  #   time between Jan 1st 1970 and Dec 5th 3769.
-  #   max time precision = 1/1,000,000 of a second.
-  #   pid <= 7,311,615 (current std max = 4,194,304).
+  #   - Date < 8888-12-02 (Windows only).
+  #   - System uptime < 6918 years (Unix only).
+  #   - PID <= 768,369,472 (current std max = 4,194,304).
+  #   - PIDs are not reused within the same millisecond.
 
-  # Note: micro_secs has three extra unused bits
+  # Surprisingly, `ps_boot_time()` is not constant from process to process, and
+  # `ps_create_time()` is derived from `ps_boot_time()` on Unix. Therefore:
+  #   - On Windows, encode `ps_create_time()`
+  #   - On Unix, encode `ps_create_time() - `ps_boot_time()`
 
-  map <- c(letters, LETTERS, 0:9)
+  pid  <- ps_pid(p)
+  time <- as.numeric(ps_create_time(p))
+
+  if (.Platform$OS.type == "unix")
+    time <- time - as.numeric(ps_boot_time())
+
+  time <- round(time, 3) * 1000 # millisecond resolution
 
+  map <- c(letters, LETTERS, 0:9)
   paste(
     collapse = '',
     map[
       1 +
         c(
-          floor(process_id / 52^(3:0)) %% 52,
-          floor(whole_secs / 62^(5:0)) %% 62,
-          floor(micro_secs / 62^(3:0)) %% 62
+          floor(pid  / 62^(3:0)) %% 62,
+          floor(time / 62^(7:0)) %% 62
         )
     ]
   )
 }
 
 
 ps__str_decode <- function(str) {
+
   map <- structure(0:61, names = c(letters, LETTERS, 0:9))
   val <- map[strsplit(str, '', fixed = TRUE)[[1]]]
+  pid <- sum(val[01:04] * 62^(3:0))
 
-  process_id <- sum(val[01:04] * 52^(3:0))
-  whole_secs <- sum(val[05:10] * 62^(5:0))
-  micro_secs <- sum(val[11:14] * 62^(3:0))
-
-  time <- whole_secs + (micro_secs / 1000000)
-  time <- as.POSIXct(time, tz = 'GMT', origin = '1970-01-01')
-
-  # Allow fuzzy-matching the time by +/- 2 microseconds
   tryCatch(
     expr = {
-      p <- ps_handle(pid = process_id)
-      stopifnot(abs(ps_create_time(p) - time) < 2 / 1000000)
+      p <- ps_handle(pid = pid)
+      stopifnot(str == ps__str_encode(p))
       p
     },
     error = function(e) {
-      ps_handle(pid = process_id, time = time)
+
+      time <- sum(val[05:12] * 62^(7:0)) / 1000
+
+      if (.Platform$OS.type == "unix")
+        time <- time + as.numeric(ps_boot_time())
+
+      ps_handle(pid = pid, time = format_unix_time(time))
     }
   )
 }

R/utils.R

@@ -137,7 +137,7 @@ assert_pid <- function(x) {
     is.character(x) &&
       length(x) == 1 &&
       !is.na(x) &&
-      grepl("^[A-Za-z]{4}[A-Za-z0-9]{10}$", x)
+      grepl("^[A-Za-z][A-Za-z0-9]{11}$", x)
   ) {
     return(x)
   }

tests/testthat/test-common.R

@@ -16,29 +16,6 @@ test_that("print", {
   expect_output(print(ps), format_regexp())
 })
 
-test_that("string", {
-  ps <- ps_handle()
-
-  # Values satisfy encoding assumptions
-  expect_true(all(ps_pids() < 52^4))
-  expect_true(Sys.time() < 62^6 * .99)
-  expect_identical(nchar(format(ps_create_time(), "%OS8")), 9L)
-
-  # Roundtrip through ps_string
-  str <- expect_silent(ps_string(ps))
-  ps2 <- expect_silent(ps_handle(str))
-
-  # Got the same process back
-  expect_true(ps_is_running(ps2))
-  expect_identical(ps_pid(ps), ps_pid(ps2))
-  expect_identical(ps_ppid(ps), ps_ppid(ps2))
-
-  # Invalid process
-  str <- ps__str_encode(ps_pid(ps), ps_create_time(ps) + 1)
-  ps3 <- expect_silent(ps_handle(str))
-  expect_false(ps_is_running(ps3))
-})
-
 test_that("pid", {
   ## Argument check
   expect_error(ps_pid(123), class = "invalid_argument")

tests/testthat/test-z-string.R

@@ -0,0 +1,46 @@
+# Named 'test-z-string' so it will run last.
+# Testing for errors that crop up due to differences
+# in start (load/attach) time for `ps`.
+
+test_that("string", {
+  ps <- ps_handle()
+
+  # Values satisfy encoding assumptions
+  expect_true(all(ps_pids() < 52 * 62^3))
+  expect_lt(Sys.time(), (62^8 / 1000) * 0.99)
+
+  # Roundtrip through ps_string
+  str <- expect_silent(ps_string(ps))
+  ps2 <- expect_silent(ps_handle(str))
+
+  # Got the same process back
+  expect_true(ps_is_running(ps2))
+  expect_identical(ps_pid(ps), ps_pid(ps2))
+  expect_identical(ps_ppid(ps), ps_ppid(ps2))
+
+  # Invalid process
+  ps2 <- expect_silent(ps_handle(ps_pid(ps), ps_create_time(ps) + 1))
+  expect_false(ps_is_running(ps2))
+  str <- expect_silent(ps_string(ps2))
+  ps2 <- expect_silent(ps_handle(str))
+  expect_false(ps_is_running(ps2))
+
+})
+
+
+test_that("ipc string", {
+
+  skip_on_cran()
+  skip_on_covr()
+
+  expect_true(
+    callr::r(
+      function(str) {
+        ps <- ps::ps_handle(str)
+        ps::ps_is_running(ps)
+      },
+      args = list(str = ps_string())
+    )
+  )
+
+})