[PATCH] AF_UNIX socket support

As anticipated, here is the patch for AF_UNIX sockets.  It is pretty
smooth, most of the changes are to support testing the new address
family.  A SUnit testsuite should be added, because Sport and Swazoo
testcases now do not cover the entire Sockets package.  That's left for
later though.

As a quick recall, the address class (UnixAddress, IPAddress) also acts
as a factory for "Socket implementation" classes (coming from the
AbstractSocketImpl hierarchy).  This is different, and more useful, than
what the Java sockets library in java.net does (the GNU Smalltalk
sockets package is based on Java sockets).  Each address family can then
potentially have its own implementation classes, or just use SocketImpl
and DatagramSocketImpl, which are concrete classes after the last patch
I sent.  Unfortunately I did have to add AF_UNIX-specific implementation
classes, because after closing a socket you have to unlink it too, and I
wanted to hide that detail.  Nevertheless, the implementation of
UnixAddress and of the implementation classes (in UnixSocketImpl.st) is
very simple.

An interesting point is that since SocketAddress instances represent
machines, and not the endpoint of a socket as for struct
sockaddr_{in,un} in C, UnixAddress is a singleton.  The path to the
socket goes in the "port" argument to the class-side constructor
methods.  If you s/port/service/, it makes a lot of sense actually. :-)

Paolo

diff --git a/ChangeLog b/ChangeLog
index b39a56d..4d48b53 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2008-07-15  Paolo Bonzini  <[hidden email]>
+
+ * kernel/File.st: Add #isSocket.
+
 2008-07-14  Tony Garnock-Jones  <[hidden email]>
 
  * kernel/LargeInt.st: Fix a bootstrapping bug by correcting a send of
diff --git a/kernel/File.st b/kernel/File.st
index 87a982c..62bc9e6 100644
--- a/kernel/File.st
+++ b/kernel/File.st
@@ -340,12 +340,20 @@ FilePath subclass: File [
  File checkError
     ]
 
+    isSocket [
+ "Answer whether the file is an AF_UNIX socket."
+
+ <category: 'accessing'>
+ self exists ifFalse: [ ^false ].
+ ^(self stat stMode bitAnd: 8r170000) = 8r140000
+    ]
+
     isDirectory [
  "Answer whether the file is a directory."
 
  <category: 'accessing'>
  self exists ifFalse: [ ^false ].
- ^(self stat stMode bitAnd: 61440) = 16384
+ ^(self stat stMode bitAnd: 8r170000) = 8r40000
     ]
 
     isSymbolicLink [
diff --git a/packages/sockets/ChangeLog b/packages/sockets/ChangeLog
index 350b39b..ec8a183 100644
--- a/packages/sockets/ChangeLog
+++ b/packages/sockets/ChangeLog
@@ -1,5 +1,14 @@
 2008-07-15  Paolo Bonzini  <[hidden email]>
 
+ * SocketAddress.st: Fix parameter name for #=, add #isMulticast.
+ * UnixSocketImpl.st: New.
+ * cfuncs.st: Add AF_UNIX/PF_UNIX constants.
+ * package.xml: Add UnixSocketImpl.st.
+ * sockets.c: Add AF_UNIX/PF_UNIX constants.
+ * Tests.st: Make tests independent of the address family.
+
+2008-07-15  Paolo Bonzini  <[hidden email]>
+
  * AbstractSocketImpl.st: Document classes.
  * Datagram.st: Document classes.
  * IPSocketImpl.st: Document classes.
diff --git a/packages/sockets/Makefile.frag b/packages/sockets/Makefile.frag
index 676349d..75078b4 100644
--- a/packages/sockets/Makefile.frag
+++ b/packages/sockets/Makefile.frag
@@ -1,5 +1,5 @@
 Sockets_FILES = \
-packages/sockets/Buffers.st packages/sockets/Datagram.st packages/sockets/SocketAddress.st packages/sockets/AbstractSocketImpl.st packages/sockets/IPSocketImpl.st packages/sockets/Sockets.st packages/sockets/Tests.st packages/sockets/cfuncs.st packages/sockets/init.st packages/sockets/ChangeLog
+packages/sockets/Buffers.st packages/sockets/Datagram.st packages/sockets/SocketAddress.st packages/sockets/AbstractSocketImpl.st packages/sockets/IPSocketImpl.st packages/sockets/UnixSocketImpl.st packages/sockets/Sockets.st packages/sockets/Tests.st packages/sockets/cfuncs.st packages/sockets/init.st packages/sockets/ChangeLog
 $(Sockets_FILES):
 $(srcdir)/packages/sockets/stamp-classes: $(Sockets_FILES)
  touch $(srcdir)/packages/sockets/stamp-classes
diff --git a/packages/sockets/SocketAddress.st b/packages/sockets/SocketAddress.st
index 9e28859..66e1f08 100644
--- a/packages/sockets/SocketAddress.st
+++ b/packages/sockets/SocketAddress.st
@@ -284,16 +284,23 @@ and vice versa.'>
  self error: 'unknown address family'
     ]
 
