'From Squeak 1.23 of October 4, 1997 on 18 October 1997 at 9:13:03 am'! Stream subclass: #Connection instanceVariableNames: 'isBlocking socket isInitiator debug remnant readBuffer bufferDataSize readObjects bytesNeeded actionLists ' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Connection class instanceVariableNames: 'backgroundConnections serviceProcess shouldAcceptConnections terminationSemaphore servicePort listeningSockets '! Error subclass: #ConnectionError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Connection subclass: #EvaluationServer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Socket subclass: #EventSocket instanceVariableNames: 'actionLists monitoringProcess previousDataAvailable openOnce ' classVariableNames: 'NetworkInitialized ' poolDictionaries: '' category: 'Connections'! Object subclass: #ListeningSocketStream instanceVariableNames: 'sockets port semaphore ' classVariableNames: '' poolDictionaries: '' category: 'Connections'! ConnectionError subclass: #SocketError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Connection subclass: #StringConnection instanceVariableNames: '' classVariableNames: 'CrLf ' poolDictionaries: '' category: 'Connections'! StringConnection subclass: #DisplayServer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Connection subclass: #TimeServer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Connections'! Object subclass: #UnixHost instanceVariableNames: 'address ' classVariableNames: '' poolDictionaries: '' category: 'Connections'! !Object methodsFor: 'connections' stamp: 'taj 8/7/97 11:40'! asTransportString |rs s| s := RWBinaryOrTextStream on: ByteArray new. rs := ReferenceStream on: s. rs nextPut: self. rs close. s text. ^s contents! ! Connection comment: 'This class provides a high level interface to tcpip sockets. It uses stream protocol, and is implemented using ReferenceStreams so that it can work with any kind of object, not just characters. An example: server: c _ Connection port: 1234. c nextPut: (c next storeString). c close. client: c _ Connection to: ''server.free.com'' port: 1234. c nextPut: #(a test). Transcript show: c next;cr. Notice that only one side needs to use the close method, the other will close automatically when all data is read. Address can be specified using either names or dot notation "111.111.111.111". By subclassing Connection you can create connection servers. For example, to create the EvaluationServer from Connection, the following method was added: eventRead: aString self nextPut: (Compiler evaluate: aString) To start the server, say the following: EvaluationServer service: 1234 "the port number" The server runs in the background and can handle any number of connections from any number of sources. To access the server, use code like the following: c_Connection to: ''111.111.111.111'' port: 1234. c nextPut: ''2+2''. Transcript show: c next printString;cr. c nextPut: ''200 factorial''. Transcript show: c next printString;cr. c close. To stop the server and close all current connections to it, say: EvaluationServer stopService. Also see the comment for StringConnection; it allows you to communicate with non-Smalltalk systems. tim jones (tim@thregecy.com)'! !Connection methodsFor: 'override for server' stamp: 'taj 8/7/97 06:37'! eventClosed! ! !Connection methodsFor: 'override for server' stamp: 'taj 8/7/97 06:37'! eventOpened! ! !Connection methodsFor: 'override for server' stamp: 'taj 8/7/97 06:37'! eventRead: anObject! ! !Connection methodsFor: 'private' stamp: 'taj 8/9/97 00:28'! assureClosedStatus socket isConnected ifFalse: [ socket close ]. ! ! !Connection methodsFor: 'private' stamp: 'taj 9/4/97 00:05'! assureObjectsToRead "returns 1 object sent by other side of connection" self atEnd ifTrue: [self error: 'connection is closed']. [readObjects isEmpty] whileTrue: [self readObjects. self wait]! ! !Connection methodsFor: 'private' stamp: 'taj 8/11/97 05:10'! error: aString ConnectionError signal: aString! ! !Connection methodsFor: 'private' stamp: 'taj 8/9/97 19:05'! initialize actionLists _ Dictionary new. isInitiator _ false. debug _ false. remnant _ ''. bufferDataSize _ 0. bytesNeeded _ 0. readBuffer _ String new: 1024. readObjects _ OrderedCollection new. isBlocking _ true! ! !Connection methodsFor: 'private' stamp: 'taj 8/7/97 10:17'! isInitiator: aBoolean isInitiator := aBoolean! ! !Connection methodsFor: 'private' stamp: 'taj 8/11/97 06:23'! llConnectionClosed debug ifTrue: [Transcript show: 'c ' , self remoteAddress;cr]. self triggerEvent: #closed: with: self. self eventClosed. self release ! ! !Connection methodsFor: 'private' stamp: 'taj 8/9/97 18:10'! llConnectionOpened debug ifTrue: [Transcript show: 'o ' , self remoteAddress;cr]. self triggerEvent: #opened. self eventOpened. ! ! !Connection methodsFor: 'private' stamp: 'taj 9/29/97 16:17'! llRead: bytesToRead | totalBytesRead bytesRead stream| totalBytesRead _ 0. stream _ WriteStream on: (String new: 1024). stream nextPutAll: remnant. readBuffer size < bytesToRead ifTrue: [readBuffer := String new: bytesToRead]. [totalBytesRead < bytesToRead] whileTrue: [socket waitForDataUntil: Socket standardDeadline. bytesRead _ socket receiveDataInto: readBuffer. (stream isEmpty and: [bytesRead>=bytesToRead]) ifTrue: [bufferDataSize _ bytesRead. ^readBuffer]. stream nextPutAll: (readBuffer copyFrom: 1 to: bytesRead). totalBytesRead := totalBytesRead + bytesRead]. bufferDataSize _ stream size. ^stream contents ! ! !Connection methodsFor: 'private' stamp: 'taj 8/8/97 07:17'! llReadyToRead isBlocking ifFalse: [self readObjects. self processReadObjects] ! ! !Connection methodsFor: 'private' stamp: 'taj 8/8/97 09:19'! processReadObjects | object | [readObjects isEmpty] whileFalse: [object _ readObjects removeFirst. debug ifTrue: [Transcript show: 'r ' , self remoteAddress , ': ' , object printString;cr]. self triggerEvent: #read: with: object. self eventRead: object]! ! !Connection methodsFor: 'private' stamp: 'taj 8/11/97 06:53'! readObjects | buffer stream size processedTo charactersLeft packet | bytesNeeded = 0 ifTrue: [bytesNeeded _ 6]. buffer _ self llRead: bytesNeeded. stream _ ReadStream on: buffer from: 1 to: bufferDataSize. processedTo _ stream position. [stream atEnd] whileFalse: [size _ (stream next: 6) asNumber. size = 0 ifTrue: [self halt]. charactersLeft _ bufferDataSize - stream position. charactersLeft < size ifTrue: [stream position: processedTo. charactersLeft _ bufferDataSize - stream position. remnant _ stream next: charactersLeft. bytesNeeded _ size - charactersLeft. bytesNeeded < 0 ifTrue: [ self halt]. ^ self]. packet _ (stream next: size) asTransportedObject. readObjects add: packet. processedTo _ stream position]. remnant _ ''. bytesNeeded _ 0. ! ! !Connection methodsFor: 'private' stamp: 'taj 8/10/97 18:05'! socket: aSocket "private" socket notNil ifTrue: [socket removeAllActionsWithReceiver: self]. socket _ aSocket. socket when: #dataAvailable send: #llReadyToRead to: self. socket when: #disconnected send: #llConnectionClosed to: self. socket when: #connected send: #llConnectionOpened to: self. socket startEvents. ! ! !Connection methodsFor: 'private' stamp: 'taj 8/26/97 17:40'! write: aString "send the data to the other side of the connection" | data dataSize bytesWritten totalBytesWritten | self isClosed ifTrue: [ConnectionError signal: 'connection is closed']. data _ aString. dataSize _ data size. bytesWritten _ totalBytesWritten _ 0. [totalBytesWritten ~= dataSize] whileTrue: [[totalBytesWritten = 0 ifTrue: [bytesWritten _ socket sendData: data] ifFalse: [bytesWritten _ socket sendData: (data copyFrom: totalBytesWritten + 1 to: dataSize)]. socket waitForSendDoneUntil: Socket standardDeadline.] on: SocketError do: [:x | self close. ConnectionError signal: 'connection is closed.']. totalBytesWritten _ totalBytesWritten + bytesWritten]! ! !Connection methodsFor: 'event manager' stamp: 'taj 8/9/97 18:41'! actionLists ^ actionLists ! ! !Connection methodsFor: 'event manager' stamp: 'taj 8/9/97 18:42'! release super release. actionLists _ nil ! ! !Connection methodsFor: 'stream protocol' stamp: 'taj 8/18/97 22:51'! atEnd readObjects isEmpty ifFalse: [^false]. socket waitForDisconnectionOrDataAvailable = #disconnected ifTrue: [^true]. ^false.! ! !Connection methodsFor: 'stream protocol' stamp: 'taj 8/9/97 00:28'! close "stop using this connection" socket close.! ! !Connection methodsFor: 'stream protocol' stamp: 'taj 8/9/97 18:00'! next | result | self assureObjectsToRead. "returns 1 object sent by other side of connection" result _ readObjects removeFirst. debug ifTrue: [Transcript show: 'r ' , self remoteAddress , ': ' , result printString;cr]. ^ result! ! !Connection methodsFor: 'stream protocol' stamp: 'taj 8/26/97 17:40'! nextPut: anObject "send the object to the other side of the connection" | stringRep sizeString | self isClosed ifTrue: [ConnectionError signal: 'connection is closed']. stringRep _ anObject asTransportString. sizeString _ stringRep size printString , ' ' copyFrom: 1 to: 6. self write: sizeString, stringRep. debug ifTrue: [Transcript show: 'w ' , self remoteAddress , ': ' , anObject printString; cr] ! ! !Connection methodsFor: 'stream protocol' stamp: 'taj 8/9/97 18:01'! peek self assureObjectsToRead. ^readObjects first. ! ! !Connection methodsFor: 'queries' stamp: 'taj 10/4/97 22:53'! contents |collection| collection := OrderedCollection new. self do: [:i| collection add: i]. ^collection! ! !Connection methodsFor: 'queries' stamp: 'taj 8/9/97 00:32'! isClosed self assureClosedStatus. ^socket isConnected not ! ! !Connection methodsFor: 'queries' stamp: 'taj 8/7/97 08:07'! isInitiator "was this connection initiated on this side?" ^isInitiator! ! !Connection methodsFor: 'queries' stamp: 'taj 8/7/97 08:08'! localAddress "local tcpip address" ^self class localAddress! ! !Connection methodsFor: 'queries' stamp: 'taj 8/7/97 21:53'! remoteAddress "address of remote side of this connection" | addr s | addr _ socket remoteAddress. s _ WriteStream on: ''. 1 to: 3 do: [ :i | (addr at: i) printOn: s. s nextPut: $.]. (addr at: 4) printOn: s. ^ s contents ! ! !Connection methodsFor: 'other' stamp: 'taj 8/10/97 05:20'! debug: aBoolean "print debugging info to transcript" debug := aBoolean! ! !Connection methodsFor: 'other' stamp: 'taj 8/8/97 07:15'! shouldBlock: aBoolean "should this socket block for io?" isBlocking := aBoolean! ! !Connection methodsFor: 'waiting' stamp: 'taj 9/4/97 00:00'! wait self class wait! ! !Connection class methodsFor: 'image startup/shutdown' stamp: 'taj 9/29/97 16:37'! basicShutDown |port| self isServicing ifTrue: [port := servicePort. self stopService. servicePort := port] ! ! !Connection class methodsFor: 'image startup/shutdown' stamp: 'taj 9/29/97 16:37'! basicStartUp servicePort notNil ifTrue: [self service: servicePort]. ! ! !Connection class methodsFor: 'image startup/shutdown' stamp: 'taj 9/29/97 16:41'! shutDown self allSubclasses do: [:i| i basicShutDown]! ! !Connection class methodsFor: 'image startup/shutdown' stamp: 'taj 9/29/97 16:41'! startUp self allSubclasses do: [:i| i basicStartUp]! ! !Connection class methodsFor: 'private' stamp: 'taj 10/18/97 09:04'! acceptServiceConnection: socket [true] whileTrue: [self wait. shouldAcceptConnections ifFalse: [self cleanup: socket. listeningSockets release. terminationSemaphore signal. Processor terminateActive]. socket isUnconnectedOrInvalid ifTrue: [^self cleanup: socket ]. socket isConnected ifTrue: [^self inBackgroundUsing: socket]] ! ! !Connection class methodsFor: 'private' stamp: 'taj 10/17/97 21:26'! cleanup: aSocket [aSocket destroy] on: Error do: [:x| Transcript show: 'cleanup: ',x description;cr]! ! !Connection class methodsFor: 'private' stamp: 'taj 10/16/97 23:03'! inBackgroundUsing: aSocket |connection| connection := self privateNew shouldBlock: false; isInitiator: false; socket: aSocket; yourself. self backgroundConnections add: connection. connection when: #closed: do: [:c| self backgroundConnections remove: c] ! ! !Connection class methodsFor: 'private' stamp: 'taj 8/11/97 04:36'! privateNew ^self basicNew initialize! ! !Connection class methodsFor: 'instance creation' stamp: 'taj 8/7/97 07:24'! port: anInteger ^self port: anInteger timeout: 30 ! ! !Connection class methodsFor: 'instance creation' stamp: 'taj 8/18/97 20:10'! port: anInteger timeout: seconds | instance socket | socket _ EventSocket new. socket listenOn: anInteger. (socket waitForConnectionOrDataAvailableUntil: (Socket deadlineSecs: seconds)) ifFalse: [socket close; destroy. ConnectionError signal: 'timeout waiting for connection']. instance _ self privateNew socket: socket; isInitiator: false; yourself. ^ instance ! ! !Connection class methodsFor: 'instance creation' stamp: 'taj 8/18/97 20:10'! to: aString port: anInteger | socket instance | socket _ EventSocket new. socket connectTo: aString asAddress port: anInteger. (socket waitForConnectionOrDataAvailableUntil: Socket standardDeadline) ifFalse: [socket close; destroy. ConnectionError signal: 'timeout waiting for connection']. instance _ self privateNew socket: socket; isInitiator: true; yourself. ^ instance ! ! !Connection class methodsFor: 'queries' stamp: 'taj 8/7/97 06:48'! localAddress ^NetNameResolver localAddressString! ! !Connection class methodsFor: 'queries' stamp: 'taj 8/7/97 06:55'! networkingInstalled ^true "don't know how to detect this in squeak"! ! !Connection class methodsFor: 'port servicing' stamp: 'taj 8/11/97 06:30'! backgroundConnections backgroundConnections isNil ifTrue: [backgroundConnections _ OrderedCollection new]. ^backgroundConnections! ! !Connection class methodsFor: 'port servicing' stamp: 'taj 9/7/97 18:59'! isServicing ^serviceProcess notNil! ! !Connection class methodsFor: 'port servicing' stamp: 'taj 10/18/97 09:10'! listeningPortsCount ^1! ! !Connection class methodsFor: 'port servicing' stamp: 'taj 10/17/97 21:39'! service: anInteger |socket| self stopService. servicePort := anInteger. listeningSockets := ListeningSocketStream port: servicePort size: self listeningPortsCount. serviceProcess _ Process forContext: [[true] whileTrue: [Processor yield. [socket := listeningSockets next. self acceptServiceConnection: socket] on: ConnectionError do: [:x| Transcript show: x description;cr. self cleanup: socket]]] priority: Processor highIOPriority. shouldAcceptConnections := true. serviceProcess resume ! ! !Connection class methodsFor: 'port servicing' stamp: 'taj 10/18/97 09:05'! stopService serviceProcess notNil ifTrue: [terminationSemaphore := Semaphore new. shouldAcceptConnections := false. terminationSemaphore wait. self backgroundConnections copy do: [:i| i close]. serviceProcess := nil. servicePort := nil]. ! ! !Connection class methodsFor: 'event manager' stamp: 'taj 8/11/97 06:22'! eventsTriggered ^#(read: closed: opened) ! ! !Connection class methodsFor: 'waiting' stamp: 'taj 9/4/97 00:04'! wait EventSocket wait ! ! ConnectionError comment: 'This error is signalled whenever there is a problem with the Connection. Catch it with code like: [ ... ] on: ConnectionError do: [ ... ]'! EvaluationServer comment: 'This server evalutes all strings passed to it and returns the result. For example, ''2+2'' returns the object 4. '! !EvaluationServer methodsFor: 'from connection' stamp: 'taj 8/11/97 08:27'! eventRead: aString self nextPut: (Compiler evaluate: aString) ! ! EventSocket comment: 'EventSocket works just like the normal Socket, but it also triggers the following VisualSmalltalk events: #dataAvailable when there is something to be read from the socket #disconnected when the socket disconnects #connected when the socket connects Send the EventSocket startEvents to being event triggering. As an added bonus, when event triggering is enabled you need only close one of two communicating sockets; the other will close automatically after all data is read, and both will be automatically destroyed. '! !EventSocket methodsFor: 'event manager' stamp: 'taj 8/11/97 08:01'! startEvents monitoringProcess resume.! ! !EventSocket methodsFor: 'event manager' stamp: 'taj 10/18/97 09:03'! triggerSocketEventsOnce |status| socketHandle isNil ifTrue: [Processor terminateActive]. status := self status. openOnce ifFalse: [(status == Connected) ifTrue: [openOnce := true. self triggerEvent: #connected]] ifTrue: [self dataAvailable ifTrue: [self triggerEvent: #dataAvailable. ^self]. status = OtherEndClosed ifTrue: [self close. self destroy]. status = Unconnected ifTrue: [self destroy]]. ! ! !EventSocket methodsFor: 'private' stamp: 'taj 8/7/97 02:23'! actionLists ^actionLists ! ! !EventSocket methodsFor: 'private' stamp: 'taj 8/4/97 08:25'! delay ^delay! ! !EventSocket methodsFor: 'private' stamp: 'taj 9/29/97 16:32'! initialize self class initializeNetwork. super initialize. actionLists := Dictionary new. previousDataAvailable := false. openOnce := false. monitoringProcess := Process forContext: [[true] whileTrue: [self triggerSocketEventsOnce. self wait]] priority: Processor highIOPriority. ! ! !EventSocket methodsFor: 'private' stamp: 'taj 8/10/97 09:12'! release super release. monitoringProcess _ nil. actionLists _ Dictionary new.! ! !EventSocket methodsFor: 'socket overrides' stamp: 'taj 8/10/97 07:48'! close socketHandle isNil ifTrue: [^self]. super close.! ! !EventSocket methodsFor: 'socket overrides' stamp: 'taj 8/18/97 22:55'! dataAvailable socketHandle isNil ifTrue: [^false]. ^super dataAvailable.! ! !EventSocket methodsFor: 'socket overrides' stamp: 'taj 8/10/97 06:23'! destroy self triggerEvent: #disconnected. super destroy. self release. ! ! !EventSocket methodsFor: 'socket overrides' stamp: 'taj 8/8/97 19:54'! error: aString SocketError signal: aString! ! !EventSocket methodsFor: 'socket overrides' stamp: 'taj 8/8/97 21:22'! isConnected socketHandle isNil ifTrue: [^false]. ^super isConnected.! ! !EventSocket methodsFor: 'queries' stamp: 'taj 8/7/97 08:19'! remoteAddress ^self primSocketRemoteAddress: socketHandle! ! !EventSocket methodsFor: 'queries' stamp: 'taj 9/29/97 16:19'! status ^ self primSocketConnectionStatus: socketHandle. ! ! !EventSocket methodsFor: 'waiting' stamp: 'taj 9/29/97 16:29'! wait self class wait "semaphore wait"! ! !EventSocket methodsFor: 'waiting' stamp: 'taj 9/29/97 16:32'! waitForConnectionOrDataAvailableUntil: deadline "Wait up to the given millisecond clock time for a connection to be established. Return true if it is established by the deadline." [true] whileTrue: [self isConnected ifTrue: [^true]. self dataAvailable ifTrue: [^true]. Time millisecondClockValue >= deadline ifTrue: [^false]. self wait] ! ! !EventSocket methodsFor: 'waiting' stamp: 'taj 9/29/97 16:32'! waitForDisconnectionOrDataAvailable [true] whileTrue: [self dataAvailable ifTrue: [^#dataAvailable]. self isConnected ifFalse: [^#disconnected]. self wait] ! ! !EventSocket class methodsFor: 'image shutdown' stamp: 'taj 10/18/97 09:02'! shutDown self allInstances do: [:i| i destroy]. NetworkInitialized := false. ! ! !EventSocket class methodsFor: 'class initialization' stamp: 'taj 8/11/97 08:05'! initialize NetworkInitialized := false. ^super initialize! ! !EventSocket class methodsFor: 'class initialization' stamp: 'taj 8/11/97 08:06'! initializeNetwork NetworkInitialized ifFalse: [ Socket initializeNetwork: 0. NetworkInitialized := true].! ! !EventSocket class methodsFor: 'tests' stamp: 'taj 8/10/97 17:55'! clientServerTest "Socket clientServerTest" | sock1 sock2 bytesToSend sendBuf receiveBuf done bytesSent bytesReceived t | Transcript show: 'starting client/server test'; cr. Transcript show: 'initializing network'; cr. Socket initializeNetwork: 0. Transcript show: 'opening connection'; cr. sock1 _ self new. sock2 _ self new. self wireSocket: sock1. self wireSocket: sock2. sock1 listenOn: 54321. sock2 connectTo: (NetNameResolver localHostAddress) port: 54321. sock1 waitForConnectionUntil: self standardDeadline. sock2 waitForConnectionUntil: self standardDeadline. sock1 startEvents. sock2 startEvents. (sock1 isConnected) ifFalse: [self error: 'sock1 not connected']. (sock2 isConnected) ifFalse: [self error: 'sock2 not connected']. Transcript show: 'connection established'; cr. bytesToSend _ 1000000. sendBuf _ String new: 4000 withAll: $x. receiveBuf _ String new: 50000. done _ false. bytesSent _ bytesReceived _ 0. t _ Time millisecondsToRun: [ [done] whileFalse: [ (sock1 sendDone and: [bytesSent < bytesToSend]) ifTrue: [ bytesSent _ bytesSent + (sock1 sendData: sendBuf)]. sock2 dataAvailable ifTrue: [ bytesReceived _ bytesReceived + (sock2 receivedDataInto: receiveBuf)]. done _ (bytesSent >= bytesToSend) and: [bytesReceived = bytesSent]]]. Transcript show: 'closing connection'; cr. sock1 waitForSendDoneUntil: self standardDeadline. sock1 close. sock2 close. Transcript show: 'client/server test done; time = ', t printString; cr. Transcript show: (bytesSent // t) printString, ' kBytes/sec'; cr. ! ! !EventSocket class methodsFor: 'tests' stamp: 'taj 8/18/97 22:35'! showSocketDifferences | socket unixHost | unixHost := NetNameResolver addressFromString: '111.111.111.116'. socket _ Socket new connectTo: unixHost port: 79. socket waitForConnectionUntil: Socket standardDeadline. socket sendData: 'timjones' , (String with: Character cr with: Character linefeed). (Delay forSeconds: 2) wait. socket waitForDataUntil: Socket standardDeadline. socket receivedDataInto: (String new: 10000). socket isConnected ifTrue: [socket close. socket destroy. ^ 'Windows'] ifFalse: [socket close. socket destroy. ^ 'Mac'].! ! !EventSocket class methodsFor: 'tests' stamp: 'taj 8/10/97 17:47'! wireSocket: aSocket aSocket when: #dataAvailable do: [Transcript show: '*data available*']. aSocket when: #disconnected do: [Transcript show: '*disconnected*']. ! ! !EventSocket class methodsFor: 'event system' stamp: 'taj 8/10/97 07:59'! eventsTriggered ^#(dataAvailable disconnected connected)! ! !EventSocket class methodsFor: 'waiting' stamp: 'taj 9/4/97 00:01'! wait (Delay forMilliseconds: 100) wait! ! !ListeningSocketStream methodsFor: 'private' stamp: 'taj 10/17/97 21:38'! addASocket |socket| socket := EventSocket new. [socket listenOn: port] on: SocketError do: [socket destroy]. semaphore critical: [sockets add: socket]! ! !ListeningSocketStream methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 21:32'! next self addASocket. ^semaphore critical: [sockets removeFirst]! ! !ListeningSocketStream methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 21:34'! port: anInteger size: anotherInteger port := anInteger. sockets := OrderedCollection new: anotherInteger. semaphore := Semaphore forMutualExclusion. anotherInteger timesRepeat: [ self addASocket ]. ! ! !ListeningSocketStream methodsFor: 'as yet unclassified' stamp: 'taj 10/17/97 21:33'! release semaphore critical: [super release. sockets do: [:socket| socket close. socket destroy]. sockets := nil]! ! !ListeningSocketStream class methodsFor: 'as yet unclassified' stamp: 'taj 10/16/97 22:03'! port: anInteger size: anotherInteger ^self new port: anInteger size: anotherInteger! ! SocketError comment: 'This error is signalled whenever there is a problem with the EventSocket. Catch it with code like: [ ... ] on: SocketError do: [ ... ]'! !String methodsFor: 'connections' stamp: 'taj 8/7/97 21:08'! asAddress |addr| self isDottedAddress ifTrue: [^NetNameResolver addressFromString: self]. addr := NetNameResolver addressForName: self timeout: 30. addr isNil ifTrue: [ConnectionError signal: 'timeout resolving address']. ^addr! ! !String methodsFor: 'connections' stamp: 'taj 8/7/97 07:56'! asDottedAddress |addr s| self isDottedAddress ifTrue: [ ^self ]. addr := NetNameResolver addressForName: self timeout: 30. addr isNil ifTrue: [ConnectionError signal: 'timeout resolving address']. s _ WriteStream on: ''. 1 to: 3 do: [ :i | (addr at: i) printOn: s. s nextPut: $.]. (addr at: 4) printOn: s. ^ s contents ! ! !String methodsFor: 'connections' stamp: 'taj 8/7/97 11:34'! asTransportedObject |s rs object| s := RWBinaryOrTextStream on: self from: 1 to: self size. rs := ReferenceStream on: s. object := rs next. rs close. ^object ! ! !String methodsFor: 'connections' stamp: 'taj 8/7/97 07:50'! isDottedAddress (self occurrencesOf: $.) ~= 3 ifTrue: [ ^false ]. self do: [ :c | (c isDigit not and: [ c ~= $. ]) ifTrue: [ ^false ] ]. ^true! ! StringConnection comment: 'String Connections work exactly like connections, except that you can only send and receive strings. This allows you to easily communicate with non-Smalltalk TCP/IP systems. StringConnection sends all strings with CRLF termination, and can handle response strings with CR, LF, or CRLF used as the line terminator. The following methods are taken from the UnixHost class and show how easy it is: timestamp ^(StringConnection to: address port: 13) next finger: aString |connection stream| stream _ WriteStream on: ''''. connection := StringConnection to: self address port: 79. connection nextPut: aString. [connection atEnd] whileFalse: [stream nextPutAll: connection next;cr.]. ^stream contents webPage: page |connection stream| stream _ WriteStream on: ''''. connection := StringConnection to: address port: 80. connection nextPut: ''GET '',page. connection do: [:line| stream nextPutAll: line;cr]. ^stream contents tim jones (tim@thregecy.com)'! !StringConnection methodsFor: 'private' stamp: 'taj 8/19/97 12:22'! readLineFrom: aStream |line| line := WriteStream on: ''. [aStream atEnd] whileFalse: [(CrLf includes: aStream peek) ifTrue: [(CrLf includes: aStream peek) ifTrue: [aStream next]. (CrLf includes: aStream peek) ifTrue: [aStream next]. ^ line contents.]. line nextPut: aStream next]. ^false ! ! !StringConnection methodsFor: 'from connection' stamp: 'taj 10/10/97 20:51'! nextPut: aString self write: aString,(String with: Character cr with: Character linefeed). ! ! !StringConnection methodsFor: 'from connection' stamp: 'taj 8/14/97 07:18'! readObjects | buffer stream processedTo charactersLeft packet | bytesNeeded = 0 ifTrue: [bytesNeeded _ 1]. buffer _ self llRead: bytesNeeded. stream _ ReadStream on: buffer from: 1 to: bufferDataSize. processedTo _ stream position. [stream atEnd] whileFalse: [packet _ self readLineFrom: stream. packet = false ifTrue: [stream position: processedTo. charactersLeft _ bufferDataSize - stream position. remnant _ stream next: charactersLeft. bytesNeeded _ 1. ^ self]. readObjects add: packet. processedTo _ stream position]. remnant _ ''. bytesNeeded _ 0 ! ! DisplayServer comment: 'This server displays the printString of the objects it is sent on the Transcript.'! !DisplayServer methodsFor: 'from connection' stamp: 'taj 8/11/97 05:45'! eventRead: anObject Transcript show: anObject printString;cr.! ! !StringConnection class methodsFor: 'tests' stamp: 'taj 8/9/97 03:25'! finger: aString at: address " StringConnection finger: 'timjones' at: '111.111.111.116' " |connection stream| stream _ WriteStream on: ''. connection := StringConnection to: address port: 79. connection nextPut: aString. [connection atEnd] whileFalse: [stream nextPutAll: connection next;cr.]. ^stream contents! ! !StringConnection class methodsFor: 'tests' stamp: 'taj 8/9/97 17:40'! page: page at: address " StringConnection page: '/welcome.html' at: '111.111.111.116' " |connection stream| stream _ WriteStream on: ''. connection := StringConnection to: address port: 80. connection nextPut: 'GET ',page. [connection atEnd] whileFalse: [stream nextPutAll: connection next;cr.]. ^stream contents! ! !StringConnection class methodsFor: 'tests' stamp: 'taj 8/9/97 03:24'! timeAt: address " StringConnection timeAt: '111.111.111.116' " |connection| connection := StringConnection to: address port: 13. ^connection next! ! !StringConnection class methodsFor: 'private' stamp: 'taj 8/14/97 07:36'! initialize CrLf := String with: Character cr with: Character linefeed.! ! TimeServer comment: 'This server just sends out the current time and closes whenever a client connects.'! !TimeServer methodsFor: 'from connection' stamp: 'taj 8/10/97 05:31'! eventOpened self nextPut: Time now. self close. ! ! !UnixHost methodsFor: 'private' stamp: 'taj 8/9/97 18:19'! address: aString address := aString! ! !UnixHost methodsFor: 'queries' stamp: 'taj 8/9/97 18:18'! address ^address! ! !UnixHost methodsFor: 'queries' stamp: 'taj 8/9/97 18:20'! finger: aString |connection stream| stream _ WriteStream on: ''. connection := StringConnection to: self address port: 79. connection nextPut: aString. [connection atEnd] whileFalse: [stream nextPutAll: connection next;cr.]. ^stream contents! ! !UnixHost methodsFor: 'queries' stamp: 'taj 8/9/97 18:30'! timestamp ^(StringConnection to: address port: 13) next ! ! !UnixHost methodsFor: 'queries' stamp: 'taj 8/9/97 19:14'! webPage: page |connection stream| stream _ WriteStream on: ''. connection := StringConnection to: address port: 80. connection nextPut: 'GET ',page. connection do: [:line| stream nextPutAll: line;cr]. ^stream contents! ! !UnixHost class methodsFor: 'tests' stamp: 'taj 8/9/97 18:29'! test1 |warmspot| warmspot := UnixHost at: '111.111.111.116'. Transcript show: warmspot timestamp;cr. Transcript show: (warmspot finger: 'timjones');cr. Transcript show: (warmspot webPage: '/welcome.html');cr.! ! !UnixHost class methodsFor: 'instance creation' stamp: 'taj 8/9/97 18:19'! at: aString ^self new address: aString! ! EventSocket initialize! StringConnection initialize!