File : aws-server-protocol_handler.adb


------------------------------------------------------------------------------

--                              Ada Web Server                              --

--                                                                          --

--                         Copyright (C) 2000-2003                          --

--                                ACT-Europe                                --

--                                                                          --

--  Authors: Dmitriy Anisimkov - Pascal Obry                                --

--                                                                          --

--  This library 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 2 of the License, or (at   --

--  your option) any later version.                                         --

--                                                                          --

--  This library 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 this library; if not, write to the Free Software Foundation, --

--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --

--                                                                          --

--  As a special exception, if other files instantiate generics from this   --

--  unit, or you link this unit with other files to produce an executable,  --

--  this  unit  does not  by itself cause  the resulting executable to be   --

--  covered by the GNU General Public License. This exception does not      --

--  however invalidate any other reasons why the executable file  might be  --

--  covered by the  GNU Public License.                                     --

------------------------------------------------------------------------------


--  $RCSfile: aws-server-protocol_handler.adb,v $

--  $Revision: 1.1 $

--  $Date: 2003/10/05 19:59:59 $

--  $Author: Jano $


--  This procedure is responsible of handling the HTTP protocol. Every

--  responses and coming requests are parsed/formated here.


with Ada.Characters.Handling;
with Ada.Streams.Stream_IO;
with Ada.Strings.Fixed;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;

with AWS.Config;
with AWS.Headers.Values;
with AWS.Log;
with AWS.Messages;
with AWS.MIME;
with AWS.Net.Buffered;
with AWS.OS_Lib;
with AWS.Parameters.Set;
with AWS.Resources;
with AWS.Session;
with AWS.Server.Get_Status;
with AWS.Status.Set;
with AWS.Templates;
with AWS.Translator;
with AWS.Utils;
with AWS.URL;

separate (AWS.Server)

procedure Protocol_Handler
  (HTTP_Server : in out HTTP;
   Index       : in     Positive)
