tomasz
/
code-examples
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Old Ada http server.

master
Tomasz Polgrabia 2025-03-09 12:23:51 +01:00
parent c019a5a884
commit 4a9d20f1ee
12 changed files with 532 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
2014/2014_08/ada_http_server/#signals.adb# Normal file
View File

@ -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;

13
2014/2014_08/ada_http_server/#test.txt# Normal file
View File

@ -0,0 +1,13 @@
Ala ma kota
adasdada
asda
d
Dada
sd
a
d
a
da
takaotootootootgf

7
2014/2014_08/ada_http_server/constants.ads Normal file
View File

@ -0,0 +1,7 @@
package constants is
cr : Character := Character'Val(13);
lf : Character := Character'Val(10);
newline: String := (cr, lf);
end constants;

75
2014/2014_08/ada_http_server/dispatchers.adb Normal file
View File

@ -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;

17
2014/2014_08/ada_http_server/dispatchers.ads Normal file
View File

@ -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;

247
2014/2014_08/ada_http_server/handlers.adb Normal file
View File

@ -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;

37
2014/2014_08/ada_http_server/handlers.ads Normal file
View File

@ -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;

BIN
2014/2014_08/ada_http_server/server Normal file
View File

Binary file not shown.

67
2014/2014_08/ada_http_server/server.adb Normal file
View File

@ -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;

16
2014/2014_08/ada_http_server/signals.adb Normal file
View File

@ -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;

23
2014/2014_08/ada_http_server/signals.ads Normal file
View File

@ -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;

13
2014/2014_08/ada_http_server/test.txt Normal file
View File

@ -0,0 +1,13 @@
Ala ma kota
adasdada
asda
d
Dada
sd
a
d
a
da
taka