initial commit after reorganization

Author: Daniel Collins

.gitignore

@@ -0,0 +1,10 @@
+*~
+*.orig
+*.swp
+*.out
+*.rej
+*.ali
+*.o
+
+/bin
+

LICENSE

@@ -0,0 +1,21 @@
+This program (all files herein) is hereby placed in the public domain.
+
+If you live in a country which does not regcognize the above commission,
+you may wish to instead use this program under a liberal license, below.
+
+-------
+
+Alternatively, this program is licensed to you under the following terms:
+
+Copyright (C) 2020, Daniel C.
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
+RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

build.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+gnatmake test

http-request.adb

@@ -0,0 +1,98 @@
+with Ada.Text_IO; use Ada.Text_IO;
+
+package body HTTP.Request is
+package body Parse is
+   procedure Debug (Ctx : in Context; Str : in String) is
+	  function Slice (Idx:    in HTTP.Indexes; Str : in String) return String
+	  is        (Str (Idx.First .. Idx.Last));
+   begin
+	  Put_Line ("KIND: " & Slice (Ctx.Split.Line.Kind, Str));
+	  Put_Line ("PATH: " & Slice (Ctx.Split.Line.Path, Str));
+	  Put_Line ("VERS: " & Slice (Ctx.Split.Line.Vers, Str));
+	  for I in Integer range 1 .. Ctx.Split.Cnt-1 loop
+		 Put_Line ("["
+		             & Slice (Ctx.Split.Headers (I).Key, Str) & ": "
+		             & Slice (Ctx.Split.Headers (I).Val, Str)
+		             &
+		           "]");
+	  end loop;
+	  Put_Line ("TERMINAL STATE: " & Parse_State'Image (Ctx.State));
+   end Debug;
+
+   package State is
+	  type Char_Table is array (Character)   of Parse_State;
+	  type Step_Table is array (Parse_State) of  Char_Table;
+
+	  subtype Up  is Character range 'A' .. 'Z';
+	  subtype Low is Character range 'a' .. 'z';
+	  subtype Num is Character range '0' .. '9';
+
+	  CR : constant Character := ASCII.CR; LF : constant Character := ASCII.LF;
+
+	  -- A mealy machine expressed as a lookup table, for request parsing;
+	  Table : Step_Table :=
+		(
+		 Kind => (Up => Kind,     ' ' => Path,                 others => Err),
+		 Path => (Up | Low |'/' | '.' => Path,    ' ' => Pref, others => Err),
+		 Pref => (Up | Num |'/' | '.' => Pref,     CR => Line, others => Err),
+		 --------------------------------------------------------------------
+		 -- TODO: ... Perhaps put the transitions for Responses here.
+		 --------------------------------------------------------------------
+		 Line => (                                 LF => Head, others => Err),
+		 Head => (Up|Low|'-' => Head, ':' => SSep, CR => Term, others => Err),
+		 SSep       => ( ' ' => HBod, others => Err ),
+		 HBod       => (CR   => Line, others => HBod),
+		 Term       => (LF   => Done, others => Err ),
+		 Done       => (others => Overread),
+		 Overread   => (others => Overread), -- Maps to itself.
+		 Err        => (others => Err    )); -- Maps to itself.
+
+	  function Step (St : Parse_State; Ch : Character) return Parse_State
+	  is                 (State.Table (St) (Ch));
+   end State;
+
+   procedure Update_Split (Req      : in out As_Sliced;
+                           Prv, Nxt : in     Parse_State;
+                           Count    : in     Natural) is
+	  procedure Update (Next_Indxs  : in out Indexes;
+	                    Transition  : in     Boolean) is
+	  begin
+		 if Transition then Next_Indxs.First := Count + 1; end if;
+		                    Next_Indxs.Last  := Count;
+	  end Update;
+
+	  Trans : Boolean := Prv /= Nxt;
+   begin -- TODO: Use inheiritance + casting to have a single function.
+	  case Nxt is
+		 when Kind => Update (Req.Line.Kind, False);
+		 when Path => Update (Req.Line.Path, Trans);
+		 when Pref => Update (Req.Line.Vers, Trans);
+		 when Head => Update (Req.Headers (Req.Cnt).Key, Trans);
+		 when HBod => Update (Req.Headers (Req.Cnt).Val, Trans);
+		 when Line => Req.Cnt := Req.Cnt + 1;
+		 when others => null;
+	  end case;
+   end Update_Split;
+
+   procedure One_Char (Ctx : in out Context; Char : in Character) is
+	  Next_State : Parse_State;
+   begin
+	  Next_State := State.Step(Ctx.State, Char);
+	  Update_Split (Ctx.Split, Ctx.State, Next_State, Ctx.Count);
+
+	  Ctx. Count := Ctx. Count + 1;
+	  Ctx. State := Next_State;
+   end One_Char;
+
+   procedure Str_Read (Ctx: in out Context; Str: in String; Cnt: out Natural) is
+	  Original : Positive := Ctx.Count;
+   begin
+	  for I in Str'Range loop
+		 One_Char (Ctx, Str (I));
+		 exit when Ctx. State = Done;
+	  end loop;
+
+	  Cnt := Ctx. Count - Original;
+   end Str_Read;
+end Parse;
+end HTTP.Request;

http-request.ads

@@ -0,0 +1,65 @@
+package HTTP.Request with SPARK_Mode => On
+is
+   package Sliced is
+	  type Header is record
+		 Key : Indexes;
+		 Val : Indexes;
+	  end record;
+	  subtype Header_Index is Natural range 1 ..  20;
+	  type    Header_List  is array (Header_Index) of Header;
+
+	  type Request_Line is record
+		 Kind : Indexes; -- Get, Post, ect.
+		 Path : Indexes;
+		 Vers : Indexes;
+	  end record;
+
+	  type Request is record
+		 Line    : Request_Line;
+		 Headers : Header_List;
+		 Cnt     : Natural := 0;
+	  end record;
+   end Sliced;
+
+   type As_Stored is null record; -- TODO;
+   type As_Sliced is new Sliced.Request;
+   type Parse_State is private;
+
+
+   -- Note: Parse is a separate nested pacakge.
+   package Parse is
+	  type Context is private;
+	  procedure One_Char (Ctx : in out Context; Char: in Character);
+	  procedure Str_Read (Ctx : in out Context; Str : in String; Cnt: out Natural);
+	  procedure Debug    (Ctx : in     Context; Str : in String);
+
+   private
+	  type Context is record
+		 State : Parse_State;
+		 Split : As_Sliced;      -- TODO: Better names for ``Count''
+		 Count : Positive := 1;  -- Position of incoming char (1st, 2nd, ..)
+	  end record;
+   end Parse;
+
+-- Note: Parse is a separate nested package.
+
+private
+   type Parse_State is (
+	  -- Request Header --
+	  Kind, -- Kind: The request method type; Get, Post, ect.
+	  Path,
+	  Pref, -- HTTP version preferred by client.
+
+	  Line, -- Waiting for the rest of the carriage return sequence.
+	  Head, -- Gathering the name of header (Part preceeded by colon ':').
+	  SSep, -- Remainder of separator, following colon; (a single space).
+	  HBod, -- Body of header. (Following the colon and space);
+
+	  -- Final CRLF; HTTP Requests terminated by an additional CRLF sequence;
+	  -- These states represent this final evenuality.
+	  Term,     -- Remainder of terminal CRLF sequence (the LF ('\n') part);
+	  Done,     -- Done reading all the header sections!
+	  Overread, -- A character was fed after all header sections done with!
+	  Err       -- Error state; Signals that an error occurred.
+	 ) with Default_Value => Kind;
+end HTTP.Request;

http.ads

@@ -0,0 +1,14 @@
+--
+-- Nice little HTTP 1.x request parser. Uses a state machine.
+-- Operates by cutting up the incoming request string into sections.
+--
+
+package HTTP with SPARK_Mode => On
+is
+   type Version is delta 0.1 range 1.0 .. 9.9;
+
+   type Indexes is record
+	  First : Natural := 1;
+	  Last  : Natural := 0;
+   end record;
+end HTTP;

test.adb

@@ -0,0 +1,18 @@
+with HTTP;         use HTTP;
+with HTTP.Request; use HTTP.Request;
+
+procedure Test is
+   CRLF        : constant String := ASCII.CR & ASCII.LF;
+   Test_String : constant String :=
+	 "GET /index.html HTTP/1.1"                                   & CRLF &
+	 "User-Agent: Mozilla/4.0 (compatible; MSIE5.01; Windows NT)" & CRLF &
+	 "Host: www.adaisquitecool.com"                               & CRLF &
+	 "Accept-Language: en-us"                                     & CRLF &
+	 "Accept-Encoding: gzip, deflate"                             & CRLF &
+	 "Connection: Keep-Alive"                                     & CRLF & CRLF;
+   HTTP_Parser : Parse.Context;
+   Read_Length :       Natural;
+begin
+   Parse.Str_Read (HTTP_Parser, Test_String, Read_Length);
+   Parse.Debug    (HTTP_Parser, Test_String);
+end Test;