File : src/aws-server.adb


------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                         Copyright (C) 2000-2003                          --
--                                ACT-Europe                                --
--                                                                          --
--  Authors: Dmitriy Anisimkov - Pascal Obry                                --
--                                                                          --
--  This library is free software; you can redistribute it and/or modify    --
--  it under the terms of the GNU General Public License as published by    --
--  the Free Software Foundation; either version 2 of the License, or (at   --
--  your option) any later version.                                         --
--                                                                          --
--  This 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       --
--  General Public License for more details.                                --
--                                                                          --
--  You should have received a copy of the GNU General Public License       --
--  along with this library; if not, write to the Free Software Foundation, --
--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --
--                                                                          --
--  As a special exception, if other files instantiate generics from this   --
--  unit, or you link this unit with other files to produce an executable,  --
--  this  unit  does not  by itself cause  the resulting executable to be   --
--  covered by the GNU General Public License. This exception does not      --
--  however invalidate any other reasons why the executable file  might be  --
--  covered by the  GNU Public License.                                     --
------------------------------------------------------------------------------

--  $Id: aws-server.adb,v 1.116 2003/10/10 12:53:38 obry Exp $

with Ada.Calendar;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Task_Attributes;
with Ada.Text_IO;
with Ada.Unchecked_Deallocation;

with AWS.Config.Set;
with AWS.Dispatchers.Callback;
with AWS.Log;
with AWS.Messages;
with AWS.MIME;
with AWS.Net.Buffered;
with AWS.Net.SSL;
with AWS.OS_Lib;
with AWS.Server.Log;
with AWS.Session.Control;
with AWS.Status.Translate_Table;
with AWS.Templates;

