"

 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 := 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

! !