Rombobjörn

summaryrefslogtreecommitdiff
path: root/system_log.adb
blob: e77c95dca6f5295020ae76cc813c7123d38f1148 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
-- 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;