package body AWS.Server is

   use Ada;
   use type Net.Socket_Access;

   Security_Initialized : Boolean := False;

   procedure Free is new Ada.Unchecked_Deallocation
     (Dispatchers.Handler'Class, Dispatchers.Handler_Class_Access);

   protected File_Upload_UID is
      procedure Get (ID : out Natural);
      --  returns a UID for file upload. This is to ensure that files
      --  coming from clients will always have different name.
   private
      UID : Natural := 0;
   end File_Upload_UID;

   procedure Start
     (Web_Server : in out HTTP;
      Dispatcher : in     Dispatchers.Handler'Class);
   --  Start web server with current configuration.

   procedure Protocol_Handler
     (HTTP_Server : in out HTTP;
      Index       : in     Positive;
      Keep_Alive  : in     Boolean);
   --  Handle the lines, this is where all the HTTP protocol is defined.
   --  Keep_Alive is True when there is enough slots to enable Keep_Alive
   --  connections.

   function Accept_Socket_Serialized
     (Server : in HTTP_Access)
      return Net.Socket_Type'Class;
   --  Do a protected accept on the HTTP socket. It is not safe to call
   --  multiple accept on the same socket on some platforms.

   protected Counter is

      procedure Add;
      --  Add one to the server counter.

      procedure Remove;
      --  Removes one to the server counter.

      entry Zero;
      --  Accepted only when counter is equal to 0 (no more active server)

   private

      C : Natural := 0;

   end Counter;

   package Line_Attribute is new Task_Attributes (HTTP_Access, null);
   --  A line specific attribute

   ------------------------------
   -- Accept_Socket_Serialized --
   ------------------------------

   function Accept_Socket_Serialized
     (Server : in HTTP_Access)
      return Net.Socket_Type'Class
   is
      New_Socket : Net.Socket_Type'Class
        := Net.Socket (CNF.Security (Server.Properties));

      Released_Socket : Net.Socket_Access;

      Accepting : Boolean := False;
      --  Determine either "accept socket" mode or "give back" mode.
      --  Init to False to not Release semaphore in case of exception
      --  in Seize_Or_Socket call.

      procedure Free is new
        Ada.Unchecked_Deallocation (Net.Socket_Type'Class, Net.Socket_Access);

   begin
      Server.Sock_Sem.Seize_Or_Socket (Released_Socket);

      Accepting := Released_Socket = null;

      if Accepting then
         --  No socket was given back to the server, just accept a socket from
         --  the server socket.

         Net.Accept_Socket (Server.Sock, New_Socket);

         Server.Sock_Sem.Release;

      else
         --  A socket was given back to the server, return it

         New_Socket := Released_Socket.all;

         --  We do not call AWS.Net.Free as we do not want to destroy the
         --  socket buffers.

         Free (Released_Socket);
      end if;

      return New_Socket;

   exception
      when others =>
         if Accepting then
            Server.Sock_Sem.Release;
         end if;

         raise;
   end Accept_Socket_Serialized;

   ------------
   -- Config --
   ------------

   function Config (Web_Server : in HTTP) return AWS.Config.Object is
   begin
      return Web_Server.Properties;
   end Config;

   -------------
   -- Counter --
   -------------

   protected body Counter is

      ---------
      -- Add --
      ---------

      procedure Add is
      begin
         C := C + 1;
      end Add;

      ------------
      -- Remove --
      ------------

      procedure Remove is
      begin
         C := C - 1;
      end Remove;

      ----------
      -- Zero --
      ----------

      entry Zero when C = 0 is
      begin
         null;
      end Zero;

   end Counter;

   ------------------------------------------
   -- Default_Unexpected_Exception_Handler --
   ------------------------------------------

   procedure Default_Unexpected_Exception_Handler
     (E      : in     Ada.Exceptions.Exception_Occurrence;
      Log    : in out AWS.Log.Object;
      Error  : in     Exceptions.Data;
      Answer : in out Response.Data)
   is
      use Ada.Exceptions;
      use type Templates.Translate_Table;
      pragma Unreferenced (Log);

      Fatal_Error_Template  : constant String := "500.tmplt";
   begin
      if Error.Fatal then
         Text_IO.Put_Line
           (Text_IO.Current_Error, "Fatal error, slot"
              & Positive'Image (Error.Slot) & " is dead now.");
         Text_IO.New_Line (Text_IO.Current_Error);

         Text_IO.Put_Line
           (Text_IO.Current_Error, Exception_Information (E));

      else
         if AWS.OS_Lib.Is_Regular_File (Fatal_Error_Template) then
            Answer := Response.Build
              (MIME.Text_HTML,
               String'(Templates.Parse
                         (Fatal_Error_Template,
                          Status.Translate_Table (Error.Request)
                            & Templates.Assoc
                                ("EXCEPTION", Exception_Information (E)))),
               Messages.S500);
         else
            Answer := Response.Build
              (MIME.Text_HTML,
               "Internal Server Error.<br>"
                 & "Please, send the following information to the Web "
                 & "Master, thanks.<br><hr><br>"
                 & "<pre>" & Exception_Information (E) & "</pre>"
                 & "<br><hr>",
               Messages.S500);
         end if;
      end if;
   end Default_Unexpected_Exception_Handler;

   ---------------------
   -- File_Upload_UID --
   ---------------------

   protected body File_Upload_UID is

      ---------
      -- Get --
      ---------

      procedure Get (ID : out Natural) is
      begin
         ID  := UID;
         UID := UID + 1;
      end Get;

   end File_Upload_UID;

   --------------
   -- Finalize --
   --------------

   procedure Finalize (Web_Server : in out HTTP) is
   begin
      Shutdown (Web_Server);
   end Finalize;

   -----------------
   -- Get_Current --
   -----------------

   function Get_Current return HTTP_Access is
   begin
      return Line_Attribute.Value;
   end Get_Current;

   ----------------------
   -- Give_Back_Socket --
   ----------------------

   procedure Give_Back_Socket
     (Web_Server : in out HTTP;
      Socket     : in     Net.Socket_Type'Class) is
   begin
      Web_Server.Sock_Sem.Put_Socket (new Net.Socket_Type'Class'(Socket));
   end Give_Back_Socket;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Web_Server : in out HTTP) is
      pragma Warnings (Off, Web_Server);
   begin
      null;
   end Initialize;

   ----------
   -- Line --
   ----------

   task body Line is

      HTTP_Server : HTTP_Access;
      Slot_Index  : Positive;

   begin

      select
         accept Start
           (Server : in HTTP;
            Index  : in Positive)
         do
            HTTP_Server := Server.Self;
            Slot_Index  := Index;
         end Start;
      or
         terminate;
      end select;

      Line_Attribute.Set_Value (HTTP_Server);

      --  Real job start here, we will exit only if there is an unrecoverable
      --  problem.

      while not HTTP_Server.Shutdown loop

         declare
            --  Wait for an incoming connection. Each call for the same server
            --  is serialized as some platforms do not handle properly
            --  multiple accepts on the same socket.

            Socket : aliased Net.Socket_Type'Class
              := Accept_Socket_Serialized (HTTP_Server);

            Free_Slots : Natural;

            Keep_Alive_Limit : constant Positive
               := CNF.Free_Slots_Keep_Alive_Limit (HTTP_Server.Properties);

         begin
            HTTP_Server.Slots.Set
              (Socket'Unchecked_Access,
               Slot_Index,
               Free_Slots);

            --  If there is no more slot available and we have many
            --  of them, try to abort one of them.

            if Free_Slots = 0
              and then CNF.Max_Connection (HTTP_Server.Properties) > 1
            then
               select
                  HTTP_Server.Cleaner.Force;
               or
                  delay 4.0;
                  Ada.Text_IO.Put_Line
                    (Text_IO.Current_Error, "Server too busy.");
               end select;
            end if;

            Protocol_Handler
              (HTTP_Server.all, Slot_Index, Free_Slots >= Keep_Alive_Limit);

            HTTP_Server.Slots.Release (Slot_Index);
         end;
      end loop;

   exception
      when E : others =>
         if not HTTP_Server.Shutdown then
            declare
               S      : Status.Data;
               pragma Warnings (Off, S);
               Answer : Response.Data;
            begin
               AWS.Log.Write
                 (HTTP_Server.Error_Log,
                  "Dead slot " & Utils.Image (Slot_Index) & ' '
                    & Utils.CRLF_2_Spaces
                        (Ada.Exceptions.Exception_Information (E)));

               HTTP_Server.Exception_Handler
                 (E, HTTP_Server.Error_Log, (True, Slot_Index, S), Answer);
            end;
         end if;
   end Line;

   ------------------
   -- Line_Cleaner --
   ------------------

   task body Line_Cleaner is
      Mode : Timeout_Mode;
      Done : Boolean := False;
   begin
      loop
         select
            accept Force do
               Mode := Force;
            end Force;
         or
            delay 30.0;
            Mode := Cleaner;
         end select;

         loop
            Server.Slots.Abort_On_Timeout (Mode, Done);

            exit when Mode /= Force or else Done;

            select
               accept Force;
            or
               delay 1.0;
            end select;
         end loop;

      end loop;
   end Line_Cleaner;

   ----------------------
   -- Protocol_Handler --
   ----------------------

   procedure Protocol_Handler
     (HTTP_Server : in out HTTP;
      Index       : in     Positive;
      Keep_Alive  : in     Boolean) is separate;

   ---------
   -- Set --
   ---------

   procedure Set
     (Web_Server : in out HTTP;
      Dispatcher : in     Dispatchers.Handler'Class)
   is
      Old : Dispatchers.Handler_Class_Access := Web_Server.Dispatcher;
   begin
      Web_Server.Dispatcher_Sem.Write;

      Web_Server.Dispatcher :=
        new Dispatchers.Handler'Class'(Dispatcher);

      Web_Server.Dispatcher_Sem.Release_Write;

      Free (Old);
   end Set;

   ------------------
   -- Set_Security --
   ------------------

   procedure Set_Security (Certificate_Filename : in String) is
   begin
      Security_Initialized := True;
      Net.SSL.Initialize (Certificate_Filename);
   end Set_Security;

   --------------------------------------
   -- Set_Unexpected_Exception_Handler --
   --------------------------------------

   procedure Set_Unexpected_Exception_Handler
     (Web_Server : in out HTTP;
      Handler    : in     Exceptions.Unexpected_Exception_Handler) is
   begin
      if Web_Server.Shutdown then
         Web_Server.Exception_Handler := Handler;
      else
         Ada.Exceptions.Raise_Exception (Constraint_Error'Identity,
            "Could not change exception handler on the active server.");
      end if;
   end Set_Unexpected_Exception_Handler;

   --------------
   -- Shutdown --
   --------------

   procedure Shutdown (Web_Server : in out HTTP) is

      procedure Free is
         new Ada.Unchecked_Deallocation (Line_Cleaner, Line_Cleaner_Access);

      procedure Free is
         new Ada.Unchecked_Deallocation (Line_Set, Line_Set_Access);

      procedure Free is
         new Ada.Unchecked_Deallocation (Slots, Slots_Access);

      procedure Free is
         new Ada.Unchecked_Deallocation (Line, Line_Access);

      All_Lines_Terminated : Boolean := False;

   begin
      if Web_Server.Shutdown then
         return;
      end if;

      Web_Server.Shutdown := True;

      --  First, close the sever socket, so no more request will be queued,
      --  furthermore this will help terminate all lines (see below).

      Net.Std.Shutdown (Web_Server.Sock);

      --  Release the slots

      for S in 1 .. Web_Server.Slots.N loop
         Web_Server.Slots.Shutdown (S);
      end loop;

      --  Wait for all lines to be terminated to be able to release associated
      --  memory.

      while not All_Lines_Terminated loop
         All_Lines_Terminated := True;

         for K in Web_Server.Lines'Range loop
            if not Web_Server.Lines (K)'Terminated then
               All_Lines_Terminated := False;
            end if;
         end loop;

         delay 0.5;
      end loop;

      --  Release the cleaner task

      abort Web_Server.Cleaner.all;

      --  Wait for Cleaner task to terminate to be able to release associated
      --  memory.

      while not Web_Server.Cleaner'Terminated loop
         delay 0.5;
      end loop;

      --  Release lines and slots memory

      for K in Web_Server.Lines'Range loop
         Free (Web_Server.Lines (K));
      end loop;

      Net.Std.Free (Web_Server.Sock);

      Free (Web_Server.Lines);

      Free (Web_Server.Cleaner);

      Free (Web_Server.Slots);

      Free (Web_Server.Dispatcher);

      --  Release the session server if needed

      if CNF.Session (Web_Server.Properties) then
         Session.Control.Shutdown;
      end if;

      --  Close logs, this ensure that all data will be written to the file.

      Log.Stop (Web_Server);

      Log.Stop_Error (Web_Server);

      --  Server removed

      Counter.Remove;
   end Shutdown;

   -----------
   -- Slots --
   -----------

   protected body Slots is

      ----------------------
      -- Abort_On_Timeout --
      ----------------------

      procedure Abort_On_Timeout
        (Mode : in Timeout_Mode; Done : out Boolean) is
      begin
         Done := False;

         for S in Table'Range loop
            if Is_Abortable (S, Mode) then
               Shutdown (S);
               Done := True;
            end if;
         end loop;
      end Abort_On_Timeout;

      ----------------
      -- Free_Slots --
      ----------------

      function Free_Slots return Natural is
      begin
         return Count;
      end Free_Slots;

      ---------
      -- Get --
      ---------

      function Get (Index : in Positive) return Slot is
      begin
         return Table (Index);
      end Get;

      ------------------
      -- Get_Peername --
      ------------------

      function Get_Peername (Index : in Positive) return String is
         use type Socket_Access;
         Socket : constant Socket_Access := Table (Index).Sock;
      begin
         if Socket = null then
            return "";
         else
            return Net.Peer_Addr (Socket.all);
         end if;
      end Get_Peername;

      ---------------------
      -- Get_Socket_Info --
      ---------------------

      function Get_Socket_Info (Index : in Positive) return Socket_Data is
         use type Socket_Access;
         Socket : constant Socket_Access := Table (Index).Sock;
      begin
         if Socket = null then
            return Socket_Data'
              (Peername_Length => 1, Peername => "-", FD => 0);

         else
            declare
               Peername : constant String := Net.Peer_Addr (Socket.all);
            begin
               return Socket_Data'
                  (Peername_Length => Peername'Length,
                   Peername        => Peername,
                   FD              => Net.Get_FD (Socket.all));
            end;
         end if;
      end Get_Socket_Info;

      -------------------------------------
      -- Increment_Slot_Activity_Counter --
      -------------------------------------

      procedure Increment_Slot_Activity_Counter (Index : in Positive) is
      begin
         Table (Index).Slot_Activity_Counter
           := Table (Index).Slot_Activity_Counter + 1;
         Table (Index).Alive_Counter
           := Table (Index).Alive_Counter + 1;
      end Increment_Slot_Activity_Counter;

      ------------------
      -- Is_Abortable --
      ------------------

      function Is_Abortable
        (Index : in Positive;
         Mode  : in Timeout_Mode)
         return Boolean
      is
         use type Calendar.Time;
         Phase : constant Slot_Phase    := Table (Index).Phase;
         Now   : constant Calendar.Time := Calendar.Clock;
      begin
         return
           (Phase in Abortable_Phase
            and then
            Now - Table (Index).Phase_Time_Stamp > Timeouts (Mode, Phase))

           or else

           (Phase in Data_Phase
            and then
            Now - Table (Index).Data_Time_Stamp > Data_Timeouts (Phase));
      end Is_Abortable;

      --------------------------
      -- Mark_Data_Time_Stamp --
      --------------------------

      procedure Mark_Data_Time_Stamp (Index : in Positive) is
      begin
         Table (Index).Data_Time_Stamp := Ada.Calendar.Clock;
      end Mark_Data_Time_Stamp;

      ----------------
      -- Mark_Phase --
      ----------------

      procedure Mark_Phase (Index : in Positive; Phase : in Slot_Phase) is
      begin
         --  Check if the Aborted phase happen between after socket operation
         --  and before Mark_Phase call.

         if Table (Index).Phase = Aborted
           and then Phase /= Closed
         then
            raise Net.Socket_Error;
         end if;

         Table (Index).Phase_Time_Stamp := Ada.Calendar.Clock;
         Table (Index).Phase := Phase;

         if Phase in Data_Phase then
            Mark_Data_Time_Stamp (Index);
         end if;
      end Mark_Phase;

      -------------
      -- Release --
      -------------

      procedure Release (Index : in Positive) is
         use type Socket_Access;
      begin
         pragma Assert (Count < N);
         --  No more release than it is possible
         pragma Assert
           ((Table (Index).Phase = Closed
               and then -- If phase is closed, then Sock must be null
               (Table (Index).Sock = null))
            or else -- or phase is not closed
              (Table (Index).Phase /= Closed));

         Count := Count + 1;

         if Table (Index).Phase /= Closed then

            if not Table (Index).Socket_Taken  then

               if Table (Index).Phase /= Aborted then
                  begin
                     --  This must never fail, it is possible that Shutdown
                     --  raise Socket_Error if the slot has been aborted by
                     --  the browser for example.
                     Net.Shutdown (Table (Index).Sock.all);
                  exception
                     when Net.Socket_Error =>
                        null;
                  end;
               end if;

               Net.Free (Table (Index).Sock.all);
            else

               Table (Index).Socket_Taken := False;
            end if;

            Mark_Phase (Index, Closed);
            Table (Index).Sock := null;
         end if;
      end Release;

      ---------
      -- Set --
      ---------

      procedure Set
        (Socket     : in     Socket_Access;
         Index      : in     Positive;
         Free_Slots :    out Natural) is
      begin
         pragma Assert (Count > 0);

         Table (Index).Sock := Socket;
         Mark_Phase (Index, Wait_For_Client);
         Table (Index).Alive_Counter := 0;
         Table (Index).Alive_Time_Stamp := Ada.Calendar.Clock;
         Table (Index).Activity_Counter := Table (Index).Activity_Counter + 1;
         Count := Count - 1;
         Free_Slots := Count;
      end Set;

      ------------------
      -- Set_Timeouts --
      ------------------

      procedure Set_Timeouts
        (Phase_Timeouts : in Timeouts_Array;
         Data_Timeouts  : in Data_Timeouts_Array) is
      begin
         Timeouts := Phase_Timeouts;
         Slots.Data_Timeouts := Set_Timeouts.Data_Timeouts;
      end Set_Timeouts;

      --------------
      -- Shutdown --
      --------------

      procedure Shutdown (Index : in Positive) is
      begin
         if Table (Index).Phase not in Closed .. Aborted then
            Mark_Phase (Index, Aborted);
            Net.Shutdown (Table (Index).Sock.all);
         end if;
      end Shutdown;

      ------------------
      -- Socket_Taken --
      ------------------

      procedure Socket_Taken (Index : in Positive) is
      begin
         Table (Index).Socket_Taken := True;
      end Socket_Taken;

   end Slots;

   ----------------------
   -- Socket_Semaphore --
   ----------------------

   protected body Socket_Semaphore is

      ----------------
      -- Put_Socket --
      ----------------

      entry Put_Socket (Socket : in Net.Socket_Access)
        when Size /= Max_Sockets is
      begin
         Size := Size + 1;

         if Last > Max_Sockets then
            Last := Sockets'First;
         end if;

         Sockets (Last) := Socket;

         Last := Last + 1;
      end Put_Socket;

      -------------
      -- Release --
      -------------

      procedure Release is
      begin
         Seized := False;
      end Release;

      ---------------------
      -- Seize_Or_Socket --
      ---------------------

      entry Seize_Or_Socket (Socket : out Net.Socket_Access)
        when not Seized or else Size /= 0 is
      begin
         if not Seized then
            Seized := True;

         else
            Size := Size - 1;

            if Current > Max_Sockets then
               Current := Sockets'First;
            end if;

            Socket := Sockets (Current);

            Current := Current + 1;
         end if;
      end Seize_Or_Socket;

   end Socket_Semaphore;

   -----------
   -- Start --
   -----------

   procedure Start
     (Web_Server                : in out HTTP;
      Name                      : in     String;
      Callback                  : in     Response.Callback;
      Max_Connection            : in     Positive  := Default.Max_Connection;
      Admin_URI                 : in     String    := Default.Admin_URI;
      Port                      : in     Positive  := Default.Server_Port;
      Security                  : in     Boolean   := False;
      Session                   : in     Boolean   := False;
      Case_Sensitive_Parameters : in     Boolean   := True;
      Upload_Directory          : in     String    := Default.Upload_Directory;
      Line_Stack_Size           : in     Positive  := Default.Line_Stack_Size)
   is
   begin
      CNF.Set.Server_Name      (Web_Server.Properties, Name);
      CNF.Set.Admin_URI        (Web_Server.Properties, Admin_URI);
      CNF.Set.Server_Port      (Web_Server.Properties, Port);
      CNF.Set.Security         (Web_Server.Properties, Security);
      CNF.Set.Session          (Web_Server.Properties, Session);
      CNF.Set.Upload_Directory (Web_Server.Properties, Upload_Directory);
      CNF.Set.Max_Connection   (Web_Server.Properties, Max_Connection);
      CNF.Set.Line_Stack_Size  (Web_Server.Properties, Line_Stack_Size);

      CNF.Set.Case_Sensitive_Parameters
        (Web_Server.Properties, Case_Sensitive_Parameters);

      Start (Web_Server, Dispatchers.Callback.Create (Callback));
   end Start;

   -----------
   -- Start --
   -----------

   procedure Start
     (Web_Server : in out HTTP;
      Callback   : in     Response.Callback;
      Config     : in     AWS.Config.Object) is
   begin
      Web_Server.Properties := Config;
      Start (Web_Server, Dispatchers.Callback.Create (Callback));
   end Start;

   -----------
   -- Start --
   -----------

   procedure Start
     (Web_Server : in out HTTP;
      Dispatcher : in     Dispatchers.Handler'Class;
      Config     : in     AWS.Config.Object) is
   begin
      Web_Server.Properties := Config;
      Start (Web_Server, Dispatcher);
   end Start;

   -----------
   -- Start --
   -----------

   procedure Start
     (Web_Server : in out HTTP;
      Dispatcher : in     Dispatchers.Handler'Class)
   is
      Max_Connection : constant Positive
        := CNF.Max_Connection (Web_Server.Properties);

   begin
      --  If it is an SSL connection, initialize the SSL library

      if not Security_Initialized
        and then CNF.Security (Web_Server.Properties)
      then
         Security_Initialized := True;
         Net.SSL.Initialize (CNF.Certificate);
      end if;

      Net.Std.Bind
        (Web_Server.Sock,
         CNF.Server_Port (Web_Server.Properties),
         CNF.Server_Host (Web_Server.Properties));

      Net.Std.Listen
        (Web_Server.Sock,
         Queue_Size => CNF.Accept_Queue_Size (Web_Server.Properties));

      Web_Server.Dispatcher := new Dispatchers.Handler'Class'(Dispatcher);

      --  Initialize slots

      Web_Server.Slots := new Slots (Max_Connection);

      --  Set timeouts

      Web_Server.Slots.Set_Timeouts
        ((Cleaner => -- Timeouts for Line_Cleaner
            (Wait_For_Client  =>
               CNF.Cleaner_Wait_For_Client_Timeout (Web_Server.Properties),
             Client_Header    =>
               CNF.Cleaner_Client_Header_Timeout (Web_Server.Properties),
             Client_Data      =>
               CNF.Cleaner_Client_Data_Timeout (Web_Server.Properties),
             Server_Response  =>
               CNF.Cleaner_Server_Response_Timeout (Web_Server.Properties)),

          Force   => -- Force timeouts used when there is no free slot
            (Wait_For_Client  =>
               CNF.Force_Wait_For_Client_Timeout (Web_Server.Properties),
             Client_Header    =>
               CNF.Force_Client_Header_Timeout (Web_Server.Properties),
             Client_Data      =>
               CNF.Force_Client_Data_Timeout (Web_Server.Properties),
             Server_Response  =>
               CNF.Cleaner_Server_Response_Timeout (Web_Server.Properties))),

         (Client_Data     =>
            CNF.Receive_Timeout (Web_Server.Properties),
          Server_Response =>
            CNF.Send_Timeout (Web_Server.Properties)));

      --  Started time

      Web_Server.Start_Time := Calendar.Clock;

      --  Initialize the connection lines

      Web_Server.Lines := new Line_Set'
        (1 .. Max_Connection
         => new Line (CNF.Line_Stack_Size (Web_Server.Properties)));

      --  Initialize the cleaner task

      Web_Server.Cleaner := new Line_Cleaner (Web_Server.Self);

      --  Set Shutdown to False here since it must be done before starting the
      --  lines.

      Web_Server.Shutdown := False;

      --  Start each connection lines.

      for I in 1 .. Max_Connection loop
         Web_Server.Lines (I).Start (Web_Server, I);
      end loop;

      --  Initialize session server.

      if AWS.Config.Session (Web_Server.Properties) then
         AWS.Session.Control.Start
           (Session_Check_Interval => CNF.Session_Cleanup_Interval,
            Session_Lifetime       => CNF.Session_Lifetime);
      end if;

      Counter.Add;
   end Start;

   ---------------------
   -- Start_Error_Log --
   ---------------------

   procedure Start_Error_Log
     (Web_Server        : in out HTTP;
      Split_Mode        : in     AWS.Log.Split_Mode := AWS.Log.None;
      Filename_Prefix   : in     String             := "")
      renames AWS.Server.Log.Start_Error;

   ---------------
   -- Start_Log --
   ---------------

   procedure Start_Log
     (Web_Server      : in out HTTP;
      Split_Mode      : in     AWS.Log.Split_Mode := AWS.Log.None;
      Filename_Prefix : in     String             := "";
      Auto_Flush      : in     Boolean            := False)
      renames AWS.Server.Log.Start;

   --------------------
   -- Stop_Error_Log --
   --------------------

   procedure Stop_Error_Log (Web_Server : in out HTTP)
     renames AWS.Server.Log.Stop_Error;

   --------------
   -- Stop_Log --
   --------------

   procedure Stop_Log (Web_Server : in out HTTP)
     renames AWS.Server.Log.Stop;

   ----------
   -- Wait --
   ----------

   procedure Wait (Mode : in Termination := No_Server) is
   begin
      case Mode is
         when No_Server =>
            Counter.Zero;

         when Q_Key_Pressed =>
            declare
               K : Character;
            begin
               loop
                  Text_IO.Get_Immediate (K);
                  exit when K = 'q' or else K = 'Q';
               end loop;
            end;

         when Forever =>
            loop
               delay Duration'Last;
            end loop;
      end case;
   end Wait;

end AWS.Server;