diff options
Diffstat (limited to 'system_log.adb')
| -rw-r--r-- | system_log.adb | 138 |
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; |