"{ Package: 'stx:libbasic2' }"

"{ NameSpace: Smalltalk }"

Object subclass:#TerminalSession

	instanceVariableNames:'inStream outStream errStream readerProcess shellPid shellCommand

		shellDirectory readerDelay pluggableCheckBeforeReadAction

		pluggableProcessInputAction execFDArray stxToStdinPipe

		stdOutToStxPipe pty ptyName terminatedAction collectedOutput

		promptActions'

	classVariableNames:'Debug'

	poolDictionaries:''

	category:'Views-TerminalViews'

!

!TerminalSession class methodsFor:'documentation'!

documentation

"

    This keeps the state and API to interact with another program

    via a terminal session. Under Unix, a pseudo-tty connection

    is used; other operating systems might use other mechanisms.

    This is (currently) used by the GDBApplication, to interact

    offers (such as terminal emulation, window size, CTRL-c support etc.)

    A lot of code has been Extracted from TerminalView, which will be refactored, 

    outStream   - the controlled program's output (a pty-half)

    inStream    - the controlled program's input (a pty-half)

    errStream   - the controlled program's output (a pty-half)

"

! !

!TerminalSession class methodsFor:'initialization'!

initialize

    Debug := false.

    "

     self initialize

    "

! !

!TerminalSession methodsFor:'accessing'!

errStream

    ^ errStream

!

inStream

    ^ inStream

!

outStream

    ^ outStream

!

pluggableCheckBeforeReadAction:something

    pluggableCheckBeforeReadAction := something.

!

pluggableProcessInputAction:something

    pluggableProcessInputAction := something.

!

pty

    ^ pty

!

ptyName

    ^ ptyName

!

shellCommand

    ^ shellCommand

!

shellDirectory

    ^ shellDirectory

!

shellPid

    ^ shellPid

!

terminatedAction:something

    terminatedAction := something.

! !

!TerminalSession methodsFor:'initialization & release'!

closeDownShell

    "shut down my shell process and stop the background reader thread."

    |pid|

    (pid := shellPid) notNil ifTrue:[

        Debug ifTrue:[

            Transcript show:'killing shell pid='; showCR:pid.

        ].

        OperatingSystem isMSWINDOWSlike ifFalse:[

            OperatingSystem terminateProcessGroup:pid.

        ].    

        OperatingSystem terminateProcess:pid.

        Delay waitForSeconds:0.2.

        shellPid notNil ifTrue:[

            "/ Delay waitForSeconds:1.

            OperatingSystem isMSWINDOWSlike ifFalse:[

                OperatingSystem killProcessGroup:pid.

            ].

            OperatingSystem killProcess:pid.

            shellPid := nil.

        ].

        OperatingSystem closePid:pid.

    ].

    "Modified: / 5.5.1999 / 18:43:02 / cg"

!

closeStreams

    self stopReaderProcess.

    inStream notNil ifTrue:[

        inStream isStream ifTrue:[inStream close].

        inStream := nil

    ].

    outStream notNil ifTrue:[

        outStream close.

        outStream := nil

    ].

    errStream notNil ifTrue:[

        errStream close.

        errStream := nil

    ].

!

createTerminalConnectionAndSetupWith:setupBlock

    "create a terminal conenction (pseudo terminal or pipe)"

    |slaveFD master slave ptyTriple|

    OperatingSystem isMSWINDOWSlike ifTrue:[

        "use two pipes to COMMAND.COM"

        stxToStdinPipe := NonPositionableExternalStream makePipe.

        stxToStdinPipe isNil ifTrue:[

            self error:(self class classResources string:'Could not create pipe to COMMAND.COM.') mayProceed:true. 

            ^ self.

        ].

        stdOutToStxPipe := NonPositionableExternalStream makePipe.

        stdOutToStxPipe isNil ifTrue:[

            self error:(self class classResources classResources string:'Could not create pipe from COMMAND.COM.') mayProceed:true. 

            ^ self.

        ].

        "/ pipe readSide is p at:1;

        "/      writeSide is p at:2

        slaveFD := (stdOutToStxPipe at:2) fileDescriptor.

        execFDArray := Array 

                         with:(stxToStdinPipe at:1) fileDescriptor        "stdin"

                         with:slaveFD                                       "stdout"

                         with:slaveFD.                                      "stderr"

        outStream := stdOutToStxPipe at:1.

        inStream  := stxToStdinPipe at:2.

    ] ifFalse:[

        "Use a pseudo-tty"

        ptyTriple := OperatingSystem makePTY.

        ptyTriple isNil ifTrue:[

            self warn:'Cannot open pty.'.

            ^ self.

        ].

        ptyName := ptyTriple at:3.

        "/ pty at:1 is the master;

        "/ pty at:2 is the slave

        master := NonPositionableExternalStream forReadWriteToFileDescriptor:(ptyTriple at:1).

        master buffered:false.

        slave := NonPositionableExternalStream forReadWriteToFileDescriptor:(ptyTriple at:2).

        slave buffered:false.

        pty := { master . slave }.

        inStream := outStream := master.

        setupBlock value.

        "/ fork a shell process on the slave-side

        slaveFD := (ptyTriple at:2).

        execFDArray := Array with:slaveFD with:slaveFD with:slaveFD.

    ].

