[Help-smalltalk] TCP -> Sockets

[Paolo Bonzini]

Since I don't have time to implement IPv6, I decided instead to do 
AF_UNIX sockets. :-)  That's easier, and will show how to implement a 
different address family.  I'll blog on how everything-is-an-object 
makes for a nicer implementation in Smalltalk than Java when I have some 
time.

As part of this, the TCP package was moved to Sockets, and the namespace 
was renamed too.  The old names are still available for backwards 
compatibility.

I also committed the attached patch that I had lying around for a while, 
that completes the refactoring of AbstractSocketImpl, so that the socket 
implementation classes are potentially oblivious of the address 
families.  In practice, different subclasses will be needed, but this at 
least makes SocketImpl and DatagramSocketImpl concrete classes rather 
than abstract.

Paolo

2008-07-15  Paolo Bonzini  <address@hidden>
    
        * AbstractSocketImpl.st: Remove #addressClass, replace #new with
        #newFor:.  Use SocketAddress class>>#fromSockAddr:port:.
        Define #outOfBandImplClass.  Check for getpeername and getsockname
        errors better.  Move OOBSocketImpl here...
        * IPSocketImpl.st: ... from here.  Remove class-side #addressClass
        from AbstractSocketImpl.
        * SocketAddress.st: Provide default implementation classes.
        Use #new:addressClass: in #newRawSocket.  Define
        SocketAddress class>>#fromSockAddr:port:.
        * Sockets.st: Add AbstractSocket class>>#new:addressClass:,
        use it instead of "self new: addressClass someSocketImplClass new"

diff --git a/packages/sockets/AbstractSocketImpl.st 
b/packages/sockets/AbstractSocketImpl.st
index 32d03d0..fbc7ec4 100644
--- a/packages/sockets/AbstractSocketImpl.st
+++ b/packages/sockets/AbstractSocketImpl.st
@@ -59,13 +59,13 @@ FileDescriptor subclass: AbstractSocketImpl [
        self subclassResponsibility
     ]
 
