Re: [2.8alpha][GOODIE][FIX] Client Server Framework (very basic)

-- -------------------------------------------------- Smalltalking by choice. Isn't it nice to have one! 'From Squeak2.8alpha of 9 March 2000 [latest update: #1974] on 28 March 2000 at 11:59:53 pm'! nil subclass: #ObjectBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! Object subclass: #AbstractSpace instanceVariableNames: 'space ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! AbstractSpace class instanceVariableNames: ''! AbstractSpace subclass: #AddressSpace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! AddressSpace class instanceVariableNames: ''! AbstractConnectionLocator subclass: #ChatterLocator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Network'! ConnectionEndpoint subclass: #ChatterObjectPeer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Network'! EventModel subclass: #ChatterSpace instanceVariableNames: 'registry locator ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! Object subclass: #ChatterSpaceRegistry instanceVariableNames: 'registry ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! TestCase subclass: #ChatterTestCase instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-UnitTests'! AddressSpace subclass: #ConnectionSpace instanceVariableNames: '' classVariableNames: 'CurrentConnectionSpace ' poolDictionaries: '' category: 'Chatter-Services'! ConnectionSpace class instanceVariableNames: ''! AbstractSpace subclass: #DiscoverySpace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! DiscoverySpace class instanceVariableNames: ''! ChatterSpace subclass: #DistributedChatterSpace instanceVariableNames: 'endPoint engine ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! Object subclass: #IncomingProtocolPipe instanceVariableNames: 'handlers stream engine ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Network'! IncomingProtocolPipe class instanceVariableNames: ''! Object subclass: #LoginService instanceVariableNames: 'username password connector ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! LoginService class instanceVariableNames: ''! ObjectBinding class instanceVariableNames: ''! Object subclass: #ObjectFront instanceVariableNames: 'binding ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! ObjectFront class instanceVariableNames: ''! Object subclass: #OutgoingProtocolPipe instanceVariableNames: 'stream engine ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Network'! OutgoingProtocolPipe class instanceVariableNames: ''! Object subclass: #ProtocolEngine instanceVariableNames: 'connection incomingPipe outgoingPipe running objectMap transactionMap nextObjectHandle nextTransactionHandle ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Network'! AbstractSpace subclass: #RegistrySpace instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! RegistrySpace class instanceVariableNames: 'Registry '! Object subclass: #RemoteConnectionBinding instanceVariableNames: 'connection remoteHandle ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! RemoteConnectionBinding class instanceVariableNames: ''! Object subclass: #RemoteHandle instanceVariableNames: 'handle ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! RemoteHandle class instanceVariableNames: ''! Object subclass: #RemoteMessageSend instanceVariableNames: 'actionKey transactionHandle message ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! RemoteMessageSend class instanceVariableNames: ''! Object subclass: #SecurityToken instanceVariableNames: 'ticket ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! SecurityToken subclass: #NullSecurityToken instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! nil subclass: #ServiceDescriptor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! ServiceDescriptor class instanceVariableNames: ''! nil subclass: #SymbolicBinding instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Services'! SymbolicBinding class instanceVariableNames: ''! EventModel subclass: #SynchronizingPromise instanceVariableNames: 'syncSemaphore result isException connector ' classVariableNames: '' poolDictionaries: '' category: 'Chatter-Spaces'! SynchronizingPromise class instanceVariableNames: ''! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:09'! addressSpace ^self @ 2! ! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:09'! addressSpace: anAddressSpace self at: 2 put: anAddressSpace! ! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:05'! invokeMessage: aMessage aMessage instVarNamed: #lookupClass put: self object class. ^self addressSpace invokeMessage: aMessage on: self object ! ! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:09'! object ^self @ 1! ! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:09'! object: anObject self at: 1 put: anObject ! ! !ObjectBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:45'! printOn: aStream self object printOn: aStream. ! ! !ProtoObject methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 12:30'! invokeMessage: aMsg ^aMsg sentTo: self! ! !ProtoObject methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 04:06'! isRemoteHandle ^false. ! ! !AbstractSpace commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !AbstractSpace methodsFor: 'accessing' stamp: 'rww 3/6/2000 13:03'! locator ^ServiceLocator immediateLocator! ! !AbstractSpace methodsFor: 'accessing' stamp: 'rww 3/6/2000 13:03'! serviceName "Answer the receiver's instance variable serviceName." ^'hah-hah'! ! !AbstractSpace methodsFor: 'accessing' stamp: 'rww 3/3/2000 08:38'! space "Answer the receiver's instance variable space." ^space! ! !AbstractSpace methodsFor: 'accessing' stamp: 'rww 3/3/2000 08:38'! space: anObject "Set the receiver's instance variable space to anObject." space := anObject! ! !AbstractSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 20:04'! asDescriptor ^ServiceDescriptor new serviceName: self serviceName; locator: self locator; yourself. ! ! !AbstractSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/6/2000 13:03'! initializeOn: aServiceDescriptor space := TupleSpace new. ! ! !AbstractSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 11:27'! printOn: aStream aStream nextPutAll: self class name; nextPutAll: ':( serviceName: '; nextPutAll: self serviceName; nextPutAll: ' space: '; nextPutAll: self space printString; nextPutAll: ')'.! ! !AbstractSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 17:22'! release space release. space := nil.! ! !AbstractSpace class methodsFor: 'private defaults' stamp: 'rww 3/4/2000 20:06'! defaultDescriptor ^ServiceDescriptor new serviceName: self defaultName; locator: self defaultLocator; yourself. ! ! !AbstractSpace class methodsFor: 'private defaults' stamp: 'rww 3/4/2000 17:46'! defaultLocator ^ServiceLocator immediateLocator ! ! !AbstractSpace class methodsFor: 'override defaults' stamp: 'rww 3/4/2000 19:55'! defaultName ^'<AbstractService>' ! ! !AbstractSpace class methodsFor: 'instance creation' stamp: 'rww 3/4/2000 17:44'! new ^self newOnDescriptor: self defaultDescriptor. ! ! !AbstractSpace class methodsFor: 'instance creation' stamp: 'rww 3/5/2000 14:27'! newOnDescriptor: aDescriptor ^super new initializeOn: aDescriptor. ! ! !AddressSpace methodsFor: 'utils' stamp: 'rww 3/5/2000 13:53'! bindTo: object | binding | binding := ObjectBinding object: object addressSpace: self. ^ObjectFront on: binding. ! ! !AddressSpace methodsFor: 'utils' stamp: 'rww 3/5/2000 14:30'! initializeOn: aServiceDescriptor super initializeOn: aServiceDescriptor. self createRegistryService. self createDiscoveryService. ! ! !AddressSpace methodsFor: 'utils' stamp: 'rww 3/5/2000 14:22'! invokeMessage: aMessage on: anObject ^self bindTo: (aMessage sentTo: anObject).! ! !AddressSpace methodsFor: 'collection API' stamp: 'rww 3/6/2000 10:32'! at: aSymbol ^(space detect: aSymbol asSymbolicBinding ifNone: [self errorNotFound]) object. ! ! !AddressSpace methodsFor: 'collection API' stamp: 'rww 3/6/2000 09:20'! at: aSymbol put: anObject space add: (aSymbol asSymbolicBinding object: anObject). ! ! !AddressSpace methodsFor: 'collection API' stamp: 'rww 3/6/2000 09:19'! errorNotFound self error: 'element not found'! ! !AddressSpace methodsFor: 'templates' stamp: 'rww 3/10/2000 17:04'! createDiscoveryService |discoveryDescriptor discovery| discoveryDescriptor := ServiceDescriptor new serviceName: DiscoverySpace defaultName; locator: self locator; yourself. discovery := DiscoverySpace newOnDescriptor: discoveryDescriptor. self registry registerService: discovery. ^discovery! ! !AddressSpace methodsFor: 'templates' stamp: 'rww 3/10/2000 17:05'! createRegistryService |registryDescriptor registry | registryDescriptor := ServiceDescriptor new serviceName: RegistrySpace defaultName, self serviceName; locator: self locator; yourself. registry := RegistrySpace newOnDescriptor: registryDescriptor. self at: 'RegistryService' put: registry. ! ! !AddressSpace methodsFor: 'templates' stamp: 'rww 3/5/2000 14:31'! registry ^(space detect: ('RegistryService' asSymbolicBinding) ifNone: [self error: 'NotFound']) object. ! ! !AddressSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 20:22'! addressSpaceErrorClass ^LindaError! ! !AddressSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 17:13'! defaultName ^self uniqueName ! ! !AddressSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 19:35'! example "AddressSpace example" ^AddressSpace new. ! ! !AddressSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:28'! newOnDescriptor: aDescriptor |addressSpace| addressSpace := super newOnDescriptor: aDescriptor. ^addressSpace bindTo: addressSpace. ! ! !AddressSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:37'! uniqueName ^'AddressSpace-', NetNameResolver localHostName, '-', Time millisecondClockValue printString,'-', Random new next printString. ! ! !ChatterLocator methodsFor: 'private initialize' stamp: 'rww 3/28/2000 00:48'! privateInitializeOnParameters: paramCollection " 'chatter://tcp/connecter/babylon:4200/login' asLocator resolve" " 'chatter://tcp/listener/4200' asLocator resolve" " 'chatter://inmemory/connecter/babylon:4199/admin' asLocator resolve" " 'chatter://inmemory/listener/4199' asLocator resolve" [self transport: (paramCollection removeFirst). self endPointClass: 'ChatterObjectPeer'. self role: (paramCollection removeFirst). self resolver initializeOnTransport: self transport parameters: paramCollection] on: Error do: [:ex | self error: 'invalid locator']. ! ! !ChatterLocator methodsFor: 'api' stamp: 'rww 3/27/2000 23:24'! createResolver ^(self role == self class listenerRole) ifTrue: [ListenerResolver new] ifFalse: [ConnecterResolver new]. ! ! !ChatterLocator methodsFor: 'accessing' stamp: 'rww 3/26/2000 03:55'! role ^self parameters at: #role ifAbsent: [self error: 'no role'].! ! !ChatterLocator methodsFor: 'accessing' stamp: 'rww 3/26/2000 03:55'! role: aRole ^self parameters at: #role put: aRole asSymbol. ! ! !ChatterLocator class methodsFor: 'class initialization' stamp: 'rww 3/28/2000 02:25'! connecterRole ^#remote ! ! !ChatterLocator class methodsFor: 'class initialization' stamp: 'rww 3/26/2000 00:26'! initialize "ChatterLocator initialize" self registerName: 'chatter' forLocatorClass: self. ! ! !ChatterLocator class methodsFor: 'class initialization' stamp: 'rww 3/28/2000 02:25'! listenerRole ^#listener ! ! !ChatterObjectPeer methodsFor: 'initialize-release' stamp: 'rww 3/24/2000 17:04'! initializeOnDuplexStream: aDuplexStream super initializeOnDuplexStream: aDuplexStream. self pushDuplexStream: (ObjectSerializingStream on: self duplexStream). ! ! !ChatterObjectPeer methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 18:07'! proxyOn: aHandle ^ObjectFront on: (RemoteConnectionBinding on: self handle: aHandle).! ! !ChatterObjectPeer class methodsFor: 'instance creation' stamp: 'rww 3/24/2000 17:04'! on: aDuplexStream ^DistributedChatterSpace on: (super on: aDuplexStream). ! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:46'! bind: aSymbol to: anObject ^self registry at: aSymbol put: anObject ! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:50'! initialize self bind: #login to: LoginService new. self bind: #securityToken to: NullSecurityToken new. ! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:47'! listRegistry ^self registry keys! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/26/2000 04:11'! locator ^locator ifNil: [locator := self class createUniqueLocator].! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/26/2000 04:08'! locator: aLocator locator := aLocator. ! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:44'! lookup: aSymbol ^self registry at: aSymbol ifAbsent: [nil]. ! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:44'! registry registry == nil ifTrue: [registry := Dictionary new]. ^registry! ! !ChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:46'! unbind: aSymbol ^self registry removeKey: aSymbol ! ! !ChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/25/2000 17:49'! createUniqueLocator ^'AddressSpace-', NetNameResolver localHostName, '-', Time millisecondClockValue printString,'-', Random new next printString. ! ! !ChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:48'! new ^super new initialize! ! !ChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/27/2000 11:48'! onLocator: locator ^super new initialize; locator: locator; yourself! ! !ChatterSpaceRegistry methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 16:46'! atLocator: aLocator ^self registry at: aLocator ifAbsent: [self error: 'space not found']. ! ! !ChatterSpaceRegistry methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 16:45'! deregisterSpace: aSpace self registry removeKey: aSpace locator ifAbsent: [nil]. ! ! !ChatterSpaceRegistry methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 16:45'! registerSpace: aSpace self registry at: aSpace locator put: aSpace. ! ! !ChatterSpaceRegistry methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 16:44'! registry ^registry ifNil: [registry := Dictionary new].! ! !ChatterTestCase methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 20:45'! testChatterLocator 'chatter://tcp/connecter/babylon:4200' asLocator. 'chatter://tcp/listener/4200' asLocator. 'chatter://inmemory/connecter/babylon:4199' asLocator. 'chatter://inmemory/listener/4199' asLocator. ! ! !ChatterTestCase class methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 20:44'! runSUnitAsMorphic "ClientServerUnitTest runSUnitAsMorphic" TestModel openAsMorph patternText: (Text fromString: 'Chatter*.test*'); runTests. ! ! !ConnectionSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 10:23'! createConnectionService |connMgr connLocatorString | connLocatorString := self class localLocator. connMgr := self bindTo: (ConnectionManager serviceClass: 'RemoteObjectService' connectionLocatorString: connLocatorString). self at: 'myConnectionManager' asSymbolicBinding put: connMgr. connMgr start. connMgr explore. ! ! !ConnectionSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 11:36'! createRandomService self at: 'randomizer' asSymbolicBinding put: Random new. ! ! !ConnectionSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 11:39'! fullyResolvedLocatorFor: aTuple |loc uniqueName| uniqueName := self uniqueNameFor: aTuple. loc := RemoteObjectLocator fromString: 'comm://tcp/host=', (NetNameResolver localHostName), '/port=4200/externalName=', uniqueName. ^loc! ! !ConnectionSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 11:38'! randomName |randomValue| randomValue := ((self at: 'randomizer') next * 1000000000000) rounded. randomValue ! ! !ConnectionSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 11:31'! uniqueNameFor: aTuple | uname | uname := self registry detect: (String | aTuple) ifNone: [nil]. (uname == nil) ifTrue: [uname := self randomName. self registry add: (uname | aTuple)]. ^uname! ! !ConnectionSpace methodsFor: 'nil' stamp: 'rww 3/11/2000 11:35'! initializeOn: aServiceDescriptor super initializeOn: aServiceDescriptor. self createConnectionService. self createRandomService. ! ! !ConnectionSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 10:24'! current CurrentConnectionSpace ifNil: [CurrentConnectionSpace := super new]. ^CurrentConnectionSpace.! ! !ConnectionSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 11:12'! localLocator ^'comm://tcp/host=127.0.0.1/port=4200'.! ! !ConnectionSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 10:24'! new ^self current! ! !ConnectionSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 06:29'! resetCurrent self current release. CurrentConnectionSpace := nil. ! ! !ConnectionSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/11/2000 10:27'! startConnectionTo: aLocator "ConnectionSpace startConnectionTo: 'comm://tcp/host=', (NetNameResolver localHostName), '/port=4200'. " (ConnectionManager connectWithClass: RemoteObjectClient connectionLocatorString: aLocator) explore. ! ! !ConnectionSpace class methodsFor: 'nil' stamp: 'rww 3/10/2000 16:13'! uniqueName ^'ConnectionSpace-', NetNameResolver localHostName, '-', Time millisecondClockValue printString,'-', Random new next printString. ! ! !DiscoverySpace commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !DiscoverySpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:08'! defaultName ^'DiscoveryService' ! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:57'! close self engine stop. self engine removeEventsTriggeredFor: self. engine := nil. self endPoint close. endPoint := nil.! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 17:24'! endPoint ^endPoint! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 19:21'! engine ^engine! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:25'! initializeOn: anEndPoint endPoint := anEndPoint. engine := ProtocolEngine onSpace: self endPoint: anEndPoint. self setupEventDependenciesOnEngine. engine start.! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:42'! processEvent: event self trigger: event message ! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:49'! processException: exception Transcript cr; show: 'DistributedChatterSpace exception: ', exception messageText. self close.! ! !DistributedChatterSpace methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:38'! setupEventDependenciesOnEngine self engine when: #exception send: #processException: to: self. self engine when: #event send: #processEvent: to: self. ! ! !DistributedChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 17:23'! on: anEndPoint ^super new initializeOn: anEndPoint. ! ! !DistributedChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 17:28'! test "DistributedChatterSpace test" |locatorString mgr | locatorString := 'comm://tcp/host=localhost/port=4200'. mgr := ConnectionManager serviceClass: ChatterObjectPeer connectionLocatorString: locatorString. mgr start. mgr explore. DistributedChatterSpace testClient. ! ! !DistributedChatterSpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 17:28'! testClient "DistributedChatterSpace testClient" |locatorString client | locatorString := 'comm://tcp/host=localhost/port=4200'. client := ConnectionManager clientClass: ChatterObjectPeer connectionLocatorString: locatorString. client explore. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/18/2000 06:48'! eventAction ^MessageSend receiver: self selector: #processEventMsg: ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/18/2000 06:48'! exceptionAction ^MessageSend receiver: self selector: #processExceptionMsg: ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/17/2000 10:55'! nextRequest ^self stream next! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/20/2000 03:59'! processEventMsg: remoteMsg self engine processEvent: remoteMsg. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/20/2000 03:59'! processExceptionMsg: remoteMsg self engine processException: remoteMsg. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/20/2000 03:59'! processQuitMsg: remoteMsg self engine processQuit: remoteMsg. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/20/2000 03:59'! processReplyMsg: remoteMsg self engine processReply: remoteMsg. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/20/2000 03:28'! processSendMsg: remoteMsg Transcript cr; show: 'balooah'. [| aMsg reply recv | aMsg := remoteMsg message. recv := self engine resolveObjectHandle: aMsg receiver. aMsg receiver: recv. Transcript cr; show: 'set receiver ', recv printString. reply := aMsg value. Transcript cr; show: 'got reply ', reply printString. self engine returnReply: reply forMsg: remoteMsg. ] on: Error do: [:ex | Transcript cr; show: 'exception ', ex printString. self engine returnException: ex forMsg: aMsg]. ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/18/2000 06:48'! quitAction ^MessageSend receiver: self selector: #processQuitMsg: ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/18/2000 06:48'! replyAction ^MessageSend receiver: self selector: #processReplyMsg: ! ! !IncomingProtocolPipe methodsFor: 'handlers' stamp: 'rww 3/18/2000 06:48'! sendAction ^MessageSend receiver: self selector: #processSendMsg: ! ! !IncomingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:55'! engine ^engine! ! !IncomingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:47'! handlers handlers == nil ifTrue: [handlers := Dictionary new]. ^handlers! ! !IncomingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:55'! stream ^stream! ! !IncomingProtocolPipe methodsFor: 'initialize-release' stamp: 'rww 3/18/2000 01:48'! initializeWithEngine: anEngine on: aStream stream := aStream. engine := anEngine. self handlers at: RemoteMessageSend eventActionKey put: self eventAction. self handlers at: RemoteMessageSend sendActionKey put: self sendAction. self handlers at: RemoteMessageSend replyActionKey put: self replyAction. self handlers at: RemoteMessageSend exceptionActionKey put: self exceptionAction. self handlers at: RemoteMessageSend quitActionKey put: self quitAction. ! ! !IncomingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/19/2000 18:01'! pumpNextCommand "Consume the next client request and return the next action to perform." | request handler | request := self nextRequest. handler := handlers at: request actionKey ifAbsent: [self error: 'Unknown service request.']. handler valueWithArguments: (Array with: request). ! ! !IncomingProtocolPipe class methodsFor: 'as yet unclassified' stamp: 'rww 3/17/2000 10:45'! newWithEngine: anEngine on: aStream ^super new initializeWithEngine: anEngine on: aStream. ! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:58'! connector ^connector! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:58'! connector: aConnector connector := aConnector! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:05'! initializeOnConnector: aConn connector := aConn. self username: 'camp'. self password: 'smalltalk'. ! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:38'! login: aName password: aPassword ((aName = self username) and: [aPassword = self password]) ifTrue: [^self connector registerService: AddressSpace new] ifFalse: [self connector close]. ^nil! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:53'! password ^password! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:53'! password: aPassword password := aPassword! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:53'! username ^username! ! !LoginService methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:53'! username: aName username := aName! ! !LoginService class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:57'! onConnector: aConn ^super new initializeOnConnector: aConn! ! !ObjectBinding class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:10'! defaultArity ^2! ! !ObjectBinding class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:09'! object: anObject addressSpace: anAddressSpace ^super new object: anObject; addressSpace: anAddressSpace; yourself. ! ! !ObjectFront methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:12'! doesNotUnderstand: aMessage aMessage instVarNamed: #lookupClass put: binding class. ^binding invokeMessage: aMessage. ! ! !ObjectFront methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:42'! initializeOn: aBinding binding := aBinding. ! ! !ObjectFront methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 14:44'! printOn: aStream binding printOn: aStream. ! ! !ObjectFront class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:41'! on: binding ^super new initializeOn: binding! ! !OutgoingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/17/2000 11:18'! promiseFor: aMsg | replyPromise | replyPromise := SynchronizingPromise new. self registerPromise: replyPromise for: aMsg. ^replyPromise ! ! !OutgoingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/17/2000 11:19'! registerPromise: replyPromise for: aMsg self engine registerPromise: replyPromise for: aMsg. ! ! !OutgoingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/17/2000 10:33'! send: aMsg |promise| promise := self promiseFor: aMsg. stream nextPut: aMsg. ^promise.! ! !OutgoingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/28/2000 23:37'! send: aMsg notifying: msgSender |promise| promise := self promiseFor: aMsg. promise when: #result send: #processResult: to: msgSender. stream nextPut: aMsg. ^promise.! ! !OutgoingProtocolPipe methodsFor: 'protocol' stamp: 'rww 3/18/2000 01:44'! triggerRemoteEvent: anEventMsg stream nextPut: anEventMsg. ! ! !OutgoingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:35'! engine ^engine ! ! !OutgoingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:36'! initializeWithEngine: anEngine on: aStream stream := aStream. engine := anEngine. ! ! !OutgoingProtocolPipe methodsFor: 'accessing' stamp: 'rww 3/18/2000 00:07'! stream ^stream ! ! !OutgoingProtocolPipe class methodsFor: 'nil' stamp: 'rww 3/17/2000 10:36'! newWithEngine: anEngine on: aStream ^super new initializeWithEngine: anEngine on: aStream. ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/18/2000 01:40'! asyncSend: aMsg |sendMsg| sendMsg := RemoteMessageSend newSend. sendMsg message: aMsg. ^self outgoingPipe send: sendMsg. ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/28/2000 23:29'! asyncSend: aMsg notifying: msgSender |sendMsg| sendMsg := RemoteMessageSend newSend. sendMsg message: aMsg. ^self outgoingPipe send: sendMsg notifying: msgSender. ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/18/2000 02:40'! deregisterService: aService self objectMap removeKey: (self objectMap keyAtValue: aService) ifAbsent: [nil]. ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/20/2000 04:18'! registerService: aService |key| key := self nextObjectHandle. ^self registerService: aService as: key. ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/20/2000 04:17'! registerService: aService as: aKey self objectMap at: aKey put: aService. ^RemoteHandle on: aKey ! ! !ProtocolEngine methodsFor: 'messaging' stamp: 'rww 3/18/2000 01:44'! triggerRemoteEvent: anEvent |eventMsg| eventMsg := RemoteMessageSend newEvent. eventMsg message: anEvent. self outgoingPipe triggerRemoteEvent: eventMsg ! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/20/2000 19:27'! connection ^connection! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:49'! incomingPipe ^incomingPipe! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rw 3/20/2000 03:24'! nextObjectHandle |next| [next := nextObjectHandle. nextObjectHandle := next + 1. self objectMap includesKey: next] whileTrue: []. ^next.! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/16/2000 03:32'! nextTransactionHandle |next| next := nextTransactionHandle. nextTransactionHandle := next + 1. ^next.! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:54'! objectMap ^objectMap! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:49'! outgoingPipe ^outgoingPipe! ! !ProtocolEngine methodsFor: 'accessing' stamp: 'rww 3/17/2000 10:54'! transactionMap ^transactionMap! ! !ProtocolEngine methodsFor: 'engine' stamp: 'rww 3/16/2000 02:46'! priority ^Processor userSchedulingPriority - 1! ! !ProtocolEngine methodsFor: 'engine' stamp: 'rww 3/28/2000 23:19'! serviceLoop [running] whileTrue: [ [self incomingPipe pumpNextCommand] on: Error do: [:ex | Transcript cr; show: 'ChatterError -> ', ex messageText. self trigger: #exception with: ex]]. ! ! !ProtocolEngine methodsFor: 'engine' stamp: 'rww 3/16/2000 02:41'! start running := true. [self serviceLoop] forkAt: self priority ! ! !ProtocolEngine methodsFor: 'engine' stamp: 'rww 3/16/2000 02:42'! stop running := false! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/28/2000 23:34'! getPromiseAtHandle: aTransactionHandle |promise| promise := self transactionMap at: aTransactionHandle ifAbsent: [nil]. self transactionMap removeKey: aTransactionHandle. ^promise! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/19/2000 18:08'! processEvent: aMsg self trigger: #event with: aMsg message! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/28/2000 23:34'! processException: aMsg |promise| promise := self getPromiseAtHandle: aMsg transactionHandle. promise == nil ifTrue: [self trigger: #exception with: aMsg message] ifFalse: [promise exception: aMsg message]. ! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/18/2000 00:36'! processQuit: aMsg aMsg message = 'campsmalltalk' ifTrue: [self endPoint close]. ! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/28/2000 23:32'! processReply: aMsg |promise| promise := self getPromiseAtHandle: aMsg transactionHandle. promise == nil ifTrue: [self trigger: #exception with: 'Bad transaction ID'] ifFalse: [promise result: aMsg message].! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/18/2000 01:40'! registerPromise: aPromise for: sendMsg sendMsg transactionHandle: self nextTransactionHandle. self transactionMap at: sendMsg transactionHandle put: aPromise.! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/20/2000 04:19'! resolveObjectHandle: aHandle ^self objectMap at: aHandle handle! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/20/2000 03:37'! returnException: ex forMsg: aMsg |exceptionMsg| exceptionMsg := RemoteMessageSend newException. exceptionMsg transactionHandle: aMsg transactionHandle. exceptionMsg message: ex. self outgoingPipe triggerRemoteEvent: exceptionMsg. ! ! !ProtocolEngine methodsFor: 'protocol' stamp: 'rww 3/20/2000 04:36'! returnReply: reply forMsg: aMsg |replyMsg| replyMsg := RemoteMessageSend newReply. replyMsg transactionHandle: aMsg transactionHandle. replyMsg message: reply. self outgoingPipe triggerRemoteEvent: replyMsg. ! ! !ProtocolEngine methodsFor: 'initialize-release' stamp: 'rww 3/24/2000 17:33'! initializeOnSpace: aSpace endPoint: anEndPoint connection := anEndPoint. running := false. nextObjectHandle := 1. nextTransactionHandle := 1. incomingPipe := IncomingProtocolPipe newWithEngine: self on: anEndPoint. outgoingPipe := OutgoingProtocolPipe newWithEngine: self on: anEndPoint. objectMap := IdentityDictionary new. transactionMap := Dictionary new.! ! !ProtocolEngine class methodsFor: 'as yet unclassified' stamp: 'rww 3/24/2000 17:32'! onSpace: aSpace endPoint: anEndPoint ^super new initializeOnSpace: aSpace endPoint: anEndPoint.! ! !RegistrySpace commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !RegistrySpace methodsFor: 'action' stamp: 'rww 3/4/2000 20:21'! deregisterService: aService self space remove: aService asBinding ifNone: [nil]. ! ! !RegistrySpace methodsFor: 'action' stamp: 'rww 3/4/2000 20:21'! deregisterServiceNamed: aSymbol self space remove: aSymbol asBinding ifNone: [nil]. ! ! !RegistrySpace methodsFor: 'action' stamp: 'rww 3/5/2000 14:10'! findServiceNamed: aServiceName ^(self space detect: aServiceName asSymbolicBinding ifNone: [self nilBinding]) object. ! ! !RegistrySpace methodsFor: 'action' stamp: 'rww 3/5/2000 13:58'! registerService: aService |reg oldReg | reg := aService serviceName asSymbolicBinding object: aService. oldReg := self space detect: reg ifNone: [nil]. oldReg ifNotNil: [reg transferContentsTo: oldReg] ifNil: [self space add: reg]. ^reg! ! !RegistrySpace class methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 11:31'! defaultName ^'RegistryService' ! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:48'! connection ^connection! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:49'! connection: aConnection connection := aConnection! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:49'! handle ^remoteHandle! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 02:49'! handle: aHandle remoteHandle := aHandle! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 06:53'! invokeMessage: aMessage |aMsgSend| aMsgSend := MessageSend receiver: self handle selector: aMessage selector arguments: aMessage arguments. ^self connection syncSend: aMsgSend ! ! !RemoteConnectionBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:44'! processResult: aResult ! ! !RemoteConnectionBinding class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 04:33'! on: aConnection handle: aHandle ^super new connection: aConnection; handle: aHandle. ! ! !RemoteHandle methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:27'! handle ^handle! ! !RemoteHandle methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:27'! handle: aHandle handle := aHandle! ! !RemoteHandle methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 04:05'! isRemoteHandle ^true! ! !RemoteHandle class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:27'! on: aHandle ^super new handle: aHandle! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:27'! actionKey ^actionKey! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:27'! actionKey: anActionKey actionKey := anActionKey! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:28'! message ^message.! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:28'! message: aMessage message := aMessage.! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 04:34'! printOn: aStream super printOn: aStream. aStream nextPutAll: '( '; nextPutAll: self actionKey printString; nextPutAll: ', '; nextPutAll: self transactionHandle printString; nextPutAll: ', '; nextPutAll: self message printString; nextPutAll: ')'. ! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:27'! transactionHandle ^transactionHandle! ! !RemoteMessageSend methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:28'! transactionHandle: aHandle transactionHandle := aHandle! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:46'! eventActionKey ^#event! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:47'! exceptionActionKey ^#exception! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:29'! newEvent ^super new actionKey: self eventActionKey; yourself! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:29'! newException ^super new actionKey: self exceptionActionKey; yourself! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:29'! newQuit ^super new actionKey: self quitActionKey; yourself! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:29'! newReply ^super new actionKey: self replyActionKey; yourself! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:29'! newSend ^super new actionKey: self sendActionKey; yourself! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:47'! quitActionKey ^#quit! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:47'! replyActionKey ^#reply! ! !RemoteMessageSend class methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:47'! sendActionKey ^#send! ! !SecurityToken methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:54'! checkSecurity: aMsg ^true! ! !SecurityToken methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:52'! initialize self ticket: Array new.! ! !SecurityToken methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:51'! ticket ^ticket! ! !SecurityToken methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:51'! ticket: aTicket ticket := aTicket. ! ! !NullSecurityToken methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:53'! checkSecurity: aMsg aMsg selector == #login:password: ifTrue: [^true]. ^false! ! !SecurityToken class methodsFor: 'as yet unclassified' stamp: 'rww 3/20/2000 15:52'! new ^super new initialize! ! !ServiceDescriptor methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 16:42'! locator ^self @ 2. ! ! !ServiceDescriptor methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 16:43'! locator: aLocator self at: 2 put: aLocator. ! ! !ServiceDescriptor methodsFor: 'as yet unclassified' stamp: 'rww 3/3/2000 11:12'! serviceName ^self @ 1. ! ! !ServiceDescriptor methodsFor: 'as yet unclassified' stamp: 'rww 3/3/2000 11:12'! serviceName: aName self at: 1 put: aName. ! ! !ServiceDescriptor class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 16:42'! defaultArity ^2! ! !String methodsFor: 'chatterspaces' stamp: 'rww 3/4/2000 22:54'! asSymbolicBinding ^self asSymbol asSymbolicBinding! ! !Symbol methodsFor: 'chatterspaces' stamp: 'rww 3/4/2000 22:55'! asSymbolicBinding ^SymbolicBinding symbol: self object: Object ! ! !SymbolicBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/5/2000 12:45'! asSymbolicBinding ^self! ! !SymbolicBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:46'! object ^self @ 2! ! !SymbolicBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:46'! object: anObject self at: 2 put: anObject! ! !SymbolicBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:47'! symbol ^self @ 1! ! !SymbolicBinding methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:46'! symbol: aSymbol self at: 1 put: aSymbol! ! !SymbolicBinding class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:44'! defaultArity ^2! ! !SymbolicBinding class methodsFor: 'as yet unclassified' stamp: 'rww 3/4/2000 22:45'! symbol: aSymbol object: anObject ^super new symbol: aSymbol; object: anObject; yourself. ! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:19'! connector ^connector! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 03:19'! connector: aConn connector := aConn! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:40'! exception: anException isException := true. self result: anException! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:41'! initialize syncSemaphore := Semaphore new. isException := false.! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 00:40'! isException ^isException! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/18/2000 01:18'! result syncSemaphore wait. self isException ifTrue: [^result signal]. ^result! ! !SynchronizingPromise methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 23:28'! result: aResult aResult isRemoteHandle ifTrue: [result := self connector proxyOn: aResult] ifFalse: [result := aResult]. syncSemaphore signal. self trigger: #result with: result. ! ! !SynchronizingPromise class methodsFor: 'as yet unclassified' stamp: 'rww 3/17/2000 10:25'! new ^super new initialize! ! ChatterLocator initialize! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." |workspace| workspace := Workspace new. workspace contents: ' "Client server example code" |serviceLocator clientLocator manager client timeClass| serviceLocator := ''chatter://tcp/listener/9121'' asLocator. clientLocator := ''chatter://tcp/connecter/localhost:9121'' asLocator. manager := serviceLocator resolve. client := clientLocator resolve. client close. manager close. "Unit test case" ChatterTestCase runSUnitAsMorphic. "Check for cleanup. Sockets seem to be hanging around even if they are closed" ConnectionManager allInstances. ChatterObjectPeer allInstances. Socket allInstances. '. workspace openLabel: 'Chatter Workspace'! 'From Squeak2.8alpha of 9 March 2000 [latest update: #1974] on 29 March 2000 at 6:57:56 pm'! TestCase subclass: #ClientServerUnitTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-UnitTests'! DuplexStreamAdaptor subclass: #ObjectSerializingStream instanceVariableNames: 'readStream writeStream ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Streams'! ObjectSerializingStream class instanceVariableNames: ''! AbstractReliableStream subclass: #ReliableSocketStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Streams'! ConnectionConnecter subclass: #TCPConnecter instanceVariableNames: 'host port ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-TransportFactories'! ConnectionListener subclass: #TCPListener instanceVariableNames: 'host port listenerConnection ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-TransportFactories'! TCPListener class instanceVariableNames: ''! !ClientServerUnitTest commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !ClientServerUnitTest reorganize! ('running' testConnection testConnectionLocally testConnectionLocator testObjectSerializingStream testObjectSerializingStreamLocally) ! !ClientServerUnitTest methodsFor: 'running' stamp: 'rww 3/28/2000 12:45'! testConnection |client mgr timeClass | mgr := 'comm://tcp/9111/ObjectService' asLocator resolve. client := 'comm://tcp/localhost:9111/ObjectClient' asLocator resolve. timeClass := client lookup: #Time. self assert: ((client syncSend: #now to: timeClass) isKindOf: Time). client close. mgr close.! ! !ClientServerUnitTest methodsFor: 'running' stamp: 'rww 3/28/2000 12:50'! testConnectionLocally |client mgr timeClass | mgr := 'comm://inmemory/9109/ObjectService' asLocator resolve. client := 'comm://inmemory/localhost:9109/ObjectClient' asLocator resolve. timeClass := client lookup: #Time. self assert: ((client syncSend: #now to: timeClass) isKindOf: Time). client close. mgr close.! ! !ClientServerUnitTest methodsFor: 'running' stamp: 'rww 3/28/2000 12:14'! testConnectionLocator 'comm://tcp/4201/ObjectService' asLocator. 'comm://tcp/localhost:4201/ObjectClient' asLocator. ! ! !ClientServerUnitTest methodsFor: 'running' stamp: 'rww 3/28/2000 11:26'! testObjectSerializingStream |client| ObjectSerializingStream runServer. client := ObjectSerializingStream connectTestClient. client nextPut: 'camp smalltalk'. self assert: (client next = 'camp smalltalk'). client close. ! ! !ClientServerUnitTest methodsFor: 'running' stamp: 'rww 3/28/2000 11:26'! testObjectSerializingStreamLocally |ioPair| ioPair := ObjectSerializingStream createLocalPair. (ioPair at: 1) nextPut: 'camp smalltalk'. self assert: ((ioPair at: 2) next = 'camp smalltalk'). ! ! !ClientServerUnitTest class methodsFor: 'as yet unclassified' stamp: 'rww 3/28/2000 11:23'! runSUnitAsMorphic "ClientServerUnitTest runSUnitAsMorphic" TestModel openAsMorph patternText: (Text fromString: 'ClientServer*.test*'); runTests. ! ! !ObjectSerializingStream commentStamp: '<historical>' prior: 0! Big endian comunications! !ObjectSerializingStream methodsFor: 'Stream API' stamp: 'rww 3/24/2000 12:21'! next |binStream size refStream object| self closed ifTrue: [self errorClosedStream]. binStream := RWBinaryOrTextStream on: (ByteArray new: 100). binStream nextPutAll: (self duplexStream next: 4). binStream reset. size := binStream nextInt32. binStream reset. binStream nextPutAll: (self duplexStream next: size). binStream reset. refStream := SrpObjectStream onBinaryStream: binStream. object := refStream next. ^object ! ! !ObjectSerializingStream methodsFor: 'Stream API' stamp: 'rww 3/24/2000 12:21'! nextPut: anObject |byteStream bytes size| self closed ifTrue: [self errorClosedStream]. byteStream := SrpObjectStream new. byteStream nextPut: anObject. bytes := byteStream streamContents. size := ByteArray new: 4. size unsignedLongAt: 1 put: bytes size bigEndian: true. self duplexStream nextPutAll: size. self duplexStream nextPutAll: bytes. ! ! !ObjectSerializingStream class methodsFor: 'tests' stamp: 'rww 3/28/2000 09:29'! acceptTestServer | objStream transportStream socket | Transcript cr; show: 'initializing network ... '. Socket initializeNetworkIfFail: [^Transcript show:'failed']. Transcript show:'ok';cr. socket _ Socket newTCP. socket listenOn: 9101. Transcript show: 'server endpoint created -- run client test in other image'; cr. (socket waitForConnectionUntil: Socket standardDeadline) ifFalse: [self error: 'no connection']. transportStream := ReliableSocketStream on: socket. objStream := ObjectSerializingStream on: transportStream. ^objStream ! ! !ObjectSerializingStream class methodsFor: 'tests' stamp: 'rww 3/28/2000 09:29'! connectTestClient | objStream transportStream socket | Transcript cr; show: 'initializing network ... '. Socket initializeNetworkIfFail: [^Transcript show:'failed']. Transcript show:'ok';cr. socket _ Socket newTCP. socket connectTo: (NetNameResolver localHostAddress) port: 9101. Transcript show: 'client endpoint created'; cr. (socket waitForConnectionUntil: Socket standardDeadline) ifFalse: [^self error: 'no connection']. transportStream := ReliableSocketStream on: socket. objStream := ObjectSerializingStream on: transportStream. ^objStream ! ! !ObjectSerializingStream class methodsFor: 'tests' stamp: 'rww 3/25/2000 16:20'! createLocalPair |ioPair| ioPair := ReliableInMemoryStream createPair. ioPair at: 1 put: (ObjectSerializingStream on: (ioPair at: 1)). ioPair at: 2 put: (ObjectSerializingStream on: (ioPair at: 2)). ^ioPair! ! !ObjectSerializingStream class methodsFor: 'tests' stamp: 'rww 3/24/2000 10:41'! runServer [ |server| server := self acceptTestServer. [ [server closed not] whileTrue: [server nextPut: server next] ] on: Error do: [:e | Transcript cr; show: 'Server exception->', e messageText. server close]. Transcript cr; show: 'Server closing'. server close. ] forkAt: Processor lowIOPriority. ! ! !ObjectSerializingStream class methodsFor: 'tests' stamp: 'rww 3/23/2000 20:34'! testObjectStream "ObjectSerializingStream testObjectStream" |byteArray msgSend| byteArray := SrpObjectStream new nextPut: (MessageSend receiver: Transcript selector: #explore); streamContents. msgSend := SrpObjectStream loadObjectFromBinary: byteArray. msgSend value. ^msgSend! ! !PositionableStream methodsFor: 'positioning' stamp: 'rww 3/25/2000 23:45'! skipDelimiter: anObject "Advance the position past all leading delimiter matches" [self atEnd] whileFalse: [self next = anObject ifFalse: [^ self position: self position-1]]. ! ! !ReliableSocketStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:22'! next [self closed not and: [self connection dataAvailable not]] whileTrue: [ (self connection waitForDataUntil: Socket standardDeadline)]. self closed ifTrue: [^self errorStreamClosed]. self connection receiveDataInto: self singleByteInBuffer. ^self singleByteInBuffer at: 1.! ! !ReliableSocketStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:22'! nextPut: aByte self closed ifTrue: [self errorStreamClosed]. [self connection sendDone not] whileTrue: [ (self connection waitForSendDoneUntil: Socket standardDeadline)]. self singleByteOutBuffer at: 1 put: aByte. self connection sendData: self singleByteOutBuffer. ! ! !ReliableSocketStream methodsFor: 'query' stamp: 'rww 3/24/2000 12:35'! closeConnection self connection closeAndDestroy.! ! !ReliableSocketStream methodsFor: 'query' stamp: 'rww 3/24/2000 12:32'! closed super closed ifTrue: [^true]. self connection isConnected ifFalse: [self close]. ^super closed ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/22/2000 13:41'! resetDnsNetwork "ReliableTransportStream resetDnsNetwork" |s| Socket initializeNetwork. s := Socket newTCP. s connectTo: (NetNameResolver addressForName: 'localhost') port: 21. s waitForConnectionUntil: Socket standardDeadline. s sendSomeData: (String cr, String cr). 1 to: 250 do: [:i | (Delay forMilliseconds: 1) wait. s sendSomeData: (String cr, String cr). [s dataAvailable] whileTrue: [Transcript cr; show: s getData printString]]. s destroy. ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/22/2000 13:41'! resetIpNetwork "ReliableTransportStream resetIpNetwork" |s| Socket initializeNetwork. s := Socket newTCP. s connectTo: (NetNameResolver addressForName: '127.0.0.1') port: 21. s waitForConnectionUntil: Socket standardDeadline. s sendSomeData: (String cr, String cr). 1 to: 250 do: [:i | (Delay forMilliseconds: 1) wait. s sendSomeData: (String cr, String cr). [s dataAvailable] whileTrue: [Transcript cr; show: s getData printString]]. s destroy. ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/22/2000 13:41'! resetNetwork "ReliableTransportStream resetNetwork" ReliableSocketStream resetIpNetwork. (Delay forMilliseconds: 1000) wait. ReliableSocketStream resetDnsNetwork. ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/23/2000 18:22'! startClientAndTest [ | socket stream | Transcript show: 'initializing network ... '. Socket initializeNetworkIfFail: [^Transcript show:'failed']. Transcript show:'ok';cr. socket _ Socket newTCP. socket connectTo: (NetNameResolver localHostAddress) port: 4201. Transcript show: 'client endpoint created'; cr. socket waitForConnectionUntil: Socket standardDeadline. stream := ReliableSocketStream onConnection: socket. [ stream nextPutAll: 'The Fourth Estate, Inc.' asByteArray. stream nextPutAll: 'MyRoaRR' asByteArray. ] on: Error do: [:e | Transcript cr; show: e messageText printString]. stream close. Transcript cr; show: 'client endpoint destroyed'; cr. ] forkAt: Processor lowIOPriority. ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/23/2000 18:22'! startServer [ | transportStream nextByte socket | Transcript show: 'initializing network ... '. Socket initializeNetworkIfFail: [^Transcript show:'failed']. Transcript show:'ok';cr. socket _ Socket newTCP. socket listenOn: 4201. Transcript show: 'server endpoint created -- run client test in other image'; cr. socket waitForConnectionUntil: Socket standardDeadline. transportStream := ReliableSocketStream onConnection: socket. [transportStream closed] whileFalse: [ [nextByte := transportStream next] on: Error do: [:e | Transcript cr; show: e messageText printString]. Transcript cr; show: nextByte printString]. transportStream close. Transcript cr; show: 'server endpoint destroyed'; cr. ] forkAt: Processor lowIOPriority. ! ! !ReliableSocketStream class methodsFor: 'tests' stamp: 'rww 3/22/2000 13:39'! test "ReliableSocketStream test" ReliableSocketStream resetNetwork. ReliableSocketStream startServer. ReliableSocketStream startClientAndTest. ! ! !String methodsFor: 'converting' stamp: 'rww 3/27/2000 18:24'! substringsDelimitedByAnyOf: aDelimiterArray "Answer an array of the substrings that compose the receiver." | validCharArray result end beginning | result _ WriteStream on: (Array new: 10). validCharArray := aDelimiterArray complement. end _ 0. "find one substring each time through this loop" [ "find the beginning of the next substring" beginning _ self indexOfAnyOf: validCharArray startingAt: end+1 ifAbsent: [ nil ]. beginning ~~ nil ] whileTrue: [ "find the end" end _ self indexOfAnyOf: aDelimiterArray startingAt: beginning ifAbsent: [ self size + 1 ]. end _ end - 1. result nextPut: (self copyFrom: beginning to: end). ]. ^result contents! ! !TCPConnecter methodsFor: 'api' stamp: 'rww 3/23/2000 22:21'! connect | socket attempts aHost aPort | aHost := self host. aPort := self port. Socket initializeNetworkIfFail: [self error: 'bad network'. ^nil]. socket _ Socket newTCP. socket connectTo: (NetNameResolver addressForName: aHost) port: aPort asNumber. attempts := 0. [socket isConnected and: [attempts < 3]] whileTrue: [ attempts := attempts + 1. socket waitForConnectionUntil: Socket standardDeadline]. socket isConnected ifFalse: [self error: 'no connection'. ^nil]. ^ReliableSocketStream on: socket ! ! !TCPConnecter methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:55'! host ^host ! ! !TCPConnecter methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:55'! host: aHost host := aHost ! ! !TCPConnecter methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:55'! port ^port! ! !TCPConnecter methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:55'! port: aPort port := aPort! ! !TCPConnecter class reorganize! ('instance creation' fromLocator:) ('class initialization' initialize) ! !TCPConnecter class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:56'! fromLocator: locator "Return an instance of the receiver constructed from values found in <parameters>." ^super new locator: locator; host: locator resolver host; port: locator resolver port; yourself ! ! !TCPConnecter class methodsFor: 'class initialization' stamp: 'rww 3/25/2000 11:08'! initialize " TCPConnecter initialize" self registerConnecter: TCPConnecter forTransportName: 'tcp' ! ! !TCPListener reorganize! ('api' close createListenerConnection nextConnection) ('accessing' host host: listenerConnection listenerConnection: port port:) ! !TCPListener methodsFor: 'api' stamp: 'rww 3/24/2000 12:39'! close self listenerConnection == nil ifFalse: [self listenerConnection close. self listenerConnection: nil]. ! ! !TCPListener methodsFor: 'api' stamp: 'rww 3/9/2000 10:09'! createListenerConnection listenerConnection == nil ifFalse: [^listenerConnection]. Socket initializeNetworkIfFail: [^Transcript show:'failed']. listenerConnection _ Socket newTCP. listenerConnection listenOn: self port backlogSize: self class defaultQueueDepth. ! ! !TCPListener methodsFor: 'api' stamp: 'rww 3/24/2000 00:36'! nextConnection self listenerConnection isValid ifTrue: [ |sock| sock := self listenerConnection waitForAcceptUntil: (Socket deadlineSecs: 10). ^(sock == nil) ifTrue: [nil] ifFalse: [ReliableSocketStream on: sock]] ifFalse: [ |isConn| isConn := self listenerConnection waitForConnectionUntil: (Socket deadlineSecs: 10). isConn ifFalse: [self listenerConnection: nil.]. ^ReliableSocketStream on: self listenerConnection]. ! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 08:22'! host ^host! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 08:22'! host: aHost host := aHost! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 10:08'! listenerConnection listenerConnection == nil ifTrue: [self createListenerConnection]. ^listenerConnection! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 10:09'! listenerConnection: aConnection listenerConnection := aConnection! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 08:21'! port ^port! ! !TCPListener methodsFor: 'accessing' stamp: 'rww 3/9/2000 08:20'! port: aPort port := aPort.! ! !TCPListener class reorganize! ('instance creation' fromLocator:) ('class initialization' initialize) ! !TCPListener class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:57'! fromLocator: locator "Return an instance of the receiver constructed from values found in <parameters>." ^super new locator: locator; port: locator resolver port asNumber; yourself ! ! !TCPListener class methodsFor: 'class initialization' stamp: 'rww 3/25/2000 11:07'! initialize " TCPListener initialize" self registerListener: TCPListener forTransportName: 'tcp' ! ! !TestModel methodsFor: 'derived accessing' stamp: 'rww 3/26/2000 04:46'! patternText: aText | patternInput | patternInput := aText string. self classPattern: (self classPatternFrom: patternInput); selectorPattern: (self selectorPatternFrom: patternInput). self changed: #patternText. ^true! ! !TestModel methodsFor: 'interface opening' stamp: 'rww 3/26/2000 04:43'! openAsMorph "doIt: [TestModel new openAsMorph]" | topWindowM runButtonM detailsTextM failureListM errorListM | self updateColorSelector: #updateColorM. "=== build the parts ... ===" (topWindowM := SystemWindow labelled: self windowLabel) model: self. self patternTextM: (PluggableTextMorph on: self text: #patternText accept: #patternText:). runButtonM := PluggableButtonMorph on: self getState: #runButtonState action: #runTests label: #runButtonLabel. runButtonM onColor: self runButtonColor offColor: self runButtonColor. self summaryTextM: (PluggableTextMorph on: self text: #summaryText accept: nil). detailsTextM := PluggableTextMorph on: self text: #detailsText accept: nil. failureListM := PluggableListMorph on: self list: #failureList selected: #failureListSelectionIndex changeSelected: #failureListSelectionIndex:. errorListM := PluggableListMorph on: self list: #errorList selected: #errorListSelectionIndex changeSelected: #errorListSelectionIndex:. "=== assemble the whole ... ===" topWindowM addMorph: self patternTextM frame: (0.0@0.0 extent: 1.0@0.1); addMorph: runButtonM frame: (0.0@0.1 extent: 0.2@0.1); addMorph: self summaryTextM frame: (0.2@0.1 extent: 0.8@0.1); addMorph: detailsTextM frame: (0.0@0.2 extent: 1.0@0.1); addMorph: failureListM frame: (0.0@0.3 extent: 1.0@0.35); addMorph: errorListM frame: (0.0@0.65 extent: 1.0@0.35). "=== open it ... ===" topWindowM openInWorldExtent: 250@200. ! ! TCPConnecter initialize! TCPListener initialize! 'From Squeak2.8alpha of 9 March 2000 [latest update: #1974] on 29 March 2000 at 6:58:03 pm'! Object subclass: #AbstractLocator instanceVariableNames: 'parameters ' classVariableNames: 'DelimiterSet LocatorClasses ' poolDictionaries: '' category: 'ClientServer-Locator'! AbstractLocator subclass: #AbstractConnectionLocator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Locator'! AbstractLocator class instanceVariableNames: ''! Stream subclass: #AbstractReliableStream instanceVariableNames: 'connection singleByteInBuffer singleByteOutBuffer ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Streams'! AbstractReliableStream class instanceVariableNames: ''! Object subclass: #AbstractResolver instanceVariableNames: 'transport port ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Locator'! AbstractResolver subclass: #ConnecterResolver instanceVariableNames: 'host ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Locator'! EventModel subclass: #ConnectionConnecter instanceVariableNames: 'locator ' classVariableNames: 'ConnectionConnecters ' poolDictionaries: '' category: 'ClientServer-TransportFactories'! Object subclass: #ConnectionEndpoint instanceVariableNames: 'duplexStream ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Endpoint'! ConnectionEndpoint class instanceVariableNames: ''! EventModel subclass: #ConnectionListener instanceVariableNames: 'running locator ' classVariableNames: 'ConnectionListeners ' poolDictionaries: '' category: 'ClientServer-TransportFactories'! ConnectionListener class instanceVariableNames: ''! AbstractConnectionLocator subclass: #ConnectionLocator instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Locator'! ConnectionLocator class instanceVariableNames: ''! EventModel subclass: #ConnectionManager instanceVariableNames: 'serviceClass listener ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Endpoint'! ConnectionManager class instanceVariableNames: ''! ConnectionEndpoint subclass: #ConnectionService instanceVariableNames: 'running actions ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Endpoint'! Stream subclass: #DuplexStreamAdaptor instanceVariableNames: 'duplexStream ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Streams'! DuplexStreamAdaptor class instanceVariableNames: ''! ConnectionConnecter subclass: #InMemoryConnecter instanceVariableNames: 'port ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-TransportFactories'! ConnectionListener subclass: #InMemoryListener instanceVariableNames: 'port queue ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-TransportFactories'! Object subclass: #InMemoryTransport instanceVariableNames: 'inQueue outQueue ' classVariableNames: 'LoopbackPorts ' poolDictionaries: '' category: 'ClientServer-TransportFactories'! InMemoryTransport class instanceVariableNames: ''! AbstractResolver subclass: #ListenerResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Locator'! ConnectionEndpoint subclass: #ObjectClient instanceVariableNames: 'sendSemaphore syncSemaphore replyHandler result ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Endpoint'! ConnectionService subclass: #ObjectService instanceVariableNames: 'objectMap ' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Endpoint'! ObjectService class instanceVariableNames: ''! AbstractReliableStream subclass: #ReliableInMemoryStream instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'ClientServer-Streams'! ReliableInMemoryStream class instanceVariableNames: ''! !Object methodsFor: 'testing' stamp: 'rww 3/23/2000 20:07'! isDuplexStream ^false! ! !Object methodsFor: 'testing' stamp: 'rww 3/23/2000 20:07'! isReliableStream ^false! ! !AbstractLocator methodsFor: 'initializing' stamp: 'rww 3/26/2000 02:35'! initialize parameters := Dictionary new.! ! !AbstractLocator methodsFor: 'initializing' stamp: 'rww 3/27/2000 18:27'! privateInitializeOnParameters: paramCollection self subclassResponsibility ! ! !AbstractLocator methodsFor: 'printing' stamp: 'rww 3/26/2000 00:11'! printOn: aStream super printOn: aStream. aStream nextPutAll: '( '. self parameters associationsDo: [:e | e key printOn: aStream. aStream nextPutAll: '='. e value printOn: aStream. aStream nextPutAll: ', ']. aStream position: aStream position - 2. aStream nextPutAll: ')'. ! ! !AbstractLocator methodsFor: 'printing' stamp: 'rww 3/27/2000 12:11'! toString |stream| stream := WriteStream on: ''. self toStringOn: stream. ! ! !AbstractLocator methodsFor: 'printing' stamp: 'rww 3/27/2000 12:11'! toStringOn: stream stream nextPutAll: self class locatorClassName. stream nextPutAll: '://'. ! ! !AbstractLocator methodsFor: 'accessing' stamp: 'rww 3/9/2000 07:41'! parameters parameters == nil ifTrue: [parameters := Dictionary new]. ^parameters! ! !AbstractConnectionLocator reorganize! ('printing' toStringOn:) ('private api' createResolver) ('api' resolve) ('accessing' endPointClass endPointClass: resolver transport transport:) ! !AbstractConnectionLocator methodsFor: 'printing' stamp: 'rww 3/27/2000 12:12'! toStringOn: stream super toStringOn: stream. stream nextPutAll: self role asString. stream nextPutAll: '/'. stream nextPutAll: self host. stream nextPutAll: ':'. stream nextPutAll: self port asString. stream nextPutAll: '/'. ! ! !AbstractConnectionLocator methodsFor: 'private api' stamp: 'rww 3/27/2000 23:23'! createResolver self subclassResponsibility! ! !AbstractConnectionLocator methodsFor: 'api' stamp: 'rww 3/28/2000 00:10'! resolve ^self resolver resolveForLocator: self! ! !AbstractConnectionLocator methodsFor: 'accessing' stamp: 'rww 3/28/2000 00:11'! endPointClass ^self parameters at: #endPointClass ifAbsent: [self error: 'endPointClass not set']. ! ! !AbstractConnectionLocator methodsFor: 'accessing' stamp: 'rww 3/28/2000 00:11'! endPointClass: aClass self parameters at: #endPointClass put: (Smalltalk at: aClass asSymbol ifAbsent: [nil])! ! !AbstractConnectionLocator methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:20'! resolver ^self parameters at: #resolver ifAbsentPut: [self createResolver]. ! ! !AbstractConnectionLocator methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:44'! transport ^self parameters at: #transport ifAbsent: [self error: 'no transport set']. ! ! !AbstractConnectionLocator methodsFor: 'accessing' stamp: 'rww 3/28/2000 00:50'! transport: aTransport ^self parameters at: #transport put: aTransport ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/25/2000 23:50'! deregisterName: aName self locatorClasses removeKey: aName ifAbsent: []. ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/26/2000 00:28'! locatorClassName ^self locatorClasses keyAtValue: self. ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/25/2000 23:51'! locatorClassNamed: aLocatorName ^self locatorClasses at: aLocatorName ifAbsent: [self error: 'no registered class']. ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/25/2000 23:49'! locatorClasses ^LocatorClasses ifNil: [LocatorClasses := Dictionary new]. ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/26/2000 02:33'! locatorForScheme: aScheme |locatorClass| locatorClass := self locatorClassNamed: aScheme. ^locatorClass basicNew. ! ! !AbstractLocator class methodsFor: 'register locators' stamp: 'rww 3/25/2000 23:50'! registerName: aName forLocatorClass: aClass self locatorClasses at: aName put: aClass. ! ! !AbstractLocator class methodsFor: 'instance creation' stamp: 'rww 3/27/2000 18:23'! delimiterSet ^DelimiterSet ifNil: [ DelimiterSet := CharacterSet new. DelimiterSet add: $:; add: $/. DelimiterSet].! ! !AbstractLocator class methodsFor: 'instance creation' stamp: 'rww 3/27/2000 23:59'! fromString: aLocatorString " 'chatter://remote/tcp/babylon:4200/login' asLocator" " 'chatter://listener/tcp/4200/services' asLocator" " 'chatter://inmemory/config' asLocator" " 'comm://tcp/babylon:4201' asLocator" | substrings locator | substrings := (aLocatorString substringsDelimitedByAnyOf: self delimiterSet) asOrderedCollection. (substrings size < 2) ifTrue: [self error: 'invalid locator']. locator := self locatorForScheme: (substrings removeFirst). locator privateInitializeOnParameters: substrings. ^locator! ! !AbstractLocator class methodsFor: 'instance creation' stamp: 'rww 3/26/2000 03:41'! new ^super new initialize! ! !AbstractReliableStream commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !AbstractReliableStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:09'! atEnd ^self closed! ! !AbstractReliableStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:09'! close self release! ! !AbstractReliableStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:10'! next self subclassResponsibility! ! !AbstractReliableStream methodsFor: 'Stream API' stamp: 'rww 3/18/2000 06:19'! next: anInteger "Answer the next anInteger elements of my collection. Must override to get class right." | newArray | newArray _ ByteArray new: anInteger. 1 to: anInteger do: [:index | newArray at: index put: self next]. ^newArray! ! !AbstractReliableStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:10'! nextPut: aThang self subclassResponsibility! ! !AbstractReliableStream methodsFor: 'Stream Blocked API' stamp: 'rww 3/23/2000 20:07'! contents ^self shouldNotImplement! ! !AbstractReliableStream methodsFor: 'Stream Blocked API' stamp: 'rww 3/23/2000 20:08'! do: aBlock ^self shouldNotImplement! ! !AbstractReliableStream methodsFor: 'Stream Blocked API' stamp: 'rww 3/23/2000 20:08'! nextMatchAll: aColl ^self shouldNotImplement! ! !AbstractReliableStream methodsFor: 'Stream Blocked API' stamp: 'rww 3/23/2000 20:08'! nextMatchFor: anObject ^self shouldNotImplement! ! !AbstractReliableStream methodsFor: 'Stream Blocked API' stamp: 'rww 3/23/2000 20:08'! upToEnd ^self shouldNotImplement! ! !AbstractReliableStream methodsFor: 'initialize-release' stamp: 'rww 3/24/2000 12:35'! closeConnection self connection close. ! ! !AbstractReliableStream methodsFor: 'initialize-release' stamp: 'rww 3/23/2000 20:32'! initializeOnConnection: aConnection connection := aConnection. singleByteInBuffer := ByteArray new: 1. singleByteOutBuffer := ByteArray new: 1.! ! !AbstractReliableStream methodsFor: 'initialize-release' stamp: 'rww 3/24/2000 12:35'! release self connection == nil ifFalse: [ self closeConnection. connection := nil]. ! ! !AbstractReliableStream methodsFor: 'query' stamp: 'rww 3/23/2000 20:05'! closed ^self connection == nil. ! ! !AbstractReliableStream methodsFor: 'query' stamp: 'rww 3/23/2000 20:06'! isReliableStream ^true! ! !AbstractReliableStream methodsFor: 'accessing' stamp: 'rww 3/23/2000 18:21'! connection ^connection! ! !AbstractReliableStream methodsFor: 'accessing' stamp: 'rww 3/22/2000 13:43'! singleByteInBuffer ^singleByteInBuffer! ! !AbstractReliableStream methodsFor: 'accessing' stamp: 'rww 3/22/2000 13:43'! singleByteOutBuffer ^singleByteOutBuffer! ! !AbstractReliableStream methodsFor: 'exceptions' stamp: 'rww 3/23/2000 20:05'! errorStreamClosed self error: 'reliable stream is closed'. ! ! !AbstractReliableStream class methodsFor: 'instance creation' stamp: 'rww 3/23/2000 20:03'! on: aConnection ^super basicNew initializeOnConnection: aConnection! ! !AbstractResolver commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !AbstractResolver reorganize! ('accessing' port port: transport transport:) ('api' resolveForLocator:) ! !AbstractResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:54'! port ^port! ! !AbstractResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:54'! port: aPort port := aPort. ! ! !AbstractResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:55'! transport ^transport! ! !AbstractResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:55'! transport: aTransport transport := aTransport. ! ! !AbstractResolver methodsFor: 'api' stamp: 'rww 3/28/2000 00:13'! resolveForLocator: aLocator self subclassResponsibility. ! ! !ConnecterResolver commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !ConnecterResolver reorganize! ('accessing' host host:) ('api' resolveForLocator:) ('initialize-release' initializeOnTransport:parameters:) ! !ConnecterResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:57'! host ^host! ! !ConnecterResolver methodsFor: 'accessing' stamp: 'rww 3/27/2000 23:58'! host: aHost host := aHost! ! !ConnecterResolver methodsFor: 'api' stamp: 'rww 3/28/2000 00:14'! resolveForLocator: aLocator ^ConnectionManager clientClass: aLocator endPointClass locator: aLocator. ! ! !ConnecterResolver methodsFor: 'initialize-release' stamp: 'rww 3/27/2000 23:57'! initializeOnTransport: aTransportSymbol parameters: paramCollection " 'chatter://inmemory/listener/4199' asLocator resolve" " 'chatter://tcp/listener/4200' asLocator resolve" " 'comm://tcp/4201/ObjectService' asLocator" self transport: aTransportSymbol. self host: paramCollection removeFirst. self port: paramCollection removeFirst.! ! !ConnectionConnecter methodsFor: 'accessing' stamp: 'rww 3/28/2000 01:59'! locator ^locator! ! !ConnectionConnecter methodsFor: 'accessing' stamp: 'rww 3/28/2000 01:59'! locator: aLocator locator := aLocator! ! !ConnectionConnecter methodsFor: 'api' stamp: 'rww 3/23/2000 16:59'! connect self subclassResponsibility! ! !ConnectionConnecter class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:53'! fromLocator: locator "Return an instance of the receiver constructed from values found in <locator>." ^self subclassResponsibility! ! !ConnectionConnecter class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:53'! transport: aTransportName locator: locator | connecterClass | connecterClass := self connectionConnecters at: aTransportName ifAbsent: [self error: 'Unknown communication transport, ', aTransportName]. ^connecterClass fromLocator: locator! ! !ConnectionConnecter class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:42'! connectionConnecters ConnectionConnecters == nil ifTrue: [ConnectionConnecters := Dictionary new]. ^ConnectionConnecters ! ! !ConnectionConnecter class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:50'! deregisterConnecterForTransportName: aTransportName self connectionConnecters removeKey: aTransportName ifAbsent: []! ! !ConnectionConnecter class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:38'! registerConnecter: aConnecterClass forTransportName: aTransportName self connectionConnecters at: aTransportName put: aConnecterClass! ! !ConnectionEndpoint commentStamp: '<historical>' prior: 0! ConnectionEndpoint is an abstract class that models one end of a communication pair. connector - a stack of protocol streams which map sent and received objects in the right way TODO!!!!!! I must change the push and drop of protocol streams instance based rather than class based. There is other details to be set in each stream like the addressSpace for the LocatorResolvingStream. ! !ConnectionEndpoint methodsFor: 'accessing' stamp: 'rww 3/23/2000 23:12'! duplexStream ^duplexStream ! ! !ConnectionEndpoint methodsFor: 'protocol stack' stamp: 'rww 3/23/2000 23:16'! dropAll [self duplexStream isDuplexStream] whileTrue: [self dropDuplexStream]. ! ! !ConnectionEndpoint methodsFor: 'protocol stack' stamp: 'rww 3/28/2000 20:27'! dropDuplexStream |poppedStream| self duplexStream == nil ifTrue: [self error: 'nil stream']. self duplexStream isDuplexStream ifFalse: [ self duplexStream isReliableStream ifTrue: [self duplexStream close. duplexStream := nil]]. poppedStream := self duplexStream. duplexStream := poppedStream duplexStream. poppedStream duplexStream: nil. poppedStream close. ! ! !ConnectionEndpoint methodsFor: 'protocol stack' stamp: 'rww 3/23/2000 18:17'! pushDuplexStream: aDuplexStream duplexStream := aDuplexStream duplexStream: self duplexStream.! ! !ConnectionEndpoint methodsFor: 'initialize-release' stamp: 'rww 3/23/2000 23:14'! initializeOnDuplexStream: aDuplexStream duplexStream := aDuplexStream ! ! !ConnectionEndpoint methodsFor: 'streaming' stamp: 'rww 3/24/2000 12:15'! close self dropAll. duplexStream := nil. ! ! !ConnectionEndpoint methodsFor: 'streaming' stamp: 'rww 3/23/2000 18:12'! next ^self duplexStream next! ! !ConnectionEndpoint methodsFor: 'streaming' stamp: 'rww 3/23/2000 18:12'! nextPut: aProtocolDataUnit self duplexStream nextPut: aProtocolDataUnit! ! !ConnectionEndpoint class methodsFor: 'instance creation' stamp: 'rww 3/23/2000 23:11'! on: aDuplexStream "Return an instance of the receiver that communicates over <anIOPair>." ^super new initializeOnDuplexStream: aDuplexStream! ! !ConnectionListener commentStamp: '<historical>' prior: 0! ConnectionListener is the abstract superclass of service connection endpoints. It knows how to recognize inbound connection requests and arranges to complete the connection. ! !ConnectionListener methodsFor: 'initializing' stamp: 'rww 3/11/2000 06:37'! initialize running := false. ! ! !ConnectionListener methodsFor: 'api' stamp: 'rww 3/24/2000 12:38'! close self subclassResponsibility! ! !ConnectionListener methodsFor: 'api' stamp: 'rww 3/9/2000 10:02'! createListenerConnection self subclassResponsibility! ! !ConnectionListener methodsFor: 'api' stamp: 'jws 3/22/1999 09:01'! nextConnection "Return the next pending connection, or nil." self subclassResponsibility! ! !ConnectionListener methodsFor: 'api' stamp: 'jws 4/4/1999 06:33'! priority ^Processor highIOPriority! ! !ConnectionListener methodsFor: 'api' stamp: 'rww 3/9/2000 10:09'! start self isRunning ifTrue: [self error: 'Already running.']. running := true. [self listenLoop] forkAt: self priority! ! !ConnectionListener methodsFor: 'api' stamp: 'rww 3/9/2000 09:45'! stop running := false. ! ! !ConnectionListener methodsFor: 'private' stamp: 'jws 3/22/1999 08:33'! idleWait (Delay forMilliseconds: 100) wait! ! !ConnectionListener methodsFor: 'private' stamp: 'rww 3/9/2000 14:47'! listen "Return an IOPair for the next connection. Return nil if none." | ioPairOrNil | ioPairOrNil := self nextConnection. ioPairOrNil == nil ifFalse: [self trigger: #newConnection: with: ioPairOrNil]. ^ioPairOrNil! ! !ConnectionListener methodsFor: 'private' stamp: 'rww 3/24/2000 12:38'! listenLoop "Polled connection loop. Sleep for a brief period if there are no pending connections." [self isRunning] whileTrue: [self listen == nil ifTrue: [self idleWait]]. ! ! !ConnectionListener methodsFor: 'testing' stamp: 'jws 3/22/1999 09:08'! isRunning ^running! ! !ConnectionListener methodsFor: 'accessing' stamp: 'rww 3/28/2000 01:58'! locator ^locator! ! !ConnectionListener methodsFor: 'accessing' stamp: 'rww 3/28/2000 01:59'! locator: aLocator locator := aLocator! ! !ConnectionListener class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:54'! fromLocator: locator "Return an instance of the receiver constructed from values found in <locator>." ^self subclassResponsibility! ! !ConnectionListener class methodsFor: 'instance creation' stamp: 'jws 3/19/1999 10:59'! new ^super new initialize! ! !ConnectionListener class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:53'! transport: aTransportName locator: locator | listenerClass | listenerClass := self connectionListeners at: aTransportName ifAbsent: [self error: 'Unknown communication transport, ', aTransportName]. ^listenerClass fromLocator: locator! ! !ConnectionListener class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:49'! connectionListeners ConnectionListeners == nil ifTrue: [ConnectionListeners := Dictionary new]. ^ConnectionListeners! ! !ConnectionListener class methodsFor: 'accessing' stamp: 'jws 3/25/1999 18:02'! defaultQueueDepth ^5! ! !ConnectionListener class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:51'! deregisterListenerForTransportName: aTransportName self connectionListeners removeKey: aTransportName ifAbsent: [] ! ! !ConnectionListener class methodsFor: 'accessing' stamp: 'rww 3/23/2000 16:49'! registerListener: aListenerClass forTransportName: aTransportName self connectionListeners at: aTransportName put: aListenerClass! ! !ConnectionLocator reorganize! ('initialize-release' privateInitializeOnParameters:) ('private api' createResolver) ! !ConnectionLocator methodsFor: 'initialize-release' stamp: 'rww 3/28/2000 00:01'! privateInitializeOnParameters: paramCollection " 'comm://tcp/4201/ObjectService' asLocator" " 'comm://tcp/babylon:4201/ObjectClient' asLocator" self transport: paramCollection removeFirst. self endPointClass: paramCollection last. self resolver initializeOnTransport: self transport parameters: paramCollection. ! ! !ConnectionLocator methodsFor: 'private api' stamp: 'rww 3/28/2000 00:08'! createResolver ^(ConnectionService withAllSubclasses includes: self endPointClass) ifTrue: [ListenerResolver new] ifFalse: [ConnecterResolver new]. ! ! !ConnectionLocator class reorganize! ('class initialization' initialize) ! !ConnectionLocator class methodsFor: 'class initialization' stamp: 'rww 3/28/2000 00:00'! initialize "ConnectionLocator initialize" self registerName: 'comm' forLocatorClass: self. ! ! !ConnectionManager commentStamp: '<historical>' prior: 0! ConnectionManager is the object responsible for coordinating the rendezvous of clients and servers. A connection manager coordinates instances of listeners and services. A listener is responsible for listening for connection requests over a communication link. A service is responsible for implementing a service protocol that operates over a communication link arranged by the manager. Tests: ObjectService test. ObjectService sendTimeTest. ConnectionManager allInstances explore. ObjectService allInstances explore. ObjectClient allInstances explore. Socket allInstances explore. ! !ConnectionManager reorganize! ('accessing' listener listener: serviceClass serviceClass:) ('initializing' close release) ('api' serveOn: start stop) ! !ConnectionManager methodsFor: 'accessing' stamp: 'jws 3/19/1999 08:59'! listener ^listener! ! !ConnectionManager methodsFor: 'accessing' stamp: 'rww 3/28/2000 20:15'! listener: aConnectionListener listener := aConnectionListener. ! ! !ConnectionManager methodsFor: 'accessing' stamp: 'jws 3/19/1999 08:59'! serviceClass ^serviceClass! ! !ConnectionManager methodsFor: 'accessing' stamp: 'jws 3/19/1999 09:00'! serviceClass: aConnectionServiceClass serviceClass := aConnectionServiceClass! ! !ConnectionManager methodsFor: 'initializing' stamp: 'rww 3/24/2000 12:16'! close self stop. self release. ! ! !ConnectionManager methodsFor: 'initializing' stamp: 'rww 3/28/2000 20:16'! release self listener close. self listener: nil! ! !ConnectionManager methodsFor: 'api' stamp: 'rww 3/23/2000 23:58'! serveOn: aConnection self serviceClass on: aConnection! ! !ConnectionManager methodsFor: 'api' stamp: 'rww 3/28/2000 20:17'! start self listener when: #newConnection: send: #serveOn: to: self. self listener start.! ! !ConnectionManager methodsFor: 'api' stamp: 'rww 3/28/2000 19:59'! stop self listener == nil ifFalse: [self listener stop. self listener removeEventsTriggeredFor: self].! ! !ConnectionManager class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 02:21'! clientClass: aClientClass locator: locator | connection| connection := (ConnectionConnecter transport: locator transport locator: locator) connect. ^connection == nil ifTrue: [self error: 'no connection'. nil] ifFalse: [locator endPointClass on: connection]. ! ! !ConnectionManager class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 02:22'! serviceClass: aServiceClass locator: locator |listener| listener := ConnectionListener transport: locator transport locator: locator. ^self new serviceClass: aServiceClass; listener: listener; yourself! ! !ConnectionService commentStamp: '<historical>' prior: 0! ConnectionService is responsible for fielding remote requests for service.! !ConnectionService methodsFor: 'private' stamp: 'rww 3/24/2000 00:36'! nextAction "Consume the next client request and return the next action to perform." | request | request := self nextRequest. ^actions at: request ifAbsent: [self error: 'Unknown service request.']! ! !ConnectionService methodsFor: 'private' stamp: 'rww 3/9/2000 15:06'! nextRequest ^self next! ! !ConnectionService methodsFor: 'private' stamp: 'jws 4/4/1999 07:14'! priority ^Processor userSchedulingPriority - 1! ! !ConnectionService methodsFor: 'private' stamp: 'rww 3/28/2000 11:56'! processNextAction [self nextAction value] on: Error do: [:ex | Transcript cr; show: self class name, '>>processNextAction error->', ex messageText. self stop. self close. ex return].! ! !ConnectionService methodsFor: 'private' stamp: 'rww 3/24/2000 10:49'! serviceLoop [running] whileTrue: [self processNextAction]. ! ! !ConnectionService methodsFor: 'api' stamp: 'jws 4/9/1999 17:28'! start running := true. [self serviceLoop] forkAt: self priority ! ! !ConnectionService methodsFor: 'api' stamp: 'jws 4/9/1999 17:28'! stop running := false! ! !ConnectionService methodsFor: 'initializing' stamp: 'rww 3/23/2000 23:46'! initializeOnDuplexStream: aDuplexStream super initializeOnDuplexStream: aDuplexStream. running := false. actions := Dictionary new. ! ! !ConnectionService class reorganize! ('instance creation' on:) ! !ConnectionService class methodsFor: 'instance creation' stamp: 'rww 3/24/2000 00:30'! on: aDuplexStream "Return an instance of the receiver that communicates over <anIOPair>." |service| service := super on: aDuplexStream. service start. ^service! ! !DuplexStreamAdaptor methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:09'! atEnd ^self closed! ! !DuplexStreamAdaptor methodsFor: 'Stream API' stamp: 'rww 3/22/2000 13:20'! close self release! ! !DuplexStreamAdaptor methodsFor: 'Stream API' stamp: 'rww 3/22/2000 13:33'! next ^self closed ifTrue: [self errorStreamClosed] ifFalse: [self duplexStream next].! ! !DuplexStreamAdaptor methodsFor: 'Stream API' stamp: 'rww 3/22/2000 13:32'! nextPut: aThang self closed ifTrue: [self errorStreamClosed] ifFalse: [self duplexStream nextPut: aThang]. ! ! !DuplexStreamAdaptor methodsFor: 'initialize-release' stamp: 'rww 3/22/2000 12:56'! initializeOn: aDuplexStream duplexStream := aDuplexStream. ! ! !DuplexStreamAdaptor methodsFor: 'initialize-release' stamp: 'rww 3/22/2000 13:07'! release self duplexStream: nil. ! ! !DuplexStreamAdaptor methodsFor: 'query' stamp: 'rww 3/22/2000 13:20'! closed ^self duplexStream == nil. ! ! !DuplexStreamAdaptor methodsFor: 'query' stamp: 'rww 3/22/2000 12:57'! isDuplexStream ^true! ! !DuplexStreamAdaptor methodsFor: 'Stream Blocked API' stamp: 'rww 3/9/2000 12:25'! contents ^self shouldNotImplement! ! !DuplexStreamAdaptor methodsFor: 'Stream Blocked API' stamp: 'rww 3/22/2000 13:02'! do: aBlock ^self shouldNotImplement! ! !DuplexStreamAdaptor methodsFor: 'Stream Blocked API' stamp: 'rww 3/9/2000 12:26'! nextMatchAll: aColl ^self shouldNotImplement! ! !DuplexStreamAdaptor methodsFor: 'Stream Blocked API' stamp: 'rww 3/9/2000 12:26'! nextMatchFor: anObject ^self shouldNotImplement! ! !DuplexStreamAdaptor methodsFor: 'Stream Blocked API' stamp: 'rww 3/22/2000 13:02'! upToEnd ^self shouldNotImplement! ! !DuplexStreamAdaptor methodsFor: 'accessing' stamp: 'rww 3/22/2000 12:54'! duplexStream ^duplexStream! ! !DuplexStreamAdaptor methodsFor: 'accessing' stamp: 'rww 3/22/2000 12:54'! duplexStream: aDuplexStream duplexStream := aDuplexStream! ! !DuplexStreamAdaptor methodsFor: 'exceptions' stamp: 'rww 3/22/2000 13:32'! errorStreamClosed self error: 'duplex stream is closed'. ! ! !DuplexStreamAdaptor class methodsFor: 'instance creation' stamp: 'rww 3/22/2000 12:53'! on: aDuplexStream ^super basicNew initializeOn: aDuplexStream ! ! !InMemoryConnecter commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !InMemoryConnecter reorganize! ('accessing' port port:) ('api' connect) ! !InMemoryConnecter methodsFor: 'accessing' stamp: 'rww 3/25/2000 13:10'! port ^port! ! !InMemoryConnecter methodsFor: 'accessing' stamp: 'rww 3/25/2000 13:11'! port: aPort port := aPort! ! !InMemoryConnecter methodsFor: 'api' stamp: 'rww 3/25/2000 17:18'! connect ^ReliableInMemoryStream on: (InMemoryTransport connectToPort: self port).! ! !InMemoryConnecter class reorganize! ('class initialization' initialize) ('instance creation' fromLocator:) ! !InMemoryConnecter class methodsFor: 'class initialization' stamp: 'rww 3/25/2000 16:18'! initialize " InMemoryConnecter initialize" self registerConnecter: InMemoryConnecter forTransportName: 'inmemory' ! ! !InMemoryConnecter class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:55'! fromLocator: locator "Return an instance of the receiver constructed from values found in <parameters>." ^super new locator: locator; port: locator resolver port asNumber; yourself ! ! !InMemoryListener commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !InMemoryListener reorganize! ('accessing' port port: theNextConnection theNextConnection:) ('api' close nextConnection start stop) ! !InMemoryListener methodsFor: 'accessing' stamp: 'rww 3/25/2000 13:11'! port ^port! ! !InMemoryListener methodsFor: 'accessing' stamp: 'rww 3/25/2000 13:11'! port: aPort port := aPort! ! !InMemoryListener methodsFor: 'accessing' stamp: 'rww 3/25/2000 17:10'! theNextConnection ^queue next.! ! !InMemoryListener methodsFor: 'accessing' stamp: 'rww 3/25/2000 17:10'! theNextConnection: aConn queue nextPut: aConn! ! !InMemoryListener methodsFor: 'api' stamp: 'rww 3/25/2000 17:12'! close self stop.! ! !InMemoryListener methodsFor: 'api' stamp: 'rww 3/25/2000 17:18'! nextConnection ^ReliableInMemoryStream on: self theNextConnection! ! !InMemoryListener methodsFor: 'api' stamp: 'rww 3/25/2000 17:10'! start queue := SharedQueue new. InMemoryTransport listenOnPort: self port withListener: self. super start.! ! !InMemoryListener methodsFor: 'api' stamp: 'rww 3/25/2000 17:12'! stop super stop. InMemoryTransport stopListeningOnPort: self port. queue := nil. ! ! !InMemoryListener class reorganize! ('instance creation' fromLocator:) ('class initialization' initialize) ! !InMemoryListener class methodsFor: 'instance creation' stamp: 'rww 3/28/2000 01:56'! fromLocator: locator "Return an instance of the receiver constructed from values found in <parameters>." ^super new locator: locator; port: locator resolver port asNumber; yourself ! ! !InMemoryListener class methodsFor: 'class initialization' stamp: 'rww 3/25/2000 16:18'! initialize " InMemoryListener initialize" self registerListener: InMemoryListener forTransportName: 'inmemory' ! ! !InMemoryTransport commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !InMemoryTransport methodsFor: 'Stream API' stamp: 'rww 3/22/2000 15:39'! close inQueue := nil. outQueue := nil. ! ! !InMemoryTransport methodsFor: 'Stream API' stamp: 'rww 3/8/2000 12:55'! closeAndDestroy inQueue := nil. outQueue := nil. ! ! !InMemoryTransport methodsFor: 'Stream API' stamp: 'rww 3/8/2000 12:56'! isConnected ^(inQueue isNil and: [outQueue isNil]) not! ! !InMemoryTransport methodsFor: 'Stream API' stamp: 'rww 3/8/2000 12:54'! next ^inQueue next. ! ! !InMemoryTransport methodsFor: 'Stream API' stamp: 'rww 3/8/2000 12:54'! nextPut: anObject ^outQueue nextPut: anObject. ! ! !InMemoryTransport methodsFor: 'initialize-release' stamp: 'rww 3/8/2000 12:50'! initializeWithInQ: inQ outQ: outQ inQueue := inQ. outQueue := outQ. ! ! !InMemoryTransport methodsFor: 'accessing' stamp: 'rww 3/8/2000 12:49'! inQueue "Answer the receiver's instance variable inQueue." ^inQueue! ! !InMemoryTransport methodsFor: 'accessing' stamp: 'rww 3/8/2000 12:49'! inQueue: anObject "Set the receiver's instance variable inQueue to anObject." inQueue := anObject! ! !InMemoryTransport methodsFor: 'accessing' stamp: 'rww 3/8/2000 12:49'! outQueue "Answer the receiver's instance variable outQueue." ^outQueue! ! !InMemoryTransport methodsFor: 'accessing' stamp: 'rww 3/8/2000 12:49'! outQueue: anObject "Set the receiver's instance variable outQueue to anObject." outQueue := anObject! ! !InMemoryTransport class methodsFor: 'rendezvous' stamp: 'rww 3/25/2000 17:08'! connectToPort: aPort |inMemListener pair| inMemListener := self loopbackPorts at: aPort ifAbsent: [self error: 'Not a valid port']. pair := self newPair. inMemListener theNextConnection: (pair at: 2). ^pair at: 1 ! ! !InMemoryTransport class methodsFor: 'rendezvous' stamp: 'rww 3/25/2000 17:02'! listenOnPort: aPort withListener: aListener self loopbackPorts at: aPort put: aListener. ! ! !InMemoryTransport class methodsFor: 'rendezvous' stamp: 'rww 3/25/2000 16:12'! loopbackPorts ^LoopbackPorts ifNil: [LoopbackPorts := Dictionary new]. ! ! !InMemoryTransport class methodsFor: 'rendezvous' stamp: 'rww 3/25/2000 16:13'! stopListeningOnPort: aPort self loopbackPorts removeKey: aPort ifAbsent: []. ! ! !InMemoryTransport class methodsFor: 'instance creation' stamp: 'rww 3/8/2000 12:53'! newPair "LoopbackTransport newPair" |pair left right leftQ rightQ| pair := Array new: 2. left := self new. right := self new. leftQ := SharedQueue new. rightQ := SharedQueue new. left initializeWithInQ: leftQ outQ: rightQ. right initializeWithInQ: rightQ outQ: leftQ. pair at: 1 put: left. pair at: 2 put: right. ^pair. ! ! !ListenerResolver commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !ListenerResolver reorganize! ('api' resolveForLocator:) ('initialize-release' initializeOnTransport:parameters:) ! !ListenerResolver methodsFor: 'api' stamp: 'rww 3/28/2000 02:27'! resolveForLocator: aLocator |mgr| mgr := ConnectionManager serviceClass: aLocator endPointClass locator: aLocator. mgr start. ^mgr ! ! !ListenerResolver methodsFor: 'initialize-release' stamp: 'rww 3/27/2000 23:56'! initializeOnTransport: aTransportSymbol parameters: paramCollection " 'chatter://inmemory/listener/4199' asLocator resolve" " 'chatter://tcp/listener/4200' asLocator resolve" " 'comm://tcp/4201/ObjectService' asLocator" self transport: aTransportSymbol. self port: paramCollection removeFirst.! ! !ObjectClient methodsFor: 'accessing' stamp: 'tfei 3/13/2000 19:33'! sendSemaphore ^sendSemaphore! ! !ObjectClient methodsFor: 'accessing' stamp: 'tfei 3/13/2000 19:33'! syncSemaphore ^syncSemaphore! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:03'! asyncSend: aSelector to: aRemoteReceiver | msg | self sendSemaphore wait. msg := MessageSend receiver: aRemoteReceiver selector: aSelector. self nextPut: 'send'; nextPut: msg. self setReplyHandler. ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:22'! asyncSend: aSelector to: aRemoteReceiver with: anArg | msg | self sendSemaphore wait. msg := MessageSend receiver: aRemoteReceiver selector: aSelector argument: anArg. self nextPut: 'send'; nextPut: msg. self setReplyHandler. ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:22'! asyncSend: aSelector to: aRemoteReceiver withArguments: anArgArray | msg | self sendSemaphore wait. msg := MessageSend receiver: aRemoteReceiver selector: aSelector arguments: anArgArray. self nextPut: 'send'; nextPut: msg. self setReplyHandler. ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:23'! lookup: aSymbol | | self sendSemaphore wait. self nextPut: 'lookup'; nextPut: aSymbol. self setReplyHandler. ^self result ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:19'! result |theResult| self syncSemaphore wait. theResult := result. result := nil. (theResult isKindOf: Error) ifTrue: [ self sendSemaphore signal. ^theResult signal]. self sendSemaphore signal. ^theResult ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'rww 3/28/2000 15:17'! setReplyHandler replyHandler := [ [result := self next; next. self syncSemaphore signal] on: Error do: [:ex | result := ex. self syncSemaphore signal]] forkAt: Processor lowIOPriority. ! ! !ObjectClient methodsFor: 'sending-receiving' stamp: 'tfei 3/13/2000 21:08'! syncSend: aSelector to: aRemoteReceiver self asyncSend: aSelector to: aRemoteReceiver. ^self result.! ! !ObjectClient methodsFor: 'initialize' stamp: 'rww 3/23/2000 23:49'! initializeOnDuplexStream: aDuplexStream super initializeOnDuplexStream: aDuplexStream. self pushDuplexStream: (ObjectSerializingStream on: self duplexStream). sendSemaphore := Semaphore forMutualExclusion. syncSemaphore := Semaphore new.! ! !ObjectService methodsFor: 'protocol' stamp: 'tfei 3/13/2000 13:46'! lookupAction ^MessageSend receiver: self selector: #processLookup arguments: #()! ! !ObjectService methodsFor: 'protocol' stamp: 'rww 3/24/2000 10:51'! processLookup "Resolve the next name in the stream in the current environment. Add it as an entry to the object map and return its key." [| identifier object | identifier := self next. object := Smalltalk at: identifier ifAbsent: [Error signal: 'unknown name', identifier]. self flag: 'Need to ensure remote exception is signalled on failure'. self objectMap addLast: object. self flag: 'Need to protect all of this'. self nextPut: 'result'. self nextPut: self objectMap size] on: Error do: [:ex | self nextPut: 'exception'. self nextPut: ex messageText]. ! ! !ObjectService methodsFor: 'protocol' stamp: 'rww 3/9/2000 12:04'! processQuit self stop. self close.! ! !ObjectService methodsFor: 'protocol' stamp: 'rww 3/24/2000 10:50'! processSend [| result recv remoteMsg | remoteMsg := self next. recv := self objectMap at: remoteMsg receiver ifAbsent: [Error signal: 'unbound receiver']. remoteMsg receiver: recv. result := remoteMsg value. self nextPut: 'result'. self nextPut: result] on: Error do: [:ex | self nextPut: 'exception'. self nextPut: ex messageText]. ! ! !ObjectService methodsFor: 'protocol' stamp: 'rww 3/9/2000 11:56'! quitAction ^MessageSend receiver: self selector: #processQuit arguments: #()! ! !ObjectService methodsFor: 'protocol' stamp: 'rww 3/9/2000 11:56'! sendAction ^MessageSend receiver: self selector: #processSend arguments: #()! ! !ObjectService methodsFor: 'accessing' stamp: 'tfei 3/13/2000 13:36'! objectMap objectMap == nil ifTrue: [objectMap := OrderedCollection new]. ^objectMap! ! !ObjectService methodsFor: 'initialize' stamp: 'rww 3/23/2000 23:48'! initializeOnDuplexStream: aDuplexStream super initializeOnDuplexStream: aDuplexStream. self pushDuplexStream: (ObjectSerializingStream on: self duplexStream). actions at: 'lookup' put: self lookupAction; at: 'send' put: self sendAction; at: 'quit' put: self quitAction.! ! !ReliableInMemoryStream commentStamp: '<historical>' prior: 0! Main comment stating the purpose of this class and relevant relationship to other classes. Possible useful expressions for doIt or printIt. Structure: instVar1 type -- comment about the purpose of instVar1 instVar2 type -- comment about the purpose of instVar2 Any further useful comments about the general approach of this implementation.! !ReliableInMemoryStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:24'! next self closed ifTrue: [^self errorStreamClosed]. ^self connection next ! ! !ReliableInMemoryStream methodsFor: 'Stream API' stamp: 'rww 3/23/2000 20:25'! nextPut: aByte self closed ifTrue: [self errorStreamClosed]. self connection nextPut: aByte. ! ! !ReliableInMemoryStream class methodsFor: 'scripts' stamp: 'rww 3/25/2000 16:20'! createPair "ReliableInMemoryStream createPair" |ioPair first second | ioPair := InMemoryTransport newPair. first := ReliableInMemoryStream on: (ioPair at: 1). second := ReliableInMemoryStream on: (ioPair at: 2). ioPair at: 1 put: first. ioPair at: 2 put: second. ^ioPair! ! !ReliableInMemoryStream class methodsFor: 'scripts' stamp: 'rww 3/25/2000 16:20'! test "ReliableInMemoryStream test" |ioPair first second proc1 proc2| ioPair := ReliableInMemoryStream createPair. first := ioPair at: 1. second := ioPair at: 2. first nextPutAll: 'The Fourth Estate, Inc.' asByteArray. second nextPutAll: 'RoaRR' asByteArray. proc1 := [[first closed not] whileTrue: [Transcript cr; show: first next printString]] fork. proc2 := [[second closed not] whileTrue: [Transcript cr; show: second next printString]] fork. (Delay forMilliseconds: 1000) wait. first close. second close. proc1 terminate. proc2 terminate. ^ioPair! ! !String methodsFor: 'converting' stamp: 'rww 3/26/2000 01:28'! asLocator "convert to a Locator" " 'http://www.cc.gatech.edu/' asLocator" " 'chatter://listener/tcp/9000' asLocator" ^AbstractLocator fromString: self! ! ConnectionLocator initialize! InMemoryConnecter initialize! InMemoryListener initialize! "Postscript: Leave the line above, and replace the rest of this comment by a useful one. Executable statements should follow this comment, and should be separated by periods, with no exclamation points (!!). Be sure to put any further comments in double-quotes, like this one." |workspace| workspace := Workspace new. workspace contents: ' "Client server example code" |serviceLocator clientLocator manager client timeClass| serviceLocator := ''comm://tcp/9111/ObjectService'' asLocator. clientLocator := ''comm://tcp/localhost:9111/ObjectClient'' asLocator. manager := serviceLocator resolve. client := clientLocator resolve. timeClass := client lookup: #Time. Transcript cr; cr; show: ''The remote time is: '', (client syncSend: #now to: timeClass) printString. client close. manager close. "Unit test case" ClientServerUnitTest runSUnitAsMorphic. "Check for cleanup. Sockets seem to be hanging around even if they are closed" ConnectionManager allInstances. ObjectClient allInstances. ObjectService allInstances. Socket allInstances. '. workspace openLabel: 'ClientServer Workspace'. !