!

killShell

    "shut down my shell process and stop the background reader thread."

    |pid|

    (pid := shellPid) notNil ifTrue:[

        Debug ifTrue:[

            Transcript show:'killing shell pid='; showCR:pid.

        ].

        OperatingSystem terminateProcessGroup:pid.

        OperatingSystem terminateProcess:pid.

        Delay waitForSeconds:1.

        shellPid notNil ifTrue:[

            OperatingSystem isMSWINDOWSlike ifFalse:[

                OperatingSystem killProcessGroup:pid.

            ].

            OperatingSystem killProcess:pid.

            shellPid := nil.

        ].

        OperatingSystem closePid:pid.

    ].

!

reinitialize

    shellPid := nil.

    inStream := outStream := errStream := nil.

!

startCommand:aCommand in:aDirectory environment:envIn setupTerminalWith:setupBlock terminatedAction:terminatedActionArg

    "start a command on a pseudo terminal. If the command arg is nil,

     a shell is started. If aDirectory is not nil, the command is

     executed in that directory.

     Also fork a reader process, to read the shell's output and

     tell me, whenever something arrives"

    |blocked exitStatus 

     cmd shell args env shellAndArgs didOpenTerminal|

    shellCommand := aCommand.

    shellDirectory := aDirectory.

    terminatedAction := terminatedActionArg.

    didOpenTerminal := false.

    (inStream isNil or:[outStream isNil]) ifTrue:[

        self createTerminalConnectionAndSetupWith:setupBlock.

        didOpenTerminal := true.

    ].

    OperatingSystem isMSWINDOWSlike ifTrue:[

        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:aCommand.

        shell := shellAndArgs at:1.

        args  := (shellAndArgs at:2) ? ''.

    ] ifFalse:[

        aCommand isNil ifTrue:[

            shell := OperatingSystem getEnvironment:'SHELL'.

            shell size == 0 ifTrue:[

                shell := '/bin/sh'.

            ].

            cmd := shell asFilename baseName.

            args := (Array with:cmd).

        ] ifFalse:[

            shell := '/bin/sh'.

            args := (Array with:'sh' with:'-c' with:aCommand).

        ].

        env := Dictionary new.

        env declareAllFrom:envIn.

        env at:'SHELL' put:shell.

    ].

    blocked := OperatingSystem blockInterrupts.

    shellPid := Processor

               monitor:[

                  OperatingSystem

                      exec:shell

                      withArguments:args

                      environment:env

                      fileDescriptors:execFDArray

                      fork:true

                      newPgrp:true

                      inDirectory:aDirectory.

               ]

               action:[:status |

                    Debug ifTrue:[

                        Transcript show:'pid:'; showCR:status pid.

                        Transcript show:'status:'; showCR:status status.

                        Transcript show:'code:'; showCR:status code.

                        Transcript show:'core:'; showCR:status core.

                    ].

                    status stillAlive ifFalse:[

                        exitStatus := status.

                        OperatingSystem closePid:shellPid.

                        shellPid := nil.

                        terminatedAction valueWithOptionalArgument:status

                    ].

               ].

    blocked ifFalse:[

        OperatingSystem unblockInterrupts

    ].

    "close the slave side of the pty/pipes (only used by the child)"

    pty notNil ifTrue:[

        (pty at:2) close.

    ].

    didOpenTerminal ifTrue:[

        stdOutToStxPipe notNil ifTrue:[

            (stdOutToStxPipe at:2) close.

            (stxToStdinPipe at:1) close.

        ].

        shellPid isNil ifTrue:[

        "/ self warn:'Cannot start shell'.

            outStream notNil ifTrue:[outStream close].

            inStream notNil ifTrue:[inStream close].

            inStream := outStream := nil.

        ].

    ].

    ^ shellPid

    "Created: / 20-07-1998 / 18:19:32 / cg"

    "Modified: / 01-08-2013 / 20:38:37 / cg"

! !

!TerminalSession methodsFor:'input / output'!

