ps_string() 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 11 alphanumeric characters,
 #' with the first character guarantied to be a letter. Encodes the pid and
 #' creation time for a process.
 #'
@@ -18,20 +18,21 @@
 
 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).
+  process_id  <- ps_pid(p)
+  create_secs <- as.numeric(ps_create_time(p))
+  boot_secs   <- as.numeric(ps_boot_time())
+  offset_ms   <- floor((create_secs - boot_secs) * 1000)
 
-  # Note: micro_secs has three extra unused bits
+  # Assumptions:
+  #   System uptime < 111 years.
+  #   PIDs are not reused within the same millisecond.
+  #   PID <= 7,311,615 (current std max = 4,194,304).
 
   map <- c(letters, LETTERS, 0:9)
 
@@ -41,8 +42,7 @@ ps__str_encode <- function(process_id, time) {
       1 +
         c(
           floor(process_id / 52^(3:0)) %% 52,
-          floor(whole_secs / 62^(5:0)) %% 62,
-          floor(micro_secs / 62^(3:0)) %% 62
+          floor(offset_ms  / 62^(6:0)) %% 62
         )
     ]
   )
@@ -53,22 +53,19 @@ ps__str_decode <- function(str) {
   map <- structure(0:61, names = c(letters, LETTERS, 0:9))
   val <- map[strsplit(str, '', fixed = TRUE)[[1]]]
 
-  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')
+  process_id  <- sum(val[01:04] * 52^(3:0))
+  offset_ms   <- sum(val[05:11] * 62^(6:0))
+  create_time <- ps_boot_time() + (offset_ms / 1000)
 
-  # Allow fuzzy-matching the time by +/- 2 microseconds
+  # Allow fuzzy-matching the microseconds
   tryCatch(
     expr = {
       p <- ps_handle(pid = process_id)
-      stopifnot(abs(ps_create_time(p) - time) < 2 / 1000000)
+      stopifnot(abs(ps_create_time(p) - create_time) < 1 / 1000)
       p
     },
     error = function(e) {
-      ps_handle(pid = process_id, time = time)
+      ps_handle(pid = process_id, time = create_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]{4}[A-Za-z0-9]{7}$", x)
   ) {
     return(x)
   }

tests/testthat/test-common.R

@@ -21,8 +21,6 @@ test_that("string", {
 
   # 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))
@@ -34,9 +32,11 @@ test_that("string", {
   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))
+  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("pid", {