lithium3

Check-in [e0251e7c05]
Login
☰Home Timeline Branches Tags Tickets Wiki Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:lithium-log: add a periodic marker to the log when in debug mode
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e0251e7c053c35f0dd6974cf05f845d1b87c6f45
User & Date: nat 2017-06-10 21:24:14
Context
2017-06-30
19:45
lithium-comment_cookie_smaz: base-64 smaz comment cookie codec check-in: ae25cab791 user: nat tags: trunk
2017-06-10
21:24
lithium-log: add a periodic marker to the log when in debug mode check-in: e0251e7c05 user: nat tags: trunk
2017-06-05
20:48
lithium-dispatchers: add expiration purge to prevent termination issue check-in: bb942f62bc user: nat tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to src/lithium-log.adb. 

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------


with Ada.Text_IO;
with Syslog.Guess.App_Name;
with Syslog.Guess.Hostname;
with Syslog.Transport.Send_Task;
with Syslog.Transport.UDP;

package body Lithium.Log is


|














>








1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar;
with Ada.Text_IO;
with Syslog.Guess.App_Name;
with Syslog.Guess.Hostname;
with Syslog.Transport.Send_Task;
with Syslog.Transport.UDP;

package body Lithium.Log is
︙︙
42
43
44
45
46
47
48


























49
50
51
52
53
54
55

           (Syslog.Transport.UDP.Transport);
         Syslog.Set_Transport (Syslog.Transport.Send_Task.Transport);
         Syslog.Set_Default_Facility (Syslog.Facilities.Daemon);
         Natools.Web.Log := Lithium.Log.Syslog_Log'Access;
      end if;
   end Initialize;




























   procedure Syslog_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String) is
   begin
      Syslog.Log (Severity_Table (Severity), Message);
   end Syslog_Log;








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>








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

           (Syslog.Transport.UDP.Transport);
         Syslog.Set_Transport (Syslog.Transport.Send_Task.Transport);
         Syslog.Set_Default_Facility (Syslog.Facilities.Daemon);
         Natools.Web.Log := Lithium.Log.Syslog_Log'Access;
      end if;
   end Initialize;


   overriding procedure Run (Object : in out Marker) is
      pragma Unreferenced (Object);
      function Image (N : Natural) return Character
        is (Character'Val (Character'Pos ('0') + N));
      Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Year : Ada.Calendar.Year_Number;
      Month : Ada.Calendar.Month_Number;
      Day : Ada.Calendar.Day_Number;
      Seconds : Ada.Calendar.Day_Duration;
   begin
      Ada.Calendar.Split (Now, Year, Month, Day, Seconds);
      Ada.Text_IO.Put_Line ("------- "
        & Image (Year / 1000)
        & Image ((Year / 100) mod 10)
        & Image ((Year / 10) mod 10)
        & Image (Year mod 10)
        & '-'
        & Image (Month / 10)
        & Image (Month mod 10)
        & '-'
        & Image (Day / 10)
        & Image (Day mod 10)
        & " -------");
   end Run;


   procedure Syslog_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String) is
   begin
      Syslog.Log (Severity_Table (Severity), Message);
   end Syslog_Log;
︙︙

Changes to src/lithium-log.ads. 

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

------------------------------------------------------------------------------
-- Copyright (c) 2015, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Lithium.Log provides the glue between ada-syslog and natools-web.        --
------------------------------------------------------------------------------


with Natools.Web;

package Lithium.Log is

   procedure Initialize (Debug : in Boolean);

   procedure Text_IO_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String);

   procedure Syslog_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String);






end Lithium.Log;


|


















>














>
>
>
>
>


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

------------------------------------------------------------------------------
-- Copyright (c) 2015-2017, Natacha Porté                                   --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Lithium.Log provides the glue between ada-syslog and natools-web.        --
------------------------------------------------------------------------------

with Natools.Cron;
with Natools.Web;

package Lithium.Log is

   procedure Initialize (Debug : in Boolean);

   procedure Text_IO_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String);

   procedure Syslog_Log
     (Severity : in Natools.Web.Severities.Code;
      Message : in String);


   type Marker is new Natools.Cron.Callback with null record;

   overriding procedure Run (Object : in out Marker);