-    AbstractSocketImpl class >> new [
+    AbstractSocketImpl class >> newFor: addressClass [
        "Create a socket for the receiver."
 
        <category: 'socket creation'>
        | descriptor |
        descriptor := self 
-                   create: self addressClass protocolFamily
+                   create: addressClass protocolFamily
                    type: self socketType
                    protocol: self protocol.
        File checkError.
@@ -92,14 +92,6 @@ FileDescriptor subclass: AbstractSocketImpl [
            yourself
     ]
 
-    addressClass [
-       "Answer the class responsible for handling addresses for
-        the receiver"
-
-       <category: 'socket operations'>
-       ^self class addressClass
-    ]
-
     bindTo: ipAddress port: port [
        "Bind the receiver to the given IP address and port. `Binding' means
         attaching the local endpoint of the socket."
@@ -194,11 +186,10 @@ FileDescriptor subclass: AbstractSocketImpl [
        | sock addrLen fd |
        sock := ByteArray new: CSockAddrStruct sizeof.
        addrLen := CInt gcValue: CSockAddrStruct sizeof.
-       (fd := self fd) isNil ifTrue: [ ^nil ].
-       self 
-           getSockName: fd
-           addr: sock
-           addrLen: addrLen.
+       (fd := self fd) isNil
+           ifTrue: [ ^nil ].
+       (self getSockName: self fd addr: sock addrLen: addrLen) = -1
+           ifTrue: [ ^nil ].
        ^sock
     ]
 
@@ -380,13 +371,19 @@ FileDescriptor subclass: AbstractSocketImpl [
         class, an Integer or a Boolean."
 
        <category: 'private'>
-       | byteArray |
-       anObject class == ByteArray ifTrue: [^anObject].
-       anObject class == self addressClass ifTrue: [^anObject asByteArray].
-       byteArray := ByteArray new: CInt sizeof.
-       anObject == true ifTrue: [byteArray intAt: 1 put: 1].
-       anObject isInteger ifTrue: [byteArray intAt: 1 put: anObject].
-       ^byteArray
+       anObject == true ifTrue: [
+           ^#[1 0 0 0]].
+       anObject == false ifTrue: [
+           ^#[0 0 0 0]].
+       anObject isInteger ifTrue: [
+           ^(ByteArray new: CInt sizeof)
+               at: 1 put: (anObject bitAnd: 255);
+               at: 2 put: (anObject // 256 bitAnd: 255);
+               at: 3 put: (anObject // 65536 bitAnd: 255);
+               at: 4 put: (anObject // 16777216 bitAnd: 255);
+               yourself].
+
+       ^anObject asByteArray
     ]
 
     hasBeenConnectedTo: ipAddress port: port [
@@ -404,7 +401,7 @@ FileDescriptor subclass: AbstractSocketImpl [
        | port |
        port := ValueHolder new.
        self 
-           hasBeenConnectedTo: (self addressClass fromSockAddr: sockAddr port: 
port)
+           hasBeenConnectedTo: (SocketAddress fromSockAddr: sockAddr port: 
port)
            port: port value
     ]
 
@@ -422,7 +419,7 @@ FileDescriptor subclass: AbstractSocketImpl [
        <category: 'private'>
        | port |
        port := ValueHolder new.
-       self hasBeenBoundTo: (self addressClass fromSockAddr: sockAddr port: 
port)
+       self hasBeenBoundTo: (SocketAddress fromSockAddr: sockAddr port: port)
            port: port value
     ]
 
@@ -506,7 +503,7 @@ AbstractSocketImpl subclass: SocketImpl [
         on the receiver."
 
        <category: 'abstract'>
-       self subclassResponsibility
+       ^OOBSocketImpl
     ]
 
     connectTo: ipAddress port: port [
@@ -514,7 +511,7 @@ AbstractSocketImpl subclass: SocketImpl [
         machine."
 
        <category: 'socket operations'>
-       | addr fd |
+       | addr fd peer |
        addr := ipAddress port: port.
        
        [(fd := self fd) isNil ifTrue: [ ^self ].
@@ -527,7 +524,9 @@ AbstractSocketImpl subclass: SocketImpl [
 
        "connect does not block, so wait for"
        self ensureWriteable.
-       self isOpen ifTrue: [self hasBeenConnected]
+       self isOpen ifTrue: [
+           peer := self getPeerName ifNil: [ addr ].
+           self hasBeenConnectedTo: peer]
     ]
 
     getPeerName [
@@ -538,21 +537,13 @@ AbstractSocketImpl subclass: SocketImpl [
        | peer addrLen fd |
        peer := ByteArray new: CSockAddrStruct sizeof.
        addrLen := CInt gcValue: CSockAddrStruct sizeof.
-       (fd := self fd) isNil ifTrue: [ ^nil ].
-       self 
-           getPeerName: self fd
-           addr: peer
-           addrLen: addrLen.
+       (fd := self fd) isNil
+           ifTrue: [ ^nil ].
+       (self getPeerName: self fd addr: peer addrLen: addrLen) = -1
+           ifTrue: [ ^nil ].
        ^peer
     ]
 
-    hasBeenConnected [
-       "Retrieve and save the remote address and port that the receiver is
-        connected to."
-
-       <category: 'private'>
-       self hasBeenConnectedTo: self getPeerName
-    ]
 ]
 
 
@@ -648,7 +639,7 @@ AbstractSocketImpl subclass: DatagramSocketImpl [
        port := ValueHolder new.
        ^aDatagram
            data: data;
-           address: (self addressClass fromSockAddr: from port: port);
+           address: (SocketAddress fromSockAddr: from port: port);
            port: port value;
            yourself
     ]
@@ -748,3 +739,31 @@ DatagramSocketImpl subclass: RawSocketImpl [
     ]
 ]
 
+
+
+
+DatagramSocketImpl subclass: OOBSocketImpl [
+    
+    <comment: nil>
+    <category: 'Sockets-Protocols'>
+
+    canRead [
+       "Answer whether out-of-band data is available on the socket"
+
+       <category: 'implementation'>
+       ^self exceptionalCondition
+    ]
+
+    ensureReadable [
+       "Stop the process until an error occurs or out-of-band data
+        becomes available on the socket"
+
+       <category: 'implementation'>
+       ^self waitForException
+    ]
+
+    flags [
+       <category: 'private'>
+       ^self msgOOB
+    ]
+]
diff --git a/packages/sockets/IPSocketImpl.st b/packages/sockets/IPSocketImpl.st
index 939a3a9..29cefef 100644
--- a/packages/sockets/IPSocketImpl.st
+++ b/packages/sockets/IPSocketImpl.st
@@ -41,7 +41,7 @@ SocketAddress subclass: IPAddress [
        "Set up the default implementation classes for the receiver"
 
        <category: 'initialization'>
-       self defaultRawSocketImplClass: ICMPSocketImpl.
+       self defaultDatagramSocketImplClass: ICMPSocketImpl.
        self defaultDatagramSocketImplClass: UDPSocketImpl.
        self defaultStreamSocketImplClass: TCPSocketImpl
     ]
@@ -364,22 +364,6 @@ SocketImpl subclass: TCPSocketImpl [
     <comment: nil>
     <category: 'Sockets-Protocols'>
 
-    TCPSocketImpl class >> addressClass [
-       "Answer the class that holds network addresses for TCP sockets,
-        i.e. IPAddress."
-
-       <category: 'implementation'>
-       ^IPAddress
-    ]
-
-    outOfBandImplClass [
-       "Return an implementation class to be used for out-of-band data
-        on the receiver."
-
-       <category: 'implementation'>
-       ^OOBSocketImpl
-    ]
-
     valueWithoutBuffering: aBlock [
         "Evaluate aBlock, ensuring that any data that it writes to the socket
          is sent immediately to the network."
@@ -397,55 +381,11 @@ SocketImpl subclass: TCPSocketImpl [
 
 
 
-DatagramSocketImpl subclass: OOBSocketImpl [
-    
-    <comment: nil>
-    <category: 'Sockets-Protocols'>
-
-    OOBSocketImpl class >> addressClass [
-       "Answer the class that holds network addresses for TCP sockets,
-        i.e. IPAddress."
-
-       <category: 'implementation'>
-       ^IPAddress
-    ]
-
-    canRead [
-       "Answer whether out-of-band data is available on the socket"
-
-       <category: 'implementation'>
-       ^self exceptionalCondition
-    ]
-
-    ensureReadable [
-       "Stop the process until an error occurs or out-of-band data
-        becomes available on the socket"
-
-       <category: 'implementation'>
-       ^self waitForException
-    ]
-
-    flags [
-       <category: 'private'>
-       ^self msgOOB
-    ]
-]
-
-
-
 MulticastSocketImpl subclass: UDPSocketImpl [
     
     <comment: nil>
     <category: 'Sockets-Protocols'>
 
-    UDPSocketImpl class >> addressClass [
-       "Answer the class that holds network addresses for UDP sockets,
-        i.e. IPAddress."
-
-       <category: 'implementation'>
-       ^IPAddress
-    ]
-
     ipMulticastIf [
        "Answer the local device for a multicast socket (in the form of
         an address)"
@@ -533,23 +473,15 @@ RawSocketImpl subclass: ICMPSocketImpl [
     <comment: nil>
     <category: 'Sockets-Protocols'>
 
-    ICMPSocketImpl class >> addressClass [
-       "Answer the class that holds network addresses for ICMP sockets,
-        i.e. IPAddress."
-
-       <category: 'implementation'>
-       ^IPAddress
-    ]
 ]
 
 
 
-Eval [
-    CStruct newStruct: #CSockAddrStruct
-       declaration: #(
+CStruct subclass: CSockAddrStruct [
+    <declaration: #(
                #(#sinFamily #short)
                #(#sinPort #(#array #byte 2))
                #(#sinAddr #(#array #byte 4))
-               #(#sinZero #(#array #byte 8)))
+               #(#sinZero #(#array #byte 8))) >
 ]
 
diff --git a/packages/sockets/SocketAddress.st 
b/packages/sockets/SocketAddress.st
index b14a255..0e6211a 100644
--- a/packages/sockets/SocketAddress.st
+++ b/packages/sockets/SocketAddress.st
@@ -49,7 +49,7 @@ Object subclass: SocketAddress [
         Socket's protocol and a low-level C interface."
 
        <category: 'accessing'>
-       ^defaultStreamSocketImplClass
+       ^defaultStreamSocketImplClass ifNil: [ SocketImpl ]
     ]
 
     SocketAddress class >> defaultStreamSocketImplClass: aClass [
@@ -65,7 +65,7 @@ Object subclass: SocketAddress [
         Socket's protocol and a low-level C interface."
 
        <category: 'accessing'>
-       ^defaultRawSocketImplClass
+       ^defaultRawSocketImplClass ifNil: [ RawSocketImpl ]
     ]
 
     SocketAddress class >> defaultRawSocketImplClass: aClass [
@@ -81,7 +81,7 @@ Object subclass: SocketAddress [
         Socket's protocol and a low-level C interface."
 
        <category: 'accessing'>
-       ^defaultDatagramSocketImplClass
+       ^defaultDatagramSocketImplClass ifNil: [ DatagramSocketImpl ]
     ]
 
     SocketAddress class >> defaultDatagramSocketImplClass: aClass [
@@ -99,7 +99,7 @@ Object subclass: SocketAddress [
         Ordinary user programs usually have no need to use this method."
 
        <category: 'initialization'>
-       ^DatagramSocket new: defaultRawSocketImplClass new
+       ^DatagramSocket new: self defaultRawSocketImplClass addressClass: self
     ]
 
     SocketAddress class >> flush [
@@ -260,7 +260,13 @@ Object subclass: SocketAddress [
         to contain the port that the structure refers to."
 
        <category: 'abstract'>
-       self subclassResponsibility
+       | addressFamily |
+       addressFamily := aByteArray at: 2.
+       self allSubclassesDo: [ :each |
+           each addressFamily = addressFamily ifTrue: [
+               ^each fromSockAddr: aByteArray port: portAdaptor ] ].
+
+       self error: 'unknown address family'
     ]
 
     = anIPAddress [
diff --git a/packages/sockets/Sockets.st b/packages/sockets/Sockets.st
index d6fc290..d23df26 100644
--- a/packages/sockets/Sockets.st
+++ b/packages/sockets/Sockets.st
@@ -302,6 +302,15 @@ Stream subclass: AbstractSocket [
        ^super new initialize: implementation
     ]
 
+    AbstractSocket class >> new: implementationClass addressClass: 
addressClass [
+       "Answer a new instance of the receiver, using as the underlying
+        layer a new instance of `implementationClass' and using the
+        protocol family of `addressClass'."
+
+       <category: 'instance creation'>
+       ^self new: (implementationClass newFor: addressClass)
+    ]
+
     AbstractSocket class >> new [
        <category: 'instance creation'>
        self shouldNotImplement
@@ -624,7 +633,7 @@ AbstractSocket subclass: DatagramSocket [
        localAddr := ipAddress isNil 
                    ifTrue: [addressClass anyLocalAddress]
                    ifFalse: [ipAddress].
-       ^(self new: addressClass defaultDatagramSocketImplClass new) 
+       ^(self new: addressClass defaultDatagramSocketImplClass addressClass: 
addressClass)
            remote: remoteAddr
            port: remotePort
            local: localAddr
@@ -886,7 +895,7 @@ AbstractSocket subclass: ServerSocket [
        localAddr := ipAddress isNil 
                    ifTrue: [addressClass unknownAddress]
                    ifFalse: [ipAddress].
-       ^(self new: addressClass defaultStreamSocketImplClass new) 
+       ^(self new: addressClass defaultStreamSocketImplClass addressClass: 
addressClass) 
            port: anInteger
            queueSize: backlog
            bindTo: localAddr
@@ -1031,7 +1040,7 @@ AbstractSocket subclass: StreamSocket [
        addressClass := ipAddress isNil 
                    ifTrue: [addressClass]
                    ifFalse: [ipAddress class].
-       ^(self new: addressClass defaultStreamSocketImplClass new) 
+       ^(self new: addressClass defaultStreamSocketImplClass addressClass: 
addressClass)
            remote: remoteAddr
            port: remotePort
            local: localAddr