'From Pharo-1.0 of 19 October 2009 [Latest update: #10517] on 25 May 2010 at 2:24:21 pm'!
"Change Set:		SocketWoes
Date:			25 May 2010
Author:			BillSchwab

The test case should be safe to load; the changes to Socket and ConnectionQueue are as-is, without warranty, load at your-own-risk.  You've been warned<g>.  That said, 1.0 and 1.0 beta both fail the test w/o these changes, and appear to pass with them."!


!ConnectionQueue methodsFor: 'private' stamp: 'BillSchwab 5/25/2010 14:15'!
listenLoop
	"Private!! This loop is run in a separate process. It will establish up to maxQueueLength connections on the given port."
	"Details: When out of sockets or queue is full, retry more frequently, since a socket may become available, space may open in the queue, or a previously queued connection may be aborted by the client, making it available for a fresh connection."
	"Note: If the machine is disconnected from the network while the server is running, the currently waiting socket will go from 'isWaitingForConnection' to 'unconnected', and attempts to create new sockets will fail. When this happens, delete the broken socket and keep trying to create a socket in case the network connection is re-established. Connecting and disconnecting was tested under PPP on Mac system 8.1. It is not if this will work on other platforms.
	
	Fixed to not accept the connection if the queue is full (gvc)."


	| newConnection |

	socket := Socket newTCP.
	"We'll accept four simultanous connections at the same time"
	socket listenOn: portNumber backlogSize: 4.
	"If the listener is not valid then the we cannot use the
	BSD style accept() mechanism."
	socket isValid ifFalse: [^self oldStyleListenLoop].
	[true] whileTrue: [
		socket isValid ifFalse: [
			"socket has stopped listening for some reason"
			socket destroy.
			(Delay forMilliseconds: 10) wait.
			^self listenLoop ].
		[newConnection := socket "waitForConnectionFor:" waitForAcceptFor: 10]
			on: ConnectionTimedOut
			do: [:ex | newConnection := nil].
		"5-10 - wks; waiting for accept above, do don't accept again.
		(newConnection notNil and: [newConnection isConnected])
			ifTrue: [(accessSema critical: [connections size < maxQueueLength])
						ifTrue: [newConnection := socket accept]
						ifFalse: [socket closeAndDestroy: 0].
			]
			ifFalse: [newConnection := nil]."
		(newConnection notNil and: [newConnection isConnected]) ifTrue: [
			accessSema critical: [connections addLast: newConnection].
			newConnection := nil.
			self changed].
		self pruneStaleConnections]. ! !

!ConnectionQueue methodsFor: 'private' stamp: 'BillSchwab 5/25/2010 14:09'!
listenLoopAsFound
	"Private!! This loop is run in a separate process. It will establish up to maxQueueLength connections on the given port."
	"Details: When out of sockets or queue is full, retry more frequently, since a socket may become available, space may open in the queue, or a previously queued connection may be aborted by the client, making it available for a fresh connection."
	"Note: If the machine is disconnected from the network while the server is running, the currently waiting socket will go from 'isWaitingForConnection' to 'unconnected', and attempts to create new sockets will fail. When this happens, delete the broken socket and keep trying to create a socket in case the network connection is re-established. Connecting and disconnecting was tested under PPP on Mac system 8.1. It is not if this will work on other platforms.
	
	Fixed to not accept the connection if the queue is full (gvc)."


	| newConnection |

	socket := Socket newTCP.
	"We'll accept four simultanous connections at the same time"
	socket listenOn: portNumber backlogSize: 4.
	"If the listener is not valid then the we cannot use the
	BSD style accept() mechanism."
	socket isValid ifFalse: [^self oldStyleListenLoop].
	[true] whileTrue: [
		socket isValid ifFalse: [
			"socket has stopped listening for some reason"
			socket destroy.
			(Delay forMilliseconds: 10) wait.
			^self listenLoop ].
		[newConnection := socket "waitForConnectionFor:" waitForAcceptFor: 10]
			on: ConnectionTimedOut
			do: [:ex | newConnection := nil].
		(newConnection notNil and: [newConnection isConnected])
			ifTrue: [(accessSema critical: [connections size < maxQueueLength])
						ifTrue: [newConnection := socket accept]
						ifFalse: [socket closeAndDestroy: 0].
						"5-10 - wks - is the code below trying again??
						Clear the new connection to prevent same."
						newConnection := nil.
			]
			ifFalse: [newConnection := nil].
		(newConnection notNil and: [newConnection isConnected]) ifTrue: [
			accessSema critical: [connections addLast: newConnection].
			newConnection := nil.
			self changed].
		self pruneStaleConnections]. ! !


