The Trunk: Network-ul.175.mcz

Levente Uzonyi uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ul.175.mcz

==================== Summary ====================

Name: Network-ul.175
Author: ul
Time: 27 March 2016, 4:03:32.820897 am
UUID: 43c19bb9-e215-4b46-ad56-9a6466e93dc9
Ancestors: Network-ul.174

Socket changes:
- removed RegistryThreshold, because it was unused
- added DefaultReceiveBufferSize and DefaultSendBufferSize, both with the value of 8192. These can later be turned into preferences or something. All socket initialization methods use these variables. And this is the default size of a sent chunk in #sendData: too.
- don't waste seconds trying to look up the hostname for 0.0.0.0, just return nil in #peerName
- simplified #sendSomeData:startIndex:count:for:,
#waitForConnectionUntil:, #waitForDataFor:ifClosed:ifTimedOut:, #waitForDataIfClosed: and #waitForSendDoneFor:
- added #isOtherEndConnected and #isThisEndConnected to let waiting be possible in these cases as well, but they are not in use yet, because there are some issues to solve first

=============== Diff against Network-ul.174 ===============

Item was changed:
  Object subclass: #Socket
  instanceVariableNames: 'semaphore socketHandle readSemaphore writeSemaphore'
+ classVariableNames: 'Connected DeadServer DefaultReceiveBufferSize DefaultSendBufferSize InvalidSocket MaximumReadSemaphoreWaitTimeout OtherEndClosed Registry TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection'
- classVariableNames: 'Connected DeadServer InvalidSocket MaximumReadSemaphoreWaitTimeout OtherEndClosed Registry RegistryThreshold TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection'
  poolDictionaries: ''
  category: 'Network-Kernel'!
 
  !Socket commentStamp: 'gk 12/13/2005 00:43' prior: 0!
  A Socket represents a network connection point. Current sockets are designed to support the TCP/IP and UDP protocols. Sockets are the lowest level of networking object in Squeak and are not normally used directly. SocketStream is a higher level object wrapping a Socket in a stream like protocol.
 
  ProtocolClient and subclasses are in turn wrappers around a SocketStream to provide support for specific network protocols such as POP, NNTP, HTTP, and FTP.!

Item was changed:
  ----- Method: Socket class>>initialize (in category 'class initialization') -----
  initialize
  "Socket initialize"
 
  "Socket Types"
  TCPSocketType := 0.
  UDPSocketType := 1.
 
  "Socket Status Values"
  InvalidSocket := -1.
  Unconnected := 0.
  WaitingForConnection := 1.
  Connected := 2.
  OtherEndClosed := 3.
  ThisEndClosed := 4.
+
+ "Default buffer sizes"
+ DefaultReceiveBufferSize := 8192.
+ DefaultSendBufferSize := 8192!
-
- RegistryThreshold := 100. "# of sockets"!

Item was removed:
- ----- Method: Socket class>>registryThreshold (in category 'registry') -----
- registryThreshold
- "Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
- ^RegistryThreshold!

Item was removed:
- ----- Method: Socket class>>registryThreshold: (in category 'registry') -----
- registryThreshold: aNumber
- "Return the registry threshold above which socket creation may fail due to too many already open sockets. If the threshold is reached, a full GC will be issued if the creation of a socket fails."
- RegistryThreshold := aNumber!

Item was changed:
  ----- Method: Socket>>acceptFrom: (in category 'initialize-destroy') -----
  acceptFrom: aSocket
  "Initialize a new socket handle from an accept call"
 
  self initializeSocketHandleUsing: [ :semaIndex :readSemaIndex :writeSemaIndex |
  self
  primAcceptFrom: aSocket socketHandle
+ receiveBufferSize: DefaultReceiveBufferSize
+ sendBufSize: DefaultSendBufferSize
- receiveBufferSize: 8000
- sendBufSize: 8000
  semaIndex: semaIndex
  readSemaIndex: readSemaIndex
  writeSemaIndex: writeSemaIndex ]!

Item was changed:
  ----- Method: Socket>>initialize: (in category 'initialize-destroy') -----
  initialize: socketType
  "Initialize a new socket handle. If socket creation fails, socketHandle will be set to nil."
 
  self initializeSocketHandleUsing: [ :semaIndex :readSemaIndex :writeSemaIndex |
  self primSocketCreateNetwork: 0
  type: socketType
+ receiveBufferSize: DefaultReceiveBufferSize
+ sendBufSize: DefaultSendBufferSize
- receiveBufferSize: 8000
- sendBufSize: 8000
  semaIndex: semaIndex
  readSemaIndex: readSemaIndex
  writeSemaIndex: writeSemaIndex ]!

