Rombobjörn

summaryrefslogtreecommitdiff
path: root/system_log.adb
diff options
context:
space:
mode:
Diffstat (limited to 'system_log.adb')
-rw-r--r--system_log.adb138
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;