"

 COPYRIGHT (c) 2012-2013 by Jan Vrany

              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.

"

"{ Package: 'stx:libscm/mercurial' }"

Object subclass:#HGCommandServer

	classVariableNames:'Tracing IdleTimeout'

	poolDictionaries:''

	category:'SCM-Mercurial-Internal'

!

ReadStream subclass:#InputChannel

	instanceVariableNames:'server id lock rlock binary closed'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommandServer

!

WriteStream subclass:#OutputChannel

	instanceVariableNames:'server id lock rlock'

	classVariableNames:''

	poolDictionaries:''

	privateIn:HGCommandServer

!

!HGCommandServer class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2012-2013 by Jan Vrany

              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.

"

! !

!HGCommandServer class methodsFor:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

    Tracing := true.

    IdleTimeout"[ms]":= 1000 * 60   "= 1min"

    "Modified: / 05-03-2013 / 19:08:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!HGCommandServer class methodsFor:'* uncategorized *'!

trace

    ^Tracing

    "Created: / 03-03-2013 / 17:20:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer methodsFor:'accessing'!

repository:anHGRepository

! !

!HGCommandServer methodsFor:'executing'!

execute: anHGCommand

    "Executes an HG command"

    state ~~ #connected ifTrue:[

        "/spin-lock wait...

        [ #(disconnected connected) includes: state ] whileFalse:[

            Delay waitForMilliseconds: 15.

        ].

        state == #disconnected ifTrue:[

            self start

        ]

    ].

        ].

    ].

    "Created: / 24-02-2013 / 15:10:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer methodsFor:'initialization'!

initialize

    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)

    "/ repository := nil.

    "/ pid := nil.

    "/ input := nil.

    "/ output := nil.

    state := #disconnected.

    "/ readerwriter := nil.

    "/ encoder := nil.

    "/ channel_o := nil.

    "/ channel_e := nil.

    "/ channel_r := nil.

    "/ channel_d := nil.

    "/ channel_I := nil.

    "/ channel_L := nil.

    "/ super initialize.   -- commented since inherited method does nothing

    "Modified: / 24-02-2013 / 14:55:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer methodsFor:'private'!

arguments

    ^{

        HGCommand hgCommand .

"/        '--debug' . '--verbose'.

        '--config' . 'ui.interactive=True' .

        'serve' .

        '--cmdserver' . 'pipe' .

    }

    "Created: / 24-02-2013 / 12:02:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

channelWithId: channelId

    channelId == $o codePoint ifTrue:[

        ^ channel_o

    ].

    channelId == $e codePoint ifTrue:[

        ^ channel_e

    ].

    channelId == $r codePoint ifTrue:[

        ^ channel_r

    ].

    channelId == $d codePoint ifTrue:[

        ^ channel_d

    ].

    channelId == $I codePoint  ifTrue:[

        ^ channel_I

    ] .

    channelId == $L codePoint  ifTrue:[

        ^ channel_L

    ].

    channelId == $M codePoint ifTrue:[

        ^ channel_M

    ].

    self error: 'Invalid channel: ', channelId

    "Created: / 24-02-2013 / 12:59:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-03-2013 / 14:14:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

