diff -r 1c1d4014849b -r f7f96fedf2ea UnixPTYStream.st --- /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 $' +! !