-    = anIPAddress [
- "Answer whether the receiver and anIPAddress represent
+    = aSocketAddress [
+ "Answer whether the receiver and aSocketAddress represent
  the same machine.  The host name is not checked because
  an IPAddress created before a DNS is activated is named
  after its numbers-and-dots notation, while the same IPAddress,
  created when a DNS is active, is named after its resolved name."
 
  <category: 'accessing'>
- ^self class == anIPAddress class
-    and: [self asByteArray = anIPAddress asByteArray]
+ ^self class == aSocketAddress class
+    and: [self asByteArray = aSocketAddress asByteArray]
+    ]
+
+    isMulticast [
+ "Answer whether an address is reserved for multicast connections."
+
+ <category: 'testing'>
+ ^false
     ]
 
     hash [
diff --git a/packages/sockets/Tests.st b/packages/sockets/Tests.st
index 0041009..31a94f8 100644
--- a/packages/sockets/Tests.st
+++ b/packages/sockets/Tests.st
@@ -10,6 +10,18 @@ Socket class extend [
  s close
     ]
 
+    testPort2For: anAddressClass [
+ <category: 'tests'>
+ anAddressClass == UnixAddress ifTrue: [ ^'/tmp/gst.test2' ].
+ ^54322
+    ]
+
+    testPortFor: anAddressClass [
+ <category: 'tests'>
+ anAddressClass == UnixAddress ifTrue: [ ^'/tmp/gst.test' ].
+ ^54321
+    ]
+
     tweakedLoopbackTest [
  "Send data from one socket to another on the local machine, trying to avoid
  buffering overhead.  Tests most of the socket primitives.  Comparison of
@@ -35,16 +47,34 @@ Socket class extend [
  output buffer sizes."
 
  <category: 'tests'>
+ ^self loopbackTest: bufferSizes addressClass: Socket defaultAddressClass
+    ]
+
+    loopbackTestOn: addressClass [
+ "Send data from one socket to another on the local machine. Tests most of
+ the socket primitives.  The parameter is the address class (family)
+ to use."
+
+ <category: 'tests'>
+ ^self loopbackTest: nil addressClass: addressClass
+    ]
+
+    loopbackTest: bufferSizes addressClass: addressClass [
+ "Send data from one socket to another on the local machine. Tests most of
+ the socket primitives.  The parameters are the size of the input and
+ output buffer sizes, and the address class (family) to use."
+
+ <category: 'tests'>
  | queue server client bytesToSend sendBuf bytesSent bytesReceived t extraBytes timeout process |
  Transcript
     cr;
     show: 'starting loopback test';
     cr.
  queue := ServerSocket
-    port: 54321
+    port: (self testPortFor: addressClass)
     queueSize: 5
-    bindTo: nil.
- client := Socket remote: queue localAddress port: 54321.
+    bindTo: addressClass loopbackHost.
+ client := Socket remote: queue localAddress port: (self testPortFor: addressClass).
  bufferSizes isNil
     ifFalse:
  [client
@@ -88,13 +118,21 @@ Socket class extend [
  client close.
  queue close.
  Transcript
-    show: 'loopback test done; ' , (t / 100.0) printString , ' seconds';
+    show: 'loopback test done; ' , (t / 1000.0) printString , ' seconds';
     cr;
     show: (bytesToSend asFloat / t roundTo: 0.01) printString;
     showCr: ' kBytes/sec'
     ]
 
     producerConsumerTest [
+ "Send data from one datagram socket to another on the local machine. Tests most of the
+ socket primitives and works with different processes."
+
+ <category: 'tests'>
+ ^self producerConsumerTestOn: Socket defaultAddressClass
+    ]
+
+    producerConsumerTestOn: addressClass [
  "Send data from one socket to another on the local machine. Tests most of the
  socket primitives and works with different processes."
 
@@ -112,9 +150,9 @@ Socket class extend [
  [producer :=
  [| timeout process sendBuf |
  queue := ServerSocket
-    port: 54321
+    port: (self testPortFor: addressClass)
     queueSize: 5
-    bindTo: nil.
+    bindTo: addressClass loopbackHost.
  queueReady signal.
  timeout := false.
  process :=
@@ -138,7 +176,7 @@ Socket class extend [
  fork.
  consumer :=
  [queueReady wait.
- client := Socket remote: queue localAddress port: 54321.
+ client := Socket remote: queue localAddress port: (self testPortFor: addressClass).
 
  [[client canRead] whileTrue:
  [bytesReceived := bytesReceived + client nextHunk size].
@@ -155,32 +193,42 @@ Socket class extend [
  client close.
  queue close.
  Transcript
-    show: 'loopback test done; ' , (t / 100.0) printString , ' seconds';
+    show: 'loopback test done; ' , (t / 1000.0) printString , ' seconds';
     cr;
     show: (bytesToSend asFloat / t roundTo: 0.01) printString;
     showCr: ' kBytes/sec'
     ]
 
-    udpLoopbackTest [
- "Send data from one UDP socket to another on the local machine. Tests most of the
+    datagramLoopbackTest [
+ "Send data from one datagram socket to another on the local machine. Tests most of the
+ socket primitives and works with different processes."
+
+ <category: 'tests'>
+ ^self datagramLoopbackTestOn: Socket defaultAddressClass
+    ]
+
+    datagramLoopbackTestOn: addressClass [
+ "Send data from one datagram socket to another on the local machine. Tests most of the
  socket primitives and works with different processes."
 
  <category: 'tests'>
  | bytesToSend bytesSent bytesReceived t |
  Transcript
     cr;
-    show: 'starting udp loopback test';
+    show: 'starting datagram loopback test';
     cr.
  bytesToSend := 5000000.
  bytesSent := bytesReceived := 0.
  t := Time millisecondsToRun:
  [| server client datagram |
- client := DatagramSocket port: 54322.
+ client := DatagramSocket
+    local: addressClass loopbackHost
+    port: (self testPort2For: addressClass).
  server := DatagramSocket
-    remote: IPAddress anyLocalAddress
-    port: 54322
+    remote: addressClass loopbackHost
+    port: (self testPort2For: addressClass)
     local: nil
-    port: 54321.
+    port: (self testPortFor: addressClass).
  datagram := Datagram data: (String new: 128 withAll: $x) asByteArray.
 
  [server
@@ -197,7 +245,7 @@ Socket class extend [
  server close.
  client close].
  Transcript
-    show: 'udp loopback test done; ' , (t / 100.0) printString , ' seconds';
+    show: 'udp loopback test done; ' , (t / 1000.0) printString , ' seconds';
     cr;
     show: '% packets lost '
  , (100 - (bytesReceived / bytesSent * 100)) asFloat printString;
@@ -244,8 +292,7 @@ Socket class extend [
     cr.
  sock close.
  Transcript
-    show: 'send test done; time = ' , (t / 1000) asFloat printString
- , ' seconds';
+    show: 'send test done; time = ' , (t / 1000.0) printString, ' seconds';
     cr;
     show: (bytesToSend asFloat / t) printString;
     showCr: ' kBytes/sec'
diff --git a/packages/sockets/UnixSocketImpl.st b/packages/sockets/UnixSocketImpl.st
new file mode 100644
index 0000000..fe402e9
--- /dev/null
+++ b/packages/sockets/UnixSocketImpl.st
@@ -0,0 +1,197 @@
+"======================================================================
+|
+|   Smalltalk AF_UNIX sockets
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2008 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+
+SocketAddress subclass: UnixAddress [
+    
+    <comment: '
+This class represents an address for a machine using the AF_UNIX
+address family.  Since this address family is only used for local
+sockets, the class is a singleton; the filesystem path to the socket
+is represented using the port argument to socket functions, as either
+a String or a File object.
+'>
+    <category: 'Sockets-Protocols'>
+
+    UnixAddress class [
+ | uniqueInstance |
+
+ initialize [
+    "Set up the default implementation classes for the receiver"
+
+    <category: 'initialization'>
+    self defaultDatagramSocketImplClass: UnixDatagramSocketImpl.
+    self defaultStreamSocketImplClass: UnixSocketImpl
+ ]
+
+ uniqueInstance [
+    <category: 'instance creation'>
+    uniqueInstance isNil ifTrue: [ uniqueInstance := self new ].
+    ^uniqueInstance
+        ]
+
+ createLocalAddress [
+    "Answer an object representing a local address in the address
+     family for the receiver"
+
+    <category: 'initialization'>
+    ^self uniqueInstance
+        ]
+
+ createLoopbackHost [
+    "Answer an object representing the loopback host in the address
+     family for the receiver.  This is 127.0.0.1 for IPv4."
+
+    <category: 'initialization'>
+    ^self uniqueInstance
+        ]
+
+ createUnknownAddress [
+    "Answer an object representing an unkown address in the address
+     family for the receiver"
+
+    <category: 'initialization'>
+    ^self uniqueInstance
+        ]
+
+ fromSockAddr: aByteArray port: portAdaptor [
+    "Private - Answer the unique UnixAddress instance, filling
+     in the portAdaptor's value from a ByteArray containing a
+     C sockaddr_in structure."
+
+    <category: 'instance creation'>
+    | s size |
+    size := aByteArray
+ indexOf: 0 startingAt: 4 ifAbsent: [ aByteArray size + 1 ].
+    s := String new: size - 3.
+    s replaceFrom: 1 to: s size with: aByteArray startingAt: 3.
+    portAdaptor value: s.
+    ^self uniqueInstance
+ ]
+
+ extractAddressesAfterLookup: result [
+    "Not implemented, DNS should not answer AF_UNIX addresses!"
+
+    self shouldNotImplement
+        ]
+    ]
+
+    = aSocketAddress [
+ "Answer whether the receiver and aSocketAddress represent
+ the same socket on the same machine."
+
+ <category: 'accessing'>
+ ^self == aSocketAddress
+    ]
+
+    isMulticast [
+ "Answer whether an address is reserved for multicast connections."
+
+ <category: 'testing'>
+ ^false
+    ]
+
+    hash [
+ "Answer an hash value for the receiver"
+
+ <category: 'accessing'>
+ ^self class hash
+    ]
+
+    printOn: aStream [
+ "Print the receiver in dot notation."
+
+ <category: 'printing'>
+ aStream nextPutAll: '[AF_UNIX address family]'
+    ]
+
+    port: port [
+ "Return a ByteArray containing a struct sockaddr for the given port
+ on the IP address represented by the receiver. Family = AF_INET."
+
+ <category: 'private'>
+ | portString |
+ portString := port asString.
+ portString isEmpty
+    ifTrue: [self error: 'invalid socket path'].
+ portString size > 108
+    ifTrue: [self error: 'socket path too long'].
+ ^(ByteArray new: 110)
+    "Write sin_family = AF_INET in host order"
+    shortAt: 1 put: self class addressFamily;
+    replaceFrom: 3 to: portString size + 2 with: portString startingAt: 1;
+    yourself
+    ]
+]
+
+
+SocketImpl subclass: UnixSocketImpl [
+    
+    <comment: '
+This class represents a stream socket using the AF_UNIX address family.
+It unlinks the filesystem path when the socket is closed.
+'>
+    
+    <category: 'Sockets-Protocols'>
+
+    close [
+ <category: 'socket operations'>
+
+ | port |
+ port := localPort.
+ [ super close ] ensure: [
+    port isNil ifFalse: [ port asFile remove ] ]
+    ]
+]
+
+DatagramSocketImpl subclass: DatagramUnixSocketImpl [
+    
+    <comment: '
+This class represents a datagram socket using the AF_UNIX address family.
+It unlinks the filesystem path when the socket is closed.
+'>
+    
+    <category: 'Sockets-Protocols'>
+
+    close [
+ <category: 'socket operations'>
+
+ | port |
+ port := localPort.
+ [ super close ] ensure: [
+    port isNil ifFalse: [ port asFile remove ] ]
+    ]
+]
+
+Eval [
+    UnixAddress initialize
+]
diff --git a/packages/sockets/cfuncs.st b/packages/sockets/cfuncs.st
index 0cf2c1f..a7aa5f4 100644
--- a/packages/sockets/cfuncs.st
+++ b/packages/sockets/cfuncs.st
@@ -14,6 +14,22 @@ IPAddress class extend [
 
 ]
 
+UnixAddress class extend [
+
+    addressFamily [
+ <category: 'C constants'>
+ <cCall: 'TCPafUnix' returning: #long args: #()>
+
+    ]
+
+    protocolFamily [
+ <category: 'C constants'>
+ <cCall: 'TCPpfUnix' returning: #long args: #()>
+
+    ]
+
+]
+
 
 
 AbstractSocketImpl class extend [
diff --git a/packages/sockets/package.xml b/packages/sockets/package.xml
index ba407a8..7cccc0f 100644
--- a/packages/sockets/package.xml
+++ b/packages/sockets/package.xml
@@ -6,6 +6,7 @@
   <filein>SocketAddress.st</filein>
   <filein>AbstractSocketImpl.st</filein>
   <filein>IPSocketImpl.st</filein>
+  <filein>UnixSocketImpl.st</filein>
   <filein>Sockets.st</filein>
   <filein>Tests.st</filein>
   <filein>cfuncs.st</filein>
@@ -18,6 +19,7 @@
   <file>SocketAddress.st</file>
   <file>AbstractSocketImpl.st</file>
   <file>IPSocketImpl.st</file>
+  <file>UnixSocketImpl.st</file>
   <file>Sockets.st</file>
   <file>Tests.st</file>
   <file>cfuncs.st</file>
diff --git a/packages/sockets/sockets.c b/packages/sockets/sockets.c
index 43fae16..cea5c02 100644
--- a/packages/sockets/sockets.c
+++ b/packages/sockets/sockets.c
@@ -226,7 +226,9 @@ getAnyLocalAddress (char *name, char *whereToPut)
   static long name(void) { return (constant); }
 
 constantFunction (afInet, AF_INET);
+constantFunction (afUnix, AF_UNIX);
 constantFunction (pfInet, PF_INET);
+constantFunction (pfUnix, PF_UNIX);
 constantFunction (msgOOB, MSG_OOB);
 constantFunction (msgPeek, MSG_PEEK);
 constantFunction (solSocket, SOL_SOCKET);
@@ -287,7 +289,9 @@ gst_initModule (VMProxy * proxy)
   vmProxy->defineCFunc ("TCPsocket", socket);
 
   vmProxy->defineCFunc ("TCPpfInet", pfInet);
+  vmProxy->defineCFunc ("TCPpfUnix", pfUnix);
   vmProxy->defineCFunc ("TCPafInet", afInet);
+  vmProxy->defineCFunc ("TCPafUnix", afUnix);
   vmProxy->defineCFunc ("TCPipMulticastTtl", ipMulticastTtl);
   vmProxy->defineCFunc ("TCPipMulticastIf", ipMulticastIf);
   vmProxy->defineCFunc ("TCPipAddMembership", ipAddMembership);

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk