------------------------------------------------------------------------------ -- Ada Web Server -- -- -- -- Copyright (C) 2021, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 3, 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. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are -- -- granted additional permissions described in the GCC Runtime Library -- -- Exception, version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- 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. -- ------------------------------------------------------------------------------ with Ada.Integer_Text_IO; with Ada.Text_IO; with AWS.HTTP2.Frame.Continuation; with AWS.HTTP2.Frame.Data; with AWS.HTTP2.Frame.GoAway; with AWS.HTTP2.Frame.Headers; with AWS.HTTP2.Frame.Ping; with AWS.HTTP2.Frame.Priority; with AWS.HTTP2.Frame.Push_Promise; with AWS.HTTP2.Frame.RST_Stream; with AWS.HTTP2.Frame.Settings; with AWS.HTTP2.Frame.Window_Update; with AWS.Net.Buffered; package body AWS.HTTP2.Frame is use Ada.Text_IO; ------------ -- Adjust -- ------------ overriding procedure Adjust (Self : in out Object) is begin Self.Counter.all := Self.Counter.all + 1; end Adjust; ---------- -- Dump -- ---------- procedure Dump (Self : Object'Class; Message : String) is begin Put (Message & " - FRAME: Id:" & Integer (Self.Header.H.Stream_Id)'Img); Put (" L:" & Integer (Self.Header.H.Length)'Img); Integer_Text_IO.Put (Integer (Self.Header.H.Length), Width => 12, Base => 16); Put_Line (" Kind: " & Self.Header.H.Kind'Img & " Flags:" & Self.Header.H.Flags'Img); Self.Dump_Payload; end Dump; -------------- -- Finalize -- -------------- overriding procedure Finalize (Self : in out Object) is Ref_Counter : Utils.Counter_Access := Self.Counter; begin -- Ensure call is idempotent Self.Counter := null; if Ref_Counter /= null then Ref_Counter.all := Ref_Counter.all - 1; if Ref_Counter.all = 0 then -- Call to Release (Self); or Self.Release; does not dispatch. -- Need GNAT bug report. Release (Object'Class (Self)); Utils.Unchecked_Free (Ref_Counter); end if; end if; end Finalize; ---------------- -- Initialize -- ---------------- overriding procedure Initialize (Self : in out Object) is begin Self.Counter := new Natural'(1); end Initialize; -------------- -- Is_Valid -- -------------- function Is_Valid (Self : Object'Class; Settings : Connection.Object; Error : out Error_Codes) return Boolean is begin Error := Self.Validate (Settings); return Error = C_No_Error; end Is_Valid; ---------- -- Read -- ---------- function Read (Sock : Net.Socket_Type'Class; Settings : Connection.Object) return Object'Class is H : Object; begin -- Get the frame header Net.Buffered.Read (Sock, H.Header.S); -- The frame is invalid, do not try to build the payload, return now if not H.Header.H.Kind'Valid then if Debug then Put ("INALID "); Utils.Dump_Binary (H.Header.S); end if; H.Header.H.Kind := K_Invalid; end if; if H.Validate (Settings) /= C_No_Error then return H; end if; -- Get the frame payload case H.Header.H.Kind is when K_Data => return Frame.Data.Read (Sock, H); when K_Settings => return Frame.Settings.Read (Sock, H); when K_Headers => return Frame.Headers.Read (Sock, H); when K_Window_Update => return Frame.Window_Update.Read (Sock, H); when K_RST_Stream => return Frame.RST_Stream.Read (Sock, H); when K_GoAway => return Frame.GoAway.Read (Sock, H); when K_Continuation => return Frame.Continuation.Read (Sock, H); when K_Ping => return Frame.Ping.Read (Sock, H); when K_Priority => return Frame.Priority.Read (Sock, H); when K_Push_Promise => return Frame.Push_Promise.Read (Sock, H); when K_Invalid => raise Protocol_Error with Exception_Message (C_Protocol_Error, "invalid frame kind"); end case; end Read; ---------- -- Send -- ---------- procedure Send (Self : Object'Class; Sock : Net.Socket_Type'Class) is begin if HTTP2.Debug then Self.Dump ("SEND"); end if; -- Send header Net.Buffered.Write (Sock, Self.Header.S); -- Send payload if any if Self.Header.H.Length > 0 then Self.Send_Payload (Sock); end if; Net.Buffered.Flush (Sock); end Send; -------------- -- Set_Flag -- -------------- procedure Set_Flag (Self : in out Object; Flag : Flags_Type; Value : Boolean := True) is begin Self.Header.H.Flags := (if Value then Self.Header.H.Flags or Flag else Self.Header.H.Flags and not Flag); end Set_Flag; --------------- -- Set_Flags -- --------------- procedure Set_Flags (Self : in out Object; Flags : Flags_Type) is begin Self.Header.H.Flags := Flags; end Set_Flags; -------------- -- Validate -- -------------- function Validate (Self : Object; Settings : Connection.Object) return Error_Codes is Kind : Frame.Kind_Type renames Self.Header.H.Kind; Fixed_Size : constant Length_Type := (case Kind is when K_Priority => 5, when K_Ping => 8, when K_RST_Stream | K_Window_Update => 4, when others => 0); begin if Self.Length > Settings.Max_Frame_Size or else (Fixed_Size /= 0 and then Self.Header.H.Length /= Fixed_Size) then return C_Frame_Size_Error; elsif Kind = K_Invalid then return C_Protocol_Error; else return C_No_Error; end if; end Validate; end AWS.HTTP2.Frame;