changed: #openPipeFor:withMode:errorDisposition:inDirectory:
authorStefan Vogel <sv@exept.de>
Fri, 26 Oct 2012 11:51:53 +0200
changeset 14436 c65fa56075a4
parent 14435 fc486e748569
child 14437 3a983b537183
changed: #openPipeFor:withMode:errorDisposition:inDirectory: raise #openError: instead of #openError
PipeStream.st
--- a/PipeStream.st	Fri Oct 26 11:49:17 2012 +0200
+++ b/PipeStream.st	Fri Oct 26 11:51:53 2012 +0200
@@ -566,20 +566,20 @@
 
     |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
      shellPath shellArgs mbx mbxName
-     realCmd execDirectory tmpComFile nullOutput resultPid|
+     realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
 
     handle notNil ifTrue:[
-	"the pipe was already open ...
-	 this should (can) not happen."
-	^ self errorAlreadyOpen
+        "the pipe was already open ...
+         this should (can) not happen."
+        ^ self errorAlreadyOpen
     ].
 
     rwMode = #r ifTrue:[
-	mode := #readonly. didWrite := false.
+        mode := #readonly. didWrite := false.
     ] ifFalse:[rwMode = #'r+' ifTrue:[
-	mode := #readwrite. didWrite := true.
+        mode := #readwrite. didWrite := true.
     ] ifFalse:[
-	mode := #writeonly. didWrite := true.
+        mode := #writeonly. didWrite := true.
     ]].
 
     lastErrorNumber := nil.
@@ -591,79 +591,79 @@
     execFdArray := #(0 1 2) copy.
 
     OperatingSystem isVMSlike ifTrue:[
-	"/
-	"/ the generated COM-file includes a 'set default'
-	"/
-	tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
-	realCmd := '@' , tmpComFile osName.
-	execDirectory := nil.
+        "/
+        "/ the generated COM-file includes a 'set default'
+        "/
+        tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
+        realCmd := '@' , tmpComFile osName.
+        execDirectory := nil.
 
-	mbx := OperatingSystem createMailBox.
-	mbx isNil ifTrue:[
-	    lastErrorNumber := OperatingSystem currentErrorNumber.
-	    tmpComFile delete.
-	    ^ self openError
-	].
-	mbxName := OperatingSystem mailBoxNameOf:mbx.
+        mbx := OperatingSystem createMailBox.
+        mbx 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.
+        "/ '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.
-	].
+        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.
+        ].
     ] ifFalse:[
-	shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
-	shellPath := shellAndArgs at:1.
-	shellArgs := shellAndArgs at:2.
+        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
+        shellPath := shellAndArgs at:1.
+        shellArgs := shellAndArgs at:2.
 
-	mode == #readwrite ifTrue:[
-	    pipeFdArray := OperatingSystem makeBidirectionalPipe.
-	    pipeFdArray isNil ifTrue:[
-		lastErrorNumber := OperatingSystem currentErrorNumber.
-		^ self openError
-	    ].
-	    myFd := pipeFdArray at:1.
-	    execFd := pipeFdArray at:2.
-	    execFdArray at:1 put:execFd.
-	    execFdArray at:2 put:execFd.
-	] ifFalse:[
-	    pipeFdArray := OperatingSystem makePipe.
-	    pipeFdArray isNil ifTrue:[
-		lastErrorNumber := OperatingSystem currentErrorNumber.
-		^ self openError
-	    ].
+        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.
+        ] 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.
-	    ].
-	].
+            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.
+            ].
+        ].
     ].
 
     errorDisposition == #discard ifTrue:[
-	nullOutput := Filename nullDevice writeStream.
-	execFdArray at:3 put:nullOutput fileDescriptor
+        nullOutput := Filename nullDevice writeStream.
+        execFdArray at:3 put:nullOutput fileDescriptor
     ] ifFalse:[
-	(errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
-	    execFdArray at:3 put:1
-	] 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
@@ -673,84 +673,84 @@
 
     "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.
-	       ]
-	       action:[:status |
-		  status stillAlive ifFalse:[
-		      exitStatus := status.
+               monitor:[
+                  OperatingSystem
+                      exec:shellPath
+                      withArguments:shellArgs
+                      environment:nil
+                      fileDescriptors:execFdArray
+                      fork:true
+                      newPgrp:true
+                      inDirectory:execDirectory.
+               ]
+               action:[:status |
+                  status stillAlive ifFalse:[
+                      exitStatus := status.
 
-		      "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.
-		  ].
-	       ].
+                      OperatingSystem closePid:pid.
+                      pid := nil.
+                      exitSema signal.
+                  ].
+               ].
 
     "subprocess has been created.
      close unused filedescriptors"
 
     execFd notNil ifTrue:[
-	OperatingSystem closeFd:execFd.
+        OperatingSystem closeFd:execFd.
     ].
 
     nullOutput notNil ifTrue:[
-	nullOutput close
+        nullOutput close
     ].
 
     resultPid notNil 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 setFileDescriptor:myFd mode:rwMode.
-	    handleType := #pipeFilePointer.
-	]
+        "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 setFileDescriptor:myFd mode:rwMode.
+            handleType := #pipeFilePointer.
+        ]
     ] ifFalse:[
-	"creation of subprocesss failed"
-	lastErrorNumber := OperatingSystem currentErrorNumber.
-	OperatingSystem isVMSlike ifTrue:[
-	    OperatingSystem destroyMailBox:mbx.
-	    tmpComFile delete.
-	] ifFalse:[
-	    OperatingSystem closeFd:myFd.
-	].
+        "creation of subprocesss failed"
+        lastErrorNumber := OperatingSystem currentErrorNumber.
+        OperatingSystem isVMSlike ifTrue:[
+            OperatingSystem destroyMailBox:mbx.
+            tmpComFile delete.
+        ] ifFalse:[
+            OperatingSystem closeFd:myFd.
+        ].
     ].
 
     blocked ifFalse:[
-	OperatingSystem unblockInterrupts
+        OperatingSystem unblockInterrupts
     ].
 
     (resultPid isNil or:[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)
-	"
-	exitAction value.
-	^ self openError
+        "
+         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.
+        ^ self openError:lastErrorNumber.
     ].
 
     commandString := realCmd.
@@ -796,11 +796,11 @@
 !PipeStream class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.111 2010-02-09 18:01:01 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.112 2012-10-26 09:51:53 stefan Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.111 2010-02-09 18:01:01 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.112 2012-10-26 09:51:53 stefan Exp $'
 ! !
 
 PipeStream initialize!