------------------------------------------------------------------------------
--                                                                          --
--                           POLYORB COMPONENTS                             --
--                                                                          --
--                A W S . S E R V E R . G E T _ S T A T U S                 --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--         Copyright (C) 2000-2012, Free Software Foundation, Inc.          --
--                                                                          --
-- This is free software;  you can redistribute it  and/or modify it  under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
-- sion.  This software is distributed in the hope  that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
-- License for  more details.                                               --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
--                  PolyORB is maintained by AdaCore                        --
--                     (email: sales@adacore.com)                           --
--                                                                          --
------------------------------------------------------------------------------

with GNAT.Calendar.Time_IO;

with AWS.Hotplug.Get_Status;
with AWS.Session;
with AWS.Templates;
with AWS.Utils;

function AWS.Server.Get_Status (Server : HTTP) return String is

   use Ada;
   use AWS.Templates;

--   function Slot_Table return Translate_Table;
   --  returns the information for each slot

   function Session_Table return Translate_Table;
   --  returns session information

   -------------------
   -- Session_Table --
   -------------------

   function Session_Table return Translate_Table is

      Sessions           : Vector_Tag;
      Sessions_TS        : Vector_Tag;
      Sessions_Terminate : Vector_Tag;
      Keys               : Vector_Tag;
      Values             : Vector_Tag;
      M_Keys             : Matrix_Tag;
      M_Values           : Matrix_Tag;

      procedure For_Each_Key_Value
        (N          : Positive;
         Key, Value : String;
         Quit       : in out Boolean);
      --  add key/value pair to the list

      procedure For_Each_Session
        (N          : Positive;
         SID        : Session.ID;
         Time_Stamp : Calendar.Time;
         Quit       : in out Boolean);
      --  add session SID to the list

      ------------------------
      -- For_Each_Key_Value --
      ------------------------

      procedure For_Each_Key_Value
        (N          : Positive;
         Key, Value : String;
         Quit       : in out Boolean)
      is
         pragma Warnings (Off, N);
         pragma Warnings (Off, Quit);
      begin
         Keys   := Keys & Key;
         Values := Values & Value;
      end For_Each_Key_Value;

      --------------------------
      -- Build_Key_Value_List --
      --------------------------

      procedure Build_Key_Value_List is
         new Session.For_Every_Session_Data (For_Each_Key_Value);

      ----------------------
      -- For_Each_Session --
      ----------------------

      procedure For_Each_Session
        (N          : Positive;
         SID        : Session.ID;
         Time_Stamp : Calendar.Time;
         Quit       : in out Boolean)
      is
         pragma Warnings (Off, N);
         pragma Warnings (Off, Quit);
         use type Calendar.Time;
      begin
         Sessions    := Sessions & Session.Image (SID);

         Sessions_TS := Sessions_TS
           & GNAT.Calendar.Time_IO.Image (Time_Stamp, "%a %D %T");

         Sessions_Terminate := Sessions_Terminate
           & GNAT.Calendar.Time_IO.Image
           (Time_Stamp + Session.Get_Lifetime, "%a %D %T");

         Build_Key_Value_List (SID);

         M_Keys   := M_Keys & Keys;
         M_Values := M_Values & Values;

         Clear (Keys);
         Clear (Values);
      end For_Each_Session;

      ------------------------
      -- Build_Session_List --
      ------------------------

      procedure Build_Session_List is
         new Session.For_Every_Session (For_Each_Session);

   begin
      Build_Session_List;

      return Translate_Table'
        (Assoc ("SESSIONS_V",           Sessions),
         Assoc ("SESSIONS_TS_V",        Sessions_TS),
         Assoc ("SESSIONS_TERMINATE_V", Sessions_Terminate),
         Assoc ("KEYS_M",               M_Keys),
         Assoc ("VALUES_M",             M_Values));
   end Session_Table;

   ----------------
   -- Slot_Table --
   ----------------

--     function Slot_Table return Translate_Table is

--        Sock                  : Vector_Tag;
--        Phase                 : Vector_Tag;
--        Abortable             : Vector_Tag;
--        Activity_Counter      : Vector_Tag;
--        Slot_Activity_Counter : Vector_Tag;
--        Activity_Time_Stamp   : Vector_Tag;
--        Peer_Name             : Vector_Tag;

--        --  Avoid : may be referenced before it has a value
--        pragma Warnings (Off, Sock);
--        pragma Warnings (Off, Phase);
--        pragma Warnings (Off, Abortable);
--        pragma Warnings (Off, Activity_Counter);
--        pragma Warnings (Off, Slot_Activity_Counter);
--        pragma Warnings (Off, Activity_Time_Stamp);
--        pragma Warnings (Off, Peer_Name);

--        Slot_Data             : Slot;

--     begin
--        for K in 1 .. CNF.Max_Connection (Server.Properties) loop
--           Slot_Data := Server.Slots.Get (Index => K);

--           declare
--              SD : constant Socket_Data
--                := Server.Slots.Get_Socket_Info (Index => K);
--           begin
--              Sock      := Sock      & SD.FD;
--              Peer_Name := Peer_Name & SD.Peername;
--           end;

