[2.8alpha][GOODIE][FIX] Client Server Framework (very basic)Robert Withers withers at vnet.netThu Mar 30 01:01:21 UTC 2000
"Richard A. O'Keefe" wrote:
>
> > rendezvouss (??? How the heck do you make that plural ???). There
>
> rendevouses
>
> WRONG. Why not check a dictionary before answering?
>
> rendezvous (RON-day-voo) roudezvousing, rendezvoused;
> a rather formal word. The form 'rendezvous' is
> pronounced (RON-day-vooz) when it is the plural of
> the noun or the third person singular of the verb.
> ...
> [start of entry in Collins COBUILD dictionary, with
> phonetic spelling changed to fit into ASCII.]
>
> In short, the _spelling_ of 'rendezvous' is not changed
> when the -s morpheme is added, but the pronunciation _is_.
I suppose we can thank the Normans for that contribution to English. I
think I actually had the pronunciation right but I figured that you
don't pronounce the 's' in French words, so I doubled it like the German
letter like in Schloss. Is anyone doing anything in the natural
language arena? I'll bet we could come up with an incredible interface
to look at word roots and definitions.
That scolding applies particularly to the original lazy poster. I don't
actually own a dictionary. I was quite impressed with the volume of
messages in response to the CS framework and I thought that many of you
may be loading it and testing it out. A few are which is really cool.
What do you think of the fit of this framework into Squeak? The
CSFramework part is actually quite small (64k), but the BinaryInteropt
is pretty large isn't it? (264k) So the issues should probably be split
into whether the BinaryInteropt is the right solution as a binary
encoding standard adn whether the CSFramework is a good wrapping of the
Socket/Transport layer?
Here is all the code I am working on right now. I already posted
LindaTalk and the BinaryInteropt code was in the csframework file. I
have split the csframework into an abstract layer and dialect specific
layer. With the appropriate BinaryInteropt and
ClientServerFramework-<Dialect> changesets, we should be able to hook
different images up. Someone is working of a VW3.0 port, that I know
of.
Finally (and I didn't mean to write this much! sorry!), I have included
my current, broken work on distributed objects. The endpoints do
connect and the serialization if setup. The last step, that currently
occurs, is that the DistributedChatterSpace (think ObjectSession), gets
created and a ProtocolEngine is installed onto the ChatterObjectPeer and
started. This object installs two Pipes on each stream half-plex and
starts a pump process to read from the IncomingPipe. It does route the
messages to the engine, where a object substitution occurs and then the
message is sent to the real receiver object. Finally, it sends a Reply
or Exception back to the sender. I don't think I currently populate the
objectMap with any accessable objects. The rest is halfway through a
refactor and it isn't working. There is also a bit of prototype spike
code in the Chatter-Services category, which is shows my thoughts on how
to wrap references to internal AddressSpace objects and redirect message
sends to the space so it can control the send. Try AddressSpace new
registry.
So, what do y'all think?
regards,
Robert
--
--------------------------------------------------
Smalltalking by choice. Isn't it nice to have one!
-------------- next part --------------
'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'!
-------------- next part --------------
'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 at 0.0 extent: 1.0 at 0.1);
addMorph: runButtonM frame: (0.0 at 0.1 extent: 0.2 at 0.1);
addMorph: self summaryTextM frame: (0.2 at 0.1 extent: 0.8 at 0.1);
addMorph: detailsTextM frame: (0.0 at 0.2 extent: 1.0 at 0.1);
addMorph: failureListM frame: (0.0 at 0.3 extent: 1.0 at 0.35);
addMorph: errorListM frame: (0.0 at 0.65 extent: 1.0 at 0.35).
"=== open it ... ==="
topWindowM openInWorldExtent: 250 at 200.
! !
TCPConnecter initialize!
TCPListener initialize!
-------------- next part --------------
'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'.
!
More information about the Squeak-dev mailing list |