imported

1 files changed, 138 insertions, 0 deletions

diff --git a/system_log.adb b/system_log.adb
new file mode 100644
index 0000000..71da109
--- /dev/null
+++ b/system_log.adb
@@ -0,0 +1,138 @@
+-- System_Log, a binding to the Unix syslog functions
+-- Copyright 2009 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;
+with Ada.Unchecked_Conversion;
+
+package body System_Log is
+
+   Facility_Numbers : constant array(Log_Facility) of int :=
+      (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
+
+   Level_Numbers : constant array(Log_Level) of int :=
+      (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;
+
+   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;
+   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");
+      Bits : constant := Log_Level'Pos(Log_Level'Last) + 1;
+      type Mask is range 0 .. 2 ** Bits - 1;
+      for Mask'Size use Bits;
+      function To_Mask is new Ada.Unchecked_Conversion(Source => Log_Levels,
+                                                       Target => Mask);
+      function To_Levels is new Ada.Unchecked_Conversion(Source => Mask,
+                                                         Target => Log_Levels);
+   begin
+      Old_Levels := To_Levels(Mask(setlogmask(int(To_Mask(New_Levels)))));
+   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(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) + 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;