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 | with Ada.Text_IO;
with Ada.Exceptions;
with AWS.Server;
with AWS.Response;
with AWS.Status;
with AWS.MIME;
with AWS.Config;
with AWS.Config.Set;
with AAA.Strings;
package body Adabots_Lua_Dispatcher is
function Create_Lua_Dispatcher (Port : Integer) return Lua_Dispatcher is
begin
return
(Ada.Finalization.Limited_Controlled with
Server => new Command_Server (Port));
end Create_Lua_Dispatcher;
type Server_Status is
(Awaiting_Command, Sending_Command, Fetching_Return_Value,
Returning_Result, Stopping);
function Strip_Prefix (Source, Prefix : String) return String;
function Strip_Prefix (Source, Prefix : String) return String is
begin
return Source (Source'First + Prefix'Length .. Source'Last);
end Strip_Prefix;
task body Command_Server is
HTTP_Server : AWS.Server.HTTP;
AWS_Config : AWS.Config.Object := AWS.Config.Default_Config;
Next_Command : Unbounded_String;
Previous_Result : Unbounded_String;
Status : Server_Status := Awaiting_Command;
function Respond (Request : AWS.Status.Data) return AWS.Response.Data;
function Respond (Request : AWS.Status.Data) return AWS.Response.Data is
URI : constant String := AWS.Status.URI (Request);
Return_Value_Prefix : constant String := "/return_value/";
Command : Unbounded_String;
begin
if URI = "/" then
Fetch_Command (Command);
return
AWS.Response.Build (AWS.MIME.Text_Plain, To_String (Command));
elsif AAA.Strings.Has_Prefix (URI, Return_Value_Prefix) then
Push_Return_Value (Strip_Prefix (URI, Return_Value_Prefix));
return
AWS.Response.Build
(AWS.MIME.Text_Plain, To_Unbounded_String (""));
end if;
return
AWS.Response.Build
(AWS.MIME.Text_Plain, To_Unbounded_String ("error"));
end Respond;
begin
AWS.Config.Set.Reuse_Address (AWS_Config, True);
AWS.Config.Set.Server_Port (AWS_Config, Port);
AWS.Config.Set.Server_Name (AWS_Config, "Adabots");
AWS.Server.Start
(HTTP_Server, Callback => Respond'Unrestricted_Access,
Config => AWS_Config);
-- Ada.Text_IO.Put_Line ("Command server started");
Command_Loop :
loop
if Status = Awaiting_Command then
select
accept Schedule_Command (Command : String) do
Ada.Text_IO.Put_Line ("Scheduled " & Command);
Next_Command := To_Unbounded_String (Command);
Status := Sending_Command;
end Schedule_Command;
or
accept Shutdown do
-- Ada.Text_IO.Put_Line ("Command server shutting down...");
AWS.Server.Shutdown (HTTP_Server);
Status := Stopping;
end Shutdown;
end select;
elsif Status = Sending_Command then
accept Fetch_Command (Command : out Unbounded_String) do
Command := Next_Command;
-- Ada.Text_IO.Put_Line ("Sent " & To_String (Command));
Next_Command := To_Unbounded_String ("");
Status := Fetching_Return_Value;
end Fetch_Command;
elsif Status = Fetching_Return_Value then
accept Push_Return_Value (Return_Value : String) do
Previous_Result := To_Unbounded_String (Return_Value);
Status := Returning_Result;
end Push_Return_Value;
elsif Status = Returning_Result then
accept Get_Result (Result : out Unbounded_String) do
Result := Previous_Result;
Previous_Result := To_Unbounded_String ("");
Status := Awaiting_Command;
end Get_Result;
end if;
exit Command_Loop when Status = Stopping;
end loop Command_Loop;
exception
when Error : others =>
Ada.Text_IO.Put_Line ("Unexpected error:");
Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (Error));
Ada.Text_IO.Skip_Line;
end Command_Server;
function Raw_Function (T : Lua_Dispatcher; Lua_Code : String) return String
is
Returned_String : Unbounded_String;
begin
T.Server.Schedule_Command (Lua_Code);
T.Server.Get_Result (Returned_String);
declare
String_Result : constant String := To_String (Returned_String);
begin
if AAA.Strings.Has_Prefix (String_Result, "error: ") then
raise Program_Error with String_Result;
end if;
return String_Result;
end;
end Raw_Function;
function Boolean_Function
(T : Lua_Dispatcher; Lua_Code : String) return Boolean
is
Returned_String : constant String := T.Raw_Function (Lua_Code);
begin
if Returned_String = "true" then
return True;
elsif Returned_String = "false" then
return False;
end if;
raise Program_Error with Returned_String;
end Boolean_Function;
procedure Raw_Procedure (T : Lua_Dispatcher; Lua_Code : String) is
Result : String := Raw_Function (T, Lua_Code);
pragma Unreferenced (Result);
begin
null;
end Raw_Procedure;
-- private:
overriding procedure Finalize (T : in out Lua_Dispatcher) is
begin
Ada.Text_IO.Put_Line ("Shutting down...");
T.Server.Shutdown;
Ada.Text_IO.Put_Line ("Shutdown finished...");
end Finalize;
end Adabots_Lua_Dispatcher;
|