AbstractOperatingSystem.st
changeset 20322 92697560b556
parent 20320 ccc9f6fdd5a7
child 20325 d8c3fcfa6a72
--- a/AbstractOperatingSystem.st	Thu Sep 01 17:24:14 2016 +0200
+++ b/AbstractOperatingSystem.st	Thu Sep 01 17:24:39 2016 +0200
@@ -900,6 +900,30 @@
 
 startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
     errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment inDirectory:dir
+
+    "start executing the OS command as specified by the argument, aCommandString
+     as a separate process; do not wait for the command to finish.
+     The commandString is passed to a shell for execution - see the description of
+     'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+     The command gets stdIn, stdOut and stdErr assigned from the arguments;
+     each may be nil.
+     Return the processId if successful, nil otherwise.
+     Use #monitorPid:action: for synchronization and exec status return,
+     or #killProcess: to stop it."
+
+    "raise an error: must be redefined in concrete subclass(es)"
+
+    ^ self 
+        startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+        errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil 
+        environment:environment inDirectory:dir
+        showWindow:nil
+!
+
+startProcess:aCommandString inputFrom:anExternalInStream outputTo:anExternalOutStream
+    errorTo:anExternalErrStream auxFrom:anExternalAuxStreamOrNil environment:environment 
+    inDirectory:dir showWindow:showWindowBooleanOrNil
+
     "start executing the OS command as specified by the argument, aCommandString
      as a separate process; do not wait for the command to finish.
      The commandString is passed to a shell for execution - see the description of
@@ -1341,6 +1365,82 @@
      and you don't want lines to be mangled. Set lineWise = false to
      avoid blocking on pipes"
 
+    ^ self
+        executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+        errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+        inDirectory:dirOrNil lineWise:lineWise showWindow:nil onError:aBlock
+
+    "
+        |outStream errStream|
+
+        outStream := '' writeStream.
+
+        OperatingSystem executeCommand:'ls -l'
+                        inputFrom:'abc' readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:true
+                        onError:[:exitStatus | ^ false].
+        outStream contents
+    "
+
+    "
+        |outStream errStream|
+
+        outStream := #[] writeStream.
+
+        OperatingSystem executeCommand:'cat'
+                        inputFrom:(ByteArray new:5000000) readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:false
+                        onError:[:exitStatus | ^ false].
+        outStream size
+    "
+
+    "
+        |outStream errStream|
+
+        outStream := '' writeStream.
+
+        OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
+                        inputFrom:'bla' readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:true
+                        onError:[:exitStatus |  false].
+        outStream contents
+    "
+
+    "Modified: / 11-02-2007 / 20:54:39 / cg"
+!
+
+executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+    errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+    inDirectory:dirOrNil lineWise:lineWise showWindow:showWindowBooleanOrNil onError:aBlock
+
+    "execute the unix command specified by the argument, aCommandStringOrArray.
+     If aCommandString is a String, the commandString is passed to a shell for execution
+     - see the description of 'sh -c' in your UNIX manual ('cmd.com' in your MSDOS manual).
+     If aCommandString is an Array, the first element is the command to be executed,
+     and the other elements are the arguments to the command. No shell is invoked in this case.
+     Return true if successful, or the value of aBlock if not.
+     If not successfull, aBlock is called with an OsProcessStatus
+     (containing the exit status) as argument.
+     The given in, out and err streams may be arbitrary (Smalltalk-) streams;
+     if any is not an external stream (which is required by the command),
+     extra pipes and shuffler processes are created, which stuff the data into
+     those internal stream(s).
+     Nil stream args will execute the command connected to ST/X's standard input, output or
+     error resp. - i.e. usually, i/o will be from/to the terminal.
+
+     Set lineWise to true, if both error and output is sent to the same stream
+     and you don't want lines to be mangled. Set lineWise = false to
+     avoid blocking on pipes"
+
     |pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
      shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
      inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
