#FEATURE by stefan
authorStefan Vogel <sv@exept.de>
Thu, 29 Dec 2016 21:25:18 +0100
changeset 21210 99f6f07d5a33
parent 21209 e9395c842124
child 21211 ed5fd0f7a98b
#FEATURE by stefan Use OSProcess for executing the command. Support Stream for errorDisposition. class: PipeStream class definition removed: #exitAction: comment/format in: #readingFrom: #readingFrom:errorDisposition:inDirectory: changed: #close #closeFileDescriptor #exitStatus #openPipeFor:withMode:errorDisposition:inDirectory: #pid #terminatePipeCommand #waitForPipeCommandWithTimeout:
PipeStream.st
--- a/PipeStream.st	Thu Dec 29 20:58:46 2016 +0100
+++ b/PipeStream.st	Thu Dec 29 21:25:18 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1989 by Claus Gittinger
 	      All Rights Reserved
@@ -14,7 +16,7 @@
 "{ NameSpace: Smalltalk }"
 
 NonPositionableExternalStream subclass:#PipeStream
-	instanceVariableNames:'commandString pid exitStatus exitSema exitAction'
+	instanceVariableNames:'commandString osProcess'
 	classVariableNames:'BrokenPipeSignal'
 	poolDictionaries:''
 	category:'Streams-External'
@@ -222,7 +224,7 @@
 	|p|
 
 	p := PipeStream bidirectionalFor:'cat -u'.
-	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
+	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
 	Transcript showCR:p nextLine.
 	p close
     "
@@ -275,48 +277,53 @@
      The commands error output is send to my own error output."
 
     ^ self
-	readingFrom:commandString
-	errorDisposition:#stderr
-	inDirectory:nil
+        readingFrom:commandString
+        errorDisposition:#stderr
+        inDirectory:nil
 
     "unix:
-	PipeStream readingFrom:'ls -l'.
-    "
-
-    "
-	|p|
-
-	p := PipeStream readingFrom:'ls -l'.
-	Transcript showCR:p nextLine.
-	p close
+        PipeStream readingFrom:'ls -l'.
     "
 
     "
-	|s|
-	s := PipeStream readingFrom:'sh -c sleep\ 600'.
-	(Delay forSeconds:2) wait.
-	s shutDown
+        |p|
+
+        p := PipeStream readingFrom:'ls -l'.
+        Transcript showCR:p nextLine.
+        p close
     "
 
-    "vms:
-	PipeStream readingFrom:'dir'.
+
+    "
+        |p|
+
+        p := PipeStream readingFrom:'echo error >&2'.
+        Transcript showCR:p nextLine.
+        p close
     "
 
     "
-	|p|
-	p := PipeStream readingFrom:'dir'.
-	Transcript showCR:p nextLine.
-	p close
+        |s|
+        s := PipeStream readingFrom:'sh -c sleep\ 600'.
+        (Delay forSeconds:2) wait.
+        s abortAndClose
     "
 
-    "msdos:
-	PipeStream readingFrom:'dir'.
+    "
+        |p|
+        p := PipeStream readingFrom:'dir'.
+        Transcript showCR:p nextLine.
+        p close
+    "
+
+    "Windows:
+        PipeStream readingFrom:'dir'.
     "
     "
-	|p|
-	p := PipeStream readingFrom:'dir'.
-	Transcript showCR:p nextLine.
-	p close
+        |p|
+        p := PipeStream readingFrom:'dir'.
+        Transcript showCR:p nextLine.
+        p close
     "
 
     "Modified: 24.4.1996 / 09:09:25 / stefan"
@@ -334,10 +341,27 @@
      Nil is treated like #stderr"
 
     ^ self basicNew
-	openPipeFor:commandString
-	withMode:#r
-	errorDisposition:errorDisposition
-	inDirectory:aDirectory
+        openPipeFor:commandString
+        withMode:#r
+        errorDisposition:errorDisposition
+        inDirectory:aDirectory
+
+
+    "
+        |p|
+
+        p := PipeStream readingFrom:'bla' errorDisposition:Transcript inDirectory:nil.
+        Transcript showCR:p nextLine.
+        p close
+    "
+
+    "
+        |p|
+
+        p := PipeStream readingFrom:'bla' errorDisposition:#inline inDirectory:nil.
+        Transcript showCR:p nextLine.
+        p close
+    "
 !
 
 readingFrom:commandString inDirectory:aDirectory
