Re: cookies

Re: cookies

[David C. Hoos, Sr]

Dale Stanbrough wrote in message ...
>hello Pascal,
>
>In your posting you didn't include the package...
>
>    Table_Of_Static_Keys_And_Static_Values_G
>
You'll find everything you need on this site :

http://lglwww.epfl.ch/Components/ADT/directory.html

Actually you need more that "Table_Of_Static_Keys_And_Static_Values_G"
because
this package use some others, but as I said everything should be on this Web
site.

Pascal.

Re: cookies

[Pascal Obry]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 12086 bytes --]


Lisa Winkworth a �crit dans le message <6tpv6c$o1l$1@emu.cs.rmit.edu.au>...
>Hi, does anyone have any idea how to accept/generally do stuff with cookies
>in ada95??
>Any help would be much appreciated :)
>Thanks in advance,
>Lisa
>


Lisa,

I have done a child package of cgi.ads (from David A. Wheeler) to handle
cookies.

The packages spec/body are small so I have included them in this message.

Pascal.

---------------------------------- CUT
HERE -----------------------------------------------

--         File Name : cgi-cookies.ads
--
--       Created by  : Pascal Obry
--               on  : Mon Mar 10 16:05:01 1997

with Ada.Strings.Unbounded;

package CGI.Cookies is

   use Ada.Strings.Unbounded;

   --  Get cookie number
   function Count return Natural;


   --  Get cookies value
   function Value
     (Key      : in Unbounded_String;
      Required : in Boolean          := False)
      return Unbounded_String;

   function Value
     (Key      : in String;
      Required : in Boolean := False)
      return Unbounded_String;

   function Value
     (Key      : in String;
      Required : in Boolean := False)
      return String;

   function Value
     (Key      : in Unbounded_String;
      Required : in Boolean          := False)
      return String;


   --  Was a given key provided?
   function Key_Exists (Key : in String)           return Boolean;
   function Key_Exists (Key : in Unbounded_String) return Boolean;


   --  Set cookies value
   procedure Set (Key     : in String;
                  Value   : in String;
                  Expires : in String  := "";
                  Path    : in String  := "/";
                  Domain  : in String  := "";
                  Secure  : in Boolean := False);


   --  Send cookies to client with HTML header.
   procedure Put_CGI_Header_With_Cookies
     (Header : in String := "Content-type: text/html");

end CGI.Cookies;


--         File Name : cgi-cookies.adb
--
--       Created by  : Pascal Obry
--               on  : Mon Mar 10 16:05:01 1997

with Ada.Text_IO;
with Ada.Strings.Maps;
with Ada.Characters.Handling;

with Table_Of_Static_Keys_And_Static_Values_G;

