--- a/OSProcess.st Thu Dec 22 17:24:46 2016 +0100
+++ b/OSProcess.st Thu Dec 22 17:33:14 2016 +0100
@@ -4,7 +4,8 @@
Object subclass:#OSProcess
instanceVariableNames:'pid parentPid command environment directory inStream outStream
- errorStream exitStatus finishSema'
+ errorStream auxStream showWindow lineWise exitStatus finishSema
+ shufflerProcesses terminateLock shuffleRest'
classVariableNames:''
poolDictionaries:''
category:'System-Support'
@@ -31,6 +32,31 @@
Process
"
+!
+
+examples
+ "
+ |outStream|
+
+ outStream := '' writeStream.
+
+ self new
+ command:'dir';
+ inStream:'abc' readStream;
+ outStream:outStream;
+ lineWise:true;
+ execute.
+
+ outStream contents
+ "
+! !
+
+!OSProcess class methodsFor:'instance creation'!
+
+new
+ "return an initialized instance"
+
+ ^ self basicNew initialize.
! !
!OSProcess class methodsFor:'initialize'!
@@ -40,12 +66,62 @@
Win32Process := self.
! !
+!OSProcess class methodsFor:'private shuffling'!
+
+shuffleAllFrom:anInStream to:anOutStream lineWise:lineWise lockWith:aLock
+ lineWise ifFalse:[
+ ^ anInStream copyToEndInto:anOutStream.
+ ].
+ [anInStream atEnd] whileFalse:[
+ aLock critical:[
+ self
+ shuffleFrom:anInStream
+ to:anOutStream
+ lineWise:lineWise
+ ]
+ ]
+!
+
+shuffleFrom:anInStream to:anOutStream lineWise:lineWise
+ "copy data from anInStream to anOutStream.
+ Caller makes sure, than anInStream does not block.
+ anOutstream should have been set to non-blocking-mode"
+
+ lineWise ifTrue:[
+ |data|
+
+ data := anInStream nextLine.
+ data notNil ifTrue:[
+ anOutStream nextPutLine:data
+ ] .
+ ] ifFalse:[
+ anInStream copyToEndInto:anOutStream.
+ ].
+!
+
+shuffleRestFrom:anInStream to:anOutStream lineWise:lineWise
+ [anInStream atEnd] whileFalse:[
+ self
+ shuffleFrom:anInStream
+ to:anOutStream
+ lineWise:lineWise.
+ ].
+! !
+
!OSProcess methodsFor:'accessing'!
accessor
^ self
!
+auxStream
+ ^ auxStream
+!
+
+auxStream:something
+ auxStream := something.
+!
+
command
"return the value of the instance variable 'command' (automatically generated)"
@@ -158,6 +234,14 @@
"Created: / 10.11.1998 / 21:26:34 / cg"
!
+lineWise
+ ^ lineWise
+!
+
+lineWise:something
+ lineWise := something.
+!
+
outStream
"return the value of the instance variable 'outStream' (automatically generated)"
@@ -188,6 +272,14 @@
pid:something
pid := something.
+!
+
+showWindow
+ ^ showWindow
+!
+
+showWindow:something
+ showWindow := something.
! !
!OSProcess methodsFor:'file queries'!
@@ -196,6 +288,15 @@
^ aPathName asFilename isExecutable
! !
+!OSProcess methodsFor:'initialization'!
+
+initialize
+ "Invoked when a new instance is created."
+
+ showWindow := false. "/ for backward compatibility
+ lineWise := true.
+! !
+
!OSProcess methodsFor:'printing'!
printOn:aStream
@@ -208,6 +309,85 @@
aStream nextPut:$)
! !
+!OSProcess methodsFor:'private'!
+
+setupShufflerForInput:aStream
+ |pipe externalStream shuffledStream shufflerProcess|
+
+ (aStream isNil or:[aStream isExternalStream]) ifTrue:[
+ ^ aStream.
+ ].
+
+ pipe := NonPositionableExternalStream makePipe.
+ externalStream := pipe at:1.
+ shuffledStream := pipe at:2.
+ lineWise ifFalse:[
+ shuffledStream blocking:false.
+ ].
+ aStream isBinary ifTrue:[
+ shuffledStream binary.
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ inStream to the pipe (which is connected to the commands input)
+ shufflerProcess :=
+ [
+ [
+ [aStream atEnd] whileFalse:[
+ self class shuffleFrom:aStream to:shuffledStream lineWise:lineWise.
+ shuffledStream flush
+ ]
+ ] ensure:[
+ shuffledStream close.
+ externalStream close.
+ ]
+ ] newProcess
+ name:'OSProcess input shuffler';
+"/ beSystemProcess;
+ resume.
+
+ shufflerProcesses add:shufflerProcess.
+ ^ externalStream
+!
+
+setupShufflerForOutput:aStream
+ |pipe externalStream shuffledStream shufflerProcess|
+
+ (aStream isNil or:[aStream isExternalStream]) ifTrue:[
+ ^ aStream.
+ ].
+
+ pipe := NonPositionableExternalStream makePipe.
+ externalStream := pipe at:2.
+ shuffledStream := pipe at:1.
+ aStream isBinary ifTrue:[
+ shuffledStream binary.
+ ].
+
+ shufflerProcess :=
+ [
+ WriteError handle:[:ex |
+ "/ ignored
+ ] do:[
+ [
+ self class shuffleAllFrom:shuffledStream to:aStream lineWise:lineWise lockWith:terminateLock.
+ ] ensure:[
+ externalStream close.
+ shuffleRest ifTrue:[
+ self class shuffleRestFrom:shuffledStream to:aStream lineWise:lineWise
+ ].
+ ].
+ ].
+ ] newProcess
+ priority:(Processor userSchedulingPriority "+ 1");
+ name:'OSProcess output shuffler';
+"/ beSystemProcess;
+ resume.
+
+ shufflerProcesses add:shufflerProcess.
+ ^ externalStream
+! !
+
!OSProcess methodsFor:'queries'!
getProcessHandle
@@ -215,13 +395,13 @@
(which must be explicitely freed later).
Others simply return the pid here"
- ^ self subclassResponsibility
+ ^ pid
!
isAlive
"answer true, if the process is still alive"
- ^ self subclassResponsibility
+ ^ pid notNil and:[exitStatus notNil]
!
isDead
@@ -232,6 +412,57 @@
!OSProcess methodsFor:'starting'!
+execute
+
+ |nullStream|
+
+ terminateLock := Semaphore forMutualExclusion.
+ shufflerProcesses := OrderedCollection new.
+ shuffleRest := false.
+
+ inStream := self setupShufflerForInput:inStream.
+ auxStream := self setupShufflerForInput:auxStream.
+ outStream := self setupShufflerForOutput:outStream.
+ errorStream := self setupShufflerForOutput:errorStream.
+
+ [
+ inStream isNil ifTrue:[
+ inStream := nullStream := Filename nullDevice readWriteStream.
+ ].
+ outStream isNil ifTrue:[
+ nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
+ outStream := nullStream.
+ ].
+ errorStream isNil ifTrue:[
+ errorStream := outStream
+ ].
+ self startProcess ifTrue:[
+ finishSema wait.
+ shuffleRest := true.
+ ].
+ ] ensure:[
+ (shuffleRest not and:[pid notNil]) ifTrue:[
+ "/ we were interrupted -
+ "/ terminate the os-command (and all of its forked commands)
+ self terminateGroup; terminate.
+ OperatingSystem closePid:pid.
+ ].
+ shufflerProcesses do:[:eachProcess|
+ terminateLock critical:[eachProcess terminate].
+ eachProcess waitUntilTerminated
+ ].
+ shufflerProcesses := nil.
+ nullStream notNil ifTrue:[
+ nullStream close.
+ ].
+ ].
+
+ (exitStatus isNil or:[exitStatus success]) ifFalse:[
+ ^ false
+ ].
+ ^ true
+!
+
startProcess
finishSema := Semaphore new.
@@ -242,18 +473,16 @@
inputFrom:inStream
outputTo:outStream
errorTo:errorStream
- auxFrom:nil
- environment:nil
+ auxFrom:auxStream
+ environment:environment
inDirectory:directory
- showWindow:false.
+ showWindow:showWindow.
]
action:[:status |
status stillAlive ifFalse:[
exitStatus := status.
- "/ paranoia?
pid notNil ifTrue:[
- OperatingSystem terminateProcessGroup:pid.
- OperatingSystem terminateProcess:pid.
+ self kill; killGroup. "/ paranoia? - yes!!
OperatingSystem closePid:pid.
].
finishSema signal
@@ -276,13 +505,13 @@
kill
"kill the process - the process does not get the chance to clean up"
- ^ self subclassResponsibility.
+ OperatingSystem killProcess:pid.
!
killGroup
"kill the processGroup - the processes do not get the chance to clean up"
- ^ self subclassResponsibility.
+ OperatingSystem killProcessGroup:pid.
!
killWithAllChildren
@@ -294,7 +523,7 @@
terminate
"terminate the process gracefully"
- ^ self subclassResponsibility.
+ OperatingSystem terminateProcess:pid.
!
terminateGroup
@@ -302,7 +531,7 @@
Under Windows, these is the same as terminateWithhAllChildren,
under unix, this terminates a subset of all children"
- ^ self subclassResponsibility.
+ OperatingSystem terminateProcessGroup:pid.
!
terminateWithAllChildren