connect

    | label |

    state := #connecting.

    Tracing ifTrue:[

        Logger log: 'cmdsrv: connecting...' severity: #trace facility: 'HG'.

    ].

    label := channel_o next: 13.

    label = 'capabilities:' ifFalse:[

        HGCommandError raiseErrorString: 'Invalid hello message: ', label.

    ].

    channel_o nextLine.

    label := channel_o next: 9.

    label = 'encoding:' ifFalse:[

        HGCommandError raiseErrorString: 'Expected ''encoding:'' message, got: ''', label , ''''.

    ].

    encoder := CharacterEncoder encoderFor: (channel_o nextAvailable: 1000).

    state := #connected.

    Tracing ifTrue:[

        Logger log: 'cmdsrv: connected...' severity: #trace facility: 'HG'.

    ].

    "Created: / 24-02-2013 / 12:19:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

runcommand: anHGCommand

    "Issue runcommand command to the server"

    | args argslen |

    args := OrderedCollection streamContents:[:s|

        anHGCommand workingDirectory notNil ifTrue:[

            s nextPut: '--cwd'; nextPut: anHGCommand workingDirectory.

        ].

        anHGCommand argumentsGlobalOn:s.

        s nextPut:anHGCommand command.

        anHGCommand argumentsCommandOn:s.

    ].

    argslen := args inject: -1 into: [:l :a|l + a size + 1].

    output 

        nextPutLine:'runcommand';

        nextPutLongNet: argslen.

    Tracing ifTrue:[

            Logger log: 'cmdsrv: runcommand: ' , (args asStringWith:Character space)  severity: #trace facility: 'HG'.

    ].

    args 

        do:[:e|output nextPutAll: (encoder encodeString: e)]

        separatedBy:[output nextPut: (Character codePoint: 0)].

    "Created: / 03-03-2013 / 16:38:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-03-2013 / 23:46:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

startReaderWriter

    "Initialize channels"

    channel_o := InputChannel id: $o server: self.

    channel_e := InputChannel id: $e server: self.

    channel_r := InputChannel id: $r server: self.

    channel_r binary.

    channel_d := InputChannel id: $d server: self.

    channel_I := OutputChannel id: $I server: self.

    channel_L := OutputChannel id: $L server: self.

    channel_M := OutputChannel id: $M server: self.

    readerwriter := [

        [ state ~~ #disconnecting and:[ input isOpen ] ] whileTrue:[

            (input readWaitWithTimeoutMs: IdleTimeout) ifTrue:[

                "Timeouted..."

                Tracing ifTrue:[

                    Logger log: 'cmdsrv: inactive for too long' severity: #trace facility: 'HG'.

                ].

                self stop

            ] ifFalse:[

                "Data available"

                input atEnd ifFalse:[

                    self update

                ].

            ].

        ].

    ] newProcess.

    readerwriter addExitAction:[

        input := nil.

        output := nil.

        readerwriter := nil.

        state := #disconnected.

    ].

    readerwriter resume.

    "Created: / 24-02-2013 / 12:47:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

update

    "Reads from input stream and updates corresponding channel"

    | channel len data id |

    input readWait.

    id := input next.

    channel := self channelWithId: id.

    (channel == channel_I or:[channel == channel_L]) ifTrue:[

        self shouldImplement.

    ].

    len := input nextUnsignedLongNet.

    data := input next: len.

    channel update: data encoder: encoder.

    command notNil ifTrue:[

        channel == channel_o ifTrue:[

            command spawnOutputReaderOn: channel_o

        ] ifFalse:[channel == channel_e ifTrue:[

            command spawnErrorReaderOn: channel_e

        ]].

    ].

    "Created: / 24-02-2013 / 14:06:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 04-03-2013 / 00:02:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer methodsFor:'start & stop'!

start

    "Starts the server and returns"

    | inputPipe outputPipe environment args |

    state := #starting.

    inputPipe := NonPositionableExternalStream makePipe.

    input := inputPipe first.

    input binary.

    outputPipe := NonPositionableExternalStream makePipe.

    output := outputPipe second.

"/    output binary.

    args := self arguments.

    OperatingSystem isMSWINDOWSlike ifTrue:[

        args := String streamContents:[:s|

            args

                do:[:each | s nextPut:$"; nextPutAll: each; nextPut: $"]

                separatedBy: [ s space ]

        ]

    ].

    environment := OperatingSystem isUNIXlike

                    ifTrue:[OperatingSystem getEnvironment copy]

                    ifFalse:[environment := Dictionary new].

    environment at: 'HGEDITOR' put: 'true'.

    environment at:'LANG' put:'C'.

    Processor monitor:[

        pid := OperatingSystem exec:(HGCommand hgCommand) withArguments: args

                environment:environment

                fileDescriptors:{outputPipe first fileDescriptor . inputPipe second fileDescriptor . 3}

                fork:true

                newPgrp:false

                inDirectory: Filename currentDirectory pathName.

        Tracing ifTrue:[

            Logger log: 'cmdsrv: server started' severity: #trace facility: 'HG'.

        ].

        pid.

    ] action:[:stat |

        Tracing ifTrue:[

            Logger log: 'cmdsrv: server terminated' severity: #trace facility: 'HG'.

        ].

    ].

    inputPipe second close.

    outputPipe first close.

    pid isNil ifTrue:[

        HGCommandError raiseErrorString: 'Cannot start command server'.

        input close.

        output close.

        ^ self.

    ].

    encoder := CharacterEncoder encoderFor:#ascii.

    self startReaderWriter.

    self connect.

    "Created: / 24-02-2013 / 11:40:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 05-03-2013 / 18:50:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

stop

    state == #disconnected ifFalse:[

        Tracing ifTrue:[

            Logger log: 'cmdsrv: server terminating' severity: #trace facility: 'HG'.

        ].

        state := #disconnecting.

        readerwriter terminate.

        input close.

        output close.