--
--  Author: Brent Seidel
--  Date: 6-Aug-2024
--
--  This file is part of Simple Ada Web Server.
--  Simple Ada Web Server is free software: you can redistribute it and/or
--  modify it under the terms of the GNU General Public License as published
--  by the Free Software Foundation, either version 3 of the License, or (at
--  your option) any later version.
--
--  Simple Ada Web Server is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
--  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
--  more details.
--
--  You should have received a copy of the GNU General Public License along
--  with Simple Ada Web Server. If not, see <https://www.gnu.org/licenses/>.--
--
with Ada.Text_IO;
with Ada.Exceptions;
with BBS.web.files;
with BBS.web.http;
use type BBS.web.http.request_type;
package body bbs.web.server is
   package ASU renames Ada.Strings.Unbounded; -- not the school
   --
   --  This is the web server.  In initializes the network interface and enters
   --  an infinite loop processing requests.
   --
   procedure server(internals : proc_tables.Map;
                    config_name : String;
                    port : GNAT.Sockets.Port_Type) is
      local      : GNAT.Sockets.Sock_Addr_Type;
      sock_rx    : GNAT.Sockets.Socket_Type;  --  Socket for receiving requests
      sock_tx    : GNAT.Sockets.Socket_Type;  --  Socket for responding to requests
      handlers   : array (1 .. num_handlers) of request_handler;
      handler_index : Natural := 1;
      internal_map : constant proc_tables.Map := internals;
      directory  : dictionary.Map;
      handled    : Boolean;
      fail_count : Integer;
   begin
      --
      --  Do a bunch of initialization stuff.  We want to listen on any
      --  interface to the specified port.  The socket is IPv4 TCP/IP.
      --
      load_directory(config_name, directory);
      local.Addr := GNAT.Sockets.Any_Inet_Addr;
      local.Port := port;
      GNAT.Sockets.Create_Socket(sock_rx, GNAT.Sockets.Family_Inet,
                                 GNAT.Sockets.Socket_Stream);
      GNAT.Sockets.Set_Socket_Option(sock_rx, GNAT.Sockets.Socket_Level,
                                     (GNAT.Sockets.Reuse_Address, True));
      GNAT.Sockets.Bind_Socket(sock_rx, local);
      --
      --  Once the socket is configured.  Listen on it and accept a connection.
      --  once the connection is made, read from it and write back a response.
      --  Then close the sockets and exit.
      --
      GNAT.Sockets.Listen_Socket(sock_rx);
      while not exit_flag.get loop
         --
         --  Check if the configuration needs to be reloaded.
         --
         if reload_configuration.get then
            load_directory(config_name, directory);
            reload_configuration.clear;
         end if;
         --
         --  This call blocks until a connection request comes in.  Once a
         --  request comes, increment the counter of requests handled.
         --
         GNAT.Sockets.Accept_Socket(sock_rx, sock_tx, local);
         request_counter.increment;
         --
         --  Handlers contains a array of num_handlers tasks.  As requests come
         --  in, they are assigned to tasks in round-robin fashon.  If the next
         --  task is not ready to accept the job, the next task is tried.  This
         --  helps to prevent one slow task from blocking processing if other
         --  tasks are available.
         --
         --  The delay time can be tuned so that the loop waiting for an
         --  available task doesn't use up enough CPU time to prevent tasks
         --  from becoming available.  In most cases, this should not be an
         --  issue.
         --
         --  Note that a malicious user can still block processing by initiating
         --  num_handlers requests and just holding them open.
         --
         handled := False;
         fail_count := 0;
         while not handled loop
            if (debug.get) then
               Ada.Text_IO.Put_Line(Integer'Image(request_counter.read) &
                                      " requests serviced, " &
                                      Integer'Image(task_counter.read) &
                                      " active tasks.");
               Ada.Text_IO.Put_Line("Using server index " & Natural'Image(handler_index));
            end if;
            begin
               select
                  handlers(handler_index).start(sock_tx, internal_map, directory);
                  handled := True;
               or
                  delay 0.0;
               end select;
            exception
               when Tasking_Error =>
                  fail_count := fail_count + 1;
                  if fail_count > num_handlers then
                     web.exit_flag.set;
                     handled := True;
                     Ada.Text_IO.Put_Line("All tasks failed.  Exiting.");
                  end if;
                  Ada.Text_IO.Put_Line("Task " & Integer'Image(handler_index) &
                                         " is dead.  Trying the next one.");
            end;
            handler_index := handler_index + 1;
            if handler_index > num_handlers then
               handler_index := 1;
            end if;
         end loop;
      end loop;
      --
      --  Close the sockets and exit.  The outer loop exits when the exit_flag
      --  gets set.
      --
      GNAT.Sockets.Close_Socket(sock_rx);
      Ada.Text_IO.Put_Line("Done.");
         --
         --  Tell all the handler tasks to terminate.  The timed select is there
         --  just in case a task has already terminated.
         --
      for handler_index in handlers'Range loop
         begin
            select
               handlers(handler_index).end_task;
            or
               delay 2.0; -- Give each task 2 seconds to terminate.
            end select;
         exception
            when Tasking_Error =>
               Ada.Text_IO.Put_Line("Task " & Integer'Image(handler_index) &
                                      " is already terminated.");
         end;
      end loop;
   exception
      when err: others =>
         Ada.Text_IO.Put_Line("Exception occured in web server.");
         Ada.Text_IO.Put_Line(Ada.Exceptions.Exception_Information(err));
         --
         --  Tell all the handler tasks to terminate.  The timed select is there
         --  just in case a task has already terminated.
         --
         for handler_index in handlers'Range loop
            begin
               select
                  handlers(handler_index).end_task;
               or
                  delay 2.0; -- Give each task 2 seconds to terminate.
               end select;
            exception
               when Tasking_Error =>
                  Ada.Text_IO.Put_Line("Task " & Integer'Image(handler_index) &
                                         " is already terminated.");
            end;
         end loop;
         raise;
   end server;
   --
   --  Handle the details of the http request.  This is done as a task.  Once a
   --  network connection is made, the stream for that connection is handed off
   --  to a task which processes the request and then waits for the next one.
   --
   task body request_handler is
      internal_map : proc_tables.Map;
      directory : dictionary.Map;
      sock      : GNAT.Sockets.Socket_Type;
      item      : ASU.Unbounded_String;
      req       : BBS.web.http.request_type;
      headers   : params.Map;
      el        : element;
      param     : params.Map;
      s         : GNAT.Sockets.Stream_Access;
      exit_flag : Boolean := False;
   begin
      loop
         select
            accept start(socket : GNAT.Sockets.Socket_Type;
                         internals : proc_tables.Map;
                         dir : dictionary.Map) do
               sock := socket;
               internal_map := internals;
               directory := dir;
            end start;
         or
            accept end_task do
               exit_flag := true;
            end end_task;
         end select;
         exit when exit_flag;
         task_counter.increment;
         s := GNAT.Sockets.Stream(sock);
         --
         --  First read the HTTP headers.  These will need to be parsed to
         --  determine what is being requested.  Both GET and POST requests
         --  should be handled.  POST requests will need to be able to handle
         --  passed parameters so that forms can be processed.
         --
         begin
            BBS.web.http.read_headers(s, sock, req, item, headers, param, directory);
         exception
               --
               --  If the remote end of the socket is closed while reading the
               --  headers, a closed_by_peer exception is thrown
               --  and further processing is abandoned.  The handler sets the
               --  request type to bbs.http.Other which is not proceesed.  The
               --  normal cleanup is done and the task loops to wait for another
               --  request.
               --
            when closed_by_peer =>
               Ada.Text_IO.Put_Line("Socket unexpectedly closed.");
               req := BBS.web.http.Other;
         end;
         --
         --  Check the request type.  If the type is other than GET or POST, a
         --  response has already been sent.
         --
         case req is
            when BBS.web.http.GET =>
               --
               --  Check if the requested item is in the directory.
               --
               if directory.Contains(ASU.To_String(item)) then
                  el := directory.Element(ASU.To_String(item));
                  declare
                     name : constant String := ASU.To_String(el.file);
                     mime : constant String := ASU.To_String(el.mime);
                  begin
                     --
                     --  The following mime types should be supported:
                     --  * application/javascript
                     --  * application/pdf
                     --  * application/xml
                     --  * image/jpeg
                     --  * image/png
                     --  * image/svg+xml
                     --  * text/css
                     --  * text/html
                     --  * text/plain
                     --
                     --  Note that a pseudo type "internal" is also supported.
                     --  This indicates that the item is procedurally generated
                     --  and the procedure will be responsible for generating
                     --  the proper types.  Dispatch to the proper procedure
                     --  will be done based on the requested item.
                     --
                     if (mime = "text/html") or (mime = "text/plain") or
                       (mime = "text/css") or (mime = "application/javascript") or
                       (mime = "application/xml") or (mime = "image/svg+xml") then
                        --
                        --  Send an text type file with the proper mime type.
                        --
                        BBS.web.files.send_text_with_headers(s, mime, name);
                     elsif (mime = "image/jpeg") or (mime = "image/png") or
                       (mime = "application/pdf") then
                        --
                        --  Send a binary file with the proper mime type.
                        --
                        BBS.web.files.send_binary_with_headers(s, mime, name);
                     elsif mime = "internal" then
                        if internal_map.Contains(name) then
                           internal_map.Element(name)(s, headers, param);
                        end if;
                     else
                        --
                        --  If the mime type is unrecognized, it is an internal
                        --  error.
                        --
                        BBS.web.http.internal_error(s, mime);
                     end if;
                  end;
               else
                  BBS.web.http.not_found(s, ASU.To_String(item));
               end if;
            when BBS.web.http.POST =>
               --
               --  POST requests will only work on internal type files.
               --
               --  Check if the requested item is in the directory.
               --
               if directory.Contains(ASU.To_String(item)) then
                  el := directory.Element(ASU.To_String(item));
                  declare
                     name : constant String := ASU.To_String(el.file);
                     mime : constant String := ASU.To_String(el.mime);
                  begin
                     if mime = "internal" then
                        if internal_map.Contains(name) then
                          internal_map.Element(name)(s, headers, param);
                        end if;
                     else
                        --
                        --  If the mime type is unrecognized, it is an internal
                        --  error.
                        --
                        BBS.web.http.internal_error(s, mime);
                     end if;
                  end;
               else
                  BBS.web.http.not_found(s, ASU.To_String(item));
               end if;
            when others => -- Handled in HTTP package
               null;
         end case;
         --
         --  Close the session socket
         --
         GNAT.Sockets.Close_Socket(sock);
         task_counter.decrement;
      end loop;
   end request_handler;

end bbs.web.server;