package body CGI.Cookies is

   use Ada;
   use Ada.Strings.Maps;

   --  to set cookie
   type Key_Values_Record is
      record
         Value   : Unbounded_String;
         Expires : Unbounded_String;
         Path    : Unbounded_String;
         Domain  : Unbounded_String;
         Secure  : Boolean := False;
      end record;

   package Cookie_Table is
      new Table_Of_Static_Keys_And_Static_Values_G (Unbounded_String,
                                                    "<",
                                                    "=",
                                                    Key_Values_Record);

   --  to hold cookie value sent be the client
   type Key_Value_Pair is
      record
         Key   : Unbounded_String;
         Value : Unbounded_String;
      end record;

   type Key_Value_Sequence is array (Positive range <>) of Key_Value_Pair;
   type Access_Key_Value_Sequence is access Key_Value_Sequence;

   -- The following are data internal to this package.

   Cookie_Data     : Access_Key_Value_Sequence;

   Set_Cookie_Data : Cookie_Table.Table_Type;


   Ampersands :    constant Character_Set      := To_Set ('&');
   Equals     :    constant Character_Set      := To_Set ('=');
   Plus_To_Space : constant Character_Mapping  := To_Mapping ("+", " ");


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

   --  Get cookie number
   function Count return Natural is
   begin
      if Cookie_Data = null then
         return 0;
      else
         return Cookie_Data'Length;
      end if;
   end Count;
                      ------------------------------


   --  Get cookies value
   function Value
     (Key      : in Unbounded_String;
      Required : in Boolean          := False)
      return Unbounded_String is
   begin
      for I in 1 .. Count loop
         if Cookie_Data (I).Key = Key then
            return Cookie_Data (I).Value;
         end if;
      end loop;

      -- Didn't find the Key.
      if Required then
         raise Constraint_Error;
      else
         return Null_Unbounded_String;
      end if;
   end Value;

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

   function Value
     (Key      : in String;
      Required : in Boolean := False)
      return Unbounded_String
   is
   begin
      return Value (To_Unbounded_String (Key), Required);
   end Value;

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

   function Value
     (Key      : in String;
      Required : in Boolean := False)
      return String
   is
   begin
      return To_String (Value (To_Unbounded_String (Key), Required));
   end Value;

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

   function Value
     (Key      : in Unbounded_String;
      Required : in Boolean          := False)
      return String
   is
   begin
      return To_String (Value (Key, Required));
   end Value;


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

   --  Was a given key provided?
   function Key_Exists (Key : in Unbounded_String)
                        return Boolean
   is
   begin
      for I in 1 .. Count loop
         if Cookie_Data (I).Key = Key then
            return True;
         end if;
      end loop;
      return False;
   end Key_Exists;

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

   function Key_Exists (Key : in String)
                        return Boolean
   is
   begin
     return Key_Exists (To_Unbounded_String (Key));
   end Key_Exists;


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

   --  Set cookie value
   procedure Set (Key     : in String;
                  Value   : in String;
                  Expires : in String := "";
                  Path    : in String := "/";
                  Domain  : in String := "";
                  Secure  : in Boolean := False)
   is
      Cookie_Record : Key_Values_Record;
   begin -- Set_Cookies
      Cookie_Record := (To_Unbounded_String (Value),
                        To_Unbounded_String (Expires),
                        To_Unbounded_String (Path),
                        To_Unbounded_String (Domain),
                        Secure);

      Cookie_Table.Insert_Or_Replace_Value (Set_Cookie_Data,
                                            To_Unbounded_String (Key),
                                            Cookie_Record);
   end Set;


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

   procedure Put_CGI_Header_With_Cookies
     (Header : in String := "Content-type: text/html")
   is

      procedure Put_Cookie (Key      : in     Unbounded_String;
                            Datas    : in     Key_Values_Record;
                            N        : in     Positive;
                            Continue : in out Boolean) is
      begin
         Text_IO.Put ("Set-Cookie: ");
         Text_IO.Put (To_String (Key) & '=' & To_String (Datas.Value));

         if Datas.Expires /= Null_Unbounded_String then
            Text_IO.Put ("; expires=" & To_String (Datas.Expires));
         end if;

         if Datas.Path /= Null_Unbounded_String then
            Text_IO.Put ("; path=" & To_String (Datas.Path));
         end if;

         if Datas.Domain /= Null_Unbounded_String then
            Text_IO.Put ("; domain=" & To_String (Datas.Domain));
         end if;

         if Datas.Secure then
            Text_IO.Put ("; secure");
         end if;

         Text_IO.New_Line;

         Continue := True;
      end Put_Cookie;


      procedure For_Every_Cookies is
         new Cookie_Table.Traverse_ASC_G (Put_Cookie);

   begin
      --  CGI Header
      Text_IO.Put_Line (Header);

      --  Cookies
      For_Every_Cookies (Set_Cookie_Data);
      Text_IO.New_Line;
   end Put_CGI_Header_With_Cookies;





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

   -- Initialization routines, including some private procedures only
   -- used during initialization.

   function Field_End
     (Data            : Unbounded_String;
      Field_Separator : Character;
      Starting_At     : Positive         := 1)
      return Natural
   is
      -- Return the end-of-field position in Data after "Starting_Index",
      -- assuming that fields are separated by the Field_Separator.
      -- If there's no Field_Separator, return the end of the Data.
   begin
      for I in Starting_At .. Length (Data) loop
         if Element (Data, I) = Field_Separator then
            return I - 1;
         end if;
      end loop;
      return Length (Data);
   end Field_End;

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

   function Hex_Value (H : in String) return Natural is
      -- Given hex string, return its Value as a Natural.
      Value : Natural := 0;
   begin
      for P in 1.. H'Length loop
         Value := Value * 16;

         if H(P) in '0' .. '9' then
            Value := Value + Character'Pos(H(P)) - Character'Pos('0');
         elsif H(P) in 'A' .. 'F' then
            Value := Value + Character'Pos(H(P)) - Character'Pos('A') + 10;
         elsif H(P) in 'a' .. 'f' then
            Value := Value + Character'Pos(H(P)) - Character'Pos('a') + 10;
         else
            raise Constraint_Error;
         end if;

      end loop;
      return Value;
   end Hex_Value;

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

   procedure Decode (Data : in out Unbounded_String)
   is
      use Characters.Handling;
      I : Positive := 1;
      -- In the given string, convert pattern %HH into alphanumeric