paste:someText

    "paste - redefined to send the chars to the shell instead

     of pasting into the view"

    |s nLines|

    s := someText.

    s isString ifTrue:[

        s := s asStringCollection

    ] ifFalse:[

        (s isKindOf:StringCollection) ifFalse:[

            self warn:'selection (' , s class name , ') is not convertable to Text'.

            ^ self

        ]

    ].

    (nLines := s size) == 0 ifTrue:[^ self].

    (nLines == 1 and:[(s at:1) size == 0]) ifTrue:[^ self].

    s keysAndValuesDo:[:idx :line |

        line notNil ifTrue:[inStream nextPutAll:line].

        idx ~~ nLines ifTrue:[

            self sendLineEnd.

        ]

    ].

    "Modified: / 12.6.1998 / 22:12:47 / cg"

!

sendCharacter:aCharacter

    inStream nextPut:aCharacter.

!

sendLine:aString

    inStream nextPutAll:aString.

    self sendLineEnd

!

sendLineEnd

    OperatingSystem isMSDOSlike ifTrue:[

        inStream nextPut:Character return.

        inStream nextPut:Character linefeed.

    ] ifFalse:[

        inStream nextPut:Character return.

    ].

! !

!TerminalSession methodsFor:'misc'!

collectedOutput

    "return any collected output, so far"

    collectedOutput isNil ifTrue:[^ nil].

    ^ collectedOutput contents

!

defineWindowSizeLines:numberOfLines columns:numberOfColumns

    | delta prevNumCols prevNumLines|

    "/ any idea, how to do this under windows ?

    OperatingSystem isUNIXlike ifTrue:[

        "/

        "/ tell the pty;

        "/ tell the shell;

        "/

        (inStream notNil 

        and:[inStream isExternalStream

        and:[inStream isOpen]]) ifTrue:[

            Debug ifTrue:[

                Transcript showCR:'TerminalSession [info]: changed len to ', numberOfLines printString.

            ].

            (OperatingSystem 

                setWindowSizeOnFileDescriptor:inStream fileDescriptor

                width:numberOfColumns

                height:numberOfLines) ifFalse:[

                Debug ifTrue:[

                    Transcript showCR:'TerminalSession [warning]: cannot change windowSize'.

                ].

            ].

        ].

        shellPid notNil ifTrue:[

            OperatingSystem sendSignal:OperatingSystem sigWINCH to:shellPid

        ]

    ].

    "Created: / 11.6.1998 / 22:51:39 / cg"

    "Modified: / 5.5.1999 / 19:45:09 / cg"

!

forgetPrompt:aString

    promptActions removeKey:aString

!

onPrompt:aString do:aBlock

    "remember what to do, when a prompt arrives;

     notice: will only start checking for prompt, when startCollectingOutput

     has been called."

    promptActions := Dictionary new

                        at:aString put:aBlock;

                        yourself

!

onPrompt:string1 do:block1 onPrompt:string2 do:block2

    "remember what to do, when a prompt arrives;

     notice: will only start checking for prompt, when startCollectingOutput

     has been called."

    promptActions := Dictionary new

                        at:string1 put:block1;

                        at:string2 put:block2;

                        yourself

!

outputFromAction:aBlock prompt:prompt timeout:seconds

    "evaluate aBlock and wait for the prompt.

     return gdb output as string collection"

    ^ self

        outputFromAction:aBlock 

        prompt:prompt 

        timeout:seconds

        to:nil

!

outputFromAction:aBlock prompt:prompt timeout:seconds to:aStreamOrNil

    "evaluate aBlock and wait for the prompt.

     return gdb output as string collection"

    |sema output lastSize gotPrompt|

    sema := Semaphore new.

    aStreamOrNil isNil ifTrue:[

        self startCollectingOutput.

    ] ifFalse:[

        self startCollectingOutputTo:aStreamOrNil

    ].

    self onPrompt:prompt do:[:strings | output := strings. sema signal. ].

    aBlock value.

    lastSize := 0.

    [

        |newSize|

        (gotPrompt := (sema waitWithTimeout:seconds) notNil) ifFalse:[

            newSize := collectedOutput size.

            Transcript show:'timeout - output size is: '; showCR:newSize.

            newSize > 100000 ifTrue:[

                self stopCollectingOutput.

                self onPrompt:nil do:nil.

                collectedOutput := nil.

                TimeoutError raiseRequestErrorString:'GDB output too big'.

            ].

            newSize = lastSize ifTrue:[

                "/ self information:'Error: command timeout.'.

                self stopCollectingOutput.

                self onPrompt:nil do:nil.

                TimeoutError raiseRequestErrorString:'GDB command timeout'.

            ].

            lastSize := newSize.

        ].  

    ] doWhile:[ gotPrompt not ].

    output notEmptyOrNil ifTrue:[

        output first isEmpty ifTrue:[

            "/ self halt.

            output := output copyFrom:2

        ].

    ].

    ^ output

!

outputFromCommand:aCommand prompt:prompt timeout:seconds

    "return a command's output as string collection"

    ^ self

        outputFromCommand:aCommand 

        prompt:prompt 

        timeout:seconds 

        to:nil

!