GNU Smalltalk SimpleChat TCP Server

Or: How to build yourself a re-usable class library

Last week I put together a simple echo server as a kind of "tutorial for myself" as to how to get started writing TCP servers for GNU Smalltalk. I left out all kinds of nice things, most notably error detection and proper termination, but for practical purposes, the most notably absent feature is the general one of "state". For a simple echo server, maybe that's not terribly important. So for my next self-guided dive into Smalltalk, I'm taking a crack at writing a simple chat server that allows people to connect and chat with whomever else is connected.

What I'd like to do is build off of that SimpleEcho class I put together in the last entry. After all, it seems like all I need to do differently is (1) keep track of the connected clients and (2) handle each client as a chat client instead of as an echo client.

To do that, I need some way of importing a class defined in one of my file listings into another file listing. There end up being lots of ways to do an organize this process. The packages way requires XML files, configuration, and other various ickiness. You can simply use FileStream fileIn: '' to basically "source" a file, but then you'd have problems with things like name clashes if more than one library defined a class with the name, say, of Server.

Enter namespaces, which solve such collisions by letting you create namespaces and declare in which namespace your commands are operating:

Smalltalk addSubspace: #MyNamespace!
Namespace current: MyNamespace!

Even here, there were several approaches which I could take. I could have each "package load" look somewhat like:

Smalltalk addSubspace: #MyNamespace!
Namespace current: MyNamespace!
FileStream fileIn: ''!
Namespace current: MyNamespace superspace!

Resulting in the fairly ugly block below for another file wanting to use a few packages:

PackageLoader fileInPackage: 'TCP'!

#(#SimpleChat #SimpleTCP) do: [
  :symbol | [
    | namespace |
    namespace := Namespace current addSubspace: symbol.
    Namespace current: namespace.
    FileStream fileIn: ((symbol asString), '.st').
    Namespace current: Smalltalk
  ] value

Or I could have each library file define its own namespace:

Namespace current addSubspace: #MyNamespace!
Namespace current: MyNamespace!

... actual contents ...

Namespace current: MyNamespace superspace!

With either method, you end up still with a quite unsatisfactory solution, with no support for what happens when two modules each want to use a third module, etc. This is, of course, what PackageLoader does, with its trade-off of managing an XML configuration file and installation directories.

But for the simple collection of classes which I will use here, any old simplistic namespace and file loading strategy will do, in fact no namespaces at all would do. But I'm going to use namespaces anyway, just to experiment a bit with how they work. Overall, though, I am a bit unhappy with (my understanding, at least) GNU Smalltalk handles the entire namespace and package process, as it seems to prefer a strong amount of configuration over some simple conventions by default, such as, perhaps Package import #MyPackage looking through a path for and loading it, etc. Ah well.

Anyway. The first thing I needed was to "abstractify" my EchoServer example into something that doesn't actually do, well, anything, instead delegating "that thing that needs to happen when I accept a client socket" to another object. I ended up with something like this (

"SimpleTCP -- a simple TCP server class library"

Namespace current addSubspace: #SimpleTCP!
Namespace current: SimpleTCP!

"A simple TCP server"
Object subclass: #Server
  instanceVariableNames: 'serverSocket socketHandler'
  classVariableNames: ''
  poolDictionaries: ''
  category: ''!

!Server class methodsFor: 'instance creation'!

new: aServerSocket handler: aHandler
  | simpleServer |
  simpleServer := super new.
  simpleServer socket: aServerSocket.
  simpleServer handler: aHandler.
  simpleServer init.

!Server methodsFor: 'initialization'!


!Server methodsFor: 'accessing'!


socket: aServerSocket
  serverSocket := aServerSocket.


handler: aHandler
  socketHandler := aHandler.

!Server methodsFor: 'running'!

  | s |
    serverSocket waitForConnection.
    s := (serverSocket accept).
    self handle: s
  ] repeat

!Server methodsFor: 'handling'!

handle: aSocket
  socketHandler handle: aSocket

Namespace current: SimpleTCP superspace!

There really shouldn't be much "new" there to see. Basically we let the consumer of our SimpleTCP.Server class hand it a TCP.ServerSocket and an object which responds to a handle: message, and then end up calling that object's handle message each time we accept a new client socket.

Now, for the EchoServer the handling part was pretty simple: (1) read a line of input, (2) echo it back to the client. Our ChatServer does a little more, but not much more. Again, error checking is omitted for the time being, but I ended up with a little handler something like this (

"SimpleChat -- a SimpleTCP handler for a chat server"

Namespace current addSubspace: #SimpleChat!
Namespace current: SimpleChat!

Object subclass: #Handler
  instanceVariableNames: 'clients'
  classVariableNames: ''
  poolDictionaries: ''
  category: ''!

!Handler class methodsFor: 'instance creation'!

  | chatHandler |
  chatHandler := super new.
  chatHandler init.

!Handler methodsFor: 'initialization'!

  clients := Dictionary new.

!Handler methodsFor: 'handling'!

handle: aSocket
  [self handleSocket: aSocket] fork

!Handler methodsFor: 'internal handling'!

handleSocket: aSocket
  | Name |
  'Name: ' displayOn: aSocket.
  aSocket flush.
  Name := (aSocket nextLine).
  (clients includesKey: Name) ifTrue: [
    'Sorry, that name is in use.' displayOn: aSocket.
    (Character nl asString) displayOn: aSocket.
    self handle: aSocket
  ] ifFalse: [
    self handleMessage: ('New user: ', Name) from: '[System]'.
    clients at: Name put: aSocket.
    self handleClient: aSocket named: Name

handleClient: aSocket named: Name
    | Message |
    self sendPrompt: aSocket.
    Message := (aSocket nextLine).
    self handleMessage: Message from: Name.
  ] repeat

handleMessage: Message from: Name
  clients associationsDo: [ :assoc |
    (Name = (assoc key)) ifFalse: [
      self sendMessage: ((Character nl asString), Name, ' sent: ', Message) to: (assoc value).
      self sendPrompt: (assoc value)
    ] ifTrue: [
      self sendMessage: ('You sent: ', Message) to: (assoc value)

sendMessage: Message to: aSocket
  Message displayOn: aSocket.
  (Character nl asString) displayOn: aSocket

sendPrompt: aSocket
    '> ' displayOn: aSocket.
    aSocket flush

Namespace current: SimpleChat superspace!

So, there's only a few things here of interest. One is that, much like the ChatServer example, we're fork-ing over each client request, utilising GNU Smalltalk's lightweight processes on its VM. That is of course where the similarities begin to end. What we're doing is keeping track of a dictionary of clients, mapped by the name they picked when they first connected. Then, on each line of input from each client, we're sending the message to every client in the dictionary, with a slightly different message going to the person sending the message.

Anyway, try firing up this script which sets up the chat server:

PackageLoader fileInPackage: 'TCP'!
FileStream fileIn: ''!
FileStream fileIn: ''!

| chatServer chatHandler serverSocket |
serverSocket := (TCP.ServerSocket port: 8000).
chatHandler := SimpleChat.Handler new.
chatServer := SimpleTCP.Server new: serverSocket handler: chatHandler.
chatServer run!

Now, you can use multiple telnet clients to connect and chat with your server.

changed September 28, 2007