Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | lithium-exception_log: dump request data on exception and log it |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA1: |
193f2223bf5454d9757840ad8b417873 |
| User & Date: | nat 2017-07-01 21:22:55 |
Context
|
2017-07-02
| ||
| 20:05 | lithium-comment_cookie_smaz: improve dictionary check-in: 3a87f98cd6 user: nat tags: trunk | |
|
2017-07-01
| ||
| 21:22 | lithium-exception_log: dump request data on exception and log it check-in: 193f2223bf user: nat tags: trunk | |
|
2017-06-30
| ||
| 19:45 | lithium-comment_cookie_smaz: base-64 smaz comment cookie codec check-in: ae25cab791 user: nat tags: trunk | |
Changes
Changes to src/lithium-dispatchers.adb.
| ︙ | ︙ | |||
26 27 28 29 30 31 32 33 34 35 36 37 38 39 | with Natools.Web.Simple_Pages.Markdown_Pages; with Natools.Web.Simple_Pages.Markdown_Multipages; with Natools.Web.Sites.Updates; with Natools.Web.Tag_Pages; with Lithium.Access_Log; with Lithium.Comment_Cookie_Smaz; with Lithium.Legacy_Filters; with Lithium.Markdown.Filters; package body Lithium.Dispatchers is overriding function Clone (Object : Handler) return Handler is begin | > | 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 | with Natools.Web.Simple_Pages.Markdown_Pages; with Natools.Web.Simple_Pages.Markdown_Multipages; with Natools.Web.Sites.Updates; with Natools.Web.Tag_Pages; with Lithium.Access_Log; with Lithium.Comment_Cookie_Smaz; with Lithium.Exception_Log; with Lithium.Legacy_Filters; with Lithium.Markdown.Filters; package body Lithium.Dispatchers is overriding function Clone (Object : Handler) return Handler is begin |
| ︙ | ︙ | |||
58 59 60 61 62 63 64 65 66 67 68 69 70 71 |
Access_Log.Log
(Request, Result,
Ada.Real_Time.To_Duration (Ada.Real_Time."-" (Middle, Start)),
Ada.Real_Time.To_Duration (Ada.Real_Time."-"
(Ada.Real_Time.Clock, Middle)));
return Result;
end Dispatch;
not overriding function Create (File_Name : String) return Handler is
Holder : constant Holder_Refs.Data_Access
:= new Natools.Web.Sites.Holders.Holder;
Result : constant Handler
| > > > > | 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
Access_Log.Log
(Request, Result,
Ada.Real_Time.To_Duration (Ada.Real_Time."-" (Middle, Start)),
Ada.Real_Time.To_Duration (Ada.Real_Time."-"
(Ada.Real_Time.Clock, Middle)));
return Result;
exception
when Ex : others =>
Exception_Log.Report (Ex, Request);
return Exception_Log.Respond (Ex, Request);
end Dispatch;
not overriding function Create (File_Name : String) return Handler is
Holder : constant Holder_Refs.Data_Access
:= new Natools.Web.Sites.Holders.Holder;
Result : constant Handler
|
| ︙ | ︙ |
Added src/lithium-exception_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 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 |
------------------------------------------------------------------------------
-- Copyright (c) 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 AWS.Headers;
with AWS.Messages;
with AWS.Parameters;
with Natools.S_Expressions.File_Writers;
with Natools.Time_IO.RFC_3339;
with Natools.Web;
package body Lithium.Exception_Log is
procedure Report
(Ex : in Ada.Exceptions.Exception_Occurrence;
Request : in AWS.Status.Data) is
begin
declare
Writer : Natools.S_Expressions.File_Writers.Writer
:= Natools.S_Expressions.File_Writers.Open_Or_Create
("exceptions.sx");
begin
Writer.Open_List;
Writer.Append_String
(Natools.Time_IO.RFC_3339.Image (Ada.Calendar.Clock));
Writer.Open_List;
Writer.Append_String (AWS.Status.Method (Request));
Writer.Append_String (AWS.Status.URI (Request));
Writer.Close_List;
Write_Headers :
declare
Headers : constant AWS.Headers.List
:= AWS.Status.Header (Request);
begin
Writer.Open_List;
Writer.Append_String ("headers");
for I in 1 .. AWS.Headers.Count (Headers) loop
Writer.Open_List;
Writer.Append_String (AWS.Headers.Get_Name (Headers, I));
Writer.Append_String (AWS.Headers.Get_Value (Headers, I));
Writer.Close_List;
end loop;
Writer.Close_List;
end Write_Headers;
Write_Parameters :
declare
Parameters : constant AWS.Parameters.List
:= AWS.Status.Parameters (Request);
begin
Writer.Open_List;
Writer.Append_String ("parameters");
for I in 1 .. AWS.Parameters.Count (Parameters) loop
Writer.Open_List;
Writer.Append_String (AWS.Parameters.Get_Name (Parameters, I));
Writer.Append_String (AWS.Parameters.Get_Value (Parameters, I));
Writer.Close_List;
end loop;
Writer.Close_List;
end Write_Parameters;
Writer.Open_List;
Writer.Append_String ("body");
Writer.Append_Atom (AWS.Status.Binary_Data (Request));
Writer.Close_List;
Writer.Open_List;
Writer.Append_String ("exception");
Writer.Open_List;
Writer.Append_String ("name");
Writer.Append_String (Ada.Exceptions.Exception_Name (Ex));
Writer.Close_List;
Writer.Open_List;
Writer.Append_String ("message");
Writer.Append_String (Ada.Exceptions.Exception_Message (Ex));
Writer.Close_List;
Writer.Open_List;
Writer.Append_String ("info");
Writer.Append_String (Ada.Exceptions.Exception_Information (Ex));
Writer.Close_List;
Writer.Close_List;
Writer.Close_List;
Writer.Newline;
end;
Natools.Web.Log
(Natools.Web.Severities.Error,
"Exception " & Ada.Exceptions.Exception_Name (Ex)
& " raised and logged");
exception
when Double : others =>
Last_Chance :
begin
Natools.Web.Log
(Natools.Web.Severities.Critical,
"Exception " & Ada.Exceptions.Exception_Name (Ex)
& " raised but logging raised "
& Ada.Exceptions.Exception_Name (Double)
& " (" & Ada.Exceptions.Exception_Message (Double) & ")");
exception
when others => null;
end Last_Chance;
end Report;
function Respond
(Ex : in Ada.Exceptions.Exception_Occurrence;
Request : in AWS.Status.Data)
return AWS.Response.Data
is
pragma Unreferenced (Request);
begin
return AWS.Response.Build
("text/html",
"<html><head><title>Error 500 - Internal Server Error</title></head>"
& "<body><h1>Error 500 - Internal Server Error<h1><pre><code>"
& Ada.Exceptions.Exception_Information (Ex)
& "</code></pre></body></html>",
AWS.Messages.S500);
end Respond;
end Lithium.Exception_Log;
|
Added src/lithium-exception_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 36 37 38 39 40 |
------------------------------------------------------------------------------
-- Copyright (c) 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.Exception_Log provides primitives to deal with exceptions when --
-- constructing a response. --
------------------------------------------------------------------------------
with Ada.Exceptions;
with AWS.Response;
with AWS.Status;
package Lithium.Exception_Log is
procedure Report
(Ex : in Ada.Exceptions.Exception_Occurrence;
Request : in AWS.Status.Data);
-- Report an exception occurrence when responding to Request
function Respond
(Ex : in Ada.Exceptions.Exception_Occurrence;
Request : in AWS.Status.Data)
return AWS.Response.Data;
-- Craft the emergency reponse to Request,
-- hopefully without piling on more exceptions.
end Lithium.Exception_Log;
|