end Lithium.Log;

Changes to src/lithium-main.adb.

︙︙
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

-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------


with Ada.Command_Line;
with Ada.Directories;
with Ada.Text_IO;
with AWS.Config;
with AWS.Server;

with Lithium.Dispatchers;
with Lithium.Log;

procedure Lithium.Main is
















   WS : AWS.Server.HTTP;
   Debug : constant Boolean := Ada.Command_Line.Argument_Count >= 2;
   Handler : Lithium.Dispatchers.Handler;
begin
   Lithium.Log.Initialize (Debug);

   if Ada.Command_Line.Argument_Count >= 1 then
      Handler := Lithium.Dispatchers.Create (Ada.Command_Line.Argument (1));
   else
      Handler := Lithium.Dispatchers.Create ("site.sx");
   end if;

   AWS.Server.Start (WS, Handler, AWS.Config.Get_Current);

   if not Debug then
      AWS.Server.Wait;
   elsif Ada.Directories.Exists (Ada.Command_Line.Argument (2)) then
      Ada.Text_IO.Put_Line ("Websever started, waiting for removal of "
        & Ada.Command_Line.Argument (2));

      loop
         delay 1.0;
         exit when not Ada.Directories.Exists (Ada.Command_Line.Argument (2));
      end loop;
   else
      Ada.Text_IO.Put_Line ("Websever started, waiting for Q press");

      AWS.Server.Wait (AWS.Server.Q_Key_Pressed);
   end if;

   AWS.Server.Shutdown (WS);
   Handler.Purge;

end Lithium.Main;








>





>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



















>






>





>


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

-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

with Ada.Calendar;
with Ada.Command_Line;
with Ada.Directories;
with Ada.Text_IO;
with AWS.Config;
with AWS.Server;
with Natools.Cron;
with Lithium.Dispatchers;
with Lithium.Log;

procedure Lithium.Main is
   procedure Start_Mark (Cron_Entry : in out Natools.Cron.Cron_Entry);

   procedure Start_Mark (Cron_Entry : in out Natools.Cron.Cron_Entry) is
      Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
   begin
      Cron_Entry.Set
        ((Origin => Ada.Calendar.Time_Of
                     (Ada.Calendar.Year (Now),
                      Ada.Calendar.Month (Now),
                      Ada.Calendar.Day (Now),
                      0.0),
          Period => 86_400.0),
         Log.Marker'(null record));
   end Start_Mark;

   Cron_Entry : Natools.Cron.Cron_Entry;
   WS : AWS.Server.HTTP;
   Debug : constant Boolean := Ada.Command_Line.Argument_Count >= 2;
   Handler : Lithium.Dispatchers.Handler;
begin
   Lithium.Log.Initialize (Debug);

   if Ada.Command_Line.Argument_Count >= 1 then
      Handler := Lithium.Dispatchers.Create (Ada.Command_Line.Argument (1));
   else
      Handler := Lithium.Dispatchers.Create ("site.sx");
   end if;

   AWS.Server.Start (WS, Handler, AWS.Config.Get_Current);

   if not Debug then
      AWS.Server.Wait;
   elsif Ada.Directories.Exists (Ada.Command_Line.Argument (2)) then
      Ada.Text_IO.Put_Line ("Websever started, waiting for removal of "
        & Ada.Command_Line.Argument (2));
      Start_Mark (Cron_Entry);
      loop
         delay 1.0;
         exit when not Ada.Directories.Exists (Ada.Command_Line.Argument (2));
      end loop;
   else
      Ada.Text_IO.Put_Line ("Websever started, waiting for Q press");
      Start_Mark (Cron_Entry);
      AWS.Server.Wait (AWS.Server.Q_Key_Pressed);
   end if;

   AWS.Server.Shutdown (WS);
   Handler.Purge;
   Cron_Entry.Reset;
end Lithium.Main;

This page was generated in about 0.005s by Fossil 2.23 [47362306a7] 2023-11-01 18:56:47