Re: Structure of the multitasking server

[anon@anon.org (anon)]

--
--  A Server and a Client that shows how to use 
--  GNAT.Sockets.Check_Selection as a controller for
--  multiple port server. And can be alter to allow multiple 
--  services type of server.
--
--  In C,  they call this type of server a Super-Server Class 
--  of servers.
--

-- ------------------------------------------------------------ --
-- Multi-Tasking Server that allows Multi-Service to be handled --
-- ------------------------------------------------------------ --

with Ada.Text_IO ;
with GNAT.Sockets ;
with System ;

use  Ada.Text_IO ;
use  GNAT.Sockets ;

procedure testserver is 


  -- ------------------- --
  --  Server Task Types  --
  -- ------------------- --

    -- 
    --  TCP Task
    -- 

    task tcp_hello is
        entry Initialize ;
        entry Acknowledge ;
      end tcp_hello ;


    -- 
    --  UDP Task
    -- 

    task udp_hello is
        entry Initialize ;
        entry Acknowledge ;
      end udp_hello ;


    Server_Error  : exception ;

    tcp_Socket    : Socket_Type       ;
    udp_Socket    : Socket_Type       ;


-- ------------------------------------------------------------------------ --
----                        TCP/IP Controller Task                        ----
----                                                                      ----
----  dispatches server task to handle tcp/ip services.                   ----
----                                                                      ----
-- ------------------------------------------------------------------------ --

    task Controller is
        entry Initialize_Controller ;
      end Controller  ;


    task body Controller is

        Selector      : Selector_Type   ;
        Server_Status : Selector_Status ;

        --  Exception_Fds is not use in Ada 95
        --  and is optional Ada 2005 GNAT.Sockets

        Read_Fds      : Socket_Set_Type ;
        Write_Fds     : Socket_Set_Type ;


      begin -- Controller 
          --
          -- Set up controller variables
          --
          Create_Selector ( Selector ) ;
          Empty ( Read_Fds ) ;
          Empty ( Write_Fds ) ;


          Accept Initialize_Controller ;

          --
          -- Set up and active Server
          --
          Put_Line ( "Controller: Server Dispatching Loop" ) ;
          loop
            -- Insure Fds value, 
            Empty ( Read_Fds ) ;
            Empty ( Write_Fds ) ;

            Set ( Read_Fds, tcp_Socket ) ;
            Set ( Read_Fds, udp_Socket ) ;

            --
            --  Excute the TCP/IP "Select" routine.  This routine is blocked
            --  until a connecion is made. In this part it is identical to 
            --  TCP/IP "Accept".
            --
            --  Also, Exception_Fds is not use in Ada 95 and is optional 
            --  Ada 2005 GNAT.Sockets
            --
            Check_Selector ( Selector, 
                             Read_Fds, 
                             Write_Fds, 
                             Server_Status ) ;

            -- call a server to handle job using Signalling Fds

            if Is_Set ( Read_Fds, tcp_Socket ) then
                tcp_hello.Acknowledge ;
            elsif Is_Set ( Read_Fds, udp_Socket ) then
                udp_hello.Acknowledge ;
            else
              raise Socket_Error ;
            end if ;
          end loop ;
       exception
         when Socket_Error => 
             -- need to signal servers to shutdown because 
             -- dispatcher has stopped
             raise ;            
      end Controller  ;




-- ------------------------------------------------------------------------ --
----                         TCP/IP Server Tasks                          ----
----                                                                      ----
----  Both tasks are similar.  They both send a message to a client       ----
----  Differences:                                                        ----
----        1) Transport protocols: One uses TCP, the other uses UDP      ----
----        2) Message and message length                                 ----
----                                                                      ----
----  Excution of these two servers will cause the "netstat" program      ----
----  to add the following info to the "netstat" socket report            ----
----                                                                      ----
----      IP Address        protocol    port                              ----
----      127.0.0.1         tcp         54321                             ----
----      127.0.0.1         udp         54321                             ----
----                                                                      ----
-- ------------------------------------------------------------------------ --



    task body tcp_hello is

        Port         : constant Port_Type := 54321 ;

        Address      : Sock_Addr_Type    ;
        Channel      : Stream_Access     ;
        Client       : Socket_Type       ; 

        hello_string : String ( 1..25 ) := "TCP Server: Hello, World!" ; 

      begin -- Tcp_hello

        Create_Socket ( tcp_Socket, Family_Inet, Socket_Stream ) ;
        --