!NetworkSmokeTestCase methodsFor: 'as yet unclassified' stamp: 'BillSchwab 5/25/2010 14:22'!
testLocalServerAndClient
	"11-09 - try a server and a client in the same image."

		| server port client serverSocket serverSocketStream text thread done read |

	port := 4900.
	done := Semaphore new.

	"11-09 - gag the prompter below"
	serverSocket := nil.

	server := ConnectionQueue portNumber:port queueLength:5.
	[
		client := SocketStream openConnectionToHostNamed:'localhost' port:port.
		[ serverSocket isNil ] whileTrue:[
			serverSocket := server getConnectionOrNil.
		].

		serverSocketStream := SocketStream on:serverSocket.
		text := 'Long live Tux!!'.
		serverSocketStream nextPutAll:text; flush.

		"11-09 - this hung up w/o the thread.
		11-09 - as you were; the problem was a lack of #flush on the send side, so there was
		nothing for the client side to read."
		thread := [
			read := client nextMany:text size.
			done signal.
		] forkAt:Processor userBackgroundPriority.
		thread name:'READ'.

		done wait.
		self should:[ read = text ].
		Transcript nextPutAll:'Just to make the point, we read: '; nextPutAll:read; cr; flush.

	] ensure:[
		server destroy.
		serverSocketStream close.
		client close.
	].

	"11-09 - no prompts"
	serverSocket := serverSocket.
	client := client.
	serverSocketStream := serverSocketStream.
	thread := thread.

	"
		NetworkSmokeTestCase prod:#testLocalServerAndClient.
	"
! !

!NetworkSmokeTestCase methodsFor: 'as yet unclassified' stamp: 'BillSchwab 5/25/2010 14:22'!
testLocalServerAndClientNoThread
	"11-09 - try a server and a client in the same image.  Try without the separate read thread."

		| server port client serverSocket serverSocketStream text read |

	port := 4900.

	"11-09 - gag the prompter below"
	serverSocket := nil.

	server := ConnectionQueue portNumber:port queueLength:5.
	[
		client := SocketStream openConnectionToHostNamed:'localhost' port:port.
		[ serverSocket isNil ] whileTrue:[
			serverSocket := server getConnectionOrNil.
		].

		serverSocketStream := SocketStream on:serverSocket.
		text := 'Long live Tux!!'.
		serverSocketStream nextPutAll:text; flush.

		read := client nextMany:text size.

		self should:[ read = text ].
		Transcript nextPutAll:'Just to make the point, we read: '; nextPutAll:read; cr; flush.

	] ensure:[
		server destroy.
		serverSocketStream close.
		client close.
	].

	"11-09 - no prompts"
	serverSocket := serverSocket.
	client := client.
	serverSocketStream := serverSocketStream.

	"
		NetworkSmokeTestCase prod:#testLocalServerAndClientNoThread.
	"
! !


!Socket methodsFor: 'waiting' stamp: 'BillSchwab 5/25/2010 14:04'!
waitForAcceptFor: timeout
	"Wait and accept an incoming connection. Return nil if it fails."

	"5-10 - accepting, so wait for that, not a connection??
	self waitForConnectionFor: timeout ifTimedOut: [^ nil].
	self waitForAcceptFor: timeout ifTimedOut: [^ nil].
	^ self isConnected
		ifTrue:[self accept]"
	^self waitForAcceptFor: timeout ifTimedOut: [^ nil]
		! !