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
|
-- System_Log, a binding to the Unix syslog functions
-- Copyright 2009 - 2013 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;
-- 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;
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
-- Convert the input array of Boolean to a number, pass that to
-- setlogmask, and convert the output in the other direction.
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;
|