2016 Update

Task/Echo-server/Ada/echo-server-2.ada

@@ -0,0 +1,143 @@
+with Ada.Text_IO;
+with Ada.IO_Exceptions;
+with GNAT.Sockets;
+procedure echo_server_multi is
+-- Multiple socket connections example based on Rosetta Code echo server.
+
+   Tasks_To_Create : constant := 3; -- simultaneous socket connections.
+
+-------------------------------------------------------------------------------
+-- Use stack to pop the next free task index. When a task finishes its
+-- asynchronous (no rendezvous) phase, it pushes the index back on the stack.
+   type Integer_List is array (1..Tasks_To_Create) of integer;
+   subtype Counter is integer range 0 .. Tasks_To_Create;
+   subtype Index is integer range 1 .. Tasks_To_Create;
+   protected type Info is
+      procedure Push_Stack (Return_Task_Index : in Index);
+      procedure Initialize_Stack;
+      entry Pop_Stack (Get_Task_Index : out Index);
+   private
+      Task_Stack   : Integer_List; -- Stack of free-to-use tasks.
+      Stack_Pointer: Counter := 0;
+   end Info;
+
+   protected body Info is
+      procedure Push_Stack (Return_Task_Index : in Index) is
+      begin -- Performed by tasks that were popped, so won't overflow.
+         Stack_Pointer := Stack_Pointer + 1;
+         Task_Stack(Stack_Pointer) := Return_Task_Index;
+      end;
+
+      entry Pop_Stack (Get_Task_Index : out Index) when Stack_Pointer /= 0 is
+      begin -- guarded against underflow.
+         Get_Task_Index := Task_Stack(Stack_Pointer);
+         Stack_Pointer := Stack_Pointer -  1;
+      end;
+
+      procedure Initialize_Stack is
+      begin
+         for I in Task_Stack'range loop
+            Push_Stack (I);
+         end loop;
+      end;
+   end Info;
+
+   Task_Info : Info;
+
+-------------------------------------------------------------------------------
+   task type SocketTask is
+      -- Rendezvous the setup, which sets the parameters for entry Echo.
+      entry Setup (Connection : GNAT.Sockets.Socket_Type;
+                   Client     : GNAT.Sockets.Sock_Addr_Type;
+                   Channel    : GNAT.Sockets.Stream_Access;
+                   Task_Index : Index);
+      -- Echo accepts the asynchronous phase, i.e. no rendezvous. When the
+      -- communication is over, push the task number back on the stack.
+      entry Echo;
+   end SocketTask;
+
+   task body SocketTask is
+      my_Connection : GNAT.Sockets.Socket_Type;
+      my_Client     : GNAT.Sockets.Sock_Addr_Type;
+      my_Channel    : GNAT.Sockets.Stream_Access;
+      my_Index      : Index;
+   begin
+      loop -- Infinitely reusable
+         accept Setup (Connection : GNAT.Sockets.Socket_Type;
+                       Client  : GNAT.Sockets.Sock_Addr_Type;
+                       Channel : GNAT.Sockets.Stream_Access;
+                       Task_Index   : Index) do
+            -- Store parameters and mark task busy.
+            my_Connection := Connection;
+            my_Client     := Client;
+            my_Channel    := Channel;
+            my_Index      := Task_Index;
+         end;
+
+         accept Echo; -- Do the echo communications.
+         begin
+            Ada.Text_IO.Put_Line ("Task " & integer'image(my_Index));
+            loop
+               Character'Output (my_Channel, Character'Input(my_Channel));
+            end loop;
+         exception
+            when Ada.IO_Exceptions.End_Error =>
+              Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " end");
+            when others =>
+              Ada.Text_IO.Put_Line ("Echo " & integer'image(my_Index) & " err");
+         end;
+         GNAT.Sockets.Close_Socket (my_Connection);
+         Task_Info.Push_Stack (my_Index); -- Return to stack of unused tasks.
+      end loop;
+   end SocketTask;
+
+-------------------------------------------------------------------------------
+-- Setup the socket receiver, initialize the task stack, and then loop,
+-- blocking on Accept_Socket, using Pop_Stack for the next free task from the
+-- stack, waiting if necessary.
+   task type SocketServer (my_Port : GNAT.Sockets.Port_Type) is
+      entry Listen;
+   end SocketServer;
+
+   task body SocketServer is
+   Receiver   : GNAT.Sockets.Socket_Type;
+   Connection : GNAT.Sockets.Socket_Type;
+   Client     : GNAT.Sockets.Sock_Addr_Type;
+   Channel    : GNAT.Sockets.Stream_Access;
+   Worker     : array (1..Tasks_To_Create) of SocketTask;
+   Use_Task   : Index;
+
+   begin
+      accept Listen;
+      GNAT.Sockets.Create_Socket (Socket => Receiver);
+      GNAT.Sockets.Set_Socket_Option
+        (Socket => Receiver,
+         Option => (Name    => GNAT.Sockets.Reuse_Address, Enabled => True));
+      GNAT.Sockets.Bind_Socket
+        (Socket  => Receiver,
+         Address => (Family => GNAT.Sockets.Family_Inet,
+                     Addr   => GNAT.Sockets.Inet_Addr ("127.0.0.1"),
+                     Port   => my_Port));
+      GNAT.Sockets.Listen_Socket (Socket => Receiver);
+      Task_Info.Initialize_Stack;
+Find: loop -- Block for connection and take next free task.
+         GNAT.Sockets.Accept_Socket
+           (Server  => Receiver,
+            Socket  => Connection,
+            Address => Client);
+         Ada.Text_IO.Put_Line ("Connect " & GNAT.Sockets.Image(Client));
+         Channel := GNAT.Sockets.Stream (Connection);
+         Task_Info.Pop_Stack(Use_Task); -- Protected guard waits if full house.
+         -- Setup the socket in this task in rendezvous.
+         Worker(Use_Task).Setup(Connection,Client, Channel,Use_Task);
+         -- Run the asynchronous task for the socket communications.
+         Worker(Use_Task).Echo; -- Start echo loop.
+      end loop Find;
+   end SocketServer;
+
+   Echo_Server : SocketServer(my_Port => 12321);
+
+-------------------------------------------------------------------------------
+begin
+   Echo_Server.Listen;
+end echo_server_multi;

Task/Echo-server/Common-Lisp/echo-server-1.lisp

@@ -4,7 +4,7 @@
 
 (defun read-all (stream)
   (loop for char = (read-char-no-hang stream nil :eof)
-     until (or (null char) (eq char :eof)) collect char into msg
+     until (or (null char) (eql char :eof)) collect char into msg
      finally (return (values msg char))))
 
 (defun echo-server (port &optional (log-stream *standard-output*))

Task/Echo-server/Factor/echo-server.factor

@@ -1,17 +1,16 @@
-USING: accessors io io.encodings.utf8 io.servers.connection
-threads ;
+USING: accessors io io.encodings.utf8 io.servers io.sockets threads ;
 IN: rosetta.echo
 
 CONSTANT: echo-port 12321
 
 : handle-client ( -- )
-    [ write "\r\n" write flush ] each-line ;
+   [ print flush ] each-line ;
 
 : <echo-server> ( -- threaded-server )
     utf8 <threaded-server>
-        "echo-server" >>name
+        "echo server" >>name
         echo-port >>insecure
         [ handle-client ] >>handler ;
 
-: start-echo-server ( -- threaded-server )
-    <echo-server> [ start-server ] in-thread ;
+: start-echo-server ( -- )
+    <echo-server> [ start-server ] in-thread start-server drop ;

Task/Echo-server/Lua/echo-server.lua

@@ -0,0 +1,31 @@
+require("socket")
+
+function checkOn (client)
+    local line, err = client:receive()
+    if line then
+        print(tostring(client) .. " said " .. line)
+        client:send(line .. "\n")
+    end
+    if err and err ~= "timeout" then
+        print(tostring(client) .. " " .. err)
+        client:close()
+        return err
+    end
+    return nil
+end
+
+local delay, clients, newClient = 10^-6, {}
+local server = assert(socket.bind("*", 12321))
+server:settimeout(delay)
+print("Server started")
+while 1 do
+    repeat
+        newClient = server:accept()
+        for k, v in pairs(clients) do
+            if checkOn(v) then table.remove(clients, k) end
+        end
+    until newClient
+    newClient:settimeout(delay)
+    print(tostring(newClient) .. " connected")
+    table.insert(clients, newClient)
+end

Task/Echo-server/Perl-6/echo-server.pl6

@@ -8,7 +8,7 @@ while $socket.accept -> $conn {
     start {
         while $conn.recv -> $stuff {
             say "Echoing $stuff";
-            $conn.send($stuff);
+            $conn.print($stuff);
         }
         $conn.close;
     }

Task/Echo-server/Racket/echo-server.rkt

@@ -1,5 +1,4 @@
 #lang racket
-
 (define listener (tcp-listen 12321))
 (let echo-server ()
   (define-values [I O] (tcp-accept listener))