characters,
      -- where HH is a hex number. Since this encoding only permits values
      -- from %00 to %FF, there's no need to handle 16-bit characters.
   begin
      while I <= Length(Data) - 2 loop
         if Element (Data, I) = '%' and
           Is_Hexadecimal_Digit (Element (Data, I+1)) and
           Is_Hexadecimal_Digit (Element (Data, I+2)) then

            Replace_Element
              (Data, I,
               Character'Val (Hex_Value (Slice (Data, I+1, I+2))));
            Delete (Data, I+1, I+2);
         end if;
         I := I + 1;
      end loop;
   end Decode;
                      ------------------------------

   procedure Set_CGI_Position
     (Key_Number : in Positive;
      Datum      : in Unbounded_String)
   is
      Last : Natural := Field_End(Datum, '=');
      -- Given a Key number and a datum of the form key=value
      -- assign the CGI_Data(Key_Number) the values of key and value.
   begin
      Cookie_Data (Key_Number).Key
        := To_Unbounded_String (Slice (Datum, 1, Last));
      Cookie_Data (Key_Number).Value
        := To_Unbounded_String (Slice (Datum, Last+2, Length (Datum)));
      Decode (Cookie_Data (Key_Number).Key);
      Decode (Cookie_Data (Key_Number).Value);
   end Set_CGI_Position;

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

   procedure Set_CGI_Data (Raw_Data : in Unbounded_String) is
      -- Set CGI_Data using Raw_Data.
      Key_Number         : Positive := 1;
      Character_Position : Positive := 1;
      Last : Natural;
   begin
      while Character_Position <= Length (Raw_Data) loop
         Last := Field_End (Raw_Data, ';', Character_Position);
         Set_CGI_Position
           (Key_Number,
            To_Unbounded_String (Slice (Raw_Data, Character_Position,
Last)));
         Character_Position := Last + 3; -- Skip over field separator. "; "
         Key_Number := Key_Number + 1;
      end loop;
   end Set_CGI_Data;

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

   procedure Initialize is
      Raw_Data : Unbounded_String;
   begin
      Raw_Data := To_Unbounded_String (Get_Environment("HTTP_COOKIE"));

      Translate (Raw_Data, Mapping => Plus_To_Space);

      if Length (Raw_Data) > 0 then
         Cookie_Data :=
           new Key_Value_Sequence (1 .. Count (Raw_Data, ";") + 1);
         Set_CGI_Data (Raw_Data);
      end if;

   end Initialize;

begin
   Initialize;
end CGI.Cookies;
---------------------------------- CUT
HERE -----------------------------------------------

cookies

[Lisa Winkworth]

Hi, does anyone have any idea how to accept/generally do stuff with cookies
in ada95??
Any help would be much appreciated :)
Thanks in advance,
Lisa


-- 
                          liswin@cs.rmit.edu.au

	      Devils speak of the ways in which she'll manifest
              Angels bleed from the tainted touch of my caress
	       Need to contaminate to alleviate this lonliness	
	         I now know the depths I reach are limitless

Re: cookies

[Dale Stanbrough]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: Type: text/plain, Size: 892 bytes --]

In article <6tqfe6$kk1$1@cf01.edf.fr>, "Pascal Obry" <p.obry@der.edf.fr> wrote:

> Lisa Winkworth a �crit dans le message <6tpv6c$o1l$1@emu.cs.rmit.edu.au>...
> >Hi, does anyone have any idea how to accept/generally do stuff with cookies
> >in ada95??
> >Any help would be much appreciated :)
> >Thanks in advance,
> >Lisa
> >
> 
> 
> Lisa,
> 
> I have done a child package of cgi.ads (from David A. Wheeler) to handle
> cookies.
> 
> The packages spec/body are small so I have included them in this message.
> 
> Pascal.



hello Pascal,

In your posting you didn't include the package...

    Table_Of_Static_Keys_And_Static_Values_G

which is no doubt easy to write, but i've got no time to do it (and it is
for someone else's subject after all! :-)

Would it be possible for you to post this package to me, so i can place it
in the public directory for our students?


Thanks,

Dale

Re: cookies

[Lisa Winkworth]

David C. Hoos, Sr <david.c.hoos.sr@ada95.com> wrote:

: Dale Stanbrough wrote in message ...
:>hello Pascal,
:>
:>In your posting you didn't include the package...
:>
:>    Table_Of_Static_Keys_And_Static_Values_G
:>
: You'll find everything you need on this site :

: http://lglwww.epfl.ch/Components/ADT/directory.html

: Actually you need more that "Table_Of_Static_Keys_And_Static_Values_G"
: because
: this package use some others, but as I said everything should be on this Web
: site.

: Pascal.

Thanks for the help Pascal :)  'tis much appreciated :)
Lisa.



-- 
                          liswin@cs.rmit.edu.au

	      Devils speak of the ways in which she'll manifest
              Angels bleed from the tainted touch of my caress
	       Need to contaminate to alleviate this lonliness	
	         I now know the depths I reach are limitless