FileOut questionLic. Edgar J. De Cleene edgardec2001 at yahoo.com.arSun May 7 11:19:56 UTC 2006
Skipped content of type multipart/alternative-------------- next part --------------
'From Squeak3.9alpha of 4 July 2005 [latest update: #6705] on 7 May 2006 at 8:17:32 am'!
AppRegistry subclass: #MailSender
instanceVariableNames: ''
classVariableNames: 'SmtpServer UserName'
poolDictionaries: ''
category: 'System-Applications'!
Object subclass: #RemoteDebugServer
instanceVariableNames: 'socket'
classVariableNames: 'Current'
poolDictionaries: ''
category: 'RemoteCommand'!
Object subclass: #Socket
instanceVariableNames: 'semaphore socketHandle readSemaphore writeSemaphore primitiveOnlySupportsOneSemaphore'
classVariableNames: 'Connected DeadServer InvalidSocket OtherEndClosed Registry RegistryThreshold TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection'
poolDictionaries: ''
category: 'Network-Kernel'!
!MailSender class methodsFor: 'testing' stamp: 'dvf 5/11/2002 01:31'!
isSmtpServerSet
^ SmtpServer notNil and: [SmtpServer notEmpty]
! !
!MailSender class methodsFor: 'communication' stamp: 'ads 5/11/2003 21:11'!
sendMessage: aMailMessage
self default ifNotNil: [self default sendMailMessage: aMailMessage]! !
!MailSender class methodsFor: 'settings' stamp: 'rbb 3/1/2005 10:59'!
setSmtpServer
"Set the SMTP server used to send outgoing messages via"
SmtpServer ifNil: [SmtpServer := ''].
SmtpServer := UIManager default
request: 'What is your mail server for outgoing mail?'
initialAnswer: SmtpServer.
! !
!MailSender class methodsFor: 'settings' stamp: 'rbb 3/1/2005 11:00'!
setUserName
"Change the user's email name for use in composing messages."
(UserName isNil) ifTrue: [UserName := ''].
UserName := UIManager default
request: 'What is your email address?\(This is the address other people will reply to you)' withCRs
initialAnswer: UserName.
UserName ifNotNil: [UserName := UserName]! !
!MailSender class methodsFor: 'accessing' stamp: 'dvf 5/11/2002 01:29'!
smtpServer
"Answer the server for sending email"
self isSmtpServerSet
ifFalse: [self setSmtpServer].
SmtpServer isEmpty ifTrue: [
self error: 'no SMTP server specified' ].
^SmtpServer! !
!MailSender class methodsFor: 'accessing' stamp: 'dvf 5/11/2002 00:49'!
userName
"Answer the user name to be used in composing messages."
(UserName isNil or: [UserName isEmpty])
ifTrue: [self setUserName].
UserName isEmpty ifTrue: [ self error: 'no user name specified' ].
^UserName! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 07:33'!
askMom: xObject
socket sendObject: xObject! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 7/18/2005 18:43'!
checkCompatibility: aSet
| list |
list _ OrderedCollection new.
aSet do: [:ea| Smalltalk at: ea ifAbsent: [ list add: ea]].
self halt.
! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 9/17/2005 10:19'!
initialize
Transcript clear.
socket := Socket
tcpCreateIfFail: [^ Transcript show: 'failed'].
Transcript show: 'Starting server';
cr! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 4/8/2006 10:48'!
loop
| xObject momSaid |
Transcript open.
Transcript show: self class current;cr.
socket listenOn: 8000.
[true]
whileTrue: [
socket waitForConnectionUntil: (Socket deadlineSecs: 30).
[socket isConnected]
whileTrue: [
socket dataAvailable
ifTrue: [momSaid := socket getData.
Transcript show:momSaid ;cr.
xObject := Compiler evaluate: momSaid for: nil notifying: self logged: true.
socket sendObject: xObject]]]! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 9/19/2005 10:12'!
notify: error at: location in: source
socket isConnected
ifTrue: [socket sendObject: error]! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 9/1/2005 10:27'!
processThis
| momSaid realClass selector cm xObject |
momSaid := socket getData.
Transcript show:momSaid ;cr.
realClass := ((momSaid findTokens: ' ') at: 1) asSymbol.
selector := ((momSaid findTokens: ' ') at: 2).
cm _ (Smalltalk at: realClass ) methodDict
self halt.
xObject := Compiler evaluateForMom: momSaid for: nil notifying: self logged: true.
socket sendObject: xObject! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 9/1/2005 17:23'!
processThis: aString
| momSaid realClass selector method instanceDict outStream sourceFile oldPos preamble |
momSaid := aString.
realClass := ((momSaid findTokens: ' ') at: 1) asSymbol.
selector := ((momSaid findTokens: ' ') at: 2) asSymbol.
instanceDict := (Smalltalk at: realClass ) methodDict.
method := instanceDict at: selector ifAbsent:[].
outStream := RWBinaryOrTextStream on:''.
sourceFile := SourceFiles at: method fileIndex.
oldPos := method filePosition.
sourceFile position: oldPos.
preamble := (Smalltalk at: realClass ) name , ' methodsFor: ' ,
((Smalltalk at: realClass ) organization categoryOfElement: selector) asString printString.
preamble size > 0 ifTrue: "Copy the preamble"
[outStream copyPreamble: preamble from: sourceFile].
"Copy the method chunk"
outStream copyMethodChunkFrom: sourceFile.
sourceFile skipSeparators. "The following chunk may have ]style["
sourceFile peek == $] ifTrue: [
outStream cr; copyMethodChunkFrom: sourceFile].
outStream cr.
socket sendData: outStream contents ! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 07:30'!
select
^ self! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 07:30'!
selectFrom: from to: to
^ self! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 07:28'!
selectionInterval
^ (0 to: 0)! !
!RemoteDebugServer methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 07:29'!
text
^ Text fromString:'' ! !
!RemoteDebugServer class methodsFor: 'as yet unclassified' stamp: 'edc 2/3/2005 08:48'!
current
^ Current! !
!RemoteDebugServer class methodsFor: 'as yet unclassified' stamp: 'edc 2/19/2005 11:00'!
start
Current _ self new .
self current loop! !
!RemoteDebugServer class methodsFor: 'as yet unclassified' stamp: 'edc 7/19/2005 07:27'!
stop
Socket allInstancesDo: [:s| s closeAndDestroy.
s _ nil. ].! !
!Socket methodsFor: 'initialize-destroy' stamp: 'JMM 5/22/2000 22:47'!
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 = nil ifTrue: [ "socket creation failed"
Smalltalk unregisterExternalObject: semaphore.
Smalltalk unregisterExternalObject: readSemaphore.
Smalltalk unregisterExternalObject: writeSemaphore.
readSemaphore _ writeSemaphore _ semaphore _ nil
] ifFalse:[self register].
! !
!Socket methodsFor: 'initialize-destroy' stamp: 'JMM 5/22/2000 22:54'!
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 = 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].
! !
!Socket methodsFor: 'initialize-destroy' stamp: 'JMM 5/22/2000 23:04'!
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 = nil ifTrue: [ "socket creation failed"
Smalltalk unregisterExternalObject: semaphore.
Smalltalk unregisterExternalObject: readSemaphore.
Smalltalk unregisterExternalObject: writeSemaphore.
readSemaphore _ writeSemaphore _ semaphore _ nil
] ifFalse:[self register].
! !
!Socket methodsFor: 'initialize-destroy' stamp: 'mir 2/22/2002 15:48'!
initializeNetwork
self class initializeNetwork! !
!Socket methodsFor: 'accessing' stamp: 'ar 4/30/1999 04:25'!
address
"Shortcut"
^self localAddress! !
!Socket methodsFor: 'accessing' stamp: 'MU 11/26/2003 16:53'!
localAddress
self isWaitingForConnection
ifFalse: [[self waitForConnectionFor: Socket standardTimeout]
on: ConnectionTimedOut
do: [:ex | ^ ByteArray new: 4]].
^ self primSocketLocalAddress: socketHandle! !
!Socket methodsFor: 'accessing' stamp: 'MU 11/26/2003 16:53'!
localPort
self isWaitingForConnection
ifFalse: [[self waitForConnectionFor: Socket standardTimeout]
on: ConnectionTimedOut
do: [:ex | ^ 0]].
^ self primSocketLocalPort: socketHandle! !
!Socket methodsFor: 'accessing' stamp: 'jm 3/13/98 12:11'!
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."
^ NetNameResolver
nameForAddress: self remoteAddress
timeout: 20
! !
!Socket methodsFor: 'accessing' stamp: 'ar 4/30/1999 04:25'!
port
"Shortcut"
^self localPort! !
!Socket methodsFor: 'accessing' stamp: 'JMM 6/5/2000 10:12'!
primitiveOnlySupportsOneSemaphore
^primitiveOnlySupportsOneSemaphore! !
!Socket methodsFor: 'accessing' stamp: 'JMM 5/22/2000 22:49'!
readSemaphore
primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
^readSemaphore! !
!Socket methodsFor: 'accessing' stamp: 'jm 9/17/97 14:34'!
remoteAddress
^ self primSocketRemoteAddress: socketHandle
! !
!Socket methodsFor: 'accessing' stamp: 'jm 9/17/97 14:34'!
remotePort
^ self primSocketRemotePort: socketHandle
! !
!Socket methodsFor: 'accessing' stamp: 'JMM 5/9/2000 15:32'!
semaphore
^semaphore! !
!Socket methodsFor: 'accessing' stamp: 'ar 7/16/1999 17:22'!
socketHandle
^socketHandle! !
!Socket methodsFor: 'accessing' stamp: 'JMM 5/22/2000 22:49'!
writeSemaphore
primitiveOnlySupportsOneSemaphore ifTrue: [^semaphore].
^writeSemaphore! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:52'!
dataAvailable
"Return true if this socket has unread received data."
socketHandle == nil ifTrue: [^ false].
^ self primSocketReceiveDataAvailable: socketHandle
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:52'!
isConnected
"Return true if this socket is connected."
socketHandle == nil ifTrue: [^ false].
^ (self primSocketConnectionStatus: socketHandle) == Connected
! !
!Socket methodsFor: 'queries' stamp: 'JMM 5/5/2000 12:15'!
isOtherEndClosed
"Return true if this socket had the other end closed."
socketHandle == nil ifTrue: [^ false].
^ (self primSocketConnectionStatus: socketHandle) == OtherEndClosed
! !
!Socket methodsFor: 'queries' stamp: 'JMM 5/5/2000 12:17'!
isThisEndClosed
"Return true if this socket had the this end closed."
socketHandle == nil ifTrue: [^ false].
^ (self primSocketConnectionStatus: socketHandle) == ThisEndClosed
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isUnconnected
"Return true if this socket's state is Unconnected."
socketHandle == nil ifTrue: [^ false].
^ (self primSocketConnectionStatus: socketHandle) == Unconnected
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isUnconnectedOrInvalid
"Return true if this socket is completely disconnected or is invalid."
| status |
socketHandle == nil ifTrue: [^ true].
status _ self primSocketConnectionStatus: socketHandle.
^ (status = Unconnected) | (status = InvalidSocket)
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:51'!
isValid
"Return true if this socket contains a valid, non-nil socket handle."
| status |
socketHandle == nil ifTrue: [^ false].
status _ self primSocketConnectionStatus: socketHandle.
^ status ~= InvalidSocket
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
isWaitingForConnection
"Return true if this socket is waiting for a connection."
socketHandle == nil ifTrue: [^ false].
^ (self primSocketConnectionStatus: socketHandle) == WaitingForConnection
! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:54'!
sendDone
"Return true if the most recent send operation on this socket has completed."
socketHandle == nil ifTrue: [^ false].
^ self primSocketSendDone: socketHandle
! !
!Socket methodsFor: 'queries' stamp: 'JMM 5/8/2000 23:24'!
socketError
^self primSocketError: socketHandle! !
!Socket methodsFor: 'queries' stamp: 'jm 2/25/1999 13:56'!
statusString
"Return a string describing the status of this socket."
| status |
socketHandle == nil ifTrue: [^ 'destroyed'].
status _ self primSocketConnectionStatus: socketHandle.
status = InvalidSocket ifTrue: [^ 'invalidSocketHandle'].
status = Unconnected ifTrue: [^ 'unconnected'].
status = WaitingForConnection ifTrue: [^ 'waitingForConnection'].
status = Connected ifTrue: [^ 'connected'].
status = OtherEndClosed ifTrue: [^ 'otherEndClosedButNotThisEnd'].
status = ThisEndClosed ifTrue: [^ 'thisEndClosedButNotOtherEnd'].
^ 'unknown socket status'
! !
!Socket methodsFor: 'connection open/close' stamp: 'bolot 7/16/1999 14:36'!
accept
"Accept a connection from the receiver socket.
Return a new socket that is connected to the client"
^Socket acceptFrom: self.! !
!Socket methodsFor: 'connection open/close' stamp: 'jm 9/11/97 20:29'!
close
"Close this connection gracefully. For TCP, this sends a close request, but the stream remains open until the other side also closes it."
self primSocketCloseConnection: socketHandle. "close this end"
! !
!Socket methodsFor: 'connection open/close' stamp: 'jm 11/4/97 07:15'!
closeAndDestroy
"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
self closeAndDestroy: 20.
! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 5/15/2003 18:31'!
closeAndDestroy: timeoutSeconds
"First, try to close this connection gracefully. If the close attempt fails or times out, abort the connection. In either case, destroy the socket. Do nothing if the socket has already been destroyed (i.e., if its socketHandle is nil)."
socketHandle = nil
ifFalse: [
self isConnected ifTrue: [
self close. "close this end"
(self waitForDisconnectionFor: timeoutSeconds)
ifFalse: [
"if the other end doesn't close soon, just abort the connection"
self primSocketAbortConnection: socketHandle]].
self destroy].
! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 5/9/2003 18:13'!
connectNonBlockingTo: hostAddress port: port
"Initiate a connection to the given port at the given host address. This operation will return immediately; follow it with waitForConnectionUntil: to wait until the connection is established."
| status |
self initializeNetwork.
status _ self primSocketConnectionStatus: socketHandle.
(status == Unconnected)
ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before opening a new connection'].
self primSocket: socketHandle connectTo: hostAddress port: port.
! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 5/15/2003 18:29'!
connectTo: hostAddress port: port
"Initiate a connection to the given port at the given host address.
Waits until the connection is established or time outs."
self connectTo: hostAddress port: port waitForConnectionFor: Socket standardTimeout! !
!Socket methodsFor: 'connection open/close' stamp: 'mu 8/14/2003 15:15'!
connectTo: hostAddress port: port waitForConnectionFor: timeout
"Initiate a connection to the given port at the given host
address. Waits until the connection is established or time outs."
self connectNonBlockingTo: hostAddress port: port.
self
waitForConnectionFor: timeout
ifTimedOut: [ConnectionTimedOut signal: 'Cannot connect to '
, (NetNameResolver stringFromAddress: hostAddress) , ':' , port asString]! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 5/8/2003 16:03'!
connectToHostNamed: hostName port: portNumber
| serverIP |
serverIP _ NetNameResolver addressForName: hostName timeout: 20.
^self connectTo: serverIP port: portNumber
! !
!Socket methodsFor: 'connection open/close' stamp: 'jm 3/10/98 11:56'!
disconnect
"Break this connection, no matter what state it is in. Data that has been sent but not received will be lost."
self primSocketAbortConnection: socketHandle.
! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 2/22/2002 16:25'!
listenOn: port
"Listen for a connection on the given port. This operation will return immediately; follow it with waitForConnectionUntil: to wait until a connection is established."
| status |
status _ self primSocketConnectionStatus: socketHandle.
(status == Unconnected)
ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
self primSocket: socketHandle listenOn: port.
! !
!Socket methodsFor: 'connection open/close' stamp: 'mir 2/22/2002 16:25'!
listenOn: portNumber backlogSize: backlog
"Listen for a connection on the given port.
If this method succeeds, #accept may be used to establish a new connection"
| status |
status _ self primSocketConnectionStatus: socketHandle.
(status == Unconnected)
ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
self primSocket: socketHandle listenOn: portNumber backlogSize: backlog.
! !
!Socket methodsFor: 'connection open/close' stamp: 'ikp 9/1/2003 20:32'!
listenOn: portNumber backlogSize: backlog interface: ifAddr
"Listen for a connection on the given port.
If this method succeeds, #accept may be used to establish a new connection"
| status |
status _ self primSocketConnectionStatus: socketHandle.
(status == Unconnected)
ifFalse: [InvalidSocketStatusException signal: 'Socket status must Unconnected before listening for a new connection'].
self primSocket: socketHandle listenOn: portNumber backlogSize: backlog interface: ifAddr.
! !
!Socket methodsFor: 'receiving' stamp: 'jm 9/15/97 12:22'!
discardReceivedData
"Discard any data received up until now, and return the number of bytes discarded."
| buf totalBytesDiscarded |
buf _ String new: 10000.
totalBytesDiscarded _ 0.
[self isConnected and: [self dataAvailable]] whileTrue: [
totalBytesDiscarded _
totalBytesDiscarded + (self receiveDataInto: buf)].
^ totalBytesDiscarded
! !
!Socket methodsFor: 'receiving' stamp: 'edc 2/15/2004 09:17'!
getData
| t1 t2 |
(self waitForDataUntil: Socket standardDeadline)
ifFalse: [self error: 'getData timeout'].
t1 _ String new: 4000.
t2 _ self
primSocket: socketHandle
receiveDataInto: t1
startingAt: 1
count: t1 size.
^ t1 copyFrom: 1 to: t2! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:52'!
receiveAvailableData
"Receive all available data (if any). Do not wait."
| buffer bytesRead |
buffer _ String new: 2000.
bytesRead _ self receiveAvailableDataInto: buffer.
^buffer copyFrom: 1 to: bytesRead! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:52'!
receiveAvailableDataInto: buffer
"Receive all available data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Do not wait for data."
^self receiveAvailableDataInto: buffer startingAt: 1! !
!Socket methodsFor: 'receiving' stamp: 'mu 8/9/2003 18:04'!
receiveAvailableDataInto: buffer startingAt: startIndex
"Receive all available data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Do not wait for data."
| bufferPos bytesRead |
bufferPos := startIndex.
[self dataAvailable
and: [bufferPos-1 < buffer size]]
whileTrue: [
bytesRead := self receiveSomeDataInto: buffer startingAt: bufferPos.
bufferPos := bufferPos + bytesRead].
^bufferPos - startIndex! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:05'!
receiveData
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once.
Either returns data or signals a time out or connection close."
| buffer bytesRead |
buffer _ String new: 2000.
bytesRead _ self receiveDataInto: buffer.
^buffer copyFrom: 1 to: bytesRead! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:05'!
receiveDataInto: aStringOrByteArray
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once.
Either returns data or signals a time out or connection close."
^self receiveDataInto: aStringOrByteArray startingAt: 1! !
!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:12'!
receiveDataInto: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once. The answer may be zero (indicating that no data was
available before the socket closed)."
| bytesRead closed |
bytesRead := 0.
closed := false.
[closed not and: [bytesRead == 0]]
whileTrue: [
self waitForDataIfClosed: [closed := true].
bytesRead := self primSocket: socketHandle
receiveDataInto: aStringOrByteArray
startingAt: aNumber
count: aStringOrByteArray size-aNumber+1].
^bytesRead
! !
!Socket methodsFor: 'receiving' stamp: 'gk 2/9/2005 12:33'!
receiveDataSignallingClosedInto: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data until something is read or the socket is closed, upon which
we signal."
| bytesRead |
bytesRead := 0.
[bytesRead == 0]
whileTrue: [
self waitForData.
bytesRead := self primSocket: socketHandle
receiveDataInto: aStringOrByteArray
startingAt: aNumber
count: aStringOrByteArray size-aNumber+1].
^bytesRead
! !
!Socket methodsFor: 'receiving' stamp: 'gk 2/9/2005 12:24'!
receiveDataSignallingTimeout: timeout into: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Wait for data once for the specified nr of seconds. This method will
throw exceptions on timeout or the socket closing."
self waitForDataFor: timeout.
^self primSocket: socketHandle
receiveDataInto: aStringOrByteArray
startingAt: aNumber
count: aStringOrByteArray size-aNumber+1
! !
!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:03'!
receiveDataTimeout: timeout
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once."
| buffer bytesRead |
buffer _ String new: 2000.
bytesRead _ self receiveDataTimeout: timeout into: buffer.
^buffer copyFrom: 1 to: bytesRead! !
!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:01'!
receiveDataTimeout: timeout into: aStringOrByteArray
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once."
^self receiveDataTimeout: timeout into: aStringOrByteArray startingAt: 1! !
!Socket methodsFor: 'receiving' stamp: 'svp 9/22/2003 23:58'!
receiveDataTimeout: timeout into: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Wait for data once for the specified nr of seconds. The answer may be
zero (indicating that there was no data available within the given timeout)."
self waitForDataFor: timeout ifClosed: [] ifTimedOut: [].
^self primSocket: socketHandle
receiveDataInto: aStringOrByteArray
startingAt: aNumber
count: aStringOrByteArray size-aNumber+1
! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:18'!
receiveDataWithTimeout
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once.
Either returns data or signals a time out or connection close."
| buffer bytesRead |
buffer _ String new: 2000.
bytesRead _ self receiveDataWithTimeoutInto: buffer.
^buffer copyFrom: 1 to: bytesRead! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 16:18'!
receiveDataWithTimeoutInto: aStringOrByteArray
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once.
Either returns data or signals a time out or connection close."
^self receiveDataWithTimeoutInto: aStringOrByteArray startingAt: 1! !
!Socket methodsFor: 'receiving' stamp: 'svp 9/23/2003 00:01'!
receiveDataWithTimeoutInto: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received.
Note the given buffer may be only partially filled by the received data.
Waits for data once."
^self receiveDataTimeout: Socket standardTimeout into: aStringOrByteArray startingAt: aNumber
! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeData
"Receive currently available data (if any). Do not wait."
| buffer bytesRead |
buffer _ String new: 2000.
bytesRead _ self receiveSomeDataInto: buffer.
^buffer copyFrom: 1 to: bytesRead! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeDataInto: aStringOrByteArray
"Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
^self receiveSomeDataInto: aStringOrByteArray startingAt: 1! !
!Socket methodsFor: 'receiving' stamp: 'mir 5/15/2003 13:46'!
receiveSomeDataInto: aStringOrByteArray startingAt: aNumber
"Receive data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data."
^ self primSocket: socketHandle
receiveDataInto: aStringOrByteArray
startingAt: aNumber
count: aStringOrByteArray size-aNumber+1
! !
!Socket methodsFor: 'sending' stamp: 'mir 5/15/2003 18:33'!
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: 5000).
bytesSent _ bytesSent + count].
^ bytesSent
! !
!Socket methodsFor: 'sending' stamp: 'ar 7/20/1999 17:23'!
sendData: buffer count: n
"Send the amount of data from the given buffer"
| sent |
sent _ 0.
[sent < n] whileTrue:[
sent _ sent + (self sendSomeData: buffer startIndex: sent+1 count: (n-sent))].! !
!Socket methodsFor: 'sending' stamp: 'ls 1/5/1999 15:05'!
sendSomeData: aStringOrByteArray
"Send as much of the given data as possible and 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
sendSomeData: aStringOrByteArray
startIndex: 1
count: aStringOrByteArray size! !
!Socket methodsFor: 'sending' stamp: 'ls 3/3/1999 18:59'!
sendSomeData: aStringOrByteArray startIndex: startIndex
"Send as much of the given data as possible 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
sendSomeData: aStringOrByteArray
startIndex: startIndex
count: (aStringOrByteArray size - startIndex + 1)! !
!Socket methodsFor: 'sending' stamp: 'mir 5/15/2003 18:34'!
sendSomeData: aStringOrByteArray startIndex: startIndex count: count
"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."
| bytesSent |
(self waitForSendDoneFor: 20)
ifTrue: [
bytesSent _ self primSocket: socketHandle
sendData: aStringOrByteArray
startIndex: startIndex
count: count]
ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
^ bytesSent
! !
!Socket methodsFor: 'sending' stamp: 'mir 2/19/2002 18:33'!
sendStreamContents: stream
"Send the data in the stream. Close the stream.
Usefull for directly sending contents of a file without reading into memory first."
self sendStreamContents: stream checkBlock: [true]! !
!Socket methodsFor: 'sending' stamp: 'mir 2/19/2002 18:31'!
sendStreamContents: stream checkBlock: checkBlock
"Send the data in the stream. Close the stream after you are done. After each block of data evaluate checkBlock and abort if it returns false.
Usefull for directly sending contents of a file without reading into memory first."
| chunkSize buffer |
chunkSize _ 5000.
buffer _ ByteArray new: chunkSize.
stream binary.
[[stream atEnd and: [checkBlock value]]
whileFalse: [
buffer _ stream next: chunkSize into: buffer.
self sendData: buffer]]
ensure: [stream close]! !
!Socket methodsFor: 'waiting' stamp: 'mu 8/9/2003 15:17'!
waitForAcceptFor: timeout
"Wait and accept an incoming connection. Return nil if it falis"
[self waitForConnectionFor: timeout] on: ConnectionTimedOut do: [:ex | ^nil].
^self isConnected
ifTrue:[self accept]
! !
!Socket methodsFor: 'waiting' stamp: 'svp 7/27/2003 00:23'!
waitForAcceptFor: timeout ifTimedOut: timeoutBlock
"Wait and accept an incoming connection"
self waitForConnectionFor: timeout ifTimedOut: [^timeoutBlock value].
^self accept! !
!Socket methodsFor: 'waiting' stamp: 'edc 4/12/2004 08:52'!
waitForAcceptUntil: deadLine
"Wait and accept an incoming connection"
self waitForConnectionUntil: deadLine.
^ self isConnected
ifTrue: [self accept]! !
!Socket methodsFor: 'waiting' stamp: 'mu 8/19/2003 02:57'!
waitForConnectionFor: timeout
"Wait up until the given deadline for a connection to be established. Return true if it is established by the deadline, false if not."
^self
waitForConnectionFor: timeout
ifTimedOut: [ConnectionTimedOut signal: 'Failed to connect in ', timeout asString, ' seconds']
! !
!Socket methodsFor: 'waiting' stamp: 'svp 7/27/2003 00:01'!
waitForConnectionFor: timeout ifTimedOut: timeoutBlock
"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 deadline |
deadline := Socket deadlineSecs: timeout.
status _ self primSocketConnectionStatus: socketHandle.
[(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
whileTrue: [
semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
status _ self primSocketConnectionStatus: socketHandle].
status = Connected ifFalse: [^timeoutBlock value]
! !
!Socket methodsFor: 'waiting' stamp: 'jm 3/2/98 18:15'!
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 |
status _ self primSocketConnectionStatus: socketHandle.
[(status = WaitingForConnection) and: [Time millisecondClockValue < deadline]]
whileTrue: [
semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
status _ self primSocketConnectionStatus: socketHandle].
^ status = Connected! !
!Socket methodsFor: 'waiting' stamp: 'svp 9/23/2003 00:09'!
waitForData
"Wait for data to arrive. This method will block until
data is available or the socket is closed. If the socket is closed
a ConnectionClosed exception will be signaled."
^self waitForDataIfClosed:
[ConnectionClosed signal: 'Connection close while waiting for data.']! !
!Socket methodsFor: 'waiting' stamp: 'svp 7/27/2003 00:18'!
waitForDataFor: timeout
"Wait for the given nr of seconds for data to arrive.
Signal a time out or connection close exception if either happens before data becomes available."
^self
waitForDataFor: timeout
ifClosed: [ConnectionClosed signal: 'Connection closed while waiting for data.']
ifTimedOut: [ConnectionTimedOut signal: 'Data receive timed out.']
! !
!Socket methodsFor: 'waiting' stamp: 'svp 7/27/2003 00:16'!
waitForDataFor: timeout ifClosed: closedBlock ifTimedOut: timedOutBlock
"Wait for the given nr of seconds for data to arrive."
| deadline |
deadline := Socket deadlineSecs: timeout.
[Time millisecondClockValue < deadline]
whileTrue: [
(self primSocketReceiveDataAvailable: socketHandle)
ifTrue: [^self].
self isConnected
ifFalse: [^closedBlock value].
self readSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
(self primSocketReceiveDataAvailable: socketHandle)
ifFalse: [
self isConnected
ifTrue: [^timedOutBlock value]
ifFalse: [^closedBlock value]]! !
!Socket methodsFor: 'waiting' stamp: 'svp 9/23/2003 00:08'!
waitForDataIfClosed: closedBlock
"Wait indefinitely for data to arrive. This method will block until
data is available or the socket is closed."
[true]
whileTrue: [
(self primSocketReceiveDataAvailable: socketHandle)
ifTrue: [^self].
self isConnected
ifFalse: [^closedBlock value].
self readSemaphore wait].
! !
!Socket methodsFor: 'waiting' stamp: 'edc 2/15/2004 09:19'!
waitForDataUntil: deadline
"Wait up until the given deadline for data to arrive. Return true if data
arrives by the deadline, false if not."
| dataArrived |
[self isConnected & (dataArrived := self primSocketReceiveDataAvailable: socketHandle) not
and: ["Connection end and final data can happen fast, so test in this
order "
Time millisecondClockValue < deadline]]
whileTrue: [self readSemaphore waitTimeoutMSecs: deadline - Time millisecondClockValue].
^ dataArrived! !
!Socket methodsFor: 'waiting' stamp: 'svp 9/22/2003 23:37'!
waitForDisconnectionFor: timeout
"Wait up until the given deadline for the the connection to be broken. Return true if it is broken by the deadline, false if not."
"Note: The client should know the the connect is really going to be closed (e.g., because he has called 'close' to send a close request to the other end) before calling this method.
JMM 00/5/17 note that other end can close which will terminate wait"
| extraBytes status deadline |
extraBytes _ 0.
status _ self primSocketConnectionStatus: socketHandle.
deadline := Socket deadlineSecs: timeout.
[((status = Connected) or: [(status = ThisEndClosed)]) and:
[Time millisecondClockValue < deadline]] whileTrue: [
self dataAvailable
ifTrue: [extraBytes _ extraBytes + self discardReceivedData].
semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
status _ self primSocketConnectionStatus: socketHandle].
^ status ~= Connected
! !
!Socket methodsFor: 'waiting' stamp: 'edc 10/5/2004 11:44'!
waitForDisconnectionUntil: deadline
"Wait up until the given deadline for the the connection to be broken. Return true if it is broken by the deadline, false if not."
"Note: The client should know the the connect is really going to be closed (e.g., because he has called 'close' to send a close request to the other end) before calling this method.
JMM 00/5/17 note that other end can close which will terminate wait"
| extraBytes status |
extraBytes := 0.
status := self primSocketConnectionStatus: socketHandle.
[((status = Connected) or: [(status = ThisEndClosed)]) and:
[Time millisecondClockValue < deadline]] whileTrue: [
self dataAvailable
ifTrue: [extraBytes := extraBytes + self discardReceivedData].
semaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue).
status := self primSocketConnectionStatus: socketHandle].
extraBytes > 0
ifTrue: [self inform: 'Discarded ', extraBytes printString, ' bytes while closing connection.'].
^ status ~= Connected
! !
!Socket methodsFor: 'waiting' stamp: 'mir 5/15/2003 18:33'!
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."
| sendDone deadline |
deadline := Socket deadlineSecs: timeout.
[self isConnected & (sendDone _ self primSocketSendDone: socketHandle) not
"Connection end and final data can happen fast, so test in this order"
and: [Time millisecondClockValue < deadline]] whileTrue: [
self writeSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
^ sendDone! !
!Socket methodsFor: 'waiting' stamp: 'edc 10/5/2004 11:42'!
waitForSendDoneUntil: deadline
"Wait up until the given deadline for the current send operation to complete. Return true if it completes by the deadline, false if not."
| sendDone |
[self isConnected & (sendDone := self primSocketSendDone: socketHandle) not
"Connection end and final data can happen fast, so test in this order"
and: [Time millisecondClockValue < deadline]] whileTrue: [
self writeSemaphore waitTimeoutMSecs: (deadline - Time millisecondClockValue)].
^ sendDone! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex
"Create and return a new socket handle based on accepting the connection from the given listening socket"
<primitive: 'primitiveSocketAccept' module: 'SocketPlugin'>
^self primitiveFailed! !
!Socket methodsFor: 'primitives' stamp: 'JMM 5/22/2000 22:55'!
primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
"Create and return a new socket handle based on accepting the connection from the given listening socket"
<primitive: 'primitiveSocketAccept3Semaphores' module: 'SocketPlugin'>
primitiveOnlySupportsOneSemaphore _ true.
^self primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex ! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID connectTo: hostAddress port: port
"Attempt to establish a connection to the given port of the given host. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
<primitive: 'primitiveSocketConnectToPort' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'JMM 5/25/2000 21:48'!
primSocket: socketID getOption: aString
"Get some option information on this socket. Refer to the UNIX
man pages for valid SO, TCP, IP, UDP options. In case of doubt
refer to the source code.
TCP_NODELAY, SO_KEEPALIVE are valid options for example
returns an array containing the error code and the option value"
<primitive: 'primitiveSocketGetOptions' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID listenOn: port
"Listen for a connection on the given port. This is an asynchronous call; query the socket status to discover if and when the connection is actually completed."
<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: aHandle listenOn: portNumber backlogSize: backlog
"Primitive. Set up the socket to listen on the given port.
Will be used in conjunction with #accept only."
<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
self destroy. "Accept not supported so clean up"! !
!Socket methodsFor: 'primitives' stamp: 'ikp 9/1/2003 20:33'!
primSocket: aHandle listenOn: portNumber backlogSize: backlog interface: ifAddr
"Primitive. Set up the socket to listen on the given port.
Will be used in conjunction with #accept only."
<primitive: 'primitiveSocketListenOnPortBacklogInterface' module: 'SocketPlugin'>
self destroy. "Accept not supported so clean up"! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID receiveDataInto: aStringOrByteArray startingAt: startIndex count: count
"Receive data from the given socket into the given array starting at the given index. Return the number of bytes read or zero if no data is available."
<primitive: 'primitiveSocketReceiveDataBufCount' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'JMM 5/24/2000 17:19'!
primSocket: socketID receiveUDPDataInto: aStringOrByteArray startingAt: startIndex count: count
"Receive data from the given socket into the given array starting at the given index.
Return an Array containing the amount read, the host address byte array, the host port, and the more flag"
<primitive: 'primitiveSocketReceiveUDPDataBufCount' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocket: socketID sendData: aStringOrByteArray 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 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. The size of the send buffer is determined when the socket is created."
<primitive: 'primitiveSocketSendDataBufCount' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'JMM 5/25/2000 00:08'!
primSocket: socketID sendUDPData: 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 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. The size of the send buffer is determined when the socket is created."
<primitive: 'primitiveSocketSendUDPDataBufCount' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 7/18/2000 11:42'!
primSocket: socketID setOption: aString value: aStringValue
"Set some option information on this socket. Refer to the UNIX
man pages for valid SO, TCP, IP, UDP options. In case of doubt
refer to the source code.
TCP_NODELAY, SO_KEEPALIVE are valid options for example
returns an array containing the error code and the negotiated value"
<primitive: 'primitiveSocketSetOptions' module: 'SocketPlugin'>
^nil! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
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."
<primitive: 'primitiveSocketListenWithOrWithoutBacklog' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketAbortConnection: socketID
"Terminate the connection on the given port immediately without going through the normal close sequence. This is an asynchronous call; query the socket status to discover if and when the connection is actually terminated."
<primitive: 'primitiveSocketAbortConnection' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketCloseConnection: socketID
"Close the connection on the given port. The remote end is informed that this end has closed and will do no further sends. This is an asynchronous call; query the socket status to discover if and when the connection is actually closed."
<primitive: 'primitiveSocketCloseConnection' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketConnectionStatus: socketID
"Return an integer reflecting the connection status of this socket. For a list of possible values, see the comment in the 'initialize' method of this class. If the primitive fails, return a status indicating that the socket handle is no longer valid, perhaps because the Squeak image was saved and restored since the socket was created. (Sockets do not survive snapshots.)"
<primitive: 'primitiveSocketConnectionStatus' module: 'SocketPlugin'>
^ InvalidSocket
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex
"Return a new socket handle for a socket of the given type and buffer sizes. Return nil if socket creation fails.
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)
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. Note the macintosh implementation ignores this buffer size. Also see setOption to get/set socket buffer sizes which allows you to set/get the current buffer sizes for reading and writing.
If semaIndex is > 0, it is taken to be the index of a Semaphore in the external objects array to be associated with this socket. This semaphore will be signalled when the socket status changes, such as when data arrives or a send completes. 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. For example, a process waiting to send some data can see if the last send has completed."
<primitive: 'primitiveSocketCreate' module: 'SocketPlugin'>
^ nil "socket creation failed"
! !
!Socket methodsFor: 'primitives' stamp: 'JMM 5/22/2000 22:48'!
primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex readSemaIndex: aReadSema writeSemaIndex: aWriteSema
"See comment in primSocketCreateNetwork: with one semaIndex. However you should know that some implementations
ignore the buffer size and this interface supports three semaphores, one for open/close/listen and the other two for
reading and writing"
<primitive: 'primitiveSocketCreate3Semaphores' module: 'SocketPlugin'>
primitiveOnlySupportsOneSemaphore _ true.
^ self primSocketCreateNetwork: netType
type: socketType
receiveBufferSize: rcvBufSize
sendBufSize: sendBufSize
semaIndex: semaIndex! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketDestroy: socketID
"Release the resources associated with this socket. If a connection is open, it is aborted."
<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketDestroyGently: socketID
"Release the resources associated with this socket. If a connection is open, it is aborted.
Do not fail if the receiver is already closed."
<primitive: 'primitiveSocketDestroy' module: 'SocketPlugin'>
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketError: socketID
"Return an integer encoding the most recent error on this socket. Zero means no error."
<primitive: 'primitiveSocketError' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketLocalAddress: socketID
"Return the local host address for this socket."
<primitive: 'primitiveSocketLocalAddress' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketLocalPort: socketID
"Return the local port for this socket, or zero if no port has yet been assigned."
<primitive: 'primitiveSocketLocalPort' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketReceiveDataAvailable: socketID
"Return true if data may be available for reading from the current socket."
<primitive: 'primitiveSocketReceiveDataAvailable' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketRemoteAddress: socketID
"Return the remote host address for this socket, or zero if no connection has been made."
<primitive: 'primitiveSocketRemoteAddress' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketRemotePort: socketID
"Return the remote port for this socket, or zero if no connection has been made."
<primitive: 'primitiveSocketRemotePort' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'primitives' stamp: 'ar 2/2/2001 15:09'!
primSocketSendDone: socketID
"Return true if there is no send in progress on the current socket."
<primitive: 'primitiveSocketSendDone' module: 'SocketPlugin'>
self primitiveFailed
! !
!Socket methodsFor: 'registry' stamp: 'ar 3/21/98 17:40'!
register
^self class register: self! !
!Socket methodsFor: 'registry' stamp: 'ar 3/21/98 17:41'!
unregister
^self class unregister: self! !
!Socket methodsFor: 'finalization' stamp: 'JMM 5/22/2000 22:52'!
finalize
self primSocketDestroyGently: socketHandle.
Smalltalk unregisterExternalObject: semaphore.
Smalltalk unregisterExternalObject: readSemaphore.
Smalltalk unregisterExternalObject: writeSemaphore.
! !
!Socket methodsFor: 'printing' stamp: 'jm 11/23/1998 11:57'!
printOn: aStream
super printOn: aStream.
aStream nextPutAll: '[', self statusString, ']'.
! !
!Socket methodsFor: 'datagrams' stamp: 'JMM 6/7/2000 14:58'!
receiveDataInto: aStringOrByteArray fromHost: hostAddress port: portNumber
| datagram |
"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."
primitiveOnlySupportsOneSemaphore ifTrue:
[self setPeer: hostAddress port: portNumber.
^self receiveDataInto: aStringOrByteArray].
[true] whileTrue:
[datagram _ self receiveUDPDataInto: aStringOrByteArray.
((datagram at: 2) = hostAddress and: [(datagram at: 3) = portNumber])
ifTrue: [^datagram at: 1]
ifFalse: [^0]]! !
!Socket methodsFor: 'datagrams' stamp: 'JMM 6/3/2000 21:54'!
receiveUDPDataInto: aStringOrByteArray
"Receive UDP data into the given buffer and return the number of bytes received. Note the given buffer may be only partially filled by the received data. What is returned is an array, the first element is the bytes read, the second the sending bytearray address, the third the senders port, the fourth, true if more of the datagram awaits reading"
^ self primSocket: socketHandle
receiveUDPDataInto: aStringOrByteArray
startingAt: 1
count: aStringOrByteArray size
! !
!Socket methodsFor: 'datagrams' stamp: 'JMM 5/25/2000 00:05'!
sendData: aStringOrByteArray toHost: hostAddress port: portNumber
"Send a UDP packet containing the given data to the specified host/port."
primitiveOnlySupportsOneSemaphore ifTrue:
[self setPeer: hostAddress port: portNumber.
^self sendData: aStringOrByteArray].
^self sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber! !
!Socket methodsFor: 'datagrams' stamp: 'mir 5/15/2003 18:34'!
sendUDPData: aStringOrByteArray toHost: hostAddress port: portNumber
"Send a UDP packet containing the given data to the specified host/port."
| bytesToSend bytesSent count |
bytesToSend _ aStringOrByteArray size.
bytesSent _ 0.
[bytesSent < bytesToSend] whileTrue: [
(self waitForSendDoneFor: 20)
ifFalse: [ConnectionTimedOut signal: 'send data timeout; data not sent'].
count _ self primSocket: socketHandle
sendUDPData: aStringOrByteArray
toHost: hostAddress
port: portNumber
startIndex: bytesSent + 1
count: bytesToSend - bytesSent.
bytesSent _ bytesSent + count].
^ bytesSent
! !
!Socket methodsFor: 'datagrams' stamp: 'ar 4/30/1999 04:29'!
setPeer: hostAddress port: port
"Set the default send/recv address."
self primSocket: socketHandle connectTo: hostAddress port: port.
! !
!Socket methodsFor: 'datagrams' stamp: 'ar 4/30/1999 04:29'!
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: 'mir 2/22/2002 16:25'!
getOption: aName
"Get options on this socket, see Unix man pages for values for
sockets, IP, TCP, UDP. IE SO_KEEPALIVE
returns an array, element one is an status number (0 ok, -1 read only option)
element two is the resulting of the requested option"
(socketHandle == nil or: [self isValid not])
ifTrue: [InvalidSocketStatusException signal: 'Socket status must valid before getting an option'].
^self primSocket: socketHandle getOption: aName
"| foo options |
Socket initializeNetwork.
foo _ Socket newTCP.
foo connectTo: (NetNameResolver addressFromString: '192.168.1.1') port: 80.
foo waitForConnectionUntil: (Socket standardDeadline).
options _ {
'SO_DEBUG'. 'SO_REUSEADDR'. 'SO_REUSEPORT'. 'SO_DONTROUTE'.
'SO_BROADCAST'. 'SO_SNDBUF'. 'SO_RCVBUF'. 'SO_KEEPALIVE'.
'SO_OOBINLINE'. 'SO_PRIORITY'. 'SO_LINGER'. 'SO_RCVLOWAT'.
'SO_SNDLOWAT'. 'IP_TTL'. 'IP_HDRINCL'. 'IP_RCVOPTS'.
'IP_RCVDSTADDR'. 'IP_MULTICAST_IF'. 'IP_MULTICAST_TTL'.
'IP_MULTICAST_LOOP'. 'UDP_CHECKSUM'. 'TCP_MAXSEG'.
'TCP_NODELAY'. 'TCP_ABORT_THRESHOLD'. 'TCP_CONN_NOTIFY_THRESHOLD'.
'TCP_CONN_ABORT_THRESHOLD'. 'TCP_NOTIFY_THRESHOLD'.
'TCP_URGENT_PTR_TYPE'}.
1 to: options size do: [:i | | fum |
fum _foo getOption: (options at: i).
Transcript show: (options at: i),fum printString;cr].
foo _ Socket newUDP.
foo setPeer: (NetNameResolver addressFromString: '192.168.1.9') port: 7.
foo waitForConnectionUntil: (Socket standardDeadline).
1 to: options size do: [:i | | fum |
fum _foo getOption: (options at: i).
Transcript show: (options at: i),fum printString;cr].
"! !
!Socket methodsFor: 'other' stamp: 'mir 2/22/2002 16:30'!
setOption: aName value: aValue
| value |
"setup options on this socket, see Unix man pages for values for
sockets, IP, TCP, UDP. IE SO_KEEPALIVE
returns an array, element one is the error number
element two is the resulting of the negotiated value.
See getOption for list of keys"
(socketHandle == nil or: [self isValid not])
ifTrue: [InvalidSocketStatusException signal: 'Socket status must valid before setting an option'].
value _ aValue asString.
aValue == true ifTrue: [value _ '1'].
aValue == false ifTrue: [value _ '0'].
^ self primSocket: socketHandle setOption: aName value: value! !
!Socket methodsFor: 'sending-receiving objects' stamp: 'edc 8/2/2005 08:10'!
getObject
"gets a serialized object from this socket"
| encoded newObject |
encoded := RWBinaryOrTextStream on: ''.
[encoded size isZero]
whileTrue: [encoded nextPutAll: self getData].
[self isConnected
and: [self dataAvailable]]
whileTrue: [encoded nextPutAll: self getData].
encoded reset.
newObject := encoded fileInObjectAndCode.
^newObject
! !
!Socket methodsFor: 'sending-receiving objects' stamp: 'edc 8/2/2005 06:45'!
sendObject: anObject
"sends a serialized object to this socket"
| encoded |
encoded _ SmartRefStream streamedRepresentationOf: anObject.
self sendData: encoded! !
!Socket class methodsFor: 'class initialization' stamp: 'ar 12/12/2001 19:12'!
initialize
"Socket initialize"
"Socket Types"
TCPSocketType _ 0.
UDPSocketType _ 1.
"Socket Status Values"
InvalidSocket _ -1.
Unconnected _ 0.
WaitingForConnection _ 1.
Connected _ 2.
OtherEndClosed _ 3.
ThisEndClosed _ 4.
RegistryThreshold _ 100. "# of sockets"! !
!Socket class methodsFor: 'instance creation' stamp: 'ls 9/24/1999 09:45'!
acceptFrom: aSocket
^[ super new acceptFrom: aSocket ]
repeatWithGCIf: [ :sock | sock isValid not ]! !
!Socket class methodsFor: 'instance creation' stamp: 'ar 4/30/1999 04:15'!
createIfFail: failBlock
"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
"Note: The default creates a TCP socket"
^self tcpCreateIfFail: failBlock! !
!Socket class methodsFor: 'instance creation' stamp: 'ar 4/30/1999 04:13'!
new
"Return a new, unconnected Socket. Note that since socket creation may fail, it is safer to use the method createIfFail: to handle such failures gracefully; this method is primarily for backward compatibility and may be disallowed in a future release."
"Note: The default creates a TCP socket - this is also backward compatibility."
^self newTCP! !
!Socket class methodsFor: 'instance creation' stamp: 'mir 2/22/2002 15:48'!
newTCP
"Create a socket and initialise it for TCP"
self initializeNetwork.
^[ super new initialize: TCPSocketType ]
repeatWithGCIf: [ :socket | socket isValid not ]! !
!Socket class methodsFor: 'instance creation' stamp: 'mir 2/22/2002 15:49'!
newUDP
"Create a socket and initialise it for UDP"
self initializeNetwork.
^[ super new initialize: UDPSocketType ]
repeatWithGCIf: [ :socket | socket isValid not ]! !
!Socket class methodsFor: 'instance creation' stamp: 'mir 2/22/2002 15:49'!
tcpCreateIfFail: failBlock
"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
| sock |
self initializeNetwork.
sock _ super new initialize: TCPSocketType.
sock isValid ifFalse: [^ failBlock value].
^ sock
! !
!Socket class methodsFor: 'instance creation' stamp: 'mir 2/22/2002 15:49'!
udpCreateIfFail: failBlock
"Attempt to create a new socket. If successful, return the new socket. Otherwise, return the result of evaluating the given block. Socket creation can fail if the network isn't available or if there are not sufficient resources available to create another socket."
| sock |
self initializeNetwork.
sock _ super new initialize: UDPSocketType.
sock isValid ifFalse: [^ failBlock value].
^ sock
! !
!Socket class methodsFor: 'network initialization' stamp: 'mir 2/22/2002 15:01'!
initializeNetwork
"Initialize the network drivers and the NetNameResolver. Do nothing if the network is already initialized."
"Note: The network must be re-initialized every time Squeak starts up, so applications that persist across snapshots should be prepared to re-initialize the network as needed. Such applications should call 'Socket initializeNetwork' before every network transaction. "
NetNameResolver initializeNetwork! !
!Socket class methodsFor: 'network initialization' stamp: 'mir 2/22/2002 14:59'!
primInitializeNetwork: resolverSemaIndex
"Initialize the network drivers on platforms that need it, such as the Macintosh, and return nil if network initialization failed or the reciever if it succeeds. Since mobile computers may not always be connected to a network, this method should NOT be called automatically at startup time; rather, it should be called when first starting a networking application. It is a noop if the network driver has already been initialized. If non-zero, resolverSemaIndex is the index of a VM semaphore to be associated with the network name resolver. This semaphore will be signalled when the resolver status changes, such as when a name lookup query is completed."
"Note: some platforms (e.g., Mac) only allow only one name lookup query at a time, so a manager process should be used to serialize resolver lookup requests."
<primitive: 'primitiveInitializeNetwork' module: 'SocketPlugin'>
^ nil "return nil if primitive fails"
! !
!Socket class methodsFor: 'utilities' stamp: 'tk 4/9/98 15:54'!
deadServer
^ DeadServer! !
!Socket class methodsFor: 'utilities' stamp: 'tk 4/9/98 15:56'!
deadServer: aStringOrNil
"Keep the machine name of the most recently encoutered non-responding machine. Next time the user can move it to the last in a list of servers to try."
DeadServer _ aStringOrNil! !
!Socket class methodsFor: 'utilities' stamp: 'mir 5/15/2003 18:28'!
deadlineSecs: secs
"Return a deadline time the given number of seconds from now."
^ Time millisecondClockValue + (secs * 1000) truncated
! !
!Socket class methodsFor: 'utilities' stamp: 'jm 1/14/1999 12:13'!
nameForWellKnownTCPPort: portNum
"Answer the name for the given well-known TCP port number. Answer a string containing the port number if it isn't well-known."
| portList entry |
portList _ #(
(7 'echo') (9 'discard') (13 'time') (19 'characterGenerator')
(21 'ftp') (23 'telnet') (25 'smtp')
(80 'http') (110 'pop3') (119 'nntp')).
entry _ portList detect: [:pair | pair first = portNum] ifNone: [^ 'port-', portNum printString].
^ entry last
! !
!Socket class methodsFor: 'utilities' stamp: 'mir 5/15/2003 18:30'!
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 = 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'.
! !
!Socket class methodsFor: 'utilities' stamp: 'mir 2/22/2002 15:49'!
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"
| serverAddr sockets sock deadline done unconnectedCount connectedCount waitingCount result |
serverAddr _ NetNameResolver addressForName: hostName timeout: 10.
serverAddr = nil ifTrue: [
self inform: 'Could not find an address for ', hostName.
^ #()].
sockets _ portList collect: [:portNum |
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 millisecondClockValue > deadline ifTrue: [done _ true]].
result _ (sockets select: [:s | s isConnected])
collect: [:s | self nameForWellKnownTCPPort: s remotePort].
sockets do: [:s | s destroy].
^ result
! !
!Socket class methodsFor: 'utilities' stamp: 'jm 1/14/1999 17:25'!
pingPortsOn: hostName
"Attempt to connect to a set of well-known sockets on the given host, and answer the names of the available ports."
"Socket pingPortsOn: 'www.disney.com'"
^ Socket
pingPorts: #(7 13 19 21 23 25 80 110 119)
on: hostName
timeOutSecs: 20
! !
!Socket class methodsFor: 'utilities' stamp: 'mir 5/15/2003 16:17'!
standardDeadline
"Return a default deadline time some seconds into the future."
^ self deadlineSecs: self standardTimeout
! !
!Socket class methodsFor: 'utilities' stamp: 'mir 5/15/2003 16:16'!
standardTimeout
^45
! !
!Socket class methodsFor: 'utilities' stamp: 'ar 4/30/1999 04:21'!
wildcardAddress
"Answer a don't-care address for use with UDP sockets."
^ByteArray new: 4 "0.0.0.0"! !
!Socket class methodsFor: 'utilities' stamp: 'ar 4/30/1999 04:21'!
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 class methodsFor: 'registry' stamp: 'ar 10/7/1998 14:40'!
register: anObject
WeakArray isFinalizationSupported ifFalse:[^anObject].
self registry add: anObject! !
!Socket class methodsFor: 'registry' stamp: 'ar 10/7/1998 14:40'!
registry
WeakArray isFinalizationSupported ifFalse:[^nil].
^Registry isNil
ifTrue:[Registry := WeakRegistry new]
ifFalse:[Registry].! !
!Socket class methodsFor: 'registry' stamp: 'ar 12/12/2001 19:12'!
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! !
!Socket class methodsFor: 'registry' stamp: 'ar 12/12/2001 19:12'!
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! !
!Socket class methodsFor: 'registry' stamp: 'ar 10/7/1998 15:22'!
unregister: anObject
WeakArray isFinalizationSupported ifFalse:[^anObject].
self registry remove: anObject ifAbsent:[]! !
Socket initialize!
More information about the Squeak-dev mailing list |