Add kill-process and flesh out inotify

db4
Slava Pestov 2008-02-03 14:23:14 -06:00
parent 1dbd54293c
commit d92361286d
7 changed files with 42 additions and 12 deletions

View File

@ -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 }

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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."

View File

@ -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

View File

@ -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