'From Squeak2.8alpha of 19 January 2000 [latest update: #2299] on 7 June 2000 at 7:46:20 pm'! "Change Set: JMM-Network-Server Date: 5 June 2000 Author: John M McIntosh johnmci@smalltalkconsulting.com A dummy network application for stress testing the socket code. This code uses multiple processes to listen on a socket, then accepts and reads incoming requests, builds an answer then sent it out to the client and closes the socket. It then tracks the response time so you can track performance implications and of course see if you are dropping requests or replies. "! Object subclass: #JMMClientOfServer instanceVariableNames: 'socket delay sendBuf running receiveBuf bytesReceived terminator ' classVariableNames: '' poolDictionaries: '' category: 'JMM-Network Server'! !JMMClientOfServer commentStamp: '' prior: 0! Made for stress testing the tcp/ip socket code. By John M McIntosh johnmci@smalltalkconsulting.com www.smaltalkconsulting.com This class just makes a request to a server, reads the results and terminates If a problem happens it beeps, sorry no writting to the thread unsafe Transcript. You must supply a valid server host address. See the constants Category.! Object subclass: #JMMNetWorkRequest instanceVariableNames: 'socket workItem startTime endTime ' classVariableNames: '' poolDictionaries: '' category: 'JMM-Network Server'! !JMMNetWorkRequest commentStamp: '' prior: 0! Made for stress testing the tcp/ip socket code. By John M McIntosh johnmci@smalltalkconsulting.com www.smaltalkconsulting.com Used by JMMServer to store information and results for incoming request! Object subclass: #JMMServer instanceVariableNames: 'incomingRequests outGoingAnswers random listenProcess workProcess writeProcess largestSize listenSocket stopRunning numberIncoming numberProcessed numberCompleted statisticsProcess writeStream loggingSeconds dummyPageCache outBoundByteCount numberOfReadFailures numberOfWriteFailures deadSockets randMutual hadToAbortWrite timeStatsMutual timeStats ' classVariableNames: '' poolDictionaries: '' category: 'JMM-Network Server'! !JMMServer commentStamp: '' prior: 0! Made for stress testing the tcp/ip socket code. By John M McIntosh johnmci@smalltalkconsulting.com www.smaltalkconsulting.com This class emulates a simple server. On a fast machine it should manage well over 50 connections per second forever and move anywhere from 4 million to 12 million bits per second. Run an instance on this class on your server, then use instances of JMMClientOfServer to make requests to it. It also produces a log file showing the current incoming, processing, completed connects along with arrays of numbers that represent the milliseconds taken from the point of accept to when we close and destory the socket. Counters are also used to track failures and bad sockets are kept around to be examined. ! !JMMClientOfServer methodsFor: 'constants' stamp: 'JMM 6/1/2000 09:53'! hostAddress ^NetNameResolver addressFromString: '192.168.1.2'! ! !JMMClientOfServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 22:44'! terminationSeconds "How long to run when waiting for data, if we exceed this we terminate" ^180! ! !JMMClientOfServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 22:43'! waitTime " Time to wait for data, but total time is dictated by the terminator" ^10! ! !JMMClientOfServer methodsFor: 'initialize' stamp: 'JMM 6/2/2000 22:44'! initialize Socket initializeNetworkIfFail: [^self beep]. socket _ Socket newTCP. sendBuf _ String new: 80 withAll: $x. receiveBuf _ String new: 20000 withAll: $ . bytesReceived _ 0. running _ true. ! ! !JMMClientOfServer methodsFor: 'running' stamp: 'JMM 5/31/2000 14:29'! pullData socket waitForDataUntil: (Socket deadlineSecs: self waitTime). socket dataAvailable ifTrue: [bytesReceived _ bytesReceived + (socket receiveDataInto: receiveBuf)]! ! !JMMClientOfServer methodsFor: 'running' stamp: 'JMM 5/31/2000 15:01'! run self terminationThing. socket connectTo: self hostAddress port: 54321. socket waitForConnectionUntil: Socket standardDeadline. socket isConnected ifFalse: [self zap. ^self]. socket sendData: sendBuf. socket waitForSendDoneUntil: Socket standardDeadline. socket sendDone ifFalse: [self zap. ^self]. self pullData. [((receiveBuf includes: $$) not and: [self running]) and: [socket isUnconnectedOrInvalid not]] whileTrue: [self pullData]. socket closeAndDestroy. self terminator terminate. (receiveBuf includes: $$) ifFalse: [Transcript show: '*No$*'. Transcript show: bytesReceived printString. Transcript show: socket statusString. self zap].! ! !JMMClientOfServer methodsFor: 'running' stamp: 'JMM 6/2/2000 22:46'! terminationThing self delay: (Delay forSeconds: self terminationSeconds). self terminator: ([self delay wait. self running: false.] forkAt: Processor userInterruptPriority)! ! !JMMClientOfServer methodsFor: 'running' stamp: 'JMM 6/2/2000 22:39'! zap self beep. self terminator terminate. ! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 23:29'! delay ^delay! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 23:29'! delay: aDelay delay _ aDelay! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:53'! running ^running! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:42'! running: aFlag running _ aFlag! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:50'! terminator ^terminator! ! !JMMClientOfServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:50'! terminator: aThing terminator _ aThing! ! !JMMClientOfServer class methodsFor: 'instance creation' stamp: 'JMM 6/2/2000 22:39'! initializeClass "JMMClientOfServer initializeClass" ! ! !JMMClientOfServer class methodsFor: 'instance creation' stamp: 'JMM 5/28/2000 22:33'! new ^super new initialize! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:51'! endTime ^endTime! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:51'! endTime: time endTime _ time! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:50'! socket ^socket! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:50'! socket: aSocket socket _ aSocket.! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:51'! startTime ^startTime! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:51'! startTime: time startTime _ time! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:50'! workItem ^workItem! ! !JMMNetWorkRequest methodsFor: 'accessors' stamp: 'JMM 5/31/2000 19:50'! workItem: aItem workItem _ aItem! ! !JMMNetWorkRequest class methodsFor: 'instance creation' stamp: 'JMM 5/31/2000 19:54'! newWithSocket: aSocket ^super new socket: aSocket; startTime: (Time millisecondClockValue);yourself! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/29/2000 23:00'! deadSockets ^deadSockets! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/30/2000 00:25'! deadSockets: aCollection deadSockets _ aCollection! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/29/2000 20:53'! dummyPageCache ^dummyPageCache! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/29/2000 20:53'! dummyPageCache: aCollection dummyPageCache _ aCollection.! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:15'! incomingRequests ^incomingRequests! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:05'! listenProcess ^listenProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:15'! listenProcess: aProcess listenProcess _ aProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:09'! listenSocket ^listenSocket! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:09'! listenSocket: aSocket listenSocket _ aSocket! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:17'! numberCompleted ^numberCompleted! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:16'! numberIncoming ^numberIncoming! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:16'! numberProcessed ^numberProcessed! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/29/2000 21:00'! outBoundByteCount ^outBoundByteCount ! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/29/2000 20:59'! outBoundByteCount: aNumber outBoundByteCount _ aNumber ! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 19:53'! outGoingAnswers ^outGoingAnswers! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/30/2000 01:13'! randMutual ^randMutual! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 19:53'! random ^random! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/30/2000 01:13'! randomNext ^self randMutual critical: [random next]! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:04'! statisticsProcess ^statisticsProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 22:04'! statisticsProcess: aProcess statisticsProcess _ aProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:17'! stopRunning ^stopRunning! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:16'! stopRunning: stopRequest stopRunning _ stopRequest.! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/31/2000 20:06'! timeStats ^timeStats! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/31/2000 20:06'! timeStats: aCollection timeStats _ aCollection! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/31/2000 20:05'! timeStatsMutual ^timeStatsMutual! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/31/2000 20:05'! timeStatsMutual: aMutx timeStatsMutual _ aMutx.! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:05'! workProcess ^workProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 21:28'! workProcess: aProcess workProcess _ aProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 20:06'! writeProcess ^writeProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 21:27'! writeProcess: aProcess writeProcess _ aProcess! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 21:55'! writeStream ^writeStream! ! !JMMServer methodsFor: 'accessors' stamp: 'JMM 5/28/2000 21:55'! writeStream: aStream writeStream _ aStream! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 22:55'! backLogMessageSize ^200! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/3/2000 22:02'! largestSize "Note the data we send is really upto 20000 since we tack a trailer character on the data so the client knows when he has received all the data" ^19999! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/3/2000 22:00'! listenPort ^54321! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/3/2000 22:03'! loggingSeconds ^1! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 5/29/2000 20:52'! numberOfChoices ^100! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 23:04'! secondsToWaitBeforeDisconnecting ^120! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 23:00'! secondsToWaitForData ^60! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 22:57'! secondsToWaitForListen ^15*60! ! !JMMServer methodsFor: 'constants' stamp: 'JMM 6/2/2000 23:03'! secondsToWaitForSend ^60! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/28/2000 20:21'! incrementNumberCompleted numberCompleted _ numberCompleted + 1.! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/31/2000 15:34'! incrementNumberHadToAbortWrite hadToAbortWrite _ hadToAbortWrite + 1.! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/28/2000 20:21'! incrementNumberIncoming numberIncoming _ numberIncoming + 1.! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/29/2000 21:27'! incrementNumberOfReadFailures numberOfReadFailures _ numberOfReadFailures + 1.! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/30/2000 01:21'! incrementNumberOfWriteFailures numberOfWriteFailures _ numberOfWriteFailures + 1.! ! !JMMServer methodsFor: 'counting' stamp: 'JMM 5/28/2000 20:21'! incrementNumberProcessed numberProcessed _ numberProcessed + 1.! ! !JMMServer methodsFor: 'initialize-release' stamp: 'JMM 6/3/2000 22:03'! initialize Socket initializeNetworkIfFail: [^self error: 'Network Failed to initialize']. incomingRequests _ SharedQueue new. outGoingAnswers _ SharedQueue new. deadSockets _ OrderedCollection new. randMutual _ Semaphore forMutualExclusion. timeStatsMutual _ Semaphore forMutualExclusion. timeStats _ OrderedCollection new: 200. random _ Random new. stopRunning _ false. numberIncoming _ 0. numberProcessed _ 0. numberCompleted _ 0. outBoundByteCount _ 0. numberOfReadFailures _ 0. numberOfWriteFailures _ 0. hadToAbortWrite _ 0. self buildDummyPages ! ! !JMMServer methodsFor: 'initialize-release' stamp: 'JMM 6/1/2000 08:46'! terminate self stopRunning: true. (Delay forSeconds: 5) wait. self listenProcess terminate. self workProcess terminate. self writeProcess terminate. self listenSocket closeAndDestroy. self deadSockets do: [:s | s socket disconnect]. self writeStream close.! ! !JMMServer methodsFor: 'process' stamp: 'JMM 5/28/2000 22:03'! buildStatisticsProcess self writeStream: (CrLfFileStream new open: 'JMMServerLog.txt' forWrite: true). self statisticsProcess: ( [[self stopRunning not] whileTrue: [(Delay forSeconds: self loggingSeconds) wait. self everyNSeconds]] forkAt: Processor userInterruptPriority)! ! !JMMServer methodsFor: 'process' stamp: 'JMM 5/28/2000 21:08'! buildWorkProcess self workProcess: ([[self stopRunning not] whileTrue: [self handleWorkItem: self incomingRequests next]] forkAt: Processor userBackgroundPriority).! ! !JMMServer methodsFor: 'process' stamp: 'JMM 5/28/2000 21:47'! run self buildStatisticsProcess. self buildWriteProcess. self buildWorkProcess. self buildListenProcess ! ! !JMMServer methodsFor: 'process-incoming' stamp: 'JMM 6/2/2000 22:57'! acceptRequests | request | request _ self listenSocket waitForAcceptUntil: (Socket deadlineSecs: self secondsToWaitForListen). request isConnected ifTrue: [self incrementNumberIncoming. self incomingRequests nextPut: (JMMNetWorkRequest newWithSocket: request)]! ! !JMMServer methodsFor: 'process-incoming' stamp: 'JMM 5/28/2000 21:09'! buildListenProcess self buildListenSocket. self listenProcess: ([[self stopRunning not] whileTrue: [self acceptRequests]] forkAt: Processor userInterruptPriority)! ! !JMMServer methodsFor: 'process-incoming' stamp: 'JMM 6/2/2000 23:01'! goHandleDummyRequest: aWorkItem "Read a response from the client, right now we ignore it" | buffer n answer | buffer _ String new: 4000. aWorkItem socket waitForDataUntil: (Socket deadlineSecs: self secondsToWaitForData). aWorkItem socket dataAvailable ifTrue: [n _ aWorkItem socket receiveDataInto: buffer.] ifFalse: [self incrementNumberOfReadFailures. self deadSockets add: aWorkItem. ^nil]. answer _ self dummyPageCache at: (self randomNext * (self numberOfChoices - 1)) rounded + 1. aWorkItem workItem: answer. self incrementNumberProcessed. ! ! !JMMServer methodsFor: 'process-outgoing' stamp: 'JMM 5/31/2000 16:52'! buildWriteProcess self writeProcess: ([[self stopRunning not] whileTrue: [self writeWorkItem: self outGoingAnswers next]] forkAt: Processor userBackgroundPriority)! ! !JMMServer methodsFor: 'process-outgoing' stamp: 'JMM 5/31/2000 19:59'! handleWorkItem: aWorkItem [| answer | self goHandleDummyRequest: aWorkItem. aWorkItem workItem isNil ifFalse: [self outGoingAnswers nextPut: aWorkItem]] forkAt: Processor userBackgroundPriority! ! !JMMServer methodsFor: 'process-outgoing' stamp: 'JMM 6/2/2000 23:04'! writeData: aWorkItem | aSocket | aSocket _ aWorkItem socket. aSocket isConnected ifFalse: [aSocket closeAndDestroy. ^self]. aSocket sendData: aWorkItem workItem. aSocket waitForSendDoneUntil: (Socket deadlineSecs: self secondsToWaitForSend). aSocket sendDone ifTrue: [aSocket close. aSocket waitForDisconnectionUntil: (Socket deadlineSecs: self secondsToWaitBeforeDisconnecting). aSocket isUnconnected ifFalse: [self incrementNumberHadToAbortWrite. aSocket disconnect]. aSocket destroy] ifFalse: [self incrementNumberOfWriteFailures. self deadSockets add: aSocket]. ! ! !JMMServer methodsFor: 'process-outgoing' stamp: 'JMM 5/31/2000 20:10'! writeWorkItem: aWorkItem [self writeData: aWorkItem. outBoundByteCount _ outBoundByteCount + aWorkItem workItem size. aWorkItem endTime: Time millisecondClockValue. self addToTimeStats: aWorkItem. self incrementNumberCompleted] forkAt: Processor userBackgroundPriority! ! !JMMServer methodsFor: 'setup' stamp: 'JMM 5/30/2000 01:13'! buildARandomAnswer | rndSize strm | rndSize _ (((self random next) * self largestSize) truncated) + 1. strm _ WriteStream on: (String new: rndSize). rndSize timesRepeat: [strm nextPut: (((self randomNext) < 0.5) ifTrue: [$X] ifFalse: [$Y])]. strm nextPut: $$. ^strm contents.! ! !JMMServer methodsFor: 'setup' stamp: 'JMM 5/29/2000 20:55'! buildDummyPages self dummyPageCache: (Array new: self numberOfChoices). 1 to: self numberOfChoices do: [: i | self dummyPageCache at: i put: self buildARandomAnswer] ! ! !JMMServer methodsFor: 'setup' stamp: 'JMM 6/3/2000 22:00'! buildListenSocket | server | server _ Socket newTCP. server listenOn: self listenPort backlogSize: self backLogMessageSize. server isValid ifFalse:[self error:'Accept() is not supported']. self listenSocket: server.! ! !JMMServer methodsFor: 'statistics' stamp: 'JMM 5/31/2000 20:08'! addToTimeStats: aWorkItem self timeStatsMutual critical: [self timeStats add: (aWorkItem endTime - aWorkItem startTime)]! ! !JMMServer methodsFor: 'statistics' stamp: 'JMM 5/31/2000 20:12'! everyNSeconds self writeStream nextPutAll: Time millisecondClockValue printString;tab. self writeStream nextPutAll: self numberIncoming printString;tab. self writeStream nextPutAll: self numberProcessed printString;tab. self writeStream nextPutAll: self numberCompleted printString;tab. self writeStream nextPutAll: self outBoundByteCount printString;tab. self timeStatsMutual critical: [ self timeStats do: [:e | self writeStream nextPutAll: e printString;tab]. self timeStats: (OrderedCollection new: 200)]. self writeStream cr. ! ! !JMMServer class methodsFor: 'instance creation' stamp: 'JMM 6/3/2000 22:00'! new " JMMServer new run" ^super new initialize! ! !JMMServer class methodsFor: 'testing' stamp: 'JMM 6/2/2000 23:11'! tapTheServer "JMMServer tapTheServer " | socket sendBuf receiveBuf bytesReceived serverName t1 | Transcript show: 'starting JMMServer test'; cr. Transcript show: 'initializing network ... '. Socket initializeNetworkIfFail: [^Transcript show:'failed']. Transcript show:'ok';cr. socket _ Socket newTCP. serverName _ FillInTheBlank request: 'What is your remote Test JMMServer?' initialAnswer: ''. socket connectTo: (NetNameResolver addressFromString: serverName) port: 54321. socket waitForConnectionUntil: Socket standardDeadline. Transcript show: 'client endpoint created'; cr. sendBuf _ String new: 80 withAll: $x. receiveBuf _ String new: 20000. bytesReceived _ 0. t1 _ Time millisecondsToRun: [socket sendData: sendBuf. [receiveBuf includes: $$] whileFalse: [socket waitForDataUntil: (Socket deadlineSecs: 120). socket dataAvailable ifTrue: [bytesReceived _ bytesReceived + (socket receiveDataInto: receiveBuf)]]]. Transcript show: 'Bytes received ',bytesReceived printString,' in ',t1 printString,' Milliseconds';cr. socket closeAndDestroy.! ! !JMMServer reorganize! ('accessors' deadSockets deadSockets: dummyPageCache dummyPageCache: incomingRequests listenProcess listenProcess: listenSocket listenSocket: numberCompleted numberIncoming numberProcessed outBoundByteCount outBoundByteCount: outGoingAnswers randMutual random randomNext statisticsProcess statisticsProcess: stopRunning stopRunning: timeStats timeStats: timeStatsMutual timeStatsMutual: workProcess workProcess: writeProcess writeProcess: writeStream writeStream:) ('constants' backLogMessageSize largestSize listenPort loggingSeconds numberOfChoices secondsToWaitBeforeDisconnecting secondsToWaitForData secondsToWaitForListen secondsToWaitForSend) ('counting' incrementNumberCompleted incrementNumberHadToAbortWrite incrementNumberIncoming incrementNumberOfReadFailures incrementNumberOfWriteFailures incrementNumberProcessed) ('initialize-release' initialize terminate) ('process' buildStatisticsProcess buildWorkProcess run) ('process-incoming' acceptRequests buildListenProcess goHandleDummyRequest:) ('process-outgoing' buildWriteProcess handleWorkItem: writeData: writeWorkItem:) ('setup' buildARandomAnswer buildDummyPages buildListenSocket) ('statistics' addToTimeStats: everyNSeconds) !