initial checkin
authorClaus Gittinger <cg@exept.de>
Sat, 06 Jul 2013 21:25:54 +0200
changeset 3028 e49cf8755fd6
parent 3027 552aa6706d4c
child 3029 63199a092c30
initial checkin
TerminalSession.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/TerminalSession.st	Sat Jul 06 21:25:54 2013 +0200
@@ -0,0 +1,483 @@
+"{ Package: 'stx:libbasic2' }"
+
+Object subclass:#TerminalSession
+	instanceVariableNames:'inStream outStream errStream readerProcess shellPid shellCommand
+		shellDirectory readerDelay pluggableCheckBeforeReadAction
+		pluggableProcessInputAction'
+	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) mostly used by the TerminalView application,
+    but can be used whereever more control is needed than a simple pipe
+    offers (such as terminal emulation, window size, CTRL-c support etc.)
+
+    Extracted from TerminalView, which is refactored, once this is stable.
+
+"
+! !
+
+!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.
+!
+
+shellCommand
+    ^ shellCommand
+!
+
+shellDirectory
+    ^ shellDirectory
+!
+
+shellPid
+    ^ shellPid
+! !
+
+!TerminalSession methodsFor:'initialization & release'!
+
+closeDownShell
+    "shut down my shell process and stop the background reader thread."
+
+    |pid|
+
+    (pid := shellPid) notNil ifTrue:[
+        Debug ifTrue:[
+            Transcript print:'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.
+    ].
+
+    "Modified: / 5.5.1999 / 18:43:02 / cg"
+!
+
+closeStreams
+    inStream notNil ifTrue:[
+        inStream isStream ifTrue:[inStream close].
+        inStream := nil
+    ].
+    outStream notNil ifTrue:[
+        outStream close.
+        outStream := nil
+    ].
+    errStream notNil ifTrue:[
+        errStream close.
+        errStream := nil
+    ].
+!
+
+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:terminatedAction
+    "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"
+
+    |pty slaveFD execFdArray blocked exitStatus 
+     stxToStdinPipe stdOutToStxPipe cmd shell args env shellAndArgs|
+
+    shellCommand := aCommand.
+    shellDirectory := aDirectory.
+
+    OperatingSystem isMSWINDOWSlike ifTrue:[
+        "use two pipes to COMMAND.COM"
+        stxToStdinPipe := NonPositionableExternalStream makePipe.
+        stxToStdinPipe isNil ifTrue:[
+            self warn:(self class classResources string:'Could not create pipe to COMMAND.COM.'). 
+            ^ self.
+        ].
+
+        stdOutToStxPipe := NonPositionableExternalStream makePipe.
+        stdOutToStxPipe isNil ifTrue:[
+            self warn:(self class classResources classResources string:'Could not create pipe from COMMAND.COM.'). 
+            ^ 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.
+
+        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:aCommand.
+        shell := shellAndArgs at:1.
+        args  := (shellAndArgs at:2) ? ''.
+    ] ifFalse:[
+        "Use a pseudo-tty"
+        pty := NonPositionableExternalStream makePTYPair.
+        pty isNil ifTrue:[
+            self warn:'Cannot open pty.'.
+            ^ self.
+        ].
+
+        "/ pty at:1 is the master;
+        "/ pty at:2 is the slave
+        inStream := outStream := (pty at:1).
+        setupBlock value.
+        "/ fork a shell process on the slave-side
+        slaveFD := (pty at:2) fileDescriptor.
+        execFdArray := Array with:slaveFD with:slaveFD with:slaveFD.
+
+        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 value
+                    ].
+               ].
+
+    blocked ifFalse:[
+        OperatingSystem unblockInterrupts
+    ].
+
+    "close the slave side of the pty/pipes (only used by the child)"
+    pty notNil ifTrue:[
+        (pty at:2) close.
+    ].
+
+    stdOutToStxPipe notNil ifTrue:[
+        (stdOutToStxPipe at:2) close.
+        (stxToStdinPipe at:1) close.
+    ].
+
+    shellPid isNil ifTrue:[
+        self warn:'Cannot start shell'.
+        outStream close.
+        inStream close.
+        inStream := outStream := nil.
+        ^ self.
+    ].
+
+    "Created: / 20.7.1998 / 18:19:32 / cg"
+    "Modified: / 5.5.1999 / 17:28: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"
+!
+
+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'!
+
+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"
+!
+
+sendInterruptSignal
+    "send an INT-signal to the shell (UNIX only)"
+
+    shellPid notNil ifTrue:[
+        OperatingSystem sendSignal:(OperatingSystem sigINT) to:shellPid negated.
+    ].
+
+    "Modified: / 10.6.1998 / 17:49:49 / cg"
+!
+
+sendKillSignal
+    "send a KILL-signal to the shell (UNIX only)"
+
+    shellPid notNil ifTrue:[
+        OperatingSystem sendSignal:(OperatingSystem sigKILL) to:shellPid negated.
+    ]
+! !
+
+!TerminalSession methodsFor:'reader process'!
+
+readAnyAvailableData
+    "read data from the stream,
+     and sends me #processInput:n: events if something arrived.
+     Returns the amount of data read."
+
+    |buffer n bufferSize|
+
+    outStream isNil ifTrue:[^ 0].   "/ already closed
+
+    bufferSize := 256.
+    buffer := String new:bufferSize.
+
+    ExternalStream readErrorSignal handle:[:ex |
+        n := 0
+    ] do:[
+        n := outStream nextAvailableBytes:bufferSize into:buffer startingAt:1.
+        n > 0 ifTrue:[
+            pluggableProcessInputAction notNil ifTrue:[
+                pluggableProcessInputAction value:buffer value:n.
+            ]
+        ].
+    ].
+    ^ n
+!
+
+readerProcessLoop
+    "look for the session's output"
+
+    StreamError handle:[:ex |
+        Transcript show:'Terminal(PTY-reader) [error]: '; showCR:ex description.
+    ] do:[
+        [true] whileTrue:[
+            AbortOperationRequest handle:[:ex |
+            ] do:[
+                |n sensor|
+
+                readerDelay notNil ifTrue:[ Delay waitForSeconds:readerDelay].
+                outStream readWait.
+
+                (pluggableCheckBeforeReadAction isNil
+                or:[pluggableCheckBeforeReadAction value]) ifTrue:[
+                    n := self readAnyAvailableData.
+                    n == 0 ifTrue:[
+                        "/ Windows IPC has a bug - it always
+                        "/ returns 0 (when the command is idle)
+                        "/ and says it's at the end (sigh)
+
+                        OperatingSystem isMSWINDOWSlike ifTrue:[
+                            Delay waitForSeconds:0.1
+                        ] ifFalse:[
+                            outStream atEnd ifTrue:[
+                                outStream close. outStream := nil.
+                                inStream close.  inStream := nil.
+                                Processor activeProcess terminate.
+                            ] ifFalse:[
+                                "/ this should not happen.
+
+                                Delay waitForSeconds:0.1
+                            ]
+                        ].
+                    ]
+                ]
+            ]
+        ]
+    ]
+!
+
+startReaderProcess
+    "Start a reader process, which looks for the commands output,
+     and sends me #processInput:n: events whenever something arrives."
+
+    readerProcess isNil ifTrue:[
+        readerProcess := [
+            [
+                self readerProcessLoop.
+            ] ifCurtailed:[
+                readerProcess := nil    
+            ]
+        ] fork. "/ forkAt:9.
+        readerProcess name:'pty reader'.
+    ]
+
+    "
+     VT100TerminalView openShell
+    "
+
+    "Modified: / 5.5.1999 / 17:58:02 / cg"
+    "Modified: / 28.1.2002 / 21:10:13 / micha"
+!
+
+stopReaderProcess
+    "stop the background reader thread"
+
+    readerProcess notNil ifTrue:[
+        readerProcess terminate.
+        "/ give it a chance to really terminate
+        Processor yield.
+        readerProcess := nil
+    ].
+! !
+
+!TerminalSession class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic2/TerminalSession.st,v 1.1 2013-07-06 19:25:54 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/libbasic2/TerminalSession.st,v 1.1 2013-07-06 19:25:54 cg Exp $'
+! !
+
+
+TerminalSession initialize!