extra/io/unix/launcher/launcher.factor

   1 IN: io.unix.launcher
   2 USING: io io.launcher io.unix.backend io.nonblocking
   3 sequences kernel namespaces math system alien.c-types
   4 debugger continuations ;
   5
   6 ! Search unix first
   7 USE: unix
   8
   9 : with-fork ( quot -- pid )
  10     fork [ zero? -rot if ] keep ; inline
  11
  12 : prepare-execve ( args -- cmd args envp )
  13     #! Doesn't free any memory, so we only call this word
  14     #! after forking.
  15     [ malloc-char-string ] map
  16     [ first ] keep
  17     f add >c-void*-array
  18     f ;
  19
  20 : (spawn-process) ( args -- )
  21     [ prepare-execve execve ] catch 1 exit ;
  22
  23 : spawn-process ( args -- pid )
  24     [ (spawn-process) ] [ drop ] with-fork ;
  25
  26 : wait-for-process ( pid -- )
  27     0 <int> 0 waitpid drop ;
  28
  29 : shell-command ( string -- args )
  30     { "/bin/sh" "-c" } swap add ;
  31
  32 M: unix-io run-process ( string -- )
  33     shell-command spawn-process wait-for-process ;
  34
  35 : detached-shell-command ( string -- args )
  36     shell-command "&" add ;
  37
  38 M: unix-io run-detached ( string -- )
  39     detached-shell-command spawn-process wait-for-process ;
  40
  41 : open-pipe ( -- pair )
  42     2 "int" <c-array> dup pipe zero?
  43     [ 2 c-int-array> ] [ drop f ] if ;
  44
  45 : setup-stdio-pipe ( stdin stdout -- )
  46     2dup first close second close
  47     >r first 0 dup2 drop r> second 1 dup2 drop ;
  48
  49 : spawn-process-stream ( args -- in out pid )
  50     open-pipe open-pipe [
  51         setup-stdio-pipe
  52         (spawn-process)
  53     ] [
  54         2dup second close first close
  55         rot drop
  56     ] with-fork >r first swap second r> ;
  57
  58 TUPLE: pipe-stream pid ;
  59
  60 : <pipe-stream> ( in out pid -- stream )
  61     pipe-stream construct-boa
  62     -rot handle>duplex-stream over set-delegate ;
  63
  64 M: pipe-stream stream-close
  65     dup delegate stream-close
  66     pipe-stream-pid wait-for-process ;
  67
  68 M: unix-io <process-stream>
  69     shell-command spawn-process-stream <pipe-stream> ;