Item was changed:
  ----- Method: Socket>>initialize:family: (in category 'initialize-destroy') -----
  initialize: socketType family: family
  "Initialize a new socket handle. If socket creation fails, socketHandle will be set to nil."
 
  NetNameResolver useOldNetwork ifTrue: [ ^self initialize: socketType ].
  self initializeSocketHandleUsing: [ :semaIndex :readSemaIndex :writeSemaIndex |
  self primSocketCreateNetwork: family
  type: socketType
+ receiveBufferSize: DefaultReceiveBufferSize
+ sendBufSize: DefaultSendBufferSize
- receiveBufferSize: 8000
- sendBufSize: 8000
  semaIndex: semaIndex
  readSemaIndex: readSemaIndex
  writeSemaIndex: writeSemaIndex ]!

Item was added:
+ ----- Method: Socket>>isOtherEndConnected (in category 'queries') -----
+ isOtherEndConnected
+ "Return true if this socket is connected, or this end has closed the connection but not the other end, so we can still send data."
+
+ | state |
+ socketHandle ifNil: [ ^false ].
+ (state := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ].
+ ^state == ThisEndClosed
+ !

Item was added:
+ ----- Method: Socket>>isThisEndConnected (in category 'queries') -----
+ isThisEndConnected
+ "Return true if this socket is connected, other the other end has closed the connection but not this end, so we can still receive data."
+
+ | state |
+ socketHandle ifNil: [ ^false ].
+ (state := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ].
+ ^state == OtherEndClosed
+ !

Item was changed:
  ----- Method: Socket>>peerName (in category 'accessing') -----
  peerName
  "Return the name of the host I'm connected to, or nil if its name isn't known to the domain name server or the request times out."
  "Note: Slow. Calls the domain name server, taking up to 20 seconds to time out. Even when sucessful, delays of up to 13 seconds have been observed during periods of high network load."
 
+ | remoteAddress |
+ NetNameResolver useOldNetwork ifFalse: [ ^self remoteAddress hostName ].
+ (remoteAddress := self remoteAddress) = #[0 0 0 0] ifTrue: [
+ "Don't wait for the lookup"
+ ^nil ].
+ ^NetNameResolver
+ nameForAddress:  remoteAddress
+ timeout: 20!
- ^NetNameResolver useOldNetwork
- ifFalse: [ self remoteAddress hostName ]
- ifTrue: [ NetNameResolver
- nameForAddress: self remoteAddress
- timeout: 20 ]!

Item was changed:
  ----- Method: Socket>>sendData: (in category 'sending') -----
  sendData: aStringOrByteArray
  "Send all of the data in the given array, even if it requires multiple calls to send it all. Return the number of bytes sent."
 
  "An experimental version use on slow lines: Longer timeout and smaller writes to try to avoid spurious timeouts."
 
  | bytesSent bytesToSend count |
  bytesToSend := aStringOrByteArray size.
  bytesSent := 0.
  [bytesSent < bytesToSend] whileTrue: [
  (self waitForSendDoneFor: 60)
  ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
  count := self primSocket: socketHandle
  sendData: aStringOrByteArray
  startIndex: bytesSent + 1
+ count: (bytesToSend - bytesSent min: DefaultSendBufferSize).
- count: (bytesToSend - bytesSent min: 5000).
  bytesSent := bytesSent + count].
 
  ^ bytesSent
  !

Item was changed:
  ----- Method: Socket>>sendSomeData:startIndex:count:for: (in category 'sending') -----
  sendSomeData: aStringOrByteArray startIndex: startIndex count: count for: aTimeoutInSeconds
  "Send up to count bytes of the given data starting at the given index. Answer the number of bytes actually sent."
  "Note: This operation may have to be repeated multiple times to send a large amount of data."
 
+ (self waitForSendDoneFor: aTimeoutInSeconds) ifFalse: [
+ ConnectionTimedOut signal: 'send data timeout; data not sent'.
+ ^0 ].
+ ^self primSocket: socketHandle
+ sendData: aStringOrByteArray
+ startIndex: startIndex
+ count: count!
- | bytesSent |
- (self waitForSendDoneFor: aTimeoutInSeconds)
- ifTrue: [
- bytesSent := self primSocket: socketHandle
- sendData: aStringOrByteArray
- startIndex: startIndex
- count: count]
- ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
- ^ bytesSent
- !

Item was changed:
  ----- Method: Socket>>waitForConnectionUntil: (in category 'waiting') -----
  waitForConnectionUntil: deadline
  "Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."
 
