UnixPTYStream.st
changeset 4245 79cce4a51ea1
parent 4242 f870cb692e7e
child 4254 7cccdc94fa82
child 4558 6b2a3c9cec9f
--- a/UnixPTYStream.st	Thu Dec 29 20:42:45 2016 +0100
+++ b/UnixPTYStream.st	Thu Dec 29 22:53:02 2016 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1998 by eXept Software AG
               All Rights Reserved
@@ -182,8 +184,7 @@
 openPTYFor:aCommandString withMode:openMode inDirectory:aDirectory
     "open a pty to the unix command in commandString"
 
-    |blocked ptyFdArray execFdArray slaveFd masterFd shellAndArgs
-     shellPath shellArgs mbx mbxName env|
+    |ptyFdArray slaveFd masterFd env remotePipeEnd result|
 
     handle notNil ifTrue:[
         "the pipe was already open ...
@@ -192,113 +193,54 @@
     ].
         
     lastErrorNumber := nil.
-    exitStatus := nil.
-    exitSema := Semaphore new name:'pty exitSema'.
+    "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:[
-        mbx := OperatingSystem createMailBox.
-        mbx isNil ifTrue:[
-            lastErrorNumber := OperatingSystem currentErrorNumber.
-            ^ self openError
-        ].
-        mbxName := OperatingSystem mailBoxNameOf:mbx.
-        "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
-
-        shellPath := ''.
-        shellArgs := aCommandString.
+    ptyFdArray := OperatingSystem makePTYPair.
+    ptyFdArray isNil ifTrue:[
+        lastErrorNumber := OperatingSystem lastErrorNumber.
+        ^ self openError:lastErrorNumber.
+    ].
 
-        execFdArray := Array with:mbx with:mbx with:mbx.
-    ] ifFalse:[
-        ptyFdArray := OperatingSystem makePTYPair.
-        ptyFdArray isNil ifTrue:[
-            lastErrorNumber := OperatingSystem currentErrorNumber.
-            ^ self openError
-        ].
+    masterFd := ptyFdArray at:1.
+    slaveFd := ptyFdArray at:2.
 
-        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:aCommandString.
-        shellPath := shellAndArgs at:1.
-        shellArgs := shellAndArgs at:2.
-
-        masterFd := ptyFdArray at:1.
-        slaveFd := ptyFdArray at:2.
-        execFdArray := Array with:slaveFd with:slaveFd with:slaveFd.
-    ].
+    remotePipeEnd := self class forFileDescriptor:slaveFd mode:#readwrite buffered:false handleType:#pipeFilePointer.
 
     env := Dictionary new.
     env at:'TERM'  put:'dumb'.
-    env at:'SHELL' put:shellPath.
-
-    "/ must block here, to avoid races due to early finishing
-    "/ subprocesses ...
-
-    blocked := OperatingSystem blockInterrupts.
+    env at:'SHELL' put:'/bin/sh'.
 
-    pid := Processor 
-               monitor:[
-                  OperatingSystem 
-                      exec:shellPath
-                      withArguments:shellArgs
-                      environment:env
-                      fileDescriptors:execFdArray
-                      fork:true
-                      newPgrp:true
-                      inDirectory:aDirectory
-                      showWindow:nil.
-               ]
-               action:[:status |
-                  status stillAlive ifFalse:[
-                      exitStatus := status.
-                      OperatingSystem closePid:pid.
-                      pid := nil.
-                      exitSema signal.
-                  ].
-               ].
+    osProcess := OSProcess new 
+                    command:aCommandString;
+                    directory:aDirectory;
+                    environment:env;
+                    inStream:remotePipeEnd;
+                    outStream:remotePipeEnd;
+                    errorStream:remotePipeEnd.
 
-    (OperatingSystem isVMSlike) ifFalse:[
-        OperatingSystem closeFd:slaveFd.
+    result := osProcess startProcess.
+
+    remotePipeEnd notNil ifTrue:[
+        remotePipeEnd close.
     ].
 
-    pid notNil ifTrue:[
-        (OperatingSystem isVMSlike) ifTrue:[
-            "/
-            "/ reopen the mailbox as a file ...
-            "/
-            mbxName := OperatingSystem mailBoxNameOf:mbx.
-            mbxName notNil ifTrue:[
-                self open:mbxName withMode:openMode
-            ].
-        ] ifFalse:[
-            self setFileHandle:masterFd mode:openMode.
-        ]
+    result ifTrue:[
+        self setFileHandle:masterFd mode:openMode.
     ] ifFalse:[
-        lastErrorNumber := OperatingSystem currentErrorNumber.
-        OperatingSystem isVMSlike ifTrue:[
-            OperatingSystem destroyMailBox:mbx
-        ] ifFalse:[
-            OperatingSystem closeFd:masterFd.
-        ].
+        "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)"
+        lastErrorNumber := OperatingSystem lastErrorNumber.
+        OperatingSystem closeFd:masterFd.
+        ^ self openError:lastErrorNumber.
     ].
 
-    blocked ifFalse:[
-        OperatingSystem unblockInterrupts
-    ].
-
-    lastErrorNumber notNil ifTrue:[
-        "
-         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)
-        "
-        ^ self openError
-    ].
-
-    commandString := aCommandString.
-    buffered := false.
-
-    hitEOF := false.
-    binary := false.
-    Lobby register:self.
+    self registerForFinalization.
 
     "Created: / 9.7.1998 / 20:21:42 / cg"
     "Modified: / 9.7.1998 / 20:28:31 / cg"