with
  Ada.Characters.Latin_1,
  Ada.Command_Line,
  Ada.Streams,
  Ada.Strings.Fixed,
  Ada.Strings.Maps,
  Ada.Strings.Unbounded,
  Ada.Text_IO,
  Interfaces.C,
  POSIX.File_Status,
  POSIX.Files,
  POSIX.IO,
  POSIX.Process_Primitives,
  POSIX.Unsafe_Process_Primitives;

with
  EUP.Sockets,
  Fork,
  GNAT.Sockets,
  GNAT.Sockets.Compatibility,
  Search_And_Replace,
  Stream_Shortcuts;

procedure Minimal_Web_Server is
   package Unbounded renames Ada.Strings.Unbounded;
   package Latin_1   renames Ada.Characters.Latin_1;

   New_Line   : constant String := Latin_1.CR & Latin_1.LF;
   Whitespace : constant Ada.Strings.Maps.Character_Set :=
                  Ada.Strings.Maps.To_Set (Latin_1.HT & " ");

   procedure Extract_First_Non_Whitespace_Slice
     (Source  : in out Unbounded.Unbounded_String;
      Extract :    out Unbounded.Unbounded_String) is
      package Sets renames Ada.Strings.Maps;
      Index : Natural := 0;
   begin
      loop
         exit when Index + 1 > Unbounded.Length (Source);
         exit when
           not Sets.Is_In (Element => Unbounded.Element (Source, Index + 1),
                           Set     => Whitespace);
         Index := Index + 1;
      end loop;

      Unbounded.Delete (Source  => Source,
                        From    => 1,
                        Through => Index);

      loop
         exit when Index + 1 > Unbounded.Length (Source);
         exit when
           Sets.Is_In (Element => Unbounded.Element (Source, Index + 1),
                       Set     => Whitespace);
         Index := Index + 1;
      end loop;

      Extract :=
        Unbounded.To_Unbounded_String (Unbounded.Slice  (Source => Source,
                                                         Low    => 1,
                                                         High   => Index));

      Unbounded.Delete (Source  => Source,
                        From    => 1,
                        Through => Index);
   end Extract_First_Non_Whitespace_Slice;

   function "=" (Left  : in Unbounded.Unbounded_String;
                 Right : in String) return Boolean is
   begin
      return Unbounded.To_String (Left) = Right;
   end "=";

   function Header (Content_Type : String := "text/html; charset=iso-8859-1")
                   return String is
   begin
      return
        "HTTP/1.0 200 OK" & New_Line &
        "Content-type: " & Content_Type & New_Line &
        New_Line;
   end Header;

   procedure Cannot_Do
     (Connection : access Ada.Streams.Root_Stream_Type'Class) is
   begin
      Stream_Shortcuts.Put
        (Target => Connection,
         Item   =>
           "HTTP/1.0 501 Not implemented." & New_Line &
           "Content-type: text/plain; charset=iso-8859-1" & New_Line &
           New_Line &
           "We've only implemented GET." & New_Line);
   end Cannot_Do;

   procedure Do_404
     (Argument   : in     Unbounded.Unbounded_String;
      Connection : access Ada.Streams.Root_Stream_Type'Class) is
   begin
      Stream_Shortcuts.Put
        (Target => Connection,
         Item   =>
           "HTTP/1.0 404 Not found" & New_Line &
           "Content-type: text/plain; charset=iso-8859-1" & New_Line &
           New_Line &
           "The requested item (" & Unbounded.To_String (Argument) &
           ") is not available." & New_Line);
   end Do_404;

   function Exists (File_Name : in     Unbounded.Unbounded_String)
                   return Boolean is
   begin
      return POSIX.Files.Is_File_Present
        (Pathname => POSIX.To_POSIX_String (Unbounded.To_String (File_Name)));
   exception
      when others =>
         return False;
   end Exists;

   function Is_A_Directory (Item : in     Unbounded.Unbounded_String)
                           return Boolean is
   begin
      return POSIX.File_Status.Is_Directory
        (File_Status => POSIX.File_Status.Get_File_Status
           (Pathname => POSIX.To_POSIX_String (Unbounded.To_String (Item))));
   exception
      when others =>
         return False;
   end Is_A_Directory;

   procedure Do_Ls (Directory_Name : in     Unbounded.Unbounded_String;
                    Connection     : in     POSIX.IO.File_Descriptor) is
      use type POSIX.IO.File_Descriptor;
      Directory : constant POSIX.POSIX_String := POSIX.To_POSIX_String
                    (Unbounded.To_String (Directory_Name));
      Written   : POSIX.IO_Count;
      Arguments : POSIX.POSIX_String_List;
   begin
      POSIX.IO.Write
        (File   => Connection,
         Buffer => POSIX.To_POSIX_String
           (Header (Content_Type => "text/plain; charset=iso-8859-1")),
         Last   => Written);

      if POSIX.IO.Duplicate_And_Close (File   => Connection,
                                       Target => POSIX.IO.Standard_Output) /=
        POSIX.IO.Standard_Output then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      if POSIX.IO.Duplicate_And_Close (File   => Connection,
                                       Target => POSIX.IO.Standard_Error) /=
        POSIX.IO.Standard_Error then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      POSIX.IO.Close (File => Connection);

      POSIX.Append (List => Arguments, Str  => "ls");
      POSIX.Append (List => Arguments, Str  => "-l");
      POSIX.Append (List => Arguments, Str  => Directory);
      POSIX.Unsafe_Process_Primitives.Exec (Pathname => "/bin/ls",
                                            Arg_List => Arguments);
      POSIX.Process_Primitives.Exit_Process (Status => 1);
   end Do_Ls;

   function Extension (File_Name : in Unbounded.Unbounded_String)
                      return String is
      Separator : Natural := Unbounded.Length (File_Name);
   begin
      loop
         exit when Separator = 0;
         exit when Unbounded.Element (File_Name, Separator) = '.';
         Separator := Separator - 1;
      end loop;

      return Unbounded.Slice (Source => File_Name,
                              Low    => Separator + 1,
                              High   => Unbounded.Length (File_Name));
   end Extension;

   procedure Sanitize (Argument : in out Unbounded.Unbounded_String) is
      Default_S : constant String := "/tmp/";
      Default_U : constant Unbounded.Unbounded_String :=
        Unbounded.To_Unbounded_String (Default_S);
      Index : Natural := 0;
   begin
      Unbounded.Insert (Source   => Argument,
                        Before   => 1,
                        New_Item => Default_S);

      while Index < Unbounded.Length (Argument) loop
         Index := Index + 1;
         case Unbounded.Element (Argument, Index) is
            when '+' =>
               Unbounded.Replace_Element (Source => Argument,
                                          Index  => Index,
                                          By     => ' ');
            when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9'
              | '/' | '-' | '_' | '.' =>
               null;
            when others =>
               Unbounded.Delete (Source  => Argument,
                                 From    => Index,
                                 Through => Index);
               Index := Index - 1;
         end case;
      end loop;

      Search_And_Replace (Source     => Argument,
                          Pattern    => "/./",
                          By         => "/");
      Search_And_Replace (Source     => Argument,
                          Pattern    => "//",
                          By         => "/");

      for Index in 1 .. Unbounded.Length (Argument) - 1 loop
         if Unbounded.Slice (Source => Argument,
                             Low    => Index,
                             High   => Index + 1) = ".." then
            Argument := Default_U;
            return;
         end if;
      end loop;
   end Sanitize;

   procedure Do_CGI
     (CGI_Program     : in     Unbounded.Unbounded_String;
      Connection      : access Ada.Streams.Root_Stream_Type'Class;
      File_Descriptor : in     POSIX.IO.File_Descriptor) is
      use type POSIX.IO.File_Descriptor;
      Arguments : POSIX.POSIX_String_List;
   begin
      Stream_Shortcuts.Put (Target => Connection,
                            Item   => "HTTP/1.0 200 OK" & New_Line);

      if POSIX.IO.Duplicate_And_Close (File   => File_Descriptor,
                                       Target => POSIX.IO.Standard_Output) /=
        POSIX.IO.Standard_Output then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      if POSIX.IO.Duplicate_And_Close (File   => File_Descriptor,
                                       Target => POSIX.IO.Standard_Error) /=
        POSIX.IO.Standard_Error then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      POSIX.IO.Close (File => File_Descriptor);

      declare
         Program : constant POSIX.POSIX_String :=
           POSIX.To_POSIX_String (Unbounded.To_String (CGI_Program));
      begin
         POSIX.Append (List => Arguments,
                       Str  => Program);
         POSIX.Unsafe_Process_Primitives.Exec (Pathname => Program,
                                               Arg_List => Arguments);
         POSIX.Process_Primitives.Exit_Process (Status => 1);
      end;
   end Do_CGI;

   procedure Do_Cat
     (File_Name       : in     Unbounded.Unbounded_String;
      Connection      : access Ada.Streams.Root_Stream_Type'Class;
      File_Descriptor : in     POSIX.IO.File_Descriptor) is
      use type POSIX.IO.File_Descriptor;
      Type_Code : constant String := Extension (File_Name);
      Arguments : POSIX.POSIX_String_List;
   begin
      if Type_Code = "html" then
         Stream_Shortcuts.Put
           (Target => Connection,
            Item   => Header (Content_Type =>
                                "text/html; charset=iso-8859-1"));
      elsif Type_Code = "png" then
         Stream_Shortcuts.Put
           (Target => Connection,
            Item   => Header (Content_Type => "image/png"));
      elsif Type_Code = "jpeg" then
         Stream_Shortcuts.Put
           (Target => Connection,
            Item   => Header (Content_Type => "image/jpeg"));
      elsif Type_Code = "pdf" then
         Stream_Shortcuts.Put
           (Target => Connection,
            Item   => Header (Content_Type => "application/pdf"));
      else
         Stream_Shortcuts.Put
           (Target => Connection,
            Item   => Header (Content_Type =>
                                "text/plain; charset=iso-8859-1"));
      end if;

      if POSIX.IO.Duplicate_And_Close (File   => File_Descriptor,
                                       Target => POSIX.IO.Standard_Output) /=
        POSIX.IO.Standard_Output then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      if POSIX.IO.Duplicate_And_Close (File   => File_Descriptor,
                                       Target => POSIX.IO.Standard_Error) /=
        POSIX.IO.Standard_Error then
         POSIX.Process_Primitives.Exit_Process (Status => 2);
      end if;
      POSIX.IO.Close (File => File_Descriptor);

      POSIX.Append (List => Arguments,
                    Str  => "cat");
      POSIX.Append (List => Arguments,
                    Str  => POSIX.To_POSIX_String (Unbounded.To_String
                                                   (File_Name)));
      POSIX.Unsafe_Process_Primitives.Exec (Pathname => "/bin/cat",
                                            Arg_List => Arguments);
      POSIX.Process_Primitives.Exit_Process (Status => 1);
   end Do_Cat;

   procedure Process
     (Request         : in     Unbounded.Unbounded_String;
      Connection      : access Ada.Streams.Root_Stream_Type'Class;
      File_Descriptor : in     POSIX.IO.File_Descriptor) is
      use type Interfaces.C.int;
      Request_Copy, Command, Argument : Unbounded.Unbounded_String;
   begin
      if Fork = 0 then
         Request_Copy := Request;
         Extract_First_Non_Whitespace_Slice (Source  => Request_Copy,
                                             Extract => Command);
         Extract_First_Non_Whitespace_Slice (Source  => Request_Copy,
                                             Extract => Argument);
         Sanitize (Argument);

         if Command /= "GET" then
            Cannot_Do (Connection => Connection);
         elsif not Exists (File_Name => Argument) then
            Do_404 (Argument   => Argument,
                    Connection => Connection);
         elsif Is_A_Directory (Argument) then
            Do_Ls (Directory_Name => Argument,
                   Connection     => File_Descriptor);
         elsif Extension (Argument) = "cgi" then
            Do_CGI (CGI_Program     => Argument,
                    Connection      => Connection,
                    File_Descriptor => File_descriptor);
         else
            Do_Cat (File_Name       => Argument,
                    Connection      => Connection,
                    File_Descriptor => File_descriptor);
         end if;
      end if;
   end Process;

   Server, Connection : GNAT.Sockets.Socket_Type;
   Client             : GNAT.Sockets.Sock_Addr_Type;
   Channel            : GNAT.Sockets.Stream_Access;
   File               : POSIX.IO.File_Descriptor;
   HTTP_Request       : Unbounded.Unbounded_String;
begin
   if Ada.Command_Line.Argument_Count = 1 then
      Server := EUP.Sockets.Make_Server
                  (Port => GNAT.Sockets.Port_Type'Value
                             (Ada.Command_Line.Argument (1)));
      loop
         GNAT.Sockets.Accept_Socket (Server  => Server,
                                     Socket  => Connection,
                                     Address => Client);
         Channel := GNAT.Sockets.Stream (Socket => Connection);
         File := GNAT.Sockets.Compatibility.Posix_File_Descriptor (Connection);

         HTTP_Request := Stream_Shortcuts.Get_Line (Source => Channel);
         Stream_Shortcuts.Skip_Until_Empty_Line (Source => Channel);

         Process (Request         => HTTP_Request,
                  Connection      => Channel,
                  File_Descriptor => File);

         GNAT.Sockets.Close_Socket (Socket => Connection);
      end loop;
   else
      Ada.Text_IO.Put_Line
        (File => Ada.Text_IO.Standard_Error,
         Item => "Usage: " & Ada.Command_Line.Command_Name & " port_number");
      Ada.Command_Line.Set_Exit_Status (Code => Ada.Command_Line.Failure);
   end if;
end Minimal_Web_Server;