diff --git a/doc/specs/stdlib_system.md b/doc/specs/stdlib_system.md index 3dbe434fe..ee1892e33 100644 --- a/doc/specs/stdlib_system.md +++ b/doc/specs/stdlib_system.md @@ -284,6 +284,31 @@ This is an `intent(inout)` argument, and on return is updated with the terminate {!example/system/example_process_4.f90!} ``` +## `send_signal`- send (POSIX) signal to a process + +### Status + +Experimental + +### Description + +The `send_signal` interface is used to send POSIX signal to a running external process. +It attempts to send the signal and returns a boolean flag indicating whether the operation was successful. +It does not do anything on Windows (no-op). + +### Syntax + +`call ` [[stdlib_subprocess(module):send_signal(subroutine)]] `(process, signal, success)` + +### Arguments + +`process`: Shall be a `type(process_type)` object representing the external process to be terminated. +This is an `intent(inout)` argument, and on return is updated with the terminated process state. + +`signal`: Shall be a `integer` variable representing the signal number to be sent. + +`success`: Shall be a `logical` variable. It is set to `.true.` if the signal was sent successfully, or `.false.` otherwise. + ## `sleep` - Pause execution for a specified time in milliseconds ### Status diff --git a/example/system/CMakeLists.txt b/example/system/CMakeLists.txt index f5518b74b..833e2ed2f 100644 --- a/example/system/CMakeLists.txt +++ b/example/system/CMakeLists.txt @@ -7,4 +7,5 @@ ADD_EXAMPLE(process_4) ADD_EXAMPLE(process_5) ADD_EXAMPLE(process_6) ADD_EXAMPLE(process_7) +ADD_EXAMPLE(process_8) ADD_EXAMPLE(sleep) diff --git a/example/system/example_process_8.f90 b/example/system/example_process_8.f90 new file mode 100644 index 000000000..e143ed2a4 --- /dev/null +++ b/example/system/example_process_8.f90 @@ -0,0 +1,43 @@ +! Process example 4: send a posix signal to a running process +! no-op on Windows +program example_process_send_signal + use stdlib_system, only: process_type, runasync, is_running, send_signal, is_windows, sleep + implicit none + type(process_type) :: process + logical :: running, success + + integer, parameter :: SIGTERM = 15 + + if (is_windows()) then + print *, "This is a no-op on Windows" + stop 0 + end if + + print *, "Starting a long-running process..." + ! choosing ping as SIGTERM causes it to exit + process = runasync("ping -c 10 127.0.0.1") + + ! Verify the process is running + running = is_running(process) + print *, "Process running:", running + + ! Wait a bit before sending a signal + call sleep(250) + + print *, "Sending SIGTERM to the process" + call send_signal(process, SIGTERM, success) + + if (success) then + print *, "Signal sent successfully" + else + print *, "Failed to send signal SIGTERM" + endif + + ! wait a bit to see if process is running + !call sleep(1) + + ! Verify the process is no longer running + running = is_running(process) + print *, "Process running after signal SIGTERM:", running + +end program example_process_send_signal diff --git a/src/stdlib_system.F90 b/src/stdlib_system.F90 index 576f72273..25d125b19 100644 --- a/src/stdlib_system.F90 +++ b/src/stdlib_system.F90 @@ -78,6 +78,7 @@ module stdlib_system public :: update public :: wait public :: kill +public :: send_signal public :: elapsed public :: is_windows @@ -139,6 +140,10 @@ module stdlib_system !! Kill a process procedure :: kill => process_kill + + !! Send (POSIX) signal to a process + !! no-op on Windows + procedure :: send_signal => process_send_signal !! Get process ID procedure :: pid => process_get_ID @@ -408,6 +413,36 @@ module subroutine process_kill(process, success) logical, intent(out) :: success end subroutine process_kill end interface kill + +interface send_signal + !! version: experimental + !! + !! sends (POSIX) signal to a running process. + !! ([Specification](../page/specs/stdlib_system.html#send_signal)) + !! + !! ### Summary + !! Provides a method to send POSIX signals to a running process. + !! Returns a boolean flag indicating whether the operation was successful. + !! + !! ### Description + !! + !! This interface allows for the sending of signal to an external process. + !! If the signal is sent successfully, the `success` output flag is set to `.true.`, otherwise `.false.`. + !! This function is useful for controlling and managing processes + !! + !! @note This operation may be system-dependent and could fail if the underlying user does not have + !! the necessary rights to kill a process. It is a no-op on Windows + !! + module subroutine process_send_signal(process, signal, success) + !> The process object to send a signal to + class(process_type), intent(inout) :: process + !> The integer representation of the signal + !> Example: 9 for SIGKILL + integer, intent(in) :: signal + !> Boolean flag indicating whether the operation was successful + logical, intent(out) :: success + end subroutine process_send_signal +end interface send_signal interface sleep !! version: experimental diff --git a/src/stdlib_system_subprocess.F90 b/src/stdlib_system_subprocess.F90 index 00f5d759a..f95e483af 100644 --- a/src/stdlib_system_subprocess.F90 +++ b/src/stdlib_system_subprocess.F90 @@ -43,6 +43,13 @@ logical(c_bool) function process_system_kill(pid) bind(C, name='process_kill') implicit none integer(process_ID), intent(in), value :: pid end function process_system_kill + + logical(c_bool) function process_system_send_signal(pid, signal) bind(C, name='process_send_signal') + import c_bool, process_ID + implicit none + integer(process_ID), intent(in), value :: pid + integer, intent(in), value :: signal + end function process_system_send_signal ! System implementation of a wait function subroutine process_wait(seconds) bind(C,name='process_wait') @@ -473,6 +480,40 @@ module subroutine process_kill(process, success) end if end subroutine process_kill + + ! Send POSIX signal to a process + module subroutine process_send_signal(process, signal, success) + class(process_type), intent(inout) :: process + ! Signal number + integer, intent(in) :: signal + ! Return a boolean flag for successful operation + logical, intent(out) :: success + + integer(c_int) :: exit_code + logical(c_bool) :: running + + success = .true. + + ! No need to + if (process%completed) return + if (process%id == FORKED_PROCESS) return + + success = logical(process_system_send_signal(process%id, signal)) + + if (success) then + + call process_query_status(process%id, wait=C_FALSE, is_running=running, exit_code=exit_code) + process%completed = .not.running + + if (process%completed) then + ! Process completed, may have returned an error code + process%exit_code = exit_code + call save_completed_state(process,delete_files=.true.) + end if + + end if + + end subroutine process_send_signal subroutine save_completed_state(process,delete_files) class(process_type), intent(inout) :: process diff --git a/src/stdlib_system_subprocess.c b/src/stdlib_system_subprocess.c index 59f010ddd..9aa0c862a 100644 --- a/src/stdlib_system_subprocess.c +++ b/src/stdlib_system_subprocess.c @@ -284,6 +284,14 @@ bool process_kill_unix(stdlib_pid pid) { return false; } +// send signal to a process. returns true if success, else false. +bool process_send_signal_unix(stdlib_pid pid, int signal) { + if (kill(pid, signal) == 0) { + return true; + } + + return false; // errors occurred +} // On UNIX systems: just fork a new process. The command line will be executed from Fortran. void process_create_posix(stdlib_pid* pid) @@ -329,6 +337,17 @@ bool process_kill(stdlib_pid pid) #endif // _WIN32 } +// Cross-platform interface: send signal to a process by ID +// no-op on Windows +bool process_send_signal(stdlib_pid pid, int signal) +{ +#ifndef _WIN32 + return process_send_signal_unix(pid, signal); +#else + return false; +#endif +} + // Cross-platform interface: sleep(seconds) void process_wait(float seconds) { diff --git a/test/system/test_subprocess.f90 b/test/system/test_subprocess.f90 index 248e9bb8e..b012df84d 100644 --- a/test/system/test_subprocess.f90 +++ b/test/system/test_subprocess.f90 @@ -1,6 +1,7 @@ module test_subprocess use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test - use stdlib_system, only: process_type, run, runasync, is_running, wait, update, elapsed, is_windows, kill + use stdlib_system, only: process_type, run, runasync, is_running, wait, update, elapsed, is_windows, & + kill, send_signal implicit none @@ -15,6 +16,7 @@ subroutine collect_suite(testsuite) new_unittest('test_run_synchronous', test_run_synchronous), & new_unittest('test_run_asynchronous', test_run_asynchronous), & new_unittest('test_process_kill', test_process_kill), & + new_unittest('test_process_send_signal', test_process_send_signal), & new_unittest('test_process_state', test_process_state) & ] end subroutine collect_suite @@ -94,6 +96,44 @@ subroutine test_process_kill(error) call check(error, process%completed, "Process should be marked as completed after being killed") end subroutine test_process_kill + subroutine test_process_send_signal(error) + type(error_type), allocatable, intent(out) :: error + type(process_type) :: process + logical :: success + + ! As the function does nothing on windows + if (is_windows()) return + + ! Start a long-running process asynchronously + process = runasync("ping -c 10 127.0.0.1") + + ! Ensure the process starts running + call check(error, .not. process%completed, "Process should not be completed immediately after starting") + if (allocated(error)) return + + call check(error, is_running(process), "Process should be running immediately after starting") + if (allocated(error)) return + + ! send SIGWINCH(28) to process, this should not cause the process to exit + call send_signal(process, 28, success) + call check(error, success, "Failed to send signal SIGWINCH to the process") + if (allocated(error)) return + + ! Verify the process is still running + call check(error, .not. process%completed, "Process should not exit after SIGWINCH signal") + if (allocated(error)) return + + ! send SIGKILL to process + call send_signal(process, 9, success) + call check(error, success, "Failed to send signal SIGKILL to the process") + if (allocated(error)) return + + ! Verify the process is no longer running + call check(error, .not. process%completed, "Process should be completed after being killed") + if (allocated(error)) return + + end subroutine test_process_send_signal + !> Test updating and checking process state subroutine test_process_state(error) type(error_type), allocatable, intent(out) :: error