'From Squeak 2.3 of January 14, 1999 on 3 March 1999 at 7:02:54 pm'!
"Change Set:		GenericServer
Date:			3 March 1999
Author:			Lex Spoon

Contains some classes to help in writing certain kinds of servers:

	1) GenericServer maintains lists of connections, polls them for I/O, and listens for new connections.

	2) ObjectSocket streams a sequence of arbitrary objects across a Socket.

	3) StringSocket is similar to ObjectSocket, but it streams Arrays of Strings instead of arbitrary objects.  It is easier to secure servers based on StringSocket.

"!

Object subclass: #GenericServer
	instanceVariableNames: 'connections connectionQueue '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-GenericServer'!
Stream subclass: #ObjectSocket
	instanceVariableNames: 'socket outBuf outBufIndex inBuf outObjects inObjects '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-ObjectSocket'!
Stream subclass: #StringSocket
	instanceVariableNames: 'socket outBuf outBufIndex inBuf inBufIndex outArrays inArrays numStringsInNextArray stringsForNextArray nextStringSize '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Network-ObjectSocket'!

!GenericServer commentStamp: 'ls 3/3/1999 18:51' prior: 0!
An abstract server.  The intention is that servers can be practically written by subclassing GenericServer.  Suggestions on improving this mini-framework are appreciated.

Instances maintain a list of existing connections, and contain logic to initialize new connections,  dispose of dropped connections, and dispatch incoming messages.  Users must ensure the #processIO method must be called periodically, which will handle the details of buffering network I/O and accepting new connections.

Subclasses MUST define the following method:

	connectionForSocket:

Subclasses SHOULD USUALLY define the following methods, which by default do nothing:

	connectionQuitting:
	processMessage:fromConnection:
!

!GenericServer methodsFor: 'private' stamp: 'ls 2/24/1999 10:56'!
initialize
	connections _ IdentitySet new.! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/22/1999 14:11'!
acceptNewConnections
	"accept any new connections that have arrived"
	| socket |
	connectionQueue ifNotNil: [
		[ connectionQueue connectionCount > 0 ] whileTrue: [
			socket _  connectionQueue getConnectionOrNil.
			connections add: (self connectionForSocket: socket) ] ]! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/24/1999 10:50'!
connectionForSocket: socket
	"create a new packet-oriented socket on top of the given raw socket"
	^self subclassResponsibility! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/24/1999 10:44'!
connectionQuitting: aConnection
	"a client is quitting.  subclasses  will probably want to override this and free up extra resources held by the connection"
! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/24/1999 10:55'!
processConnections
	"process IO on all connections, and react to messages that come in"
	| message |
	connections do: [ :connection |
		connection processIO.
		[	message _ connection nextMessageOrNil.  message ~~ nil ] whileTrue: [
			self processMessage: message fromConnection: connection. ].
	].! !

!GenericServer methodsFor: 'networking' stamp: 'ls 1/20/1999 11:07'!
processIO
	"process IO on all connections, and react to messages that come in"

	self pruneStaleConnections.
	self acceptNewConnections.
	self processConnections.! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/24/1999 10:54'!
processMessage: aMessage
	"a message has arrived; deal with it"! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/24/1999 10:43'!
pruneStaleConnections
	"remove connections that are no longer valid; for instance, clients that quit without officially logging off"
	| deadConnections |
	deadConnections _ connections select: [ :c | c isConnected not ].

	deadConnections do: [ :connection |
		self connectionQuitting: connection ].

	connections removeAll: deadConnections.
! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/22/1999 14:14'!
startListeningOnPort: port
	^self startListeningOnPort: port  queueLength: 5! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/22/1999 14:15'!
startListeningOnPort: port  queueLength: queueLength
	"most clients should probably call startListeningOnPort: instead"
	connectionQueue ifNotNil: [ self error: 'already listening!!' ].
	connectionQueue _ ConnectionQueue portNumber: port  queueLength: queueLength.
	! !

