From eb7fd4a69b257a79b722077e835f32b63bc1f4f9 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 29 Oct 2011 02:47:10 -0700 Subject: [PATCH] Add options to set the child process group id or session for Unix. This fixes part of #307. --- basis/io/launcher/launcher-docs.factor | 12 +++++++- basis/io/launcher/launcher.factor | 12 ++++++-- basis/io/launcher/unix/unix-tests.factor | 39 ++++++++++++++++++++++-- basis/io/launcher/unix/unix.factor | 32 +++++++++++++------ basis/io/launcher/windows/windows.factor | 4 +-- basis/unix/ffi/ffi.factor | 5 +++ 6 files changed, 85 insertions(+), 19 deletions(-) diff --git a/basis/io/launcher/launcher-docs.factor b/basis/io/launcher/launcher-docs.factor index e496797f6b..9c1dee1b4c 100644 --- a/basis/io/launcher/launcher-docs.factor +++ b/basis/io/launcher/launcher-docs.factor @@ -35,6 +35,15 @@ $nl { "a file stream or a socket - the stream is connected to the given Factor stream, which cannot be used again from within Factor and must be closed after the process has been started" } } ; +ARTICLE: "io.launcher.group" "Setting process groups" +"The process group of a child process can be controlled by setting the " { $snippet "group" } " slot of a " { $link process } " tuple:" +{ $list + { $link +same-group+ } + { $link +new-group+ } + { $link +new-session+ } +} +"The default value is " { $link +same-group+ } ", which denotes that the child process should be part of the process group of the parent process. The " { $link +new-group+ } " option creates a new process group, while the " { $link +new-session+ } " creates a new session." ; + ARTICLE: "io.launcher.priority" "Setting process priority" "The priority of the child process can be set by storing one of the below symbols in the " { $snippet "priority" } " slot of a " { $link process } " tuple:" { $list @@ -126,7 +135,7 @@ HELP: kill-process { $description "Kills a running process. Does nothing if the process has already exited." } ; HELP: kill-process* -{ $values { "handle" "a process handle" } } +{ $values { "process" "process" } } { $contract "Kills a running process." } { $notes "User code should call " { $link kill-process } " instead." } ; @@ -282,6 +291,7 @@ ARTICLE: "io.launcher" "Operating system processes" "io.launcher.detached" "io.launcher.environment" "io.launcher.redirection" + "io.launcher.group" "io.launcher.priority" "io.launcher.timeouts" } ; diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 40e8a5994b..d7f6bda04c 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -21,6 +21,7 @@ stdout stderr priority +group timeout @@ -47,10 +48,15 @@ SYMBOL: +high-priority+ SYMBOL: +highest-priority+ SYMBOL: +realtime-priority+ +SYMBOL: +same-group+ +SYMBOL: +new-group+ +SYMBOL: +new-session+ + : ( -- process ) process new H{ } clone >>environment - +append-environment+ >>environment-mode ; + +append-environment+ >>environment-mode + +same-group+ >>group ; : process-started? ( process -- ? ) dup handle>> swap status>> or ; @@ -158,12 +164,12 @@ M: process-failed error. : try-process ( desc -- ) run-process wait-for-success ; -HOOK: kill-process* io-backend ( handle -- ) +HOOK: kill-process* io-backend ( process -- ) : kill-process ( process -- ) t >>killed [ pipe>> [ dispose ] when* ] - [ handle>> [ kill-process* ] when* ] bi ; + [ dup handle>> [ kill-process* ] [ drop ] if ] bi ; M: process timeout timeout>> ; diff --git a/basis/io/launcher/unix/unix-tests.factor b/basis/io/launcher/unix/unix-tests.factor index 46b3d9f8a5..1df90f8900 100644 --- a/basis/io/launcher/unix/unix-tests.factor +++ b/basis/io/launcher/unix/unix-tests.factor @@ -4,8 +4,8 @@ io.pathnames tools.test io.launcher arrays io namespaces continuations math io.encodings.binary io.encodings.ascii accessors kernel sequences io.encodings.utf8 destructors io.streams.duplex locals concurrency.promises threads -unix.process calendar unix unix.process debugger.unix -io.timeouts io.launcher.unix ; +unix.process calendar unix debugger.unix io.timeouts +io.launcher.unix ; [ ] [ [ "launcher-test-1" temp-file delete-file ] ignore-errors @@ -158,7 +158,7 @@ io.timeouts io.launcher.unix ; [ p fulfill ] [ wait-for-process s fulfill ] bi ] in-thread - p 1 seconds ?promise-timeout handle>> kill-process* + p 1 seconds ?promise-timeout kill-process* s 3 seconds ?promise-timeout 0 = ] ] unit-test @@ -181,3 +181,36 @@ io.timeouts io.launcher.unix ; [ wait-for-process ] tri ] unit-test + +! Test priority +[ 0 ] [ + + { "bash" "-c" "sleep 2&" } >>command + +low-priority+ >>priority + run-process status>> +] unit-test + +! Check that processes launched with the group option kill their children (or not) +! This test should leave two sleeps running for 30 seconds. +[ + { "bash" "-c" "sleep 30& sleep 30" } >>command + +same-group+ >>group + 500 milliseconds >>timeout + run-process +] [ process-was-killed? ] must-fail-with + +! This test should kill the sleep after 500ms. +[ + { "bash" "-c" "sleep 30& sleep 30" } >>command + +new-group+ >>group + 500 milliseconds >>timeout + run-process +] [ process-was-killed? ] must-fail-with + +! This test should kill the sleep after 500ms. +[ + { "bash" "-c" "sleep 30& sleep 30" } >>command + +new-session+ >>group + 500 milliseconds >>timeout + run-process +] [ process-was-killed? ] must-fail-with diff --git a/basis/io/launcher/unix/unix.factor b/basis/io/launcher/unix/unix.factor index 1eed2eb75e..7c3264f6be 100644 --- a/basis/io/launcher/unix/unix.factor +++ b/basis/io/launcher/unix/unix.factor @@ -14,16 +14,23 @@ IN: io.launcher.unix : assoc>env ( assoc -- env ) [ "=" glue ] { } assoc>map ; +: setup-process-group ( process -- process ) + dup group>> { + { +same-group+ [ ] } + { +new-group+ [ 0 0 setpgid io-error ] } + { +new-session+ [ setsid io-error ] } + } case ; + : setup-priority ( process -- process ) dup priority>> [ - H{ - { +lowest-priority+ 20 } - { +low-priority+ 10 } - { +normal-priority+ 0 } - { +high-priority+ -10 } - { +highest-priority+ -20 } - { +realtime-priority+ -20 } - } at set-priority + { + { +lowest-priority+ [ 20 ] } + { +low-priority+ [ 10 ] } + { +normal-priority+ [ 0 ] } + { +high-priority+ [ -10 ] } + { +highest-priority+ [ -20 ] } + { +realtime-priority+ [ -20 ] } + } case set-priority ] when* ; : reset-fd ( fd -- ) @@ -69,6 +76,7 @@ IN: io.launcher.unix ] when ; : spawn-process ( process -- * ) + [ setup-process-group ] [ 2drop 249 _exit ] recover [ setup-priority ] [ 2drop 250 _exit ] recover [ setup-redirection ] [ 2drop 251 _exit ] recover [ current-directory get absolute-path cd ] [ 2drop 252 _exit ] recover @@ -82,8 +90,12 @@ M: unix current-process-handle ( -- handle ) getpid ; M: unix run-process* ( process -- pid ) [ spawn-process ] curry [ ] with-fork ; -M: unix kill-process* ( pid -- ) - SIGTERM kill io-error ; +M: unix kill-process* ( process -- ) + [ handle>> SIGTERM ] [ group>> ] bi { + { +same-group+ [ kill ] } + { +new-group+ [ killpg ] } + { +new-session+ [ killpg ] } + } case io-error ; : find-process ( handle -- process ) processes get swap [ nip swap handle>> = ] curry diff --git a/basis/io/launcher/windows/windows.factor b/basis/io/launcher/windows/windows.factor index 4cc6028944..11650d479c 100755 --- a/basis/io/launcher/windows/windows.factor +++ b/basis/io/launcher/windows/windows.factor @@ -143,8 +143,8 @@ M: launch-error error. "Launch descriptor:" print nl process>> . ; -M: windows kill-process* ( handle -- ) - hProcess>> 255 TerminateProcess win32-error=0/f ; +M: windows kill-process* ( process -- ) + handle>> hProcess>> 255 TerminateProcess win32-error=0/f ; : dispose-process ( process-information -- ) #! From MSDN: "Handles in PROCESS_INFORMATION must be closed diff --git a/basis/unix/ffi/ffi.factor b/basis/unix/ffi/ffi.factor index 56d08b8f7e..8d384092ed 100644 --- a/basis/unix/ffi/ffi.factor +++ b/basis/unix/ffi/ffi.factor @@ -80,6 +80,8 @@ FUNCTION: int getaddrinfo ( c-string hostname, c-string servname, addrinfo* hint FUNCTION: c-string getcwd ( c-string buf, size_t size ) ; FUNCTION: pid_t getpid ; FUNCTION: int getdtablesize ; +FUNCTION: pid_t getpgrp ; +FUNCTION: pid_t getpgid ( pid_t pid ) ; FUNCTION: gid_t getegid ; FUNCTION: uid_t geteuid ; FUNCTION: gid_t getgid ; @@ -88,6 +90,7 @@ FUNCTION: c-string getenv ( c-string name ) ; FUNCTION: int getgrgid_r ( gid_t gid, group* grp, c-string buffer, size_t bufsize, group** result ) ; FUNCTION: int getgrnam_r ( c-string name, group* grp, c-string buffer, size_t bufsize, group** result ) ; FUNCTION: passwd* getpwent ( ) ; +FUNCTION: int killpg ( pid_t pgrp, int sig ) ; FUNCTION: void setpwent ( ) ; FUNCTION: void setpassent ( int stayopen ) ; FUNCTION: passwd* getpwuid ( uid_t uid ) ; @@ -153,8 +156,10 @@ FUNCTION: int setegid ( gid_t egid ) ; FUNCTION: int seteuid ( uid_t euid ) ; FUNCTION: int setgid ( gid_t gid ) ; FUNCTION: int setgroups ( int ngroups, gid_t* gidset ) ; +FUNCTION: int setpgid ( pid_t pid, pid_t gid ) ; FUNCTION: int setregid ( gid_t rgid, gid_t egid ) ; FUNCTION: int setreuid ( uid_t ruid, uid_t euid ) ; +FUNCTION: pid_t setsid ( ) ; FUNCTION: int setsockopt ( int s, int level, int optname, void* optval, socklen_t optlen ) ; FUNCTION: int setuid ( uid_t uid ) ; FUNCTION: int socket ( int domain, int type, int protocol ) ;