subproc.tcl

   1
   2 # Copyright 2016,2020 Ian Jackson
   3 # SPDX-License-Identifier: GPL-3.0-or-later
   4 # There is NO WARRANTY.
   5
   6 package require Tclx
   7
   8 namespace eval subproc {
   9
  10 #----- general purpose subprocess handling -----
  11 #
  12 # One useful procedure:
  13 #    subprocess::fork ONDEATH INCHILD
  14 # forks, evaluates INCHILD in the calling context but in the child
  15 # and when the child dies evaluates [concat [list ONDEATH] W2 W3]
  16 # where W2 and W3 are the 2nd and 3rd elements of the list returned
  17 # by tclx's wait.
  18 #
  19 # INCHILD should not return; if it does or if it gets an error, the
  20 # result is that the child gets a SIGKILL.
  21
  22 variable children
  23
  24 proc fork {ondeath inchild} {
  25     variable children
  26     global errorCode errorInfo
  27     foreach f {stdout stderr} {
  28         if {[catch { flush $f } emsg]} {
  29             catch { bgerror $emsg }
  30         }
  31     }
  32     set pid [::fork]
  33     if {!$pid} {
  34         if {[catch {
  35             uplevel 1 $inchild
  36         } emsg]} {
  37             puts stderr "CHILD ERROR $emsg\n$errorCode\n$errorInfo\n"
  38         }
  39         kill KILL [id process]
  40     }
  41     set children($pid) $ondeath
  42     return $pid
  43 }
  44
  45 proc chld-handler {} {
  46     variable children
  47     while 1 {
  48         if {[catch { set got [wait -nohang] }]} break
  49         if {![llength $got]} break
  50         manyset $got pid how how2
  51         if {[info exists children($pid)]} {
  52             set l $children($pid)
  53             unset children($pid)
  54             if {[catch {
  55                 uplevel #0 [concat [list $l] $how $how2]
  56             } emsg]} {
  57                 catch { bgerror $emsg }
  58             }
  59         }
  60     }
  61 }
  62
  63 signal -restart trap CHLD { after idle subproc::chld-handler }
  64
  65 }