--           Phase     := Phase & Slot_Phase'Image (Slot_Data.Phase);

--           Abortable := Abortable
--             & Server.Slots.Is_Abortable (Index => K, Mode => Force);

--           Activity_Counter := Activity_Counter & Slot_Data.Activity_Counter;

--           Slot_Activity_Counter := Slot_Activity_Counter
--             & Slot_Data.Slot_Activity_Counter;

--           Activity_Time_Stamp := Activity_Time_Stamp &
--             GNAT.Calendar.Time_IO.Image (Slot_Data.Phase_Time_Stamp,
--                                          "%a %D %T");
--        end loop;

--        return Translate_Table'
--          (Assoc ("SOCK_V",                  Sock),
--           Assoc ("PEER_NAME_V",             Peer_Name),
--           Assoc ("PHASE_V",                 Phase),
--           Assoc ("ABORTABLE_V",             Abortable),
--           Assoc ("SLOT_ACTIVITY_COUNTER_V", Slot_Activity_Counter),
--           Assoc ("ACTIVITY_COUNTER_V",      Activity_Counter),
--           Assoc ("ACTIVITY_TIME_STAMP_V",   Activity_Time_Stamp));
--     end Slot_Table;

   Admin_URI : constant String := CNF.Admin_URI (Server.Properties);

   Translations : constant Templates.Translate_Table
     := (Assoc ("SERVER_NAME",
                CNF.Server_Name (Server.Properties)),

         Assoc ("START_TIME",
                GNAT.Calendar.Time_IO.Image
                (Server.Start_Time, "%A %-d %B %Y, %T")),

         Assoc ("MAX_CONNECTION",
                CNF.Max_Connection (Server.Properties)),

         Assoc ("SERVER_PORT",
                CNF.Server_Port (Server.Properties)),

         Assoc ("SECURITY",
                CNF.Security (Server.Properties)),

--         Assoc ("SERVER_SOCK",
--                Integer (Net.Std.Get_FD (Server.Sock))),

         Assoc ("VERSION",
                Version),

         Assoc ("SESSION",
                CNF.Session (Server.Properties)),

         Assoc ("SESSION_LIFETIME",
                Utils.Image (Session.Get_Lifetime)),

         Assoc ("SESSION_CLEANUP_INTERVAL",
                Utils.Image (CNF.Session_Cleanup_Interval)),

         Assoc ("CLEANER_WAIT_FOR_CLIENT_TIMEOUT",
                Utils.Image
                  (CNF.Cleaner_Wait_For_Client_Timeout (Server.Properties))),

         Assoc ("CLEANER_CLIENT_HEADER_TIMEOUT",
                Utils.Image
                  (CNF.Cleaner_Client_Header_Timeout (Server.Properties))),

         Assoc ("CLEANER_CLIENT_DATA_TIMEOUT",
                Utils.Image
                  (CNF.Cleaner_Client_Data_Timeout (Server.Properties))),

         Assoc ("CLEANER_SERVER_RESPONSE_TIMEOUT",
                Utils.Image
                  (CNF.Cleaner_Server_Response_Timeout (Server.Properties))),

         Assoc ("FORCE_WAIT_FOR_CLIENT_TIMEOUT",
                Utils.Image
                  (CNF.Force_Wait_For_Client_Timeout (Server.Properties))),

         Assoc ("FORCE_CLIENT_HEADER_TIMEOUT",
                Utils.Image
                  (CNF.Force_Client_Header_Timeout (Server.Properties))),

         Assoc ("FORCE_CLIENT_DATA_TIMEOUT",
                Utils.Image
                  (CNF.Force_Client_Data_Timeout (Server.Properties))),

         Assoc ("FORCE_SERVER_RESPONSE_TIMEOUT",
                Utils.Image
                  (CNF.Force_Server_Response_Timeout (Server.Properties))),

         Assoc ("SEND_TIMEOUT",
                Utils.Image (CNF.Send_Timeout (Server.Properties))),

         Assoc ("RECEIVE_TIMEOUT",
                Utils.Image (CNF.Receive_Timeout (Server.Properties))),

         Assoc ("ACCEPT_QUEUE_SIZE",
                Utils.Image (CNF.Accept_Queue_Size (Server.Properties))),

         Assoc ("STATUS_PAGE",
                CNF.Status_Page (Server.Properties)),

         Assoc ("LOGO",
                Admin_URI & "-logo"),

         Assoc ("LOG",
                Log.Is_Active (Server.Log)),

         Assoc ("LOG_FILE",
                Log.Filename (Server.Log)),

         Assoc ("LOG_MODE",
                Log.Split_Mode'Image (Log.Mode (Server.Log))),

         Assoc ("ADMIN",
                Admin_URI),

         Assoc ("UPLOAD_DIRECTORY",
                CNF.Upload_Directory (Server.Properties)))
--   & Slot_Table
   & Session_Table
   & Hotplug.Get_Status (Server.Filters);

begin
   return Templates.Parse
     (CNF.Status_Page (Server.Properties), Translations);
end AWS.Server.Get_Status;
