-- System_Log, a binding to the Unix syslog functions
-- Copyright 2009 - 2017 B. Persson, Bjorn@Rombobeorn.se
--
-- This library is free software: you can redistribute it and/or modify it
-- under the terms of the GNU General Public License version 3, as published
-- by the Free Software Foundation.


with Interfaces.C.Strings; use Interfaces.C; use Interfaces.C.Strings;

package body System_Log is


   subtype Facility_Number is int range 0 .. 23 * 8;

   Facility_Numbers : constant array(Log_Facility) of Facility_Number :=
      (Kernel   =>  0 * 8,   -- LOG_KERN
       User     =>  1 * 8,   -- LOG_USER
       Mail     =>  2 * 8,   -- LOG_MAIL
       Daemon   =>  3 * 8,   -- LOG_DAEMON
       Syslog   =>  5 * 8,   -- LOG_SYSLOG
       LPR      =>  6 * 8,   -- LOG_LPR
       News     =>  7 * 8,   -- LOG_NEWS
       UUCP     =>  8 * 8,   -- LOG_UUCP
       Cron     =>  9 * 8,   -- LOG_CRON
       Authpriv => 10 * 8,   -- LOG_AUTHPRIV
       FTP      => 11 * 8,   -- LOG_FTP
       Local0   => 16 * 8,   -- LOG_LOCAL0
       Local1   => 17 * 8,   -- LOG_LOCAL1
       Local2   => 18 * 8,   -- LOG_LOCAL2
       Local3   => 19 * 8,   -- LOG_LOCAL3
       Local4   => 20 * 8,   -- LOG_LOCAL4
       Local5   => 21 * 8,   -- LOG_LOCAL5
       Local6   => 22 * 8,   -- LOG_LOCAL6
       Local7   => 23 * 8);  -- LOG_LOCAL7

   subtype Level_Number is Natural range 0 .. 7;

   Level_Numbers : constant array(Log_Level) of Level_Number :=
      (Emergency => 0,   -- LOG_EMERG
       Alert     => 1,   -- LOG_ALERT
       Critical  => 2,   -- LOG_CRIT
       Error     => 3,   -- LOG_ERR
       Warning   => 4,   -- LOG_WARNING
       Notice    => 5,   -- LOG_NOTICE
       Info      => 6,   -- LOG_INFO
       Debug     => 7);  -- LOG_DEBUG

   Name_Storage : chars_ptr := Null_Ptr;
   -- The name that is passed to Open_Log is saved in Name_Storage because the
   -- C library doesn't save it.


   procedure Open_Log(Source_Name        : in String;
                      Facility           : in Log_Facility;
                      Console_On_Error   : in Boolean := False;
                      Delay_Open         : in Boolean := True;
                      Standard_Error_Too : in Boolean := False;
                      Include_PID        : in Boolean := False)
   is
      LOG_PID    : constant := 1;   -- log the pid with each message
      LOG_CONS   : constant := 2;   -- log on the console if errors in sending
      LOG_NDELAY : constant := 8;   -- don't delay open
      LOG_PERROR : constant := 32;  -- log to stderr as well

      procedure openlog(ident    : in chars_ptr;
                        option   : in int;
                        facility : in int);
      pragma Import(C, openlog, "openlog");

      Options : int := 0;
   begin
      Name_Storage := New_String(Source_Name);
      if Console_On_Error then
         Options := Options + LOG_CONS;
      end if;
      if not Delay_Open then
         Options := Options + LOG_NDELAY;
      end if;
      if Standard_Error_Too then
         Options := Options + LOG_PERROR;
      end if;
      if Include_PID then
         Options := Options + LOG_PID;
      end if;
      openlog(Name_Storage, Options, Facility_Numbers(Facility));
   end Open_Log;


   procedure Set_Log_Levels(New_Levels : in  Log_Levels) is
      Dummy : Log_Levels;
      pragma Unreferenced(Dummy);
   begin
      Set_Log_Levels(New_Levels, Dummy);
   end Set_Log_Levels;


   procedure Set_Log_Levels(New_Levels : in  Log_Levels;
                            Old_Levels : out Log_Levels)
   is
      function setlogmask(mask : int) return int;
      pragma Import(C, setlogmask, "setlogmask");

      New_Mask : int := 0;
      Old_Mask : unsigned;
   begin
      -- Convert the input array of Boolean to a number.
      for L in Log_Levels'Range loop
         if New_Levels(L) then
            New_Mask := New_Mask + 2 ** Level_Numbers(L);
         end if;
      end loop;
      -- Pass that number to setlogmask and get the previous mask back.
      Old_Mask := unsigned(setlogmask(New_Mask));
      -- Convert the output number to an array of Boolean.
      for L in Log_Levels'Range loop
         Old_Levels(L) := (Old_Mask and 2 ** Level_Numbers(L)) /= 0;
      end loop;
   end Set_Log_Levels;


   procedure Set_Log_Threshold(Threshold : in Log_Level) is
      Levels : Log_Levels := (others => False);
   begin
      Levels(Emergency .. Threshold) := (others => True);
      Set_Log_Levels(Levels);
   end Set_Log_Threshold;


   procedure syslog(priority : in int;
                    format   : in char_array;
                    message  : in char_array);
   pragma Import(C, syslog, "syslog");


   Simple_Format : constant char_array := To_C("%s");


   procedure Log(Level : in Log_Level; Message : in String) is
   begin
      syslog(int(Level_Numbers(Level)), Simple_Format, To_C(Message));
   end Log;


   procedure Log(Facility : in Log_Facility;
                 Level    : in Log_Level;
                 Message  : in String)
   is
   begin
      syslog(Facility_Numbers(Facility) + int(Level_Numbers(Level)),
             Simple_Format, To_C(Message));
   end Log;


   procedure Close_Log is
      procedure closelog;
      pragma Import(C, closelog, "closelog");
   begin
      closelog;
      Free(Name_Storage);
   end Close_Log;


end System_Log;