------------------------------------------------------------------------------ -- Ada Web Server -- -- -- -- Copyright (C) 2000-2020, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 3, 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. -- -- -- -- 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 -- -- . -- -- -- -- 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. -- ------------------------------------------------------------------------------ with Ada.Characters.Handling; with Ada.Environment_Variables; with AWS.Config.Ini; with AWS.OS_Lib; with AWS.Utils; package body AWS.Config is use Ada; Server_Config : Object; -- This variable will be updated with options found in 'aws.ini' and -- '.ini'. Ini_Loaded : Boolean := False; -- Set to True when initialization (.ini) files have been loaded procedure Read_Or_Ignore (Filename : String); -- Read and parse Filename, does not raise an exception if the file does -- not exists or can't be read. ----------------------- -- Accept_Queue_Size -- ----------------------- function Accept_Queue_Size (O : Object) return Positive is begin return O.P (Accept_Queue_Size).Pos_Value; end Accept_Queue_Size; -------------------- -- Admin_Password -- -------------------- function Admin_Password (O : Object) return String is begin return To_String (O.P (Admin_Password).Str_Value); end Admin_Password; ----------------- -- Admin_Realm -- ----------------- function Admin_Realm (O : Object) return String is begin return To_String (O.P (Admin_Realm).Str_Value); end Admin_Realm; --------------- -- Admin_URI -- --------------- function Admin_URI (O : Object) return String is begin return To_String (O.P (Admin_URI).Str_Value); end Admin_URI; ------------------------------- -- Case_Sensitive_Parameters -- ------------------------------- function Case_Sensitive_Parameters (O : Object) return Boolean is begin return O.P (Case_Sensitive_Parameters).Bool_Value; end Case_Sensitive_Parameters; ----------------- -- Certificate -- ----------------- function Certificate (O : Object) return String is begin return To_String (O.P (Certificate).Str_Value); end Certificate; -------------------------- -- Certificate_Required -- -------------------------- function Certificate_Required (O : Object) return Boolean is begin return O.P (Certificate_Required).Bool_Value; end Certificate_Required; ------------------------ -- Check_URL_Validity -- ------------------------ function Check_URL_Validity (O : Object) return Boolean is begin return O.P (Check_URL_Validity).Bool_Value; end Check_URL_Validity; ----------------------- -- Cipher_Priorities -- ----------------------- function Cipher_Priorities (O : Object) return String is begin return To_String (O.P (Cipher_Priorities).Str_Value); end Cipher_Priorities; --------------------------------- -- Cleaner_Client_Data_Timeout -- --------------------------------- function Cleaner_Client_Data_Timeout (O : Object) return Duration is begin return O.P (Cleaner_Client_Data_Timeout).Dur_Value; end Cleaner_Client_Data_Timeout; ----------------------------------- -- Cleaner_Client_Header_Timeout -- ----------------------------------- function Cleaner_Client_Header_Timeout (O : Object) return Duration is begin return O.P (Cleaner_Client_Header_Timeout).Dur_Value; end Cleaner_Client_Header_Timeout; ------------------------------------- -- Cleaner_Server_Response_Timeout -- ------------------------------------- function Cleaner_Server_Response_Timeout (O : Object) return Duration is begin return O.P (Cleaner_Server_Response_Timeout).Dur_Value; end Cleaner_Server_Response_Timeout; ------------------------------------- -- Cleaner_Wait_For_Client_Timeout -- ------------------------------------- function Cleaner_Wait_For_Client_Timeout (O : Object) return Duration is begin return O.P (Cleaner_Wait_For_Client_Timeout).Dur_Value; end Cleaner_Wait_For_Client_Timeout; ---------------------- -- Config_Directory -- ---------------------- function Config_Directory return String is use Ada.Characters.Handling; function Home_Path return String; --------------- -- Home_Path -- --------------- function Home_Path return String is use Ada.Environment_Variables; Home : constant String := "HOME"; -- Unix User : constant String := "USERPROFILE"; -- Windows begin if Exists (Home) then return Value (Home); elsif Exists (User) then return Value (User); else return "~"; end if; end Home_Path; Result : constant String := To_String (Process_Options (Config_Directory).Str_Value); begin if Result'Length = 0 or else Result (Result'First) in '/' | '\' or else (Result'Length > 2 and then To_Lower (Result (Result'First)) in 'a' .. 'z' and then Result (Result'First + 1) = ':') then return Result; end if; return Home_Path & OS_Lib.Directory_Separator & Result; end Config_Directory; ---------------------- -- Context_Lifetime -- ---------------------- function Context_Lifetime return Duration is begin return Process_Options (Context_Lifetime).Dur_Value; end Context_Lifetime; -------------- -- CRL_File -- -------------- function CRL_File (O : Object) return String is begin return To_String (O.P (CRL_File).Str_Value); end CRL_File; ---------------------------- -- Directory_Browser_Page -- ---------------------------- function Directory_Browser_Page (O : Object) return String is begin return To_String (O.P (Directory_Browser_Page).Str_Value); end Directory_Browser_Page; ------------------------- -- Disable_Program_Ini -- ------------------------- function Disable_Program_Ini return Boolean is begin return Process_Options (Disable_Program_Ini).Bool_Value; end Disable_Program_Ini; ---------------- -- Down_Image -- ---------------- function Down_Image (O : Object) return String is begin return To_String (O.P (Down_Image).Str_Value); end Down_Image; ------------------------- -- Error_Log_Activated -- ------------------------- function Error_Log_Activated (O : Object) return Boolean is begin return O.P (Error_Log_Activated).Bool_Value; end Error_Log_Activated; ------------------------------- -- Error_Log_Filename_Prefix -- ------------------------------- function Error_Log_Filename_Prefix (O : Object) return String is begin return To_String (O.P (Error_Log_Filename_Prefix).Str_Value); end Error_Log_Filename_Prefix; -------------------------- -- Error_Log_Split_Mode -- -------------------------- function Error_Log_Split_Mode (O : Object) return String is begin return To_String (O.P (Error_Log_Split_Mode).Str_Value); end Error_Log_Split_Mode; -------------------------- -- Exchange_Certificate -- -------------------------- function Exchange_Certificate (O : Object) return Boolean is begin return O.P (Exchange_Certificate).Bool_Value; end Exchange_Certificate; ------------------------------- -- Force_Client_Data_Timeout -- ------------------------------- function Force_Client_Data_Timeout (O : Object) return Duration is begin return O.P (Force_Client_Data_Timeout).Dur_Value; end Force_Client_Data_Timeout; --------------------------------- -- Force_Client_Header_Timeout -- --------------------------------- function Force_Client_Header_Timeout (O : Object) return Duration is begin return O.P (Force_Client_Header_Timeout).Dur_Value; end Force_Client_Header_Timeout; ----------------------------------- -- Force_Server_Response_Timeout -- ----------------------------------- function Force_Server_Response_Timeout (O : Object) return Duration is begin return O.P (Force_Server_Response_Timeout).Dur_Value; end Force_Server_Response_Timeout; ----------------------------------- -- Force_Wait_For_Client_Timeout -- ----------------------------------- function Force_Wait_For_Client_Timeout (O : Object) return Duration is begin return O.P (Force_Wait_For_Client_Timeout).Dur_Value; end Force_Wait_For_Client_Timeout; --------------------------------- -- Free_Slots_Keep_Alive_Limit -- --------------------------------- function Free_Slots_Keep_Alive_Limit (O : Object) return Natural is begin return O.P (Free_Slots_Keep_Alive_Limit).Nat_Value; end Free_Slots_Keep_Alive_Limit; ----------------- -- Get_Current -- ----------------- function Get_Current return Object is begin if not Ini_Loaded then Ini_Loaded := True; Load_Config; end if; return Server_Config; end Get_Current; ------------------ -- Hotplug_Port -- ------------------ function Hotplug_Port (O : Object) return Positive is begin return O.P (Hotplug_Port).Pos_Value; end Hotplug_Port; --------------------------- -- Input_Line_Size_Limit -- --------------------------- function Input_Line_Size_Limit return Positive is begin return Process_Options (Input_Line_Size_Limit).Pos_Value; end Input_Line_Size_Limit; --------------- -- IPv6_Only -- --------------- function IPv6_Only (O : Object) return Boolean is begin return O.P (IPv6_Only).Bool_Value; end IPv6_Only; ----------------------------- -- Is_WebSocket_Origin_Set -- ----------------------------- function Is_WebSocket_Origin_Set return Boolean is begin return Process_Options (Parameter_Name'(WebSocket_Origin)).Is_Set; end Is_WebSocket_Origin_Set; ---------------------------- -- Keep_Alive_Close_Limit -- ---------------------------- function Keep_Alive_Close_Limit (O : Object) return Positive is begin if O.P (Keep_Alive_Close_Limit).Nat_Value = 0 then return Max_Connection (O) * 4; else return O.P (Keep_Alive_Close_Limit).Nat_Value; end if; end Keep_Alive_Close_Limit; ---------------------------- -- Keep_Alive_Force_Limit -- ---------------------------- function Keep_Alive_Force_Limit (O : Object) return Positive is begin if O.P (Keep_Alive_Force_Limit).Nat_Value = 0 then return Max_Connection (O) * 2; else return O.P (Keep_Alive_Force_Limit).Nat_Value; end if; end Keep_Alive_Force_Limit; --------- -- Key -- --------- function Key (O : Object) return String is begin return To_String (O.P (Key).Str_Value); end Key; --------------------- -- Line_Stack_Size -- --------------------- function Line_Stack_Size (O : Object) return Positive is begin return O.P (Line_Stack_Size).Pos_Value; end Line_Stack_Size; ----------------- -- Load_Config -- ----------------- procedure Load_Config is begin Read_Or_Ignore (Config_Directory & OS_Lib.Directory_Separator & "aws.ini"); Read_Or_Ignore ("aws.ini"); if not Disable_Program_Ini then Read_Or_Ignore (Ini.Program_Ini_File (Full_Path => True)); Read_Or_Ignore (Ini.Program_Ini_File (Full_Path => False)); end if; end Load_Config; ------------------- -- Log_Activated -- ------------------- function Log_Activated (O : Object) return Boolean is begin return O.P (Log_Activated).Bool_Value; end Log_Activated; ----------------------------------------- -- Log_Extended_Fields_Generic_Iterate -- ----------------------------------------- procedure Log_Extended_Fields_Generic_Iterate (O : Object) is begin for J in 1 .. Log_Extended_Fields_Length (O) loop Field_Id (SV.Element (O.P (Log_Extended_Fields).Strs_Value, J)); end loop; end Log_Extended_Fields_Generic_Iterate; -------------------------------- -- Log_Extended_Fields_Length -- -------------------------------- function Log_Extended_Fields_Length (O : Object) return Natural is begin return Natural (SV.Length (O.P (Log_Extended_Fields).Strs_Value)); end Log_Extended_Fields_Length; ------------------------ -- Log_File_Directory -- ------------------------ function Log_File_Directory (O : Object) return String is begin return To_String (O.P (Log_File_Directory).Dir_Value); end Log_File_Directory; ------------------------- -- Log_Filename_Prefix -- ------------------------- function Log_Filename_Prefix (O : Object) return String is begin return To_String (O.P (Log_Filename_Prefix).Str_Value); end Log_Filename_Prefix; -------------------- -- Log_Size_Limit -- -------------------- function Log_Size_Limit (O : Object) return Natural is begin return O.P (Log_Size_Limit).Nat_Value; end Log_Size_Limit; -------------------- -- Log_Split_Mode -- -------------------- function Log_Split_Mode (O : Object) return String is begin return To_String (O.P (Log_Split_Mode).Str_Value); end Log_Split_Mode; ---------------- -- Logo_Image -- ---------------- function Logo_Image (O : Object) return String is begin return To_String (O.P (Logo_Image).Str_Value); end Logo_Image; ----------------------------- -- Max_Concurrent_Download -- ----------------------------- function Max_Concurrent_Download return Positive is begin return Process_Options (Max_Concurrent_Download).Pos_Value; end Max_Concurrent_Download; -------------------- -- Max_Connection -- -------------------- function Max_Connection (O : Object) return Positive is begin return O.P (Max_Connection).Pos_Value; end Max_Connection; ------------------------- -- Max_POST_Parameters -- ------------------------- function Max_POST_Parameters (O : Object) return Positive is begin return O.P (Max_POST_Parameters).Pos_Value; end Max_POST_Parameters; ------------------- -- Max_WebSocket -- ------------------- function Max_WebSocket return Positive is begin return Process_Options (Max_WebSocket).Pos_Value; end Max_WebSocket; --------------------------- -- Max_WebSocket_Handler -- --------------------------- function Max_WebSocket_Handler return Positive is begin return Process_Options (Max_WebSocket_Handler).Pos_Value; end Max_WebSocket_Handler; ---------------- -- MIME_Types -- ---------------- function MIME_Types return String is begin return To_String (Process_Options (MIME_Types).Str_Value); end MIME_Types; --------------------- -- Protocol_Family -- --------------------- function Protocol_Family (O : Object) return String is begin return To_String (O.P (Protocol_Family).Str_Value); end Protocol_Family; -------------------- -- Read_Or_Ignore -- -------------------- procedure Read_Or_Ignore (Filename : String) is begin if Utils.Is_Regular_File (Filename) then Ini.Read (Server_Config, Filename); end if; exception when others => null; end Read_Or_Ignore; --------------------- -- Receive_Timeout -- --------------------- function Receive_Timeout (O : Object) return Duration is begin return O.P (Receive_Timeout).Dur_Value; end Receive_Timeout; ------------------- -- Reuse_Address -- ------------------- function Reuse_Address (O : Object) return Boolean is begin return O.P (Reuse_Address).Bool_Value; end Reuse_Address; -------------- -- Security -- -------------- function Security (O : Object) return Boolean is begin return O.P (Security).Bool_Value; end Security; ------------------- -- Security_Mode -- ------------------- function Security_Mode (O : Object) return String is begin return To_String (O.P (Security_Mode).Str_Value); end Security_Mode; ---------------------- -- Send_Buffer_Size -- ---------------------- function Send_Buffer_Size (O : Object) return Natural is begin return O.P (Send_Buffer_Size).Nat_Value; end Send_Buffer_Size; ------------------ -- Send_Timeout -- ------------------ function Send_Timeout (O : Object) return Duration is begin return O.P (Send_Timeout).Dur_Value; end Send_Timeout; ------------------- -- Server_Header -- ------------------- function Server_Header (O : Object) return String is begin return To_String (O.P (Server_Header).Str_Value); end Server_Header; ----------------- -- Server_Host -- ----------------- function Server_Host (O : Object) return String is begin return To_String (O.P (Server_Host).Str_Value); end Server_Host; ----------------- -- Server_Name -- ----------------- function Server_Name (O : Object) return String is begin return To_String (O.P (Server_Name).Str_Value); end Server_Name; ----------------- -- Server_Port -- ----------------- function Server_Port (O : Object) return Natural is begin return O.P (Server_Port).Nat_Value; end Server_Port; --------------------- -- Server_Priority -- --------------------- function Server_Priority (O : Object) return System.Any_Priority is begin return O.P (Server_Priority).Nat_Value; end Server_Priority; ---------------------- -- Service_Priority -- ---------------------- function Service_Priority return System.Any_Priority is begin return Process_Options (Service_Priority).Nat_Value; end Service_Priority; ------------- -- Session -- ------------- function Session (O : Object) return Boolean is begin return O.P (Session).Bool_Value; end Session; ------------------------------ -- Session_Cleaner_Priority -- ------------------------------ function Session_Cleaner_Priority return System.Any_Priority is begin return Process_Options (Session_Cleaner_Priority).Nat_Value; end Session_Cleaner_Priority; ------------------------------ -- Session_Cleanup_Interval -- ------------------------------ function Session_Cleanup_Interval return Duration is begin return Process_Options (Session_Cleanup_Interval).Dur_Value; end Session_Cleanup_Interval; ----------------------- -- Session_Id_Length -- ----------------------- function Session_Id_Length return Positive is begin return Process_Options (Session_Id_Length).Pos_Value; end Session_Id_Length; ---------------------- -- Session_Lifetime -- ---------------------- function Session_Lifetime return Duration is begin return Process_Options (Session_Lifetime).Dur_Value; end Session_Lifetime; ------------------ -- Session_Name -- ------------------ function Session_Name (O : Object) return String is begin return To_String (O.P (Session_Name).Str_Value); end Session_Name; -------------------------- -- Session_Private_Name -- -------------------------- function Session_Private_Name (O : Object) return String is begin return To_String (O.P (Session_Private_Name).Str_Value); end Session_Private_Name; ---------------------------- -- SSL_Session_Cache_Size -- ---------------------------- function SSL_Session_Cache_Size (O : Object) return Natural is begin return O.P (SSL_Session_Cache_Size).Nat_Value; end SSL_Session_Cache_Size; ----------------- -- Status_Page -- ----------------- function Status_Page (O : Object) return String is begin return To_String (O.P (Status_Page).Str_Value); end Status_Page; ------------------ -- TCP_No_Delay -- ------------------ function TCP_No_Delay (O : Object) return Boolean is begin return O.P (TCP_No_Delay).Bool_Value; end TCP_No_Delay; ------------------------ -- TLS_Ticket_Support -- ------------------------ function TLS_Ticket_Support (O : Object) return Boolean is begin return O.P (TLS_Ticket_Support).Bool_Value; end TLS_Ticket_Support; -------------------------------- -- Transient_Cleanup_Interval -- -------------------------------- function Transient_Cleanup_Interval return Duration is begin return Process_Options (Transient_Cleanup_Interval).Dur_Value; end Transient_Cleanup_Interval; ------------------------ -- Transient_Lifetime -- ------------------------ function Transient_Lifetime return Duration is begin return Process_Options (Transient_Lifetime).Dur_Value; end Transient_Lifetime; ---------------- -- Trusted_CA -- ---------------- function Trusted_CA (O : Object) return String is begin return To_String (O.P (Trusted_CA).Str_Value); end Trusted_CA; -------------- -- Up_Image -- -------------- function Up_Image (O : Object) return String is begin return To_String (O.P (Up_Image).Str_Value); end Up_Image; ---------------------- -- Upload_Directory -- ---------------------- function Upload_Directory (O : Object) return String is begin return To_String (O.P (Upload_Directory).Dir_Value); end Upload_Directory; ----------------------- -- Upload_Size_Limit -- ----------------------- function Upload_Size_Limit (O : Object) return Positive is begin return O.P (Upload_Size_Limit).Pos_Value; end Upload_Size_Limit; ---------------- -- User_Agent -- ---------------- function User_Agent return String is begin return To_String (Process_Options (User_Agent).Str_Value); end User_Agent; ---------------------------------- -- WebSocket_Message_Queue_Size -- ---------------------------------- function WebSocket_Message_Queue_Size return Positive is begin return Process_Options (WebSocket_Message_Queue_Size).Pos_Value; end WebSocket_Message_Queue_Size; ---------------------- -- WebSocket_Origin -- ---------------------- function WebSocket_Origin return GNAT.Regexp.Regexp is begin return Process_Options (WebSocket_Origin).Pattern; end WebSocket_Origin; ---------------------- -- WebSocket_Origin -- ---------------------- function WebSocket_Origin return String is begin return To_String (Process_Options (WebSocket_Origin).Regexp_Str); end WebSocket_Origin; ------------------------ -- WebSocket_Priority -- ------------------------ function WebSocket_Priority return System.Any_Priority is begin return Process_Options (WebSocket_Priority).Nat_Value; end WebSocket_Priority; --------------------------------------- -- WebSocket_Send_Message_Queue_Size -- --------------------------------------- function WebSocket_Send_Message_Queue_Size return Positive is begin return Process_Options (WebSocket_Send_Message_Queue_Size).Pos_Value; end WebSocket_Send_Message_Queue_Size; ----------------------- -- WebSocket_Timeout -- ----------------------- function WebSocket_Timeout return Duration is begin return Process_Options (WebSocket_Timeout).Dur_Value; end WebSocket_Timeout; -------------- -- WWW_Root -- -------------- function WWW_Root (O : Object) return String is begin return To_String (O.P (WWW_Root).Dir_Value); end WWW_Root; end AWS.Config;