File : src/aws-server-status.adb
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 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-status.adb,v 1.2 2003/09/06 16:37:04 obry Exp $
with GNAT.Calendar.Time_IO;
with AWS.Config;
with AWS.Hotplug.Get_Status;
with AWS.Session;
with AWS.Templates;
with AWS.Utils;
package body AWS.Server.Status is
use Ada;
-------------------------
-- Current_Connections --
-------------------------
function Current_Connections (Server : in HTTP) return Natural is
begin
return Server.Slots.N - Server.Slots.Free_Slots;
end Current_Connections;
---------------------------
-- Is_Security_Activated --
---------------------------
function Is_Security_Activated (Server : in HTTP) return Boolean is
begin
return AWS.Config.Security (Server.Properties);
end Is_Security_Activated;
--------------------------
-- Is_Session_Activated --
--------------------------
function Is_Session_Activated (Server : in HTTP) return Boolean is
begin
return AWS.Config.Session (Server.Properties);
end Is_Session_Activated;
-----------------
-- Is_Shutdown --
-----------------
function Is_Shutdown (Server : in HTTP) return Boolean is
begin
return Server.Shutdown;
end Is_Shutdown;
----------------------
-- Resources_Served --
----------------------
function Resources_Served (Server : in HTTP) return Natural is
N : Natural := 0;
begin
for K in 1 .. Server.Slots.N loop
N := N + Server.Slots.Get (K).Slot_Activity_Counter;
end loop;
return N;
end Resources_Served;
------------
-- Socket --
------------
function Socket (Server : in HTTP) return Net.Std.Socket_Type is
begin
return Server.Sock;
end Socket;
----------------
-- Start_Time --
----------------
function Start_Time (Server : in HTTP) return Ada.Calendar.Time is
begin
return Server.Start_Time;
end Start_Time;
------------------
-- Translations --
------------------
function Translations (Server : in HTTP) return Templates.Translate_Table is
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 : in Positive;
Key, Value : in String;
Quit : in out Boolean);
-- add key/value pair to the list
procedure For_Each_Session
(N : in Positive;
SID : in Session.ID;
Time_Stamp : in Calendar.Time;
Quit : in out Boolean);
-- add session SID to the list
------------------------
-- For_Each_Key_Value --
------------------------
procedure For_Each_Key_Value
(N : in Positive;
Key, Value : in 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 : in Positive;
SID : in Session.ID;
Time_Stamp : in 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;
-- Avoids : 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;
use type Templates.Translate_Table;
Admin_URI : constant String := CNF.Admin_URI (Server.Properties);
begin
return (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);
end Translations;
end AWS.Server.Status;