@@ -472,15 +496,21 @@
 exitStatus
     "return the exitStatus"
 
-    ^ exitStatus
-
+    osProcess isNil ifTrue:[
+        ^ nil.
+    ].
+    ^ osProcess exitStatus.
+    
     "Created: 28.12.1995 / 14:54:41 / stefan"
 !
 
 pid
     "return pid"
 
-    ^ pid
+    osProcess isNil ifTrue:[
+        ^ nil.
+    ].
+    ^ osProcess pid.
 
     "Created: 28.12.1995 / 14:54:30 / stefan"
 ! !
@@ -511,10 +541,8 @@
 
     handle notNil ifTrue:[
         super close.
-        pid notNil ifTrue:[
-            "/ wait for the pipe-command to terminate.
-            self waitForPipeCommandWithTimeout:nil.
-        ].
+        "/ wait for the pipe-command to terminate.
+        self waitForPipeCommandWithTimeout:nil.
     ].
 
     "Modified: / 12.9.1998 / 16:51:04 / cg"
@@ -568,37 +596,24 @@
     int retVal;
 
     if ((fp = __INST(handle)) != nil) {
-	__INST(handle) = nil;
-	f = __FILEVal(fp);
-	if (@global(FileOpenTrace) == true) {
-	    console_fprintf(stderr, "close [PipeStream] %"_lx_" fd=%d\n", (INT)f, fileno(f));
-	}
+        __INST(handle) = nil;
+        f = __FILEVal(fp);
+        if (@global(FileOpenTrace) == true) {
+            console_fprintf(stderr, "close [PipeStream] %"_lx_" fd=%d\n", (INT)f, fileno(f));
+        }
 #ifdef __win32__
-	do {
-	    __threadErrno = 0;
-	    retVal = __STX_C_NOINT_CALL1( "close", (void*)close, (void*)fileno(f) );
-	} while ((retVal < 0) && (__threadErrno == EINTR));
+        do {
+            __threadErrno = 0;
+            retVal = __STX_C_NOINT_CALL1( "close", (void*)close, (void*)fileno(f) );
+        } while ((retVal < 0) && (__threadErrno == EINTR));
 #else
-	__BEGIN_INTERRUPTABLE__
-	close(fileno(f));
-	__END_INTERRUPTABLE__
+        __BEGIN_INTERRUPTABLE__
+        close(fileno(f));
+        __END_INTERRUPTABLE__
 #endif
     }
 #endif /* not transputer  */
 %}.
-    exitAction notNil ifTrue:[
-	action := exitAction.
-	exitAction := nil.
-	action value.
-    ]
-!
-
-exitAction:aBlock
-    "define a block to be evaluated when the pipe is closed.
-     This is only used with VMS, to remove any temporary COM file.
-     (see readingFrom:inDirectory:)"
-
-    exitAction := aBlock
 !
 
 openPipeFor:aCommandString withMode:rwMode errorDisposition:errorDisposition inDirectory:aDirectory
@@ -611,9 +626,7 @@
      #stderr causes it to be written to smalltalks own stderr.
      Nil is treated like #stderr"
 
-    |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
-     shellPath shellArgs mbx mbxName
-     realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
+    |pipeArray remotePipeEnd nullOutput errorNumber myPipeEnd result|
 
     handle notNil ifTrue:[
         "the pipe was already open ...
@@ -632,185 +645,95 @@
     ]].
 
     lastErrorNumber := nil.
-    exitStatus := nil.
-    exitSema := Semaphore new name:'pipe exitSema'.
-
-    realCmd := aCommandString.
-    execDirectory := aDirectory.
-    execFdArray := #(0 1 2) copy.
+    commandString := aCommandString.
+    "stdio lib does not work with blocking pipes and interrupts
+     for WIN, Linux, Solaris and probably any other UNIX"
+    buffered := false.
+    hitEOF := false.
+    binary := false.
 
