Add kill-process and flesh out inotify
parent
1dbd54293c
commit
d92361286d
extra
io
unix
launcher
linux
windows/launcher
unix
windows/kernel32
|
@ -116,6 +116,15 @@ HELP: run-detached
|
|||
"The output value can be passed to " { $link wait-for-process } " to get an exit code."
|
||||
} ;
|
||||
|
||||
HELP: kill-process
|
||||
{ $values { "process" process } }
|
||||
{ $description "Kills a running process. Does nothing if the process has already exited." } ;
|
||||
|
||||
HELP: kill-process*
|
||||
{ $values { "handle" "a process handle" } }
|
||||
{ $contract "Kills a running process." }
|
||||
{ $notes "User code should call " { $link kill-process } " intead." } ;
|
||||
|
||||
HELP: process
|
||||
{ $class-description "A class representing an active or finished process."
|
||||
$nl
|
||||
|
@ -166,6 +175,8 @@ $nl
|
|||
"The following words are used to launch processes:"
|
||||
{ $subsection run-process }
|
||||
{ $subsection run-detached }
|
||||
"Stopping processes:"
|
||||
{ $subsection kill-process }
|
||||
"Redirecting standard input and output to a pipe:"
|
||||
{ $subsection <process-stream> }
|
||||
{ $subsection with-process-stream }
|
||||
|
|
|
@ -84,6 +84,11 @@ HOOK: run-process* io-backend ( desc -- handle )
|
|||
: run-detached ( desc -- process )
|
||||
>descriptor H{ { +detached+ t } } union run-process ;
|
||||
|
||||
HOOK: kill-process* io-backend ( handle -- )
|
||||
|
||||
: kill-process ( process -- )
|
||||
process-handle [ kill-process* ] when* ;
|
||||
|
||||
HOOK: process-stream* io-backend ( desc -- stream process )
|
||||
|
||||
TUPLE: process-stream process ;
|
||||
|
|
|
@ -57,7 +57,8 @@ MEMO: 'arguments' ( -- parser )
|
|||
: setup-redirection ( -- )
|
||||
+stdin+ get read-flags 0 redirect
|
||||
+stdout+ get write-flags 1 redirect
|
||||
+stderr+ get write-flags 2 redirect ;
|
||||
+stderr+ get dup +stdout+ get eq?
|
||||
[ 1 2 dup2 ] [ write-flags 2 redirect ] if ;
|
||||
|
||||
: spawn-process ( -- )
|
||||
[
|
||||
|
@ -74,6 +75,9 @@ M: unix-io run-process* ( desc -- pid )
|
|||
[ spawn-process ] [ ] with-fork <process>
|
||||
] with-descriptor ;
|
||||
|
||||
M: unix-io kill-process* ( pid -- )
|
||||
SIGTERM kill io-error ;
|
||||
|
||||
: open-pipe ( -- pair )
|
||||
2 "int" <c-array> dup pipe zero?
|
||||
[ 2 c-int-array> ] [ drop f ] if ;
|
||||
|
|
|
@ -21,8 +21,11 @@ TUPLE: linux-monitor path wd callback ;
|
|||
|
||||
TUPLE: inotify watches ;
|
||||
|
||||
: wd>path ( wd -- path )
|
||||
inotify get-global inotify-watches at linux-monitor-path ;
|
||||
: watches ( -- assoc ) inotify get-global inotify-watches ;
|
||||
|
||||
: wd>monitor ( wd -- monitor ) watches at ;
|
||||
|
||||
: wd>path ( wd -- path ) wd>monitor linux-monitor-path ;
|
||||
|
||||
: <inotify> ( -- port )
|
||||
H{ } clone
|
||||
|
@ -31,8 +34,6 @@ TUPLE: inotify watches ;
|
|||
|
||||
: inotify-fd inotify get-global port-handle ;
|
||||
|
||||
: watches inotify get-global inotify-watches ;
|
||||
|
||||
: (add-watch) ( path mask -- wd )
|
||||
inotify-fd -rot inotify_add_watch dup io-error ;
|
||||
|
||||
|
@ -105,9 +106,13 @@ M: linux-monitor dispose ( monitor -- )
|
|||
inotify-event-len "inotify-event" heap-size +
|
||||
swap >r + r> ;
|
||||
|
||||
: wd>queue ( wd -- queue )
|
||||
inotify-event-wd wd>monitor monitor-queue ;
|
||||
|
||||
: parse-file-notifications ( i buffer -- )
|
||||
2dup events-exhausted? [ 2drop ] [
|
||||
2dup inotify-event@ parse-file-notify changed-file
|
||||
2dup inotify-event@ dup inotify-event-wd wd>queue
|
||||
[ parse-file-notify changed-file ] bind
|
||||
next-event parse-file-notifications
|
||||
] if ;
|
||||
|
||||
|
|
|
@ -48,10 +48,10 @@ TUPLE: CreateProcess-args
|
|||
} get-slots CreateProcess win32-error=0/f ;
|
||||
|
||||
: escape-argument ( str -- newstr )
|
||||
[ [ dup CHAR: " = [ CHAR: \\ , ] when , ] each ] "" make ;
|
||||
CHAR: \s over member? [ "\"" swap "\"" 3append ] when ;
|
||||
|
||||
: join-arguments ( args -- cmd-line )
|
||||
" " join ;
|
||||
[ escape-argument ] map " " join ;
|
||||
|
||||
: app-name/cmd-line ( -- app-name cmd-line )
|
||||
+command+ get [
|
||||
|
@ -162,6 +162,10 @@ M: windows-io run-process* ( desc -- handle )
|
|||
] with-descriptor
|
||||
] with-destructors ;
|
||||
|
||||
M: windows-io kill-process* ( handle -- )
|
||||
PROCESS_INFORMATION-hProcess
|
||||
255 TerminateProcess win32-error=0/f ;
|
||||
|
||||
: dispose-process ( process-information -- )
|
||||
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
|
||||
#! with CloseHandle when they are no longer needed."
|
||||
|
|
|
@ -168,9 +168,10 @@ FUNCTION: time_t time ( time_t* t ) ;
|
|||
FUNCTION: int unlink ( char* path ) ;
|
||||
FUNCTION: int utimes ( char* path, timeval[2] times ) ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
! wait and waitpid
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
: SIGKILL 9 ; inline
|
||||
: SIGTERM 15 ; inline
|
||||
|
||||
FUNCTION: int kill ( pid_t pid, int sig ) ;
|
||||
|
||||
! Flags for waitpid
|
||||
|
||||
|
|
|
@ -1453,7 +1453,7 @@ FUNCTION: DWORD SleepEx ( DWORD dwMilliSeconds, BOOL bAlertable ) ;
|
|||
FUNCTION: BOOL SystemTimeToFileTime ( SYSTEMTIME* lpSystemTime, LPFILETIME lpFileTime ) ;
|
||||
! FUNCTION: SystemTimeToTzSpecificLocalTime
|
||||
! FUNCTION: TerminateJobObject
|
||||
! FUNCTION: TerminateProcess
|
||||
FUNCTION: BOOL TerminateProcess ( HANDLE hProcess, DWORD uExit ) ;
|
||||
! FUNCTION: TerminateThread
|
||||
! FUNCTION: TermsrvAppInstallMode
|
||||
! FUNCTION: Thread32First
|
||||
|
|
Loading…
Reference in New Issue