R-CMD-check / R CMD check (pull_request) Successful in 3m50s
Use system2() with separate args instead of shell-interpolated system() calls in .send_desktop_notify() and .send_webhook(). This eliminates command injection risk when msg, status, url, or payload contain shell metacharacters.
154 lines
5.0 KiB
R
154 lines
5.0 KiB
R
#' Send a CLI beep / desktop notification
|
|
#'
|
|
#' Plays an audible beep in the terminal and/or sends a desktop notification
|
|
#' when a long-running R script completes or reaches a milestone.
|
|
#'
|
|
#' @param msg Character. Optional message to include in the notification.
|
|
#' When `type = "notify"`, this becomes the notification body.
|
|
#' @param type Character. Notification method:
|
|
#' - `"beep"` (default): emit a terminal bell character (`\007`).
|
|
#' Works in any terminal that supports the bell.
|
|
#' - `"notify"`: send a desktop notification via `notify-send` (Linux) or
|
|
#' `osascript` (macOS). Falls back to `"beep"` if neither tool is found.
|
|
#' - `"webhook"`: POST a JSON payload to a URL. Requires `url` argument.
|
|
#' - `"all"`: play beep + send desktop notification (webhook only if `url`
|
|
#' is provided).
|
|
#' @param url Character. Webhook URL for `type = "webhook"` or `"all"`.
|
|
#' A JSON payload is POSTed with keys `message`, `status`, and `timestamp`.
|
|
#' @param status Character. Status label for the notification (default `"done"`).
|
|
#' Used in the notification title and webhook payload.
|
|
#' @param timeout Numeric. Seconds to wait for the webhook POST to complete
|
|
#' (default `5`). Ignored for non-webhook types.
|
|
#' @param quiet Logical. If `TRUE`, suppress the terminal beep even when
|
|
#' `type` includes `"beep"`. Useful for silent background runs.
|
|
#'
|
|
#' @return Invisible `NULL`.
|
|
#'
|
|
#' @section Requirements:
|
|
#' - `type = "notify"` requires `notify-send` (Linux) or `osascript` (macOS).
|
|
#' - `type = "webhook"` requires network access to the provided URL.
|
|
#'
|
|
#' @section Examples:
|
|
#' \preformatted{
|
|
#' # Simple terminal beep
|
|
#' beep()
|
|
#'
|
|
#' # Desktop notification with message
|
|
#' beep("Analysis complete!", type = "notify")
|
|
#'
|
|
#' # Send to a webhook (e.g., Slack, Discord, custom endpoint)
|
|
#' beep("Job finished", type = "webhook",
|
|
#' url = "https://hooks.slack.com/services/...")
|
|
#'
|
|
#' # Beep + desktop notification
|
|
#' beep("Processing done", type = "all")
|
|
#' }
|
|
#'
|
|
#' @export
|
|
#'
|
|
beep <- function(msg = "done",
|
|
type = c("beep", "notify", "webhook", "all"),
|
|
url = NULL,
|
|
status = "done",
|
|
timeout = 5,
|
|
quiet = FALSE) {
|
|
type <- match.arg(type)
|
|
|
|
# -- Terminal beep ----------------------------------------------------------
|
|
if (!quiet && grepl("beep", type)) {
|
|
cat("\007")
|
|
flush.console()
|
|
}
|
|
|
|
# -- Desktop notification ---------------------------------------------------
|
|
if (grepl("notify", type)) {
|
|
.send_desktop_notify(msg, status)
|
|
}
|
|
|
|
# -- Webhook ----------------------------------------------------------------
|
|
if (grepl("webhook", type) && !is.null(url)) {
|
|
.send_webhook(url, msg, status, timeout)
|
|
}
|
|
|
|
invisible(NULL)
|
|
}
|
|
|
|
|
|
# -- Internal helpers ---------------------------------------------------------
|
|
|
|
#' Send a desktop notification via notify-send or osascript
|
|
#'
|
|
#' @param msg Message body
|
|
#' @param status Status label for the title
|
|
#' @keywords internal
|
|
.send_desktop_notify <- function(msg, status) {
|
|
# Linux: notify-send
|
|
if (.has_command("notify-send")) {
|
|
system2("notify-send", args = c(status, msg),
|
|
stdout = TRUE, stderr = TRUE)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
# macOS: osascript
|
|
if (.has_command("osascript")) {
|
|
system2("osascript",
|
|
args = c("-e",
|
|
paste0("display notification \"", msg,
|
|
"\" with title \"", status, "\"")),
|
|
stdout = TRUE, stderr = TRUE)
|
|
return(invisible(NULL))
|
|
}
|
|
|
|
# Neither tool available — silently skip
|
|
invisible(NULL)
|
|
}
|
|
|
|
|
|
#' POST a JSON payload to a webhook URL
|
|
#'
|
|
#' @param url Webhook URL
|
|
#' @param msg Message body
|
|
#' @param status Status label
|
|
#' @param timeout Seconds to wait for the request
|
|
#' @keywords internal
|
|
.send_webhook <- function(url, msg, status, timeout) {
|
|
payload <- jsonlite::toJSON(list(
|
|
message = msg,
|
|
status = status,
|
|
timestamp = format(Sys.time(), "%Y-%m-%dT%H:%M:%S%z")
|
|
), auto_unbox = TRUE)
|
|
|
|
# Use curl via system2() for maximum compatibility (no extra R deps).
|
|
# system2() passes arguments directly to the executable without shell
|
|
# interpolation, avoiding command injection.
|
|
if (.has_command("curl")) {
|
|
system2("curl",
|
|
args = c("-s", "-X", "POST",
|
|
"-H", "Content-Type: application/json",
|
|
"-d", payload,
|
|
url,
|
|
"--max-time", as.character(timeout)),
|
|
stdout = TRUE, stderr = TRUE)
|
|
} else if (.has_command("wget")) {
|
|
system2("wget",
|
|
args = c("-q", "-O", "/dev/null",
|
|
paste0("--post-data=", payload),
|
|
paste0("--header=Content-Type: application/json"),
|
|
paste0("--timeout=", timeout),
|
|
url),
|
|
stdout = TRUE, stderr = TRUE)
|
|
}
|
|
|
|
invisible(NULL)
|
|
}
|
|
|
|
|
|
#' Check if a command exists on the system PATH
|
|
#'
|
|
#' @param cmd Command name
|
|
#' @return Logical
|
|
#' @keywords internal
|
|
.has_command <- function(cmd) {
|
|
Sys.which(cmd) != ""
|
|
}
|