-    OperatingSystem isVMSlike ifTrue:[
-        "/
-        "/ the generated COM-file includes a 'set default'
-        "/
-        tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
-        realCmd := '@' , tmpComFile osName.
-        execDirectory := nil.
+    osProcess := OSProcess new 
+                    command:aCommandString;
+                    directory:aDirectory.
 
-        mbx := OperatingSystem createMailBox.
-        mbx isNil ifTrue:[
+    mode == #readwrite ifTrue:[
+        pipeArray := NonPositionableExternalStream makeBidirectionalPipe.
+        pipeArray isNil ifTrue:[
             lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-            tmpComFile delete.
             ^ self openError:errorNumber.
         ].
-        mbxName := OperatingSystem mailBoxNameOf:mbx.
-
-        "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
-        shellPath := ''.
-        shellArgs := realCmd.
-
-        rwMode = #r ifTrue:[
-            "redirect stdout of subprocess to write to mailbox"
-            execFdArray at:2 put:mbx.
-        ] ifFalse:[
-            "redirect stdin of subprocess to read from mailbox"
-            execFdArray at:1 put:mbx.
+        myPipeEnd := pipeArray at:1.
+        remotePipeEnd := pipeArray at:2.
+        osProcess inStream:remotePipeEnd.
+        osProcess outStream:remotePipeEnd.
+    ] ifFalse:[
+        pipeArray := NonPositionableExternalStream makePipe.
+        pipeArray isNil ifTrue:[
+            lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
+            ^ self openError:errorNumber.
         ].
-    ] ifFalse:[
-        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
-        shellPath := shellAndArgs at:1.
-        shellArgs := shellAndArgs at:2.
 
-        mode == #readwrite ifTrue:[
-            pipeFdArray := OperatingSystem makeBidirectionalPipe.
-            pipeFdArray isNil ifTrue:[
-                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-                ^ self openError:errorNumber.
-            ].
-            myFd := pipeFdArray at:1.
-            execFd := pipeFdArray at:2.
-            execFdArray at:1 put:execFd.
-            execFdArray at:2 put:execFd.
+        mode == #readonly ifTrue:[
+            "redirect stdout of subprocess to write to pipe"
+            myPipeEnd := pipeArray at:1.
+            remotePipeEnd := pipeArray at:2.
+            osProcess outStream:remotePipeEnd.
         ] ifFalse:[
-            pipeFdArray := OperatingSystem makePipe.
-            pipeFdArray isNil ifTrue:[
-                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
-                ^ self openError:errorNumber.
-            ].
-
-            mode == #readonly ifTrue:[
-                "redirect stdout of subprocess to write to pipe"
-                myFd := pipeFdArray at:1.
-                execFd := pipeFdArray at:2.
-                execFdArray at:2 put:execFd.
-            ] ifFalse:[
-                "redirect stdin of subprocess to read from pipe"
-                myFd := pipeFdArray at:2.
-                execFd := pipeFdArray at:1.
-                execFdArray at:1 put:execFd.
-            ].
+            "redirect stdin of subprocess to read from pipe"
+            myPipeEnd := pipeArray at:2.
+            remotePipeEnd := pipeArray at:1.
+            osProcess inStream:remotePipeEnd.
         ].
     ].
 
     errorDisposition == #discard ifTrue:[
         nullOutput := Filename nullDevice writeStream.
-        execFdArray at:3 put:nullOutput fileDescriptor
-    ] ifFalse:[
-        (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
-            execFdArray at:3 put:1
-        ] ifFalse:[
-"/            errorDisposition isStream ifTrue:[
-"/self halt.
-"/            ].
-        ].
-    ].
-
-    "/ must block here, to avoid races due to early finishing
-    "/ subprocesses ...
-
-    blocked := OperatingSystem blockInterrupts.
+        osProcess errorStream:nullOutput.
+    ] ifFalse:[(errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
+        osProcess errorStream:osProcess outStream.
+    ] ifFalse:[(errorDisposition == #stderr or:[errorDisposition == nil]) ifTrue:[
+        osProcess errorStream:Stderr.
+    ] ifFalse:[errorDisposition isStream ifTrue:[
+        osProcess errorStream:errorDisposition.
+    ]]]].
 
