Status: FixedWaitingToBePharoed
Owner: stephane.ducasse
Labels: Milestone-1.3 Type-Squeak
New issue 3349 by stephane.ducasse: Some network fixes
http://code.google.com/p/pharo/issues/detail?id=3349
Levente Uzonyi uploaded a new version of Network to project The Trunk:
http://source.squeak.org/trunk/Network-ul.99.mcz
==================== Summary ====================
Name: Network-ul.99
Author: ul
Time: 25 November 2010, 11:25:58.723 pm
UUID: 26c053e2-d198-0144-a3c9-c8181481e3da
Ancestors: Network-ar.98
- fixed clock rollover issues (http://bugs.squeak.org/view.php?id=7343
http://bugs.squeak.org/view.php?id=6857 )
- replaced #waitForConnectionUntil: sends to #waitForConnectionFor: sends
in SocksSocket
- simplified a few methods (some are from Pharo)
=============== Diff against Network-ar.98 ===============
Item was changed:
----- Method: ConnectionQueue>>listenLoop (in category 'private') -----
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."
| 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
+ waitForAcceptFor: 10
+ ifTimedOut: [ nil ].
- newConnection := [socket waitForAcceptFor: 10]
- on: ConnectionTimedOut
- do: [nil].
(newConnection notNil and: [newConnection isConnected])
ifTrue: [
accessSema critical: [connections addLast:
newConnection.].
newConnection := nil.
self changed].
self pruneStaleConnections]. !
Item was changed:
----- Method: ConnectionQueue>>oldStyleListenLoop (in category 'private')
-----
oldStyleListenLoop
"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."
[true] whileTrue: [
((socket == nil) and: [connections size < maxQueueLength])
ifTrue: [
"try to create a new socket for listening"
socket := Socket createIfFail: [nil]].
socket == nil
ifTrue: [(Delay forMilliseconds: 100) wait]
ifFalse: [
socket isUnconnected ifTrue: [socket
listenOn: portNumber].
+ socket
+ waitForConnectionFor: 10
+ ifTimedOut: [
- [socket waitForConnectionFor: 10]
- on: ConnectionTimedOut
- do: [:ex |
socket isConnected
ifTrue:
[ "connection established"
accessSema
critical: [connections addLast: socket].
socket :=
nil]
ifFalse: [
socket
isWaitingForConnection
ifFalse: [socket destroy. socket := nil]]]]. "broken socket; start over"
self pruneStaleConnections].
!
Item was changed:
----- Method: Socket class>>deadlineSecs: (in category 'utilities') -----
deadlineSecs: secs
"Return a deadline time the given number of seconds from now."
+ self deprecated: 'Using this method may result in clock rollover
related bug. Don''t use it.'.
^ Time millisecondClockValue + (secs * 1000) truncated
!
Item was changed:
----- Method: Socket class>>ping: (in category 'utilities') -----
ping: hostName
"Ping the given host. Useful for checking network connectivity. The
host must be running a TCP echo server."
"Socket ping: 'squeak.cs.uiuc.edu'"
| tcpPort sock serverAddr startTime echoTime |
tcpPort := 7. "7 = echo port, 13 = time port, 19 = character
generator port"
serverAddr := NetNameResolver addressForName: hostName timeout: 10.
+ serverAddr ifNil: [ ^self inform: 'Could not find an address for ',
hostName ].
- serverAddr = nil ifTrue: [
- ^ self inform: 'Could not find an address for ', hostName].
sock := Socket new.
sock connectNonBlockingTo: serverAddr port: tcpPort.
[sock waitForConnectionFor: 10]
on: ConnectionTimedOut
do: [:ex |
(self confirm: 'Continue to wait for connection
to ', hostName, '?')
ifTrue: [ex retry]
ifFalse: [
sock destroy.
^ self]].
sock sendData: 'echo!!'.
startTime := Time millisecondClockValue.
[sock waitForDataFor: 15]
on: ConnectionTimedOut
do: [:ex | (self confirm: 'Packet sent but no echo yet; keep
waiting?')
ifTrue: [ex retry]].
echoTime := Time millisecondClockValue - startTime.
sock destroy.
self inform: hostName, ' responded in ', echoTime printString, '
milliseconds'.
!
Item was changed:
----- Method: Socket class>>pingPorts:on:timeOutSecs: (in
category 'utilities') -----
pingPorts: portList on: hostName timeOutSecs: timeOutSecs
"Attempt to connect to each of the given sockets on the given host.
Wait at most timeOutSecs for the connections to be established. Answer an
array of strings indicating the available ports."
- "Socket pingPorts: #(7 13 19 21 23 25 80 110 119)
on: 'squeak.cs.uiuc.edu' timeOutSecs: 15"
+ "Socket pingPorts: #(7 13 19 21 23 25 80 110 119) on: 'squeak.org'
timeOutSecs: 15"
- | serverAddr sockets deadline done result unconnectedCount
connectedCount waitingCount |
- serverAddr := NetNameResolver addressForName: hostName timeout: 10.
- serverAddr = nil ifTrue: [
- self inform: 'Could not find an address for ', hostName.
- ^ #()].
+ | serverAddr sockets startTime timeoutMsecs done result
unconnectedCount connectedCount waitingCount |
+ serverAddr := NetNameResolver addressForName: hostName timeout: 10.
+ serverAddr ifNil: [
+ self inform: 'Could not find an address for ' ,
hostName.
+ ^ #() ].
+ sockets := portList
+ collect: [ :portNum |
+ | sock |
+ sock := Socket new.
+ [ sock connectTo: serverAddr port: portNum ]
+ on: ConnectionTimedOut
+ do: [ ].
+ sock ].
+ startTime := Time millisecondClockValue.
+ timeoutMsecs := (1000 * timeOutSecs) truncated.
- sockets := portList collect: [:portNum | | sock |
- sock := Socket new.
- sock connectTo: serverAddr port: portNum].
-
- deadline := self deadlineSecs: timeOutSecs.
done := false.
+ [ done ]
+ whileFalse: [
+ unconnectedCount := 0.
+ connectedCount := 0.
+ waitingCount := 0.
+ sockets
+ do: [ :s |
+ s isUnconnectedOrInvalid
+ ifTrue: [
unconnectedCount := unconnectedCount + 1 ]
+ ifFalse: [
+ s isConnected
+ ifTrue: [
connectedCount := connectedCount + 1 ].
+ s
isWaitingForConnection
+ ifTrue: [
waitingCount := waitingCount + 1 ] ] ].
+ waitingCount = 0
+ ifTrue: [ done := true ].
+ connectedCount = sockets size
+ ifTrue: [ done := true ].
+ (Time millisecondsSince: startTime) >= timeoutMsecs
+ ifTrue: [ done := true ] ].
+ result := (sockets select: [ :s | s isConnected ]) collect: [ :s |
self nameForWellKnownTCPPort: s remotePort ].
+ sockets do: [ :s | s destroy ].
+ ^ result!
- [done] whileFalse: [
- unconnectedCount := 0.
- connectedCount := 0.
- waitingCount := 0.
- sockets do: [:s |
- s isUnconnectedOrInvalid
- ifTrue: [unconnectedCount :=
unconnectedCount + 1]
- ifFalse: [
- s isConnected ifTrue:
[connectedCount := connectedCount + 1].
- s isWaitingForConnection ifTrue:
[waitingCount := waitingCount + 1]]].
- waitingCount = 0 ifTrue: [done := true].
- connectedCount = sockets size ifTrue: [done := true].
- Time millisecondClockValue > deadline ifTrue: [done :=
true]].
-
- result := (sockets select: [:s | s isConnected])
- collect: [:s | self nameForWellKnownTCPPort: s remotePort].
- sockets do: [:s | s destroy].
- ^ result
- !
Item was changed:
----- Method: Socket>>acceptFrom: (in category 'initialize-destroy') -----
acceptFrom: aSocket
"Initialize a new socket handle from an accept call"
| semaIndex readSemaIndex writeSemaIndex |
primitiveOnlySupportsOneSemaphore := false.
semaphore := Semaphore new.
readSemaphore := Semaphore new.
writeSemaphore := Semaphore new.
semaIndex := Smalltalk registerExternalObject: semaphore.
readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
socketHandle := self primAcceptFrom: aSocket socketHandle
receiveBufferSize: 8000
sendBufSize: 8000
semaIndex: semaIndex
readSemaIndex: readSemaIndex
writeSemaIndex:
writeSemaIndex.
+ socketHandle
+ ifNotNil: [ self register ]
+ ifNil: [ "socket creation failed"
+ Smalltalk unregisterExternalObject: semaphore.
+ Smalltalk unregisterExternalObject: readSemaphore.
+ Smalltalk unregisterExternalObject: writeSemaphore.
+ readSemaphore := writeSemaphore := semaphore := nil
]
- socketHandle = nil ifTrue: [ "socket creation failed"
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- readSemaphore := writeSemaphore := semaphore := nil
- ] ifFalse:[self register].
!
Item was changed:
----- Method: Socket>>destroy (in category 'initialize-destroy') -----
destroy
"Destroy this socket. Its connection, if any, is aborted and its
resources are freed. Do nothing if the socket has already been destroyed
(i.e., if its socketHandle is nil)."
+ socketHandle ifNotNil: [
+ self isValid ifTrue: [ self primSocketDestroy: socketHandle
].
- socketHandle = nil ifFalse:
- [self isValid ifTrue: [self primSocketDestroy:
socketHandle].
Smalltalk unregisterExternalObject: semaphore.
Smalltalk unregisterExternalObject: readSemaphore.
Smalltalk unregisterExternalObject: writeSemaphore.
socketHandle := nil.
readSemaphore := writeSemaphore := semaphore := nil.
+ self unregister ]!
- self unregister].
- !
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."
| semaIndex readSemaIndex writeSemaIndex |
primitiveOnlySupportsOneSemaphore := false.
semaphore := Semaphore new.
readSemaphore := Semaphore new.
writeSemaphore := Semaphore new.
semaIndex := Smalltalk registerExternalObject: semaphore.
readSemaIndex := Smalltalk registerExternalObject: readSemaphore.
writeSemaIndex := Smalltalk registerExternalObject: writeSemaphore.
socketHandle :=
self primSocketCreateNetwork: 0
type: socketType
receiveBufferSize: 8000
sendBufSize: 8000
semaIndex: semaIndex
readSemaIndex: readSemaIndex
writeSemaIndex: writeSemaIndex.
+ socketHandle
+ ifNotNil: [ self register ]
+ ifNil: [ "socket creation failed"
+ Smalltalk unregisterExternalObject: semaphore.
+ Smalltalk unregisterExternalObject: readSemaphore.
+ Smalltalk unregisterExternalObject: writeSemaphore.
+ readSemaphore := writeSemaphore := semaphore := nil
]
- socketHandle = nil ifTrue: [ "socket creation failed"
- Smalltalk unregisterExternalObject: semaphore.
- Smalltalk unregisterExternalObject: readSemaphore.
- Smalltalk unregisterExternalObject: writeSemaphore.
- readSemaphore := writeSemaphore := semaphore := nil
- ] ifFalse:[self register].
!