is

   use Ada;
   use Ada.Strings;
   use Ada.Strings.Unbounded;

   Case_Sensitive_Parameters : constant Boolean
     := CNF.Case_Sensitive_Parameters (HTTP_Server.Properties);

   Admin_URI      : constant String
     := CNF.Admin_URI (HTTP_Server.Properties);

   HTTP_10        : constant String := "HTTP/1.0";

   C_Stat         : AWS.Status.Data;     -- Connection status


   P_List         : AWS.Parameters.List; -- Form data


   Sock_Ptr       : constant Socket_Access
     := HTTP_Server.Slots.Get (Index => Index).Sock;

   Sock           : Net.Socket_Type'Class renames Sock_Ptr.all;

   Socket_Taken   : Boolean := False;
   --  Set to True if a socket has been reserved for a push session.


   Will_Close     : Boolean := True;
   --  Will_Close is set to true when the connection will be closed by the

   --  server. It means that the server is about to send the latest message

   --  to the client using this socket. The value will be changed by

   --  Set_Close_Status.


   Data_Sent      : Boolean := False;
   --  Will be set to true when some data will have been sent back to the

   --  client. At this point it is not possible to send an unexpected

   --  exception message to the client. The only option in case of problems is

   --  to close the connection.


   --  Duplication of some status fields for faster access


   Status_Connection         : Unbounded_String;
   Status_Multipart_Boundary : Unbounded_String;
   Status_Content_Type       : Unbounded_String;

   procedure Send_Resource
     (Method : in     Status.Request_Method;
      File   : in out Resources.File_Type;
      Length : in out Response.Content_Length_Type);
   --  Send the last header line Transfer-Encoding and Content_Length if

   --  necessary and send the file content. Length is the size of the

   --  resource/file as known before the call, Length returned value is the

   --  actual number of bytes sent.


   procedure Answer_To_Client;
   --  This procedure use the C_Stat status data to build the correct answer

   --  to the client. If Force_Answer is not Empty it will be sent back to the

   --  client's browser, otherwise the answer will be retreived from user's

   --  callback.


   procedure Send (Answer : in Response.Data);
   --  Send Answer to the client's browser


   procedure Get_Message_Header;
   --  Parse HTTP message header. This procedure fill in the C_Stat status

   --  data.


   procedure Get_Message_Data;
   --  If the client sent us some data read them. Right now only the

   --  POST method is handled. This procedure fill in the C_Stat status

   --  data.


   procedure Parse_Request_Line (Command : in String);
   --  Parse the request line:

   --  Request-Line = Method SP Request-URI SP HTTP-Version CRLF


   function Is_Valid_HTTP_Date (HTTP_Date : in String) return Boolean;
   --  Check the date format as some Web brower seems to return invalid date

   --  field.


   procedure Set_Close_Status;
   --  Set Will_Close properly depending on the HTTP version and current

   --  request status. This routine must be called after Get_Message_header as

   --  the request header must have been parsed.


   ----------------------

   -- Answer_To_Client --

   ----------------------


   procedure Answer_To_Client is
      use type Messages.Status_Code;

      Answer : Response.Data;

      procedure Build_Answer;
      --  Build the Answer that should be sent to the client's browser


      procedure Create_Session;
      --  Create a session if needed


      procedure Answer_File (File_Name : in String);
      --  Assign File to Answer response data


      -----------------

      -- Answer_File --

      -----------------


      procedure Answer_File (File_Name : in String) is
      begin
         Answer := Response.File
           (Content_Type => MIME.Content_Type (File_Name),
            Filename     => File_Name);
      end Answer_File;

      ------------------

      -- Build_Answer --

      ------------------


      procedure Build_Answer is
         URL : constant AWS.URL.Object := AWS.Status.URI (C_Stat);
         URI : constant String         := AWS.URL.URL (URL);
      begin
         --  Check if the status page, status page logo or status page images

         --  are requested. These are AWS internal data that should not be

         --  handled by AWS users.


         --  AWS Internal status page handling.


         if Admin_URI'Length > 0
              and then
           URI'Length >= Admin_URI'Length
              and then
           URI (URI'First .. URI'First + Admin_URI'Length - 1) = Admin_URI
         then

            if URI = Admin_URI then

               --  Status page

               begin
                  Answer := Response.Build
                    (Content_Type => MIME.Text_HTML,
                     Message_Body => Get_Status (HTTP_Server));
               exception
                  when Templates.Template_Error =>
                     Answer := Response.Build
                       (Content_Type => MIME.Text_HTML,
                        Message_Body =>
                          "Status template error. Please check "
                          & "that '" & CNF.Status_Page (HTTP_Server.Properties)
                          & "' file is valid.");
               end;

            elsif URI = Admin_URI & "-logo" then
               --  Status page logo

               Answer_File (CNF.Logo_Image (HTTP_Server.Properties));

            elsif URI = Admin_URI & "-uparr" then
               --  Status page hotplug up-arrow

               Answer_File (CNF.Up_Image (HTTP_Server.Properties));

            elsif URI = Admin_URI & "-downarr" then
               --  Status page hotplug down-arrow

               Answer_File (CNF.Down_Image (HTTP_Server.Properties));

            elsif URI = Admin_URI & "-HPup" then
               --  Status page hotplug up message

               Hotplug.Move_Up
                 (HTTP_Server.Filters,
                  Positive'Value (AWS.Parameters.Get (P_List, "N")));
               Answer := Response.URL (Admin_URI);

            elsif URI = Admin_URI & "-HPdown" then
               --  Status page hotplug down message

               Hotplug.Move_Down
                 (HTTP_Server.Filters,
                  Positive'Value (AWS.Parameters.Get (P_List, "N")));
               Answer := Response.URL (Admin_URI);

            else
               Answer := Response.Build
                 (Content_Type => MIME.Text_HTML,
                  Message_Body =>
                    "Invalid use of reserved status URI prefix: " & Admin_URI);
            end if;

            --  End of Internal status page handling.


            --  Check if the URL is trying to reference resource above Web root

            --  directory.


         elsif CNF.Check_URL_Validity (HTTP_Server.Properties)
           and then not AWS.URL.Is_Valid (URL)
         then
            --  403 status code "Forbidden".


            Answer := Response.Build
              (Status_Code   => Messages.S403,
               Content_Type  => "text/plain",
               Message_Body  => "Request " & URI & ASCII.LF
                 & " trying to reach resource above the Web root directory.");

         else
            --  Otherwise, check if a session needs to be created


            Create_Session;

            --  and get answer from client callback


            declare
               Found : Boolean;
            begin
               HTTP_Server.Slots.Mark_Phase (Index, Server_Processing);

               --  Check the hotplug filters


               Hotplug.Apply (HTTP_Server.Filters, C_Stat, Found, Answer);

               --  If no one applied, run the user callback


               if not Found then
                  AWS.Status.Set.Socket (C_Stat, Sock_Ptr);

                  HTTP_Server.Dispatcher_Sem.Read;

                  --  Be sure to always release the read semaphore


                  begin
                     Answer := Dispatchers.Dispatch
                       (HTTP_Server.Dispatcher.all, C_Stat);

                     HTTP_Server.Dispatcher_Sem.Release_Read;
                  exception
                     when others =>
                        HTTP_Server.Dispatcher_Sem.Release_Read;
                        raise;
                  end;

               end if;

               HTTP_Server.Slots.Mark_Phase (Index, Server_Response);
            end;
         end if;
      end Build_Answer;

      --------------------

      -- Create_Session --

      --------------------


      procedure Create_Session is
         use type Session.ID;
      begin
         if CNF.Session (HTTP_Server.Properties)
           and then (AWS.Status.Session (C_Stat) = Session.No_Session
                     or else not Session.Exist (AWS.Status.Session (C_Stat)))
         then
            --  Generate the session ID

            AWS.Status.Set.Session (C_Stat);
         end if;
      end Create_Session;

   begin
      --  Set status peername


      AWS.Status.Set.Peername
        (C_Stat, HTTP_Server.Slots.Get_Peername (Index));

      Build_Answer;

      Send (Answer);
   end Answer_To_Client;

   ----------------------

   -- Get_Message_Data --

   ----------------------


   procedure Get_Message_Data is

      use type Status.Request_Method;

      Multipart_Boundary : constant String
        := To_String (Status_Multipart_Boundary);

      procedure File_Upload
        (Start_Boundary, End_Boundary : in String;
         Parse_Boundary               : in Boolean);
      --  Handle file upload data coming from the client browser.


      function Value_For (Name : in String; Into : in String) return String;
      --  Returns the value for the variable named "Name" into the string

      --  "Into". The data format is: name1="value2"; name2="value2"...


      -----------------

      -- File_Upload --

      -----------------


      procedure File_Upload
        (Start_Boundary, End_Boundary : in String;
         Parse_Boundary               : in Boolean)
      is
         Name            : Unbounded_String;
         Filename        : Unbounded_String;
         Server_Filename : Unbounded_String;
         Content_Type    : Unbounded_String;
         File            : Streams.Stream_IO.File_Type;
         Is_File_Upload  : Boolean;

         End_Found       : Boolean := False;
         --  Set to true when the end-boundary has been found.


         type Error_State is (No_Error, Name_Error, Device_Error);
         --  This state is to monitor the file upload process. If we receice

         --  Name_Error or Device_Error while writing data on disk we need to

         --  continue reading all data from the socket if we want to be able

         --  to send back an error message.


         Error : Error_State := No_Error;

         procedure Get_File_Data;
         --  Read file data from the stream, set End_Found if the end-boundary

         --  signature has been read.


         function Target_Filename (Filename : in String) return String;
         --  Returns the full path name for the file as stored on the

         --  server side.


         --------------

         -- Get_Data --

         --------------


         procedure Get_File_Data is

            use type Streams.Stream_Element;
            use type Streams.Stream_Element_Offset;
            use type Streams.Stream_Element_Array;

            function Check_EOF return Boolean;
            --  Returns True if we have reach the end of file data


            procedure Write (Buffer : in Streams.Stream_Element_Array);
            pragma Inline (Write);
            --  Write buffer to the file, handle the Device_Error exception


            Buffer : Streams.Stream_Element_Array (1 .. 4096);
            Index  : Streams.Stream_Element_Offset := Buffer'First;

            Data   : Streams.Stream_Element_Array (1 .. 1);

            ---------------

            -- Check_EOF --

            ---------------


            function Check_EOF return Boolean is

               Signature : constant Streams.Stream_Element_Array
                 := (1 => 13, 2 => 10)
                    & Translator.To_Stream_Element_Array (Start_Boundary);

               Buffer : Streams.Stream_Element_Array (1 .. Signature'Length);
               Index  : Streams.Stream_Element_Offset := Buffer'First;

               procedure Write_Data;
               --  Put buffer data into the main buffer (Get_Data.Buffer). If

               --  the main buffer is not big enough, it will write the buffer

               --  into the file bdefore.


               ----------------

               -- Write_Data --

               ----------------


               procedure Write_Data is
               begin
                  if Error /= No_Error then
                     return;
                  end if;

                  if Get_File_Data.Buffer'Last
                    < Get_File_Data.Index + Index - 1
                  then
                     Write (Get_File_Data.Buffer
                              (Get_File_Data.Buffer'First
                                 .. Get_File_Data.Index - 1));
                     Get_File_Data.Index := Get_File_Data.Buffer'First;
                  end if;

                  Get_File_Data.Buffer
                    (Get_File_Data.Index .. Get_File_Data.Index + Index - 2)
                    := Buffer (Buffer'First .. Index - 1);

                  Get_File_Data.Index := Get_File_Data.Index + Index - 1;
               end Write_Data;

            begin
               Buffer (Index) := 13;
               Index := Index + 1;

               loop
                  Net.Buffered.Read (Sock, Data);

                  if Data (1) = 13 then
                     Write_Data;
                     return False;
                  end if;

                  Buffer (Index) := Data (1);

                  if Index = Buffer'Last then
                     if Buffer = Signature then
                        return True;
                     else
                        Write_Data;
                        return False;
                     end if;
                  end if;

                  Index := Index + 1;

               end loop;
            end Check_EOF;

            -----------

            -- Write --

            -----------


            procedure Write (Buffer : in Streams.Stream_Element_Array) is
            begin
               if Error = No_Error then
                  Streams.Stream_IO.Write (File, Buffer);
               end if;
            exception
               when Text_IO.Device_Error =>
                  Error := Device_Error;
            end Write;

         begin
            begin
               Streams.Stream_IO.Create
                 (File,
                  Streams.Stream_IO.Out_File,
                  To_String (Server_Filename));
            exception
               when Text_IO.Name_Error =>
                  Error := Name_Error;
            end;

            Read_File : loop
               Net.Buffered.Read (Sock, Data);

               while Data (1) = 13 loop
                  exit Read_File when Check_EOF;
               end loop;

               Buffer (Index) := Data (1);
               Index := Index + 1;

               if Index > Buffer'Last then
                  Write (Buffer);
                  Index := Buffer'First;

                  HTTP_Server.Slots.Mark_Data_Time_Stamp
                    (Protocol_Handler.Index);
               end if;
            end loop Read_File;

            if Index /= Buffer'First then
               Write (Buffer (Buffer'First .. Index - 1));
            end if;

            if Error = No_Error then
               Streams.Stream_IO.Close (File);
            end if;

            --  Check for end-boundary, at this point we have at least two

            --  chars. Either the terminating "--" or CR+LF.


            Net.Buffered.Read (Sock, Data);
            Net.Buffered.Read (Sock, Data);

            if Data (1) = 10 then
               --  We have CR+LF, it is a start-boundary

               End_Found := False;

            else
               --  We have read the "--", read line terminator. This is the

               --  end-boundary.


               End_Found := True;
               Net.Buffered.Read (Sock, Data);
               Net.Buffered.Read (Sock, Data);
            end if;

            if Error = Name_Error then
               --  We can't create the file, add a clear exception message

               Ada.Exceptions.Raise_Exception
                 (Text_IO.Name_Error'Identity,
                  "Cannot create file " & To_String (Server_Filename));

            elsif Error = Device_Error then
               --  We can't write to the file, there is probably no space left

               --  on devide.

               Ada.Exceptions.Raise_Exception
                 (Text_IO.Device_Error'Identity,
                  "No space left on device while writting "
                    & To_String (Server_Filename));
            end if;
         end Get_File_Data;

         ---------------------

         -- Target_Filename --

         ---------------------


         function Target_Filename (Filename : in String) return String is
            I           : constant Natural
              := Fixed.Index (Filename, Maps.To_Set ("/\"),
                              Going => Strings.Backward);
            Upload_Path : constant String
              := CNF.Upload_Directory (HTTP_Server.Properties);

            UID         : Natural;
         begin
            File_Upload_UID.Get (UID);

            if I = 0 then
               return Upload_Path
                 & Utils.Image (UID) & '.'
                 & Filename;
            else
               return Upload_Path
                 & Utils.Image (UID) & '.'
                 & Filename (I + 1 .. Filename'Last);
            end if;
         end Target_Filename;

      begin
         --  Reach the boundary


         if Parse_Boundary then
            loop
               declare
                  Data : constant String := Net.Buffered.Get_Line (Sock);
               begin
                  exit when Data = Start_Boundary;

                  if Data = End_Boundary then
                     --  This is the end of the multipart data

                     return;
                  end if;
               end;
            end loop;
         end if;

         --  Read file upload parameters


         declare
            Data : constant String := Net.Buffered.Get_Line (Sock);
         begin
            Is_File_Upload := Fixed.Index (Data, "filename=") /= 0;

            Name     := To_Unbounded_String (Value_For ("name", Data));
            Filename := To_Unbounded_String (Value_For ("filename", Data));
         end;

         --  Reach the data


         loop
            declare
               Data : constant String := Net.Buffered.Get_Line (Sock);
            begin
               if Data = "" then
                  exit;
               else
                  Content_Type := To_Unbounded_String
                    (Data
                     (Messages.Content_Type_Token'Length + 1 .. Data'Last));
               end if;
            end;
         end loop;

         --  Read file/field data


         if Is_File_Upload then
            --  This part of the multipart message contains file data.


            --  Set Server_Filename, the name of the file in the local file

            --  sytstem.


            Server_Filename := To_Unbounded_String
              (Target_Filename (To_String (Filename)));

            if To_String (Filename) /= "" then
               --  First value is the uniq name on the server side


               AWS.Parameters.Set.Add
                 (P_List, To_String (Name), To_String (Server_Filename));

               --  Second value is the original name as found on the client

               --  side.


               AWS.Parameters.Set.Add
                 (P_List, To_String (Name), To_String (Filename));

               --  Read file data, set End_Found if the end-boundary signature

               --  has been read.


               Get_File_Data;

               if not End_Found then
                  File_Upload (Start_Boundary, End_Boundary, False);
               end if;

            else
               --  There is no file for this multipart, user did not enter

               --  something in the field.


               File_Upload (Start_Boundary, End_Boundary, True);
            end if;

         else
            --  This part of the multipart message contains field value


            declare
               Value : Unbounded_String;
            begin
               loop
                  declare
                     L : constant String := Net.Buffered.Get_Line (Sock);
                  begin
                     End_Found := (L = End_Boundary);

                     exit when End_Found or else L = Start_Boundary;

                     --  Append this line to the value


                     if Value /= Null_Unbounded_String then
                        Append (Value, ASCII.CR & ASCII.LF);
                     end if;
                     Append (Value, L);
                  end;
               end loop;

               AWS.Parameters.Set.Add
                 (P_List, To_String (Name), To_String (Value));
            end;

            if not End_Found then
               File_Upload (Start_Boundary, End_Boundary, False);
            end if;
         end if;
      end File_Upload;

      ---------------

      -- Value_For --

      ---------------


      function Value_For (Name : in String; Into : in String) return String is
         Pos   : constant Natural := Fixed.Index (Into, Name & '=');
         Start : constant Natural := Pos + Name'Length + 2;
      begin
         if Pos = 0 then
            return "";
         else
            return Into
              (Start .. Fixed.Index (Into (Start .. Into'Last), """") - 1);
         end if;
      end Value_For;

   begin
      --  Is there something to read ?


      if Status.Content_Length (C_Stat) /= 0 then

         if Status.Method (C_Stat) = Status.POST
           and then Status_Content_Type = MIME.Appl_Form_Data
         then
            --  Read data from the stream and convert it to a string as

            --  these are a POST form parameters.

            --  The body has the format: name1=value1;name2=value2...


            declare
               use Streams;

               Data : Stream_Element_Array
                 (1 .. Stream_Element_Offset (Status.Content_Length (C_Stat)));
            begin
               Net.Buffered.Read (Sock, Data);

               AWS.Status.Set.Binary (C_Stat, Data);
               --  We record the message body as-is to be able to send it back

               --  to an hotplug module if needed.


               --  We then decode it and add the parameters read in the

               --  message body.


               AWS.Parameters.Set.Add (P_List, Translator.To_String (Data));
            end;

         elsif Status.Method (C_Stat) = Status.POST
           and then Status_Content_Type = MIME.Multipart_Form_Data
         then
            --  This is a file upload


            File_Upload ("--" & Multipart_Boundary,

                         "--" & Multipart_Boundary & "--",

                         True);

         elsif Status.Method (C_Stat) = Status.POST
           and then Status.Is_SOAP (C_Stat)
         then
            --  This is a SOAP request, read and set the Payload XML message


            declare
               use Streams;

               Data : Stream_Element_Array
                 (1 .. Stream_Element_Offset (Status.Content_Length (C_Stat)));
            begin
               Net.Buffered.Read (Sock, Data);

               AWS.Status.Set.Payload (C_Stat, Translator.To_String (Data));
            end;

         else
            --  Let's suppose for now that all others content type data are

            --  binary data.


            declare
               use Streams;

               Data : Stream_Element_Array
                 (1 .. Stream_Element_Offset (Status.Content_Length (C_Stat)));
            begin
               Net.Buffered.Read (Sock, Data);
               AWS.Status.Set.Binary (C_Stat, Data);
            end;

         end if;
      end if;
   end Get_Message_Data;

   ------------------------

   -- Get_Message_Header --

   ------------------------


   procedure Get_Message_Header is
   begin
      --  Get and parse request line


      declare
         Data : constant String := Net.Buffered.Get_Line (Sock);
      begin
         HTTP_Server.Slots.Mark_Phase (Index, Client_Header);
         Parse_Request_Line (Data);
      end;

      Status.Set.Read_Header (Socket => Sock, D => C_Stat);

      Status_Connection := To_Unbounded_String (Status.Connection (C_Stat));

      --  Get necessary data from header for the reading HTTP body.


      declare

         procedure Named_Value
           (Name, Value : in String;
            Quit        : in out Boolean);
         --  Looking for the Boundary value in the

         --  Content-Type header line.


         procedure Value (Item : in String; Quit : in out Boolean);
         --  Reading the first unnamed value into the Status_Content_Type

         --  variable from the Content-Type header line.


         -----------------

         -- Named_Value --

         -----------------


         procedure Named_Value
           (Name, Value : in String;
            Quit        : in out Boolean) is
         begin
            if Ada.Characters.Handling.To_Lower (Name) = "boundary" then
               Status_Multipart_Boundary := To_Unbounded_String (Value);
               Quit := True;
            end if;
         end Named_Value;

         -----------

         -- Value --

         -----------


         procedure Value (Item : in String; Quit : in out Boolean) is
         begin
            if Status_Content_Type /= Null_Unbounded_String then
               --  Only first unnamed value is the Content_Type.


               Quit := True;

            elsif Item'Length > 0 then
               Status_Content_Type := To_Unbounded_String (Item);
            end if;
         end Value;

         procedure Parse is new Headers.Values.Parse (Value, Named_Value);

      begin
         --  Clear Content-Type status as this could have already been set in

         --  previous request.

         Status_Content_Type := Null_Unbounded_String;

         Parse (Status.Content_Type (C_Stat));
      end;
   end Get_Message_Header;

   ------------------------

   -- Is_Valid_HTTP_Date --

   ------------------------


   function Is_Valid_HTTP_Date (HTTP_Date : in String) return Boolean is
      Mask   : constant String := "Aaa, 99 Aaa 9999 99:99:99 GMT";
      Offset : constant Integer := HTTP_Date'First - 1;
      --  Make sure the function works for inputs with 'First <> 1

      Result : Boolean := True;
   begin
      for I in Mask'Range loop
         Result := I + Offset in HTTP_Date'Range;

         exit when not Result;

         case Mask (I) is
            when 'A' =>
               Result := HTTP_Date (I + Offset) in 'A' .. 'Z';

            when 'a' =>
               Result := HTTP_Date (I + Offset) in 'a' .. 'z';

            when '9' =>
               Result := HTTP_Date (I + Offset) in '0' .. '9';

            when others =>
               Result := Mask (I) = HTTP_Date (I + Offset);
         end case;
      end loop;

      return Result;
   end Is_Valid_HTTP_Date;

   ------------------------

   -- Parse_Request_Line --

   ------------------------


   procedure Parse_Request_Line (Command : in String) is

      I1, I2 : Natural;
      --  Index of first space and second space


      I3 : Natural;
      --  Index of ? if present in the URI (means that there is some

      --  parameters)


      procedure Cut_Command;
      --  Parse Command and set I1, I2 and I3


      function Resource return String;
      pragma Inline (Resource);
      --  Returns first parameter. parameters are separated by spaces.


      function Parameters return String;
      --  Returns parameters if some where specified in the URI.


      function HTTP_Version return String;
      pragma Inline (HTTP_Version);
      --  Returns second parameter. parameters are separated by spaces.


      -----------------

      -- Cut_Command --

      -----------------


      procedure Cut_Command is
      begin
         I1  := Fixed.Index (Command, " ");
         I2  := Fixed.Index (Command (I1 + 1 .. Command'Last), " ", Backward);

         I3  := Fixed.Index (Command (I1 + 1 .. I2 - 1), "?");

         if I3 = 0 then
            --  Could be encoded ?


            I3  := Fixed.Index (Command (I1 + 1 .. I2 - 1), "%3f");

            if I3 = 0 then
               I3  := Fixed.Index (Command (I1 + 1 .. I2 - 1), "%3F");
            end if;
         end if;
      end Cut_Command;

      ------------------

      -- HTTP_Version --

      ------------------


      function HTTP_Version return String is
      begin
         return Command (I2 + 1 .. Command'Last);
      end HTTP_Version;

      ----------------

      -- Parameters --

      ----------------


      function Parameters return String is
      begin
         if I3 = 0 then
            return "";
         else
            if Command (I3) = '%' then
               return Command (I3 + 3 .. I2 - 1);
            else
               return Command (I3 + 1 .. I2 - 1);
            end if;
         end if;
      end Parameters;

      ---------

      -- URI --

      ---------


      function Resource return String is
      begin
         if I3 = 0 then
            return URL.Decode (Command (I1 + 1 .. I2 - 1));
         else
            return URL.Decode (Command (I1 + 1 .. I3 - 1));
         end if;
      end Resource;

   begin
      Cut_Command;

      --  GET and HEAD can have a set of parameters (query) attached. This is

      --  not really standard see [RFC 2616 - 13.9] but is widely used now.

      --

      --  POST parameters are passed into the message body, we do not allow

      --  parameters here even is this could be possible but as of today this

      --  feature is not used and it is not clear if it is permitted or

      --  prohibited by reading RFC 2616.


      if Messages.Match (Command, Messages.Get_Token) then
         Status.Set.Request (C_Stat, Status.GET, Resource, HTTP_Version);
         AWS.Parameters.Set.Add (P_List, Parameters);

      elsif Messages.Match (Command, Messages.Head_Token) then
         Status.Set.Request (C_Stat, Status.HEAD, Resource, HTTP_Version);
         AWS.Parameters.Set.Add (P_List, Parameters);

      elsif Messages.Match (Command, Messages.Post_Token) then
         Status.Set.Request (C_Stat, Status.POST, Resource, HTTP_Version);

      end if;
   end Parse_Request_Line;

   ----------

   -- Send --

   ----------


   procedure Send (Answer : in Response.Data) is

      use type Response.Data_Mode;

      Status : Messages.Status_Code;

      Length : Response.Content_Length_Type := 0;

      procedure Send_General_Header;
      --  Send the "Date:", "Server:", "Set-Cookie:" and "Connection:" header


      procedure Send_Header_Only;
      --  Send HTTP message header only. This is used to implement the HEAD

      --  request.


      procedure Send_Data;
      --  Send a text/binary data to the client


      ---------------

      -- Send_Data --

      ---------------


      procedure Send_Data is
         use type Calendar.Time;
         use type AWS.Status.Request_Method;

         Filename      : constant String
           := Response.Filename (Answer);

         File_Size     : constant Response.Content_Length_Type
           := Response.Content_Length (Answer);

         Is_Up_To_Date : Boolean;

         File_Mode     : constant Boolean
           := Response.Mode (Answer) = Response.File;

         File          : Resources.File_Type;
      begin
         Is_Up_To_Date := File_Mode
              and then
           Is_Valid_HTTP_Date (AWS.Status.If_Modified_Since (C_Stat))
              and then
           Resources.File_Timestamp (Filename)
             = Messages.To_Time (AWS.Status.If_Modified_Since (C_Stat));
         --  Equal used here see [RFC 2616 - 14.25]


         if Is_Up_To_Date then
            --  [RFC 2616 - 10.3.5]

            Net.Buffered.Put_Line
              (Sock,
               Messages.Status_Line (Messages.S304));

            Send_General_Header;
            Net.Buffered.New_Line (Sock);
            return;
         else
            Net.Buffered.Put_Line (Sock, Messages.Status_Line (Status));
         end if;

         --  Checking if we have to close connection because of undefined

         --  message length comming from a user's stream.


         if Response.Content_Length (Answer) = Response.Undefined_Length
            and then AWS.Status.HTTP_Version (C_Stat) = HTTP_10
            --  We cannot use transfer-encoding chunked in HTTP_10

            and then AWS.Status.Method (C_Stat) /= AWS.Status.HEAD
            --  We have to send message_body

         then
            --  In this case we need to close the connection explicitly at the

            --  end of the transfer.

            Will_Close := True;
         end if;

         Send_General_Header;

         --  Send file last-modified timestamp info in case of a file


         if File_Mode then
            Net.Buffered.Put_Line
              (Sock,
               Messages.Last_Modified (Resources.File_Timestamp (Filename)));
         end if;

         --  Note that we cannot send the Content_Length header at this

         --  point. A server should not send Content_Length if the

         --  transfer-coding used is not identity. This is allowed by the

         --  RFC but it seems that some implementation does not handle this

         --  right. The file can be sent using either identity or chunked

         --  transfer-coding. The proper header will be sent in Send_Resource

         --  see [RFC 2616 - 4.4].


         --  Send message body


         Response.Create_Resource (File, Answer);

         --  Length is the real resource/file size


         Length := File_Size;

         Send_Resource (AWS.Status.Method (C_Stat), File, Length);
      end Send_Data;

      -------------------------

      -- Send_General_Header --

      -------------------------


      procedure Send_General_Header is
         use type Messages.Cache_Option;
      begin
         --  Session


         if CNF.Session (HTTP_Server.Properties)
           and then AWS.Status.Session_Created (C_Stat)
         then
            --  This is an HTTP connection with session but there is no session

            --  ID set yet. So, send cookie to client browser.


            Net.Buffered.Put_Line
              (Sock,
               "Set-Cookie: AWS="
               & Session.Image (AWS.Status.Session (C_Stat)) & "; path=/");
         end if;

         --  Date


         Net.Buffered.Put_Line
           (Sock,
            "Date: " & Messages.To_HTTP_Date (OS_Lib.GMT_Clock));

         --  Server


         Net.Buffered.Put_Line
           (Sock,
            "Server: AWS (Ada Web Server) v" & Version);

         if Will_Close then
            --  We have decided to close connection after answering the client

            Net.Buffered.Put_Line (Sock, Messages.Connection ("close"));
         else
            Net.Buffered.Put_Line (Sock, Messages.Connection ("keep-alive"));
         end if;

         --  Send Content-Type, Cache-Control, Location, WWW-Authenticate

         --  and others user defined header lines.


         Response.Send_Header (Socket => Sock, D => Answer);

      end Send_General_Header;

      ----------------------

      -- Send_Header_Only --

      ----------------------


      procedure Send_Header_Only is
         use type AWS.Status.Request_Method;
      begin
         --  First let's output the status line


         Net.Buffered.Put_Line (Sock, Messages.Status_Line (Status));

         Send_General_Header;

         --  There is no content


         Net.Buffered.Put_Line (Sock, Messages.Content_Length (0));

         --  End of header


         Net.Buffered.New_Line (Sock);
      end Send_Header_Only;

      use type Response.Data;

   begin
      Data_Sent := True;

      Status := Response.Status_Code (Answer);

      case Response.Mode (Answer) is

         when Response.File | Response.Stream | Response.Message =>
            Send_Data;

         when Response.Header =>
            Send_Header_Only;

         when Response.Socket_Taken =>
            HTTP_Server.Slots.Socket_Taken (Index);
            Socket_Taken := True;

         when Response.No_Data =>
            Ada.Exceptions.Raise_Exception
              (Constraint_Error'Identity,
               "Answer not properly initialized (No_Data)");
      end case;

      Net.Buffered.Flush (Sock);

      AWS.Log.Write (HTTP_Server.Log, C_Stat, Status, Length);
   end Send;

   -------------------

   -- Send_Resource --

   -------------------


   procedure Send_Resource
     (Method : in     Status.Request_Method;
      File   : in out Resources.File_Type;
      Length : in out Response.Content_Length_Type)
   is
      use type Status.Request_Method;
      use type Streams.Stream_Element_Offset;

      Buffer_Size : constant := 4 * 1_024;
      --  Size of the buffer used to send the file.


      Chunk_Size  : constant := 1_024;
      --  Size of the buffer used to send the file with the chunked encoding.

      --  This is the maximum size of each chunk.


      procedure Send_File;
      --  Send file in one part


      procedure Send_File_Chunked;
      --  Send file in chunks, used in HTTP/1.1 and when the message length

      --  is not known)


      Last : Streams.Stream_Element_Offset;

      ---------------

      -- Send_File --

      ---------------


      procedure Send_File is

         use type Ada.Streams.Stream_Element_Offset;

         Buffer : Streams.Stream_Element_Array (1 .. Buffer_Size);

      begin
         loop
            Resources.Read (File, Buffer, Last);

            exit when Last < Buffer'First;

            Net.Buffered.Write (Sock, Buffer (1 .. Last));

            Length := Length + Positive (Last);

            HTTP_Server.Slots.Mark_Data_Time_Stamp (Index);
         end loop;
      end Send_File;

      ---------------------

      -- Send_File_Chunk --

      ---------------------


      procedure Send_File_Chunked is
         use type Streams.Stream_Element_Array;
         --  Note that we do not use a buffered socket here. Opera on SSL

         --  sockets does not like chunk that are not sent in a whole.


         Buffer : Streams.Stream_Element_Array (1 .. Chunk_Size);
         --  Each chunk will have a maximum length of Buffer'Length


         CRLF : constant Streams.Stream_Element_Array
           := (1 => Character'Pos (ASCII.CR), 2 => Character'Pos (ASCII.LF));

         Last_Chunk : constant Streams.Stream_Element_Array
           := Character'Pos ('0') & CRLF & CRLF;
         --  Last chunk for a chunked encoding stream. See [RFC 2616 - 3.6.1]


      begin
         Send_Chunks : loop
            Resources.Read (File, Buffer, Last);

            if Last = 0 then
               --  There is not more data to read, the previous chunk was the

               --  last one, just terminate the chunk message here.

               Net.Send (Sock, Last_Chunk);
               exit Send_Chunks;
            end if;

            Length := Length + Positive (Last);

            HTTP_Server.Slots.Mark_Data_Time_Stamp (Index);

            declare
               H_Last : constant String := Utils.Hex (Positive (Last));

               Chunk  : constant Streams.Stream_Element_Array
                 := Translator.To_Stream_Element_Array (H_Last)
                 & CRLF
                 & Buffer (1 .. Last)
                 & CRLF;
               --  A chunk is composed of:

               --     the Size of the chunk in hexadecimal

               --     a line feed

               --     the chunk

               --     a line feed


            begin
               --  Check if the last data portion.


               if Last < Buffer'Last then
                  --  No more data, add the terminating chunk

                  Net.Send (Sock, Chunk & Last_Chunk);
                  exit Send_Chunks;
               else
                  Net.Send (Sock, Chunk);
               end if;
            end;
         end loop Send_Chunks;
      end Send_File_Chunked;

   begin
      if Status.HTTP_Version (C_Stat) = HTTP_10
        or else Length /= Response.Undefined_Length
      then
         --  If content length is undefined and we handle an HTTP/1.0 protocol

         --  then the end of the stream will be determined by closing the

         --  connection. [RFC 1945 - 7.2.2] See the Will_Close local variable.


         if Length /= Response.Undefined_Length then
            Net.Buffered.Put_Line (Sock, Messages.Content_Length (Length));
         end if;

         --  Terminate header


         Net.Buffered.New_Line (Sock);

         if Method /= Status.HEAD and then Length /= 0 then
            Length := 0;
            Send_File;
         end if;

      else
         --  HTTP/1.1 case and we do not know the message lenght.

         --

         --  Terminate header, do not send the Content_Length see

         --  [RFC 2616 - 4.4]. It could be possible to send the Content_Length

         --  as this is cleary a permission but it does not work in some

         --  obsucre cases.


         Net.Buffered.Put_Line (Sock, Messages.Transfer_Encoding ("chunked"));
         Net.Buffered.New_Line (Sock);
         Net.Buffered.Flush (Sock);

         --  Past this point we will not use the buffered mode. Opera on SSL

         --  sockets does not like chunk that are not sent in a whole.


         if Method /= Status.HEAD then
            Length := 0;
            Send_File_Chunked;
         end if;
      end if;

      Resources.Close (File);

   exception
      when Text_IO.Name_Error =>
         raise;

      when others =>
         Resources.Close (File);
         raise;
   end Send_Resource;

   ----------------------

   -- Set_Close_Status --

   ----------------------


   procedure Set_Close_Status is
      Connection : constant String := To_String (Status_Connection);
   begin
      --  Connection, check connection string with Match to skip connection

      --  options [RFC 2616 - 14.10].


      Will_Close := AWS.Messages.Match (Connection, "close")
        or else HTTP_Server.Slots.N = 1
        or else (Status.HTTP_Version (C_Stat) = HTTP_10
                   and then
                 AWS.Messages.Does_Not_Match (Connection, "keep-alive"));
   end Set_Close_Status;


begin
   --  This new connection has been initialized because some data are

   --  beeing sent. We are by default using HTTP/1.1 persistent

   --  connection. We will exit this loop only if the client request

   --  so or if we time-out on waiting for a request.


   For_Every_Request : loop

      begin
         Data_Sent := False;

         HTTP_Server.Slots.Mark_Phase (Index, Wait_For_Client);

         Status.Set.Reset (C_Stat);

         P_List := Status.Parameters (C_Stat);

         Parameters.Set.Case_Sensitive
           (P_List, Case_Sensitive_Parameters);

         HTTP_Server.Slots.Increment_Slot_Activity_Counter (Index);

         Get_Message_Header;

         Set_Close_Status;

         HTTP_Server.Slots.Mark_Phase (Index, Client_Data);

         Get_Message_Data;

         Status.Set.Keep_Alive (C_Stat, not Will_Close);

         Status.Set.Parameters (C_Stat, P_List);

         HTTP_Server.Slots.Mark_Phase (Index, Server_Response);

         Answer_To_Client;

      exception
         --  We must never exit the loop with an exception. This loop is

         --  supposed to be used for the keep-alive connection. We must exit

         --  properly and the slot will be closed. An exception propagated

         --  outside of this loop will kill definitely one of the server's

         --  slot.


         when Net.Socket_Error =>
            --  Exit from keep-alive loop in case of socket error

            exit For_Every_Request;

         when E : others =>

            declare
               use type Response.Data_Mode;

               Answer : Response.Data;
            begin
               --  Log this error


               AWS.Log.Write
                 (HTTP_Server.Error_Log,
                  C_Stat,
                  Utils.CRLF_2_Spaces
                    (Ada.Exceptions.Exception_Information (E)));

               --  Call exception handler


               HTTP_Server.Exception_Handler
                 (E,
                  HTTP_Server.Error_Log,
                  AWS.Exceptions.Data'(False, Index, C_Stat),
                  Answer);

               --  We have an exception while sending data back to the

               --  client. This is most probably an exception coming

               --  from a user's stream. The only option is to exit and

               --  close the connection, we can't recover in a middle of

               --  a response.


               exit For_Every_Request when Data_Sent;

               if Response.Mode (Answer) /= Response.No_Data then
                  HTTP_Server.Slots.Mark_Phase (Index, Server_Response);
                  Send (Answer);
               end if;

            exception
               when Net.Socket_Error =>
                  --  There is nothing further we can do. The socket has

                  --  certainly been closed while sending back the answer.

                  exit For_Every_Request;

               when E : others =>
                  --  Here we got an exception (other than Net.Socket_Error).

                  --  It is probably due to a problem in a user's stream

                  --  implementation. Just log the problem and exit.

                  Log.Write
                    (HTTP_Server.Error_Log,
                     C_Stat,
                     "Exception handler bug "
                       & Utils.CRLF_2_Spaces
                           (Ada.Exceptions.Exception_Information (E)));
                  exit For_Every_Request;
            end;
      end;

      --  Exit if connection has not the Keep-Alive status or we are working

      --  on HTTP/1.0 protocol or we have a single slot.


      exit For_Every_Request when Will_Close or else Socket_Taken;

   end loop For_Every_Request;

   --  Release memory for local objects


   Status.Set.Free (C_Stat);
end Protocol_Handler;