-    "beware: pid may change if subprocess is fast"
-    pid := resultPid :=  Processor
-               monitor:[
-                  OperatingSystem
-                      exec:shellPath
-                      withArguments:shellArgs
-                      environment:nil
-                      fileDescriptors:execFdArray
-                      fork:true
-                      newPgrp:true
-                      inDirectory:execDirectory
-                      showWindow:false.
-               ]
-               action:[:status |
-                  status stillAlive ifFalse:[
-                      exitStatus := status.
+    osProcess terminateActionBlock:[
+            "writing doesn't make sense - there is no reader any longer"
+            mode == #readwrite ifTrue:[
+                "... but allow to read the rest of the command's output"
+                self shutDownOutput.
+            ] ifFalse:[mode == #writeonly ifTrue:[
+                self closeFileDescriptor.
+            ]].
+       ].
 
-                      "writing doesn't make sense - there is no reader any longer"
-                      mode == #readwrite ifTrue:[
-                          "... but allow to read the rest of the command's output"
-                          self shutDownOutput.
-                      ] ifFalse:[mode == #writeonly ifTrue:[
-                          self closeFileDescriptor.
-                      ]].
-
-                      OperatingSystem closePid:pid.
-                      pid := nil.
-                      exitSema signal.
-                  ].
-               ].
+    result := osProcess startProcess.
 
     "subprocess has been created.
      close unused filedescriptors"
-
-    execFd notNil ifTrue:[
-        OperatingSystem closeFd:execFd.
+    remotePipeEnd notNil ifTrue:[
+        remotePipeEnd close.
     ].
-
     nullOutput notNil ifTrue:[
         nullOutput close
     ].
 
-    resultPid notNil ifTrue:[
+    result ifTrue:[
         "successfull creation of subprocesss"
-        OperatingSystem isVMSlike ifTrue:[
-            "/
-            "/ reopen the mailbox as a file ...
-            "/
-            mbxName := OperatingSystem mailBoxNameOf:mbx.
-            mbxName notNil ifTrue:[
-                super open:mbxName withMode:rwMode.
-                exitAction := [tmpComFile delete].
-            ].
-        ] ifFalse:[
-            self setFileHandle:myFd mode:rwMode.
-            handleType := #pipeFilePointer.
-        ]
+        self setFileHandle:myPipeEnd fileHandle mode:rwMode.
+        myPipeEnd unregisterForFinalization.    "make sure filedesciptor is not closed by finalizer"
+        myPipeEnd := nil.
+        handleType := #pipeFilePointer.
     ] ifFalse:[
-        "creation of subprocesss failed"
-        lastErrorNumber := OperatingSystem currentErrorNumber.
-        OperatingSystem isVMSlike ifTrue:[
-            OperatingSystem destroyMailBox:mbx.
-            tmpComFile delete.
-        ] ifFalse:[
-            OperatingSystem closeFd:myFd.
-        ].
-    ].
-
-    blocked ifFalse:[
-        OperatingSystem unblockInterrupts
-    ].
-
-    (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
-        "
-         the pipe open failed for some reason ...
+        "the pipe open failed for some reason ...
          ... this may be either due to an invalid command string,
          or due to the system running out of memory (when forking
-         the unix process)
-        "
-        exitAction value.
+         the unix process)"
+        lastErrorNumber := OperatingSystem lastErrorNumber.
+        myPipeEnd close.
         ^ self openError:lastErrorNumber.
     ].
 
-    commandString := realCmd.
-
-    "stdio lib does not work with blocking pipes and interrupts
-     for WIN, Linux, Solaris and probably any other UNIX"
-    buffered := false.
-    position := 0.
-    hitEOF := false.
-    binary := false.
     self registerForFinalization.
 
     "Modified: / 23.4.1996 / 17:05:59 / stefan"
@@ -819,11 +742,8 @@
 !
 
 terminatePipeCommand
-    |tpid|
-
-    (tpid := pid) notNil ifTrue:[
-	OperatingSystem terminateProcessGroup:tpid.
-	OperatingSystem terminateProcess:tpid.
+    osProcess notNil ifTrue:[
+        osProcess terminateGroup.
     ].
 !
 
@@ -831,14 +751,10 @@
     "wait for the pipe command to terminate itself.
      Return true, if a timeout occurred."
 
-    pid notNil ifTrue:[
-	[
-	    pid notNil ifTrue:[
-		exitSema waitWithTimeout:seconds.
-	    ]
-	] valueUninterruptably
+    osProcess notNil ifTrue:[
+        ^ osProcess finishSema waitWithTimeout:seconds.
     ].
-    ^ pid notNil
+    ^ false
 ! !
 
 !PipeStream class methodsFor:'documentation'!