From d546322cf8512219f029c910c1883deca68fa8e1 Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Fri, 9 May 2025 17:09:39 +0100 Subject: [PATCH 1/7] correct for time drift --- DESCRIPTION | 2 +- R/string.R | 39 ++++++++++++++++++--------------------- R/utils.R | 2 +- 3 files changed, 20 insertions(+), 23 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ceefb87c..04cf32fb 100644 --- a/DESCRIPTION +++ b/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"), diff --git a/R/string.R b/R/string.R index ec56ae92..30099a25 100644 --- a/R/string.R +++ b/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) } ) } diff --git a/R/utils.R b/R/utils.R index 9fb11a64..16ddfcc7 100644 --- a/R/utils.R +++ b/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) } From b0d17f1ff8b4e0ac711bd0f25bd7d2eb0bcadfa6 Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Fri, 9 May 2025 17:18:55 +0100 Subject: [PATCH 2/7] updated tests --- tests/testthat/test-common.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-common.R b/tests/testthat/test-common.R index 03eef3f7..9d8ff502 100644 --- a/tests/testthat/test-common.R +++ b/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", { From df1d6c844daef00ad32beccb20752e793da32c69 Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Fri, 9 May 2025 23:44:52 +0100 Subject: [PATCH 3/7] cross-platform `ps_string()` --- R/string.R | 48 +++++++++++++++++++++++++++++------------------- man/ps_string.Rd | 6 +++--- 2 files changed, 32 insertions(+), 22 deletions(-) diff --git a/R/string.R b/R/string.R index 30099a25..b84ffc6f 100644 --- a/R/string.R +++ b/R/string.R @@ -24,25 +24,32 @@ ps_string <- function(p = ps_handle()) { ps__str_encode <- function(p) { - 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) - # Assumptions: - # System uptime < 111 years. - # PIDs are not reused within the same millisecond. - # PID <= 7,311,615 (current std max = 4,194,304). + # - Date < 3085-12-14 and System uptime < 1116 years. + # - PIDs are not reused within the same 0.01 seconds. + # - PID <= 7,311,615 (current std max = 4,194,304). - map <- c(letters, LETTERS, 0:9) + # 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()` + + 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, 2) * 100 # 1/100 second resolution + + map <- c(letters, LETTERS, 0:9) paste( collapse = '', map[ 1 + c( - floor(process_id / 52^(3:0)) %% 52, - floor(offset_ms / 62^(6:0)) %% 62 + floor(pid / 52^(3:0)) %% 52, + floor(time / 62^(6:0)) %% 62 ) ] ) @@ -50,22 +57,25 @@ ps__str_encode <- function(p) { 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] * 52^(3:0)) - 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 microseconds tryCatch( expr = { - p <- ps_handle(pid = process_id) - stopifnot(abs(ps_create_time(p) - create_time) < 1 / 1000) + p <- ps_handle(pid = pid) + stopifnot(str == ps__str_encode(p)) p }, error = function(e) { - ps_handle(pid = process_id, time = create_time) + + time <- sum(val[05:11] * 62^(6:0)) / 100 + + if (.Platform$OS.type == "unix") + time <- time + as.numeric(ps_boot_time()) + + ps_handle(pid = pid, time = format_unix_time(time)) } ) } diff --git a/man/ps_string.Rd b/man/ps_string.Rd index 4ac5edd5..9eee2f65 100644 --- a/man/ps_string.Rd +++ b/man/ps_string.Rd @@ -15,9 +15,9 @@ A process string (scalar character), that can be passed to } \description{ A convenient format for passing between processes, naming semaphores, or -using as a directory/file name. Will always be 14 alphanumeric characters, -with the first and last characters guarantied to be letters. Encodes the -pid and creation time for a process. +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. } \examples{ \dontshow{if (ps::ps_is_supported() && ! ps:::is_cran_check()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} From 040ed5318f9baed71d20f1a789f85825d85d4797 Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Sat, 10 May 2025 00:09:19 +0100 Subject: [PATCH 4/7] test ps_string with callr --- tests/testthat/test-common.R | 23 ----------------- tests/testthat/test-z-string.R | 45 ++++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+), 23 deletions(-) create mode 100644 tests/testthat/test-z-string.R diff --git a/tests/testthat/test-common.R b/tests/testthat/test-common.R index 9d8ff502..3c70e888 100644 --- a/tests/testthat/test-common.R +++ b/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)) - - # 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("pid", { ## Argument check expect_error(ps_pid(123), class = "invalid_argument") diff --git a/tests/testthat/test-z-string.R b/tests/testthat/test-z-string.R new file mode 100644 index 00000000..818a9610 --- /dev/null +++ b/tests/testthat/test-z-string.R @@ -0,0 +1,45 @@ +# 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^4)) + + # 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()) + ) + ) + +}) From bf3edcecb47310ab068394a43528857520e2cd6b Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Mon, 12 May 2025 17:57:39 +0100 Subject: [PATCH 5/7] use 12-character string --- R/string.R | 19 ++++++++++--------- R/utils.R | 2 +- man/ps_string.Rd | 2 +- 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/R/string.R b/R/string.R index b84ffc6f..cfee236a 100644 --- a/R/string.R +++ b/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 11 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. #' @@ -25,9 +25,10 @@ ps_string <- function(p = ps_handle()) { ps__str_encode <- function(p) { # Assumptions: - # - Date < 3085-12-14 and System uptime < 1116 years. - # - PIDs are not reused within the same 0.01 seconds. - # - PID <= 7,311,615 (current std max = 4,194,304). + # - Date < 3664-01-26 (Windows only). + # - System uptime < 1694 years (Unix only). + # - PID <= 4,194,304 (current standard maximum). + # - PIDs are not reused within the same millisecond. # Surprisingly, `ps_boot_time()` is not constant from process to process, and # `ps_create_time()` is derived from `ps_boot_time()` on Unix. Therefore: @@ -40,16 +41,16 @@ ps__str_encode <- function(p) { if (.Platform$OS.type == "unix") time <- time - as.numeric(ps_boot_time()) - time <- round(time, 2) * 100 # 1/100 second resolution + time <- round(time, 3) * 1000 # millisecond resolution - map <- c(letters, LETTERS, 0:9) + map <- c(letters, LETTERS) paste( collapse = '', map[ 1 + c( floor(pid / 52^(3:0)) %% 52, - floor(time / 62^(6:0)) %% 62 + floor(time / 52^(7:0)) %% 52 ) ] ) @@ -58,7 +59,7 @@ ps__str_encode <- function(p) { ps__str_decode <- function(str) { - map <- structure(0:61, names = c(letters, LETTERS, 0:9)) + map <- structure(0:51, names = c(letters, LETTERS)) val <- map[strsplit(str, '', fixed = TRUE)[[1]]] pid <- sum(val[01:04] * 52^(3:0)) @@ -70,7 +71,7 @@ ps__str_decode <- function(str) { }, error = function(e) { - time <- sum(val[05:11] * 62^(6:0)) / 100 + time <- sum(val[05:12] * 52^(7:0)) / 1000 if (.Platform$OS.type == "unix") time <- time + as.numeric(ps_boot_time()) diff --git a/R/utils.R b/R/utils.R index 16ddfcc7..aa995e89 100644 --- a/R/utils.R +++ b/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]{7}$", x) + grepl("^[A-Za-z]{4}[A-Za-z0-9]{8}$", x) ) { return(x) } diff --git a/man/ps_string.Rd b/man/ps_string.Rd index 9eee2f65..28610851 100644 --- a/man/ps_string.Rd +++ b/man/ps_string.Rd @@ -15,7 +15,7 @@ A process string (scalar character), that can be passed to } \description{ A convenient format for passing between processes, naming semaphores, or -using as a directory/file name. Will always be 11 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. } From 7653621fa76249005472e0c7a7a389c1c05a519b Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Mon, 12 May 2025 20:01:01 +0100 Subject: [PATCH 6/7] base-62 across the board --- R/string.R | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/R/string.R b/R/string.R index cfee236a..4a724671 100644 --- a/R/string.R +++ b/R/string.R @@ -25,9 +25,9 @@ ps_string <- function(p = ps_handle()) { ps__str_encode <- function(p) { # Assumptions: - # - Date < 3664-01-26 (Windows only). - # - System uptime < 1694 years (Unix only). - # - PID <= 4,194,304 (current standard maximum). + # - 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. # Surprisingly, `ps_boot_time()` is not constant from process to process, and @@ -43,14 +43,14 @@ ps__str_encode <- function(p) { time <- round(time, 3) * 1000 # millisecond resolution - map <- c(letters, LETTERS) + map <- c(letters, LETTERS, 0:9) paste( collapse = '', map[ 1 + c( - floor(pid / 52^(3:0)) %% 52, - floor(time / 52^(7:0)) %% 52 + floor(pid / 62^(3:0)) %% 62, + floor(time / 62^(7:0)) %% 62 ) ] ) @@ -59,9 +59,9 @@ ps__str_encode <- function(p) { ps__str_decode <- function(str) { - map <- structure(0:51, names = c(letters, LETTERS)) + map <- structure(0:61, names = c(letters, LETTERS, 0:9)) val <- map[strsplit(str, '', fixed = TRUE)[[1]]] - pid <- sum(val[01:04] * 52^(3:0)) + pid <- sum(val[01:04] * 62^(3:0)) tryCatch( expr = { @@ -71,7 +71,7 @@ ps__str_decode <- function(str) { }, error = function(e) { - time <- sum(val[05:12] * 52^(7:0)) / 1000 + time <- sum(val[05:12] * 62^(7:0)) / 1000 if (.Platform$OS.type == "unix") time <- time + as.numeric(ps_boot_time()) From 861be2b12b19a5dd89854782667ec7a8508271ee Mon Sep 17 00:00:00 2001 From: Daniel Smith Date: Mon, 12 May 2025 21:12:40 +0100 Subject: [PATCH 7/7] updated regex and tests --- R/utils.R | 2 +- tests/testthat/test-z-string.R | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index aa995e89..77568dd3 100644 --- a/R/utils.R +++ b/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]{8}$", x) + grepl("^[A-Za-z][A-Za-z0-9]{11}$", x) ) { return(x) } diff --git a/tests/testthat/test-z-string.R b/tests/testthat/test-z-string.R index 818a9610..99ab8698 100644 --- a/tests/testthat/test-z-string.R +++ b/tests/testthat/test-z-string.R @@ -6,7 +6,8 @@ test_that("string", { ps <- ps_handle() # Values satisfy encoding assumptions - expect_true(all(ps_pids() < 52^4)) + 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))