*scratch*

vijay's weblog

An asynchronous network server

An event-based echo server in Spark-Scheme:

(define server (create-server
                   (lambda (client)
                      (socket-send client (recv-all client)))))

(listen server 8080)

This is built on top of the reactor framework:

(import (net) (reactor))

(define (create-server on-client-request)
   (let ((server-socket (socket-acceptor)))
     (acceptor-on-client-read! server-socket
          (lambda (acceptor client-socket)
             (socket-non-blocking! client-socket #t)
             (on-client-request client-socket)))
     (acceptor-on-server-timeout! server-socket
         (lambda (acceptor) null))
     (acceptor-on-client-connect! server-socket
          (lambda (acceptor client-socket)
             (acceptor-add-watch acceptor 
                   (connection-socket client-socket) 'for-read)))
     server-socket))

(define (listen server-socket port)
   (acceptor-port! server-socket port)
   (acceptor-open server-socket #t (list 10 0))
   (let ((cb null))
     (set! cb (lambda () (acceptor-watch server-socket) (cb)))
     (thread cb)))

(define (recv-all socket)
   (let loop ((in (socket-recv socket 1024))
              (s (open-output-string)))
     (if (> (string-length in) 0)
       (begin
          (fprintf s "~a" in)
          (loop (socket-recv socket 1024) s))
       (get-output-string s))))

A client written in python to test the server:

import socket
import sys

HOST = '127.0.0.1'
PORT = 8080

try:
  sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
except socket.error, msg:
  sys.stderr.write("[ERROR] %s\n" % msg[1])
  sys.exit(1)

try:
  sock.connect((HOST, PORT))
except socket.error, msg:
  sys.stderr.write("[ERROR] %s\n" % msg[1])
  sys.exit(2)

req = ""
req = req + sys.argv[1]
req = req + "\n"

sock.send(req)
string = sock.recv(len(req))
print len(string)
sock.close()

Though it need some tidying-up, the reactor framework can be used to write interesting network applications.

Smalltalk India Meetup

Gave a short talk at the Smalltalk India Meetup. It was a live presentation of “concurrent objects” in Spark-Scheme:

Concurrent objects are represented as closures. All computations take place by message-passing. There is no shared state and as a consequence you are free from all problems associated with explicit locking (or lack of it). If you are familiar with Erlang, you know what I am talking about. Here is the definition of a tiny object that compute areas of various geometric objects:

(import (match)) ;; for pattern matching messages

(define pi 3.14159)

(define (area-server self) ;; self is a unique integer that 
                           ;; identifies this object within the system.
   (let loop ((message (receive self)))
     (unless (eq? message 'exit)
            (match message
                   (('circle r)
                     (printf "area of circle = ~a~n"  (* pi (* r r))))
                   (('rectangle h w)
                     (printf "area of rectange = ~a~n"  (* h w)))
                    (_ (printf "unknown message - ~a~n" message)))
              (flush-output) ;; We need this because the server
                             ;; is running in its own process.
              (loop (receive self)))))

A new instance of area-server is created by calling the spawn function:

> (spawn area-server)
=> 1

The integer id returned by spawn is used to send messages to the concurrent object:

> (send 1 '(circle 10))
 => area of circle = 314.159

As the number of objects in the system grows, it might become hard to keep track of the object ids. It is convenient to map the id to a name and use that name in send and receive:

> (register 2 "area-server")
> (send "area-server" '(rectangle 3 4))
=> area of rectange = 12

The object prints out the result. Let us see how we can make it to actually return the result. We need some changes to the protocol so that the object receives the id of the client that made the request. It will use this id to send back the result to that particular client. Here is our modified area-server:

(define (area-server self)
  (let loop ((message (receive self)))
    (unless (eq? message 'exit)
            (match message
                   (('circle r client-pid)
                    (send client-pid (* pi (* r r))))
                   (('rectangle h w client-pid)
                    (send client-pid (* h w)))
                   (_ (printf "unknown message - ~a~n" message)))
            (flush-output)
            (loop (receive self)))))

Let us define a client to test our new server:

(define (area-client self)
    (send "area-server" (list 'circle 20 self)) ;; Note that we append 
                                                ;; our id to the message.
    (printf "result = ~a~n" (receive self)) ;; area-server sends back 
                                            ;; the result and we print it.
    (flush-output))

Make sure that everything works fine:

> (spawn area-server)
=> 3
> (register 3 "area-server")
> (spawn area-client)
=> 4 ;; id of client
=> result = 1256.636 ;; result received from area-server.

To make it more useful, let us wrap our client in another function:

(define (spawn-area-client server-id message)
  (spawn
    (lambda (self)
      (register self "area-client")
      (send server-id (append message (list self)))
      (printf "result = ~a~n" (receive self))
      (flush-output))))

Now it is easier to test various message patterns:

> (spawn-area-client "area-server" (list 'circle 3.4))
=>10
=> result = 36.31678039999999
> (spawn-area-client "area-server" (list 'rectangle 4.5 6.7))
=> 11
=> result = 30.150000000000002

Concurrent objects are location agnostic. You can develop and test components in a single VM and later deploy them across a network, with little ceremony. To enable the area-server to receive messages from the network, you just need to start the remoting service:

> (remoting!)

The client should append its location to its name:

(send server-id (append message (list "area-client@node2")))

That’s all we need to make objects at different locations communicate with each other:

> (remoting!)
> (spawn-area-client "area-server@node1" (list 'circle 10.56))
=> 1
=> result = 350.330010624

Before we conclude, a word about fault tolerance. A process can exit the message loop on its own or it could get killed if the VM sends it the kill signal. We can assign a process to watch other processes (or concurrent objects). When an object dies or gets killed, all its watchers are notified. Here is a watcher process that restarts area-server whenever it dies as a result of a kill signal:

(define (watcher pid proc proc-name)
  (spawn
   (lambda (watcher-id)
     (watch pid watcher-id) ;; a watcher can watch any number of processes.
     (let loop ((message (receive watcher-id)))
         (if (eq? (car message) 'killed)
            (let ((new-id (spawn proc)))
              (register new-id proc-name)
              (watcher new-id proc proc-name)))))))

The watcher is assigned to watch the running area-server:

> (watcher 3 area-server "area-server")

3 is the id of area-server process to watch. If that process gets killed, the watcher process will restart it and bind it to the name “area-server”. We can kill a running process by calling the kill function:

> (kill 3)

Now if you go to the client node (node2) and send a message, you will still get the result from the new process spawned by the watcher. The re-spawning happens quite quickly as the processes are very lightweight objects living in the VM itself. We can run tens-of-thousands of such concurrent objects efficiently in a single instance of Spark.

Well, that’s all there is about concurrent objects!!

PS: If you are wondering why I was allowed to talk about a Lisp implementation at a Smalltalk event, there could be many reasons for that:

  • Lisp is the grand-daddy of all dynamic languages
  • Message-passing is of great interest to Smalltalkers
  • Alan Kay is the biggest fan of Lisp!

Looking forward for the next meetup of the Smalltalk India Group. Found some guys there who are really passionate about what they are doing in this amazing language!

The ring benchmark - 2 (Spark-Scheme)

Click here to download:
ring.ss (1 KB)

I wrote one in Spark-Scheme, so that I can compare it with the Erlang version. LOC is same for both. Of course, Erlang does a better job in spawning new processes. The difference becomes noticeable when we cross the 100000 process threshold. Erlang spawns 100000+ processes in less than 1 second, while Spark-Scheme takes somewhere between 3-7 seconds. I don't think it is bad, considering the fact that the entire process management code in Spark is written in Scheme (as a hobby project!), while Erlang is optimized to do this kind of work.