--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/UnixPTYStream.st Thu Jul 09 22:02:12 1998 +0200
@@ -0,0 +1,328 @@
+"
+ COPYRIGHT (c) 1998 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+
+PipeStream subclass:#UnixPTYStream
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'OS-Unix'
+!
+
+!UnixPTYStream class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 1998 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+
+!
+
+documentation
+"
+ These are much like PipeStreams, but allow bi-directional communication
+ with a Unix command. (i.e. everything written to the PTYStream is seen
+ by the commands standard-input, everything written by the command to its
+ stdErr or stdOut can be read from me.
+
+ In addition, sending control characters (such as INTR or QUIT),
+ will be handled by the command as a signal (unless the command changed
+ its standard input to raw mode).
+
+ [author:]
+ Claus Gittinger
+
+ [see also:]
+ TerminalView
+ PipeStream ExternalStream FileStream Socket
+ OperatingSystem
+"
+
+!
+
+examples
+"
+ that one is not special (could be done with a PipeStream):
+ [exBegin]
+ |pty|
+
+ pty := UnixPTYStream to:'ls -l'.
+ [pty atEnd] whileFalse:[
+ Transcript showCR:(pty nextLine).
+ ].
+ pty close.
+ [exEnd]
+ [exBegin]
+ |pty|
+
+ pty := PipeStream readingFrom:'ls -l'.
+ [pty atEnd] whileFalse:[
+ Transcript showCR:(pty nextLine).
+ ].
+ pty close.
+ [exEnd]
+ [exBegin]
+ |pty|
+
+ pty := PipeStream readingFrom:'rsh ibm ls -l'.
+ [pty atEnd] whileFalse:[
+ Transcript showCR:(pty nextLine).
+ ].
+ pty close.
+ [exEnd]
+
+ but that one is (simulating an editor session):
+ [exBegin]
+ |pty|
+
+ pty := UnixPTYStream to:'ed'.
+ [
+ pty readWait.
+ [pty atEnd] whileFalse:[
+ Transcript showCR:(pty nextLine).
+ pty readWait.
+ ].
+ pty close.
+ ] forkAt:9.
+
+ pty nextPutLine:'r Makefile'.
+ pty nextPutLine:'1,2d'.
+ pty nextPutLine:'$d'.
+ pty nextPutLine:'w xxx'.
+ pty nextPutLine:'q'.
+ [exEnd]
+
+"
+! !
+
+!UnixPTYStream class methodsFor:'instance creation'!
+
+to:commandString
+ "create and return a new ptyStream which can read/write to the unix command
+ given by commandString."
+
+ ^ (self basicNew) to:commandString
+
+ "unix:
+ UnixPTYStream to:'sh'
+ "
+
+ "Modified: / 9.7.1998 / 18:26:31 / cg"
+! !
+
+!UnixPTYStream class methodsFor:'blocked instance creation'!
+
+readingFrom:commandString
+ ^ self shouldNotImplement
+
+ "Created: / 9.7.1998 / 18:25:09 / cg"
+ "Modified: / 9.7.1998 / 18:25:34 / cg"
+!
+
+readingFrom:commandString errorDisposition:handleError inDirectory:aDirectory
+ ^ self shouldNotImplement
+
+ "Modified: / 9.7.1998 / 18:25:31 / cg"
+!
+
+readingFrom:commandString inDirectory:aDirectory
+ ^ self shouldNotImplement
+
+ "Created: / 9.7.1998 / 18:25:38 / cg"
+!
+
+writingTo:commandString
+ ^ self shouldNotImplement
+
+ "Created: / 9.7.1998 / 18:25:42 / cg"
+!
+
+writingTo:commandString inDirectory:aDirectory
+ ^ self shouldNotImplement
+
+ "Created: / 9.7.1998 / 18:25:46 / cg"
+! !
+
+!UnixPTYStream methodsFor:'private'!
+
+openPTYFor:aCommandString withMode:mode inDirectory:aDirectrory
+ "open a pty to the unix command in commandString"
+
+ |blocked ptyFdArray execFdArray slaveFd masterFd shellAndArgs
+ osType shellPath shellArgs closeFdArray mbx mbxName
+ env shell args|
+
+ filePointer notNil ifTrue:[
+ "the pipe was already open ...
+ this should (can) not happen."
+ ^ self errorOpen
+ ].
+
+ lastErrorNumber := nil.
+ exitStatus := nil.
+ exitSema := Semaphore new name:'pty exitSema'.
+
+ osType := OperatingSystem platformName.
+ osType == #vms 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.
+
+ execFdArray := Array with:mbx with:mbx with:mbx.
+ closeFdArray := nil.
+ ] ifFalse:[
+ ptyFdArray := OperatingSystem makePTYPair.
+ ptyFdArray isNil ifTrue:[
+ lastErrorNumber := OperatingSystem currentErrorNumber.
+ ^ self openError
+ ].
+
+ 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.
+ closeFdArray := Array with:masterFd.
+ ].
+
+ 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.
+
+ pid := Processor
+ monitor:[
+ OperatingSystem
+ exec:shellPath
+ withArguments:shellArgs
+ environment:env
+ fileDescriptors:execFdArray
+ closeDescriptors:closeFdArray
+ fork:true
+ newPgrp:true
+"/ inDirectory:aDirectrory.
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
+ OperatingSystem closePid:pid.
+ pid := nil.
+ exitSema signal.
+ ].
+ ].
+
+ (osType ~~ #vms) ifTrue:[
+ OperatingSystem closeFd:slaveFd.
+ ].
+
+ pid notNil ifTrue:[
+ (osType == #win32) ifTrue:[
+ self setFileDescriptor:masterFd mode:mode.
+ "/ self setFileHandle:masterFd mode:mode
+ ] ifFalse:[
+ (osType == #vms) ifTrue:[
+ "/
+ "/ reopen the mailbox as a file ...
+ "/
+ mbxName := OperatingSystem mailBoxNameOf:mbx.
+ mbxName notNil ifTrue:[
+ super open:mbxName withMode:mode
+ ].
+ ] ifFalse:[
+ self setFileDescriptor:masterFd mode:mode.
+ ]
+ ]
+ ] ifFalse:[
+ lastErrorNumber := OperatingSystem currentErrorNumber.
+ osType == #vms ifTrue:[
+ OperatingSystem destroyMailBox:mbx
+ ] ifFalse:[
+ OperatingSystem closeFd:masterFd.
+ ].
+ ].
+
+ 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.
+
+ position := 1.
+ hitEOF := false.
+ binary := false.
+ Lobby register:self.
+
+ "Created: / 9.7.1998 / 20:21:42 / cg"
+ "Modified: / 9.7.1998 / 20:28:31 / cg"
+!
+
+to:command
+ "setup the receiver to read/write to command"
+
+ mode := #readwrite. didWrite := true.
+ ^ self openPTYFor:command withMode:ReadWriteMode inDirectory:nil
+
+ "Created: / 9.7.1998 / 18:27:40 / cg"
+ "Modified: / 9.7.1998 / 20:22:39 / cg"
+! !
+
+!UnixPTYStream methodsFor:'testing'!
+
+atEnd
+ ReadErrorSignal handle:[:ex |
+ ex return
+ ] do:[
+ ^ super atEnd.
+ ].
+ ^ true
+
+ "Created: / 9.7.1998 / 20:29:03 / cg"
+ "Modified: / 9.7.1998 / 20:29:48 / cg"
+! !
+
+!UnixPTYStream class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic2/UnixPTYStream.st,v 1.1 1998-07-09 20:02:12 cg Exp $'
+! !