@@ -1350,244 +1450,245 @@
     terminateLock := Semaphore forMutualExclusion.
     ((externalInStream := anInStream) notNil
      and:[externalInStream isExternalStream not]) ifTrue:[
-	pIn := NonPositionableExternalStream makePipe.
-	inStreamToClose := externalInStream := pIn at:1.
-	shuffledInStream := pIn at:2.
-	anInStream isBinary ifTrue:[
-	    shuffledInStream binary
-	].
-	lineWise ifFalse:[
-	    shuffledInStream blocking:false.
-	].
-
-	"/ start a reader process, shuffling data from the given
-	"/ inStream to the pipe (which is connected to the commands input)
-	inputShufflerProcess :=
-	    [
-		[
-		    [anInStream atEnd] whileFalse:[
-			self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
-			shuffledInStream flush
-		    ]
-		] ensure:[
-		    shuffledInStream close
-		]
-	    ] newProcess
-		name:'cmd input shuffler';
+        pIn := NonPositionableExternalStream makePipe.
+        inStreamToClose := externalInStream := pIn at:1.
+        shuffledInStream := pIn at:2.
+        anInStream isBinary ifTrue:[
+            shuffledInStream binary
+        ].
+        lineWise ifFalse:[
+            shuffledInStream blocking:false.
+        ].
+
+        "/ start a reader process, shuffling data from the given
+        "/ inStream to the pipe (which is connected to the commands input)
+        inputShufflerProcess :=
+            [
+                [
+                    [anInStream atEnd] whileFalse:[
+                        self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
+                        shuffledInStream flush
+                    ]
+                ] ensure:[
+                    shuffledInStream close
+                ]
+            ] newProcess
+                name:'cmd input shuffler';
 "/                beSystemProcess;
-		resume.
+                resume.
     ].
     ((externalOutStream := anOutStream) notNil
      and:[externalOutStream isExternalStream not]) ifTrue:[
-	pOut := NonPositionableExternalStream makePipe.
-	shuffledOutStream := (pOut at:1).
-	anOutStream isBinary ifTrue:[
-	    shuffledOutStream binary
-	].
-	outStreamToClose := externalOutStream := pOut at:2.
-	outputShufflerProcess :=
-	    [
-		WriteError handle:[:ex |
-		    "/ ignored
-		] do:[
-		    self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
-		].
-	    ] newProcess
-		priority:(Processor userSchedulingPriority "+ 1");
-		name:'cmd output shuffler';
+        pOut := NonPositionableExternalStream makePipe.
+        shuffledOutStream := (pOut at:1).
+        anOutStream isBinary ifTrue:[
+            shuffledOutStream binary
+        ].
+        outStreamToClose := externalOutStream := pOut at:2.
+        outputShufflerProcess :=
+            [
+                WriteError handle:[:ex |
+                    "/ ignored
+                ] do:[
+                    self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
+                ].
+            ] newProcess
+                priority:(Processor userSchedulingPriority "+ 1");
+                name:'cmd output shuffler';
 "/                beSystemProcess;
-		resume.
+                resume.
     ].
     (externalErrStream := anErrStream) notNil ifTrue:[
-	anErrStream == anOutStream ifTrue:[
-	    externalErrStream := externalOutStream
-	] ifFalse:[
-	    anErrStream isExternalStream ifFalse:[
-		pErr := NonPositionableExternalStream makePipe.
-		shuffledErrStream := (pErr at:1).
-		anErrStream isBinary ifTrue:[
-		    shuffledErrStream binary
-		].
-		errStreamToClose := externalErrStream := pErr at:2.
-		errorShufflerProcess :=
-		    [
-			self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
-		    ] newProcess
-			priority:(Processor userSchedulingPriority + 1);
-			name:'cmd err-output shuffler';
+        anErrStream == anOutStream ifTrue:[
+            externalErrStream := externalOutStream
+        ] ifFalse:[
+            anErrStream isExternalStream ifFalse:[
+                pErr := NonPositionableExternalStream makePipe.
+                shuffledErrStream := (pErr at:1).
+                anErrStream isBinary ifTrue:[
+                    shuffledErrStream binary
+                ].
+                errStreamToClose := externalErrStream := pErr at:2.
+                errorShufflerProcess :=
+                    [
+                        self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
+                    ] newProcess
+                        priority:(Processor userSchedulingPriority + 1);
+                        name:'cmd err-output shuffler';
 "/                        beSystemProcess;
-			resume.
-	    ]
-	]
+                        resume.
+            ]
+        ]
     ].
     ((externalAuxStream := anAuxStream) notNil
      and:[externalAuxStream isExternalStream not]) ifTrue:[
-	pAux := NonPositionableExternalStream makePipe.
-	auxStreamToClose := externalAuxStream := pAux at:1.
-	shuffledAuxStream := pAux at:2.
-	shuffledAuxStream blocking:false.
-	anAuxStream isBinary ifTrue:[
-	    shuffledAuxStream binary
-	].
-
-	"/ start a reader process, shuffling data from the given
-	"/ auxStream to the pipe (which is connected to the commands aux)
-	auxShufflerProcess :=
-	    [
-		[
-		    [anAuxStream atEnd] whileFalse:[
-			self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
-			shuffledAuxStream flush
-		    ]
-		] ensure:[
-		    shuffledAuxStream close
-		]
-	    ] newProcess
-		name:'cmd aux shuffler';
+        pAux := NonPositionableExternalStream makePipe.
+        auxStreamToClose := externalAuxStream := pAux at:1.
+        shuffledAuxStream := pAux at:2.
+        shuffledAuxStream blocking:false.
+        anAuxStream isBinary ifTrue:[
+            shuffledAuxStream binary
+        ].
+
+        "/ start a reader process, shuffling data from the given
+        "/ auxStream to the pipe (which is connected to the commands aux)
+        auxShufflerProcess :=
+            [
+                [
+                    [anAuxStream atEnd] whileFalse:[
+                        self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
+                        shuffledAuxStream flush
+                    ]
+                ] ensure:[
+                    shuffledAuxStream close
+                ]
+            ] newProcess
+                name:'cmd aux shuffler';
 "/                beSystemProcess;
-		resume.
+                resume.
     ].
 
     stopShufflers := [:shuffleRest |
-	    inputShufflerProcess notNil ifTrue:[
-		terminateLock critical:[inputShufflerProcess terminate].
-		inputShufflerProcess waitUntilTerminated
-	    ].
-	    auxShufflerProcess notNil ifTrue:[
-		terminateLock critical:[auxShufflerProcess terminate].
-		auxShufflerProcess waitUntilTerminated
-	    ].
-	    outputShufflerProcess notNil ifTrue:[
-		terminateLock critical:[outputShufflerProcess terminate].
-		outputShufflerProcess waitUntilTerminated.
-		shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
-		shuffledOutStream close.
-	    ].
-	    errorShufflerProcess notNil ifTrue:[
-		terminateLock critical:[errorShufflerProcess terminate].
-		errorShufflerProcess waitUntilTerminated.
-		shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
-		shuffledErrStream close.
-	    ].
-	].
+            inputShufflerProcess notNil ifTrue:[
+                terminateLock critical:[inputShufflerProcess terminate].
+                inputShufflerProcess waitUntilTerminated
+            ].
+            auxShufflerProcess notNil ifTrue:[
+                terminateLock critical:[auxShufflerProcess terminate].
+                auxShufflerProcess waitUntilTerminated
+            ].
+            outputShufflerProcess notNil ifTrue:[
+                terminateLock critical:[outputShufflerProcess terminate].
+                outputShufflerProcess waitUntilTerminated.
+                shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
+                shuffledOutStream close.
+            ].
+            errorShufflerProcess notNil ifTrue:[
+                terminateLock critical:[errorShufflerProcess terminate].
+                errorShufflerProcess waitUntilTerminated.
+                shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
+                shuffledErrStream close.
+            ].
+        ].
 
     closeStreams := [
-	    inStreamToClose notNil ifTrue:[
-		inStreamToClose close
-	    ].
-	    errStreamToClose notNil ifTrue:[
-		errStreamToClose close
-	    ].
-	    outStreamToClose notNil ifTrue:[
-		outStreamToClose close
-	    ].
-	    auxStreamToClose notNil ifTrue:[
-		auxStreamToClose close
-	    ].
-	    nullStream notNil ifTrue:[
-		nullStream close
-	    ].
-	].
+            inStreamToClose notNil ifTrue:[
+                inStreamToClose close
+            ].
+            errStreamToClose notNil ifTrue:[
+                errStreamToClose close
+            ].
+            outStreamToClose notNil ifTrue:[
+                outStreamToClose close
+            ].
+            auxStreamToClose notNil ifTrue:[
+                auxStreamToClose close
+            ].
+            nullStream notNil ifTrue:[
+                nullStream close
+            ].
+        ].
 
 
     sema := Semaphore new name:'OS command wait'.
     [
-	externalInStream isNil ifTrue:[
-	    externalInStream := nullStream := Filename nullDevice readWriteStream.
-	].
-	externalOutStream isNil ifTrue:[
-	    nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
-	    externalOutStream := nullStream.
-	].
-	externalErrStream isNil ifTrue:[
-	    externalErrStream := externalOutStream
-	].
-
-	pid := Processor
-		    monitor:[
-			self
-			    startProcess:aCommandStringOrArray
-			    inputFrom:externalInStream
-			    outputTo:externalOutStream
-			    errorTo:externalErrStream
-			    auxFrom:externalAuxStream
-			    environment:environmentDictionary
-			    inDirectory:dirOrNil
-		    ]
-		    action:[:status |
-			status stillAlive ifFalse:[
-			    exitStatus := status.
-			    sema signal.
-			    self closePid:pid
-			]
-		    ].
-
-	pid isNil ifTrue:[
-	    exitStatus := self osProcessStatusClass processCreationFailure
-	] ifFalse:[
-	    sema wait.
-	].
+        externalInStream isNil ifTrue:[
+            externalInStream := nullStream := Filename nullDevice readWriteStream.
+        ].
+        externalOutStream isNil ifTrue:[
+            nullStream isNil ifTrue:[nullStream := Filename nullDevice writeStream].
+            externalOutStream := nullStream.
+        ].
+        externalErrStream isNil ifTrue:[
+            externalErrStream := externalOutStream
+        ].
+
+        pid := Processor
+                    monitor:[
+                        self
+                            startProcess:aCommandStringOrArray
+                            inputFrom:externalInStream
+                            outputTo:externalOutStream
+                            errorTo:externalErrStream
+                            auxFrom:externalAuxStream
+                            environment:environmentDictionary
+                            inDirectory:dirOrNil
+                            showWindow:showWindowBooleanOrNil
+                    ]
+                    action:[:status |
+                        status stillAlive ifFalse:[
+                            exitStatus := status.
+                            sema signal.
+                            self closePid:pid
+                        ]
+                    ].
+
+        pid isNil ifTrue:[
+            exitStatus := self osProcessStatusClass processCreationFailure
+        ] ifFalse:[
+            sema wait.
+        ].
     ] ifCurtailed:[
-	closeStreams value.
-	pid notNil ifTrue:[
-	    "/ terminate the os-command (and all of its forked commands)
-	    self terminateProcessGroup:pid.
-	    self terminateProcess:pid.
-	    self closePid:pid.
-	].
-	stopShufflers value:false.
+        closeStreams value.
+        pid notNil ifTrue:[
+            "/ terminate the os-command (and all of its forked commands)
+            self terminateProcessGroup:pid.
+            self terminateProcess:pid.
+            self closePid:pid.
+        ].
+        stopShufflers value:false.
     ].
 
     closeStreams value.
     stopShufflers value:true.
     (exitStatus isNil or:[exitStatus success]) ifFalse:[
-	^ aBlock value:exitStatus
+        ^ aBlock value:exitStatus
     ].
     ^ true
 
     "
