"
 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]


  prove (done with a PipeStream):
                                                                [exBegin]
    |pty|

    pty := PipeStream readingFrom:'ls -l'.
    [pty atEnd] whileFalse:[
        Transcript showCR:(pty nextLine).
    ].
    pty close.
                                                                [exEnd]


  but that one is not possible with a PipeStream
  (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]


  and that one is even better ...
  (simulating a login session):
                                                                [exBegin]
    |pty password command|

    pty := UnixPTYStream to:'rlogin ' , OperatingSystem getHostName.
    [
        pty readWait.
        [pty atEnd] whileFalse:[
            Transcript show:(pty next).
            pty readWait.
        ].
        pty close.
    ] forkAt:9.

    password := Dialog requestPassword:'password'.
    pty nextPutLine:password.
    command := Dialog request:'command'.
    pty nextPutLine:command.
    pty nextPutLine:'exit'.
                                                                [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
     shellPath shellArgs 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'.

    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.

        execFdArray := Array with:mbx with:mbx with:mbx.
    ] 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.
    ].

    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
                      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.6 2003-02-27 14:50:38 stefan Exp $'
! !