'From Squeak2.8 of 23 June 2000 [latest update: #2342] on 7 July 2000 at 11:46:11 am'! "Change Set: correspondents1b4JMM Date: 3 July 2000 Author: Craig Latta Changes by johnmci@smalltalkconsulting.com The framework handles much of the busywork in writing new clients and servers, and cleans up several things in the traditional Smalltalk streaming framework. It includes a NetStream class whose instances can stream over several different external resources, including TCP and UDP sockets, MIDI ports, files, and serial ports. Sockets work, the rest need more work at the primitive level. I implemented the entire framework in another Smalltalk implementation; I'm porting it to Squeak as time allows. For documentation see the original author's web pages at http://netjam.org/self/projects/smalltalk/ JMM changes enable correspondents tol uses the disney exception handlers, the disney socket primitives, and the disney serial and MIDI plugins. Do not file in over top of an older correspondents application, bad things might happen. As prereqs you need the JMMExternalTableByIndex, the JMMChgFlowPreSetup, and the streaming1g1JMM For testing see the JMMSUnitsForFlow change set"! Object subclass: #Correspondent instanceVariableNames: 'stream ' classVariableNames: 'ClientStreamCreationWithResolutionSelectors ClientStreamCreationWithoutResolutionSelectors ServerStreamCreationSelectors ' poolDictionaries: 'DefaultPorts TextConstants ' category: 'System-Networking'! !Correspondent commentStamp: '' prior: 0! Correspondent comment: ' I am an abstract Class. Instances of my concrete subclasses, Client and Server, implement endpoints in multiple-party transactions. Their interactions are specified by well-known protocols. For current release documentation, see http://www.netjam.org. Author: Craig Latta ' ! Correspondent subclass: #Client instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking'! !Client commentStamp: '' prior: 0! Client comment: ' I am an abstract Class. An instance of one of my concrete subclasses implements the consumer side of a consumer-producer network communication protocol. Author: Craig Latta ' ! Error subclass: #ExceptionBadExternalHandle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionBadSerialPortHandle instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionConnectionRefused instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionDateNotSet instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedConnectionStatusInquiry instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedConnectivityTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedMIDIPortClosingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedMIDIPortReadAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSerialPortConnectionAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSerialPortOpeningAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSerialPortReadingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSerialPortWritingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSocketReadingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedSocketWritingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedUDPSocketReadingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionFailedUDPSocketWritingAttempt instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionHeaderNotFound instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionListenRefused instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionNetworkTimeout instanceVariableNames: 'bytesRead ' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionNotEnoughElements instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionPositioningError instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionReadingInterrupted instanceVariableNames: 'bytesRead ' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Error subclass: #ExceptionUnresolvableHostname instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking-Errors'! Object subclass: #ExternalResource instanceVariableNames: 'handle handleIndex ' classVariableNames: 'ConditionNames Registry ' poolDictionaries: '' category: 'System-Support-External Resources'! !ExternalResource commentStamp: 'JMM 6/26/2000 13:14' prior: 0! ExternalResource comment: ' I am an abstract Class. Instances of my concrete subclasses represent resources used by the system but maintained outside of it. Examples include external storage and network resources. instance variable: handle an opaque SmallInteger, the meaning of which is defined externally, used in external operations involving an instance handleIndex The index of the handle in the external table Registry A weakArray of instances so finalization can occur if an instance is GCed Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! ExternalResource subclass: #InternetSocketAddress instanceVariableNames: 'hostname ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !InternetSocketAddress commentStamp: 'JMM 6/26/2000 13:48' prior: 0! InternetSocketAddress comment: ' My instances indicate host/port combinations for InternetSockets. Each instance consists of six bytes: four to indicate a host, and two to indicate a port. Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! ExternalResource subclass: #NetResource instanceVariableNames: 'readSemaphore writeSemaphore readSemaphoreIndex writeSemaphoreIndex timedOut ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !NetResource commentStamp: 'JMM 6/26/2000 13:57' prior: 0! NetResource comment: ' I am an abstract Class. Instances of my concrete subclasses represent network resources. Said resources are distinguished from others by their potentially unbounded content length. instance variables: readingSemaphore a Semaphore used for suspending the Process of a sender which wants to read from an instance readingSemaphoreIndex index of readingSemaphore in external table writingSemaphore a Semaphore used for suspending the Process of a sender which wants to write to an instance writingSemaphoreIndex index of writingSemaphore in external table Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! NetResource subclass: #HardwarePort instanceVariableNames: 'portNumber ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !HardwarePort commentStamp: 'JMM 7/3/2000 13:13' prior: 0! HardwarePort comment: ' I am an abstract Class. Instances of my concrete subclasses represent serial port resources. Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! NetResource subclass: #InternetSocket instanceVariableNames: 'address openCloseSemaphore openCloseSemaphoreIndex primitiveOnlySupportsOneSemaphore ' classVariableNames: 'Connected InvalidSocket OtherEndClosed TCPSocketType ThisEndClosed UDPSocketType Unconnected WaitingForConnection ' poolDictionaries: '' category: 'System-Support-External Resources'! !InternetSocket commentStamp: 'JMM 6/26/2000 15:39' prior: 0! InternetSocket comment: ' I am an abstract Class. Instances of my concrete subclasses are conduits of information between the local host and remote Internet hosts. An instance may either be a source of information (a "server") or a sink of information (a "client"). Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! NetResource subclass: #InternetSocketAddressResolver instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !InternetSocketAddressResolver commentStamp: '' prior: 0! InternetSocketAddressResolver comment: ' My instances resolve InternetSocketAddresses for InternetSockets. Author: Craig Latta ' ! HardwarePort subclass: #MIDIPort instanceVariableNames: 'numberOfBytesRead ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! Client subclass: #RegressionTestClient instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking'! Client subclass: #SerialCorrespondent instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking'! !SerialCorrespondent commentStamp: '' prior: 0! SerialCorrespondent comment: ' I am an abstract Class. Instances of my concrete subclasses provide bidirectional, peer-to-peer communications with external serial devices. Author: Craig Latta ' ! HardwarePort subclass: #SerialPort instanceVariableNames: 'foo baudRate numberOfDataBits numberOfStartBits numberOfStopBits parityScheme useXOnXOffFlowControl isAsynchronous isExternallyClocked useDTR useCTS xOnByte xOffByte ' classVariableNames: 'ParitySchemes ' poolDictionaries: '' category: 'System-Support-External Resources'! !SerialPort commentStamp: '' prior: 0! SerialPort comment: ' My instances support communication via serial ports. I am intended to have at most one instance per hardware serial port. Author: Craig Latta ' ! Correspondent subclass: #Server instanceVariableNames: 'clients port clientsLock listeningTask ' classVariableNames: '' poolDictionaries: '' category: 'System-Networking'! !Server commentStamp: '' prior: 0! Server comment: ' I am an abstract Class. An instance of one of my concrete subclasses implements the producer side of a consumer-producer network communication protocol. Author: Craig Latta ' ! Server subclass: #RegressionTestServer instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Networking'! Server class instanceVariableNames: 'defaultServer '! InternetSocket subclass: #TCPSocket instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !TCPSocket commentStamp: 'JMM 6/26/2000 15:39' prior: 0! TCPSocket comment: ' My instances are conduits of information between the local host and remote hosts, using the Transmission Control Protocol (TCP). Author: Craig Latta Altered by johnmci@smalltalkconsulting.com to use disney primitives' ! TCPSocket subclass: #ClientTCPSocket instanceVariableNames: 'peerClosed ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !ClientTCPSocket commentStamp: '' prior: 0! ClientTCPSocket comment: ' I am an abstract Class. Instances of my concrete subclasses are TCP sockets used for communicating to or from clients in a client/server relationship. Author: Craig Latta ' ! ClientTCPSocket subclass: #IncomingClientTCPSocket instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !IncomingClientTCPSocket commentStamp: '' prior: 0! IncomingClientTCPSocket comment: ' My instances are TCP sockets used by servers for communicating to clients in a client/server relationship. Author: Craig Latta ' ! ClientTCPSocket subclass: #OutgoingClientTCPSocket instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !OutgoingClientTCPSocket commentStamp: '' prior: 0! OutgoingClientTCPSocket comment: ' My instances are TCP sockets used for communicating from clients to servers in a client/server relationship. Author: Craig Latta ' ! TCPSocket subclass: #ServerTCPSocket instanceVariableNames: 'port queueSize ' classVariableNames: '' poolDictionaries: '' category: 'System-Support-External Resources'! !ServerTCPSocket commentStamp: '' prior: 0! ServerTCPSocket comment: ' My instances are TCP sockets used for accepting clients in client/server relationships. Author: Craig Latta ' ! InternetSocket subclass: #UDPSocket instanceVariableNames: 'port ' classVariableNames: 'MaximumPayloadSize ' poolDictionaries: '' category: 'System-Support-External Resources'! !UDPSocket commentStamp: '' prior: 0! UDPSocket comment: ' My instances are conduits of information between the local host and remote hosts, using the Unreliable Datagram Protocol (UDP). Author: Craig Latta ' ! !Correspondent methodsFor: 'control'! close "Close my stream." self isActive ifTrue: [stream close]! ! !Correspondent methodsFor: 'control'! connectToAddress: anInternetSocketAddress "Connect myself to anInternetSocketAddress." stream == nil ifTrue: [self stream: (self class clientStreamForAddress: anInternetSocketAddress)] ifFalse: [stream connectToAddress: anInternetSocketAddress]! ! !Correspondent methodsFor: 'control'! connectToPort: port atHostNamed: hostname "Connect to port at hostname." stream == nil ifTrue: [self stream: (self class clientStreamForPort: port atHostNamed: hostname)] ifFalse: [stream connectToPort: port atHostNamed: hostname]! ! !Correspondent methodsFor: 'control' stamp: 'crl 11/3/1999 03:48'! reopen "Reopen myself." self isActive ifFalse: [stream reopen]! ! !Correspondent methodsFor: 'control'! serveAtPort: port "Serve at port with queueSize." self serveAtPort: port queueSize: 10! ! !Correspondent methodsFor: 'control'! serveAtPort: port queueSize: queueSize "Serve at port with queueSize." stream == nil ifTrue: [stream _ self class serverStreamForPort: port queueSize: queueSize] ifFalse: [stream serveAtPort: port queueSize: queueSize]! ! !Correspondent methodsFor: 'control' stamp: 'JMM 6/26/2000 17:27'! stream ^stream! ! !Correspondent methodsFor: 'control'! stream: aNetStream "Set my stream to aNetStream." stream _ aNetStream. self binary ifTrue: [stream beBinary]! ! !Correspondent methodsFor: 'constants'! showStatements "Answer whether statements should be printed on the Transcript." "At first, it's useful. Later, it's annoying." ^false! ! !Correspondent methodsFor: 'printing'! printOn: aStream "Print a character-based description of myself on aStream." aStream nextPutAll: 'an '. self isActive ifFalse: [aStream nextPutAll: 'in']. aStream nextPutAll: 'active '; nextPutAll: self class name! ! !Correspondent methodsFor: 'testing'! isActive "Answer whether I'm active." ^stream ~~ nil and: [stream isActive]! ! !Correspondent methodsFor: 'testing'! isOpen "Answer whether I'm open." ^stream ~~ nil and: [stream isOpen]! ! !Correspondent methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:51'! binary "Answer whether I should communicate in binary." ^self class binary! ! !Correspondent methodsFor: 'accessing'! defaultPort "Answer my default internet port." ^self class defaultPort! ! !Correspondent methodsFor: 'accessing'! nextPutAll: aString "Append aString to my peer(s). Answer aString." ^self subclassResponsibility! ! !Correspondent methodsFor: 'accessing'! numberOfBytesRead "Answer the number of bytes read in the current reading operation." ^stream numberOfBytesRead! ! !Client methodsFor: 'commands'! sendCommand: command "Send command. Answer the first line of the server response (after the status token). If there is a negative response from the server, try to handle the associated error." ^self sendCommand: command withParameter: self undefinedParameter! ! !Client methodsFor: 'commands' stamp: 'crl 3/2/1999 17:37'! sendCommand: command withParameter: parameter "Send command with parameter. Answer the first line of the server response (after the status token). If there is a negative response from the server, try to handle the associated error." stream nextPutAll: command. parameter == nil ifFalse: [ (parameter isKindOf: String) ifTrue: [stream nextPutAll: parameter] ifFalse: [stream print: parameter]]. stream crlf! ! !Client methodsFor: 'commands'! undefinedParameter "Answer the undefined parameter." ^nil! ! !Client methodsFor: 'printing' stamp: 'crl 11/3/1999 03:39'! printOn: aStream "Print a character-based description of myself on aStream." | active | active _ self isActive. super printOn: aStream. active ifFalse: [aStream nextPutAll: ' which was']. aStream nextPutAll: ' connected to '; print: stream peerAddress. active ifFalse: [stream printInactivityExplanationOn: aStream]! ! !Client methodsFor: 'control'! connectToHostNamed: hostname "Connect to hostname in anticipation of a session." self connectToPort: self defaultPort atHostNamed: hostname! ! !Client methodsFor: 'accessing'! nextPutAll: aString "Append aString to my stream." ^stream nextPutAll: aString! ! !Correspondent class methodsFor: 'control'! clientStreamForAddress: anInternetSocketAddress "Answer a client stream for anInternetSocketAddress." ^NetStream perform: self clientStreamCreationWithoutResolutionSelector with: anInternetSocketAddress! ! !Correspondent class methodsFor: 'control'! clientStreamForPort: port atHostNamed: hostname "Answer a client stream for port at hostname." ^NetStream perform: self clientStreamCreationWithResolutionSelector with: port with: hostname! ! !Correspondent class methodsFor: 'control'! serverStreamForPort: port queueSize: queueSize "Answer a server stream for port with queueSize." ^NetStream perform: self serverStreamCreationSelector with: port with: queueSize! ! !Correspondent class methodsFor: 'initialization'! initialize "Initialize myself." "Correspondent initialize" ClientStreamCreationWithoutResolutionSelectors _ ( (IdentityDictionary new) at: #tcp put: #tcpClientToAddress:; at: #udp put: #udpClientToAddress:; yourself). ClientStreamCreationWithResolutionSelectors _ ( (IdentityDictionary new) at: #tcp put: #tcpClientToPort:atHostNamed:; at: #udp put: #udpClientToPort:atHostNamed:; yourself). ServerStreamCreationSelectors _ ( (IdentityDictionary new) at: #tcp put: #tcpServerAtPort:queueSize:; at: #udp put: #udpServerAtPort:queueSize:; yourself). DefaultPorts at: #defaultIdentificationPorts put: #(113); at: #defaultIMAPPorts put: #(); at: #defaultIRCPorts put: #(6666 6667); at: #defaultMazeWarPorts put: #(7777); at: #defaultMIDIPorts put: #(7779); at: #defaultNNTPPorts put: #(119); at: #defaultPOPPorts put: #(110); at: #defaultRemoteFileStreamPorts put: #(2050); at: #defaultSMTPPorts put: #(25); at: #defaultTelnetPorts put: #(20); at: #defaultTFTPPorts put: #(69) ! ! !Correspondent class methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:50'! binary "Answer whether I should communicate in binary." ^self subclassResponsibility! ! !Correspondent class methodsFor: 'accessing'! clientStreamCreationWithResolutionSelector "Answer the NetStream selector to use for creating client streams for my instances." ^ClientStreamCreationWithResolutionSelectors at: self transport! ! !Correspondent class methodsFor: 'accessing'! clientStreamCreationWithoutResolutionSelector "Answer the NetStream selector to use for creating client streams for my instances." ^ClientStreamCreationWithoutResolutionSelectors at: self transport! ! !Correspondent class methodsFor: 'accessing'! defaultPort "Answer the default port at which my service is provided." ^self defaultPorts first! ! !Correspondent class methodsFor: 'accessing'! defaultPorts "Answer the ports at which my service is typically provided." ^self subclassResponsibility! ! !Correspondent class methodsFor: 'accessing' stamp: 'JMM 7/3/2000 22:50'! localHostname "Answer the local hostname." ^NetNameResolver nameForAddress: NetNameResolver localHostAddress timeout: 120 ! ! !Correspondent class methodsFor: 'accessing'! serverStreamCreationSelector "Answer the NetStream selector to use for creating server streams for my instances." ^ServerStreamCreationSelectors at: self transport! ! !Correspondent class methodsFor: 'accessing'! transport "Answer my mode of transport." ^self subclassResponsibility! ! !Client class methodsFor: 'examples'! example "Demonstrate reception." self needsWork! ! !Client class methodsFor: 'instance creation'! toAddress: anInternetSocketAddress "Answer an instance of myself connected to anInternetSocketAddress." ^self new connectToAddress: anInternetSocketAddress! ! !Client class methodsFor: 'instance creation'! toHostNamed: hostname "Answer an instance of myself connected to hostname." ^self new connectToHostNamed: hostname! ! !ExceptionBadExternalHandle methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:25'! isResumable ^false! ! !ExceptionBadSerialPortHandle methodsFor: 'exceptionDescription' stamp: 'JMM 6/27/2000 17:47'! isResumable ^false! ! !ExceptionConnectionRefused methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:35'! isResumable ^true! ! !ExceptionDateNotSet methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:31'! isResumable ^true! ! !ExceptionFailedConnectionStatusInquiry methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:39'! isResumable ^true! ! !ExceptionFailedConnectivityTest methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:08'! isResumable ^true! ! !ExceptionFailedMIDIPortClosingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:28'! isResumable ^true! ! !ExceptionFailedMIDIPortReadAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:29'! isResumable ^true! ! !ExceptionFailedSerialPortConnectionAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:45'! isResumable ^true! ! !ExceptionFailedSerialPortOpeningAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:44'! isResumable ^true! ! !ExceptionFailedSerialPortReadingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:47'! isResumable ^true! ! !ExceptionFailedSerialPortWritingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:48'! isResumable ^true! ! !ExceptionFailedSocketReadingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:49'! isResumable ^true! ! !ExceptionFailedSocketWritingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:50'! isResumable ^true! ! !ExceptionFailedUDPSocketReadingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:51'! isResumable ^true! ! !ExceptionFailedUDPSocketWritingAttempt methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:54'! isResumable ^true! ! !ExceptionHeaderNotFound methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:30'! isResumable ^true! ! !ExceptionListenRefused methodsFor: 'exceptionDescription' stamp: 'JMM 7/6/2000 17:10'! isResumable ^true! ! !ExceptionNetworkTimeout methodsFor: 'exceptionDescription' stamp: 'JMM 6/27/2000 17:51'! bytesRead bytesRead ifNil: [^0]. ^bytesRead! ! !ExceptionNetworkTimeout methodsFor: 'exceptionDescription' stamp: 'JMM 6/27/2000 17:49'! bytesRead: aNumber bytesRead _ aNumber.! ! !ExceptionNetworkTimeout methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:33'! isResumable ^true! ! !ExceptionNetworkTimeout class methodsFor: 'instance creation' stamp: 'JMM 6/27/2000 17:53'! bytesRead: argument ^self new bytesRead: argument; yourself! ! !ExceptionNotEnoughElements methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:41'! isResumable ^true! ! !ExceptionPositioningError methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:40'! isResumable ^true! ! !ExceptionReadingInterrupted methodsFor: 'exceptionDescription' stamp: 'JMM 6/27/2000 17:52'! bytesRead bytesRead ifNil: [^0]. ^bytesRead! ! !ExceptionReadingInterrupted methodsFor: 'exceptionDescription' stamp: 'JMM 6/27/2000 17:52'! bytesRead: aNumber bytesRead _ aNumber! ! !ExceptionReadingInterrupted methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 16:30'! isResumable ^true! ! !ExceptionReadingInterrupted class methodsFor: 'instance creation' stamp: 'JMM 6/27/2000 17:53'! bytesRead: argument ^self new bytesRead: argument; yourself! ! !ExceptionUnresolvableHostname methodsFor: 'exceptionDescription' stamp: 'JMM 6/23/2000 15:25'! isResumable ^true! ! !ExternalResource methodsFor: 'control' stamp: 'JMM 6/26/2000 18:52'! close "Close myself." "Subclasses should actually perform the required external action." handleIndex ~= 0 ifTrue: [Smalltalk unregisterExternalObjectAt: handleIndex]. handle notNil ifTrue: [self class unregister: self]. handle _ nil. handleIndex _ 0.! ! !ExternalResource methodsFor: 'control'! reopen "Reopen myself." self subclassResponsibility! ! !ExternalResource methodsFor: 'control'! restart "Restart myself, if I was active." self isActive ifTrue: [self reopen]! ! !ExternalResource methodsFor: 'finalization' stamp: 'JMM 6/26/2000 19:35'! finalize handleIndex ~= 0 ifTrue: [Smalltalk unregisterExternalObjectAt: handleIndex]. handleIndex _ 0.! ! !ExternalResource methodsFor: 'finalization' stamp: 'JMM 6/26/2000 13:05'! register ^self class register: self! ! !ExternalResource methodsFor: 'initialize' stamp: 'JMM 6/26/2000 13:01'! createHandlePost "Called via concrete classes" handleIndex _ Smalltalk registerExternalObject: handle. self register. ! ! !ExternalResource methodsFor: 'initialize' stamp: 'JMM 6/26/2000 12:46'! initialize handleIndex _ 0. ! ! !ExternalResource methodsFor: 'printing'! printOn: aStream "Print a character-based description of myself on aStream." aStream nextPutAll: 'an '. self isActive ifFalse: [aStream nextPutAll: 'in']. aStream nextPutAll: 'active '; print: self class! ! !ExternalResource methodsFor: 'testing' stamp: 'JMM 6/23/2000 23:35'! handleIsStale "Answer whether my handle is stale." ^(Smalltalk externalObjectAt: handleIndex) == nil! ! !ExternalResource methodsFor: 'testing' stamp: 'crl 11/3/1999 03:25'! isActive "Answer whether I'm active. In general, active means both myself and my peer(s) consider there to be a connection." ^self isOpen! ! !ExternalResource methodsFor: 'testing' stamp: 'crl 11/3/1999 03:26'! isOpen "Answer whether I'm open. In general, open means that I consider there to be a connection with my peer(s), but it/they may not necessarily agree." "My handle may be stale if I was open before the most recent system resumption." (handle notNil and: [self handleIsStale]) ifTrue: [handle _ nil]. ^handle notNil! ! !ExternalResource methodsFor: 'as yet unclassified' stamp: 'JMM 6/27/2000 12:48'! handle ^handle! ! !ExternalResource class methodsFor: 'initialization' stamp: 'crl 3/2/1999 17:16'! initialize "Initialize myself." ConditionNames _ ( (IdentityDictionary new) at: 1 put: #directoryFull; at: 2 put: #diskFull; at: 3 put: #noSuchVolume; at: 4 put: #ioError; at: 5 put: #badNameWhenMovingFile; at: 6 put: #fileNotOpen; at: 7 put: #endOfFile; at: 8 put: #positonBeforeStartOfFile; at: 9 put: #memoryFull; at: 10 put: #tooManyFilesOpen; at: 11 put: #fileNotFound; at: 12 put: #writeProtected; at: 13 put: #fileLocked; at: 14 put: #volumeLocked; at: 15 put: #fileBusyDirEmptyWorkingDirectoryOpen; at: 16 put: #alreadyExists; at: 17 put: #alreadyOpenForWriting; at: 18 put: #noDefaultVolumeParameterErrorEtc; at: 19 put: #badFileHandle; at: 20 put: #getFilePosition; at: 21 put: #permissionsError; at: 22 put: #externalFileSystem; at: 23 put: #rename; at: 24 put: #badMasterDirectoryBlock; at: 25 put: #writePermissions; at: 26 put: #directoryNotFoundOrBadPath; at: 27 put: #cannotMoveIntoOffspring; at: 28 put: #serverVolumeDisconnected; at: 29 put: #noForegroundProcess; at: 30 put: #notDirectory; at: 31 put: #serverFilenameMismatch; at: 32 put: #notFile; at: 33 put: #dateTimeFormat; at: 34 put: #makeDirectoryError; at: 35 put: #badArgument; at: 36 put: #badArgument; at: 37 put: #badCommand; at: 38 put: #illegalCharacters; at: 39 put: #badInstVarClass; at: 40 put: #readBufferOverrun; at: 41 put: #nullExternalPathSegmentsNotSupported; at: 42 put: #fileCrossVolumeMoveError; at: 43 put: #accessDenied; at: 44 put: #denyConflict; yourself)! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:49'! failedSocketReadingAttemptSignal ^ExceptionFailedSocketReadingAttempt! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:50'! failedSocketWritingAttemptSignal ^ExceptionFailedSocketWritingAttempt! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:51'! failedUDPSocketReadingAttemptSignal ^ExceptionFailedUDPSocketReadingAttempt! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:54'! failedUDPSocketWritingAttemptSignal ^ExceptionFailedUDPSocketWritingAttempt! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:33'! networkTimeoutSignal ^ExceptionNetworkTimeout! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:43'! notEnoughElementsSignal ^ExceptionNotEnoughElements! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 15:40'! positioningErrorSignal ^ExceptionPositioningError! ! !ExternalResource class methodsFor: 'Signal constants' stamp: 'JMM 6/23/2000 16:30'! readingInterruptedSignal ^ExceptionReadingInterrupted! ! !ExternalResource class methodsFor: 'weak' stamp: 'JMM 6/23/2000 18:26'! register: anObject WeakArray isFinalizationSupported ifFalse:[^anObject]. self registry add: anObject! ! !ExternalResource class methodsFor: 'weak' stamp: 'JMM 6/23/2000 18:26'! registry WeakArray isFinalizationSupported ifFalse:[^nil]. ^Registry isNil ifTrue:[Registry := WeakRegistry new] ifFalse:[Registry].! ! !ExternalResource class methodsFor: 'weak' stamp: 'JMM 6/23/2000 18:26'! unregister: anObject WeakArray isFinalizationSupported ifFalse:[^anObject]. self registry remove: anObject ifAbsent:[]! ! !InternetSocketAddress methodsFor: 'accessing'! at: index put: anObject "Put anObject at index." ^handle at: index put: anObject! ! !InternetSocketAddress methodsFor: 'accessing'! bytes "Answer my bytes." ^handle! ! !InternetSocketAddress methodsFor: 'accessing'! hostBytes "Answer the bytes of the IP address of the host I describe." ^handle copyFrom: 1 to: 4! ! !InternetSocketAddress methodsFor: 'accessing'! hostNumber "Answer the number of the host I describe (fully-qualified), as a String." | numberStream | numberStream _ (String new: 15) writeableStream. (self hostBytes) printOn: numberStream withDelimiter: $.. ^numberStream contents! ! !InternetSocketAddress methodsFor: 'accessing' stamp: 'JMM 6/24/2000 01:19'! hostname "Answer my hostname." (hostname == nil and: [(handle select: [:byte | byte ~= 0]) size > 0]) ifTrue: [ hostname _ String new: 512. self nameForIPAddress: self hostBytes into: hostname. hostname _ hostname trimBlanksAndZeros]. ^hostname! ! !InternetSocketAddress methodsFor: 'accessing' stamp: 'JMM 6/24/2000 01:19'! nameForIPAddress: ipAddress into: aString "Answer the name of the host which corresponds to ipAddress." | string | NetNameResolver initializeNetworkIfFail: [self error: 'network initialization failed']. string _ NetNameResolver nameForAddress: ipAddress timeout: 60. string isNil ifTrue: [self error: 'Lookup Failed']. aString replaceFrom: 1 to: string size with: string! ! !InternetSocketAddress methodsFor: 'accessing'! port "Answer the port of the address I describe." ^(handle at: 5) + ((handle at: 6) bitShift: 8)! ! !InternetSocketAddress methodsFor: 'initialization' stamp: 'JMM 6/26/2000 15:26'! close ^self! ! !InternetSocketAddress methodsFor: 'initialization' stamp: 'JMM 6/26/2000 15:25'! finalize ^self! ! !InternetSocketAddress methodsFor: 'initialization'! hostname: aString "Set my hostname to aString." hostname _ aString! ! !InternetSocketAddress methodsFor: 'initialization' stamp: 'crl 11/3/1999 01:55'! initialize "Initialize myself." "I consist of four bytes indicating a host, and two bytes indicating a port." handle _ ByteArray new: 6! ! !InternetSocketAddress methodsFor: 'initialization'! port: port ipAddress: ipAddress "Set my handle from port and ipAddress." handle replaceFrom: 1 to: 4 with: ipAddress. handle at: 5 put: (port bitAnd: 255); at: 6 put: (port bitShift: -8)! ! !InternetSocketAddress methodsFor: 'comparing'! = anInternetSocketAddress "Answer whether I am equivalent to anInternetSocketAddress." ^self bytes = anInternetSocketAddress bytes! ! !InternetSocketAddress methodsFor: 'comparing'! hash "Answer a hash value for all objects equivalent to me." ^self bytes! ! !InternetSocketAddress methodsFor: 'printing' stamp: 'crl 11/3/1999 03:09'! printOn: aStream "Print a character-based description of myself on aStream." (hostname == nil and: [self isActive not]) ifTrue: [aStream nextPutAll: 'no particular address'] ifFalse: [ self isActive ifTrue: [ self port = 0 ifTrue: [^aStream nextPutAll: '(an unknown internet socket address)']. aStream nextPutAll: 'port '; print: self port; nextPutAll: ' at ']. aStream nextPutAll: ( self hostname isEmpty ifTrue: ['(name unknown)'] ifFalse: [hostname]); nextPutAll: ' ('; nextPutAll: ( self isActive ifTrue: [self hostNumber] ifFalse: ['unresolved']); nextPut: $)]! ! !InternetSocketAddress methodsFor: 'testing' stamp: 'crl 11/3/1999 01:59'! handleIsStale "Answer whether my handle is stale." ^false! ! !InternetSocketAddress methodsFor: 'testing'! unresolved "Answer whether I am unresolved." 1 to: 4 do: [:index | (handle at: index) = 0 ifFalse: [^false]]. ^true! ! !InternetSocketAddress class methodsFor: 'instance creation'! forHostNamed: hostname "Answer a new instance of myself for the host named hostname." ^self new hostname: hostname! ! !InternetSocketAddress class methodsFor: 'instance creation'! forPort: port atHostWithIPAddress: ipAddress "Answer an instance of myself for port at the host with IP address ipAddress." ^self new port: port ipAddress: ipAddress! ! !InternetSocketAddress class methodsFor: 'instance creation'! new "Answer a new initialized instance of myself." ^super new initialize! ! !NetResource methodsFor: 'accessing'! next: anInteger into: aByteArray startingAt: startIndex "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." ^self subclassResponsibility! ! !NetResource methodsFor: 'accessing'! nextPut: anInteger from: aByteArray startingAt: startIndex "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." ^self subclassResponsibility! ! !NetResource methodsFor: 'accessing'! peerAddress "Assuming I'm connection-oriented, answer my peer address." ^self subclassResponsibility! ! !NetResource methodsFor: 'finalization' stamp: 'JMM 6/26/2000 19:37'! finalize readSemaphoreIndex ~= 0 ifTrue: [Smalltalk unregisterExternalObjectAt: readSemaphoreIndex; unregisterExternalObjectAt: writeSemaphoreIndex]. writeSemaphoreIndex _ readSemaphoreIndex _ 0. super finalize ! ! !NetResource methodsFor: 'control' stamp: 'crl 3/16/1999 01:33'! close "Close myself." Smalltalk unregisterExternalObjectAt: readSemaphoreIndex; unregisterExternalObjectAt: writeSemaphoreIndex. readSemaphore _ writeSemaphore _ readSemaphoreIndex _ writeSemaphoreIndex _ nil. super close! ! !NetResource methodsFor: 'initialization' stamp: 'JMM 6/26/2000 16:21'! initialize "Initialize myself." super initialize. timedOut _ false. readSemaphore _ Semaphore new. readSemaphoreIndex _ Smalltalk registerExternalObject: readSemaphore. writeSemaphore _ Semaphore new. writeSemaphoreIndex _ Smalltalk registerExternalObject: writeSemaphore! ! !NetResource methodsFor: 'printing' stamp: 'JMM 6/26/2000 15:38'! printInactivityExplanationOn: aStream "Print an inactivity explanation on aStream." aStream nextPutAll: ', closed '; nextPutAll: self statusString,' '! ! !NetResource methodsFor: 'testing'! dataAvailable "Answer whether there is data available for reading." ^self dataAvailableForHandle: handle! ! !NetResource methodsFor: 'testing'! dataAvailableForHandle: theHandle "Answer whether there is data available for reading for the resource with theHandle." ^self subclassResponsibility! ! !NetResource methodsFor: 'testing' stamp: 'JMM 6/24/2000 00:07'! isConnected ^true! ! !NetResource methodsFor: 'testing'! peerClosed "Answer whether my peer closed the connection." "This is only possible for ClientTCPSockets." ^false! ! !NetResource methodsFor: 'testing'! timedOut "Answer whether I missed a deadline in my most recent wait." ^self subclassResponsibility! ! !NetResource methodsFor: 'waiting' stamp: 'JMM 7/6/2000 02:32'! waitForReadabilityTimeoutAfter: timeoutInMilliseconds | deadLine | "Wait for readable data, or until timeoutInMilliseconds pass, whichever comes first. -1 is special case wait for ever, also some callers pass zero" timeoutInMilliseconds < 0 ifTrue: [[self isConnected and: [self dataAvailable not]] whileTrue: [self readSemaphore wait]. self dataAvailable ifFalse: [self class networkTimeoutSignal signal]. ^self]. deadLine _ Time millisecondClockValue + timeoutInMilliseconds. timedOut _ false. [self isConnected & self dataAvailable not "Connection end and final data can happen fast, so test in this order" and: [Time millisecondClockValue < deadLine]] whileTrue: [ self readSemaphore waitTimeoutMSecs: (deadLine - Time millisecondClockValue)]. self dataAvailable ifFalse: [((deadLine - Time millisecondClockValue - 1) < 0) ifTrue: [timedOut _ true]. self class networkTimeoutSignal signal] ! ! !NetResource methodsFor: 'waiting' stamp: 'JMM 7/6/2000 02:31'! waitForWriteability "Wait for writing space." "Writing space is typically in bountiful supply, so timeouts are effectively never necessary." [self isConnected and: [(self primSocketSendDone: handle) not] "Connection end and final data can happen fast, so test in this order"] whileTrue: [self writeSemaphore wait]. ! ! !HardwarePort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 14:37'! isConnected "Return true if this port is connected." ^(handle == nil) not! ! !HardwarePort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 15:28'! port "Answer my portNumber." ^self portNumber! ! !HardwarePort methodsFor: 'accessing' stamp: 'crl 3/12/1999 03:24'! portNumber "Answer my portNumber." ^portNumber! ! !HardwarePort methodsFor: 'accessing' stamp: 'JMM 6/26/2000 15:37'! statusString ^'Unknown'! ! !HardwarePort methodsFor: 'initialization' stamp: 'crl 3/12/1999 03:25'! portNumber: anInteger "Set my portNumber to anInteger." portNumber _ anInteger! ! !HardwarePort methodsFor: 'control' stamp: 'JMM 7/4/2000 12:59'! close "Close myself." self close: self handle. super close! ! !HardwarePort methodsFor: 'control' stamp: 'crl 3/12/1999 04:12'! close: portHandle "Close the port corresponding to portHandle." self subclassResponsibility! ! !HardwarePort methodsFor: 'control' stamp: 'JMM 7/4/2000 15:38'! primSocketSendDone: aHandle "hardware ports don't buffer, I think" ^true! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/23/2000 21:01'! 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" (handle == nil or: [self isValid not]) ifTrue: [self error: 'Socket status must valid before getting an option']. ^self primSocket: handle 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]. "! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/27/2000 20:42'! openCloseSemaphore ^openCloseSemaphore! ! !InternetSocket methodsFor: 'accessing'! peerAddress "Answer the InternetSocketAddress of my peer." ^address! ! !InternetSocket methodsFor: 'accessing'! port "Answer the local port to which I am listening, or the remote port to which I am connected." ^self subclassResponsibility! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/24/2000 01:47'! primitiveOnlySupportsOneSemaphore ^primitiveOnlySupportsOneSemaphore! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 12:06'! readSemaphore self primitiveOnlySupportsOneSemaphore ifTrue: [^openCloseSemaphore]. ^readSemaphore! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/24/2000 01:45'! socketError ^self primSocketError: handle! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/26/2000 15:36'! statusString "Return a string describing the status of this socket." | status | handle == nil ifTrue: [^ 'destroyed']. status _ self primSocketConnectionStatus: handle. 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' ! ! !InternetSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 12:06'! writeSemaphore self primitiveOnlySupportsOneSemaphore ifTrue: [^openCloseSemaphore]. ^writeSemaphore! ! !InternetSocket methodsFor: 'control' stamp: 'JMM 6/29/2000 02:24'! close "Close myself." self close: handle. super close. handle _ nil.! ! !InternetSocket methodsFor: 'control' stamp: 'JMM 6/29/2000 02:23'! close: socketHandle self closeAndDestroy: 20000. ! ! !InternetSocket methodsFor: 'control' stamp: 'JMM 6/30/2000 13:33'! closeAndDestroy: timeoutMilliseconds "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)." handle = nil ifFalse: [self isConnected ifTrue: [self primSocketCloseConnection: handle. (self waitForDisconnectionUntil: timeoutMilliseconds) ifFalse: ["if the other end doesn't close soon, just abort the connection" self primSocketAbortConnection: handle] ]. [self primSocketDestroy: handle] on: Error do: [:ex | ex return]. Smalltalk unregisterExternalObjectAt: openCloseSemaphoreIndex. openCloseSemaphore _ openCloseSemaphoreIndex _ nil]. ! ! !InternetSocket methodsFor: 'control'! connectToAddress: targetAddress "If I'm a datagram socket (UDP), specify the remote targetAddress to which future traffic should be sent. If I'm a stream socket (TCP), attempt to connect to targetAddress." address _ targetAddress! ! !InternetSocket methodsFor: 'control' stamp: 'JMM 6/23/2000 21:02'! 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" (handle == nil or: [self isValid not]) ifTrue: [self error: 'Socket status must valid before setting an option']. value _ aValue asString. aValue == true ifTrue: [value _ '1']. aValue == false ifTrue: [value _ '0']. ^ self primSocket: handle setOption: aName value: value! ! !InternetSocket methodsFor: 'finalization' stamp: 'JMM 6/27/2000 01:24'! finalize self primSocketDestroyGently: handle. openCloseSemaphoreIndex ~= 0 ifTrue: [Smalltalk unregisterExternalObjectAt: openCloseSemaphoreIndex]. openCloseSemaphoreIndex _ 0. super finalize! ! !InternetSocket methodsFor: 'initialization' stamp: 'JMM 6/26/2000 13:03'! createHandle handle _ self primSocketCreateNetwork: 0 type: (self usesTCP ifTrue: [TCPSocketType] ifFalse: [UDPSocketType]) receiveBufferSize: 8000 "these are bogus" sendBufSize: 8000 semaIndex: openCloseSemaphoreIndex readSemaIndex: readSemaphoreIndex writeSemaIndex: writeSemaphoreIndex. handle notNil ifTrue: [self createHandlePost] ! ! !InternetSocket methodsFor: 'initialization' stamp: 'JMM 6/26/2000 16:21'! initialize "Initialize myself. Create fixed-address Semaphores for use with the waiting primitives." super initialize. primitiveOnlySupportsOneSemaphore _ false. openCloseSemaphore _ Semaphore new. openCloseSemaphoreIndex _ Smalltalk registerExternalObject: openCloseSemaphore. self createHandle. ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/30/2000 12:13'! 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." self error: 'connect to failed' ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 21:02'! 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" self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/30/2000 11:59'! 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." self class failedSocketReadingAttemptSignal signal. ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/30/2000 12:00'! 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." self class failedSocketWritingAttemptSignal signal. ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 21:02'! 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" self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 12:41'! 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." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 23:52'! 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." self error: 'Socket close problem' ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 20:16'! 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.)" ^ InvalidSocket ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 19:43'! 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." ^ nil "socket creation failed" ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 19:43'! 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" primitiveOnlySupportsOneSemaphore _ true. ^ self primSocketCreateNetwork: netType type: socketType receiveBufferSize: rcvBufSize sendBufSize: sendBufSize semaIndex: semaIndex! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 18:37'! primSocketDestroy: socketID "Release the resources associated with this socket. If a connection is open, it is aborted." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 12:42'! 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." ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/24/2000 01:45'! primSocketError: socketID "Return an integer encoding the most recent error on this socket. Zero means no error." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 14:51'! primSocketLocalAddress: socketID "Return the local host address for this socket." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 14:51'! primSocketLocalPort: socketID "Return the local port for this socket, or zero if no port has yet been assigned." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 18:46'! primSocketReceiveDataAvailable: socketID "Return true if data may be available for reading from the current socket." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 14:51'! primSocketRemoteAddress: socketID "Return the remote host address for this socket, or zero if no connection has been made." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 14:51'! primSocketRemotePort: socketID "Return the remote port for this socket, or zero if no connection has been made." self primitiveFailed ! ! !InternetSocket methodsFor: 'primitives' stamp: 'JMM 6/24/2000 01:38'! primSocketSendDone: socketID "Return true if there is no send in progress on the current socket." self primitiveFailed ! ! !InternetSocket methodsFor: 'testing' stamp: 'JMM 6/23/2000 18:46'! dataAvailableForHandle: theHandle "Answer whether there is data available for reading for the resource with theHandle." theHandle == nil ifTrue: [^ false]. ^ self primSocketReceiveDataAvailable: theHandle ! ! !InternetSocket methodsFor: 'testing' stamp: 'JMM 6/23/2000 19:50'! isConnected "Return true if this socket is connected." handle == nil ifTrue: [^ false]. ^ (self primSocketConnectionStatus: handle) == Connected ! ! !InternetSocket methodsFor: 'testing' stamp: 'crl 10/28/1999 17:09'! scribes "Answer whether I read or write (as opposed to accept)." ^true! ! !InternetSocket methodsFor: 'testing'! timedOut "Answer whether I missed a deadline in my most recent wait." ^self timedOut: handle! ! !InternetSocket methodsFor: 'testing' stamp: 'JMM 6/26/2000 16:14'! timedOut: socketHandle "Answer whether I missed a deadline in my most recent wait." ^timedOut! ! !InternetSocket methodsFor: 'testing'! usesTCP "Answer whether I use TCP." ^self subclassResponsibility! ! !InternetSocket methodsFor: 'waiting' stamp: 'JMM 7/6/2000 02:28'! waitForConnectionUntil: timeoutInMilliseconds "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 | timeoutInMilliseconds < 0 ifTrue: [[(status _ self primSocketConnectionStatus: handle) = WaitingForConnection] whileTrue: [self openCloseSemaphore wait]. ^status = Connected]. deadLine _ Time millisecondClockValue + timeoutInMilliseconds. timedOut _ false. [((status _ self primSocketConnectionStatus: handle) = WaitingForConnection) and: [Time millisecondClockValue < deadLine]] whileTrue: [self openCloseSemaphore waitTimeoutMSecs: (deadLine - Time millisecondClockValue)]. ((deadLine - Time millisecondClockValue - 1) < 0) ifTrue: [timedOut _ true]. ^status = Connected ! ! !InternetSocket methodsFor: 'waiting' stamp: 'JMM 6/30/2000 12:08'! waitForDisconnectionUntil: timeoutInMilliseconds "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" | status deadLine | deadLine _ Time millisecondClockValue + timeoutInMilliseconds. status _ self primSocketConnectionStatus: handle. [((status = Connected) or: [(status = ThisEndClosed)]) and: [Time millisecondClockValue < deadLine]] whileTrue: [ self openCloseSemaphore waitTimeoutMSecs: (deadLine - Time millisecondClockValue). status _ self primSocketConnectionStatus: handle]. ^ status ~= Connected ! ! !InternetSocketAddressResolver methodsFor: 'resolving' stamp: 'JMM 6/26/2000 13:43'! addressForPort: port atHostNamed: hostname "Answer an InternetSocketAddress for port at hostname." | address | address _ InternetSocketAddress forPort: port atHostWithIPAddress: (NetNameResolver addressForName: hostname). address unresolved ifTrue: [self class unresolvableHostnameSignal signal]. ^address! ! !InternetSocketAddressResolver methodsFor: 'initialization' stamp: 'JMM 6/24/2000 00:52'! initialize "Initialize myself." super initialize. handle _ nil. self startResolver: handle! ! !InternetSocketAddressResolver methodsFor: 'initialization' stamp: 'JMM 6/24/2000 00:52'! startResolver: resolverHandle "Start myself." NetNameResolver initializeNetworkIfFail: [self error: 'network initialization failed']! ! !InternetSocketAddressResolver methodsFor: 'control' stamp: 'JMM 6/23/2000 23:27'! close "Close myself." self close: handle. super close! ! !InternetSocketAddressResolver methodsFor: 'control' stamp: 'JMM 6/24/2000 00:51'! close: resolverHandle "Close myself." ! ! !MIDIPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:03'! next: anInteger into: aByteArray startingAt: startIndex | temp count | "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." temp _ ByteArray new: (aByteArray size - startIndex + 1). count _ self readFromPort: portNumber into: temp. count = 0 ifTrue: [^count]. aByteArray replaceFrom: startIndex to: startIndex+count-1 with: temp. ^count ! ! !MIDIPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:01'! nextEvent | temp | "Answer the next event." temp _ ByteArray new: 100. numberOfBytesRead _ self readFromPort: portNumber into: handle. ^temp copyFrom: 1 to: numberOfBytesRead! ! !MIDIPort methodsFor: 'accessing' stamp: 'JMM 6/26/2000 13:30'! readFromPort: thePortNumber into: buffer "Read bytes from the MIDI port indicated by portNumber into buffer. Answer the number of bytes read." self class failedMIDIPortReadAttemptSignal signal ! ! !MIDIPort methodsFor: 'control' stamp: 'crl 3/12/1999 17:43'! close "Close myself." self close: portNumber! ! !MIDIPort methodsFor: 'control' stamp: 'JMM 6/26/2000 13:29'! close: thePortNumber "Close the MIDI port with thePortNumber." self class failedMIDIPortClosingAttemptSignal signal ! ! !MIDIPort methodsFor: 'control' stamp: 'JMM 7/4/2000 12:17'! connectToPort: thePortNumber withReadSemaphoreAt: theReadSemaphoreIndex andInterfaceClockRate: interfaceClockRate "Connect to the MIDI port with thePortNumber, using the semaphore at theReadSemaphoreIndex in the external objects array to signal when data is available, and interfaceClockRate." self primMIDIconnectToPort: thePortNumber withReadSemaphoreAt: theReadSemaphoreIndex andInterfaceClockRate: interfaceClockRate. handle _ thePortNumber. self createHandlePost! ! !MIDIPort methodsFor: 'initialization' stamp: 'JMM 7/3/2000 14:00'! portNumber: anInteger "Set my portNumber to anInteger." portNumber _ anInteger. handle _ 1. self connectToPort: portNumber withReadSemaphoreAt: readSemaphoreIndex andInterfaceClockRate: 1000000! ! !MIDIPort methodsFor: 'testing' stamp: 'crl 3/12/1999 04:21'! timedOut "Answer whether I missed a deadline in my most recent wait." "I don't support timeouts yet." ^false! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:02'! primMIDIGetClock self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:02'! primMIDIGetPortCount self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:02'! primMIDIGetPortDirectionality: portNum self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:02'! primMIDIGetPortName: portNum self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:03'! primMIDIParameterGet: whichParameter self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 14:03'! primMIDIParameterSet: whichParameter to: newValue self primitiveFailed. ! ! !MIDIPort methodsFor: 'primitives' stamp: 'JMM 7/4/2000 12:15'! primMIDIconnectToPort: thePortNumber withReadSemaphoreAt: theReadSemaphoreIndex andInterfaceClockRate: interfaceClockRate "Connect to the MIDI port with thePortNumber, using the semaphore at theReadSemaphoreIndex in the external objects array to signal when data is available, and interfaceClockRate." self primitiveFailed! ! !NetResource class methodsFor: 'instance creation' stamp: 'crl 3/12/1999 03:18'! new "Answer a new initialized instance of myself." ^super new initialize! ! !HardwarePort class methodsFor: 'instance creation' stamp: 'crl 3/12/1999 03:27'! at: portNumber "Answer an instance of myself connected to the hardware port indicated by portNumber." ^self new portNumber: portNumber! ! !InternetSocket class methodsFor: 'initialization' stamp: 'JMM 6/23/2000 18:21'! initialize "Initialize myself." "InternetSocket initialize" "Socket Types" TCPSocketType _ 0. UDPSocketType _ 1. "Socket Status Values" InvalidSocket _ -1. Unconnected _ 0. WaitingForConnection _ 1. Connected _ 2. OtherEndClosed _ 3. ThisEndClosed _ 4. ! ! !InternetSocket class methodsFor: 'initialization' stamp: 'JMM 6/23/2000 19:20'! shutDown "Stop the host platform's socket support." ! ! !InternetSocket class methodsFor: 'initialization' stamp: 'JMM 6/23/2000 23:57'! startIP "Initialize the host platform's socket support." NetNameResolver initializeNetworkIfFail: [self error: 'network initialization failed']. ! ! !InternetSocket class methodsFor: 'examples'! echoBytes "Echo some bytes to a remote server. Answer whether I was successful." ^self echoBytesOn: self echoClient! ! !InternetSocket class methodsFor: 'examples' stamp: 'JMM 6/24/2000 01:36'! echoBytesOn: aNetStream "Echo some bytes on aNetStream, which is connected to a remote host." ^[ | outgoingBytes | outgoingBytes _ 'fribbly\' withCRs. aNetStream nextPutAll: outgoingBytes. (aNetStream next: outgoingBytes size) = outgoingBytes ] ensure: [aNetStream close]! ! !InternetSocket class methodsFor: 'examples'! echoClient "Answer a NetStream connected to a remote server, for echoing bytes." ^self subclassResponsibility! ! !InternetSocket class methodsFor: 'examples'! echoServer "Answer an echo server which uses the appropriate transport mechanism." ^self subclassResponsibility! ! !InternetSocket class methodsFor: 'examples'! performExamples "Demonstrate internet sockets." "Run regression tests and answer the results." "InternetSocket performExamples" | results | results _ IdentityDictionary new. #(echoBytes reflectBytes) do: [:selector | (Array with: TCPSocket with: UDPSocket) do: [:class | results at: class name, '>>', selector put: (class perform: selector)]]. ^results! ! !InternetSocket class methodsFor: 'examples' stamp: 'JMM 6/24/2000 01:36'! reflectBytes "Reflect some bytes from a remote client. Answer whether I was successful." | server | ^[ server _ self echoServer. self reflectBytesVia: server ] ensure: [server close]! ! !InternetSocket class methodsFor: 'examples'! reflectBytesVia: serverStream "Reflect bytes via serverStream. Answer whether I was successful." ^self subclassResponsibility! ! !InternetSocket class methodsFor: 'examples' stamp: 'JMM 7/3/2000 14:57'! startUp | items | "Initialize the host platform's socket support, if needed" items _ (self registry asOrderedCollection select: [:e | e notNil]) size. items > 0 ifTrue: [self startIP]! ! !InternetSocket class methodsFor: 'instance creation'! clientToAddress: anInternetSocketAddress "Answer an instance of myself which can act as a client, connected to anInternetSocketAddress." ^self new connectToAddress: anInternetSocketAddress! ! !InternetSocketAddressResolver class methodsFor: 'utilities' stamp: 'JMM 6/24/2000 01:01'! addressForPort: port atHostNamed: hostname | address | "Answer an InternetSocketAddress for port at hostname." NetNameResolver initializeNetworkIfFail: [self error: 'network initialization failed']. address _ NetNameResolver addressForName: hostname. ^InternetSocketAddress forPort: port atHostWithIPAddress: address. ! ! !InternetSocketAddressResolver class methodsFor: 'utilities' stamp: 'JMM 6/24/2000 01:01'! bytesForHostNamed: hostname "Answer the bytes of the address number for the host named hostname." NetNameResolver initializeNetworkIfFail: [self error: 'network initialization failed']. ^(self addressForPort: 0 atHostNamed: hostname) hostBytes ! ! !InternetSocketAddressResolver class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:43'! unresolvableHostnameSignal ^ExceptionUnresolvableHostname! ! !MIDIPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:29'! failedMIDIPortClosingAttemptSignal ^ExceptionFailedMIDIPortClosingAttempt! ! !MIDIPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:30'! failedMIDIPortReadAttemptSignal ^ExceptionFailedMIDIPortReadAttempt! ! !RegressionTestClient class methodsFor: 'accessing' stamp: 'crl 11/5/1999 02:37'! binary "Answer whether I should communicate in binary." ^RegressionTestServer binary! ! !RegressionTestClient class methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:47'! defaultPorts "Answer the ports at which my service is typically provided." ^RegressionTestServer defaultPorts! ! !RegressionTestClient class methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:47'! transport "Answer my mode of transport." ^RegressionTestServer transport! ! !SerialCorrespondent methodsFor: 'accessing'! baudRate "Answer the baud rate I should use." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! defaultPort "Answer my default internet port." "This doesn't apply to serial connections." ^self shouldNotImplement! ! !SerialCorrespondent methodsFor: 'accessing'! numberOfDataBits "Answer the number of data bits per byte I should use." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! numberOfStartBits "Answer the number of start bits per byte I should use." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! numberOfStopBits "Answer the number of stop bits per byte I should use." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! parityScheme "Answer the parityScheme I should use (#none, #even, or #odd)." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! portNumber "Answer the number of the serial port I should use." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! useCTS "Answer whether I should use CTS." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! useDTR "Answer whether I should use DTR." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'accessing'! useXOnXOffFlowControl "Answer whether I should use xon-xoff flow control." ^self subclassResponsibility! ! !SerialCorrespondent methodsFor: 'control'! connectToSerialPortAt: serialPortNumber "Connect myself to the serial port at serialPortNumber." stream == nil ifTrue: [self stream: (NetStream onSerialPortAt: serialPortNumber)] ifFalse: [stream portNumber: serialPortNumber]! ! !SerialCorrespondent methodsFor: 'control'! connectToSerialPortAt: serialPortNumber atBaudRate: baudRate "Connect myself to the serial port at serialPortNumber, at baudRate." self connectToSerialPortAt: serialPortNumber. stream baudRate: baudRate! ! !SerialCorrespondent methodsFor: 'control'! initializeSerialPort "Initialize the serial port with which I will be communicating." stream == nil ifTrue: [self connectToSerialPortAt: self portNumber] ifFalse: [stream portNumber == nil ifTrue: [stream portNumber: self portNumber]]. stream baudRate == nil ifTrue: [stream baudRate: self baudRate]. stream numberOfDataBits: self numberOfDataBits; numberOfStopBits: self numberOfStopBits; parityScheme: self parityScheme; useDTR: self useDTR; useCTS: self useCTS; useXOnXOffFlowControl: self useXOnXOffFlowControl; reopen! ! !SerialCorrespondent class methodsFor: 'instance creation'! new "Answer a new initialized instance of myself." ^self basicNew initializeSerialPort! ! !SerialCorrespondent class methodsFor: 'instance creation'! toSerialPortAt: serialPortNumber "Answer an instance of myself connected to local serial port at serialPortNumber." ^(self basicNew) connectToSerialPortAt: serialPortNumber; initializeSerialPort! ! !SerialCorrespondent class methodsFor: 'instance creation'! toSerialPortAt: serialPortNumber atBaudRate: baudRate "Answer an instance of myself connected to local serial port at serialPortNumber, at baudRate." ^(self basicNew) connectToSerialPortAt: serialPortNumber atBaudRate: baudRate; initializeSerialPort! ! !SerialPort methodsFor: 'accessing'! baudRate "Answer the baudRate a communication channel should use." ^baudRate! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 13:15'! baudRate: anInteger "Set the baudRate a compliant communication channel should use to anInteger." baudRate _ anInteger. self restart! ! !SerialPort methodsFor: 'accessing'! beAsynchronous "Indicate that the channel over which traffic conforming to me is transmitted should be asynchronous." "Currently, the primitives assume this anyway, so this has no effect." isAsynchronous ifFalse: [ isAsynchronous _ true. self reopen]! ! !SerialPort methodsFor: 'accessing'! beExternallyClocked "Indicate that the channel over which traffic conforming to me is transmitted should be externally clocked (e.g., for a MIDI connection)." "Currently, the serial port primitives don't support this, so this has no effect." isExternallyClocked ifFalse: [ isExternallyClocked _ true. self reopen]! ! !SerialPort methodsFor: 'accessing'! doNotUseXOnXOffFlowControl "Record that a communication channel should not use xOn-xOff flow control." useXOnXOffFlowControl ifTrue: [ useXOnXOffFlowControl _ false. self reopen]! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 13:50'! handle "Answer my handle." ^self isOpen ifTrue: [^handle] ifFalse: [self class badSerialPortHandleSignal signal]! ! !SerialPort methodsFor: 'accessing'! next: anInteger into: aByteArray startingAt: startIndex "Read the next anInteger bytes into aByteArray, starting at startIndex. Answer the number of bytes actually read." ^self next: anInteger into: aByteArray startingAt: startIndex serialPort: self handle! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 15:41'! next: anInteger into: aByteArray startingAt: startIndex serialPort: serialPortHandle "Write the next anInteger bytes into aByteArray, starting at startIndex." ^self primReadPort: serialPortHandle into: aByteArray startingAt: startIndex count: (aByteArray size - startIndex) + 1. ! ! !SerialPort methodsFor: 'accessing'! nextPut: anInteger from: aByteArray startingAt: startIndex "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." ^self nextPut: anInteger from: aByteArray startingAt: startIndex serialPort: self handle! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 13:33'! nextPut: anInteger from: aByteArray startingAt: startIndex serialPort: serialPortHandle "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." ^self primWritePort: portNumber from: aByteArray startingAt: 1 count: aByteArray size. ! ! !SerialPort methodsFor: 'accessing'! numberOfDataBits "Answer the numberOfDataBits a communication channel should use." ^numberOfDataBits! ! !SerialPort methodsFor: 'accessing'! numberOfDataBits: anInteger "Set the number of data bits per data transmission to anInteger." numberOfDataBits _ anInteger. self restart! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 13:16'! numberOfStartBits: anInteger "Set the number of start bits per data transmission to anInteger." "The serial port primitives currently assume 1 start bit, so this has no effect." numberOfStartBits = anInteger ifFalse: [ numberOfStartBits _ anInteger. self restart]! ! !SerialPort methodsFor: 'accessing'! numberOfStopBits "Answer the numberOfStopBits a communication channel should use." ^numberOfStopBits! ! !SerialPort methodsFor: 'accessing'! numberOfStopBits: anInteger "Set the numberOfStopBits a communication channel should use to anInteger." numberOfStopBits _ anInteger. self restart! ! !SerialPort methodsFor: 'accessing'! parityScheme "Answer the parityScheme a communication channel should use." ^parityScheme! ! !SerialPort methodsFor: 'accessing'! parityScheme: aSymbol "Set the parityScheme a communication channel should use to aSymbol." parityScheme _ aSymbol. self restart! ! !SerialPort methodsFor: 'accessing'! peerAddress "Assuming I'm connection-oriented, answer my peer address." ^self printString asSymbol! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:11'! useCTS ^useCTS! ! !SerialPort methodsFor: 'accessing'! useCTS: aBoolean "Set whether I use CTS." useCTS _ aBoolean. self restart! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:11'! useDTR ^useDTR! ! !SerialPort methodsFor: 'accessing'! useDTR: aBoolean "Set whether I use DTR." useDTR _ aBoolean. self restart! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 13:17'! useXOnXOffFlowControl ^useXOnXOffFlowControl! ! !SerialPort methodsFor: 'accessing'! useXOnXOffFlowControl: aBoolean "Record that a compliant communication channel should use xOn-xOff flow control." useXOnXOffFlowControl _ aBoolean. self restart! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:12'! xOffByte ^xOffByte! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 13:17'! xOffByte: aByte xOffByte _ aByte. self restart.! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/3/2000 14:11'! xOnByte ^xOnByte! ! !SerialPort methodsFor: 'accessing' stamp: 'JMM 7/4/2000 13:17'! xOnByte: aByte xOnByte _ aByte. self restart! ! !SerialPort methodsFor: 'control' stamp: 'JMM 7/3/2000 23:07'! close: serialPortHandle "Close the serial port corresponding to serialPortHandle." portNumber ifNotNil: [self primClosePort: portNumber]. ! ! !SerialPort methodsFor: 'control' stamp: 'JMM 7/4/2000 14:15'! reopen "Reopen myself." self isOpen ifTrue: [self close]. super initialize. [self connectToSerialPortNumbered: portNumber baudRate: baudRate numberOfDataBits: numberOfDataBits numberOfStopBits: numberOfStopBits parityScheme: parityScheme useDTR: useDTR useCTS: useCTS useXOnXOffFlowControl: useXOnXOffFlowControl. ] on: self class failedSerialPortConnectionAttemptSignal do: [:exception | handle _ nil. exception pass]. ! ! !SerialPort methodsFor: 'initialization' stamp: 'JMM 7/4/2000 14:17'! connectToSerialPortNumbered: serialPortNumber baudRate: baudRateInteger numberOfDataBits: numberOfDataBitsInteger numberOfStopBits: numberOfStopBitsFloat parityScheme: paritySchemeSymbol useDTR: useDTRBoolean useCTS: useCTSBoolean useXOnXOffFlowControl: useXOnXOffFlowControlBoolean | inputFlowControlType outputFlowControlType stopBits parity | "Connect to the indicated serial port with the given parameters." handle isNil ifFalse: [self close]. baudRate _ baudRateInteger. numberOfDataBits _ numberOfDataBitsInteger. numberOfStopBits _ numberOfStopBitsFloat. parityScheme _ inputFlowControlType _useDTRBoolean ifTrue: [2] ifFalse: [useXOnXOffFlowControlBoolean ifTrue: [1] ifFalse: [0]]. outputFlowControlType _useCTSBoolean ifTrue: [2] ifFalse: [useXOnXOffFlowControlBoolean ifTrue: [1] ifFalse: [0]]. stopBits _ numberOfStopBitsFloat = 1.0 ifTrue: [1] ifFalse: [stopBits]. stopBits _ numberOfStopBitsFloat = 1.5 ifTrue: [0] ifFalse: [stopBits]. stopBits _ numberOfStopBitsFloat = 2.0 ifTrue: [2] ifFalse: [stopBits]. parityScheme _ paritySchemeSymbol. useXOnXOffFlowControl _ useXOnXOffFlowControlBoolean. useDTR _ useDTRBoolean. useCTS _ useCTSBoolean. parity _ ParitySchemes at: paritySchemeSymbol. self primOpenPort: serialPortNumber baudRate: baudRateInteger stopBitsType: stopBits parityType: parity dataBits: numberOfDataBits inFlowControlType: inputFlowControlType outFlowControlType: outputFlowControlType xOnByte: xOnByte xOffByte: xOffByte. portNumber _ serialPortNumber. handle _ serialPortNumber. self createHandlePost! ! !SerialPort methodsFor: 'initialization' stamp: 'JMM 7/3/2000 13:25'! initialize "Initialize myself." super initialize. portNumber _ 1. baudRate _ 9600. numberOfDataBits _ 8. numberOfStopBits _ 1. parityScheme _ #none. useXOnXOffFlowControl _ false. useDTR _ false. useCTS _ false. isAsynchronous _ true. isExternallyClocked _ false. xOnByte _ 19. "ctrl-S" xOffByte _ 24. "ctrl-X" ! ! !SerialPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 13:14'! primClosePort: aportNumber self class failedSerialPortOpeningAttemptSignal signal ! ! !SerialPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 13:23'! primOpenPort: aportNumber baudRate: baud stopBitsType: stop parityType: parity dataBits: numDataBits inFlowControlType: inFlowCtrl outFlowControlType: outFlowCtrl xOnByte: xOn xOffByte: xOff self class failedSerialPortConnectionAttemptSignal signal ! ! !SerialPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 13:34'! primReadPort: aportNumber into: byteArray startingAt: startIndex count: count self class failedSerialPortReadingAttemptSignal signal. ! ! !SerialPort methodsFor: 'primitives' stamp: 'JMM 7/3/2000 13:33'! primWritePort: aportNumber from: byteArray startingAt: startIndex count: count self class failedSerialPortWritingAttemptSignal signal. ! ! !SerialPort methodsFor: 'printing' stamp: 'crl 3/12/1999 03:26'! printOn: aStream "Print a Character-based description of myself on aStream." aStream nextPutAll: 'SerialPort '; print: portNumber; nextPutAll: ', '. self isActive ifFalse: [aStream nextPutAll: 'in']. aStream nextPutAll: 'active, '. isAsynchronous ifTrue: [aStream nextPut: $a] ifFalse: [aStream space]. aStream nextPutAll: 'synchronous'. isExternallyClocked ifTrue: [aStream nextPutAll: ', externally-clocked']. aStream nextPutAll: ', at '; print: baudRate; nextPutAll: ' bits per second, with '. numberOfStartBits = 0 ifTrue: [aStream nextPutAll: 'no'] ifFalse: [aStream nextPut: $1]. aStream nextPutAll: ' start bit, '; print: numberOfDataBits; nextPutAll: ' data bits, '; print: numberOfStopBits; nextPutAll: ' stop bit'. numberOfStopBits = 1 ifFalse: [aStream nextPut: $s]. aStream nextPutAll: ', '; nextPutAll: ( parityScheme = #none ifTrue: ['no'] ifFalse: [parityScheme]); nextPutAll: ' parity, and '; nextPutAll: ( useXOnXOffFlowControl ifTrue: ['xOn-xOff'] ifFalse: ['no']); nextPutAll: ' flow control'! ! !SerialPort methodsFor: 'testing'! dataAvailable "Answer whether there is data available for reading." ^self dataAvailableForHandle: self handle! ! !SerialPort methodsFor: 'testing' stamp: 'JMM 7/3/2000 13:55'! dataAvailableForHandle: serialPortHandle "Answer whether there is data available for reading for the resource with serialPortHandle. The Disney primitive doesn't know..." ^true "^self error: 'Data available for serial port failed'"! ! !SerialPort methodsFor: 'testing' stamp: 'JMM 7/4/2000 14:05'! isActive "Answer whether I'm active." ^(handle == nil) not! ! !SerialPort methodsFor: 'testing'! timedOut "Answer whether I missed a deadline in my most recent wait." "There are no signalling facilities available for serial ports in the first place." ^false! ! !SerialPort class methodsFor: 'initialization'! initialize "Initialize myself." ParitySchemes _ ( (IdentityDictionary new) at: #none put: 0; at: #odd put: 1; at: #even put: 2; yourself)! ! !SerialPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:25'! badSerialPortHandleSignal ^ExceptionBadSerialPortHandle! ! !SerialPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:31'! failedSerialPortConnectionAttemptSignal ^ExceptionFailedSerialPortConnectionAttempt! ! !SerialPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:31'! failedSerialPortOpeningAttemptSignal ^ExceptionFailedSerialPortOpeningAttempt! ! !SerialPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:31'! failedSerialPortReadingAttemptSignal ^ExceptionFailedSerialPortReadingAttempt! ! !SerialPort class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:31'! failedSerialPortWritingAttemptSignal ^ExceptionFailedSerialPortWritingAttempt! ! !Server methodsFor: 'control' stamp: 'crl 11/7/1999 20:54'! accept "Accept the next incoming client connection and start providing service to it." | client | client _ self client. clientsLock critical: [ clients at: ( [ self servesIndefinitely ifTrue: [[self serve: client] repeat] ifFalse: [ self serve: client; closeClient: client] ] forkAt: Processor lowIOPriority) put: client]! ! !Server methodsFor: 'control' stamp: 'JMM 7/3/2000 12:23'! basicCloseClient: client "Close client." "This method should be overridden if additional resource cleanup is required." client close. clients removeKey: (clients keyAtIdentityValue: client ifAbsent: [nil]) ifAbsent: []! ! !Server methodsFor: 'control' stamp: 'JMM 6/28/2000 19:28'! client "Answer the next available client." | client | client _ stream client. self binary ifTrue: [client beBinary]. ^client! ! !Server methodsFor: 'control' stamp: 'crl 11/7/1999 16:14'! close "Close myself." listeningTask terminate. "Since the listeningTask has been terminated, I no longer need to protect access to clients." clients copy keysAndValuesDo: [:process :client | process terminate. self basicCloseClient: client]. super close! ! !Server methodsFor: 'control' stamp: 'crl 11/5/1999 19:29'! closeClient: client "Close client." clientsLock critical: [self basicCloseClient: client]! ! !Server methodsFor: 'control'! reopen "Start accepting connections and providing service." self reopenAtPort: ( port == nil ifTrue: [self class defaultPort] ifFalse: [port])! ! !Server methodsFor: 'control' stamp: 'crl 11/7/1999 20:54'! reopenAtPort: anInteger "Start accepting connections at port anInteger and providing service." clientsLock _ Semaphore forMutualExclusion. clients _ IdentityDictionary new. self serveAtPort: anInteger. listeningTask _ ( [ [self accept] repeat ] forkAt: Processor highIOPriority)! ! !Server methodsFor: 'control'! serveAtPort: anInteger queueSize: queueSize "Serve at port anInteger with queueSize." port _ anInteger. super serveAtPort: port queueSize: queueSize! ! !Server methodsFor: 'testing'! servesIndefinitely "Answer whether I will serve a client indefinitely (as opposed to just once)." "By default, I do." ^true! ! !Server methodsFor: 'testing' stamp: 'crl 11/7/1999 16:09'! serving "Answer whether I have any clients." self purgeDeadClients. ^clients isEmpty not! ! !Server methodsFor: 'serving'! basicNextPacketFrom: clientStream "Answer the next packet from clientStream." ^self subclassResponsibility! ! !Server methodsFor: 'serving' stamp: 'JMM 6/30/2000 13:47'! nextPacketFrom: client "Answer the next packet from client, dealing with unsuccessful reading if necessary." ^[self basicNextPacketFrom: client] on: self class readingInterruptedSignal, self class failedSocketReadingAttemptSignal,self class failedUDPSocketReadingAttemptSignal do: [:exception | self closeClient: client. exception return]! ! !Server methodsFor: 'serving'! serve: clientStream "Serve clientStream." self subclassResponsibility! ! !Server methodsFor: 'utilities' stamp: 'crl 11/5/1999 19:31'! purgeDeadClients "Purge clients which have closed their end." clients _ clients reject: [:client | client peerClosed yourselfUnlessTrueDoFirst: [self closeClient: client]]! ! !Server methodsFor: 'printing' stamp: 'crl 11/7/1999 16:09'! printOn: aStream "Print a character-based description of myself on aStream." | active | active _ self isActive. super printOn: aStream. active ifFalse: [aStream nextPutAll: ' which was']. aStream nextPutAll: ' listening on port '; print: stream port. active ifTrue: [ aStream nextPutAll: ', '. self purgeDeadClients. clients isEmpty ifTrue: [aStream nextPutAll: 'with no clients'] ifFalse: [ | singleClient | singleClient _ clients size = 1. aStream nextPutAll: 'and serving '. singleClient ifTrue: [aStream nextPutAll: 'a ']. aStream nextPutAll: 'client'. singleClient ifFalse: [aStream nextPut: $s]. aStream nextPutAll: ' at '. (clients collect: [:client | client peerAddress]) printVerboselyOn: aStream]]! ! !Server methodsFor: 'accessing' stamp: 'crl 11/7/1999 16:05'! numberOfClients "Answer the number of clients connected to me." ^clients size! ! !RegressionTestServer methodsFor: 'testing' stamp: 'crl 11/5/1999 02:30'! servesIndefinitely "Answer whether I will serve a client indefinitely (as opposed to just once)." ^false! ! !RegressionTestServer methodsFor: 'serving' stamp: 'crl 11/5/1999 02:50'! serve: clientStream "Serve clientStream." clientStream nextPutAll: 'Thank you; come again.'; crlf! ! !Server class methodsFor: 'accessing'! defaultServer "Answer my defaultServer." ^defaultServer! ! !Server class methodsFor: 'instance creation'! new "Answer a new running instance of myself." ^self newAtPort: self defaultPort! ! !Server class methodsFor: 'instance creation'! newAtPort: port "Answer a new running instance of myself." ^self basicNew reopenAtPort: port! ! !Server class methodsFor: 'instance creation'! start "Start a default instance of myself." defaultServer _ self new! ! !Server class methodsFor: 'instance creation'! stop "Stop my default instance." defaultServer close. defaultServer _ nil! ! !RegressionTestServer class methodsFor: 'accessing' stamp: 'crl 11/5/1999 02:37'! binary "Answer whether my instances should communicate in binary." ^false! ! !RegressionTestServer class methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:48'! defaultPorts "Answer the ports at which my service is typically provided." ^#(7)! ! !RegressionTestServer class methodsFor: 'accessing' stamp: 'crl 11/4/1999 16:48'! transport "Answer my mode of transport." ^#tcp! ! !TCPSocket methodsFor: 'accessing'! next: anInteger into: aByteArray startingAt: startIndex "Read the next anInteger bytes into aByteArray, starting at startIndex, within a default timeout. Answer the number of bytes actually read." ^self next: anInteger into: aByteArray startingAt: startIndex socket: handle! ! !TCPSocket methodsFor: 'accessing' stamp: 'JMM 6/23/2000 20:15'! next: bytesToReadInteger into: targetByteArray startingAt: targetStartIndex socket: socketHandle "Read the next bytesToReadInteger bytes from the socket with handle and id into targetByteArray, starting at targetStartIndex, within a default timeout. Don't wait for there to be readable data. Answer the number of bytes actually read." ^self primSocket: socketHandle receiveDataInto: targetByteArray startingAt: targetStartIndex count: bytesToReadInteger ! ! !TCPSocket methodsFor: 'accessing'! nextPut: anInteger from: aByteArray startingAt: startIndex "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." ^self nextPut: anInteger from: aByteArray startingAt: startIndex socket: handle! ! !TCPSocket methodsFor: 'accessing' stamp: 'JMM 6/23/2000 20:14'! nextPut: bytesToWriteInteger from: sourceByteArray startingAt: sourceIndex socket: socketHandle "Write the next bytesToWriteInteger bytes, to the socket with handle and id, from sourceByteArray, starting at sourceIndex. Answer the number of bytes actually written." ^self primSocket: socketHandle sendData: sourceByteArray startIndex: sourceIndex count: sourceByteArray size ! ! !TCPSocket methodsFor: 'testing'! usesTCP "Answer whether I use TCP." ^true! ! !ClientTCPSocket methodsFor: 'testing'! isActive "Answer whether I'm active." "The peer may have closed the connection since the last time this question was asked." ^self isOpen yourselfUnlessTrue: [ | active | active _ self isActive: handle. active yourselfUnlessFalseDoFirst: [peerClosed _ true]]! ! !ClientTCPSocket methodsFor: 'testing' stamp: 'JMM 6/23/2000 20:17'! isActive: socketHandle "Answer whether I am still connected to my peer." ^self isConnected! ! !ClientTCPSocket methodsFor: 'testing'! peerClosed "Answer whether my peer closed." self isActive. ^peerClosed! ! !ClientTCPSocket methodsFor: 'initialization'! initialize "Initialize myself." peerClosed _ false. super initialize! ! !ClientTCPSocket methodsFor: 'accessing'! peerAddress "Answer the InternetSocketAddress of my peer." ^address! ! !ClientTCPSocket methodsFor: 'accessing'! port "Answer the remote port to which I am connected." ^self peerAddress port! ! !ClientTCPSocket methodsFor: 'control'! reopen "Reopen myself." self initialize; connectToAddress: address! ! !ClientTCPSocket methodsFor: 'printing' stamp: 'crl 11/3/1999 03:32'! printOn: aStream "Print a character-based description of myself on aStream." | active | active _ self isActive. super printOn: aStream. active ifFalse: [aStream nextPutAll: ' which was']. aStream nextPutAll: ' connected to '; print: self peerAddress. peerClosed ifTrue: [ aStream nextPutAll: ', which '. self isOpen ifTrue: [aStream nextPutAll: 'has ']. aStream nextPutAll: 'closed its end.'] ifFalse: [ active ifFalse: [self printInactivityExplanationOn: aStream]]! ! !IncomingClientTCPSocket methodsFor: 'accessing' stamp: 'JMM 6/27/2000 21:23'! peerAddress | addr port | "Answer the InternetSocketAddress of my peer." "Cache the answer if I don't have it already." (address == nil and: [self isOpen]) ifTrue: [ [addr _ self primSocketRemoteAddress: handle. port _ self primSocketRemotePort: handle] on: Error do: [:ex | addr _ ByteArray new: 4. port _ 0. ex return]. address _ InternetSocketAddress forPort: port atHostWithIPAddress: addr]. ^super peerAddress! ! !IncomingClientTCPSocket methodsFor: 'control' stamp: 'JMM 6/24/2000 00:33'! accept: clientHandle from: serverHandle "Accept a socket with clientHandle from a server with serverHandle." handle _ self primAcceptFrom: serverHandle receiveBufferSize: 8000 sendBufSize: 8000 semaIndex: openCloseSemaphoreIndex readSemaIndex: readSemaphoreIndex writeSemaIndex: writeSemaphoreIndex. self createHandlePost ! ! !IncomingClientTCPSocket methodsFor: 'control' stamp: 'JMM 7/3/2000 22:24'! acceptFrom: server "Connect myself to the next incoming connection over serverHandle." "Waiting around for connections is what servers do... so one would probably never want a timeout. If a server wanted to deny service after some period of time, it could just close." server waitForConnectionUntil: -1. server isConnected ifFalse: [^self]. self accept: handle from: server handle ! ! !IncomingClientTCPSocket methodsFor: 'control' stamp: 'JMM 6/24/2000 00:34'! createHandle handle _ nil.! ! !IncomingClientTCPSocket methodsFor: 'control'! reopen "Reopen myself." "The peer and I have gone our separate ways. It's up to the peer to reconnect." ^self error: 'It''s up to the peer to reconnect.'! ! !IncomingClientTCPSocket methodsFor: 'primitives' stamp: 'JMM 6/24/2000 00:37'! 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" ^self primitiveFailed! ! !IncomingClientTCPSocket methodsFor: 'primitives' stamp: 'JMM 6/24/2000 00:37'! 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" primitiveOnlySupportsOneSemaphore _ true. ^self primAcceptFrom: aHandle receiveBufferSize: rcvBufSize sendBufSize: sndBufSize semaIndex: semaIndex ! ! !OutgoingClientTCPSocket methodsFor: 'initialization' stamp: 'JMM 7/4/2000 21:30'! connectToAddress: targetAddress "Connect to the host with targetAddress." self connectToAddress: targetAddress timeoutAfter: -1! ! !OutgoingClientTCPSocket methodsFor: 'initialization' stamp: 'JMM 6/24/2000 00:16'! connectToAddress: targetAddress socket: socketHandle "Connect to targetAddress." self primSocket: socketHandle connectTo: targetAddress hostBytes port: targetAddress port. ! ! !OutgoingClientTCPSocket methodsFor: 'initialization' stamp: 'JMM 6/29/2000 02:16'! connectToAddress: targetAddress timeoutAfter: timeoutInMilliseconds "Connect to the host with targetAddress." super connectToAddress: targetAddress. self connectToAddress: targetAddress socket: handle. self waitForConnectionUntil: timeoutInMilliseconds. self connectionRefused ifTrue: [[self class connectionRefusedSignal signal] ensure: [self close]]! ! !OutgoingClientTCPSocket methodsFor: 'testing' stamp: 'JMM 6/23/2000 20:50'! connectionRefused "Answer whether a recently-attempted connection was refused." ^self isConnected not! ! !OutgoingClientTCPSocket methodsFor: 'testing' stamp: 'JMM 6/23/2000 20:50'! connectionRefused: socketHandle "Answer whether a recently-attempted connection was refused." ^self isConnected not! ! !ServerTCPSocket methodsFor: 'control' stamp: 'JMM 6/27/2000 12:36'! accept "Accept the next pending connection, and answer a NetStream on a TCPSocket for communicating over it." "Assume an underlying BSD sockets interface, and that I am a blocking socket which is already bound to a local port and listening. Suspend the current process until there is a pending connection, at which point an interpreter thread will signal." | client | client _ IncomingClientTCPSocket new. client acceptFrom: self. ^NetStream on: client! ! !ServerTCPSocket methodsFor: 'control'! listenAtPort: thePort queueSize: theQueueSize "Listen at thePort on the current host. Allow theQueueSize pending connections." port _ thePort. queueSize _ theQueueSize. self listenAtPort: thePort queueSize: theQueueSize socket: handle! ! !ServerTCPSocket methodsFor: 'control' stamp: 'JMM 7/6/2000 17:21'! listenAtPort: thePort queueSize: theQueueSize socket: socketHandle "Listen at thePort on the current host. Allow theQueueSize pending connections Handle problem with old macintosh implementation that had poor listen support." [self primSocket: socketHandle listenOn: thePort backlogSize: theQueueSize] on: self class listenRefusedSignal do: [:ex | self primSocket: socketHandle listenOn: thePort. ex return].! ! !ServerTCPSocket methodsFor: 'control'! reopen "Reopen myself." self initialize; listenAtPort: port queueSize: queueSize socket: handle! ! !ServerTCPSocket methodsFor: 'printing' stamp: 'crl 11/3/1999 03:30'! printOn: aStream "Print a character-based description of myself on aStream." | active | active _ self isActive. super printOn: aStream. active ifFalse: [aStream nextPutAll: ' which was']. aStream nextPutAll: ' listening on port '; print: port. active ifFalse: [self printInactivityExplanationOn: aStream]! ! !ServerTCPSocket methodsFor: 'accessing'! port "Answer the port on which I was, am, or will be listening." ^port! ! !ServerTCPSocket methodsFor: 'testing' stamp: 'crl 10/28/1999 17:09'! scribes "Answer whether I read or write (as opposed to accept)." ^false! ! !ServerTCPSocket methodsFor: 'primitives' stamp: 'JMM 7/6/2000 17:15'! primSocket: socketID listenOn: aPort "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. yes the primitive number is the same as listenonbacklogsize but the underlying plugin code figures out which call to make" self primitiveFailed ! ! !ServerTCPSocket methodsFor: 'primitives' stamp: 'JMM 7/6/2000 17:17'! 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." self class listenRefusedSignal signal ! ! !TCPSocket class methodsFor: 'examples' stamp: 'crl 10/20/1999 07:51'! echoClient "Answer a NetStream connected to a remote server, for echoing bytes." ^NetStream tcpClientToPort: 7 atHostNamed: 'localhost'! ! !TCPSocket class methodsFor: 'examples'! echoServer "Answer an echo server which uses the appropriate transport mechanism." ^NetStream tcpServerAtPort: 7 queueSize: 1! ! !TCPSocket class methodsFor: 'examples' stamp: 'JMM 6/24/2000 01:37'! reflectBytesVia: serverStream "Reflect bytes via serverStream. Answer whether I was successful." | client | client _ serverStream client. [client nextPutAll: client nextLine, (String with: Character cr)] ensure: [client close]. ^true! ! !TCPSocket class methodsFor: 'instance creation'! serverAtPort: port queueSize: queueSize "Answer an instance of myself which can act as a server, on the local host, at port." ^ServerTCPSocket new listenAtPort: port queueSize: queueSize! ! !OutgoingClientTCPSocket class methodsFor: 'Signal constants' stamp: 'JMM 6/26/2000 13:26'! connectionRefusedSignal ^ExceptionConnectionRefused! ! !ServerTCPSocket class methodsFor: 'Signal constants' stamp: 'JMM 7/6/2000 17:11'! listenRefusedSignal ^ExceptionListenRefused! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 13:53'! next: anInteger into: aByteArray startingAt: startIndex "Read the next anInteger bytes into aByteArray, starting at startIndex, within a default timeout. Answer the number of bytes actually received. Question (JMM) this will receive from any client, not an indicated peer, so beware" ^self nextPacketInto: aByteArray startingAt: startIndex addressInto: address socket: handle count: aByteArray size - startIndex + 1 ! ! !UDPSocket methodsFor: 'accessing'! nextPacketInto: packetByteArray "Receive the next packet into packetByteArray. Answer the number of bytes actually received." ^self nextPacketInto: packetByteArray socket: handle! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 14:00'! nextPacketInto: packetByteArray addressInto: theAddress "Receive the next packet into packetByteArray, and the address from which it came into theAddress. Answer the number of bytes actually received." ^self nextPacketInto: packetByteArray addressInto: theAddress socket: handle! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 11:42'! nextPacketInto: packetByteArray addressInto: addressBytes socket: socketHandle "Receive the next packet into packetByteArray, and the address from which it came into theAddress. Answer the number of bytes actually received." ^self nextPacketInto: packetByteArray startingAt: 1 addressInto: addressBytes socket: socketHandle! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 11:41'! nextPacketInto: packetByteArray socket: socketHandle "Write the next received packet into packetByteArray. Answer the number of bytes actually received." ^self nextPacketInto: packetByteArray startingAt: 1 addressInto: address socket: socketHandle! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 13:52'! nextPacketInto: packetByteArray startingAt: aStartIndex addressInto: addressThing socket: socketHandle ^ self nextPacketInto: packetByteArray startingAt: aStartIndex addressInto: addressThing socket: socketHandle count: packetByteArray size! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 13:52'! nextPacketInto: packetByteArray startingAt: aStartIndex addressInto: addressThing socket: socketHandle count: aNumber | results | "Write the next received packet into packetByteArray, and the address from which they came into addressBytes. Answer the number of bytes actually received." self primitiveOnlySupportsOneSemaphore ifTrue: [self bindToPort: self port. ^self primSocket: socketHandle receiveDataInto: packetByteArray startingAt: 1 count: aNumber]. results _ self primSocket: socketHandle receiveUDPDataInto: packetByteArray startingAt: aStartIndex count: aNumber. addressThing port: (results at: 3) ipAddress: (results at: 2). ^results at: 1! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 11:45'! nextPut: anInteger from: aByteArray startingAt: startIndex "Write the next anInteger elements in aByteArray, starting at startIndex. Answer the number of bytes actually written." ^self sendPacket: aByteArray startingAt: startIndex toAddress: address socket: handle ! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/29/2000 15:42'! port "Answer the port to which I am connected or listening." port ifNil: [^address port]. ^port ! ! !UDPSocket methodsFor: 'accessing'! sendPacket: aByteArray "Send aByteArray, which must not be larger than the maximum packet payload size, to my address. Answer the number of bytes actually sent." ^self sendPacket: aByteArray toAddress: address! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 12:06'! sendPacket: packetByteArray startingAt: startIndex toAddress: addressBytes socket: socketHandle "Send aByteArray, which must not be larger than the maximum packet payload size, to the address with addressBytes. Answer the number of bytes actually sent." self primitiveOnlySupportsOneSemaphore ifTrue: [self setPeer: addressBytes hostBytes port: addressBytes port. ^self primSocket: socketHandle sendData: packetByteArray startIndex: startIndex count: packetByteArray size]. ^self primSocket: socketHandle sendUDPData: packetByteArray toHost: addressBytes hostBytes port: addressBytes port startIndex: startIndex count: packetByteArray size. ! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/24/2000 01:58'! sendPacket: aByteArray toAddress: anInternetSocketAddress "Send aByteArray, which must not be larger than the maximum packet payload size, to anInternetSocketAddress. Answer the number of bytes actually sent." ^self sendPacket: aByteArray toAddress: anInternetSocketAddress socket: handle! ! !UDPSocket methodsFor: 'accessing' stamp: 'JMM 6/30/2000 11:43'! sendPacket: packetByteArray toAddress: addressBytes socket: socketHandle "Send aByteArray, which must not be larger than the maximum packet payload size, to the address with addressBytes. Answer the number of bytes actually sent." ^self sendPacket: packetByteArray startingAt: 1 toAddress: addressBytes socket: socketHandle ! ! !UDPSocket methodsFor: 'copying'! postCopy "I am a copy; complete my creation." address _ nil! ! !UDPSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 13:46'! 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" self class failedUDPSocketReadingAttemptSignal signal. ! ! !UDPSocket methodsFor: 'primitives' stamp: 'JMM 6/26/2000 13:46'! 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." self class failedUDPSocketWritingAttemptSignal signal. ! ! !UDPSocket methodsFor: 'primitives' stamp: 'JMM 6/23/2000 20:47'! primSocket: socketID setPort: aPort "Set the local port associated with a UDP socket. Note: this primitive is overloaded. The primitive will not fail on a TCP socket, but the effects will not be what was desired. Best solution would be to split Socket into two subclasses, TCPSocket and UDPSocket." self error: 'Bind to port failed' ! ! !UDPSocket methodsFor: 'initialization'! bindToPort: thePort "Bind to thePort." port _ thePort. self bindToPort: thePort socket: handle! ! !UDPSocket methodsFor: 'initialization' stamp: 'JMM 6/30/2000 11:46'! bindToPort: thePort socket: socketHandle "Bind to the thePort." self primSocket: socketHandle setPort: thePort. ! ! !UDPSocket methodsFor: 'initialization'! listenAtPort: thePort queueSize: theQueueSize "Listen at thePort with theQueueSize." self bindToPort: thePort! ! !UDPSocket methodsFor: 'initialization' stamp: 'JMM 6/30/2000 12:11'! setPeer: hostAddress port: aPort "Set the default send/recv address." self primSocket: handle connectTo: hostAddress port: port. ! ! !UDPSocket methodsFor: 'control'! restart "Restart myself." address _ nil. self close; initialize! ! !UDPSocket methodsFor: 'printing'! printOn: aStream "Print a character-based description of myself on aStream." | active | active _ self isActive. super printOn: aStream. port == nil ifFalse: [ active ifFalse: [aStream nextPutAll: ' which was']. aStream nextPutAll: ' bound to port '; print: port. address == nil ifFalse: [aStream nextPutAll: ', and']]. address == nil ifFalse: [ aStream nextPutAll: ( active ifTrue: [' which exchanges'] ifFalse: [' exchanged']); nextPutAll: ' packets with '; print: address]! ! !UDPSocket methodsFor: 'testing'! usesTCP "Answer whether I use TCP." ^false! ! !UDPSocket class methodsFor: 'instance creation'! serverAtPort: port "Answer an instance of myself which can act as a server, on the local host, at port." ^self new bindToPort: port! ! !UDPSocket class methodsFor: 'initialization'! initialize "Initialize myself." MaximumPayloadSize _ 65515! ! !UDPSocket class methodsFor: 'examples'! echoClient "Answer a NetStream connected to a remote server, for echoing bytes." "Hosts usually don't run UDP echo servers. Assume that the local host is running one." ^NetStream udpClientToPort: 7 atHostNamed: 'localhost'! ! !UDPSocket class methodsFor: 'examples'! echoServer "Answer an echo server which uses the appropriate transport mechanism." ^NetStream udpServerAtPort: 7! ! !UDPSocket class methodsFor: 'examples' stamp: 'JMM 6/29/2000 17:11'! reflectBytesVia: serverStream "Reflect bytes via serverStream. Answer whether I was successful." | packet sourceAddress | self halt: 'Not sure about upTo: 0, excludes 0 as data? '. packet _ ByteArray new: MaximumPayloadSize. sourceAddress _ InternetSocketAddress new. serverStream nextPacketInto: packet addressInto: sourceAddress. serverStream nextPutPacket: (packet stream upTo: 0) asString toAddress: sourceAddress. ^true! ! UDPSocket initialize! OutgoingClientTCPSocket class removeSelector: #addSituations! ServerTCPSocket removeSelector: #connectToInterpreter! ServerTCPSocket removeSelector: #primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:! ServerTCPSocket removeSelector: #primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex:! OutgoingClientTCPSocket removeSelector: #primSocket:connectTo:port:! !IncomingClientTCPSocket reorganize! ('accessing' peerAddress) ('control' accept:from: acceptFrom: createHandle reopen) ('primitives' primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex: primAcceptFrom:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex:) ! TCPSocket removeSelector: #next:into:startingAt:socket:primSocket:receiveDataInto:startingAt:count:! TCPSocket removeSelector: #primSocket:receiveDataInto:startingAt:count:! TCPSocket removeSelector: #primSocket:sendData:startIndex:count:! SerialPort class removeSelector: #addSituations! SerialPort initialize! SerialPort removeSelector: #requestReadabilitySignallingTimeoutAfter:! SerialPort removeSelector: #requestWriteabilitySignalling! !SerialPort reorganize! ('accessing' baudRate baudRate: beAsynchronous beExternallyClocked doNotUseXOnXOffFlowControl handle next:into:startingAt: next:into:startingAt:serialPort: nextPut:from:startingAt: nextPut:from:startingAt:serialPort: numberOfDataBits numberOfDataBits: numberOfStartBits: numberOfStopBits numberOfStopBits: parityScheme parityScheme: peerAddress useCTS useCTS: useDTR useDTR: useXOnXOffFlowControl useXOnXOffFlowControl: xOffByte xOffByte: xOnByte xOnByte:) ('control' close: reopen) ('initialization' connectToSerialPortNumbered:baudRate:numberOfDataBits:numberOfStopBits:parityScheme:useDTR:useCTS:useXOnXOffFlowControl: initialize) ('primitives' primClosePort: primOpenPort:baudRate:stopBitsType:parityType:dataBits:inFlowControlType:outFlowControlType:xOnByte:xOffByte: primReadPort:into:startingAt:count: primWritePort:from:startingAt:count:) ('printing' printOn:) ('testing' dataAvailable dataAvailableForHandle: isActive timedOut) ('waiting') ! InternetSocketAddressResolver class removeSelector: #addSituations! !InternetSocketAddressResolver class reorganize! ('utilities' addressForPort:atHostNamed: bytesForHostNamed:) ('initialization') ('Signal constants' unresolvableHostnameSignal) ! InternetSocket class removeSelector: #addSituations! InternetSocket class removeSelector: #foo! InternetSocket initialize! InternetSocket class removeSelector: #primInitializeNetwork:! InternetSocket class removeSelector: #setSpecialObjectsArrayPointer:! NetResource class removeSelector: #addSituations! MIDIPort removeSelector: #requestReadabilitySignallingTimeoutAfter:! MIDIPort removeSelector: #requestWriteabilitySignalling! !MIDIPort reorganize! ('accessing' next:into:startingAt: nextEvent readFromPort:into:) ('control' close close: connectToPort:withReadSemaphoreAt:andInterfaceClockRate:) ('initialization' portNumber:) ('testing' timedOut) ('waiting') ('primitives' primMIDIGetClock primMIDIGetPortCount primMIDIGetPortDirectionality: primMIDIGetPortName: primMIDIParameterGet: primMIDIParameterSet:to: primMIDIconnectToPort:withReadSemaphoreAt:andInterfaceClockRate:) ! InternetSocket removeSelector: #createHandlePost! InternetSocket removeSelector: #register! InternetSocket removeSelector: #requestReadabilitySignallingTimeoutAfter:! InternetSocket removeSelector: #requestWriteabilitySignalling! !InternetSocket reorganize! ('accessing' getOption: openCloseSemaphore peerAddress port primitiveOnlySupportsOneSemaphore readSemaphore socketError statusString writeSemaphore) ('control' close close: closeAndDestroy: connectToAddress: setOption:value:) ('finalization' finalize) ('initialization' createHandle initialize) ('primitives' primSocket:connectTo:port: primSocket:getOption: primSocket:receiveDataInto:startingAt:count: primSocket:sendData:startIndex:count: primSocket:setOption:value: primSocketAbortConnection: primSocketCloseConnection: primSocketConnectionStatus: primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex: primSocketCreateNetwork:type:receiveBufferSize:sendBufSize:semaIndex:readSemaIndex:writeSemaIndex: primSocketDestroy: primSocketDestroyGently: primSocketError: primSocketLocalAddress: primSocketLocalPort: primSocketReceiveDataAvailable: primSocketRemoteAddress: primSocketRemotePort: primSocketSendDone:) ('testing' dataAvailableForHandle: isConnected scribes timedOut timedOut: usesTCP) ('waiting' waitForConnectionUntil: waitForDisconnectionUntil:) ! NetResource removeSelector: #requestReadabilitySignallingTimeoutAfter:! NetResource removeSelector: #requestWriteabilitySignalling! !NetResource reorganize! ('accessing' next:into:startingAt: nextPut:from:startingAt: peerAddress) ('finalization' finalize) ('control' close) ('initialization' initialize) ('printing' printInactivityExplanationOn:) ('testing' dataAvailable dataAvailableForHandle: isConnected peerClosed timedOut) ('waiting' waitForReadabilityTimeoutAfter: waitForWriteability) ! ExternalResource class removeSelector: #addSituations! ExternalResource class removeSelector: #badExternalHandleSignal! ExternalResource class removeSelector: #badSerialPortHandleSignal! ExternalResource class removeSelector: #connectionRefusedSignal! ExternalResource class removeSelector: #dateNotSetSignal! ExternalResource class removeSelector: #failedConnectionStatusInquirySignal! ExternalResource class removeSelector: #failedConnectivityTestSignal! ExternalResource class removeSelector: #failedMIDIPortClosingAttemptSignal! ExternalResource class removeSelector: #failedMIDIPortReadAttemptSignal! ExternalResource class removeSelector: #failedSerialPortConnectionAttemptSignal! ExternalResource class removeSelector: #failedSerialPortOpeningAttemptSignal! ExternalResource class removeSelector: #failedSerialPortReadingAttemptSignal! ExternalResource class removeSelector: #failedSerialPortWritingAttemptSignal! ExternalResource class removeSelector: #headerNotFoundSignal! ExternalResource initialize! ExternalResource class removeSelector: #unresolvableHostnameSignal! !ExternalResource reorganize! ('control' close reopen restart) ('finalization' finalize register) ('initialize' createHandlePost initialize) ('printing' printOn:) ('testing' handleIsStale isActive isOpen) ('accessing') ('as yet unclassified' handle) ! Correspondent initialize!