-	|outStream errStream|
-
-	outStream := '' writeStream.
-
-	OperatingSystem executeCommand:'ls -l'
-			inputFrom:'abc' readStream
-			outputTo:outStream
-			errorTo:nil
-			inDirectory:nil
-			lineWise:true
-			onError:[:exitStatus | ^ false].
-	outStream contents
-    "
-
-    "
-	|outStream errStream|
-
-	outStream := #[] writeStream.
-
-	OperatingSystem executeCommand:'cat'
-			inputFrom:(ByteArray new:5000000) readStream
-			outputTo:outStream
-			errorTo:nil
-			inDirectory:nil
-			lineWise:false
-			onError:[:exitStatus | ^ false].
-	outStream size
-    "
-
-    "
-	|outStream errStream|
-
-	outStream := '' writeStream.
-
-	OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
-			inputFrom:'bla' readStream
-			outputTo:outStream
-			errorTo:nil
-			inDirectory:nil
-			lineWise:true
-			onError:[:exitStatus |  false].
-	outStream contents
+        |outStream errStream|
+
+        outStream := '' writeStream.
+
+        OperatingSystem executeCommand:'ls -l'
+                        inputFrom:'abc' readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:true
+                        onError:[:exitStatus | ^ false].
+        outStream contents
+    "
+
+    "
+        |outStream errStream|
+
+        outStream := #[] writeStream.
+
+        OperatingSystem executeCommand:'cat'
+                        inputFrom:(ByteArray new:5000000) readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:false
+                        onError:[:exitStatus | ^ false].
+        outStream size
+    "
+
+    "
+        |outStream errStream|
+
+        outStream := '' writeStream.
+
+        OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
+                        inputFrom:'bla' readStream
+                        outputTo:outStream
+                        errorTo:nil
+                        inDirectory:nil
+                        lineWise:true
+                        onError:[:exitStatus |  false].
+        outStream contents
     "
 
     "Modified: / 11-02-2007 / 20:54:39 / cg"
