Old Ada http server.
parent
c019a5a884
commit
4a9d20f1ee
|
|
@ -0,0 +1,17 @@
|
|||
package body signals is
|
||||
protected body Sigint_Handler is
|
||||
|
||||
procedure selector(s: Selector_Access) is
|
||||
begin
|
||||
sel := s;
|
||||
end;
|
||||
|
||||
procedure Handle is
|
||||
begin
|
||||
Call_Count := Call_Count + 1;
|
||||
i Put_Line("SIGINT handled");
|
||||
Gnat.Sockets.Abort_Selector(sel.all);
|
||||
|
||||
END Handle;
|
||||
end Sigint_Handler;
|
||||
end signals;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
Ala ma kota
|
||||
adasdada
|
||||
asda
|
||||
d
|
||||
|
||||
Dada
|
||||
sd
|
||||
a
|
||||
d
|
||||
a
|
||||
da
|
||||
|
||||
takaotootootootgf
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
package constants is
|
||||
|
||||
cr : Character := Character'Val(13);
|
||||
lf : Character := Character'Val(10);
|
||||
newline: String := (cr, lf);
|
||||
|
||||
end constants;
|
||||
|
|
@ -0,0 +1,75 @@
|
|||
package body dispatchers is
|
||||
|
||||
task body Dispatcher is
|
||||
HANDLERS_COUNT : constant Integer := 2;
|
||||
MAX_SOCKETS_COUNT : constant Integer := 1000;
|
||||
UNDISPATCHED_SOCKET_RETRY_TIME : constant Duration := 0.5;
|
||||
|
||||
handlers : array (1 .. HANDLERS_COUNT) of Handler;
|
||||
|
||||
type Socket_Index is range 1..MAX_SOCKETS_COUNT;
|
||||
package Socket_Vector is new Ada.Containers.Vectors (
|
||||
Element_Type => Socket_Type,
|
||||
Index_Type => Socket_Index);
|
||||
|
||||
function Find_Free_Handler(s: Socket_Type) return Boolean is
|
||||
begin
|
||||
for id in handlers'Range loop
|
||||
select
|
||||
handlers(id).handle(s);
|
||||
return True;
|
||||
else
|
||||
null;
|
||||
end select;
|
||||
end loop;
|
||||
return False;
|
||||
end Find_Free_Handler;
|
||||
|
||||
result : Boolean;
|
||||
undispatched : Socket_Vector.Vector;
|
||||
|
||||
begin
|
||||
accept start;
|
||||
|
||||
for id in handlers'Range loop
|
||||
handlers(id).start(id);
|
||||
end loop;
|
||||
|
||||
loop
|
||||
select
|
||||
accept dispatch (s: Socket_Type) do
|
||||
Put_Line ("dispatch command");
|
||||
result := Find_Free_Handler(s);
|
||||
if not result then
|
||||
Put_Line("All handlers are busy");
|
||||
undispatched.Append(s);
|
||||
end if;
|
||||
end dispatch;
|
||||
or
|
||||
accept stop do
|
||||
Put_Line("stop command, stopping dispatcher");
|
||||
end stop;
|
||||
exit;
|
||||
or
|
||||
delay UNDISPATCHED_SOCKET_RETRY_TIME;
|
||||
if Integer(undispatched.Length) > 0 then
|
||||
declare
|
||||
s: Socket_Type := undispatched.Element(1);
|
||||
begin
|
||||
result := Find_Free_Handler(s);
|
||||
if result then
|
||||
undispatched.Delete(1);
|
||||
Put_Line("Handled undispatched client");
|
||||
end if;
|
||||
end;
|
||||
end if;
|
||||
end select;
|
||||
end loop;
|
||||
|
||||
for id in handlers'Range loop
|
||||
handlers(id).stop;
|
||||
end loop;
|
||||
|
||||
|
||||
end dispatcher;
|
||||
end dispatchers;
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Gnat.Sockets; use Gnat.Sockets;
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
with Ada.Containers.Vectors;
|
||||
with Handlers; use Handlers;
|
||||
|
||||
package dispatchers is
|
||||
task Dispatcher is
|
||||
entry start;
|
||||
-- signal to start
|
||||
entry dispatch(s: Socket_Type);
|
||||
-- we got accepted socket from the listener
|
||||
entry stop;
|
||||
-- signal to stop
|
||||
end dispatcher;
|
||||
end dispatchers;
|
||||
|
|
@ -0,0 +1,247 @@
|
|||
package body handlers is
|
||||
task body handler is
|
||||
socket : Socket_Type;
|
||||
sel : access Gnat.Sockets.Selector_Type := new
|
||||
Gnat.Sockets.Selector_Type;
|
||||
working : Boolean := True;
|
||||
subtype Socket_Index is Integer range 1 .. 1000;
|
||||
root_path : constant String := "/var/www";
|
||||
|
||||
package Socket_Vector is new Ada.Containers.Vectors (
|
||||
Element_Type => Socket_Type,
|
||||
Index_Type => Socket_Index
|
||||
);
|
||||
|
||||
v : Socket_Vector.Vector;
|
||||
|
||||
task watcher is
|
||||
entry start;
|
||||
end watcher;
|
||||
|
||||
task body watcher is
|
||||
R : Socket_Set_Type;
|
||||
W : Socket_Set_Type;
|
||||
E : Socket_Set_Type;
|
||||
status : Selector_Status;
|
||||
active : Socket_Type;
|
||||
unparsed: Unbounded_String;
|
||||
begin
|
||||
accept start;
|
||||
Put_Line("start watcher");
|
||||
Create_Selector (sel.all);
|
||||
loop
|
||||
Put_Line("Watch loop start");
|
||||
Empty(R);
|
||||
Empty(W);
|
||||
Empty(E);
|
||||
|
||||
Put("There is ");
|
||||
Put(v.Last_Index, Width => 0);
|
||||
Put_Line(" sockets to watch");
|
||||
|
||||
Put_Line("setting to read sockets");
|
||||
|
||||
for id in 1..v.Last_Index loop
|
||||
set(R, v.Element(id));
|
||||
end loop;
|
||||
|
||||
Put_Line("start of check_selector");
|
||||
|
||||
Check_Selector(
|
||||
sel.all,
|
||||
R,
|
||||
W,
|
||||
E,
|
||||
status,
|
||||
Gnat.Sockets.Forever);
|
||||
|
||||
Put_Line("end of check_selector");
|
||||
|
||||
-- wychodzimy jedynie wtedy, gdy zmienna working
|
||||
-- jest False. Inaczej to jedynie przeładowanie
|
||||
-- socketów np. dodano nam socket do obserwacji
|
||||
exit when status = Gnat.Sockets.Aborted
|
||||
and not working;
|
||||
|
||||
if status /= Gnat.Sockets.Aborted then
|
||||
Put_Line("Sending command to client handler");
|
||||
Get(R, active);
|
||||
Handler.command(active);
|
||||
end if;
|
||||
|
||||
Put_Line("Watch loop end");
|
||||
|
||||
end loop;
|
||||
Close_Selector (sel.all);
|
||||
Put_Line("exit watcher");
|
||||
end watcher;
|
||||
|
||||
procedure Handle_File(s: Socket_Type;
|
||||
path: String;
|
||||
finished: out Boolean) is
|
||||
|
||||
sz : Natural := Natural(Size(path));
|
||||
subtype Content_Type is String (1 .. sz);
|
||||
package dio is new Ada.Direct_IO(Content_Type);
|
||||
File : dio.File_Type;
|
||||
contents : Content_Type;
|
||||
channel : Stream_Access := Stream(s);
|
||||
begin
|
||||
Put_Line("Handle_File start");
|
||||
Put_Line("Path: " & path);
|
||||
Put_Line("File size: " & Natural'Image(sz));
|
||||
|
||||
dio.Open(
|
||||
File => File,
|
||||
Mode => dio.In_File,
|
||||
Name => path);
|
||||
|
||||
Put_Line("File opened");
|
||||
|
||||
String'Write(channel, "HTTP/1.0 200 OK" & newline);
|
||||
String'Write(channel, "Server: Ada Server 0.1" &
|
||||
newline);
|
||||
|
||||
Put_Line("Root path: " & root_path & path);
|
||||
Put_Line("File size: " & Natural'Image(sz));
|
||||
|
||||
dio.Read (File, Item => contents);
|
||||
Put_Line("Contents: " & contents & newline);
|
||||
String'Write(channel, newline);
|
||||
String'Write(channel, contents);
|
||||
|
||||
dio.Close(File);
|
||||
Put_Line("Closed file");
|
||||
|
||||
Close_Socket(s);
|
||||
Put_Line("Closed socket");
|
||||
finished := True;
|
||||
end Handle_File;
|
||||
|
||||
procedure Handle_Socket(s: Socket_Type; finished: out Boolean) is
|
||||
subtype Line_Type is String (1 .. 4096);
|
||||
channel : Stream_Access := Stream (s);
|
||||
line : Line_Type;
|
||||
elem_line : Stream_Element_Array (1 .. 4096);
|
||||
last : Stream_Element_Offset;
|
||||
|
||||
package af renames Ada.Strings.Fixed;
|
||||
|
||||
function Convert is new Ada.Unchecked_Conversion (
|
||||
Source => Stream_Element_Array,
|
||||
Target => Line_Type
|
||||
);
|
||||
begin
|
||||
Put_Line("Got command to execute");
|
||||
channel := Stream (s);
|
||||
Receive_Socket(s, elem_line, last);
|
||||
line := Convert(elem_line);
|
||||
Put("Odczytano: ");
|
||||
Put(Integer(last), Width => 0);
|
||||
Put_Line(" znakow");
|
||||
if last >= 4 and line (1 .. 4) = "GET " then
|
||||
Put_Line("GET Command: " & line);
|
||||
|
||||
declare
|
||||
EOL : Integer := af.Index(line, newline);
|
||||
HTTP_Version_Offset : Integer := af.Index(line, "HTTP/1.");
|
||||
path : String := line (5..HTTP_Version_Offset - 2);
|
||||
begin
|
||||
if Exists (root_path & path) then
|
||||
Put_Line("Kind: " & File_Kind'Image(Kind(root_path & path)));
|
||||
if Kind(root_path & path) = Ordinary_File then
|
||||
Put_Line("Full path: '" & root_path & path & "'");
|
||||
handle_file(s,
|
||||
root_path & path,
|
||||
finished);
|
||||
return;
|
||||
else
|
||||
-- pewnie katalog
|
||||
if Exists(root_path & path & "index.html") then
|
||||
handle_file(s,
|
||||
root_path & path &
|
||||
"index.html",
|
||||
finished);
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Exists(root_path & path & "index.htm") then
|
||||
handle_file(s,
|
||||
root_path & path &
|
||||
"index.htm",
|
||||
finished);
|
||||
|
||||
return;
|
||||
end if;
|
||||
|
||||
String'Write(channel, "HTTP/1.0 200 OK" & newline);
|
||||
String'Write(channel, "Server: Ada Server 0.1" &
|
||||
newline & newline);
|
||||
String'Write(channel, "<html><body>" &
|
||||
"directory</body></html>" & newline);
|
||||
end if;
|
||||
else
|
||||
String'Write (channel, "HTTP/1.0 404 NOT FOUND" &
|
||||
newline);
|
||||
String'Write (channel, "Server: Ada Server 0.1" &
|
||||
newline & newline);
|
||||
String'Write (channel, "<html><body>" &
|
||||
"404 Error</body></html>");
|
||||
end if;
|
||||
end;
|
||||
|
||||
else
|
||||
String'Write(channel, "Unknown" & newline);
|
||||
end if;
|
||||
Put_Line("Closing socket");
|
||||
Close_Socket(s);
|
||||
finished := True;
|
||||
end Handle_Socket;
|
||||
|
||||
idx : Integer;
|
||||
|
||||
begin
|
||||
accept start(id: Integer) do
|
||||
idx := id;
|
||||
end start;
|
||||
|
||||
Watcher.Start;
|
||||
|
||||
Put("start client handler with id: ");
|
||||
Put(idx, Width => 0);
|
||||
New_Line;
|
||||
loop
|
||||
select
|
||||
accept handle(s: Socket_Type) do
|
||||
socket := s;
|
||||
v.Append(s);
|
||||
end handle;
|
||||
Abort_Selector(sel.all);
|
||||
Put_Line("Socket consumed by client handler");
|
||||
or
|
||||
accept command(s: Socket_Type) do
|
||||
declare
|
||||
finished: Boolean;
|
||||
begin
|
||||
Handle_Socket(s, finished);
|
||||
if finished then
|
||||
v.Delete(v.Find_Index(s));
|
||||
end if;
|
||||
end;
|
||||
end command;
|
||||
or
|
||||
accept stop do
|
||||
Put_Line("Got command to stop");
|
||||
working := False;
|
||||
Abort_Selector(sel.all);
|
||||
end stop;
|
||||
exit;
|
||||
or
|
||||
terminate;
|
||||
end select;
|
||||
end loop;
|
||||
Put_Line("end client handler");
|
||||
end handler;
|
||||
|
||||
end handlers;
|
||||
|
|
@ -0,0 +1,37 @@
|
|||
with Ada.Containers.Vectors;
|
||||
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
|
||||
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with GNAT.Sockets; use GNAT.Sockets;
|
||||
with Constants; use Constants;
|
||||
with Ada.Calendar; use Ada.Calendar;
|
||||
with Ada.Streams; use Ada.Streams;
|
||||
with Ada.Unchecked_Conversion;
|
||||
with Ada.Strings.Fixed;
|
||||
with Ada.Directories; use Ada.Directories;
|
||||
with Ada.Direct_IO;
|
||||
with Ada.Exceptions; use Ada.Exceptions;
|
||||
with Ada.IO_Exceptions; use Ada.IO_Exceptions;
|
||||
|
||||
package handlers is
|
||||
|
||||
type Client_Type is record
|
||||
socket : Socket_Type;
|
||||
read : Unbounded_String;
|
||||
unread : Unbounded_String;
|
||||
last_active : Time;
|
||||
end record;
|
||||
|
||||
type Client_Index_Type is range 1..100;
|
||||
package Client_Vector_Type is new Ada.Containers.Vectors (
|
||||
Element_Type => Client_Type,
|
||||
Index_Type => Client_Index_Type);
|
||||
|
||||
task type handler is
|
||||
entry start(id: Integer);
|
||||
entry handle(s: Socket_Type);
|
||||
entry command(s: Socket_Type);
|
||||
entry stop;
|
||||
end handler;
|
||||
|
||||
end handlers;
|
||||
Binary file not shown.
|
|
@ -0,0 +1,67 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
|
||||
with GNAT.Sockets; use GNAT.Sockets;
|
||||
with signals; use signals;
|
||||
with Ada.Containers.Vectors;
|
||||
with Handlers; use Handlers;
|
||||
with Constants; use Constants;
|
||||
with Dispatchers; use Dispatchers;
|
||||
|
||||
procedure server is
|
||||
|
||||
HOST : constant String := "localhost";
|
||||
PORT : constant Port_Type := 6666;
|
||||
work : Boolean := True;
|
||||
address : Sock_Addr_Type;
|
||||
server : Socket_Type;
|
||||
socket : Socket_Type;
|
||||
h2 : Sigint_Handler;
|
||||
status : Gnat.Sockets.Selector_Status;
|
||||
selector: signals.selector_Access;
|
||||
req : Request_Type(Non_Blocking_IO);
|
||||
begin
|
||||
Put_Line("start of server");
|
||||
Dispatcher.Start;
|
||||
selector := new Gnat.Sockets.Selector_Type;
|
||||
h2.selector(selector);
|
||||
Gnat.Sockets.Create_Selector(selector.all);
|
||||
address.Addr := Addresses (Get_Host_By_Name(host), 1);
|
||||
address.Port := PORT;
|
||||
|
||||
Create_Socket(server);
|
||||
Set_Socket_Option (
|
||||
server,
|
||||
Socket_Level,
|
||||
(Reuse_Address, True));
|
||||
|
||||
Bind_Socket (server, address);
|
||||
Put_Line("Binded");
|
||||
Listen_Socket(server);
|
||||
Put_Line("Listening");
|
||||
|
||||
loop
|
||||
Put_Line("Waiting to accept");
|
||||
Accept_Socket (
|
||||
Server => server,
|
||||
Socket => socket,
|
||||
Address => address,
|
||||
Timeout => GNAT.Sockets.Forever,
|
||||
Selector => selector,
|
||||
Status => status);
|
||||
exit when status = Gnat.Sockets.Aborted;
|
||||
Put_Line("Accepted");
|
||||
|
||||
Control_Socket(socket, req);
|
||||
|
||||
Dispatcher.dispatch(socket);
|
||||
Put_Line("Handled by listener");
|
||||
|
||||
end loop;
|
||||
|
||||
Gnat.Sockets.Close_Selector(selector.all);
|
||||
Close_Socket (server);
|
||||
|
||||
Dispatcher.Stop;
|
||||
|
||||
Put_Line("end of server");
|
||||
end server;
|
||||
|
|
@ -0,0 +1,16 @@
|
|||
package body signals is
|
||||
protected body Sigint_Handler is
|
||||
|
||||
procedure selector(s: Selector_Access) is
|
||||
begin
|
||||
sel := s;
|
||||
end;
|
||||
|
||||
procedure Handle is
|
||||
begin
|
||||
Call_Count := Call_Count + 1;
|
||||
Put_Line("SIGINT handled");
|
||||
Gnat.Sockets.Abort_Selector(sel.all);
|
||||
end Handle;
|
||||
end Sigint_Handler;
|
||||
end signals;
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
with Ada.Interrupts; use Ada.Interrupts;
|
||||
with Ada.Interrupts.Names; use Ada.Interrupts.Names;
|
||||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Gnat.Sockets; use Gnat.Sockets;
|
||||
|
||||
package signals is
|
||||
|
||||
pragma Unreserve_All_Interrupts;
|
||||
|
||||
type Selector_Access is access all Gnat.Sockets.Selector_Type;
|
||||
|
||||
protected type Sigint_Handler is
|
||||
procedure selector(s: Selector_Access);
|
||||
procedure Handle;
|
||||
|
||||
pragma Interrupt_Handler(Handle);
|
||||
pragma Attach_Handler(Handle, Sigint);
|
||||
private
|
||||
Call_Count : Natural := 0;
|
||||
sel : Selector_Access;
|
||||
end Sigint_Handler;
|
||||
|
||||
end signals;
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
Ala ma kota
|
||||
adasdada
|
||||
asda
|
||||
d
|
||||
|
||||
Dada
|
||||
sd
|
||||
a
|
||||
d
|
||||
a
|
||||
da
|
||||
|
||||
taka
|
||||
Loading…
Reference in New Issue