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 | --
-- Author: Brent Seidel
-- Date: 6-Aug-2024
--
-- This file is part of Simple Ada Web Server.
-- Simple Ada Web Server is free software: you can redistribute it and/or
-- modify it under the terms of the GNU General Public License as published
-- by the Free Software Foundation, either version 3 of the License, or (at
-- your option) any later version.
--
-- Simple Ada Web Server is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
-- more details.
--
-- You should have received a copy of the GNU General Public License along
-- with Simple Ada Web Server. If not, see <https://www.gnu.org/licenses/>.--
--
with BBS.web.http;
with BBS.web.html;
package body BBS.web.internal is
--
-- Return the count of transactions as an xml message
--
procedure xml_count(s : GNAT.Sockets.Stream_Access;
h : params.Map;
p : params.Map) is
begin
BBS.web.http.ok(s, "application/xml");
String'Write(s, "<xml><tasks>" & Integer'Image(task_counter.read) &
"</tasks><counter>" & Integer'Image(request_counter.read) &
"</counter></xml>" & CRLF);
end xml_count;
--
-- Display information sent in a form
--
procedure target(s : GNAT.Sockets.Stream_Access;
h : params.Map;
p : params.Map) is
index : params.Cursor;
begin
BBS.web.http.ok(s, "text/html");
BBS.web.html.html_head(s, "Form Parameters", "Style");
String'Write(s, "<p>Table showing the parameters submitted in a form</p>" & CRLF);
--
-- Write a table for the headers
--
String'Write(s, "<h2>Headers</h2>" & CRLF);
String'Write(s, "<table>" & CRLF);
String'Write(s, "<tr><th>Header</th><th>Value</th></tr></tr>" & CRLF);
index := params.First(h);
while (params.Has_Element(index)) loop
String'Write(s, "<tr><td>" & params.Key(index) & "</td><td>" &
params.Element(index) & "</td></tr>" & CRLF);
params.Next(index);
end loop;
String'Write(s, "</table>" & CRLF);
--
-- Write a table for the parameters
--
String'Write(s, "<h2>Form Parameters</h2>" & CRLF);
String'Write(s, "<table>" & CRLF);
String'Write(s, "<tr><th>Key</th><th>Value</th></tr></tr>" & CRLF);
index := params.First(p);
while (params.Has_Element(index)) loop
String'Write(s, "<tr><td>" & params.Key(index) & "</td><td>" &
params.Element(index) & "</td></tr>" & CRLF);
params.Next(index);
end loop;
String'Write(s, "</table>" & CRLF);
String'Write(s, "<h2>Headers</h2>" & CRLF);
BBS.web.html.html_end(s, "footer.html");
end target;
--
-- Request that the configuration file be reloaded.
--
procedure html_reload_config(s : GNAT.Sockets.Stream_Access;
h : params.Map;
p : params.Map) is
begin
BBS.web.http.ok(s, "text/html");
BBS.web.html.html_head(s, "Reload Requested", "Style");
String'Write(s, "<h1>Reload Request</h1>");
String'Write(s, "<p>Configuration file reload request submitted.</p>" & CRLF);
BBS.web.html.html_end(s, "footer.html");
bbs.web.reload_configuration.set;
end html_reload_config;
--
-- Set the web exit flag.
--
procedure html_set_exit(s : GNAT.Sockets.Stream_Access;
h : params.Map;
p : params.Map) is
begin
BBS.web.http.ok(s, "text/html");
BBS.web.html.html_head(s, "Server Exiting", "Style");
String'Write(s, "<h1>Exit Flag Set</h1>");
String'Write(s, "Web server should be exiting.");
BBS.web.html.html_end(s, "footer.html");
web.exit_flag.set;
end html_set_exit;
--
-- Raise an exception to test task exception handling
--
procedure html_raise(s : GNAT.Sockets.Stream_Access;
h : params.Map;
p : params.Map) is
begin
raise Program_Error;
end;
end BBS.web.internal;
|