@@ -2005,6 +2106,35 @@
     "Created: / 10.11.1998 / 21:05:45 / cg"
 !
 
+executeCommand:aCommandString outputTo:outStreamOrNil errorTo:errStreamOrNil inDirectory:aDirectory showWindow:showWindowBooleanOrNil
+    "much like #executeCommand:, but changes the current directory
+     for the command. Since this is OS specific, use this instead of
+     hardwiring any 'cd ..' command strings into your applictions."
+
+     ^ self
+        executeCommand:aCommandString
+        inputFrom:nil
+        outputTo:outStreamOrNil
+        errorTo:errStreamOrNil
+        auxFrom:nil
+        environment:nil
+        inDirectory:aDirectory
+        lineWise:false
+        showWindow:showWindowBooleanOrNil
+        onError:[:status| false]
+
+    "
+     OperatingSystem executeCommand:'tdump date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'.
+     OperatingSystem executeCommand:'xxdir date.obj' inDirectory:'c:\winstx\stx\libbasic\objbc'.
+     OperatingSystem executeCommand:'dir' inDirectory:'c:\'.
+     OperatingSystem executeCommand:'dir'
+    "
+
+    "Modified: / 20.1.1998 / 17:03:03 / md"
+    "Modified: / 10.11.1998 / 20:28:10 / cg"
+    "Created: / 10.11.1998 / 21:05:45 / cg"
+!
+
 executeCommand:aCommandString outputTo:outStreamOrNil inDirectory:aDirectory
     "much like #executeCommand:, but changes the current directory
      for the command. Since this is OS specific, use this instead of