+ | status waitTime |
+ [
+ (status := self primSocketConnectionStatus: socketHandle) == Connected ifTrue: [ ^true ].
+ status == WaitingForConnection ifFalse: [ ^false ].
+ (waitTime := deadline - Time millisecondClockValue) > 0 ifFalse: [ ^false ].
+ semaphore waitTimeoutMSecs: waitTime ] repeat!
- | status |
- status := self primSocketConnectionStatus: socketHandle.
- self isConnected ifTrue: [^status].
- [(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
- whileTrue: [
- semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
- status := self primSocketConnectionStatus: socketHandle].
-
- ^ status = Connected
- !

Item was changed:
  ----- Method: Socket>>waitForDataFor:ifClosed:ifTimedOut: (in category 'waiting') -----
  waitForDataFor: timeout ifClosed: closedBlock ifTimedOut: timedOutBlock
  "Wait for the given nr of seconds for data to arrive."
 
  | startTime msecsDelta |
+ socketHandle ifNil: [ ^closedBlock value ].
  startTime := Time millisecondClockValue.
  msecsDelta := (timeout * 1000) truncated.
+ [
+ (self primSocketReceiveDataAvailable: socketHandle) ifTrue: [ ^self ].
+ self isConnected ifFalse: [ ^closedBlock value ].
+ (Time millisecondsSince: startTime) < msecsDelta ifFalse: [ ^timedOutBlock value ].
- [(Time millisecondsSince: startTime) < msecsDelta] whileTrue: [
- (self primSocketReceiveDataAvailable: socketHandle)
- ifTrue: [^self].
- self isConnected
- ifFalse: [^closedBlock value].
  "Providing a maximum for the time for waiting is a workaround for a VM bug which causes sockets waiting for data forever in some rare cases, because the semaphore doesn't get signaled. Remove the ""min: self class maximumReadSemaphoreWaitTimeout"" part when the bug is fixed."
  readSemaphore waitTimeoutMSecs:
+ (msecsDelta - (Time millisecondsSince: startTime) min: self class maximumReadSemaphoreWaitTimeout) ] repeat!
- (msecsDelta - (Time millisecondsSince: startTime) min: self class maximumReadSemaphoreWaitTimeout).
- ].
-
- (self primSocketReceiveDataAvailable: socketHandle)
- ifFalse: [
- self isConnected
- ifTrue: [^timedOutBlock value]
- ifFalse: [^closedBlock value]].!

Item was changed:
  ----- Method: Socket>>waitForDataIfClosed: (in category 'waiting') -----
  waitForDataIfClosed: closedBlock
  "Wait indefinitely for data to arrive.  This method will block until
  data is available or the socket is closed."
 
+ socketHandle ifNil: [ ^closedBlock value ].
+ [
+ (self primSocketReceiveDataAvailable: socketHandle) ifTrue: [ ^self ].
+ self isConnected ifFalse: [ ^closedBlock value ].
+ "ul 8/13/2014 21:16
+  Providing a maximum for the time for waiting is a workaround for a VM bug which
+  causes sockets waiting for data forever in some rare cases, because the semaphore
+  doesn't get signaled. Replace the ""waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout""
+  part with ""wait"" when the bug is fixed."
+ readSemaphore waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout ] repeat!
- [(socketHandle ~~ nil
-  and: [self primSocketReceiveDataAvailable: socketHandle]) ifTrue:
- [^self].
- self isConnected ifFalse:
- [^closedBlock value].
- "ul 8/13/2014 21:16
-  Providing a maximum for the time for waiting is a workaround for a VM bug which
-  causes sockets waiting for data forever in some rare cases, because the semaphore
-  doesn't get signaled. Replace the ""waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout""
-  part with ""wait"" when the bug is fixed."
- readSemaphore waitTimeoutMSecs: self class maximumReadSemaphoreWaitTimeout] repeat!

Item was changed:
  ----- Method: Socket>>waitForSendDoneFor: (in category 'waiting') -----
  waitForSendDoneFor: timeout
  "Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not."
 
+ | startTime msecsDelta msecsEllapsed |
- | startTime msecsDelta msecsEllapsed sendDone |
  startTime := Time millisecondClockValue.
  msecsDelta := (timeout * 1000) truncated.
+ [
+ (self primSocketSendDone: socketHandle) ifTrue: [ ^true ].
+ self isConnected ifFalse: [ ^false ].
+ (msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta ifFalse: [ ^false ].
+ writeSemaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed ] repeat!
- [(sendDone := self primSocketSendDone: socketHandle) not and: [ self isConnected
- "Connection end and final data can happen fast, so test in this order"
- and: [(msecsEllapsed := Time millisecondsSince: startTime) < msecsDelta]]] whileTrue: [
- writeSemaphore waitTimeoutMSecs: msecsDelta - msecsEllapsed].
-
- ^ sendDone!