!GenericServer methodsFor: 'networking' stamp: 'ls 2/22/1999 14:15'!
stopListening
	"stop listening for new connections"
	connectionQueue ifNil: [ ^self ].
	connectionQueue destroy.
	connectionQueue _ nil.! !

!GenericServer methodsFor: 'access' stamp: 'ls 2/24/1999 11:01'!
connections
	"return the list of connections"
	^connections copy! !

!GenericServer methodsFor: 'access' stamp: 'ls 2/24/1999 11:03'!
isListening
	^connectionQueue notNil! !


!GenericServer class methodsFor: 'instance creation' stamp: 'ls 2/24/1999 10:57'!
new
	^super new initialize! !


!ObjectSocket commentStamp: '<historical>' prior: 0!
A network connection that passes objects instead of bytes.  The objects are encoded with SmartRefStreams.

Of course, one can send Arrays of Strings if one is unsure of what exactly SmartRefStream's are going to do.
!

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 14:36'!
initialize: aSocket
	"initialize for communication over the given socket"
	socket _ aSocket.

	outBuf _ nil.
	outObjects _ OrderedCollection new.

	inBuf _ ''.
	inObjects _ OrderedCollection new.! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 15:16'!
inputObjectTally
	"return the number of objects that have been read off the network but not returned by #next"
	^inObjects size! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 15:15'!
next
	"return the next object"
	inObjects isEmpty ifTrue: [ ^self error: 'no objects available' ].
	^inObjects removeFirst! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 10/12/1998 21:49'!
nextObjectLength
	"read the next object length from inBuf.  Returns nil if less than 4 bytes are available in inBuf"
	inBuf size < 4 ifTrue: [ ^nil ].

	^(RWBinaryOrTextStream with: inBuf) reset binary nextInt32! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 15:15'!
nextOrNil
	"return the next object, or nil if none have arrived"
	inObjects isEmpty ifTrue: [ ^nil ].
	^inObjects removeFirst! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 14:35'!
nextPut: anObject
	"queue anObject for output"
	outObjects addLast: anObject.! !

!ObjectSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/5/1999 15:14'!
processIO
	"do some network IO.  It is only done here.  Should be called periodically"

	|  encodingStream amt inObjectData |
	(socket isNil or: [ socket isConnected not ]) ifTrue: [
		"not connected--do nothing"
		^self ].


	"do some sending.  loop until we are out of data or the network is saturated"
	[
		(outBuf isNil or: [ outBufIndex > outBuf size ]) ifTrue: [
			"no data left in current buffer"
			outBuf _ nil.
			outObjects size > 0 ifTrue: [
				"encode a new object into an output buffer"
				outBuf _ RWBinaryOrTextStream on: (ByteArray new: 200).
				encodingStream _ RWBinaryOrTextStream on: (ByteArray new: 200).
				(SmartRefStream on: encodingStream) nextPutObjOnly:  outObjects removeFirst.
				outBuf nextInt32Put: encodingStream size.
				outBuf nextPutAll: encodingStream contents.

				outBuf _ outBuf contents.
				outBufIndex _ 1. ] ].

		outBuf ~~ nil and: [ socket sendDone ] 
	] whileTrue: [
		
		"there is some data available.  try to send some"
		amt _ socket sendSomeData: outBuf  startIndex: outBufIndex  count: (outBuf size - outBufIndex + 1).
		outBufIndex  _ outBufIndex + amt 
	].



	"recieve some data"
	[ socket dataAvailable ] whileTrue: [
		self flag: #inefficient.		"should avoid needless copies of the input buffer"
		inBuf _ inBuf , socket getData.

		[self nextObjectLength ~~ nil and: [ self nextObjectLength <= (inBuf size + 4) ]] whileTrue: [
			"a new object has arrived"

			inObjectData _ inBuf copyFrom: 5 to: (4 + self nextObjectLength).
			inBuf _ inBuf copyFrom: (5 + self nextObjectLength) to: inBuf size.
			inObjects addLast: (SmartRefStream on: (RWBinaryOrTextStream with: inObjectData) reset binary) next ] ].! !