--        Address.Addr := Any_Inet_Addr ;
        Address.Addr := Inet_Addr ( "127.0.0.1" ) ; -- Limited access
        Address.Port := Port ;
        --
        Bind_Socket ( tcp_Socket, Address ) ;

        --
        Listen_Socket ( tcp_Socket, 4 ) ;  

        Accept Initialize ;
        --
        --  Main Server processing routine 
        --
        Put_Line ( "TCP: Active the Server loop" ) ;
        loop 
          accept Acknowledge ;

          -- ------------------------ --
          --  Do server services job  --
          -- ------------------------ --

          --
          --  Because of Check_Selector, no wait for Accept_Socket
          --  used to obtain connected socket ( Client ) address 
          --  for the tcp protocol.
          --
          Accept_Socket ( tcp_Socket, Client, Address ) ;

          Channel := Stream ( Client ) ;

          String'Write ( Channel, hello_string ) ;

          Close_Socket ( Client ) ;

        end loop ;

        --
        -- for security, close socket if exception occured
        --
        exception
          when others =>
              Put_Line ( "TCP: Exception" ) ;
              Close_Socket ( tcp_Socket ) ;
              raise ;
      end tcp_hello ;



    -- 
    --  UDP Task
    -- 

    task body udp_hello is

        Port           : constant Port_Type := 54321 ;

        Address        : Sock_Addr_Type    ;
        Channel_Input  : Stream_Access     ;
        Channel_Output : Stream_Access     ;

        Temp           : Character         ;
        hello_string : String := "UDP Server: Repeat Hello, World!" ; 

      begin -- udp_hello

        Create_Socket ( udp_Socket, Family_Inet, Socket_Datagram ) ;
        --
--        Address.Addr := Any_Inet_Addr ;
        Address.Addr := Inet_Addr ( "127.0.0.1" ) ;
        Address.Port := Port ;
        --
        Bind_Socket ( udp_Socket, Address ) ;


        Accept Initialize ;
        --
        --  Main Server processing routine 
        --
        Put_Line ( "UDP: Active the Server loop" ) ;
        loop 
          accept Acknowledge ;

          -- ------------------------ --
          --  Do server services job  --
          -- ------------------------ --
                                           -- Accept from any Address and Port
          Address.Addr := Any_Inet_Addr ;
          Address.Port := Any_Port ;

          Channel_Input := Stream ( udp_Socket, Address ) ;  
      
          Character'Read ( Channel_Input, Temp ) ;

                                           -- Open an output channel
          Address := Get_Address ( Channel_Input ) ;
          Channel_Output := Stream ( udp_Socket, Address ) ;

          String'Write ( Channel_Output, hello_string ) ;
        end loop ;

        --
        -- for security, close socket if exception occured
        --
        exception
          when others =>
              Put_Line ( "UDP: Exception" ) ;
              Close_Socket ( udp_Socket ) ;
              raise ;
      end udp_hello ;



                      -- ------------------------ --
                      ----   Server Initiaizer  ----
                      -- ------------------------ --



  begin

    -- Initialize each server service task

    tcp_hello.Initialize ;
    udp_hello.Initialize ;

    --  Startup network controller

    Controller.Initialize_Controller ;

  --
  -- Handle all exceptions
  --
  exception 
    when Socket_Error =>
      raise ;
    when others =>
      raise ;
  end testserver ;





-- ----------------------------------------------------- --
-- Non-Tasking Client that test the Multi-Service Server --
-- ----------------------------------------------------- --

with Ada.Command_Line ;
with Ada.Text_IO ;
with Ada.Unchecked_Conversion ;
with GNAT.Sockets ;

use  Ada.Command_Line ;
use  Ada.Text_IO ;
use  GNAT.Sockets ;

procedure testclient is 

    localhost : constant Inet_Addr_Type := Inet_Addr ( "127.0.0.1" ) ;
    localport : constant Port_Type := 54321 ;
    --
    Address : Sock_Addr_Type    ;
    Channel : Stream_Access     ;
    Socket  : Socket_Type       ;
    --
    tcp_Buffer  : String ( 1..25 )  ;
    udp_Buffer  : String ( 1..32 )  ;

  begin -- Daytime0

    --
    Address.Addr := localhost ;
    Address.Port := localport ;

    --
    if Argument ( 1 ) = "-T" then
      Put_Line ( "Protocol: TCP" ) ;
      --
      Create_Socket ( Socket, Family_Inet, Socket_Stream ) ;
      Connect_Socket ( Socket, Address ) ;
      --
      Channel := Stream ( Socket ) ;
      String'Read ( Channel, tcp_Buffer ) ;
      --
      Close_Socket ( Socket ) ;
      --
      Put ( "Server Data => " ) ;
      Put ( tcp_Buffer ) ;
      Put ( " <= " ) ;
      New_Line ;

    elsif Argument ( 1 ) = "-U" then
      Put_Line ( "Protocol: UDP" ) ;
      --
      Create_Socket ( Socket, Family_Inet, Socket_Datagram ) ;
      Channel := Stream ( Socket, Address ) ;

      -- Allows server to obtain client address by send a dummy character 

      Character'Write ( Channel, Ascii.nul ) ; 
      --
      Channel := Stream ( Socket, Address ) ;
      String'Read ( Channel, udp_Buffer ) ;
      --
      Close_Socket ( Socket ) ;
      --
      Put ( "Server Data => " ) ;
      Put ( udp_Buffer ) ;
      Put ( " <= " ) ;
      New_Line ;

     else
      Put_Line ( Standard_Error, "usage: testclient [-DT]" ) ;
      Put_Line ( Standard_Error, "-T: tcp" ) ;
      Put_Line ( Standard_Error, "-U: udp" ) ;
      New_Line ;
    end if ;
  end testclient ;