"

 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

	instanceVariableNames:'repository pid input output state readerwriter encoder channel_o

		channel_e channel_r channel_d channel_I channel_L channel_M

		command'

	classVariableNames:'Tracing'

	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.

    "Modified: / 24-02-2013 / 14:41:43 / 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

    ^ repository

!

repository:anHGRepository

    repository := anHGRepository.

! !

!HGCommandServer methodsFor:'executing'!

execute: anHGCommand

    "Executes an HG command"

    | spin status blocker |

    command := anHGCommand.

    anHGCommand initialize.

    blocker := command blocker.

    self runcommand: command.

    anHGCommand spawn: [ 

        status := OperatingSystem osProcessStatusClass pid:nil status: #exit code: channel_r nextLongNet core:false.

        channel_e close.

        channel_o close.

        Tracing ifTrue:[

        ].

    ] name: 'command server result reader'.

    spin := SemaphoreSet with: blocker with: anHGCommand errors readSemaphore.

    [

        [ spin wait ~~ blocker ] whileTrue:[ anHGCommand signal ]

    ] ensure:[

        channel_e reset.

        channel_o reset.

    ].

    anHGCommand signal.

    command := nil.

    ^anHGCommand status: status result: anHGCommand result

    "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:[

    ].

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

    ].

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

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

!

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 atEnd not] ] whileTrue:[

            input readWait.

            input atEnd ifFalse:[

                self update

            ].

        ].

    ] newProcess.

    readerwriter addExitAction:[

        readerwriter := nil.

        state := #disconnected.

    ].

    readerwriter name: 'HG Reader/Writer: ', repository pathName.

    readerwriter resume.

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

    "Modified: / 03-03-2013 / 14:19:16 / 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: / 03-03-2013 / 19:44:32 / 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:[

        ].

        pid.

    ] action:[:stat |

        Tracing ifTrue:[

        ].

    ].

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

!

stop

    state == #disconnected ifFalse:[

        Tracing ifTrue:[

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

        ].

        state := #disconnecting.

        readerwriter terminate.

        input close.

        output close.

    ].

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

    "Modified: / 24-02-2013 / 23:26:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer::InputChannel class methodsFor:'documentation'!

documentation

"

    An input channel (hg serve --> smalltalk)

    [author:]

        Jan Vrany <jan.vrany@fit.cvut.cz>

    [instance variables:]

    [class variables:]

    [see also:]

"

! !

!HGCommandServer::InputChannel class methodsFor:'instance creation'!

id: id server: server

    ^self basicNew setId: id server: server

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

! !

!HGCommandServer::InputChannel methodsFor:'accessing'!

id

    ^ id

!

readSemaphore

    ^rlock

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

! !

!HGCommandServer::InputChannel methodsFor:'initialization'!

reset

    closed := false.

    collection := (binary == true ifTrue:[ByteArray] ifFalse:[String]) new: 100.

    position := 0.

    readLimit := 0.

    writeLimit := 0.

    "Created: / 03-03-2013 / 13:18:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 03-03-2013 / 15:35:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

setId: aCharacter server: anHGCommandServer    

    self reset.

    id := aCharacter.

    server := anHGCommandServer.

    lock := Semaphore forMutualExclusion.

    rlock := Semaphore new:0.

    binary := false.

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

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

! !

!HGCommandServer::InputChannel methodsFor:'misc'!

binary

    "switch to binary mode. In binary mode, reading of text streams

     returns byte-valued integers instead of characters; writing expects

     byte-valued integers respectively.

     Ignored here, but added to make internalStreams protocol compatible 

     with externalStreams."

    binary := true.

    collection := collection asByteArray

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

!

close

    lock critical:[

        closed := true.

    ].

    self readSignal

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

    "Modified: / 03-03-2013 / 17:25:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!HGCommandServer::InputChannel methodsFor:'private'!

growCollection:minNewSize

    "grow the streamed collection to at least minNewSize"

    |oldSize newSize newColl|

    oldSize := collection size.

    (oldSize == 0) ifTrue:[

	newSize := minNewSize

    ] ifFalse:[

	newSize := oldSize * 2.

	(newSize < minNewSize) ifTrue:[newSize := minNewSize].

    ].

    collection isFixedSize ifTrue:[

	newColl := collection species new:newSize.

	newColl replaceFrom:1 to:oldSize with:collection startingAt:1.