#FEATURE by cg
authorClaus Gittinger <cg@exept.de>
Tue, 08 Nov 2016 20:17:32 +0100
changeset 20928 af007eb0d189
parent 20927 99f7f2a6debe
child 20929 a60bc618b504
#FEATURE by cg class: AbstractOperatingSystem added: #executeCommand:inputFrom:outputTo:errorTo:auxFrom:environment:inDirectory:lineWise:newPgrp:showWindow:onError:
AbstractOperatingSystem.st
--- a/AbstractOperatingSystem.st	Tue Nov 08 20:16:11 2016 +0100
+++ b/AbstractOperatingSystem.st	Tue Nov 08 20:17:32 2016 +0100
@@ -1424,6 +1424,296 @@
 
 executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
     errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
+    inDirectory:dirOrNil lineWise:lineWise newPgrp:newPgrp 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.
+
+     Special for windows:
+        you can control (have to - sigh) if a window should be shown for the command or not.
+        This is the OS's H_SHOWWINDOW argument.
+        If you pass nil as showWindow-argument, the OS's default is used for the particular
+        command, which is correct most of the time: i.e. a notepad will open its window, other (non-UI)
+        executables will not.
+        However, some command-line executables show a window, even if they should not.
+        (and also, there seems to be an inconsistency between windows7 and newer windows: in newer,
+         a shell command opens a cmd-window, whereas in windows7 it did not)
+        In this case, pass an explicit false argument to suppress it.
+        This argument is ignored on Unix systems.
+        See examples below."
+
+    |pid exitStatus sema pIn pOut pErr pAux externalInStream externalOutStream externalErrStream externalAuxStream
+     shuffledInStream shuffledOutStream shuffledErrStream shuffledAuxStream
+     inputShufflerProcess outputShufflerProcess errorShufflerProcess auxShufflerProcess stopShufflers
+     inStreamToClose outStreamToClose errStreamToClose auxStreamToClose nullStream terminateLock
+     closeStreams|
+
+    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';
+"/                beSystemProcess;
+                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';
+"/                beSystemProcess;
+                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';
+"/                        beSystemProcess;
+                        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';
+"/                beSystemProcess;
+                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.
+            ].
+        ].
+
+    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
+            ].
+        ].
+
+
+    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
+                            newPgrp:newPgrp
+                            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.
+    stopShufflers value:true.
+    (exitStatus isNil or:[exitStatus success]) ifFalse:[
+        ^ 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
+    "
+
+    "Modified: / 11-02-2007 / 20:54:39 / cg"
+!
+
+executeCommand:aCommandStringOrArray inputFrom:anInStream outputTo:anOutStream
+    errorTo:anErrStream auxFrom:anAuxStream environment:environmentDictionary
     inDirectory:dirOrNil lineWise:lineWise onError:aBlock
 
     "execute the unix command specified by the argument, aCommandStringOrArray.