!StringSocket commentStamp: '<historical>' prior: 0!
This is a socket which sends arrays of strings back and forth.  This is less convenient than ObjectSockets but it is more secure.

An array of strings is represented on the network as:

	4-bytes		number of strings in the array
	4-byte		number of bytes in the first string
	n1-bytes		characters in the first string
	4-bytes		number of bytes in the second string
	n2-bytes	characters in the second string
	...

!

!StringSocket reorganize!
('private-buffering' inBufNext: inBufSize shrinkInBuf)
('private-IO' processInput processOutput tryForNextStringSize tryForNumStringsInNextArray tryForString)
('stream protocol' inputTally next nextOrNil nextPut: outputTally)
('private-initialization' initialize:)
('as yet unclassified' destroy isConnected processIO)
!


!StringSocket methodsFor: 'private-buffering' stamp: 'ls 1/8/1999 16:07'!
inBufNext: numBytes
	"return numBytes bytes from input"
	| theBytes |
	theBytes _ inBuf copyFrom: inBufIndex to: inBufIndex+numBytes-1.
	inBufIndex _ inBufIndex + numBytes.
	^theBytes! !

!StringSocket methodsFor: 'private-buffering' stamp: 'ls 1/8/1999 16:49'!
inBufSize
	"number of valid bytes of input that are available"
	^inBuf size - inBufIndex + 1! !

!StringSocket methodsFor: 'private-buffering' stamp: 'ls 1/8/1999 16:08'!
shrinkInBuf
	"shrink the input buffer, if it is mostly empty space"
	inBuf size > (2 * inBufIndex) ifTrue: [
		inBuf _ inBuf copyFrom: inBufIndex to: inBuf size.
		inBufIndex _ 1. ]! !

!StringSocket methodsFor: 'private-IO' stamp: 'ls 1/8/1999 16:39'!
processInput
	"do as much input as possible"
	|gotSomething |
	"inputting"
	self flag: #XXX.  "should have resource limits here--no more than X objects and Y bytes"

	"read as much off the wire as possible"
	self flag: #XXX.  "should avoid buffer copying here"
	[ socket isValid and: [ socket dataAvailable ]] whileTrue: [
		inBuf _ inBuf, socket getData ].

	gotSomething _ true.
	[ gotSomething ] whileTrue: [
		numStringsInNextArray ifNil: [
			gotSomething _ self tryForNumStringsInNextArray ]
		ifNotNil: [
		nextStringSize ifNil: [
			gotSomething _ self tryForNextStringSize ]
		ifNotNil: [
			gotSomething _ self tryForString ] ] ].

	self shrinkInBuf.! !

!StringSocket methodsFor: 'private-IO' stamp: 'ls 1/8/1999 16:39'!
processOutput
	"do as much output as possible"
	| nextArray amt |
	[ 	(outBuf == nil or: [ outBufIndex > outBuf size ]) ifTrue: [
			(outArrays size > 0) ifTrue: [
				"previous StringArray has been sent; fill up buffer with the next"
				nextArray _ outArrays removeFirst.
				outBuf _ RWBinaryOrTextStream on: (String new: 100).
				outBuf nextInt32Put: nextArray size.
				nextArray do: [ :string |
					outBuf nextInt32Put: string size.
					outBuf nextPutAll: string. ].
				outBuf _ outBuf contents.
				outBufIndex _ 1. ]. ].

		"check whether there is data to be sent and room on the socket"
		outBuf ~~ nil and: [ outBufIndex <= outBuf size and: [ socket isValid and: [ socket sendDone ]]]
	] whileTrue: [
		"send some data out of the buffer"
		amt _ socket sendSomeData: outBuf  startIndex: outBufIndex  count: (outBuf size - outBufIndex + 1).
		outBufIndex  _ outBufIndex + amt. ].

