'From Squeak 1.2 of June 29, 1997 on 2 August 1997 at 9:09:53 pm'!Object subclass: #Socket instanceVariableNames: 'socketHandle ' classVariableNames: 'Connected CR CrCr CrLf CrLfCrLf HTTPBlabEmail HTTPPort HTTPProxy LF OtherEndClosed ParamDelimiters SpaceLF TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection ' poolDictionaries: '' category: 'System-Network'! !Socket reorganize! ('initialize-destroy' destroy initialize:) ('queries' address dataAvailable isConnected isUnconnected peerAddress peerPort port sendDone status) ('connection open/close' close closeAndDestroy connectTo:port: destroyAll listenOn:) ('sending-receiving' discardReceivedData receivedDataInto: sendData: sendData:count:) ('datagrams' receivedDataInto:fromHost:port: sendData:toHost:port: setPeer:port: setPort:) ('other' displayString: endsWithSinglePeriodLine: getAndShowMultilineResponse getAndShowResponse getMultilineResponse getResponse getResponse: getResponseNoLF getResponseUpTo: getRestOfBuffer:totalLength: sendCommand:) ('waiting' retry:asking:ifGiveUp: waitForConnectionUntil: waitForDataAskingUserEvery: waitForDataUntil: waitForDisconnectionUntil: waitForOtherEndToCloseUntil: waitForSendDoneUntil:) ('primitives' primSocket:connectTo:port: primSocket:listenOn: primSocket:receiveDataInto:startingAt:count: primSocket:sendData:startIndex:count: primSocket:sendData:toHost:port:startIndex:count: primSocket:setPort: primSocketAbortConnection: primSocketCloseConnection: primSocketConnectionStatus: primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaphoreID: primSocketDestroy: primSocketError: primSocketLocalAddress: primSocketLocalPort: primSocketReceiveDataAvailable: primSocketRemoteAddress: primSocketRemotePort: primSocketSendDone:) ! !Socket methodsFor: 'initialize-destroy' stamp: 'ikp 8/2/97 12:55'! initialize: socketType "Create a new socket handle for the given socketType." socketHandle _ self primSocketCreateNetwork: 0 type: socketType receiveBufferSize: 8000 sendBufSize: 8000 semaphoreID: 0. ! ! !Socket methodsFor: 'queries' stamp: 'ikp 8/2/97 15:07'! address "Answer the IP address bound to the socket." ^self primSocketLocalAddress: socketHandle! ! !Socket methodsFor: 'queries' stamp: 'ikp 8/2/97 15:06'! peerAddress "Answer the IP address of the socket's peer." ^self primSocketRemoteAddress: socketHandle! ! !Socket methodsFor: 'queries' stamp: 'ikp 8/2/97 15:06'! peerPort "Answer the port number of the socket's peer." ^self primSocketRemotePort: socketHandle! ! !Socket methodsFor: 'queries' stamp: 'ikp 8/2/97 15:07'! port "Answer the port number bound to the socket." ^self primSocketLocalPort: socketHandle! ! !Socket methodsFor: 'sending-receiving' stamp: 'ikp 8/2/97 00:13'! discardReceivedData "Discard any data received up until now." | buf totalBytesRead | buf _ String new: 1000. totalBytesRead _ 0. [self isConnected and: [self dataAvailable]] whileTrue: [ totalBytesRead _ totalBytesRead + (self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size)]. ^ totalBytesRead! ! !Socket methodsFor: 'sending-receiving' stamp: 'ikp 8/2/97 15:40'! sendData: aStringOrByteArray "Send some or all of the given data and return the number of bytes actually sent." | bytesSent | (self waitForSendDoneUntil: (Socket deadlineSecs: 20)) ifTrue: [ bytesSent _ self primSocket: socketHandle sendData: aStringOrByteArray startIndex: 1 count: aStringOrByteArray size. ] ifFalse: [ self error: 'send data timeout; data not sent']. ^ bytesSent! ! !Socket methodsFor: 'sending-receiving' stamp: 'ikp 8/2/97 20:43'! sendData: aStringOrByteArray count: bytesToSend "Send some or all of the given data and return the number of bytes actually sent." | bytesSent | (self waitForSendDoneUntil: (Socket deadlineSecs: 20)) ifTrue: [ bytesSent _ self primSocket: socketHandle sendData: aStringOrByteArray startIndex: 1 count: (aStringOrByteArray size min: bytesToSend). ] ifFalse: [ self error: 'send data timeout; data not sent']. ^ bytesSent! ! !Socket methodsFor: 'datagrams' stamp: 'ikp 8/2/97 15:50'! receivedDataInto: aStringOrByteArray fromHost: hostAddress port: portNumber "Receive a UDP packet from the given hostAddress/portNumber, storing the data in the given buffer, and return the number of bytes received. Note the given buffer may be only partially filled by the received data." self setPeer: hostAddress port: portNumber. ^self receivedDataInto: aStringOrByteArray! ! !Socket methodsFor: 'datagrams' stamp: 'ikp 8/2/97 15:50'! sendData: aStringOrByteArray toHost: hostAddress port: portNumber "Send a UDP packet containing the given data to the specified host/port." self setPeer: hostAddress port: portNumber. ^self sendData: aStringOrByteArray.! ! !Socket methodsFor: 'datagrams' stamp: 'ikp 8/2/97 15:19'! setPeer: hostAddress port: port "Set the default send/recv address." self primSocket: socketHandle connectTo: hostAddress port: port. ! ! !Socket methodsFor: 'datagrams' stamp: 'ikp 8/2/97 16:01'! setPort: port "Associate a local port number with a UDP socket. Not applicable to TCP sockets." self primSocket: socketHandle setPort: port. ! ! !Socket methodsFor: 'other' stamp: 'ikp 8/2/97 15:45'! getResponseNoLF "Get the response to the last command." | buf response bytesRead c | (self waitForDataUntil: (Socket deadlineSecs: 20)) ifFalse: [ self error: 'getResponse timeout']. buf _ String new: 1000. response _ WriteStream on: ''. [self dataAvailable] whileTrue: [ bytesRead _ self primSocket: socketHandle receiveDataInto: buf startingAt: 1 count: buf size. 1 to: bytesRead do: [ :i | (c _ buf at: i) ~= LF ifTrue: [response nextPut: c]]]. ^ response contents ! ! !Socket methodsFor: 'primitives' stamp: 'ikp 8/2/97 14:20'! primSocket: socketID sendData: aStringOrByteArray toHost: hostAddress port: portNumber startIndex: startIndex count: count "Send data to the remote host through the given socket starting with the given byte index of the given byte array. The remote host is given by hostAddress and portNumber. Normally applied to a UDP socket, although the primitive will succeed if a connected TCP socket is used with the peer's address equal to hostAddress and portNumber. The data sent is 'pushed' immediately. Return the number of bytes of data actually sent; any remaining data should be re-submitted for sending after the current send operation has completed." "Note: In general, it many take several sendData calls to transmit a large data array since the data is sent in send-buffer-sized chunks (for UDP this is often approximately 8 Kbytes). The size of the send buffer is determined when the socket is created." "NOTE: THIS IS THE WRONG PRIMITIVE NUMBER!! THIS PRIMITIVE REQUIRES A NEW VM." "" self primitiveFailed ! ! !Socket methodsFor: 'primitives' stamp: 'ikp 8/2/97 14:15'! primSocket: socketID setPort: port "Set the local port associated with a UDP socket. Note: this primitive is overloaded. The primitive will not fail on a TCP socket, but the effects will not be what was desired. Best solution would be to split Socket into two subclasses, TCPSocket and UDPSocket." self primitiveFailed ! ! !Socket methodsFor: 'primitives' stamp: 'ikp 8/2/97 12:54'! primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaphoreID: semaIndex "Return a new socket handle for a socket of the given type and buffer sizes. The netType parameter is platform dependent and can be used to encode both the protocol type (IP, Xerox XNS, etc.) and/or the physical network interface to use if this host is connected to multiple networks. A zero netType means to use IP protocols and the primary (or only) network interface. The socketType parameter specifies: 0 reliable stream socket (TCP if the protocol is IP) 1 unreliable datagram socket (UDP if the protocol is IP) [NOTE: UDP is not yet implemented] The buffer size parameters allow performance to be tuned to the application. For example, a larger receive buffer should be used when the application expects to be receiving large amounts of data, especially from a host that is far away. These values are considered requests only; the underlying implementation will ensure that the buffer sizes actually used are within allowable bounds. Note that memory may be limited, so an application that keeps many sockets open should use smaller buffer sizes. If non-zero, semaIndex is the index of a VM semaphore associated with this socket. This semaphore will be signalled when the socket status changes, such as when data arrives or a send complete. All processes waiting on the semaphore will be awoken for each such event; each process must then query the socket state to figure out if the conditions they are waiting for have been met and respond accordingly. For example, a process waiting to send some data can see if the last send has completed." self primitiveFailed ! ! !Socket class methodsFor: 'instance creation' stamp: 'ikp 8/2/97 13:01'! new "Create a TCP socket by default." ^self newTCP.! ! !Socket class methodsFor: 'instance creation' stamp: 'ikp 8/2/97 12:56'! newTCP "Create a socket and initialise it for TCP" ^ super new initialize: TCPSocketType! ! !Socket class methodsFor: 'instance creation' stamp: 'ikp 8/2/97 12:56'! newUDP "Create a socket and initialise it for UDP" ^ super new initialize: UDPSocketType! ! !Socket class methodsFor: 'class initialization' stamp: 'ikp 8/2/97 12:54'! initialize "Socket initialize" "Socket Types" TCPSocketType _ 0. UDPSocketType _ 1. "Socket Status Values" Unconnected _ 0. WaitingForConnection _ 1. Connected _ 2. OtherEndClosed _ 3. ThisEndClosed _ 4. "Build a string for command line termination." CR _ Character cr. LF _ Character linefeed. CrLf _ String with: CR with: LF. CrCr _ String with: CR with: CR. CrLfCrLf _ CrLf, CrLf. "blank line" ParamDelimiters _ ' ',CrLf. HTTPPort _ 80. HTTPProxy _ nil. HTTPBlabEmail _ ''. " 'From: tedk@disney.com', CrLf " ! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 21:09'! clientServerTestUDP "Socket clientServerTestUDP" "Performa 6400/200, Linux-PPC 2.1.24: client/server UDP test done; time = 2820 2500 packets, 10000000 bytes sent (3546 kBytes/sec) 2500 packets, 10000000 bytes received (3546 kBytes/sec) 4000 bytes/packet, 886 packets/sec, 0 packets dropped" | sock1 sock2 bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t | Transcript show: 'starting client/server UDP test'; cr. Transcript show: 'initializing network'; cr. Socket initializeNetwork: 0. Transcript show: 'creating endpoints'; cr. sock1 _ Socket newUDP. "the sender" sock2 _ Socket newUDP. "the recipient" sock2 setPort: 54321. sock1 setPeer: (NetNameResolver localHostAddress) port: (sock2 port). Transcript show: 'endpoints created'; cr. bytesToSend _ 10000000. sendBuf _ String new: 4000 withAll: $x. receiveBuf _ String new: 50000. done _ false. bytesSent _ bytesReceived _ packetsSent _ packetsReceived _ 0. t _ Time millisecondsToRun: [ [done] whileFalse: [ (sock1 sendDone and: [bytesSent < bytesToSend]) ifTrue: [ packetsSent _ packetsSent + 1. bytesSent _ bytesSent + (sock1 sendData: sendBuf)]. sock2 dataAvailable ifTrue: [ packetsReceived _ packetsReceived + 1. bytesReceived _ bytesReceived + (sock2 receivedDataInto: receiveBuf)]. done _ (bytesSent >= bytesToSend)]]. Transcript show: 'closing endpoints'; cr. sock1 waitForSendDoneUntil: self standardDeadline. sock1 close. bytesReceived _ bytesReceived + sock2 discardReceivedData. sock2 close. sock1 destroy. sock2 destroy. Transcript show: 'client/server UDP test done; time = ', t printString; cr. Transcript show: packetsSent printString, ' packets, ', bytesSent printString, ' bytes sent (', (bytesSent // t) printString, ' kBytes/sec)'; cr. Transcript show: packetsReceived printString, ' packets, ', bytesReceived printString, ' bytes received (', (bytesReceived // t) printString, ' kBytes/sec)'; cr. Transcript show: (bytesSent // packetsSent) printString, ' bytes/packet, ', (packetsReceived * 1000 // t) printString, ' packets/sec, ', (packetsSent - packetsReceived) printString, ' packets dropped'; cr.! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 20:47'! remoteTestClientTCP "FIRST start up another image, and execute: Socket remoteTestServerTCP. THEN come back to this image and execute:" "Socket remoteTestClientTCP" "Performa 6400/200, Linux-PPC 2.1.24, both images on same CPU: remoteClient TCP test done; time = 5680 250 packets, 1000000 bytes sent (176 kBytes/sec) 60 packets, 1000000 bytes received (176 kBytes/sec)" | socket bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t | Transcript show: 'starting client/server TCP test'; cr. Socket initializeNetwork: 0. socket _ Socket newTCP. socket connectTo: (NetNameResolver localHostAddress) port: 54321. Transcript show: 'client endpoint created'; cr. bytesToSend _ 1000000. sendBuf _ String new: 4000 withAll: $x. receiveBuf _ String new: 50000. done _ false. bytesSent _ bytesReceived _ packetsSent _ packetsReceived _ 0. t _ Time millisecondsToRun: [ [done] whileFalse: [(socket sendDone and: [bytesSent < bytesToSend]) ifTrue: [packetsSent _ packetsSent + 1. bytesSent _ bytesSent + (socket sendData: sendBuf)]. socket dataAvailable ifTrue: [packetsReceived _ packetsReceived + 1. bytesReceived _ bytesReceived + (socket receivedDataInto: receiveBuf)]. done _ (bytesSent >= bytesToSend)]. ]. [bytesReceived < bytesToSend] whileTrue: [packetsReceived _ packetsReceived + 1. bytesReceived _ bytesReceived + (socket receivedDataInto: receiveBuf)]. socket closeAndDestroy. Transcript show: 'remoteClient TCP test done; time = ', t printString; cr. Transcript show: packetsSent printString, ' packets, ', bytesSent printString, ' bytes sent (', (bytesSent // t) printString, ' kBytes/sec)'; cr. Transcript show: packetsReceived printString, ' packets, ', bytesReceived printString, ' bytes received (', (bytesReceived // t) printString, ' kBytes/sec)'; cr.! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 20:24'! remoteTestClientUDP "FIRST start up another image, and execute: Socket remoteTestServerUDP. THEN come back to this image and execute:" "Socket remoteTestClientUDP" "Performa 6400/200, Linux-PPC 2.1.24: remoteClient UDP test done; time = 4580 2500 packets, 10000000 bytes sent (2183 kBytes/sec) 180 packets, 720000 bytes received (157 kBytes/sec) 4000 bytes/packet, 39 packets/sec, 2320 packets dropped" | socket bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t | Transcript show: 'starting client/server UDP test'; cr. Socket initializeNetwork: 0. socket _ Socket newUDP. socket setPeer: (NetNameResolver localHostAddress) port: 54321. Transcript show: 'client endpoint created'; cr. bytesToSend _ 10000000. sendBuf _ String new: 4000 withAll: $x. receiveBuf _ String new: 50000. done _ false. bytesSent _ bytesReceived _ packetsSent _ packetsReceived _ 0. t _ Time millisecondsToRun: [ [done] whileFalse: [(socket sendDone and: [bytesSent < bytesToSend]) ifTrue: [packetsSent _ packetsSent + 1. bytesSent _ bytesSent + (socket sendData: sendBuf)]. socket dataAvailable ifTrue: [packetsReceived _ packetsReceived + 1. bytesReceived _ bytesReceived + (socket receivedDataInto: receiveBuf)]. done _ (bytesSent >= bytesToSend)]. ]. [socket dataAvailable] whileTrue: [packetsReceived _ packetsReceived + 1. bytesReceived _ bytesReceived + (socket receivedDataInto: receiveBuf)]. socket closeAndDestroy. Transcript show: 'remoteClient UDP test done; time = ', t printString; cr. Transcript show: packetsSent printString, ' packets, ', bytesSent printString, ' bytes sent (', (bytesSent // t) printString, ' kBytes/sec)'; cr. Transcript show: packetsReceived printString, ' packets, ', bytesReceived printString, ' bytes received (', (bytesReceived // t) printString, ' kBytes/sec)'; cr. Transcript show: (bytesSent // packetsSent) printString, ' bytes/packet, ', (packetsReceived * 1000 // t) printString, ' packets/sec, ', (packetsSent - packetsReceived) printString, ' packets dropped'; cr.! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 20:44'! remoteTestServerTCP "See remoteTestClientTCP for instructions on running this method." "Socket remoteTestServerTCP" | socket buffer n | Socket initializeNetwork: 0. socket _ Socket newTCP. socket listenOn: 54321. Transcript show: 'server endpoint created -- run client test in other image'; cr. buffer _ String new: 4000. socket waitForConnectionUntil: self standardDeadline. [socket isConnected] whileTrue: [ socket dataAvailable ifTrue: [n _ socket receivedDataInto: buffer. socket waitForSendDoneUntil: self standardDeadline. socket sendData: buffer count: n]]. socket closeAndDestroy. Transcript cr; show: 'server endpoint destroyed'; cr.! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 20:19'! remoteTestServerUDP "See remoteTestClientUDP for instructions on running this method." "Socket remoteTestServerUDP" | socket buffer | Socket initializeNetwork: 0. socket _ Socket newUDP. socket setPort: 54321. Transcript show: 'server endpoint created -- run client test in other image'; cr. buffer _ String new: 4000. [true] whileTrue: [ socket dataAvailable ifTrue: [socket receivedDataInto: buffer. socket sendData: buffer]]. ! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 13:15'! timeTest "Socket timeTest" | serverName serverAddr s | Socket initializeNetwork: 0. serverName _ FillInTheBlank request: 'What is your time server?' initialAnswer: 'localhost'. serverAddr _ NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ', serverName]. s _ Socket new. Transcript show: '---------- Connecting ----------'; cr. s connectTo: serverAddr port: 13. "13 is the 'daytime' port number" s waitForConnectionUntil: (self deadlineSecs: 1). Transcript show: 'the time server reports: ' , s getResponseNoLF. s closeAndDestroy. Transcript show: '---------- Connection Closed ----------'; cr. ! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 16:04'! timeTestUDP "Socket timeTestUDP" | serverName serverAddr s | Socket initializeNetwork: 0. serverName _ FillInTheBlank request: 'What is your time server?' initialAnswer: 'localhost'. serverAddr _ NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ', serverName]. s _ Socket newUDP. "a 'random' port number will be allocated by the system" "Send a packet to the daytime port and it will reply with the current date." Transcript show: '---------- Sending datagram from port ' , s port printString , ' ----------'; cr. s sendData: '!!' toHost: serverAddr port: 13. "13 is the daytime service" Transcript show: 'the time server reports: ' , s getResponseNoLF. s closeAndDestroy. Transcript show: '---------- Socket closed ----------'; cr. ! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 16:04'! timeTestUDP2 "Socket timeTestUDP2" | serverName serverAddr s | Socket initializeNetwork: 0. serverName _ FillInTheBlank request: 'What is your time server?' initialAnswer: 'localhost'. serverAddr _ NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ', serverName]. s _ Socket newUDP. "The following associates a port with the UDP socket, but does NOT create a connectable endpoint" s setPort: 54321. "Send a packet to the daytime port and it will reply with the current date." Transcript show: '---------- Sending datagram from port ' , s port printString , ' ----------'; cr. s sendData: '!!' toHost: serverAddr port: 13. Transcript show: 'the time server reports: ' , s getResponseNoLF. s closeAndDestroy. Transcript show: '---------- Socket closed ----------'; cr. ! ! !Socket class methodsFor: 'examples' stamp: 'ikp 8/2/97 16:04'! timeTestUDP3 "Socket timeTestUDP3" | serverName serverAddr s | Socket initializeNetwork: 0. serverName _ FillInTheBlank request: 'What is your time server?' initialAnswer: 'localhost'. serverAddr _ NetNameResolver addressForName: serverName timeout: 10. serverAddr = nil ifTrue: [self error: 'Could not find the address for ', serverName]. s _ Socket newUDP. "The following associates a port with the UDP socket, but does NOT create a connectable endpoint" s setPort: (Socket wildcardPort). "explicitly request a default port number" "Send a packet to the daytime port and it will reply with the current date." Transcript show: '---------- Sending datagram from port ' , s port printString , ' ----------'; cr. s sendData: '!!' toHost: serverAddr port: 13. Transcript show: 'the time server reports: ' , s getResponseNoLF. s closeAndDestroy. Transcript show: '---------- Socket closed ----------'; cr. ! ! !Socket class methodsFor: 'utilities' stamp: 'ikp 8/2/97 15:57'! wildcardAddress "Answer a don't-care address for use with UDP sockets." ^ByteArray new: 4 "0.0.0.0"! ! !Socket class methodsFor: 'utilities' stamp: 'ikp 8/2/97 15:57'! wildcardPort "Answer a don't-care port for use with UDP sockets. (The system will allocate an unused port number to the socket.)" ^0! ! Socket removeSelector: #initialize! Socket initialize!