------------------------------------------------------------------------------ -- Ada Web Server -- -- -- -- Copyright (C) 2002-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. -- ------------------------------------------------------------------------------ -- $Id: aws-headers-values.adb,v 1.1 2003/10/05 19:59:54 Jano Exp $ with Ada.Exceptions; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; package body AWS.Headers.Values is use Ada.Strings; Spaces : constant Maps.Character_Set := Maps.To_Set (' ' & ASCII.HT & ASCII.LF & ASCII.CR); -- Set of spaces to ignore during parsing procedure Next_Value (Data : in String; First : in out Natural; Name_First : out Positive; Name_Last : out Natural; Value_First : out Positive; Value_Last : out Natural); -- Returns the next named or un-named value from Data. It start the search -- from First index. Returns First = 0 if it has reached the end of -- Data. Returns Name_Last = 0 if an un-named value has been found. ----------------------- -- Get_Unnamed_Value -- ----------------------- function Get_Unnamed_Value (Header_Value : in String; N : in Positive := 1) return String is First : Natural; Name_First : Positive; Name_Last : Natural; Value_First : Positive; Value_Last : Natural; Count : Natural := 0; begin First := Fixed.Index (Source => Header_Value, Set => Spaces, Test => Outside); if First = 0 then -- Value is empty or contains only spaces return ""; end if; loop Next_Value (Header_Value, First, Name_First, Name_Last, Value_First, Value_Last); if Name_Last = 0 then Count := Count + 1; if Count = N then return Header_Value (Value_First .. Value_Last); end if; end if; exit when First = 0; end loop; -- There is not such value, return the empty string return ""; end Get_Unnamed_Value; ------------ -- Index -- ------------ function Index (Set : in Values.Set; Name : in String; Case_Sensitive : in Boolean := True) return Natural is Map : Maps.Character_Mapping; M_Name : Unbounded_String; begin if Case_Sensitive then Map := Maps.Identity; M_Name := To_Unbounded_String (Name); else Map := Maps.Constants.Upper_Case_Map; M_Name := Translate (To_Unbounded_String (Name), Map); end if; for I in Set'Range loop if Set (I).Named_Value and then Translate (Set (I).Name, Map) = M_Name then return I; end if; end loop; -- Name was not found, return 0 return 0; end Index; ---------------- -- Next_Value -- ---------------- procedure Next_Value (Data : in String; First : in out Natural; Name_First : out Positive; Name_Last : out Natural; Value_First : out Positive; Value_Last : out Natural) is EDel : constant Maps.Character_Set := Maps.To_Set (",;"); -- Delimiter between name/value pairs in the HTTP header lines. -- In WWW-Authenticate, header delimiter between name="Value" -- pairs is a comma. -- In the Set-Cookie header, value delimiter between name="Value" -- pairs is a semi-colon. UVDel : constant Character := ' '; -- Delimiter of the un-named value NVDel : constant Character := '='; -- Delimiter between name and Value for a named value VDel : constant Maps.Character_Set := Maps.To_Set (UVDel & NVDel); -- Delimiter between name and value is '=' and it is a space between -- un-named values. Last : Natural; begin Last := Fixed.Index (Data (First .. Data'Last), VDel); Name_Last := 0; if Last = 0 then -- This is the last single value. Value_First := First; Value_Last := Data'Last; First := 0; -- Mean end of line elsif Data (Last) = UVDel then -- This is an un-named value Value_First := First; Value_Last := Last - 1; First := Last + 1; -- Do not return the delimiter as part of the value while Maps.Is_In (Data (Value_Last), EDel) loop Value_Last := Value_Last - 1; end loop; else -- Here we have a named value Name_First := First; Name_Last := Last - 1; First := Last + 1; -- Check if this is a quoted or unquoted value if First < Data'Last and then Data (First) = '"' then -- Quoted value Value_First := First + 1; Last := Fixed.Index (Data (Value_First .. Data'Last), """"); if Last = 0 then -- Format error as there is no closing quote Ada.Exceptions.Raise_Exception (Format_Error'Identity, "HTTP header line format error : " & Data); else Value_Last := Last - 1; end if; First := Last + 2; else -- Unquoted value Value_First := First; Last := Ada.Strings.Fixed.Index (Data (First .. Data'Last), EDel); if Last = 0 then Value_Last := Data'Last; First := 0; else Value_Last := Last - 1; First := Last + 1; end if; end if; end if; if First > Data'Last then -- We have reached the end-of-line First := 0; elsif First > 0 then -- Ignore the next leading spaces First := Fixed.Index (Source => Data (First .. Data'Last), Set => Spaces, Test => Outside); end if; end Next_Value; ----------- -- Parse -- ----------- procedure Parse (Header_Value : in String) is First : Natural; Name_First : Positive; Name_Last : Natural; Value_First : Positive; Value_Last : Natural; Quit : Boolean; begin -- Ignore the leading spaces First := Fixed.Index (Source => Header_Value, Set => Spaces, Test => Outside); if First = 0 then -- Value is empty or contains only spaces return; end if; loop Next_Value (Header_Value, First, Name_First, Name_Last, Value_First, Value_Last); Quit := False; if Name_Last > 0 then Named_Value (Header_Value (Name_First .. Name_Last), Header_Value (Value_First .. Value_Last), Quit); else Value (Header_Value (Value_First .. Value_Last), Quit); end if; exit when Quit or else First = 0; end loop; end Parse; ------------ -- Search -- ------------ function Search (Header_Value : in String; Name : in String; Case_Sensitive : in Boolean := True) return String is First : Natural; Name_First : Positive; Name_Last : Natural; Value_First : Positive; Value_Last : Natural; Map : Maps.Character_Mapping; M_Name : String (Name'Range); -- Mapped name begin First := Fixed.Index (Source => Header_Value, Set => Spaces, Test => Outside); if First = 0 then -- Value is empty or contains only spaces return ""; end if; if Case_Sensitive then Map := Maps.Identity; M_Name := Name; else Map := Maps.Constants.Upper_Case_Map; M_Name := Fixed.Translate (Name, Map); end if; loop Next_Value (Header_Value, First, Name_First, Name_Last, Value_First, Value_Last); if Name_Last > 0 and then M_Name = Fixed.Translate (Header_Value (Name_First .. Name_Last), Map) then return Header_Value (Value_First .. Value_Last); end if; exit when First = 0; end loop; -- Name not found, returns the empty string return ""; end Search; ----------- -- Split -- ----------- function Split (Header_Value : in String) return Set is First : Natural; Null_Set : Set (1 .. 0); function To_Set return Set; -- Parse the Header_Value and return a set of named and un-named -- value. Note that this routine is recursive as the final Set size is -- not known. This should not be a problem as the number of token on an -- Header_Line is quite small. ------------ -- To_Set -- ------------ function To_Set return Set is Name_First : Positive; Name_Last : Natural; Value_First : Positive; Value_Last : Natural; function Element return Data; -- Returns the Data element from the substrings defined by -- Name_First, Name_Last, Value_First, Value_Last. ------------- -- Element -- ------------- function Element return Data is function "+" (Item : in String) return Unbounded_String renames To_Unbounded_String; begin if Name_Last = 0 then return Data' (Named_Value => False, Value => +Header_Value (Value_First .. Value_Last)); else return Data' (True, Name => +Header_Value (Name_First .. Name_Last), Value => +Header_Value (Value_First .. Value_Last)); end if; end Element; begin if First = 0 then -- This is the end of recursion. return Null_Set; end if; Next_Value (Header_Value, First, Name_First, Name_Last, Value_First, Value_Last); return Element & To_Set; end To_Set; begin First := Fixed.Index (Source => Header_Value, Set => Spaces, Test => Outside); return To_Set; end Split; -------------------------- -- Unnamed_Value_Exists -- -------------------------- function Unnamed_Value_Exists (Header_Value : in String; Value : in String; Case_Sensitive : in Boolean := True) return Boolean is First : Natural; Name_First : Positive; Name_Last : Natural; Value_First : Positive; Value_Last : Natural; Map : Maps.Character_Mapping; M_Value : String (Value'Range); begin First := Fixed.Index (Source => Header_Value, Set => Spaces, Test => Outside); if First = 0 then -- Value is empty or contains only spaces return False; end if; if Case_Sensitive then Map := Maps.Identity; M_Value := Value; else Map := Maps.Constants.Upper_Case_Map; M_Value := Fixed.Translate (Value, Map); end if; loop Next_Value (Header_Value, First, Name_First, Name_Last, Value_First, Value_Last); if Name_Last = 0 and then M_Value = Fixed.Translate (Header_Value (Value_First .. Value_Last), Map) then return True; end if; exit when First = 0; end loop; -- There is not such value return False; end Unnamed_Value_Exists; end AWS.Headers.Values;