! !

!StringSocket methodsFor: 'private-IO' stamp: 'ls 1/8/1999 16:48'!
tryForNextStringSize
	"grab the size of the next string, if it's available"
	| bytes |
	self inBufSize >= 4 ifTrue: [
		bytes _ self inBufNext: 4.
		nextStringSize _ (RWBinaryOrTextStream with: bytes) reset binary nextInt32. 
		^true ] .

	^false! !

!StringSocket methodsFor: 'private-IO' stamp: 'ls 1/8/1999 16:47'!
tryForNumStringsInNextArray
	"input numStringsInNextARray, if 4 bytes are available"
	| sizeBytes |
	(self inBufSize >= 4) ifTrue: [
		sizeBytes _ self inBufNext: 4.
		numStringsInNextArray _ (RWBinaryOrTextStream with: sizeBytes asByteArray) reset nextInt32.

		stringsForNextArray _ OrderedCollection new: numStringsInNextArray.
		nextStringSize _ nil. 
		^true ].

	^false! !

!StringSocket methodsFor: 'private-IO' stamp: 'ls 1/8/1999 16:50'!
tryForString
	"try to grab an actual string"
	| string |
	(self inBufSize >= nextStringSize) ifTrue: [
		string _ (self inBufNext: nextStringSize) asString.
		stringsForNextArray addLast: string.

		stringsForNextArray size = numStringsInNextArray ifTrue: [
			"we have finished another array!!"
			inArrays addLast: stringsForNextArray asArray.
			numStringsInNextArray _ nextStringSize _ nil ]
		ifFalse: [
			"still need more strings for this array"
			nextStringSize _ nil ] .

		^true
	].

	^false! !

!StringSocket methodsFor: 'stream protocol' stamp: 'ls 1/11/1999 10:52'!
inputTally
	"number of arrays that have arrived"
	^inArrays size! !

!StringSocket methodsFor: 'stream protocol' stamp: 'ls 1/8/1999 16:15'!
next
	^inArrays removeFirst	! !

!StringSocket methodsFor: 'stream protocol' stamp: 'ls 1/8/1999 16:14'!
nextOrNil
	inArrays isEmpty
		ifTrue: [ ^nil ]
		ifFalse: [ ^inArrays removeFirst ]! !

!StringSocket methodsFor: 'stream protocol' stamp: 'ls 1/8/1999 16:15'!
nextPut: aStringArray
	outArrays addLast: aStringArray! !

!StringSocket methodsFor: 'stream protocol' stamp: 'ls 1/11/1999 10:52'!
outputTally
	"number of objects waiting to be sent over the network"
	^outArrays size! !

!StringSocket methodsFor: 'private-initialization' stamp: 'ls 1/8/1999 16:17'!
initialize: aSocket
	socket _ aSocket.
	inBuf _ ''.
	inBufIndex _ 1.

	outBuf _ nil.

	inArrays _ OrderedCollection new.
	outArrays _ OrderedCollection new.

	numStringsInNextArray _ nil.! !

!StringSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/20/1999 11:05'!
destroy
	socket destroy.
	socket _ nil.! !

!StringSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/20/1999 10:57'!
isConnected
	socket ifNil: [ ^false ].
	socket isValid ifFalse: [ ^false ].
	^socket isConnected! !

!StringSocket methodsFor: 'as yet unclassified' stamp: 'ls 1/8/1999 16:14'!
processIO
	"do some as much network IO as possible"

	self processOutput.
	self processInput.! !


!StringSocket class methodsFor: 'as yet unclassified' stamp: 'ls 1/8/1999 16:40'!
on: aSocket
	"create a StringSocket which sends StringArrays across the given socket"
	^self basicNew initialize: aSocket! !