diff --git a/2014/2014_08/ada_http_server/#signals.adb# b/2014/2014_08/ada_http_server/#signals.adb# new file mode 100644 index 0000000..3dd6ab1 --- /dev/null +++ b/2014/2014_08/ada_http_server/#signals.adb# @@ -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; diff --git a/2014/2014_08/ada_http_server/#test.txt# b/2014/2014_08/ada_http_server/#test.txt# new file mode 100644 index 0000000..08a200e --- /dev/null +++ b/2014/2014_08/ada_http_server/#test.txt# @@ -0,0 +1,13 @@ +Ala ma kota +adasdada +asda +d + +Dada +sd +a +d +a +da + +takaotootootootgf diff --git a/2014/2014_08/ada_http_server/constants.ads b/2014/2014_08/ada_http_server/constants.ads new file mode 100644 index 0000000..1be98f1 --- /dev/null +++ b/2014/2014_08/ada_http_server/constants.ads @@ -0,0 +1,7 @@ +package constants is + + cr : Character := Character'Val(13); + lf : Character := Character'Val(10); + newline: String := (cr, lf); + +end constants; diff --git a/2014/2014_08/ada_http_server/dispatchers.adb b/2014/2014_08/ada_http_server/dispatchers.adb new file mode 100644 index 0000000..73e2f7a --- /dev/null +++ b/2014/2014_08/ada_http_server/dispatchers.adb @@ -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; diff --git a/2014/2014_08/ada_http_server/dispatchers.ads b/2014/2014_08/ada_http_server/dispatchers.ads new file mode 100644 index 0000000..0c96b72 --- /dev/null +++ b/2014/2014_08/ada_http_server/dispatchers.ads @@ -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; diff --git a/2014/2014_08/ada_http_server/handlers.adb b/2014/2014_08/ada_http_server/handlers.adb new file mode 100644 index 0000000..ddc8f77 --- /dev/null +++ b/2014/2014_08/ada_http_server/handlers.adb @@ -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, "" & + "directory" & 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, "" & + "404 Error"); + 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; diff --git a/2014/2014_08/ada_http_server/handlers.ads b/2014/2014_08/ada_http_server/handlers.ads new file mode 100644 index 0000000..d3d7200 --- /dev/null +++ b/2014/2014_08/ada_http_server/handlers.ads @@ -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; diff --git a/2014/2014_08/ada_http_server/server b/2014/2014_08/ada_http_server/server new file mode 100644 index 0000000..e9f2016 Binary files /dev/null and b/2014/2014_08/ada_http_server/server differ diff --git a/2014/2014_08/ada_http_server/server.adb b/2014/2014_08/ada_http_server/server.adb new file mode 100644 index 0000000..7c95dab --- /dev/null +++ b/2014/2014_08/ada_http_server/server.adb @@ -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; diff --git a/2014/2014_08/ada_http_server/signals.adb b/2014/2014_08/ada_http_server/signals.adb new file mode 100644 index 0000000..d172195 --- /dev/null +++ b/2014/2014_08/ada_http_server/signals.adb @@ -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; diff --git a/2014/2014_08/ada_http_server/signals.ads b/2014/2014_08/ada_http_server/signals.ads new file mode 100644 index 0000000..32d68d3 --- /dev/null +++ b/2014/2014_08/ada_http_server/signals.ads @@ -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; diff --git a/2014/2014_08/ada_http_server/test.txt b/2014/2014_08/ada_http_server/test.txt new file mode 100644 index 0000000..292524c --- /dev/null +++ b/2014/2014_08/ada_http_server/test.txt @@ -0,0 +1,13 @@ +Ala ma kota +adasdada +asda +d + +Dada +sd +a +d +a +da + +taka