--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/mercurial/HGCommandServer.st Sun Mar 03 12:29:14 2013 +0000
@@ -0,0 +1,481 @@
+"
+ 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'
+ classVariableNames:'Tracing'
+ poolDictionaries:''
+ category:'SCM-Mercurial-Internal'
+!
+
+ReadStream subclass:#IChannel
+ instanceVariableNames:'server id lock rlock'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:HGCommandServer
+!
+
+WriteStream subclass:#OChannel
+ 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 methodsFor:'accessing'!
+
+repository
+ ^ repository
+!
+
+repository:anHGRepository
+ repository := anHGRepository.
+! !
+
+!HGCommandServer methodsFor:'executing'!
+
+execute: anHGCommand
+ "Executes an HG command"
+
+ | 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: / 24-02-2013 / 15:10:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2013 / 12:18:38 / 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'.
+ '--repository' . repository pathName .
+ '--config' . 'ui.interactive=True' .
+ 'serve' .
+ '--cmdserver' . 'pipe' .
+ }
+
+ "Created: / 24-02-2013 / 12:02:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2013 / 12:21:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+channelWithId: channelId
+ channelId == $M ifTrue:[
+ ^ channel_M
+ ].
+
+
+ channelId == $o ifTrue:[
+ ^ channel_o
+ ] ifFalse:[channelId == $e ifTrue:[
+ ^ channel_e
+ ] ifFalse:[channelId == $r ifTrue:[
+ ^ channel_r
+ ] ifFalse:[channelId == $d ifTrue:[
+ ^ channel_d
+ ] ifFalse:[channelId == $I ifTrue:[
+ ^ channel_I
+ ] ifFalse:[channelId == $L ifTrue:[
+ ^ channel_L
+ ] ifFalse:[
+ self error: 'Invalid channel: ', channelId
+ ]]]]]].
+
+ "Created: / 24-02-2013 / 12:59:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-02-2013 / 15:49:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+connect
+
+ | label |
+
+ state := #connecting.
+ Tracing ifTrue:[
+ Logger log: 'cmdserver: 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: 'cmdserver: connected...' severity: #trace facility: 'HG'.
+ ].
+
+ "Created: / 24-02-2013 / 12:19:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 03-03-2013 / 12:10:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startReaderWriter
+
+ "Initialize channels"
+
+ channel_o := IChannel id: $o server: self.
+ channel_e := IChannel id: $e server: self.
+ channel_r := IChannel id: $r server: self.
+ channel_d := IChannel id: $d server: self.
+
+ channel_I := OChannel id: $I server: self.
+ channel_L := OChannel id: $L server: self.
+ channel_M := OChannel id: $M server: self.
+
+ readerwriter := [
+ [ state ~~ #disconnecting and:[input atEnd not] ] whileTrue:[
+ input readWait.
+ input atEnd ifFalse:[
+ self update
+ ].
+ ].
+ self halt.
+ ] 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: / 24-02-2013 / 23:07:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+update
+ "Reads from input stream and updates corresponding channel"
+
+ | channel len data |
+
+ input readWait.
+ channel := self channelWithId: input next.
+ (channel == channel_I or:[channel == channel_L]) ifTrue:[
+ self shouldImplement.
+ ].
+ len := input nextUnsignedLongNet.
+ data := input next: len.
+ Tracing ifTrue:[
+ Logger log: 'cmdserver: < channel=', channel id, ' len=', len printString severity: #trace facility: 'HG'.
+ Logger log: ' ', data severity: #trace facility: 'HG'.
+ ].
+ channel ~~ channel_r ifTrue:[
+ channel update: (encoder decodeString: data)
+ ].
+
+ "Created: / 24-02-2013 / 14:06:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 24-02-2013 / 23:23:41 / 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: 'cmdserver: server started' severity: #trace facility: 'HG'.
+ ].
+ pid.
+ ] action:[:stat |
+ Tracing ifTrue:[
+ Logger log: 'cmdserver: server terminated' severity: #trace facility: 'HG'.
+ stat inspect.
+ ].
+ ].
+
+
+ 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: / 03-03-2013 / 12:19:41 / 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::IChannel 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::IChannel methodsFor:'accessing'!
+
+id
+ ^ id
+! !
+
+!HGCommandServer::IChannel methodsFor:'initialization'!
+
+setId: aCharacter server: anHGCommandServer
+ id := aCharacter.
+ server := anHGCommandServer.
+ lock := Semaphore forMutualExclusion.
+ rlock := Semaphore new:0.
+ collection := String new: 100.
+ position := 0.
+ readLimit := 0.
+ writeLimit := 0.
+
+ "Created: / 24-02-2013 / 12:51:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!HGCommandServer::IChannel 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.
+ collection := newColl
+ ] ifFalse:[
+ collection grow:newSize
+ ].
+
+ "Modified: 19.8.1997 / 17:53:11 / cg"
+! !
+
+!HGCommandServer::IChannel methodsFor:'reading'!
+
+next
+ [
+ lock critical:[
+ ((position-ZeroPosition+1) > readLimit) ifFalse:[
+ ^super next.
+ ].
+ ].
+ rlock wait.
+
+ ] loop
+
+ "Created: / 24-02-2013 / 13:30:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+peek
+ [
+ lock critical:[
+ ((position-ZeroPosition+1) > readLimit) ifFalse:[
+ ^super peek.
+ ].
+ ].
+ rlock wait.
+ ] loop
+
+ "Created: / 24-02-2013 / 13:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!HGCommandServer::IChannel methodsFor:'updating'!
+
+update: aString
+
+ lock critical:[
+ | len |
+
+ len := aString size.
+ readLimit + len > collection size ifTrue:[
+ self growCollection:readLimit + len.
+ ].
+ collection replaceFrom: readLimit + 1 count: len with:aString startingAt:1.
+ readLimit := readLimit + len.
+ ].
+ rlock signal.
+
+ "Created: / 24-02-2013 / 13:16:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!HGCommandServer::OChannel 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::OChannel methodsFor:'accessing'!
+
+id
+ ^ id
+! !
+
+!HGCommandServer::OChannel methodsFor:'initialization'!
+
+setId: aCharacter server: anHGCommandServer
+ id := aCharacter.
+ server := anHGCommandServer.
+ lock := Semaphore forMutualExclusion.
+ rlock := Semaphore new:0.
+ collection := String new: 100.
+ position := 0.
+ readLimit := 0.
+ writeLimit := 0.
+
+ "Created: / 24-02-2013 / 12:51:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!HGCommandServer class methodsFor:'documentation'!
+
+version_HG
+
+ ^ '$Changeset: <not expanded> $'
+! !
+
+
+HGCommandServer initialize!