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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245 | -----------------------------------------------------------------------
-- awa-commands-start -- Command to start the web server
-- Copyright (C) 2020, 2021, 2022 Stephane Carrez
-- Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
-- http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.
-----------------------------------------------------------------------
with System;
with Servlet.Core;
with Servlet.Server;
with GNAT.Sockets;
with AWA.Applications;
package body AWA.Commands.Start is
use Ada.Strings.Unbounded;
use GNAT.Sockets;
use type System.Address;
-- ------------------------------
-- Start the server and all the application that have been registered.
-- ------------------------------
overriding
procedure Execute (Command : in out Command_Type;
Name : in String;
Args : in Argument_List'Class;
Context : in out Context_Type) is
begin
if Args.Get_Count /= 0 then
Command.Usage (Name, Context);
return;
end if;
Command.Configure_Server (Context);
Command.Configure_Applications (Context);
Command.Start_Server (Context);
Command.Wait_Server (Context);
end Execute;
-- ------------------------------
-- Configure the web server container before applications are registered.
-- ------------------------------
procedure Configure_Server (Command : in out Command_Type;
Context : in out Context_Type) is
Config : Servlet.Server.Configuration;
begin
-- If daemon(3) is available and -d is defined, run it so that the parent
-- process terminates and the child process continues.
if Command.Daemon and then Sys_Daemon'Address /= System.Null_Address then
declare
Result : constant Integer := Sys_Daemon (1, 0);
begin
if Result /= 0 then
Context.Console.Error ("Cannot run in background");
end if;
end;
end if;
Config.Listening_Port := Command.Listening_Port;
Config.Max_Connection := Command.Max_Connection;
Config.TCP_No_Delay := Command.TCP_No_Delay;
Config.Input_Line_Size_Limit := Command.Input_Line_Size_Limit;
Config.Upload_Size_Limit := Command.Upload_Size_Limit;
if Command.Upload'Length > 0 then
Config.Upload_Directory := To_Unbounded_String (Command.Upload.all);
end if;
Command_Drivers.WS.Configure (Config);
end Configure_Server;
-- ------------------------------
-- Configure all registered applications.
-- ------------------------------
procedure Configure_Applications (Command : in out Command_Type;
Context : in out Context_Type) is
pragma Unreferenced (Command);
procedure Configure (URI : in String;
Application : in Servlet.Core.Servlet_Registry_Access);
Count : Natural := 0;
procedure Configure (URI : in String;
Application : in Servlet.Core.Servlet_Registry_Access) is
begin
if Application.all in ASF.Applications.Main.Application'Class then
Configure (ASF.Applications.Main.Application'Class (Application.all),
URI (URI'First + 1 .. URI'Last),
Context);
Count := Count + 1;
end if;
end Configure;
begin
Command_Drivers.WS.Iterate (Configure'Access);
if Count = 0 then
Context.Console.Error (-("There is no application"));
return;
end if;
end Configure_Applications;
-- ------------------------------
-- Start the web server.
-- ------------------------------
procedure Start_Server (Command : in out Command_Type;
Context : in out Context_Type) is
pragma Unreferenced (Command);
begin
Context.Console.Notice (N_INFO, "Starting...");
Command_Drivers.WS.Start;
end Start_Server;
-- ------------------------------
-- Wait for the server to shutdown.
-- ------------------------------
procedure Wait_Server (Command : in out Command_Type;
Context : in out Context_Type) is
pragma Unreferenced (Context);
procedure Shutdown (URI : in String;
Application : in Servlet.Core.Servlet_Registry_Access);
procedure Shutdown (URI : in String;
Application : in Servlet.Core.Servlet_Registry_Access) is
pragma Unreferenced (URI);
begin
if Application.all in AWA.Applications.Application'Class then
AWA.Applications.Application'Class (Application.all).Close;
end if;
end Shutdown;
Address : GNAT.Sockets.Sock_Addr_Type;
Listen : GNAT.Sockets.Socket_Type;
Socket : GNAT.Sockets.Socket_Type;
begin
GNAT.Sockets.Create_Socket (Listen);
Address.Addr := GNAT.Sockets.Loopback_Inet_Addr;
if Command.Management_Port > 0 then
Address.Port := Port_Type (Command.Management_Port);
else
Address.Port := 0;
end if;
GNAT.Sockets.Bind_Socket (Listen, Address);
GNAT.Sockets.Listen_Socket (Listen);
loop
GNAT.Sockets.Accept_Socket (Listen, Socket, Address);
exit;
end loop;
GNAT.Sockets.Close_Socket (Socket);
GNAT.Sockets.Close_Socket (Listen);
Command_Drivers.WS.Iterate (Shutdown'Access);
end Wait_Server;
-- ------------------------------
-- Setup the command before parsing the arguments and executing it.
-- ------------------------------
overriding
procedure Setup (Command : in out Command_Type;
Config : in out GNAT.Command_Line.Command_Line_Configuration;
Context : in out Context_Type) is
begin
GC.Set_Usage (Config => Config,
Usage => Command.Get_Name & " [arguments]",
Help => Command.Get_Description);
GC.Define_Switch (Config => Config,
Output => Command.Management_Port'Access,
Switch => "-m:",
Long_Switch => "--management-port=",
Initial => Command.Management_Port,
Argument => "NUMBER",
Help => -("The server listening management port on localhost"));
GC.Define_Switch (Config => Config,
Output => Command.Listening_Port'Access,
Switch => "-p:",
Long_Switch => "--port=",
Initial => Command.Listening_Port,
Argument => "NUMBER",
Help => -("The server listening port"));
GC.Define_Switch (Config => Config,
Output => Command.Max_Connection'Access,
Switch => "-C:",
Long_Switch => "--connection=",
Initial => Command.Max_Connection,
Argument => "NUMBER",
Help => -("The number of connections handled"));
GC.Define_Switch (Config => Config,
Output => Command.Upload'Access,
Switch => "-u:",
Long_Switch => "--upload=",
Argument => "PATH",
Help => -("The server upload directory"));
GC.Define_Switch (Config => Config,
Output => Command.Upload'Access,
Switch => "-u:",
Long_Switch => "--upload=",
Argument => "PATH",
Help => -("The server upload directory"));
GC.Define_Switch (Config => Config,
Output => Command.Upload_Size_Limit'Access,
Switch => "-M",
Long_Switch => "--max-upload-size",
Initial => Command.Upload_Size_Limit,
Help => -("Maximum size of uploaded content"));
GC.Define_Switch (Config => Config,
Output => Command.Input_Line_Size_Limit'Access,
Switch => "-F",
Long_Switch => "--max-form-size",
Initial => Command.Input_Line_Size_Limit,
Help => -("Maximum size of form submission"));
if Sys_Daemon'Address /= System.Null_Address then
GC.Define_Switch (Config => Config,
Output => Command.Daemon'Access,
Switch => "-d",
Long_Switch => "--daemon",
Help => -("Run the server in the background"));
end if;
AWA.Commands.Setup_Command (Config, Context);
end Setup;
-- ------------------------------
-- Write the help associated with the command.
-- ------------------------------
overriding
procedure Help (Command : in out Command_Type;
Name : in String;
Context : in out Context_Type) is
pragma Unreferenced (Command, Context);
begin
null;
end Help;
begin
Command_Drivers.Driver.Add_Command ("start",
-("start the web server"),
Command'Access);
end AWA.Commands.Start;
|