From a013e43a0955c815b634a92e45d925dd8c5d1aac Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 18 Sep 2021 12:09:13 +0200 Subject: [PATCH 01/51] Add routine Normalize_Lower to share between cient & server code. Part of S507-051. --- src/core/aws-utils.adb | 16 +++++++++++++++- src/core/aws-utils.ads | 7 +++++++ 2 files changed, 22 insertions(+), 1 deletion(-) diff --git a/src/core/aws-utils.adb b/src/core/aws-utils.adb index ebd58e013..0f97d51ee 100644 --- a/src/core/aws-utils.adb +++ b/src/core/aws-utils.adb @@ -30,7 +30,6 @@ pragma Ada_2012; with Ada.Calendar.Time_Zones; -with Ada.Characters.Handling; with Ada.Integer_Text_IO; with Ada.Numerics.Discrete_Random; with Ada.Numerics.Long_Elementary_Functions; @@ -883,6 +882,21 @@ package body AWS.Utils is and then U_Str (1 .. Pattern'Length) = U_Pattern; end Match; + --------------------- + -- Normalize_Lower -- + --------------------- + + function Normalize_Lower + (Name : String; + To_Lower : Boolean) return String is + begin + if To_Lower then + return Characters.Handling.To_Lower (Name); + else + return Name; + end if; + end Normalize_Lower; + -------------------------- -- Normalized_Directory -- -------------------------- diff --git a/src/core/aws-utils.ads b/src/core/aws-utils.ads index 15d17c022..633b1ce35 100644 --- a/src/core/aws-utils.ads +++ b/src/core/aws-utils.ads @@ -30,6 +30,7 @@ pragma Ada_2012; with Ada.Calendar; +with Ada.Characters.Handling; with Ada.Directories; with Ada.Finalization; with Ada.Streams; @@ -206,6 +207,12 @@ package AWS.Utils is function Is_Valid_UTF8 (Value : Unbounded_String) return Boolean; -- Likewise for an unbounded string + function Normalize_Lower (Name : String; To_Lower : Boolean) return String + with Post => + (if To_Lower + then Normalize_Lower'Result = Characters.Handling.To_Lower (Name) + else Normalize_Lower'Result = Name); + --------------- -- Semaphore -- --------------- From 38d217c1a9e6cbce8ff3c50b644266ced3adca7d Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 18 Sep 2021 12:10:18 +0200 Subject: [PATCH 02/51] Routine HN is now using the Normalize_Lower routine. Part of S507-051. --- src/core/aws-client-http_utils.adb | 17 +---------------- 1 file changed, 1 insertion(+), 16 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 21fd9ba06..a864dae26 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -63,7 +63,7 @@ package body AWS.Client.HTTP_Utils is function HN (Header_Name : String; - Is_H2 : Boolean) return String with Inline; + Is_H2 : Boolean) return String renames Utils.Normalize_Lower; -- If Is_H2 the Header_Name is converted to lower case. Note that -- even in HTTP/1 the header name are not case sensitive, but it -- seems that some browsers (like IE) are somewhat broken when @@ -448,21 +448,6 @@ package body AWS.Client.HTTP_Utils is Disconnect; end Get_Response; - -------- - -- HN -- - -------- - - function HN - (Header_Name : String; - Is_H2 : Boolean) return String is - begin - if Is_H2 then - return Characters.Handling.To_Lower (Header_Name); - else - return Header_Name; - end if; - end HN; - ----------- -- Image -- ----------- From f3e3f67459a800b564785732100a401dfb5adae9 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 18 Sep 2021 12:10:59 +0200 Subject: [PATCH 03/51] Header in HTTP/2 must be lower case. Part of S507-051. --- src/core/aws-server-protocol_handler_v2.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index 0532ff847..2b2c3bbd4 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -337,7 +337,8 @@ is procedure Add_Header (Name, Value : String) is begin - Response.Set.Add_Header (R, Name, Value); + Response.Set.Add_Header + (R, Characters.Handling.To_Lower (Name), Value); end Add_Header; begin From 650e969ee4cdf8dbb5aa4aa63425fce218e1acce Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 18 Sep 2021 12:17:10 +0200 Subject: [PATCH 04/51] Add HTTP_Version parameter to all AWS.Client API. All API are supported properly except when there is attachments. Add regression test using simple SOAP call using HTTP/2. Part of S507-051. --- regtests/0345_http2_soap_hello/test.opt | 1 + regtests/0345_http2_soap_hello/test.out | 1 + regtests/0345_http2_soap_hello/test.py | 4 + .../0345_http2_soap_hello/wsdl_h2hello.adb | 116 +++++++++++++++ .../0345_http2_soap_hello/wsdl_h2hello.gpr | 24 ++++ .../0345_http2_soap_hello/wsdl_h2hello.wsdl | 131 +++++++++++++++++ src/core/aws-client.adb | 132 ++++++++++-------- src/core/aws-client.ads | 107 +++++++------- 8 files changed, 403 insertions(+), 113 deletions(-) create mode 100644 regtests/0345_http2_soap_hello/test.opt create mode 100644 regtests/0345_http2_soap_hello/test.out create mode 100644 regtests/0345_http2_soap_hello/test.py create mode 100644 regtests/0345_http2_soap_hello/wsdl_h2hello.adb create mode 100644 regtests/0345_http2_soap_hello/wsdl_h2hello.gpr create mode 100644 regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl diff --git a/regtests/0345_http2_soap_hello/test.opt b/regtests/0345_http2_soap_hello/test.opt new file mode 100644 index 000000000..c955c181d --- /dev/null +++ b/regtests/0345_http2_soap_hello/test.opt @@ -0,0 +1 @@ +!xmlada DEAD diff --git a/regtests/0345_http2_soap_hello/test.out b/regtests/0345_http2_soap_hello/test.out new file mode 100644 index 000000000..ff376b71c --- /dev/null +++ b/regtests/0345_http2_soap_hello/test.out @@ -0,0 +1 @@ +Hello AWS and welcome in H2! 12 diff --git a/regtests/0345_http2_soap_hello/test.py b/regtests/0345_http2_soap_hello/test.py new file mode 100644 index 000000000..6eaf64962 --- /dev/null +++ b/regtests/0345_http2_soap_hello/test.py @@ -0,0 +1,4 @@ +from test_support import * + +exec_cmd('wsdl2aws', ['-q', '-f', '-doc', 'wsdl_h2hello.wsdl']) +build_and_run('wsdl_h2hello') diff --git a/regtests/0345_http2_soap_hello/wsdl_h2hello.adb b/regtests/0345_http2_soap_hello/wsdl_h2hello.adb new file mode 100644 index 000000000..c4d7846cb --- /dev/null +++ b/regtests/0345_http2_soap_hello/wsdl_h2hello.adb @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +-- SOAP/WSDL test + +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Config.Set; +with AWS.MIME; +with AWS.Net; +with AWS.Response; +with AWS.Server.Status; +with AWS.Status; + +with SOAP.Types; +with SOAP.Utils; + +with R_Hello_Demo.Client; +with R_Hello_Demo.Server; +with R_Hello_Demo.Types; + +procedure WSDL_H2Hello is + + use Ada.Strings.Unbounded; + use AWS; + use R_Hello_Demo.Types; + + H_Server : Server.HTTP; + CNF : Config.Object; + + procedure WSDL_Demo_Client is + use Ada; + R : Sayhello_Result; + begin + R := R_Hello_Demo.Client.sayHello (Firstname => "AWS"); + Text_IO.Put_Line + (To_String (R.Message) & SOAP.Types.Short'Image (R.Token)); + end WSDL_Demo_Client; + + function sayHello (Firstname : String) return Sayhello_Result; + + ------------- + -- SOAP_CB -- + ------------- + + function SOAP_CB is new R_Hello_Demo.Server.sayHello_CB (sayHello); + + function SOAP_Wrapper is new SOAP.Utils.SOAP_Wrapper (SOAP_CB); + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + SOAPAction : constant String := Status.SOAPAction (Request); + begin + if SOAPAction = "sayHello" then + return SOAP_Wrapper (Request); + else + return Response.Build (MIME.Text_HTML, "

Not a SOAP request"); + end if; + end CB; + + -------------- + -- sayHello -- + -------------- + + function sayHello (Firstname : String) return Sayhello_Result is + begin + return + (To_Unbounded_String + ("Hello " & Firstname & " and welcome in H2!"), 12); + end sayHello; + +begin + Config.Set.Server_Name (CNF, "WSDL Hello demo"); + Config.Set.Server_Host (CNF, "localhost"); + Config.Set.Server_Port (CNF, R_Hello_Demo.Server.Port); + Config.Set.HTTP2_Activated (CNF, True); + + Server.Start (H_Server, CB'Unrestricted_Access, CNF); + + if Net.IPv6_Available then + -- Need to start second server on same port but on the different + -- Protocol_Family because we do not know which family would client try + -- to connect. + + if AWS.Server.Status.Is_IPv6 (H_Server) then + Server.Add_Listening + (H_Server, "localhost", R_Hello_Demo.Server.Port, Net.FAMILY_INET); + else + Server.Add_Listening + (H_Server, "localhost", R_Hello_Demo.Server.Port, Net.FAMILY_INET6); + end if; + end if; + + WSDL_Demo_Client; + + Server.Shutdown (H_Server); +end WSDL_H2Hello; diff --git a/regtests/0345_http2_soap_hello/wsdl_h2hello.gpr b/regtests/0345_http2_soap_hello/wsdl_h2hello.gpr new file mode 100644 index 000000000..485cf66bc --- /dev/null +++ b/regtests/0345_http2_soap_hello/wsdl_h2hello.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project WSDL_H2Hello is + for Source_Dirs use ("."); + for Main use ("wsdl_h2hello.adb"); +end WSDL_H2Hello; diff --git a/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl b/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl new file mode 100644 index 000000000..f2526921f --- /dev/null +++ b/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl @@ -0,0 +1,131 @@ + + + + + + + + + A set of float + + + + + + + + + + + + + A message/token pair + + + + + + + The reponse string. + + + + + + + Value representing the length of the response. + + + + + + + + + + + + + + + + + + + + + + + + + This web service provides a simple Hello World. + + + + Called with a firstName, and returns a greeting message. + This is very simple SOAP callback. The input message is a simple string, + the response is a complexType with the response and a uniq token value. + + + + + + + just for the documentation validation. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + WSDL File for Hello AWS Demo. + + + + + + diff --git a/src/core/aws-client.adb b/src/core/aws-client.adb index 5ccd91041..c3ad140d1 100644 --- a/src/core/aws-client.adb +++ b/src/core/aws-client.adb @@ -114,18 +114,19 @@ package body AWS.Client is ------------ function Create - (Host : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Retry : Natural := Retry_Default; - Persistent : Boolean := True; - Timeouts : Timeouts_Values := No_Timeout; - Server_Push : Boolean := False; - Certificate : String := Default.Client_Certificate; - User_Agent : String := Default.User_Agent) + (Host : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Retry : Natural := Retry_Default; + Persistent : Boolean := True; + Timeouts : Timeouts_Values := No_Timeout; + Server_Push : Boolean := False; + Certificate : String := Default.Client_Certificate; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return HTTP_Connection is begin return Connection : HTTP_Connection do @@ -134,7 +135,7 @@ package body AWS.Client is Proxy, Proxy_User, Proxy_Pwd, Retry, Persistent, Timeouts, Server_Push, - Net.SSL.Null_Config, Certificate, User_Agent); + Net.SSL.Null_Config, Certificate, User_Agent, HTTP_Version); end return; end Create; @@ -252,44 +253,47 @@ package body AWS.Client is ------------ function Delete - (URL : String; - Data : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data + (URL : String; + Data : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data is begin return Delete (URL, Translator.To_Stream_Element_Array (Data), User, Pwd, Proxy, Proxy_User, Proxy_Pwd, Timeouts, - Headers, User_Agent); + Headers, User_Agent, HTTP_Version); end Delete; function Delete - (URL : String; - Data : Stream_Element_Array; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data + (URL : String; + Data : Stream_Element_Array; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data is Connection : HTTP_Connection; Result : Response.Data; begin Create (Connection, URL, User, Pwd, Proxy, Proxy_User, Proxy_Pwd, - Persistent => False, - Timeouts => Timeouts, - User_Agent => User_Agent); + Persistent => False, + Timeouts => Timeouts, + User_Agent => User_Agent, + HTTP_Version => HTTP_Version); Delete (Connection, Result, Data, Headers => Headers); Close (Connection); @@ -525,15 +529,16 @@ package body AWS.Client is ---------- function Head - (URL : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) + (URL : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data is Connection : HTTP_Connection; @@ -541,9 +546,10 @@ package body AWS.Client is begin Create (Connection, URL, User, Pwd, Proxy, Proxy_User, Proxy_Pwd, - Persistent => False, - Timeouts => Timeouts, - User_Agent => User_Agent); + Persistent => False, + Timeouts => Timeouts, + User_Agent => User_Agent, + HTTP_Version => HTTP_Version); Head (Connection, Result, Headers => Headers); Close (Connection); @@ -745,25 +751,27 @@ package body AWS.Client is --------- function Put - (URL : String; - Data : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data + (URL : String; + Data : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data is Connection : HTTP_Connection; Result : Response.Data; begin Create (Connection, URL, User, Pwd, Proxy, Proxy_User, Proxy_Pwd, - Persistent => False, - Timeouts => Timeouts, - User_Agent => User_Agent); + Persistent => False, + Timeouts => Timeouts, + User_Agent => User_Agent, + HTTP_Version => HTTP_Version); Put (Connection, Result, Data, Headers => Headers); Close (Connection); diff --git a/src/core/aws-client.ads b/src/core/aws-client.ads index 097fddae0..a338e7741 100644 --- a/src/core/aws-client.ads +++ b/src/core/aws-client.ads @@ -164,57 +164,61 @@ package AWS.Client is -- Get will retry one time if it fails. function Head - (URL : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data; + (URL : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data; -- Idem as above but we do not get the message body. -- Head will retry one time if it fails. function Put - (URL : String; - Data : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data; + (URL : String; + Data : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data; -- Send to the server URL a PUT request with Data -- Put will retry one time if it fails. function Delete - (URL : String; - Data : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data; + (URL : String; + Data : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data; -- Send to the server URL a DELETE request with Data -- Delete will retry one time if it fails. function Delete - (URL : String; - Data : Stream_Element_Array; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Timeouts : Timeouts_Values := No_Timeout; - Headers : Header_List := Empty_Header_List; - User_Agent : String := Default.User_Agent) return Response.Data; + (URL : String; + Data : Stream_Element_Array; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Timeouts : Timeouts_Values := No_Timeout; + Headers : Header_List := Empty_Header_List; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return Response.Data; -- Send to the server URL a DELETE request with Data -- Delete will retry one time if it fails. @@ -296,18 +300,19 @@ package AWS.Client is type HTTP_Connection_Access is access all HTTP_Connection; function Create - (Host : String; - User : String := No_Data; - Pwd : String := No_Data; - Proxy : String := No_Data; - Proxy_User : String := No_Data; - Proxy_Pwd : String := No_Data; - Retry : Natural := Retry_Default; - Persistent : Boolean := True; - Timeouts : Timeouts_Values := No_Timeout; - Server_Push : Boolean := False; - Certificate : String := Default.Client_Certificate; - User_Agent : String := Default.User_Agent) + (Host : String; + User : String := No_Data; + Pwd : String := No_Data; + Proxy : String := No_Data; + Proxy_User : String := No_Data; + Proxy_Pwd : String := No_Data; + Retry : Natural := Retry_Default; + Persistent : Boolean := True; + Timeouts : Timeouts_Values := No_Timeout; + Server_Push : Boolean := False; + Certificate : String := Default.Client_Certificate; + User_Agent : String := Default.User_Agent; + HTTP_Version : HTTP_Protocol := HTTPv1) return HTTP_Connection; procedure Create From 719acf18ae0e56d8ef018cb921537beb6752a8f9 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sun, 19 Sep 2021 20:15:58 +0200 Subject: [PATCH 05/51] Add routine Get_Content to retrieve the streamed headers. Part of S507-051. --- src/core/aws-headers.adb | 19 +++++++++++++++++++ src/core/aws-headers.ads | 6 ++++++ 2 files changed, 25 insertions(+) diff --git a/src/core/aws-headers.adb b/src/core/aws-headers.adb index aa11b3a71..b9d483f34 100644 --- a/src/core/aws-headers.adb +++ b/src/core/aws-headers.adb @@ -73,6 +73,25 @@ package body AWS.Headers is Debug_Flag := Activate; end Debug; + ----------------- + -- Get_Content -- + ----------------- + + procedure Get_Content + (Headers : List; + End_Block : Boolean := False) + is + CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); + begin + for J in 1 .. Count (Headers) loop + Data (Get_Line (Headers, J) & CRLF); + end loop; + + if End_Block then + Data (CRLF); + end if; + end Get_Content; + -------------- -- Get_Line -- -------------- diff --git a/src/core/aws-headers.ads b/src/core/aws-headers.ads index 601d66a47..054ea5c5c 100644 --- a/src/core/aws-headers.ads +++ b/src/core/aws-headers.ads @@ -55,6 +55,12 @@ package AWS.Headers is End_Block : Boolean := False); -- Send all header lines in Headers list to the socket + generic + with procedure Data (Value : String); + procedure Get_Content + (Headers : List; + End_Block : Boolean := False); + function Get_Line (Headers : List; N : Positive) return String with Post => (N > Count (Headers) and then Get_Line'Result'Length = 0) From 684e6e36fc08ecdd726856bc0781176ccb35123a Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sun, 19 Sep 2021 20:19:51 +0200 Subject: [PATCH 06/51] Add new routines Get_Content & Get_MIME_Header. Those routines can be used to get the streamed content for a list of attachments. Part of S507-051. --- src/core/aws-attachments.adb | 331 ++++++++++++++++++++++++++++++++++- src/core/aws-attachments.ads | 18 +- 2 files changed, 347 insertions(+), 2 deletions(-) diff --git a/src/core/aws-attachments.adb b/src/core/aws-attachments.adb index 2d6b4f52a..ba70c4e94 100644 --- a/src/core/aws-attachments.adb +++ b/src/core/aws-attachments.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2004-2017, AdaCore -- +-- Copyright (C) 2004-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 -- @@ -331,6 +331,335 @@ package body AWS.Attachments is raise Constraint_Error; end Get; + ----------------- + -- Get_Content -- + ----------------- + + procedure Get_Content + (Attachments : List; + Boundary : String) + is + CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); + + procedure Send_Attachment (Attachment : Element); + -- Sends one Attachment, including the start boundary + + procedure Send_Content (Attachment : Element); + -- Set an in-memory content + + procedure Send_Content (Data : Content); + + procedure Send_Alternative (Attachment : Element); + -- Send an alternative part + + procedure Put_Line (Data : String) with Inline; + procedure Put (Data : String) with Inline; + procedure New_Line with Inline; + procedure Write (Data : Stream_Element_Array) with Inline; + + Pref_Suf : constant String := "--"; + -- The MIME boundary prefix and suffix + + Simple_Alternative : constant Boolean := + Root_MIME (Attachments) = Multipart_Alternative; + + -------------- + -- New_Line -- + -------------- + + procedure New_Line is + begin + Get_Content.Data (CRLF); + end New_Line; + + --------- + -- Put -- + --------- + + procedure Put (Data : String) is + begin + Get_Content.Data (Data); + end Put; + + -------------- + -- Put_Line -- + -------------- + + procedure Put_Line (Data : String) is + begin + Get_Content.Data (Data & CRLF); + end Put_Line; + + ---------------------- + -- Send_Alternative -- + ---------------------- + + procedure Send_Alternative (Attachment : Element) is + + procedure Get_MIME_Header_Content is new Get_MIME_Header (Put); + + A_Boundary : Unbounded_String; + begin + if not Simple_Alternative then + -- This is not the first element, we issue an embedded MIME + -- content. + Data (Pref_Suf & Boundary); + + Get_MIME_Header_Content + (Attachments, + Alternative => True, + Boundary => A_Boundary); + else + A_Boundary := To_Unbounded_String (Boundary); + end if; + + -- Send alternatives + + for Part of Attachment.Parts loop + Put_Line (Pref_Suf & To_String (A_Boundary)); + Put_Line (Messages.Content_Type (To_String (Part.Content_Type))); + New_Line; + + Send_Content (Part); + end loop; + + if not Simple_Alternative then + -- Ends the alternative part + New_Line; + Put_Line (Pref_Suf & To_String (A_Boundary) & Pref_Suf); + end if; + end Send_Alternative; + + --------------------- + -- Send_Attachment -- + --------------------- + + procedure Send_Attachment (Attachment : Element) is + begin + case Attachment.Kind is + when Data => Send_Content (Attachment); + when Alternative => Send_Alternative (Attachment); + end case; + end Send_Attachment; + + ------------------ + -- Send_Content -- + ------------------ + + procedure Send_Content (Attachment : Element) is + + procedure Get_Header_Content is + new AWS.Headers.Get_Content (Put); + + begin + -- Send multipart message start boundary + + Put_Line (Pref_Suf & Boundary); + + -- Send header + + Get_Header_Content (Attachment.Headers); + New_Line; + + Send_Content (Attachment.Data); + end Send_Content; + + procedure Send_Content (Data : Content) is + + procedure Send_File; + + procedure Send_Content; + + ------------------ + -- Send_Content -- + ------------------ + + procedure Send_Content is + Content_Len : constant Positive := Length (Data.Content); + + procedure Send; + -- Send standard content + + procedure Send_Base64; + -- Send a base64 content + + ---------- + -- Send -- + ---------- + + procedure Send is + Chunk_Shift : constant := 1023; + K : Positive := 1; + L : Natural; + begin + loop + L := Integer'Min (K + Chunk_Shift, Content_Len); + Put (Slice (Data.Content, K, L)); + exit when L = Content_Len; + K := L + 1; + end loop; + + New_Line; + end Send; + + ----------------- + -- Send_Base64 -- + ----------------- + + procedure Send_Base64 is + Chunk_Size : constant := 60; + K : Positive := 1; + begin + while K <= Content_Len loop + if K + Chunk_Size - 1 > Content_Len then + Put_Line (Slice (Data.Content, K, Content_Len)); + K := Content_Len + 1; + else + Put_Line (Slice (Data.Content, K, K + Chunk_Size - 1)); + K := K + Chunk_Size; + end if; + end loop; + end Send_Base64; + + begin + case Data.Encode is + when None => Send; + when Base64 => Send_Base64; + end case; + end Send_Content; + + --------------- + -- Send_File -- + --------------- + + procedure Send_File is + + procedure Send; + -- Send file as-is + + procedure Send_Base64; + -- Send file encoded in Base64 + + File : Streams.Stream_IO.File_Type; + + ---------- + -- Send -- + ---------- + + procedure Send is + Buffer : Streams.Stream_Element_Array (1 .. 4_096); + Last : Streams.Stream_Element_Offset; + begin + -- Send file content + + while not Streams.Stream_IO.End_Of_File (File) loop + Streams.Stream_IO.Read (File, Buffer, Last); + Write (Buffer (1 .. Last)); + end loop; + + New_Line; + exception + when Net.Socket_Error => + -- Properly close the file if needed + if Streams.Stream_IO.Is_Open (File) then + Streams.Stream_IO.Close (File); + end if; + raise; + end Send; + + ----------------- + -- Send_Base64 -- + ----------------- + + procedure Send_Base64 is + Buffer_Size : constant := 60; + -- Note that this size must be a multiple of 3, this is + -- important to have proper chunk MIME encoding. + + Buffer : Streams.Stream_Element_Array (1 .. Buffer_Size); + Last : Streams.Stream_Element_Offset; + begin + while not Streams.Stream_IO.End_Of_File (File) loop + Streams.Stream_IO.Read (File, Buffer, Last); + + Put_Line (AWS.Translator.Base64_Encode (Buffer (1 .. Last))); + end loop; + end Send_Base64; + + begin + Stream_IO.Open + (File, Streams.Stream_IO.In_File, To_String (Data.Filename)); + + case Data.Encode is + when None => Send; + when Base64 => Send_Base64; + end case; + + Stream_IO.Close (File); + end Send_File; + + begin + case Data.Kind is + when File => Send_File; + when AWS.Attachments.Data => Send_Content; + end case; + end Send_Content; + + ----------- + -- Write -- + ----------- + + procedure Write (Data : Stream_Element_Array) is + begin + Put (Translator.To_String (Data)); + end Write; + + begin + -- Send the attachments + + for J in 1 .. Integer (Attachments.Vector.Length) loop + Send_Attachment + (Attachment_Table.Element + (Container => Attachments.Vector, + Index => J)); + end loop; + + -- Send multipart message end boundary + + Put_Line (Pref_Suf & Boundary & Pref_Suf); + end Get_Content; + + --------------------- + -- Get_MIME_Header -- + --------------------- + + procedure Get_MIME_Header + (Attachments : List; + Boundary : out Unbounded_String; + Alternative : Boolean := False) + is + CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); + L_Boundary : constant String := + "----=_NextPart_" & Utils.Random_String (10) & "." + & Utils.Image (UID.Value); + begin + UID.Increment; + + Boundary := To_Unbounded_String (L_Boundary); + + if Alternative + or else Root_MIME (Attachments) = Multipart_Alternative + then + Data + (Messages.Content_Type ("multipart/alternative", L_Boundary) + & CRLF); + else + Data (Messages.Content_Type ("multipart/mixed", L_Boundary) & CRLF); + end if; + + Data (CRLF); + end Get_MIME_Header; + ------------- -- Headers -- ------------- diff --git a/src/core/aws-attachments.ads b/src/core/aws-attachments.ads index 1e96a3f10..09c40424d 100644 --- a/src/core/aws-attachments.ads +++ b/src/core/aws-attachments.ads @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2004-2017, AdaCore -- +-- Copyright (C) 2004-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 -- @@ -152,6 +152,14 @@ package AWS.Attachments is => AWS.Attachments.Content_Id (Get (Attachments, K)) = Content_Id); -- Returns the Attachment with the Content Id + generic + with procedure Data (Chunk : String); + procedure Get_Content + (Attachments : List; + Boundary : String); + -- Create the content to be sent for all attachments, call Data for each + -- pieve of data. + generic with procedure Action (Attachment : Element; @@ -194,6 +202,14 @@ package AWS.Attachments is -- Returns the complete size of all attachments including the surrounding -- boundaries. + generic + with procedure Data (Value : String); + procedure Get_MIME_Header + (Attachments : List; + Boundary : out Unbounded_String; + Alternative : Boolean := False); + -- Output MIME header, returns the boundary for the content + procedure Send_MIME_Header (Socket : Net.Socket_Type'Class; Attachments : List; From 88e6f1de025580b3f703bb4840c519967ead0e40 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sun, 19 Sep 2021 20:20:43 +0200 Subject: [PATCH 07/51] Rework Send_Content to use the new Get_Content routine. Part of S507-051. --- src/core/aws-headers.adb | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/src/core/aws-headers.adb b/src/core/aws-headers.adb index b9d483f34..40fa82694 100644 --- a/src/core/aws-headers.adb +++ b/src/core/aws-headers.adb @@ -269,14 +269,26 @@ package body AWS.Headers is procedure Send_Header (Socket : Net.Socket_Type'Class; Headers : List; - End_Block : Boolean := False) is + End_Block : Boolean := False) + is + procedure Send (Value : String); + -- Send data over socket + + ---------- + -- Send -- + ---------- + + procedure Send (Value : String) is + begin + Net.Buffered.Put (Socket, Value); + end Send; + + procedure Send_Headers_Content is new Get_Content (Send); + begin - for J in 1 .. Count (Headers) loop - Net.Buffered.Put_Line (Socket, Get_Line (Headers, J)); - end loop; + Send_Headers_Content (Headers, End_Block); if End_Block then - Net.Buffered.New_Line (Socket); Net.Buffered.Flush (Socket); end if; end Send_Header; From f446680621071ac9577cea9efdde456e35f1111e Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sun, 19 Sep 2021 20:29:03 +0200 Subject: [PATCH 08/51] Rework implementation of Send & Send_MIME_Header. Those are now using the newly introduced Get_Content and Get_MIME_Header. Part of S507-051. --- src/core/aws-attachments.adb | 280 +++-------------------------------- 1 file changed, 22 insertions(+), 258 deletions(-) diff --git a/src/core/aws-attachments.adb b/src/core/aws-attachments.adb index ba70c4e94..d1b3a55a9 100644 --- a/src/core/aws-attachments.adb +++ b/src/core/aws-attachments.adb @@ -403,7 +403,7 @@ package body AWS.Attachments is if not Simple_Alternative then -- This is not the first element, we issue an embedded MIME -- content. - Data (Pref_Suf & Boundary); + Put_Line (Pref_Suf & Boundary); Get_MIME_Header_Content (Attachments, @@ -771,251 +771,21 @@ package body AWS.Attachments is Boundary : String) is - procedure Send_Attachment (Attachment : Element); - -- Sends one Attachment, including the start boundary - - procedure Send_Content (Attachment : Element); - -- Set an in-memory content - - procedure Send_Content (Data : Content); - - procedure Send_Alternative (Attachment : Element); - -- Send an alternative part - - Pref_Suf : constant String := "--"; - -- The MIME boundary prefix and suffix - - Simple_Alternative : constant Boolean := - Root_MIME (Attachments) = Multipart_Alternative; - - ---------------------- - -- Send_Alternative -- - ---------------------- + procedure Write (Data : String); - procedure Send_Alternative (Attachment : Element) is - A_Boundary : Unbounded_String; - begin - if not Simple_Alternative then - -- This is not the first element, we issue an embedded MIME - -- content. - Net.Buffered.Put_Line (Socket, Pref_Suf & Boundary); - Send_MIME_Header - (Socket, Attachments, - Alternative => True, - Boundary => A_Boundary); - else - A_Boundary := To_Unbounded_String (Boundary); - end if; - - -- Send alternatives - - for Part of Attachment.Parts loop - Net.Buffered.Put_Line (Socket, Pref_Suf & To_String (A_Boundary)); - Net.Buffered.Put_Line - (Socket, Messages.Content_Type (To_String (Part.Content_Type))); - Net.Buffered.New_Line (Socket); - - Send_Content (Part); - end loop; - - if not Simple_Alternative then - -- Ends the alternative part - Net.Buffered.New_Line (Socket); - Net.Buffered.Put_Line - (Socket, Pref_Suf & To_String (A_Boundary) & Pref_Suf); - end if; - end Send_Alternative; - - --------------------- - -- Send_Attachment -- - --------------------- - - procedure Send_Attachment (Attachment : Element) is - begin - case Attachment.Kind is - when Data => Send_Content (Attachment); - when Alternative => Send_Alternative (Attachment); - end case; - end Send_Attachment; - - ------------------ - -- Send_Content -- - ------------------ + ----------- + -- Write -- + ----------- - procedure Send_Content (Attachment : Element) is + procedure Write (Data : String) is begin - -- Send multipart message start boundary - - Net.Buffered.Put_Line (Socket, Pref_Suf & Boundary); - - -- Send header - - AWS.Headers.Send_Header (Socket, Attachment.Headers); - Net.Buffered.New_Line (Socket); - - Send_Content (Attachment.Data); - end Send_Content; - - procedure Send_Content (Data : Content) is - - procedure Send_File; - - procedure Send_Content; - - ------------------ - -- Send_Content -- - ------------------ - - procedure Send_Content is - Content_Len : constant Positive := Length (Data.Content); - - procedure Send; - -- Send standard content - - procedure Send_Base64; - -- Send a base64 content - - ---------- - -- Send -- - ---------- - - procedure Send is - Chunk_Shift : constant := 1023; - K : Positive := 1; - L : Natural; - begin - loop - L := Integer'Min (K + Chunk_Shift, Content_Len); - Net.Buffered.Put (Socket, Slice (Data.Content, K, L)); - exit when L = Content_Len; - K := L + 1; - end loop; - - Net.Buffered.New_Line (Socket); - end Send; - - ----------------- - -- Send_Base64 -- - ----------------- - - procedure Send_Base64 is - Chunk_Size : constant := 60; - K : Positive := 1; - begin - while K <= Content_Len loop - if K + Chunk_Size - 1 > Content_Len then - Net.Buffered.Put_Line - (Socket, - Slice (Data.Content, K, Content_Len)); - K := Content_Len + 1; - else - Net.Buffered.Put_Line - (Socket, - Slice (Data.Content, K, K + Chunk_Size - 1)); - K := K + Chunk_Size; - end if; - end loop; - end Send_Base64; - - begin - case Data.Encode is - when None => Send; - when Base64 => Send_Base64; - end case; - end Send_Content; - - --------------- - -- Send_File -- - --------------- - - procedure Send_File is - - procedure Send; - -- Send file as-is - - procedure Send_Base64; - -- Send file encoded in Base64 - - File : Streams.Stream_IO.File_Type; - - ---------- - -- Send -- - ---------- - - procedure Send is - Buffer : Streams.Stream_Element_Array (1 .. 4_096); - Last : Streams.Stream_Element_Offset; - begin - -- Send file content - - while not Streams.Stream_IO.End_Of_File (File) loop - Streams.Stream_IO.Read (File, Buffer, Last); - Net.Buffered.Write (Socket, Buffer (1 .. Last)); - end loop; - - Net.Buffered.New_Line (Socket); - exception - when Net.Socket_Error => - -- Properly close the file if needed - if Streams.Stream_IO.Is_Open (File) then - Streams.Stream_IO.Close (File); - end if; - raise; - end Send; - - ----------------- - -- Send_Base64 -- - ----------------- - - procedure Send_Base64 is - Buffer_Size : constant := 60; - -- Note that this size must be a multiple of 3, this is - -- important to have proper chunk MIME encoding. - - Buffer : Streams.Stream_Element_Array (1 .. Buffer_Size); - Last : Streams.Stream_Element_Offset; - begin - while not Streams.Stream_IO.End_Of_File (File) loop - Streams.Stream_IO.Read (File, Buffer, Last); - - Net.Buffered.Put_Line - (Socket, - AWS.Translator.Base64_Encode (Buffer (1 .. Last))); - end loop; - end Send_Base64; - - begin - Stream_IO.Open - (File, Streams.Stream_IO.In_File, To_String (Data.Filename)); - - case Data.Encode is - when None => Send; - when Base64 => Send_Base64; - end case; - - Stream_IO.Close (File); - end Send_File; + Net.Buffered.Put (Socket, Data); + end Write; - begin - case Data.Kind is - when File => Send_File; - when AWS.Attachments.Data => Send_Content; - end case; - end Send_Content; + procedure Send_Attachments is new Get_Content (Write); begin - -- Send the attachments - - for J in 1 .. Integer (Attachments.Vector.Length) loop - Send_Attachment - (Attachment_Table.Element - (Container => Attachments.Vector, - Index => J)); - end loop; - - -- Send multipart message end boundary - - Net.Buffered.Put_Line (Socket, Pref_Suf & Boundary & Pref_Suf); + Send_Attachments (Attachments, Boundary); end Send; ---------------------- @@ -1028,27 +798,21 @@ package body AWS.Attachments is Boundary : out Unbounded_String; Alternative : Boolean := False) is - L_Boundary : constant String := - "----=_NextPart_" & Utils.Random_String (10) & "." - & Utils.Image (UID.Value); - begin - UID.Increment; + procedure Write (Data : String); - Boundary := To_Unbounded_String (L_Boundary); + ----------- + -- Write -- + ----------- - if Alternative - or else Root_MIME (Attachments) = Multipart_Alternative - then - Net.Buffered.Put_Line - (Socket, - Messages.Content_Type ("multipart/alternative", L_Boundary)); - else - Net.Buffered.Put_Line - (Socket, - Messages.Content_Type ("multipart/mixed", L_Boundary)); - end if; + procedure Write (Data : String) is + begin + Net.Buffered.Put (Socket, Data); + end Write; + + procedure Send_Headers is new Get_MIME_Header (Write); - Net.Buffered.New_Line (Socket); + begin + Send_Headers (Attachments, Boundary, Alternative); end Send_MIME_Header; ----------- From 487bed79b75e6301e2ba3c8c6e607baec0411baa Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Mon, 20 Sep 2021 09:31:29 +0200 Subject: [PATCH 09/51] Minor code clean-up. Part of S507-051. --- src/core/aws-attachments.adb | 1 + src/core/aws-client-http_utils.adb | 5 +++++ src/http2/aws-http2-message.adb | 6 ++++-- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/src/core/aws-attachments.adb b/src/core/aws-attachments.adb index d1b3a55a9..d483a8571 100644 --- a/src/core/aws-attachments.adb +++ b/src/core/aws-attachments.adb @@ -459,6 +459,7 @@ package body AWS.Attachments is -- Send header Get_Header_Content (Attachment.Headers); + New_Line; Send_Content (Attachment.Data); diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index a864dae26..abb8e7bae 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -132,6 +132,7 @@ package body AWS.Client.HTTP_Utils is procedure Connect (Connection : in out HTTP_Connection) is use type Net.Socket_Access; use type Net.SSL.Session_Type; + Connect_URL : AWS.URL.Object renames Connection.Connect_URL; Security : constant Boolean := AWS.URL.Security (Connect_URL); Sock : Net.Socket_Access; @@ -668,6 +669,10 @@ package body AWS.Client.HTTP_Utils is end loop Retry; end Internal_Post_With_Attachment; + -------------------------------------- + -- Internal_Post_Without_Attachment -- + -------------------------------------- + procedure Internal_Post_Without_Attachment (Connection : in out HTTP_Connection; Result : out Response.Data; diff --git a/src/http2/aws-http2-message.adb b/src/http2/aws-http2-message.adb index ab5945120..58ebff8d1 100644 --- a/src/http2/aws-http2-message.adb +++ b/src/http2/aws-http2-message.adb @@ -61,7 +61,7 @@ package body AWS.HTTP2.Message is O.Headers := Headers; if Data'Length /= 0 then - O.M_Body := new Resources.Streams.Memory.Stream_Type; + O.M_Body := new Resources.Streams.Memory.Stream_Type; Resources.Streams.Memory.Stream_Type (O.M_Body.all).Append (Data); end if; @@ -266,6 +266,8 @@ package body AWS.HTTP2.Message is -------------------- procedure Handle_Headers (Headers : AWS.Headers.List) is + use Ada; + Max_Size : constant Positive := Connection.Max_Header_List_Size (Ctx.Settings.all); L : AWS.Headers.List; @@ -279,7 +281,7 @@ package body AWS.HTTP2.Message is 32 + Length (Element.Name) + Length (Element.Value); begin if Debug then - Ada.Text_IO.Put_Line + Text_IO.Put_Line ("#hs " & To_String (Element.Name) & ' ' & To_String (Element.Value)); end if; From 8870f391ccc16b96bec003b003155f7d0995d2b7 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Mon, 20 Sep 2021 18:38:48 +0200 Subject: [PATCH 10/51] Add Append_Body to build a message incrementally. Part of S507-051. --- src/http2/aws-http2-message.adb | 28 ++++++++++++++++++++++++++++ src/http2/aws-http2-message.ads | 12 ++++++++++++ 2 files changed, 40 insertions(+) diff --git a/src/http2/aws-http2-message.adb b/src/http2/aws-http2-message.adb index 58ebff8d1..57feac6fe 100644 --- a/src/http2/aws-http2-message.adb +++ b/src/http2/aws-http2-message.adb @@ -39,11 +39,39 @@ with AWS.HTTP2.Stream; with AWS.Messages; with AWS.Resources.Streams.Memory; with AWS.Server.HTTP_Utils; +with AWS.Translator; package body AWS.HTTP2.Message is use Ada.Strings.Unbounded; + ----------------- + -- Append_Body -- + ----------------- + + procedure Append_Body + (Self : in out Object; + Data : String) is + begin + if Self.M_Body = null then + Self.M_Body := new Resources.Streams.Memory.Stream_Type; + end if; + + Resources.Streams.Memory.Stream_Type (Self.M_Body.all).Append + (Stream_Element_Array'(Translator.To_Stream_Element_Array (Data))); + end Append_Body; + + procedure Append_Body + (Self : in out Object; + Data : Stream_Element_Array) is + begin + if Self.M_Body = null then + Self.M_Body := new Resources.Streams.Memory.Stream_Type; + end if; + + Resources.Streams.Memory.Stream_Type (Self.M_Body.all).Append (Data); + end Append_Body; + ------------ -- Create -- ------------ diff --git a/src/http2/aws-http2-message.ads b/src/http2/aws-http2-message.ads index 3afbe2d74..1dbe797e6 100644 --- a/src/http2/aws-http2-message.ads +++ b/src/http2/aws-http2-message.ads @@ -58,6 +58,18 @@ package AWS.HTTP2.Message is with Post => Create'Result.Is_Defined; -- Create a message out of a request object + procedure Append_Body + (Self : in out Object; + Data : String) + with Pre => Self.Is_Defined and then Data'Length > 0, Inline; + -- Append Data to the current body of message + + procedure Append_Body + (Self : in out Object; + Data : Stream_Element_Array) + with Pre => Self.Is_Defined and then Data'Length > 0, Inline; + -- Append Data to the current body of message + function Create (Answer : in out Response.Data; Request : AWS.Status.Data; From f451470d1744a6da8db9aa89578312217f1f61e5 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Mon, 20 Sep 2021 18:48:11 +0200 Subject: [PATCH 11/51] Do not add the multipart end boundary line by default. Add this end boundary where needed. This is more consistent as the multipart start is not in Get_Content and it is needed for the HTTP/2 client protocol implementation. Part of S507-051. --- src/core/aws-attachments.adb | 4 ---- src/core/aws-client-http_utils.adb | 3 +++ src/extended/aws-smtp-client.adb | 9 ++++++++- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/core/aws-attachments.adb b/src/core/aws-attachments.adb index d483a8571..1b61d3fae 100644 --- a/src/core/aws-attachments.adb +++ b/src/core/aws-attachments.adb @@ -624,10 +624,6 @@ package body AWS.Attachments is (Container => Attachments.Vector, Index => J)); end loop; - - -- Send multipart message end boundary - - Put_Line (Pref_Suf & Boundary & Pref_Suf); end Get_Content; --------------------- diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index abb8e7bae..fd3d931ff 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -642,6 +642,9 @@ package body AWS.Client.HTTP_Utils is -- Send the attachments AWS.Attachments.Send (Sock, Attachments, Boundary); + + Net.Buffered.Put_Line + (Sock, Pref_Suf & Boundary & Pref_Suf); end; -- Get answer from server diff --git a/src/extended/aws-smtp-client.adb b/src/extended/aws-smtp-client.adb index 1891c5409..150137e33 100644 --- a/src/extended/aws-smtp-client.adb +++ b/src/extended/aws-smtp-client.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2000-2017, AdaCore -- +-- Copyright (C) 2000-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 -- @@ -675,6 +675,8 @@ package body AWS.SMTP.Client is BCC : Recipients := No_Recipient; To_All : Boolean := True) is + Pref_Suf : constant String := "--"; + -- The MIME boundary prefix and suffix Sock : Net.Socket_Access; Answer : Server_Reply; Boundary : Unbounded_String; @@ -709,6 +711,11 @@ package body AWS.SMTP.Client is AWS.Attachments.Send (Sock.all, Attachments, To_String (Boundary)); + -- Send multipart message end boundary + + Net.Buffered.Put_Line + (Sock.all, Pref_Suf & To_String (Boundary) & Pref_Suf); + Terminate_Mail_Data (Sock.all); Check_Answer (Sock.all, Answer); From 42ecaf597b814b69de9e56882b88a9d0f25ce8ab Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Mon, 20 Sep 2021 18:49:40 +0200 Subject: [PATCH 12/51] Add support for POST with attachments for HTTP/2. Part of S507-051. --- src/core/aws-client-http_utils.adb | 301 ++++++++++++++++++++++++++++- 1 file changed, 298 insertions(+), 3 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index fd3d931ff..a231b9d15 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -108,6 +108,28 @@ package body AWS.Client.HTTP_Utils is Headers : Header_List := Empty_Header_List); -- Send a simple POST request data For HTTP/2 + procedure Internal_Post_With_Attachment_1 + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + URI : String; + SOAPAction : String; + Content_Type : String; + Attachments : Attachment_List; + Headers : Header_List := Empty_Header_List); + -- Send a simple POST request data For HTTP/1 + + procedure Internal_Post_With_Attachment_2 + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + URI : String; + SOAPAction : String; + Content_Type : String; + Attachments : Attachment_List; + Headers : Header_List := Empty_Header_List); + -- Send a simple POST request data For HTTP/2 + --------- -- "+" -- --------- @@ -512,11 +534,36 @@ package body AWS.Client.HTTP_Utils is end if; end Internal_Post; - -------------------------------------- + ----------------------------------- -- Internal_Post_With_Attachment -- - -------------------------------------- + ----------------------------------- procedure Internal_Post_With_Attachment + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + URI : String; + SOAPAction : String; + Content_Type : String; + Attachments : Attachment_List; + Headers : Header_List := Empty_Header_List) is + begin + if Connection.HTTP_Version = HTTPv1 then + Internal_Post_With_Attachment_1 + (Connection, Result, Data, URI, SOAPAction, + Content_Type, Attachments, Headers); + else + Internal_Post_With_Attachment_2 + (Connection, Result, Data, URI, SOAPAction, + Content_Type, Attachments, Headers); + end if; + end Internal_Post_With_Attachment; + + ------------------------------------- + -- Internal_Post_With_Attachment_1 -- + ------------------------------------- + + procedure Internal_Post_With_Attachment_1 (Connection : in out HTTP_Connection; Result : out Response.Data; Data : Stream_Element_Array; @@ -670,7 +717,255 @@ package body AWS.Client.HTTP_Utils is exit Retry when not Response.Is_Empty (Result); end; end loop Retry; - end Internal_Post_With_Attachment; + end Internal_Post_With_Attachment_1; + + ------------------------------------- + -- Internal_Post_With_Attachment_2 -- + ------------------------------------- + + procedure Internal_Post_With_Attachment_2 + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + URI : String; + SOAPAction : String; + Content_Type : String; + Attachments : Attachment_List; + Headers : Header_List := Empty_Header_List) + is + use Real_Time; + + use all type HTTP2.Frame.Flags_Type; + use all type HTTP2.Frame.Kind_Type; + use all type HTTP2.Frame.Settings.Settings_Kind; + + subtype Byte_4 is HTTP2.Byte_4; + + CRLF : constant Stream_Element_Array := (13, 10); + + C : AWS.Config.Object renames Connection.Config; + Request : HTTP2.Message.Object; + Stamp : constant Time := Clock; + Pref_Suf : constant String := "--"; + Boundary : constant String := + "AWS_Attachment-" & Utils.Random_String (8); + + Root_Content_Id : constant String := ""; + Root_Part_Header : AWS.Headers.List; + + Try_Count : Natural := Connection.Retry; + + Auth_Attempts : Auth_Attempts_Count := (others => 2); + Auth_Is_Over : Boolean; + Stream : HTTP2.Stream.Object; + H_Connection : aliased HTTP2.Connection.Object; + Enc_Table : aliased HTTP2.HPACK.Table.Object; + Dec_Table : aliased HTTP2.HPACK.Table.Object; + Settings : constant HTTP2.Frame.Settings.Set := + (1 => (HEADER_TABLE_SIZE, + Byte_4 (C.HTTP2_Header_Table_Size)), + 2 => (ENABLE_PUSH, + 0), + 3 => (MAX_CONCURRENT_STREAMS, + Byte_4 (C.HTTP2_Max_Concurrent_Streams)), + 4 => (INITIAL_WINDOW_SIZE, + Byte_4 (C.HTTP2_Initial_Window_Size)), + 5 => (MAX_FRAME_SIZE, + Byte_4 (C.HTTP2_Max_Frame_Size)), + 6 => (MAX_HEADER_LIST_SIZE, + Byte_4 (C.HTTP2_Max_Header_List_Size))); + Ctx : Server.Context.Object (null, + 1, + Enc_Table'Access, + Dec_Table'Access, + H_Connection'Access); + procedure Build_Root_Part_Header; + -- Builds the rootpart header and calculates its size + + function Content_Length return Stream_Element_Offset; + -- Returns the total message content length + + ---------------------------- + -- Build_Root_Part_Header -- + ---------------------------- + + procedure Build_Root_Part_Header is + begin + Root_Part_Header.Add + (Name => HN (AWS.Messages.Content_Type_Token, True), + Value => Content_Type); + + Root_Part_Header.Add + (Name => HN (AWS.Messages.Content_Id_Token, True), + Value => Root_Content_Id); + end Build_Root_Part_Header; + + -------------------- + -- Content_Length -- + -------------------- + + function Content_Length return Stream_Element_Offset is + begin + return 2 + + Boundary'Length + 2 -- Root part boundary + CR+LF + + Stream_Element_Offset (AWS.Headers.Length (Root_Part_Header)) + + Data'Length -- Root part data length + + Stream_Element_Offset + (AWS.Attachments.Length (Attachments, Boundary)); + end Content_Length; + + begin + Connection.Self.F_Headers.Reset; + + Build_Root_Part_Header; + + Retry : loop + begin + Set_Common_Post + (Connection, Data, URI, SOAPAction, Content_Type, Headers); + + if Content_Type = "" then + Set_Header + (Connection.F_Headers, + HN (Messages.Content_Type_Token, True), + MIME.Multipart_Related + & "; type=" & Content_Type + & "; start=""" & Root_Content_Id & '"' + & "; boundary=""" & Boundary & '"'); + else + Set_Header + (Connection.F_Headers, + HN (Messages.Content_Type_Token, True), + MIME.Multipart_Form_Data + & "; boundary=""" & Boundary & '"'); + end if; + + -- Send message Content-Length + + Set_Header + (Connection.F_Headers, + HN (Messages.Content_Length_Token, True), + Utils.Image (Content_Length)); + + -- Send the HTTP/2 connection preface + + Net.Buffered.Write + (Connection.Socket.all, HTTP2.Client_Connection_Preface); + + -- Send the setting frame (stream id 0) + + HTTP2.Frame.Settings.Create + (Settings).Send (Connection.Socket.all); + + -- We need to read the settings from server + + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, H_Connection); + begin + if Frame.Kind /= K_Settings then + raise Constraint_Error with + "server should have answered with a setting frame"; + end if; + end; + + -- Create frames and send them + + Stream := HTTP2.Stream.Create + (Connection.Socket, 1, H_Connection.Flow_Control_Window); + + Request := HTTP2.Message.Create + (Connection.F_Headers, + Stream_Element_Array'(1 .. 0 => <>), + Stream.Identifier); + + -- Append data & attachments + + Request.Append_Body (Pref_Suf & Boundary & CRLF); + + declare + procedure Write (Data : String); + procedure Write (Data : Stream_Element_Array); + + ----------- + -- Write -- + ----------- + + procedure Write (Data : String) is + begin + Request.Append_Body (Data); + end Write; + + procedure Write (Data : Stream_Element_Array) is + begin + Request.Append_Body (Data); + end Write; + + procedure Append_Attachments is + new AWS.Attachments.Get_Content (Write); + + procedure Append_Header is + new AWS.Headers.Get_Content (Write); + + begin + -- Root part header + + Append_Header (Root_Part_Header, End_Block => True); + + -- Data + + if Data'Length /= 0 then + Write (Data); + Write (CRLF); + end if; + + -- Attachments + + Append_Attachments (Attachments, Boundary); + end; + + Request.Append_Body (Pref_Suf & Boundary & Pref_Suf & CRLF); + + for F of Request.To_Frames (Ctx, Stream) loop + Stream.Send_Frame (F); + end loop; + + -- Get response + + Stream := HTTP2.Stream.Create + (Connection.Socket, 3, H_Connection.Flow_Control_Window); + + while not Stream.Is_Message_Ready loop + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, H_Connection); + Error : HTTP2.Error_Codes; + begin + Stream.Received_Frame (Ctx, Frame, Error); + exit when Frame.Has_Flag (HTTP2.Frame.End_Stream_Flag); + end; + end loop; + + Stream.Append_Body (Result); + + Decrement_Authentication_Attempt + (Connection, Auth_Attempts, Auth_Is_Over); + + if Auth_Is_Over then + exit Retry; + end if; + + exception + when E : Net.Socket_Error | Connection_Error => + Error_Processing + (Connection, Try_Count, Result, "UPLOAD", E, Stamp); + + exit Retry when not Response.Is_Empty (Result); + end; + end loop Retry; + end Internal_Post_With_Attachment_2; -------------------------------------- -- Internal_Post_Without_Attachment -- From 1a3d498a1062420fc91cbea53276db4afe7b9fe5 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 22 Sep 2021 10:00:28 +0200 Subject: [PATCH 13/51] Minor code refactoring, remove code duplication. Part of S507-051. --- src/core/aws-client-http_utils.adb | 63 +++++++++++++++--------------- 1 file changed, 31 insertions(+), 32 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index a231b9d15..c6b28eed6 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -130,6 +130,10 @@ package body AWS.Client.HTTP_Utils is Headers : Header_List := Empty_Header_List); -- Send a simple POST request data For HTTP/2 + function Get_Settings + (Config : AWS.Config.Object) return HTTP2.Frame.Settings.Set; + -- Returns the config set from Config + --------- -- "+" -- --------- @@ -471,6 +475,31 @@ package body AWS.Client.HTTP_Utils is Disconnect; end Get_Response; + ------------------ + -- Get_Settings -- + ------------------ + + function Get_Settings + (Config : AWS.Config.Object) return HTTP2.Frame.Settings.Set + is + use all type HTTP2.Frame.Settings.Settings_Kind; + subtype Byte_4 is HTTP2.Byte_4; + begin + return HTTP2.Frame.Settings.Set' + (1 => (HEADER_TABLE_SIZE, + Byte_4 (Config.HTTP2_Header_Table_Size)), + 2 => (ENABLE_PUSH, + 0), + 3 => (MAX_CONCURRENT_STREAMS, + Byte_4 (Config.HTTP2_Max_Concurrent_Streams)), + 4 => (INITIAL_WINDOW_SIZE, + Byte_4 (Config.HTTP2_Initial_Window_Size)), + 5 => (MAX_FRAME_SIZE, + Byte_4 (Config.HTTP2_Max_Frame_Size)), + 6 => (MAX_HEADER_LIST_SIZE, + Byte_4 (Config.HTTP2_Max_Header_List_Size))); + end Get_Settings; + ----------- -- Image -- ----------- @@ -737,13 +766,9 @@ package body AWS.Client.HTTP_Utils is use all type HTTP2.Frame.Flags_Type; use all type HTTP2.Frame.Kind_Type; - use all type HTTP2.Frame.Settings.Settings_Kind; - - subtype Byte_4 is HTTP2.Byte_4; CRLF : constant Stream_Element_Array := (13, 10); - C : AWS.Config.Object renames Connection.Config; Request : HTTP2.Message.Object; Stamp : constant Time := Clock; Pref_Suf : constant String := "--"; @@ -762,18 +787,7 @@ package body AWS.Client.HTTP_Utils is Enc_Table : aliased HTTP2.HPACK.Table.Object; Dec_Table : aliased HTTP2.HPACK.Table.Object; Settings : constant HTTP2.Frame.Settings.Set := - (1 => (HEADER_TABLE_SIZE, - Byte_4 (C.HTTP2_Header_Table_Size)), - 2 => (ENABLE_PUSH, - 0), - 3 => (MAX_CONCURRENT_STREAMS, - Byte_4 (C.HTTP2_Max_Concurrent_Streams)), - 4 => (INITIAL_WINDOW_SIZE, - Byte_4 (C.HTTP2_Initial_Window_Size)), - 5 => (MAX_FRAME_SIZE, - Byte_4 (C.HTTP2_Max_Frame_Size)), - 6 => (MAX_HEADER_LIST_SIZE, - Byte_4 (C.HTTP2_Max_Header_List_Size))); + Get_Settings (Connection.Config); Ctx : Server.Context.Object (null, 1, Enc_Table'Access, @@ -1067,11 +1081,7 @@ package body AWS.Client.HTTP_Utils is use Ada.Real_Time; use all type HTTP2.Frame.Flags_Type; use all type HTTP2.Frame.Kind_Type; - use all type HTTP2.Frame.Settings.Settings_Kind; - - subtype Byte_4 is HTTP2.Byte_4; - C : AWS.Config.Object renames Connection.Config; Request : HTTP2.Message.Object; Stamp : constant Time := Clock; Try_Count : Natural := Connection.Retry; @@ -1082,18 +1092,7 @@ package body AWS.Client.HTTP_Utils is Enc_Table : aliased HTTP2.HPACK.Table.Object; Dec_Table : aliased HTTP2.HPACK.Table.Object; Settings : constant HTTP2.Frame.Settings.Set := - (1 => (HEADER_TABLE_SIZE, - Byte_4 (C.HTTP2_Header_Table_Size)), - 2 => (ENABLE_PUSH, - 0), - 3 => (MAX_CONCURRENT_STREAMS, - Byte_4 (C.HTTP2_Max_Concurrent_Streams)), - 4 => (INITIAL_WINDOW_SIZE, - Byte_4 (C.HTTP2_Initial_Window_Size)), - 5 => (MAX_FRAME_SIZE, - Byte_4 (C.HTTP2_Max_Frame_Size)), - 6 => (MAX_HEADER_LIST_SIZE, - Byte_4 (C.HTTP2_Max_Header_List_Size))); + Get_Settings (Connection.Config); Ctx : Server.Context.Object (null, 1, Enc_Table'Access, From 3f1cc2b6903d49631cb0c6be4e1cd00a42816ddd Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 22 Sep 2021 10:05:46 +0200 Subject: [PATCH 14/51] Ensure that headers are always lower-case in HTTP/2. And make sure they are handled non case sensitive. Part of S507-051. --- regtests/0341_hpack/main.adb | 2 ++ src/http2/aws-http2-hpack.adb | 2 ++ src/http2/aws-http2-message.adb | 21 +++++++++++++++++---- src/http2/aws-http2-stream.adb | 7 +++++-- 4 files changed, 26 insertions(+), 6 deletions(-) diff --git a/regtests/0341_hpack/main.adb b/regtests/0341_hpack/main.adb index 2c57d3ec7..8d7d199df 100644 --- a/regtests/0341_hpack/main.adb +++ b/regtests/0341_hpack/main.adb @@ -100,6 +100,8 @@ procedure Main is Size : Positive; begin + H.Case_Sensitive (False); + H.Add (":method", "GET"); H.Add (":path", "/readme.txt"); H.Add (":scheme", "https"); diff --git a/src/http2/aws-http2-hpack.adb b/src/http2/aws-http2-hpack.adb index 6fc5ea48b..023bc712d 100644 --- a/src/http2/aws-http2-hpack.adb +++ b/src/http2/aws-http2-hpack.adb @@ -250,6 +250,8 @@ package body AWS.HTTP2.HPACK is Data : Boolean := False; begin + Headers.Case_Sensitive (False); + while not End_Of_Stream loop Byte := Get_Byte; diff --git a/src/http2/aws-http2-message.adb b/src/http2/aws-http2-message.adb index 57feac6fe..0fd77f79a 100644 --- a/src/http2/aws-http2-message.adb +++ b/src/http2/aws-http2-message.adb @@ -45,6 +45,12 @@ package body AWS.HTTP2.Message is use Ada.Strings.Unbounded; + function HN + (Header_Name : String; + Is_H2 : Boolean := True) + return String renames Utils.Normalize_Lower; + -- Fold header name to lower case as required by HTTP/2 protocol + ----------------- -- Append_Body -- ----------------- @@ -88,13 +94,15 @@ package body AWS.HTTP2.Message is O.Stream_Id := Stream_Id; O.Headers := Headers; + O.Headers.Case_Sensitive (False); + if Data'Length /= 0 then O.M_Body := new Resources.Streams.Memory.Stream_Type; Resources.Streams.Memory.Stream_Type (O.M_Body.all).Append (Data); end if; O.Headers.Add - (Messages.Content_Length_Token, + (HN (Messages.Content_Length_Token), Utils.Image (Stream_Element_Offset (Data'Length))); return O; @@ -122,7 +130,8 @@ package body AWS.HTTP2.Message is Size := O.M_Body.Size; if Size /= Resources.Undefined_Length then - O.Headers.Add (Messages.Content_Length_Token, Utils.Image (Size)); + O.Headers.Add + (HN (Messages.Content_Length_Token), Utils.Image (Size)); end if; end Set_Body; @@ -131,12 +140,14 @@ package body AWS.HTTP2.Message is O.Mode := Response.Mode (Answer); O.Stream_Id := Stream_Id; + O.Headers.Case_Sensitive (False); + case O.Mode is when Response.Message | Response.Header => -- Set status code O.Headers.Add - (Messages.Status_Token, + (HN (Messages.Status_Token), Messages.Image (Response.Status_Code (Answer))); if O.Mode /= Response.Header then @@ -190,7 +201,7 @@ package body AWS.HTTP2.Message is (Answer, Messages.Last_Modified_Token) then O.Headers.Add - (Messages.Last_Modified_Token, + (HN (Messages.Last_Modified_Token), Messages.To_HTTP_Date (File_Time)); end if; @@ -302,6 +313,8 @@ package body AWS.HTTP2.Message is Size : Natural := 0; Is_First : Boolean := True; begin + L.Case_Sensitive (False); + for K in 1 .. Headers.Count loop declare Element : constant AWS.Headers.Element := Headers.Get (K); diff --git a/src/http2/aws-http2-stream.adb b/src/http2/aws-http2-stream.adb index 420787ca6..246ad5b67 100644 --- a/src/http2/aws-http2-stream.adb +++ b/src/http2/aws-http2-stream.adb @@ -81,7 +81,7 @@ package body AWS.HTTP2.Stream is Window_Size : Natural; Weight : Byte_1 := Frame.Priority.Default_Weight) return Object is begin - return Object' + return Self : Object := Object' (Sock => Sock, Id => Identifier, State => Idle, @@ -100,7 +100,10 @@ package body AWS.HTTP2.Stream is End_Stream => False, Content_Length => Undefined_Length, Bytes_Received => 0, - Data_Flow => Unknown); + Data_Flow => Unknown) + do + Self.Headers.Case_Sensitive (False); + end return; end Create; ---------------------- From e9339bc88a0cad22063a7a73c271fd79a6ec8274 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 22 Sep 2021 10:07:43 +0200 Subject: [PATCH 15/51] Add support for parameters from POST message in HTTP/2. Part of S507-051. --- src/core/aws-server-protocol_handler_v2.adb | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index 2b2c3bbd4..94d94c3d7 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -39,6 +39,7 @@ with Ada.Strings.Maps.Constants; with AWS.Headers; with AWS.Log; with AWS.Messages; +with AWS.MIME; with AWS.Net.Buffered; with AWS.Response.Set; with AWS.Server.Context; @@ -548,7 +549,20 @@ is Parameters => Path (Query_First .. Path'Last)); end; - Deferred_Messages.Append (Handle_Message (Stream.Status.all, Stream)); + declare + use type AWS.Status.Request_Method; + + S : constant not null access AWS.Status.Data := Stream.Status; + CT : constant String := AWS.Status.Content_Type (Stream.Status.all); + begin + if AWS.Status.Method (S.all) = AWS.Status.POST + and then CT = MIME.Application_Form_Data + then + AWS.Status.Set.Parameters_From_Body (S.all); + end if; + + Deferred_Messages.Append (Handle_Message (S.all, Stream)); + end; end Handle_Message; -------------------------- From 1d1c7d436876154c5ec00ecb137a74b622921854 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:05:53 +0200 Subject: [PATCH 16/51] Add generic Read_G to read headers from any stream. Implement Read using Read_G. Part of S507-051. --- src/core/aws-headers.adb | 31 +++++++++++++++++++++++++++---- src/core/aws-headers.ads | 4 ++++ 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/src/core/aws-headers.adb b/src/core/aws-headers.adb index 40fa82694..7c48aeee5 100644 --- a/src/core/aws-headers.adb +++ b/src/core/aws-headers.adb @@ -174,6 +174,30 @@ package body AWS.Headers is procedure Read (Headers : in out List; Socket : Net.Socket_Type'Class) is + function Get_Line return String; + -- Read a line from socket + + -------------- + -- Get_Line -- + -------------- + + function Get_Line return String is + begin + return Net.Buffered.Get_Line (Socket); + end Get_Line; + + procedure Read is new Read_G (Get_Line); + + begin + Read (Headers); + end Read; + + ------------ + -- Read_G -- + ------------ + + procedure Read_G (Headers : in out List) is + procedure Parse_Header_Line (Line : String); -- Parse this line, update Headers accordingly @@ -213,8 +237,7 @@ package body AWS.Headers is end Parse_Header_Line; End_Of_Message : constant String := ""; - Line : Unbounded_String := - To_Unbounded_String (Net.Buffered.Get_Line (Socket)); + Line : Unbounded_String := To_Unbounded_String (Get_Line); begin Reset (Headers); @@ -226,7 +249,7 @@ package body AWS.Headers is exit when Line = Null_Unbounded_String; declare - Next_Line : constant String := Net.Buffered.Get_Line (Socket); + Next_Line : constant String := Get_Line; begin if Next_Line /= End_Of_Message and then @@ -250,7 +273,7 @@ package body AWS.Headers is end if; end; end loop; - end Read; + end Read_G; ----------- -- Reset -- diff --git a/src/core/aws-headers.ads b/src/core/aws-headers.ads index 054ea5c5c..d809279d9 100644 --- a/src/core/aws-headers.ads +++ b/src/core/aws-headers.ads @@ -88,6 +88,10 @@ package AWS.Headers is -- Returns the length (in bytes) of the header, including the ending -- empty line. + generic + with function Get_Line return String; + procedure Read_G (Headers : in out List); + procedure Read (Headers : in out List; Socket : Net.Socket_Type'Class); -- Read and parse HTTP header from the socket From 02ab55f453eb29def1b287b5e496f7b27c4fac72 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:07:51 +0200 Subject: [PATCH 17/51] Minor code clean-up. Part of S507-051. --- src/core/aws-client-http_utils.adb | 52 +++++++++++++++--------------- src/core/aws-client.adb | 2 +- src/core/aws-server-http_utils.adb | 4 +-- 3 files changed, 29 insertions(+), 29 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index c6b28eed6..48935d168 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -767,10 +767,11 @@ package body AWS.Client.HTTP_Utils is use all type HTTP2.Frame.Flags_Type; use all type HTTP2.Frame.Kind_Type; - CRLF : constant Stream_Element_Array := (13, 10); - - Request : HTTP2.Message.Object; + CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; + Settings : constant HTTP2.Frame.Settings.Set := + Get_Settings (Connection.Config); + Pref_Suf : constant String := "--"; Boundary : constant String := "AWS_Attachment-" & Utils.Random_String (8); @@ -778,21 +779,19 @@ package body AWS.Client.HTTP_Utils is Root_Content_Id : constant String := ""; Root_Part_Header : AWS.Headers.List; - Try_Count : Natural := Connection.Retry; - - Auth_Attempts : Auth_Attempts_Count := (others => 2); - Auth_Is_Over : Boolean; - Stream : HTTP2.Stream.Object; - H_Connection : aliased HTTP2.Connection.Object; - Enc_Table : aliased HTTP2.HPACK.Table.Object; - Dec_Table : aliased HTTP2.HPACK.Table.Object; - Settings : constant HTTP2.Frame.Settings.Set := - Get_Settings (Connection.Config); - Ctx : Server.Context.Object (null, - 1, - Enc_Table'Access, - Dec_Table'Access, - H_Connection'Access); + Request : HTTP2.Message.Object; + Try_Count : Natural := Connection.Retry; + Auth_Attempts : Auth_Attempts_Count := (others => 2); + Auth_Is_Over : Boolean; + Stream : HTTP2.Stream.Object; + H_Connection : aliased HTTP2.Connection.Object; + Enc_Table : aliased HTTP2.HPACK.Table.Object; + Dec_Table : aliased HTTP2.HPACK.Table.Object; + Ctx : Server.Context.Object (null, + 1, + Enc_Table'Access, + Dec_Table'Access, + H_Connection'Access); procedure Build_Root_Part_Header; -- Builds the rootpart header and calculates its size @@ -1082,8 +1081,11 @@ package body AWS.Client.HTTP_Utils is use all type HTTP2.Frame.Flags_Type; use all type HTTP2.Frame.Kind_Type; - Request : HTTP2.Message.Object; Stamp : constant Time := Clock; + Settings : constant HTTP2.Frame.Settings.Set := + Get_Settings (Connection.Config); + + Request : HTTP2.Message.Object; Try_Count : Natural := Connection.Retry; Auth_Attempts : Auth_Attempts_Count := (others => 2); Auth_Is_Over : Boolean; @@ -1091,13 +1093,11 @@ package body AWS.Client.HTTP_Utils is H_Connection : aliased HTTP2.Connection.Object; Enc_Table : aliased HTTP2.HPACK.Table.Object; Dec_Table : aliased HTTP2.HPACK.Table.Object; - Settings : constant HTTP2.Frame.Settings.Set := - Get_Settings (Connection.Config); - Ctx : Server.Context.Object (null, - 1, - Enc_Table'Access, - Dec_Table'Access, - H_Connection'Access); + Ctx : Server.Context.Object (null, + 1, + Enc_Table'Access, + Dec_Table'Access, + H_Connection'Access); begin Connection.F_Headers.Reset; diff --git a/src/core/aws-client.adb b/src/core/aws-client.adb index c3ad140d1..9705c7b28 100644 --- a/src/core/aws-client.adb +++ b/src/core/aws-client.adb @@ -348,7 +348,7 @@ package body AWS.Client is Stamp : Ada.Real_Time.Time) is use Real_Time; - Message : constant String := Ada.Exceptions.Exception_Information (E); + Message : constant String := Exception_Information (E); begin Debug_Exception (E); diff --git a/src/core/aws-server-http_utils.adb b/src/core/aws-server-http_utils.adb index 889b35958..815e9624f 100644 --- a/src/core/aws-server-http_utils.adb +++ b/src/core/aws-server-http_utils.adb @@ -592,7 +592,7 @@ package body AWS.Server.HTTP_Utils is End_Found : Boolean := False; -- Set to true when the end-boundary has been found - begin -- File_Upload + begin -- Reach the boundary if Parse_Boundary then @@ -1017,7 +1017,7 @@ package body AWS.Server.HTTP_Utils is End_Found : Boolean := False; -- Set to true when the end-boundary has been found - begin -- Store_Attachments + begin -- Reach the boundary if Parse_Boundary then From 3d1c805e2b773345d4a3b18f956eda87f90f27e1 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:13:33 +0200 Subject: [PATCH 18/51] Fix Content-Length for the message. This must now be computed just before created the message to properly support building the message body (data) incrementally. Part of S507-051. --- src/http2/aws-http2-message.adb | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/src/http2/aws-http2-message.adb b/src/http2/aws-http2-message.adb index 0fd77f79a..62404f088 100644 --- a/src/http2/aws-http2-message.adb +++ b/src/http2/aws-http2-message.adb @@ -101,10 +101,6 @@ package body AWS.HTTP2.Message is Resources.Streams.Memory.Stream_Type (O.M_Body.all).Append (Data); end if; - O.Headers.Add - (HN (Messages.Content_Length_Token), - Utils.Image (Stream_Element_Offset (Data'Length))); - return O; end Create; @@ -370,6 +366,19 @@ package body AWS.HTTP2.Message is begin if not Self.H_Sent then + if not Self.Headers.Exist (Messages.Content_Length_Token) + and then Self.M_Body /= null + then + declare + Size : constant Stream_Element_Offset := Self.M_Body.Size; + begin + if Size /= Resources.Undefined_Length then + Self.Headers.Add + (HN (Messages.Content_Length_Token), Utils.Image (Size)); + end if; + end; + end if; + Handle_Headers (Self.Headers); Self.H_Sent := True; end if; From e4d3cd9aa3c532e9a8aebf42d14ef228a183bdee Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:14:27 +0200 Subject: [PATCH 19/51] Add some message to the server's error log to ease debugging. Part of S507-051. --- src/core/aws-server-protocol_handler_v2.adb | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index 94d94c3d7..17ee23e93 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -928,7 +928,7 @@ begin exit For_Every_Frame; else - Go_Away (Error, ""); + Go_Away (Error, Error'Img & " from Received_Frame"); exit For_Every_Frame; end if; @@ -963,8 +963,14 @@ exception when Net.Socket_Error => null; - when HTTP2.Protocol_Error => + when P : HTTP2.Protocol_Error => Will_Close := True; + AWS.Log.Write + (LA.Server.Error_Log, + LA.Stat, + "Exception handler bug " + & Utils.CRLF_2_Spaces + (Ada.Exceptions.Exception_Information (P))); LA.Server.Slots.Mark_Phase (LA.Line, Server_Response); when E : others => From 4e032440aee4514bb2157a7d8662a61534cd2570 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:19:00 +0200 Subject: [PATCH 20/51] Refactor code to handle the connection preface. Also make sure we never send the connection preface twice. Part of S507-051. --- src/core/aws-client-http_utils.adb | 96 ++++++++++++++++-------------- src/core/aws-client.ads | 1 + 2 files changed, 51 insertions(+), 46 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 48935d168..0127097ad 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -134,6 +134,13 @@ package body AWS.Client.HTTP_Utils is (Config : AWS.Config.Object) return HTTP2.Frame.Settings.Set; -- Returns the config set from Config + procedure Send_H2_Connection_Preface + (Connection : in out HTTP_Connection; + Settings : HTTP2.Frame.Settings.Set; + H_Connection : HTTP2.Connection.Object) + with Pre => not Connection.H2_Preface_Sent; + -- Send connection preface and get response from server + --------- -- "+" -- --------- @@ -765,7 +772,6 @@ package body AWS.Client.HTTP_Utils is use Real_Time; use all type HTTP2.Frame.Flags_Type; - use all type HTTP2.Frame.Kind_Type; CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; @@ -860,28 +866,9 @@ package body AWS.Client.HTTP_Utils is HN (Messages.Content_Length_Token, True), Utils.Image (Content_Length)); - -- Send the HTTP/2 connection preface - - Net.Buffered.Write - (Connection.Socket.all, HTTP2.Client_Connection_Preface); - - -- Send the setting frame (stream id 0) - - HTTP2.Frame.Settings.Create - (Settings).Send (Connection.Socket.all); - - -- We need to read the settings from server - - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - begin - if Frame.Kind /= K_Settings then - raise Constraint_Error with - "server should have answered with a setting frame"; - end if; - end; + if not Connection.H2_Preface_Sent then + Send_H2_Connection_Preface (Connection, Settings, H_Connection); + end if; -- Create frames and send them @@ -1079,7 +1066,6 @@ package body AWS.Client.HTTP_Utils is is use Ada.Real_Time; use all type HTTP2.Frame.Flags_Type; - use all type HTTP2.Frame.Kind_Type; Stamp : constant Time := Clock; Settings : constant HTTP2.Frame.Settings.Set := @@ -1115,28 +1101,9 @@ package body AWS.Client.HTTP_Utils is Utils.Image (Stream_Element_Offset'(Data'Length))); end if; - -- Send the HTTP/2 connection preface - - Net.Buffered.Write - (Connection.Socket.all, HTTP2.Client_Connection_Preface); - - -- Send the setting frame (stream id 0) - - HTTP2.Frame.Settings.Create - (Settings).Send (Connection.Socket.all); - - -- We need to read the settings from server - - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - begin - if Frame.Kind /= K_Settings then - raise Constraint_Error with - "server should have answered with a setting frame"; - end if; - end; + if not Connection.H2_Preface_Sent then + Send_H2_Connection_Preface (Connection, Settings, H_Connection); + end if; -- Create frames and send them @@ -1808,6 +1775,43 @@ package body AWS.Client.HTTP_Utils is end loop; end Read_Body; + -------------------------------- + -- Send_H2_Connection_Preface -- + -------------------------------- + + procedure Send_H2_Connection_Preface + (Connection : in out HTTP_Connection; + Settings : HTTP2.Frame.Settings.Set; + H_Connection : HTTP2.Connection.Object) + is + use all type HTTP2.Frame.Kind_Type; + begin + -- Send the HTTP/2 connection preface + + Net.Buffered.Write + (Connection.Socket.all, HTTP2.Client_Connection_Preface); + + -- Send the setting frame (stream id 0) + + HTTP2.Frame.Settings.Create + (Settings).Send (Connection.Socket.all); + + -- We need to read the settings from server + + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, H_Connection); + begin + if Frame.Kind /= K_Settings then + raise Constraint_Error with + "server should have answered with a setting frame"; + end if; + end; + + Connection.H2_Preface_Sent := True; + end Send_H2_Connection_Preface; + ------------------ -- Send_Request -- ------------------ diff --git a/src/core/aws-client.ads b/src/core/aws-client.ads index a338e7741..bc67ba450 100644 --- a/src/core/aws-client.ads +++ b/src/core/aws-client.ads @@ -625,6 +625,7 @@ private C_Headers : Header_List; -- user's connection headers F_Headers : Header_List; -- final connection headers HTTP_Version : HTTP_Protocol := HTTPv1; + H2_Preface_Sent : Boolean := False; Auth : Authentication_Set; Opened : Boolean := False; Persistent : Boolean; From bd67476843fa1612c5cb20add390a6aea7264333 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:26:19 +0200 Subject: [PATCH 21/51] Fix handling of Content-Length which is never needed with HTTP/2. This is part of the Message.Object. Part of S507-051. --- src/core/aws-client-http_utils.adb | 34 ++++++------------------------ 1 file changed, 6 insertions(+), 28 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 0127097ad..74903711b 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -801,9 +801,6 @@ package body AWS.Client.HTTP_Utils is procedure Build_Root_Part_Header; -- Builds the rootpart header and calculates its size - function Content_Length return Stream_Element_Offset; - -- Returns the total message content length - ---------------------------- -- Build_Root_Part_Header -- ---------------------------- @@ -819,20 +816,6 @@ package body AWS.Client.HTTP_Utils is Value => Root_Content_Id); end Build_Root_Part_Header; - -------------------- - -- Content_Length -- - -------------------- - - function Content_Length return Stream_Element_Offset is - begin - return 2 - + Boundary'Length + 2 -- Root part boundary + CR+LF - + Stream_Element_Offset (AWS.Headers.Length (Root_Part_Header)) - + Data'Length -- Root part data length - + Stream_Element_Offset - (AWS.Attachments.Length (Attachments, Boundary)); - end Content_Length; - begin Connection.Self.F_Headers.Reset; @@ -859,13 +842,6 @@ package body AWS.Client.HTTP_Utils is & "; boundary=""" & Boundary & '"'); end if; - -- Send message Content-Length - - Set_Header - (Connection.F_Headers, - HN (Messages.Content_Length_Token, True), - Utils.Image (Content_Length)); - if not Connection.H2_Preface_Sent then Send_H2_Connection_Preface (Connection, Settings, H_Connection); end if; @@ -2227,10 +2203,12 @@ package body AWS.Client.HTTP_Utils is -- Send message Content_Length - Set_Header - (Connection.F_Headers, - HN (Messages.Content_Length_Token, Is_H2), - Utils.Image (Stream_Element_Offset'(Data'Length))); + if not Is_H2 then + Set_Header + (Connection.F_Headers, + HN (Messages.Content_Length_Token, Is_H2), + Utils.Image (Stream_Element_Offset'(Data'Length))); + end if; end Set_Common_Post; ---------------- From 19a3450b9b5524ac782932a3c99f0337d3e8adcd Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 17:37:55 +0200 Subject: [PATCH 22/51] Large code refactoring to read multipart messages. A new generic package is introduced to be able to read the attachments and file upload from any stream (socket or HTTP/2 memory stream). The Get_Message_Data is now using this new generic package. Part of S507-051. --- src/core/aws-server-http_utils.adb | 234 ++++++++++++++++++----------- src/core/aws-server-http_utils.ads | 50 ++++++ 2 files changed, 195 insertions(+), 89 deletions(-) diff --git a/src/core/aws-server-http_utils.adb b/src/core/aws-server-http_utils.adb index 815e9624f..57cdb2136 100644 --- a/src/core/aws-server-http_utils.adb +++ b/src/core/aws-server-http_utils.adb @@ -41,7 +41,6 @@ with GNAT.MD5; with GNAT.OS_Lib; with GNAT.Regexp; -with AWS.Attachments; with AWS.Digest; with AWS.Dispatchers; with AWS.Headers.Values; @@ -498,62 +497,23 @@ package body AWS.Server.HTTP_Utils is end File_Upload_UID; - ---------------------- - -- Get_Message_Data -- - ---------------------- - - procedure Get_Message_Data - (HTTP_Server : AWS.Server.HTTP; - Line_Index : Positive; - C_Stat : in out AWS.Status.Data; - Expect_100 : Boolean) - is - use type Status.Request_Method; - - type Message_Mode is - (Root_Attachment, -- Read the root attachment - Attachment, -- Read an attachment - File_Upload); -- Read a file upload - - procedure Get_File_Data - (Server_Filename : String; - Filename : String; - Start_Boundary : String; - Mode : Message_Mode; - Headers : AWS.Headers.List; - End_Found : out Boolean); - -- Read file data from the stream, set End_Found if the end-boundary - -- signature has been read. Server_Filename is the filename to be used - -- for on-disk content (Attachment and File_Upload mode). - - procedure File_Upload - (Start_Boundary, End_Boundary : String; - Parse_Boundary : Boolean); - -- Handle file upload data coming from the client browser - - procedure Store_Attachments - (Start_Boundary, End_Boundary : String; - Parse_Boundary : Boolean; - Root_Part_CID : String); - -- Store attachments coming from the client browser - - function Get_File_Upload_UID return String; - -- Returns a unique id for each file upload - - Status_Multipart_Boundary : Unbounded_String; - Status_Root_Part_CID : Unbounded_String; - Status_Content_Type : Unbounded_String; + ------------------------- + -- Multipart_Message_G -- + ------------------------- - Sock : constant Net.Socket_Type'Class := Status.Socket (C_Stat); + package body Multipart_Message_G is - Attachments : AWS.Attachments.List; + procedure Read is new Headers.Read_G (Get_Line); + -- Read header using generic Get_Line ----------------- -- File_Upload -- ----------------- procedure File_Upload - (Start_Boundary, End_Boundary : String; + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Start_Boundary, End_Boundary : String; Parse_Boundary : Boolean) is @@ -572,7 +532,7 @@ package body AWS.Server.HTTP_Utils is Server_Filename, Decoded_Server_Filename : out Unbounded_String) is Upload_Path : constant String := - CNF.Upload_Directory (HTTP_Server.Properties); + CNF.Upload_Directory (Server_Config); File_Upload_UID : constant String := Get_File_Upload_UID; begin Server_Filename := To_Unbounded_String @@ -598,7 +558,7 @@ package body AWS.Server.HTTP_Utils is if Parse_Boundary then loop declare - Data : constant String := Net.Buffered.Get_Line (Sock); + Data : constant String := Get_Line; begin exit when Data = Start_Boundary; @@ -612,27 +572,26 @@ package body AWS.Server.HTTP_Utils is -- Read header - Headers.Read (Sock); + Read (Headers); if AWS.Headers.Get_Values (Headers, Messages.Content_Type_Token) = MIME.Application_Form_Data then -- This chunk is the form parameter - Status.Set.Read_Body - (Sock, C_Stat, Boundary => Start_Boundary); + Read_Body (C_Stat, Boundary => Start_Boundary); -- Skip CRLF after boundary declare - Data : constant String := Net.Buffered.Get_Line (Sock) - with Unreferenced; + Data : constant String := Get_Line with Unreferenced; begin null; end; Status.Set.Parameters_From_Body (C_Stat); - File_Upload (Start_Boundary, End_Boundary, False); + File_Upload + (C_Stat, Attachments, Start_Boundary, End_Boundary, False); else -- Read file upload parameters @@ -666,10 +625,10 @@ package body AWS.Server.HTTP_Utils is if Is_File_Upload then -- This part of the multipart message contains file data - if CNF.Upload_Directory (HTTP_Server.Properties) = "" then + if CNF.Upload_Directory (Server_Config) = "" then raise Constraint_Error with "File upload not supported by server " - & CNF.Server_Name (HTTP_Server.Properties); + & CNF.Server_Name (Server_Config); end if; -- Set Server_Filename, the name of the file in the local file @@ -697,7 +656,9 @@ package body AWS.Server.HTTP_Utils is -- signature has been read. Get_File_Data - (To_String (Decoded_Server_Filename), + (C_Stat, + Attachments, + To_String (Decoded_Server_Filename), To_String (Filename), Start_Boundary, File_Upload, @@ -718,14 +679,17 @@ package body AWS.Server.HTTP_Utils is Status.Set.Attachments (C_Stat, Attachments); if not End_Found then - File_Upload (Start_Boundary, End_Boundary, False); + File_Upload + (C_Stat, Attachments, + 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); + File_Upload + (C_Stat, Attachments, Start_Boundary, End_Boundary, True); end if; else @@ -736,7 +700,7 @@ package body AWS.Server.HTTP_Utils is begin loop declare - L : constant String := Net.Buffered.Get_Line (Sock); + L : constant String := Get_Line; begin End_Found := (L = End_Boundary); @@ -755,7 +719,8 @@ package body AWS.Server.HTTP_Utils is end; if not End_Found then - File_Upload (Start_Boundary, End_Boundary, False); + File_Upload + (C_Stat, Attachments, Start_Boundary, End_Boundary, False); end if; end if; end if; @@ -766,7 +731,9 @@ package body AWS.Server.HTTP_Utils is ------------------- procedure Get_File_Data - (Server_Filename : String; + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Server_Filename : String; Filename : String; Start_Boundary : String; Mode : Message_Mode; @@ -844,7 +811,7 @@ package body AWS.Server.HTTP_Utils is Index := Index + 1; loop - Net.Buffered.Read (Sock, Data); + Read (Data); if Data (1) = 13 then Write_Data; @@ -899,7 +866,7 @@ package body AWS.Server.HTTP_Utils is end; Read_File : loop - Net.Buffered.Read (Sock, Data); + Read (Data); while Data (1) = 13 loop exit Read_File when Check_EOF; @@ -912,7 +879,7 @@ package body AWS.Server.HTTP_Utils is Write (Buffer, False); Index := Buffer'First; - HTTP_Server.Slots.Check_Data_Timeout (Line_Index); + Check_Data_Timeout; end if; end loop Read_File; @@ -938,7 +905,7 @@ package body AWS.Server.HTTP_Utils is -- Check for end-boundary, at this point we have at least two -- chars. Either the terminating "--" or CR+LF. - Net.Buffered.Read (Sock, Data2); + Read (Data2); if Data2 (2) = 10 then -- We have CR+LF, it is a start-boundary @@ -949,7 +916,7 @@ package body AWS.Server.HTTP_Utils is -- end-boundary. End_Found := True; - Net.Buffered.Read (Sock, Data2); + Read (Data2); end if; if Error = Name_Error then @@ -987,8 +954,11 @@ package body AWS.Server.HTTP_Utils is ----------------------- procedure Store_Attachments - (Start_Boundary, End_Boundary : String; + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Start_Boundary, End_Boundary : String; Parse_Boundary : Boolean; + Multipart_Boundary : String; Root_Part_CID : String) is function Attachment_Filename (Extension : String) return String; @@ -1001,7 +971,7 @@ package body AWS.Server.HTTP_Utils is function Attachment_Filename (Extension : String) return String is Upload_Path : constant String := - CNF.Upload_Directory (HTTP_Server.Properties); + CNF.Upload_Directory (Server_Config); begin if Extension = "" then return Upload_Path & Get_File_Upload_UID; @@ -1023,7 +993,7 @@ package body AWS.Server.HTTP_Utils is if Parse_Boundary then loop declare - Data : constant String := Net.Buffered.Get_Line (Sock); + Data : constant String := Get_Line; begin exit when Data = Start_Boundary; @@ -1037,21 +1007,18 @@ package body AWS.Server.HTTP_Utils is -- Read header - Headers.Read (Sock); + Read (Headers); if AWS.Headers.Get_Values (Headers, Messages.Content_Type_Token) = MIME.Application_Form_Data then -- This chunk is the form parameter - Status.Set.Read_Body - (Sock, C_Stat, - Boundary => "--" & To_String (Status_Multipart_Boundary)); + Read_Body (C_Stat, Boundary => "--" & Multipart_Boundary); -- Skip CRLF after boundary declare - Data : constant String := Net.Buffered.Get_Line (Sock) - with Unreferenced; + Data : constant String := Get_Line with Unreferenced; begin null; end; @@ -1059,7 +1026,9 @@ package body AWS.Server.HTTP_Utils is Status.Set.Parameters_From_Body (C_Stat); Store_Attachments - (Start_Boundary, End_Boundary, False, Root_Part_CID); + (C_Stat, Attachments, + Start_Boundary, End_Boundary, False, + Multipart_Boundary, Root_Part_CID); else Content_Id := To_Unbounded_String @@ -1067,9 +1036,10 @@ package body AWS.Server.HTTP_Utils is -- Read file/field data - if Content_Id = Status_Root_Part_CID then + if Content_Id = Root_Part_CID then Get_File_Data - ("", "", Start_Boundary, Root_Attachment, Headers, End_Found); + (C_Stat, Attachments, + "", "", Start_Boundary, Root_Attachment, Headers, End_Found); else Server_Filename := To_Unbounded_String @@ -1080,7 +1050,8 @@ package body AWS.Server.HTTP_Utils is (Headers, Messages.Content_Type_Token))))); Get_File_Data - (To_String (Server_Filename), To_String (Server_Filename), + (C_Stat, Attachments, + To_String (Server_Filename), To_String (Server_Filename), Start_Boundary, Attachment, Headers, End_Found); end if; @@ -1090,12 +1061,92 @@ package body AWS.Server.HTTP_Utils is AWS.Status.Set.Attachments (C_Stat, Attachments); else Store_Attachments - (Start_Boundary, End_Boundary, False, Root_Part_CID); + (C_Stat, Attachments, + Start_Boundary, End_Boundary, False, + Multipart_Boundary, Root_Part_CID); end if; end if; end Store_Attachments; - begin -- Get_Message_Data + end Multipart_Message_G; + + ---------------------- + -- Get_Message_Data -- + ---------------------- + + procedure Get_Message_Data + (HTTP_Server : AWS.Server.HTTP; + Line_Index : Positive; + C_Stat : in out AWS.Status.Data; + Expect_100 : Boolean) + is + use type Status.Request_Method; + + Status_Multipart_Boundary : Unbounded_String; + Status_Root_Part_CID : Unbounded_String; + Status_Content_Type : Unbounded_String; + + Sock : constant Net.Socket_Type'Class := Status.Socket (C_Stat); + + Attachments : AWS.Attachments.List; + + function Get_Line return String; + -- Read a line from Sock + + procedure Read (Buffer : out Stream_Element_Array); + -- Fill buffer from Sock + + procedure Read_Body (Stat : in out Status.Data; Boundary : String); + -- Read Sock until Boundary is found + + procedure Check_Data_Timeout; + -- Check data time-out using server settings + + ------------------------ + -- Check_Data_Timeout -- + ------------------------ + + procedure Check_Data_Timeout is + begin + HTTP_Server.Slots.Check_Data_Timeout (Line_Index); + end Check_Data_Timeout; + + -------------- + -- Get_Line -- + -------------- + + function Get_Line return String is + begin + return Net.Buffered.Get_Line (Sock); + end Get_Line; + + ---------- + -- Read -- + ---------- + + procedure Read (Buffer : out Stream_Element_Array) is + begin + Net.Buffered.Read (Sock, Buffer); + end Read; + + --------------- + -- Read_Body -- + --------------- + + procedure Read_Body (Stat : in out Status.Data; Boundary : String) is + begin + Status.Set.Read_Body (Sock, Stat, Boundary => Boundary); + end Read_Body; + + ----------------------- + -- Multipart_Message -- + ----------------------- + + package Multipart_Message is new Multipart_Message_G + (HTTP_Server.Properties, + Get_Line, Read, Read_Body, Check_Data_Timeout); + + begin if Expect_100 then Net.Buffered.Put_Line (Sock, Messages.Status_Line (Messages.S100)); Net.Buffered.New_Line (Sock); @@ -1175,8 +1226,10 @@ package body AWS.Server.HTTP_Utils is then -- This is a file upload - File_Upload - ("--" & To_String (Status_Multipart_Boundary), + Multipart_Message.File_Upload + (C_Stat, + Attachments, + "--" & To_String (Status_Multipart_Boundary), "--" & To_String (Status_Multipart_Boundary) & "--", True); @@ -1185,10 +1238,13 @@ package body AWS.Server.HTTP_Utils is then -- Attachments are to be written to separate files - Store_Attachments - ("--" & To_String (Status_Multipart_Boundary), + Multipart_Message.Store_Attachments + (C_Stat, + Attachments, + "--" & To_String (Status_Multipart_Boundary), "--" & To_String (Status_Multipart_Boundary) & "--", True, + To_String (Status_Multipart_Boundary), To_String (Status_Root_Part_CID)); else diff --git a/src/core/aws-server-http_utils.ads b/src/core/aws-server-http_utils.ads index 92098fb7c..ff5c84ab4 100644 --- a/src/core/aws-server-http_utils.ads +++ b/src/core/aws-server-http_utils.ads @@ -31,6 +31,8 @@ with Ada.Calendar; with Ada.IO_Exceptions; with Ada.Streams; +with AWS.Attachments; +with AWS.Headers; with AWS.Resources; with AWS.Response; with AWS.Status; @@ -146,4 +148,52 @@ package AWS.Server.HTTP_Utils is -- request status. This routine must be called after Get_Message_header as -- the request header must have been parsed. + generic + Server_Config : AWS.Config.Object; + with function Get_Line return String; + with procedure Read (Buffer : out Stream_Element_Array); + with procedure Read_Body (Stat : in out Status.Data; Boundary : String); + with procedure Check_Data_Timeout; + -- Check for data timeout, Server.Slots.Check_Data_Timeout (Index); + package Multipart_Message_G is + + type Message_Mode is + (Root_Attachment, -- Read the root attachment + Attachment, -- Read an attachment + File_Upload); -- Read a file upload + + procedure File_Upload + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Start_Boundary, End_Boundary : String; + Parse_Boundary : Boolean); + -- Handle file upload data coming from the client browser + + function Get_File_Upload_UID return String; + -- Returns a unique id for each file upload + + procedure Get_File_Data + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Server_Filename : String; + Filename : String; + Start_Boundary : String; + Mode : Message_Mode; + Headers : AWS.Headers.List; + End_Found : out Boolean); + -- Read file data from the stream, set End_Found if the end-boundary + -- signature has been read. Server_Filename is the filename to be used + -- for on-disk content (Attachment and File_Upload mode). + + procedure Store_Attachments + (C_Stat : in out Status.Data; + Attachments : in out AWS.Attachments.List; + Start_Boundary, End_Boundary : String; + Parse_Boundary : Boolean; + Multipart_Boundary : String; + Root_Part_CID : String); + -- Store attachments coming from the client browser + + end Multipart_Message_G; + end AWS.Server.HTTP_Utils; From 889d3388e5235fa4d1327d52e5fa5d724996d13c Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 24 Sep 2021 18:12:18 +0200 Subject: [PATCH 23/51] Minor improvement to HPACK test. Part of S507-051. --- regtests/0341_hpack/main.adb | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/regtests/0341_hpack/main.adb b/regtests/0341_hpack/main.adb index 8d7d199df..a7875c95c 100644 --- a/regtests/0341_hpack/main.adb +++ b/regtests/0341_hpack/main.adb @@ -77,16 +77,18 @@ procedure Main is end loop; end Print; - M : AWS.Headers.List := Decode (Tab_Dec'Access, Settings'Access); + M : constant AWS.Headers.List := + Decode (Tab_Dec'Access, Settings'Access); use type AWS.Headers.List; use type AWS.HTTP2.HPACK.Table.Object; begin if M /= H then - Ada.Text_IO.Put_Line ("Headers differ"); + Ada.Text_IO.Put_Line ("============= Headers differ"); Print (H); Print (M); + New_Line; end if; if Tab_Enc /= Tab_Dec then From e3cf4569bc4c0f5665b8775b7b6bbc68f599ba29 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:12:42 +0200 Subject: [PATCH 24/51] New routine to get the internal memory stream. Part of S507-051. --- src/core/aws-status.ads | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/src/core/aws-status.ads b/src/core/aws-status.ads index ad12e2548..20ac927b6 100644 --- a/src/core/aws-status.ads +++ b/src/core/aws-status.ads @@ -43,10 +43,10 @@ with AWS.Headers; with AWS.Messages; with AWS.Net; with AWS.Parameters; +with AWS.Resources.Streams.Memory; with AWS.Session; with AWS.URL; -private with AWS.Resources.Streams.Memory; private with GNAT.SHA256; package AWS.Status is @@ -223,6 +223,11 @@ package AWS.Status is -- Returns the binary data message content in a Unbounded_String -- Note that only the root part of a multipart/related message is returned. + function Binary_Data + (D : Data) + return not null access Resources.Streams.Memory.Stream_Type'Class; + -- Returns the binary data message as a memory resource stream + function Binary_Size (D : Data) return Stream_Element_Offset with Inline; -- Returns size of the binary data message content @@ -410,4 +415,9 @@ private Session_Timed_Out : Boolean := False; end record; + function Binary_Data + (D : Data) + return not null access Resources.Streams.Memory.Stream_Type'Class + is (D.Binary_Data); + end AWS.Status; From 79e7354ff6502427760f67507f2b0324cb3dbee7 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:17:36 +0200 Subject: [PATCH 25/51] Add routine Get_Line from a resource stream. Part of S507-051. --- src/core/aws-resources-streams.adb | 29 ++++++++++++++++++++++++++++- src/core/aws-resources-streams.ads | 6 +++++- 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/src/core/aws-resources-streams.adb b/src/core/aws-resources-streams.adb index ed7ee69a9..ac09487af 100644 --- a/src/core/aws-resources-streams.adb +++ b/src/core/aws-resources-streams.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2002-2012, AdaCore -- +-- Copyright (C) 2002-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 -- @@ -28,6 +28,7 @@ ------------------------------------------------------------------------------ with Ada.IO_Exceptions; +with Ada.Strings.Unbounded; with AWS.Resources.Embedded; with AWS.Resources.Streams.Disk.Once; @@ -36,6 +37,8 @@ with AWS.Resources.Streams.ZLib; package body AWS.Resources.Streams is + use Ada.Strings.Unbounded; + ------------ -- Create -- ------------ @@ -47,6 +50,30 @@ package body AWS.Resources.Streams is Resource := File_Type (Stream); end Create; + -------------- + -- Get_Line -- + -------------- + + function Get_Line (Resource : in out Stream_Type'Class) return String is + Result : Unbounded_String; + B : Stream_Element_Array (1 .. 1); + L : Stream_Element_Offset; + Stop : Boolean := False; + begin + while not Stop and then not Resource.End_Of_File loop + Resource.Read (B, L); + + if B (B'First) not in 13 | 10 then + Append (Result, Character'Val (Natural (B (B'First)))); + + elsif B (B'First) = 10 then + Stop := True; + end if; + end loop; + + return To_String (Result); + end Get_Line; + ---------- -- Name -- ---------- diff --git a/src/core/aws-resources-streams.ads b/src/core/aws-resources-streams.ads index 4f48f17c3..b8b324424 100644 --- a/src/core/aws-resources-streams.ads +++ b/src/core/aws-resources-streams.ads @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2002-2017, AdaCore -- +-- Copyright (C) 2002-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 -- @@ -42,6 +42,10 @@ package AWS.Resources.Streams is Buffer : out Stream_Element_Array; Last : out Stream_Element_Offset) is abstract; + function Get_Line (Resource : in out Stream_Type'Class) return String; + -- Returns a line (set of bytes ending with CR and/or LF) read + -- from Resource. + procedure Reset (Resource : in out Stream_Type) is abstract; procedure Set_Index From 6a9238191b806a0fd00e1ef60a3a88fc8456bb33 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:25:07 +0200 Subject: [PATCH 26/51] Add support for Boundary in Parameters_From_Body. This make it possible to set parameters from HTTP/2 messages where the whole payload is loaded as message body. Part of S507-051. --- src/core/aws-status-set.adb | 33 +++++++++++++++++++++++++++++++-- src/core/aws-status-set.ads | 6 ++++-- 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/src/core/aws-status-set.adb b/src/core/aws-status-set.adb index 0a7b1f95b..fbb06a41d 100644 --- a/src/core/aws-status-set.adb +++ b/src/core/aws-status-set.adb @@ -402,9 +402,38 @@ package body AWS.Status.Set is -- Parameters_From_Body -- -------------------------- - procedure Parameters_From_Body (D : in out Data) is + procedure Parameters_From_Body + (D : in out Data; Boundary : String := "") + is + use AWS.Resources.Streams; + + R : constant not null access Memory.Stream_Type'Class := + D.Binary_Data; begin - AWS.URL.Set.Parameters (D.URI'Access).all.Add (D.Binary_Data.all); + D.Binary_Data.Reset; + + if Boundary /= "" then + Look_Boundary : loop + declare + Line : constant String := R.Get_Line; + begin + if Line = Boundary then + -- Boundary found, skip headers until empty line found + loop + declare + Line : constant String := R.Get_Line; + begin + exit Look_Boundary when Line = ""; + end; + end loop; + end if; + end; + end loop Look_Boundary; + end if; + + -- Now parse body to set parameters + + AWS.URL.Set.Parameters (D.URI'Access).all.Add (R.all); end Parameters_From_Body; -------------- diff --git a/src/core/aws-status-set.ads b/src/core/aws-status-set.ads index 7338775fc..818e25351 100644 --- a/src/core/aws-status-set.ads +++ b/src/core/aws-status-set.ads @@ -100,10 +100,12 @@ package AWS.Status.Set is procedure Parameters (D : in out Data; Set : AWS.Parameters.List); -- Associate the parameters in Set to the status data - procedure Parameters_From_Body (D : in out Data) with Inline; + procedure Parameters_From_Body + (D : in out Data; Boundary : String := "") with Inline; -- Get HTTP parameters from message body for POST form processing. -- This routine allow to move big message body into HTTP parameters set - -- with low stack usage. + -- with low stack usage. If Boundary is set, first the given bounday will + -- be skip with any other headers just after until on empty line is found. procedure Case_Sensitive_Parameters (D : in out Data; Mode : Boolean) with Inline; From da6ad9e4ce1e8affe23523d48145aaa4513c9eec Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:27:57 +0200 Subject: [PATCH 27/51] Refactor a bit the code to allow for multiple connection with HTTP/2. This is not yet activated as for HTTP/2 we still set Will_Close to True unconditionally. Part of S507-051. --- src/core/aws-server-protocol_handler.adb | 116 ++++++++++++----------- 1 file changed, 61 insertions(+), 55 deletions(-) diff --git a/src/core/aws-server-protocol_handler.adb b/src/core/aws-server-protocol_handler.adb index 176835199..3d1eb1cd0 100644 --- a/src/core/aws-server-protocol_handler.adb +++ b/src/core/aws-server-protocol_handler.adb @@ -192,16 +192,17 @@ begin AWS.Status.Set.Case_Sensitive_Parameters (LA.Stat, Case_Sensitive_Parameters); - Get_Request_Line (LA.Stat); + if AWS.Status.Protocol (LA.Stat) = AWS.Status.HTTP_1 then + Get_Request_Line (LA.Stat); + end if; if AWS.Status.Protocol (LA.Stat) = AWS.Status.H2 then if CNF.HTTP2_Activated (LA.Server.Config) then Protocol_Handler_V2 (LA, Check_Preface => False); + -- ??? Need to be updated for handling multiple messages Will_Close := True; - exit For_Every_Request; - else Error_Answer := Response.Build (Status_Code => Messages.S505, @@ -212,76 +213,80 @@ begin end if; end if; - First_Line := False; + if AWS.Status.Protocol (LA.Stat) = AWS.Status.HTTP_1 then + First_Line := False; - AWS.Status.Set.Read_Header (Socket => Sock_Ptr.all, D => LA.Stat); + AWS.Status.Set.Read_Header (Socket => Sock_Ptr.all, D => LA.Stat); - AWS.Status.Set.Connection_Data - (LA.Stat, - CNF.Server_Host (LA.Server.Properties), - AWS.Server.Status.Port (LA.Server.all), - CNF.Security (LA.Server.Properties)); + AWS.Status.Set.Connection_Data + (LA.Stat, + CNF.Server_Host (LA.Server.Properties), + AWS.Server.Status.Port (LA.Server.all), + CNF.Security (LA.Server.Properties)); - LA.Server.Slots.Increment_Slot_Activity_Counter (LA.Line, Free_Slots); + LA.Server.Slots.Increment_Slot_Activity_Counter + (LA.Line, Free_Slots); - -- If there is no more slot available and we have many - -- of them, try to abort one of them. + -- If there is no more slot available and we have many + -- of them, try to abort one of them. - if Multislots and then Free_Slots = 0 then - Force_Clean (LA.Server.all); - end if; + if Multislots and then Free_Slots = 0 then + Force_Clean (LA.Server.all); + end if; - if Extended_Log then - AWS.Log.Set_Field - (LA.Server.Log, LA.Log_Data, - "s-free-slots", Utils.Image (Free_Slots)); - end if; + if Extended_Log then + AWS.Log.Set_Field + (LA.Server.Log, LA.Log_Data, + "s-free-slots", Utils.Image (Free_Slots)); + end if; - Set_Close_Status - (LA.Stat, - Keep_Alive => Free_Slots >= Keep_Alive_Limit, - Will_Close => Will_Close); + Set_Close_Status + (LA.Stat, + Keep_Alive => Free_Slots >= Keep_Alive_Limit, + Will_Close => Will_Close); - -- Is there something to read ? + -- Is there something to read ? - if AWS.Status.Content_Length (LA.Stat) = 0 - and then AWS.Status.Transfer_Encoding (LA.Stat) /= "chunked" - then - LA.Server.Slots.Mark_Phase (LA.Line, Server_Processing); + if AWS.Status.Content_Length (LA.Stat) = 0 + and then AWS.Status.Transfer_Encoding (LA.Stat) /= "chunked" + then + LA.Server.Slots.Mark_Phase (LA.Line, Server_Processing); - else - declare - Expect : constant String := AWS.Status.Expect (LA.Stat); - begin - LA.Expect_100 := Expect = Messages.S100_Continue; + else + declare + Expect : constant String := AWS.Status.Expect (LA.Stat); + begin + LA.Expect_100 := Expect = Messages.S100_Continue; - if not LA.Expect_100 and then Expect /= "" then - Will_Close := True; + if not LA.Expect_100 and then Expect /= "" then + Will_Close := True; - Error_Answer := Response.Build - (Status_Code => Messages.S417, - Content_Type => "text/plain", - Message_Body => "Unknown Expect header value " & Expect); + Error_Answer := Response.Build + (Status_Code => Messages.S417, + Content_Type => "text/plain", + Message_Body => + "Unknown Expect header value " & Expect); - raise Expectation_Failed; - end if; - end; + raise Expectation_Failed; + end if; + end; - LA.Server.Slots.Mark_Phase (LA.Line, Client_Data); + LA.Server.Slots.Mark_Phase (LA.Line, Client_Data); - if AWS.Status.Content_Length (LA.Stat) - <= Stream_Element_Count - (CNF.Upload_Size_Limit (LA.Server.Properties)) - then - Get_Message_Data - (LA.Server.all, LA.Line, LA.Stat, LA.Expect_100); + if AWS.Status.Content_Length (LA.Stat) + <= Stream_Element_Count + (CNF.Upload_Size_Limit (LA.Server.Properties)) + then + Get_Message_Data + (LA.Server.all, LA.Line, LA.Stat, LA.Expect_100); + end if; end if; - end if; - AWS.Status.Set.Keep_Alive (LA.Stat, not Will_Close); + AWS.Status.Set.Keep_Alive (LA.Stat, not Will_Close); - Answer_To_Client - (LA.Server.all, LA.Line, LA.Stat, Socket_Taken, Will_Close); + Answer_To_Client + (LA.Server.all, LA.Line, LA.Stat, Socket_Taken, Will_Close); + end if; if AWS.Status.Protocol (LA.Stat) = AWS.Status.Upgrade_To_H2C and then CNF.HTTP2_Activated (LA.Server.Config) @@ -290,6 +295,7 @@ begin Protocol_Handler_V2 (LA); + -- ??? Need to be updated for handling multiple messages Will_Close := True; end if; From b966530c6698b9a4ad1cf90675f04c3829f488b8 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:31:51 +0200 Subject: [PATCH 28/51] Minor code clean-up. Part of S507-051. --- src/core/aws-client-http_utils.adb | 4 ++-- src/core/aws-parameters.adb | 3 +-- src/core/aws-server-http_utils.adb | 1 + src/core/aws-server-protocol_handler_v2.adb | 2 +- src/http2/aws-http2-connection.adb | 4 ++-- src/http2/aws-http2-stream.adb | 1 - 6 files changed, 7 insertions(+), 8 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 74903711b..5563c5890 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -775,8 +775,8 @@ package body AWS.Client.HTTP_Utils is CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; - Settings : constant HTTP2.Frame.Settings.Set := - Get_Settings (Connection.Config); + Settings : constant HTTP2.Frame.Settings.Set := + Get_Settings (Connection.Config); Pref_Suf : constant String := "--"; Boundary : constant String := diff --git a/src/core/aws-parameters.adb b/src/core/aws-parameters.adb index dd6bb4481..002389c42 100644 --- a/src/core/aws-parameters.adb +++ b/src/core/aws-parameters.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2000-2017, AdaCore -- +-- Copyright (C) 2000-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 -- @@ -138,7 +138,6 @@ package body AWS.Parameters is exit when Last < Buffer'Last; end if; - end loop; end Add; diff --git a/src/core/aws-server-http_utils.adb b/src/core/aws-server-http_utils.adb index 57cdb2136..71f9c8dff 100644 --- a/src/core/aws-server-http_utils.adb +++ b/src/core/aws-server-http_utils.adb @@ -578,6 +578,7 @@ package body AWS.Server.HTTP_Utils is (Headers, Messages.Content_Type_Token) = MIME.Application_Form_Data then -- This chunk is the form parameter + Read_Body (C_Stat, Boundary => Start_Boundary); -- Skip CRLF after boundary diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index 17ee23e93..1cef2cecd 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -439,7 +439,7 @@ is Value : constant String := Headers.Get_Value (K); begin if HTTP2.Debug then - Ada.Text_IO.Put_Line ("#hg " & Header & ' ' & Value); + Text_IO.Put_Line ("#hg " & Header & ' ' & Value); end if; if Header'Length > 1 and then Header (Header'First) = ':' then diff --git a/src/http2/aws-http2-connection.adb b/src/http2/aws-http2-connection.adb index 2febb00e7..705545601 100644 --- a/src/http2/aws-http2-connection.adb +++ b/src/http2/aws-http2-connection.adb @@ -38,8 +38,8 @@ package body AWS.HTTP2.Connection is function Flow_Control_Window_Valid (Current, Increment : Integer) return Boolean is - Max : constant Natural := - Natural (HTTP2.Frame.Window_Update.Size_Increment_Type'Last); + Max : constant Natural := + Natural (HTTP2.Frame.Window_Update.Size_Increment_Type'Last); begin return Current <= Max - Increment; end Flow_Control_Window_Valid; diff --git a/src/http2/aws-http2-stream.adb b/src/http2/aws-http2-stream.adb index 246ad5b67..73536ee9b 100644 --- a/src/http2/aws-http2-stream.adb +++ b/src/http2/aws-http2-stream.adb @@ -270,7 +270,6 @@ package body AWS.HTTP2.Stream is Self.Flow_Send_Window := Self.Flow_Send_Window + Incr; else Error := HTTP2.C_Flow_Control_Error; - return; end if; end Handle_Window_Update; From 6dce33b09c02046110ba1596c2cc042117789c16 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:32:55 +0200 Subject: [PATCH 29/51] Update to be able to read POST parameter with HTTP/2. Part of S507-051. --- src/core/aws-server-http_utils.adb | 15 ++++++++++----- src/core/aws-server-http_utils.ads | 1 + 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/core/aws-server-http_utils.adb b/src/core/aws-server-http_utils.adb index 71f9c8dff..0ae4ed257 100644 --- a/src/core/aws-server-http_utils.adb +++ b/src/core/aws-server-http_utils.adb @@ -589,11 +589,12 @@ package body AWS.Server.HTTP_Utils is null; end; - Status.Set.Parameters_From_Body (C_Stat); - File_Upload (C_Stat, Attachments, Start_Boundary, End_Boundary, False); + Status.Set.Parameters_From_Body + (C_Stat, (if Is_H2 then Start_Boundary else "")); + else -- Read file upload parameters @@ -1024,13 +1025,17 @@ package body AWS.Server.HTTP_Utils is null; end; - Status.Set.Parameters_From_Body (C_Stat); - Store_Attachments (C_Stat, Attachments, Start_Boundary, End_Boundary, False, Multipart_Boundary, Root_Part_CID); + -- In HTTP/2 the whole message is read with the multipart header + -- for the main form data. + + Status.Set.Parameters_From_Body + (C_Stat, (if Is_H2 then Start_Boundary else "")); + else Content_Id := To_Unbounded_String (AWS.Headers.Get (Headers, Messages.Content_Id_Token)); @@ -1144,7 +1149,7 @@ package body AWS.Server.HTTP_Utils is ----------------------- package Multipart_Message is new Multipart_Message_G - (HTTP_Server.Properties, + (False, HTTP_Server.Properties, Get_Line, Read, Read_Body, Check_Data_Timeout); begin diff --git a/src/core/aws-server-http_utils.ads b/src/core/aws-server-http_utils.ads index ff5c84ab4..3ef9f50f4 100644 --- a/src/core/aws-server-http_utils.ads +++ b/src/core/aws-server-http_utils.ads @@ -149,6 +149,7 @@ package AWS.Server.HTTP_Utils is -- the request header must have been parsed. generic + Is_H2 : Boolean; Server_Config : AWS.Config.Object; with function Get_Line return String; with procedure Read (Buffer : out Stream_Element_Array); From a32df94e5445c54e4fb41336d12c73445dabd8c2 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:36:07 +0200 Subject: [PATCH 30/51] In HTTP/2 the body is always fully uploaded. Part of S507-051. --- src/core/aws-server-protocol_handler_v2.adb | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index 1cef2cecd..ac8b90376 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -583,6 +583,10 @@ is begin AWS.Status.Set.Reset (Status); + -- With HTTP/2 the whole body is always uploaded when receiving frames + + AWS.Status.Set.Uploaded (Status); + -- Set status socket and peername AWS.Status.Set.Socket (Status, Sock); From f05dbcdd1a6a840e4ca4273a4df3d4bfc3392581 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 10:43:14 +0200 Subject: [PATCH 31/51] Read parameters from first line only. In HTTP/2 we have the whole payload, so the body could be followed by attachments. Note also that we do not reset anymore the stream, it is the responsibility of Parameters_From_Body to place the stream at the right location (after possible main boundary). Part of S507-051. --- src/core/aws-parameters.adb | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/core/aws-parameters.adb b/src/core/aws-parameters.adb index 002389c42..a1678cac7 100644 --- a/src/core/aws-parameters.adb +++ b/src/core/aws-parameters.adb @@ -93,11 +93,19 @@ package body AWS.Parameters is return; end if; - Parameters.Reset; - loop Parameters.Read (Buffer (First .. Buffer'Last), Last); + -- Take a single line + -- ??? We can rewrite this using Get_Line probably + + for J in First .. Last loop + if Buffer (J) in 13 | 10 then + Last := J - 1; + exit; + end if; + end loop; + Found := False; Find_Last_Amp : for J in reverse First .. Last loop From 42c72b7d27d793e882dfd99e573098f25572ed39 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 11:12:24 +0200 Subject: [PATCH 32/51] Use a unique port for 0345_http2_soap_hello. --- regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl b/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl index f2526921f..a852e7fdf 100644 --- a/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl +++ b/regtests/0345_http2_soap_hello/wsdl_h2hello.wsdl @@ -125,7 +125,7 @@ + location="http://localhost:9837/hello"/> From 7aa0ba6dc24027f5e8c93f70e21c17ae3c5521a9 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 22:01:07 +0200 Subject: [PATCH 33/51] Fix wrong initialization of Max_Frame_Size (cut&paste) error. Part of S507-051. --- src/http2/aws-http2-connection.ads | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/http2/aws-http2-connection.ads b/src/http2/aws-http2-connection.ads index d46345e69..98b27d763 100644 --- a/src/http2/aws-http2-connection.ads +++ b/src/http2/aws-http2-connection.ads @@ -121,7 +121,7 @@ private S.INITIAL_WINDOW_SIZE => Default.HTTP2_Initial_Window_Size, S.MAX_FRAME_SIZE => - Default.HTTP2_Initial_Window_Size, + Default.HTTP2_Max_Frame_Size, S.MAX_HEADER_LIST_SIZE => Default.HTTP2_Max_Header_List_Size); From b4dcca42e37f1c80498f6ab1f9682903552646ff Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 22:04:56 +0200 Subject: [PATCH 34/51] Properly update connection flow control window. Not only the flow control window of the stream must be updated but also the connection one. Part of S507-051. --- src/http2/aws-http2-stream.adb | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/http2/aws-http2-stream.adb b/src/http2/aws-http2-stream.adb index 73536ee9b..424b5953a 100644 --- a/src/http2/aws-http2-stream.adb +++ b/src/http2/aws-http2-stream.adb @@ -243,7 +243,7 @@ package body AWS.HTTP2.Stream is procedure Handle_Window_Update (Frame : HTTP2.Frame.Window_Update.Object); -- Handle frame window upade, record corresponding information in the - -- frame. + -- stream and connection. --------------------- -- Handle_Priority -- @@ -268,6 +268,7 @@ package body AWS.HTTP2.Stream is (Self.Flow_Send_Window, Incr) then Self.Flow_Send_Window := Self.Flow_Send_Window + Incr; + Ctx.Settings.Update_Flow_Control_Window (Incr); else Error := HTTP2.C_Flow_Control_Error; end if; From f0f57f229bf4a7ce80a3d66d06e3132014b5c96e Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Wed, 29 Sep 2021 11:05:20 +0200 Subject: [PATCH 35/51] Add initial support for POST with attachments for HTTP/2. This works only for non persistent connection and for small messages. Add corresponding regression test. Part of S507-051. --- .../0346_http2_post_attachments/file1.dat | 1 + .../0346_http2_post_attachments/file2.dat | 1 + .../h2post_attachments.adb | 232 ++++++++++++++++++ .../h2post_attachments.gpr | 24 ++ regtests/0346_http2_post_attachments/test.out | 40 +++ regtests/0346_http2_post_attachments/test.py | 3 + src/core/aws-client-http_utils.adb | 67 ++++- src/core/aws-client.adb | 2 + src/core/aws-client.ads | 2 + src/core/aws-server-protocol_handler_v2.adb | 200 +++++++++++++-- 10 files changed, 548 insertions(+), 24 deletions(-) create mode 100644 regtests/0346_http2_post_attachments/file1.dat create mode 100644 regtests/0346_http2_post_attachments/file2.dat create mode 100644 regtests/0346_http2_post_attachments/h2post_attachments.adb create mode 100644 regtests/0346_http2_post_attachments/h2post_attachments.gpr create mode 100644 regtests/0346_http2_post_attachments/test.out create mode 100644 regtests/0346_http2_post_attachments/test.py diff --git a/regtests/0346_http2_post_attachments/file1.dat b/regtests/0346_http2_post_attachments/file1.dat new file mode 100644 index 000000000..e2129701f --- /dev/null +++ b/regtests/0346_http2_post_attachments/file1.dat @@ -0,0 +1 @@ +file1 diff --git a/regtests/0346_http2_post_attachments/file2.dat b/regtests/0346_http2_post_attachments/file2.dat new file mode 100644 index 000000000..6c493ff74 --- /dev/null +++ b/regtests/0346_http2_post_attachments/file2.dat @@ -0,0 +1 @@ +file2 diff --git a/regtests/0346_http2_post_attachments/h2post_attachments.adb b/regtests/0346_http2_post_attachments/h2post_attachments.adb new file mode 100644 index 000000000..ac1f18546 --- /dev/null +++ b/regtests/0346_http2_post_attachments/h2post_attachments.adb @@ -0,0 +1,232 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Streams; +with Ada.Strings.Fixed; +with Ada.Strings.Maps; +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Attachments; +with AWS.Client; +with AWS.Config.Set; +with AWS.Headers; +with AWS.Messages; +with AWS.MIME; +with AWS.Net.Log; +with AWS.Parameters; +with AWS.Response; +with AWS.Server.Log; +with AWS.Server.Status; +with AWS.Status; +with AWS.Translator; +with AWS.Utils; + +procedure H2Post_Attachments is + + use Ada; + use Ada.Streams; + use Ada.Strings.Unbounded; + use AWS; + + Data_Name : constant String := "big-data"; + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + Params : Parameters.List; + Attachs : Attachments.List; + + procedure Output_A_Name (E : Attachments.Element); + + ------------------- + -- Output_A_Name -- + ------------------- + + procedure Output_A_Name (E : Attachments.Element) is + use Strings.Unbounded; + + L_Filename : Unbounded_String := + To_Unbounded_String (Attachments.Local_Filename (E)); + C : constant Natural := + Strings.Unbounded.Index (L_Filename, "-"); + begin + Text_IO.Put_Line ("Filename " & Attachments.Filename (E)); + + -- Convert slashes + + Strings.Unbounded.Translate + (L_Filename, Strings.Maps.To_Mapping ("\", "/")); + + -- Now remove the pid + + Strings.Unbounded.Replace_Slice (L_Filename, 3, C, "XpidX-"); + + Text_IO.Put_Line ("Local Filename " & To_String (L_Filename)); + end Output_A_Name; + + begin + if not Status.Is_Body_Uploaded (Request) then + Text_IO.Put_Line + ("ERROR: allow client upload (should not happen in HTTP/2)"); + return Response.Continue; + end if; + + Params := Status.Parameters (Request); + Attachs := Status.Attachments (Request); + + Text_IO.Put_Line ("*** ID =" & Params.Get ("ID")); + Text_IO.Put_Line + ("*** N Attachments = " & Natural'Image (Attachments.Count (Attachs))); + + Attachments.Iterate (Attachs, Output_A_Name'Access); + + if Params.Exist (Data_Name) then + Text_IO.Put_Line + (Data_Name & " size" + & Length (Params.Get_Values (Data_Name) (1))'Img & " bytes"); + end if; + + return Response.Build (MIME.Text_HTML, "ok"); + exception + when others => + Text_IO.Put_Line ("Exception on CB!"); + return Response.Build (MIME.Text_HTML, "nok"); + end CB; + + ---------- + -- Dump -- + ---------- + + procedure Dump + (Direction : Net.Log.Data_Direction; + Socket : Net.Socket_Type'Class; + Data : Stream_Element_Array; + Last : Stream_Element_Offset) + is + use type Net.Log.Data_Direction; + begin + if Direction = Net.Log.Sent then + Text_IO.Put_Line + ("********** " & Net.Log.Data_Direction'Image (Direction)); + Text_IO.Put_Line + (Translator.To_String (Data (Data'First .. Last))); + Text_IO.New_Line; + end if; + end Dump; + + CNF : Config.Object; + WS : Server.HTTP; + WC : Client.HTTP_Connection; + R : Response.Data; + Attachments : AWS.Attachments.List; + +begin + Config.Set.Server_Name (CNF, "H2 Post Attachments"); + Config.Set.Server_Port (CNF, 0); + Config.Set.Max_Connection (CNF, 5); + Config.Set.Upload_Directory (CNF, "."); + Config.Set.HTTP2_Activated (CNF, True); + + AWS.Attachments.Add + (Attachments => Attachments, + Filename => "file1.dat", + Headers => AWS.Headers.Empty_List); + AWS.Attachments.Add + (Attachments => Attachments, + Filename => "file2.dat", + Headers => AWS.Headers.Empty_List); + + Server.Start (WS, CB'Unrestricted_Access, CNF); + + Server.Log.Start_Error (WS); + + Text_IO.Put_Line ("started"); + Text_IO.Flush; + Text_IO.New_Line; + +-- AWS.Net.Log.Start (Dump'Unrestricted_Access); + +-- Client.Create (WC, Server.Status.Local_URL (WS), HTTP_Version => HTTPv2); + + R := AWS.Client.Post + (Server.Status.Local_URL (WS) & "/Upload", Data => "ID=100", + HTTP_Version => HTTPv2); + Text_IO.Put_Line ("R-POST1 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + R := AWS.Client.Post + (Server.Status.Local_URL (WS) & "/Upload", Data => "ID=101", + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments, + HTTP_Version => HTTPv2); + Text_IO.Put_Line ("R-POST2 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + R := AWS.Client.Post + (Server.Status.Local_URL (WS) & "/Upload?ID=102", + Data => AWS.Client.No_Data, + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments, + HTTP_Version => HTTPv2); + Text_IO.Put_Line ("R-POST3 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + R := AWS.Client.Post + (Server.Status.Local_URL (WS) & "/Upload?ID=103", Data => "AnyOldString", + Content_Type => AWS.Client.No_Data, + Attachments => Attachments, + HTTP_Version => HTTPv2); + Text_IO.Put_Line ("R-POST4 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + declare + Content : Unbounded_String; + Sample : constant String := + "1234567890qwertyuioplkjhgfdszxcvbnmMNBVCXZASDFGHJKLPOIUYTW"; + Headers : AWS.Headers.List; + begin + for J in 10_001 .. 95_000 loop + Append (Content, Sample & J'Img & ASCII.LF); + end loop; + + Headers.Add + (AWS.Messages.Content_Disposition_Token, "name=""" & Data_Name & '"'); + -- !!! No name for Data_Name parameter in callback without this header. + -- Maybe need some fix. + + Attachments.Add + (Name => Data_Name, + Data => AWS.Attachments.Value (Content), + Headers => Headers); + end; + + R := AWS.Client.Post + (Server.Status.Local_URL (WS) & "/Upload", Data => "ID=104", + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments, + HTTP_Version => HTTPv2); + Text_IO.Put_Line ("R-POST5 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + Client.Close (WC); + Server.Shutdown (WS); + Text_IO.Put_Line ("shutdown"); +end H2Post_Attachments; diff --git a/regtests/0346_http2_post_attachments/h2post_attachments.gpr b/regtests/0346_http2_post_attachments/h2post_attachments.gpr new file mode 100644 index 000000000..3f6086e95 --- /dev/null +++ b/regtests/0346_http2_post_attachments/h2post_attachments.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project H2Post_Attachments is + for Source_Dirs use (".", "../common"); + for Main use ("h2post_attachments.adb"); +end H2Post_Attachments; diff --git a/regtests/0346_http2_post_attachments/test.out b/regtests/0346_http2_post_attachments/test.out new file mode 100644 index 000000000..53a057680 --- /dev/null +++ b/regtests/0346_http2_post_attachments/test.out @@ -0,0 +1,40 @@ +started + +*** ID =100 +*** N Attachments = 0 +R-POST1 : ok + +*** ID =101 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-0.file1.dat +Filename file2.dat +Local Filename ./XpidX-1.file2.dat +R-POST2 : ok + +*** ID =102 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-2.file1.dat +Filename file2.dat +Local Filename ./XpidX-3.file2.dat +R-POST3 : ok + +*** ID =103 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-4.file1.dat +Filename file2.dat +Local Filename ./XpidX-5.file2.dat +R-POST4 : ok + +*** ID =104 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-6.file1.dat +Filename file2.dat +Local Filename ./XpidX-7.file2.dat +big-data size 5610000 bytes +R-POST5 : ok + +shutdown diff --git a/regtests/0346_http2_post_attachments/test.py b/regtests/0346_http2_post_attachments/test.py new file mode 100644 index 000000000..fee5a1ede --- /dev/null +++ b/regtests/0346_http2_post_attachments/test.py @@ -0,0 +1,3 @@ +from test_support import * + +build_and_run('h2post_attachments'); diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 5563c5890..e814601f5 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -141,6 +141,9 @@ package body AWS.Client.HTTP_Utils is with Pre => not Connection.H2_Preface_Sent; -- Send connection preface and get response from server + procedure Next_Stream_Id (Connection : in out HTTP_Connection); + -- Update client's stream-id to next value + --------- -- "+" -- --------- @@ -659,7 +662,7 @@ package body AWS.Client.HTTP_Utils is end Content_Length; begin - Connection.Self.F_Headers.Reset; + Connection.F_Headers.Reset; Build_Root_Part_Header; @@ -772,6 +775,7 @@ package body AWS.Client.HTTP_Utils is use Real_Time; use all type HTTP2.Frame.Flags_Type; + use all type HTTP2.Frame.Kind_Type; CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; @@ -817,14 +821,14 @@ package body AWS.Client.HTTP_Utils is end Build_Root_Part_Header; begin - Connection.Self.F_Headers.Reset; + Connection.F_Headers.Reset; Build_Root_Part_Header; Retry : loop begin Set_Common_Post - (Connection, Data, URI, SOAPAction, Content_Type, Headers); + (Connection, Data, URI, SOAPAction, "", Headers); if Content_Type = "" then Set_Header @@ -849,7 +853,10 @@ package body AWS.Client.HTTP_Utils is -- Create frames and send them Stream := HTTP2.Stream.Create - (Connection.Socket, 1, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); Request := HTTP2.Message.Create (Connection.F_Headers, @@ -903,14 +910,38 @@ package body AWS.Client.HTTP_Utils is Request.Append_Body (Pref_Suf & Boundary & Pref_Suf & CRLF); - for F of Request.To_Frames (Ctx, Stream) loop - Stream.Send_Frame (F); - end loop; + All_Frames : loop + for F of Request.To_Frames (Ctx, Stream) loop + Stream.Send_Frame (F); + + if F.Kind = HTTP2.Frame.K_Data then + Ctx.Settings.Update_Flow_Control_Window + (-Natural (F.Length)); + end if; + end loop; + + if Request.More_Frames then + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, H_Connection); + Error : HTTP2.Error_Codes; + begin + Stream.Received_Frame (Ctx, Frame, Error); + end; + + else + exit All_Frames; + end if; + end loop All_Frames; -- Get response Stream := HTTP2.Stream.Create - (Connection.Socket, 3, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); while not Stream.Is_Message_Ready loop declare @@ -1129,6 +1160,16 @@ package body AWS.Client.HTTP_Utils is end loop Retry; end Internal_Post_Without_Attachment_2; + -------------------- + -- Next_Stream_Id -- + -------------------- + + procedure Next_Stream_Id (Connection : in out HTTP_Connection) is + use type AWS.HTTP2.Stream_Id; + begin + Connection.H2_Stream_Id := Connection.H2_Stream_Id + 2; + end Next_Stream_Id; + ---------------------------- -- Open_Set_Common_Header -- ---------------------------- @@ -1969,7 +2010,10 @@ package body AWS.Client.HTTP_Utils is -- Create frames and send them Stream := HTTP2.Stream.Create - (Connection.Socket, 1, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); Request := HTTP2.Message.Create (Connection.F_Headers, Data, Stream.Identifier); @@ -1981,7 +2025,10 @@ package body AWS.Client.HTTP_Utils is -- Get response Stream := HTTP2.Stream.Create - (Connection.Socket, 3, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); while not Stream.Is_Message_Ready loop declare diff --git a/src/core/aws-client.adb b/src/core/aws-client.adb index 9705c7b28..7b75981f9 100644 --- a/src/core/aws-client.adb +++ b/src/core/aws-client.adb @@ -191,6 +191,8 @@ package body AWS.Client is Connection.Timeouts := Timeouts; Connection.HTTP_Version := HTTP_Version; Connection.Config := AWS.Config.Get_Current; + Connection.H2_Preface_Sent := False; + Connection.H2_Stream_Id := 1; Connection.User_Agent := To_Unbounded_String (User_Agent); diff --git a/src/core/aws-client.ads b/src/core/aws-client.ads index bc67ba450..984177a17 100644 --- a/src/core/aws-client.ads +++ b/src/core/aws-client.ads @@ -35,6 +35,7 @@ with Ada.Strings.Unbounded; with AWS.Attachments; with AWS.Default; with AWS.Headers; +with AWS.HTTP2; with AWS.Net.SSL.Certificate; with AWS.Response; @@ -626,6 +627,7 @@ private F_Headers : Header_List; -- final connection headers HTTP_Version : HTTP_Protocol := HTTPv1; H2_Preface_Sent : Boolean := False; + H2_Stream_Id : AWS.HTTP2.Stream_Id := 0; Auth : Authentication_Set; Opened : Boolean := False; Persistent : Boolean; diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index ac8b90376..a339355ed 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -35,12 +35,15 @@ with Ada.Containers; with Ada.Streams; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; +with Ada.Strings.Unbounded; -with AWS.Headers; +with AWS.Attachments; +with AWS.Headers.Values; with AWS.Log; with AWS.Messages; with AWS.MIME; with AWS.Net.Buffered; +with AWS.Resources.Streams.Memory; with AWS.Response.Set; with AWS.Server.Context; with AWS.Server.HTTP_Utils; @@ -391,6 +394,7 @@ is procedure Handle_Message (Stream : HTTP2.Stream.Object) is + use type AWS.Status.Request_Method; use type HTTP2.Error_Codes; procedure Validate_Headers @@ -398,6 +402,183 @@ is Error : out HTTP2.Error_Codes); -- Validate headers name as required by HTTP/2 + procedure Handle_POST; + -- Process POST message and handle possible parameters and attachments + + ----------------- + -- Handle_POST -- + ----------------- + + procedure Handle_POST is + use Ada.Strings.Unbounded; + + procedure Named_Value + (Name, Value : String; Quit : in out Boolean); + -- Looking for the Boundary value in the Content-Type header line + + procedure Value (Item : String; Quit : in out Boolean); + -- Reading the first unnamed value into the Status_Content_Type + -- variable from the Content-Type header line. + + function Get_Line return String; + -- Read a line from Sock + + procedure Read (Buffer : out Stream_Element_Array); + -- Fill buffer from Sock + + procedure Read_Body + (Stat : in out AWS.Status.Data; Boundary : String); + -- Read Sock until Boundary is found + + procedure Check_Data_Timeout; + -- Check data time-out using server settings + + Status_Multipart_Boundary : Unbounded_String; + Status_Root_Part_CID : Unbounded_String; + Status_Content_Type : Unbounded_String; + + R_Body : constant not null access + Resources.Streams.Memory.Stream_Type'Class := + AWS.Status.Binary_Data (Stream.Status.all); + + ------------------------ + -- Check_Data_Timeout -- + ------------------------ + + procedure Check_Data_Timeout is + begin + null; + end Check_Data_Timeout; + + -------------- + -- Get_Line -- + -------------- + + function Get_Line return String is + begin + return R_Body.Get_Line; + end Get_Line; + + ----------------- + -- Named_Value -- + ----------------- + + procedure Named_Value + (Name, Value : String; Quit : in out Boolean) + is + pragma Unreferenced (Quit); + L_Name : constant String := + Ada.Characters.Handling.To_Lower (Name); + begin + if L_Name = "boundary" then + Status_Multipart_Boundary := To_Unbounded_String (Value); + elsif L_Name = "start" then + Status_Root_Part_CID := To_Unbounded_String (Value); + end if; + end Named_Value; + + ---------- + -- Read -- + ---------- + + procedure Read (Buffer : out Stream_Element_Array) is + Last : Stream_Element_Offset; + begin + R_Body.Read (Buffer, Last); + end Read; + + --------------- + -- Read_Body -- + --------------- + + procedure Read_Body + (Stat : in out AWS.Status.Data; + Boundary : String) + is + pragma Unreferenced (Stat); + Look_For : constant Stream_Element_Array := + Translator.To_Stream_Element_Array (Boundary); + Pos : Stream_Element_Offset := Look_For'First; + Buf : Stream_Element_Array (1 .. 1); + begin + null; + loop + Read (Buf); + + if Buf (Buf'First) = Look_For (Pos) then + exit when Pos = Look_For'Last; + Pos := Pos + 1; + else + Pos := Look_For'First; + end if; + end loop; + end Read_Body; + + ----------------------- + -- Multipart_Message -- + ----------------------- + + package Multipart_Message is new Multipart_Message_G + (True, LA.Server.Properties, + Get_Line, Read, Read_Body, Check_Data_Timeout); + + ----------- + -- Value -- + ----------- + + procedure Value (Item : 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 AWS.Headers.Values.Parse (Value, Named_Value); + + S : constant not null access AWS.Status.Data := Stream.Status; + CT : constant String := AWS.Status.Content_Type (Stream.Status.all); + + Attachments : AWS.Attachments.List; + + begin + -- Parse Content-Type to get the multipart information + + Parse (CT); + + R_Body.Reset; + + if CT = MIME.Application_Form_Data then + AWS.Status.Set.Parameters_From_Body (S.all); + + elsif Status_Content_Type = MIME.Multipart_Form_Data then + -- This is a file upload + + Multipart_Message.File_Upload + (S.all, + Attachments, + "--" & To_String (Status_Multipart_Boundary), + "--" & To_String (Status_Multipart_Boundary) & "--", + True); + + elsif Status_Content_Type = MIME.Multipart_Related then + -- Attachments are to be written to separate files + + Multipart_Message.Store_Attachments + (S.all, + Attachments, + "--" & To_String (Status_Multipart_Boundary), + "--" & To_String (Status_Multipart_Boundary) & "--", + True, + To_String (Status_Multipart_Boundary), + To_String (Status_Root_Part_CID)); + end if; + end Handle_POST; + ---------------------- -- Validate_Headers -- ---------------------- @@ -549,20 +730,11 @@ is Parameters => Path (Query_First .. Path'Last)); end; - declare - use type AWS.Status.Request_Method; - - S : constant not null access AWS.Status.Data := Stream.Status; - CT : constant String := AWS.Status.Content_Type (Stream.Status.all); - begin - if AWS.Status.Method (S.all) = AWS.Status.POST - and then CT = MIME.Application_Form_Data - then - AWS.Status.Set.Parameters_From_Body (S.all); - end if; + if AWS.Status.Method (Stream.Status.all) = AWS.Status.POST then + Handle_POST; + end if; - Deferred_Messages.Append (Handle_Message (S.all, Stream)); - end; + Deferred_Messages.Append (Handle_Message (Stream.Status.all, Stream)); end Handle_Message; -------------------------- From e5e2c5a56dad75169ec7f7a7500aa38a3b1cc2da Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Thu, 30 Sep 2021 18:23:02 +0200 Subject: [PATCH 36/51] Refactor code for sharing. Send_H2_Request & Get_H2_Response will be used for POST without attachment. --- src/core/aws-client-http_utils.adb | 120 +++++++++++++++++++---------- 1 file changed, 80 insertions(+), 40 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index e814601f5..be2394a9e 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -144,6 +144,20 @@ package body AWS.Client.HTTP_Utils is procedure Next_Stream_Id (Connection : in out HTTP_Connection); -- Update client's stream-id to next value + procedure Send_H2_Request + (Connection : in out HTTP_Connection; + Ctx : in out Server.Context.Object; + Stream : in out HTTP2.Stream.Object; + Request : in out HTTP2.Message.Object); + -- Send H2 request + + procedure Get_H2_Response + (Connection : in out HTTP_Connection; + Ctx : in out Server.Context.Object; + Stream : in out HTTP2.Stream.Object; + Result : out Response.Data); + -- Get H2 response + --------- -- "+" -- --------- @@ -394,6 +408,32 @@ package body AWS.Client.HTTP_Utils is end if; end Disconnect; + --------------------- + -- Get_H2_Response -- + --------------------- + + procedure Get_H2_Response + (Connection : in out HTTP_Connection; + Ctx : in out Server.Context.Object; + Stream : in out HTTP2.Stream.Object; + Result : out Response.Data) + is + begin + while not Stream.Is_Message_Ready loop + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, Ctx.Settings.all); + Error : HTTP2.Error_Codes; + begin + Stream.Received_Frame (Ctx, Frame, Error); + exit when Frame.Has_Flag (HTTP2.Frame.End_Stream_Flag); + end; + end loop; + + Stream.Append_Body (Result); + end Get_H2_Response; + ------------------ -- Get_Response -- ------------------ @@ -774,9 +814,6 @@ package body AWS.Client.HTTP_Utils is is use Real_Time; - use all type HTTP2.Frame.Flags_Type; - use all type HTTP2.Frame.Kind_Type; - CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; Settings : constant HTTP2.Frame.Settings.Set := @@ -910,30 +947,7 @@ package body AWS.Client.HTTP_Utils is Request.Append_Body (Pref_Suf & Boundary & Pref_Suf & CRLF); - All_Frames : loop - for F of Request.To_Frames (Ctx, Stream) loop - Stream.Send_Frame (F); - - if F.Kind = HTTP2.Frame.K_Data then - Ctx.Settings.Update_Flow_Control_Window - (-Natural (F.Length)); - end if; - end loop; - - if Request.More_Frames then - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - Error : HTTP2.Error_Codes; - begin - Stream.Received_Frame (Ctx, Frame, Error); - end; - - else - exit All_Frames; - end if; - end loop All_Frames; + Send_H2_Request (Connection, Ctx, Stream, Request); -- Get response @@ -943,19 +957,7 @@ package body AWS.Client.HTTP_Utils is Next_Stream_Id (Connection); - while not Stream.Is_Message_Ready loop - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - Error : HTTP2.Error_Codes; - begin - Stream.Received_Frame (Ctx, Frame, Error); - exit when Frame.Has_Flag (HTTP2.Frame.End_Stream_Flag); - end; - end loop; - - Stream.Append_Body (Result); + Get_H2_Response (Connection, Ctx, Stream, Result); Decrement_Authentication_Attempt (Connection, Auth_Attempts, Auth_Is_Over); @@ -1829,6 +1831,44 @@ package body AWS.Client.HTTP_Utils is Connection.H2_Preface_Sent := True; end Send_H2_Connection_Preface; + --------------------- + -- Send_H2_Request -- + --------------------- + + procedure Send_H2_Request + (Connection : in out HTTP_Connection; + Ctx : in out Server.Context.Object; + Stream : in out HTTP2.Stream.Object; + Request : in out HTTP2.Message.Object) + is + use all type HTTP2.Frame.Kind_Type; + begin + All_Frames : loop + for F of Request.To_Frames (Ctx, Stream) loop + Stream.Send_Frame (F); + + if F.Kind = HTTP2.Frame.K_Data then + Ctx.Settings.Update_Flow_Control_Window + (-Natural (F.Length)); + end if; + end loop; + + if Request.More_Frames then + declare + Frame : constant HTTP2.Frame.Object'Class := + HTTP2.Frame.Read + (Connection.Socket.all, Ctx.Settings.all); + Error : HTTP2.Error_Codes; + begin + Stream.Received_Frame (Ctx, Frame, Error); + end; + + else + exit All_Frames; + end if; + end loop All_Frames; + end Send_H2_Request; + ------------------ -- Send_Request -- ------------------ From 756e5601257773da8240bd81e0300d92fe4b9dbb Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Thu, 30 Sep 2021 18:24:22 +0200 Subject: [PATCH 37/51] Fix implementation of POST without attachment. Use Send_H2_Request and Get_H2_Response to fix large message issue. Add corresponding regression test. --- regtests/0347_http2_post_connection/file1.dat | 1 + regtests/0347_http2_post_connection/file2.dat | 1 + .../h2post_c_attachments.adb | 227 ++++++++++++++++++ .../h2post_c_attachments.gpr | 24 ++ regtests/0347_http2_post_connection/test.out | 40 +++ regtests/0347_http2_post_connection/test.py | 3 + src/core/aws-client-http_utils.adb | 29 +-- 7 files changed, 307 insertions(+), 18 deletions(-) create mode 100644 regtests/0347_http2_post_connection/file1.dat create mode 100644 regtests/0347_http2_post_connection/file2.dat create mode 100644 regtests/0347_http2_post_connection/h2post_c_attachments.adb create mode 100644 regtests/0347_http2_post_connection/h2post_c_attachments.gpr create mode 100644 regtests/0347_http2_post_connection/test.out create mode 100644 regtests/0347_http2_post_connection/test.py diff --git a/regtests/0347_http2_post_connection/file1.dat b/regtests/0347_http2_post_connection/file1.dat new file mode 100644 index 000000000..e2129701f --- /dev/null +++ b/regtests/0347_http2_post_connection/file1.dat @@ -0,0 +1 @@ +file1 diff --git a/regtests/0347_http2_post_connection/file2.dat b/regtests/0347_http2_post_connection/file2.dat new file mode 100644 index 000000000..6c493ff74 --- /dev/null +++ b/regtests/0347_http2_post_connection/file2.dat @@ -0,0 +1 @@ +file2 diff --git a/regtests/0347_http2_post_connection/h2post_c_attachments.adb b/regtests/0347_http2_post_connection/h2post_c_attachments.adb new file mode 100644 index 000000000..ac2527dde --- /dev/null +++ b/regtests/0347_http2_post_connection/h2post_c_attachments.adb @@ -0,0 +1,227 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Streams; +with Ada.Strings.Fixed; +with Ada.Strings.Maps; +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Attachments; +with AWS.Client; +with AWS.Config.Set; +with AWS.Headers; +with AWS.Messages; +with AWS.MIME; +with AWS.Net.Log; +with AWS.Parameters; +with AWS.Response; +with AWS.Server.Log; +with AWS.Server.Status; +with AWS.Status; +with AWS.Translator; +with AWS.Utils; + +procedure H2Post_C_Attachments is + + use Ada; + use Ada.Streams; + use Ada.Strings.Unbounded; + use AWS; + + Data_Name : constant String := "big-data"; + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + Params : Parameters.List; + Attachs : Attachments.List; + + procedure Output_A_Name (E : Attachments.Element); + + ------------------- + -- Output_A_Name -- + ------------------- + + procedure Output_A_Name (E : Attachments.Element) is + use Strings.Unbounded; + + L_Filename : Unbounded_String := + To_Unbounded_String (Attachments.Local_Filename (E)); + C : constant Natural := + Strings.Unbounded.Index (L_Filename, "-"); + begin + Text_IO.Put_Line ("Filename " & Attachments.Filename (E)); + + -- Convert slashes + + Strings.Unbounded.Translate + (L_Filename, Strings.Maps.To_Mapping ("\", "/")); + + -- Now remove the pid + + Strings.Unbounded.Replace_Slice (L_Filename, 3, C, "XpidX-"); + + Text_IO.Put_Line ("Local Filename " & To_String (L_Filename)); + end Output_A_Name; + + begin + if not Status.Is_Body_Uploaded (Request) then + Text_IO.Put_Line + ("ERROR: allow client upload (should not happen in HTTP/2)"); + return Response.Continue; + end if; + + Params := Status.Parameters (Request); + Attachs := Status.Attachments (Request); + + Text_IO.Put_Line ("*** ID =" & Params.Get ("ID")); + Text_IO.Put_Line + ("*** N Attachments = " & Natural'Image (Attachments.Count (Attachs))); + + Attachments.Iterate (Attachs, Output_A_Name'Access); + + if Params.Exist (Data_Name) then + Text_IO.Put_Line + (Data_Name & " size" + & Length (Params.Get_Values (Data_Name) (1))'Img & " bytes"); + end if; + + return Response.Build (MIME.Text_HTML, "ok"); + exception + when others => + Text_IO.Put_Line ("Exception on CB!"); + return Response.Build (MIME.Text_HTML, "nok"); + end CB; + + ---------- + -- Dump -- + ---------- + + procedure Dump + (Direction : Net.Log.Data_Direction; + Socket : Net.Socket_Type'Class; + Data : Stream_Element_Array; + Last : Stream_Element_Offset) + is + use type Net.Log.Data_Direction; + begin + if Direction = Net.Log.Sent then + Text_IO.Put_Line + ("********** " & Net.Log.Data_Direction'Image (Direction)); + Text_IO.Put_Line + (Translator.To_String (Data (Data'First .. Last))); + Text_IO.New_Line; + end if; + end Dump; + + CNF : Config.Object; + WS : Server.HTTP; + WC : Client.HTTP_Connection; + R : Response.Data; + Attachments : AWS.Attachments.List; + +begin + Config.Set.Server_Name (CNF, "H2 Post Attachments"); + Config.Set.Server_Port (CNF, 0); + Config.Set.Max_Connection (CNF, 5); + Config.Set.Upload_Directory (CNF, "."); + Config.Set.HTTP2_Activated (CNF, True); + + AWS.Attachments.Add + (Attachments => Attachments, + Filename => "file1.dat", + Headers => AWS.Headers.Empty_List); + AWS.Attachments.Add + (Attachments => Attachments, + Filename => "file2.dat", + Headers => AWS.Headers.Empty_List); + + Server.Start (WS, CB'Unrestricted_Access, CNF); + + Server.Log.Start_Error (WS); + + Text_IO.Put_Line ("started"); + Text_IO.Flush; + Text_IO.New_Line; + +-- AWS.Net.Log.Start (Dump'Unrestricted_Access); + + Client.Create (WC, Server.Status.Local_URL (WS), HTTP_Version => HTTPv2); + + AWS.Client.Post + (WC, R, URI => "/Upload", Data => "ID=100"); + Text_IO.Put_Line ("R-POST1 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + AWS.Client.Post + (WC, R, URI => "/Upload", Data => "ID=101", + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments); + Text_IO.Put_Line ("R-POST2 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + AWS.Client.Post + (WC, R, URI => "/Upload?ID=102", + Data => AWS.Client.No_Data, + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments); + Text_IO.Put_Line ("R-POST3 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + AWS.Client.Post + (WC, R, URI => "/Upload?ID=103", Data => "AnyOldString", + Content_Type => AWS.Client.No_Data, + Attachments => Attachments); + Text_IO.Put_Line ("R-POST4 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + declare + Content : Unbounded_String; + Sample : constant String := + "1234567890qwertyuioplkjhgfdszxcvbnmMNBVCXZASDFGHJKLPOIUYTW"; + Headers : AWS.Headers.List; + begin + for J in 10_001 .. 95_000 loop + Append (Content, Sample & J'Img & ASCII.LF); + end loop; + + Headers.Add + (AWS.Messages.Content_Disposition_Token, "name=""" & Data_Name & '"'); + -- !!! No name for Data_Name parameter in callback without this header. + -- Maybe need some fix. + + Attachments.Add + (Name => Data_Name, + Data => AWS.Attachments.Value (Content), + Headers => Headers); + end; + + AWS.Client.Post + (WC, R, URI => "/Upload", Data => "ID=104", + Content_Type => AWS.MIME.Application_Form_Data, + Attachments => Attachments); + Text_IO.Put_Line ("R-POST5 : " & Response.Message_Body (R)); + Text_IO.New_Line; + + Client.Close (WC); + Server.Shutdown (WS); + Text_IO.Put_Line ("shutdown"); +end H2Post_C_Attachments; diff --git a/regtests/0347_http2_post_connection/h2post_c_attachments.gpr b/regtests/0347_http2_post_connection/h2post_c_attachments.gpr new file mode 100644 index 000000000..ff0122ee8 --- /dev/null +++ b/regtests/0347_http2_post_connection/h2post_c_attachments.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project H2Post_C_Attachments is + for Source_Dirs use ("."); + for Main use ("h2post_c_attachments.adb"); +end H2Post_C_Attachments; diff --git a/regtests/0347_http2_post_connection/test.out b/regtests/0347_http2_post_connection/test.out new file mode 100644 index 000000000..53a057680 --- /dev/null +++ b/regtests/0347_http2_post_connection/test.out @@ -0,0 +1,40 @@ +started + +*** ID =100 +*** N Attachments = 0 +R-POST1 : ok + +*** ID =101 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-0.file1.dat +Filename file2.dat +Local Filename ./XpidX-1.file2.dat +R-POST2 : ok + +*** ID =102 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-2.file1.dat +Filename file2.dat +Local Filename ./XpidX-3.file2.dat +R-POST3 : ok + +*** ID =103 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-4.file1.dat +Filename file2.dat +Local Filename ./XpidX-5.file2.dat +R-POST4 : ok + +*** ID =104 +*** N Attachments = 2 +Filename file1.dat +Local Filename ./XpidX-6.file1.dat +Filename file2.dat +Local Filename ./XpidX-7.file2.dat +big-data size 5610000 bytes +R-POST5 : ok + +shutdown diff --git a/regtests/0347_http2_post_connection/test.py b/regtests/0347_http2_post_connection/test.py new file mode 100644 index 000000000..f661210c0 --- /dev/null +++ b/regtests/0347_http2_post_connection/test.py @@ -0,0 +1,3 @@ +from test_support import * + +build_and_run('h2post_c_attachments'); diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index be2394a9e..9b8adb2f0 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -431,6 +431,8 @@ package body AWS.Client.HTTP_Utils is end; end loop; + Response.Set.Clear (Result); + Stream.Append_Body (Result); end Get_H2_Response; @@ -1074,7 +1076,6 @@ package body AWS.Client.HTTP_Utils is Headers : Header_List := Empty_Header_List) is use Ada.Real_Time; - use all type HTTP2.Frame.Flags_Type; Stamp : constant Time := Clock; Settings : constant HTTP2.Frame.Settings.Set := @@ -1117,33 +1118,25 @@ package body AWS.Client.HTTP_Utils is -- Create frames and send them Stream := HTTP2.Stream.Create - (Connection.Socket, 1, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); Request := HTTP2.Message.Create (Connection.F_Headers, Data, Stream.Identifier); - for F of Request.To_Frames (Ctx, Stream) loop - Stream.Send_Frame (F); - end loop; + Send_H2_Request (Connection, Ctx, Stream, Request); -- Get response Stream := HTTP2.Stream.Create - (Connection.Socket, 3, H_Connection.Flow_Control_Window); + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); - while not Stream.Is_Message_Ready loop - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - Error : HTTP2.Error_Codes; - begin - Stream.Received_Frame (Ctx, Frame, Error); - exit when Frame.Has_Flag (HTTP2.Frame.End_Stream_Flag); - end; - end loop; + Next_Stream_Id (Connection); - Stream.Append_Body (Result); + Get_H2_Response (Connection, Ctx, Stream, Result); Decrement_Authentication_Attempt (Connection, Auth_Attempts, Auth_Is_Over); From f71422c17c4f510ac346abbc6fc09867942dba52 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:20:29 +0200 Subject: [PATCH 38/51] Add new routine to directly set the headers list. Part of S507-051. --- src/core/aws-response-set.adb | 19 +++++++++++++++---- src/core/aws-response-set.ads | 7 ++++++- 2 files changed, 21 insertions(+), 5 deletions(-) diff --git a/src/core/aws-response-set.adb b/src/core/aws-response-set.adb index 615ba4343..782df256b 100644 --- a/src/core/aws-response-set.adb +++ b/src/core/aws-response-set.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2002-2019, AdaCore -- +-- Copyright (C) 2002-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 -- @@ -317,6 +317,17 @@ package body AWS.Response.Set is D.Mode := File; end Filename; + ------------- + -- Headers -- + ------------- + + procedure Headers + (D : in out Data; + Headers : AWS.Headers.List) is + begin + D.Header := Headers; + end Headers; + -------------- -- Is_Valid -- -------------- @@ -340,11 +351,11 @@ package body AWS.Response.Set is end case; return (Redirection_Code - xor not Headers.Exist + xor not AWS.Headers.Exist (D.Header, Messages.Location_Token)) and then (D.Status_Code = Messages.S401 - xor not Headers.Exist + xor not AWS.Headers.Exist (D.Header, Messages.WWW_Authenticate_Token)); end Is_Valid; @@ -443,7 +454,7 @@ package body AWS.Response.Set is -- Set D.Content_Type with the value read from the socket D.Content_Type := To_Unbounded_String - (Headers.Get (D.Header, Messages.Content_Type_Token)); + (AWS.Headers.Get (D.Header, Messages.Content_Type_Token)); -- Set the Filename if any diff --git a/src/core/aws-response-set.ads b/src/core/aws-response-set.ads index ad12f063f..07336b7a3 100644 --- a/src/core/aws-response-set.ads +++ b/src/core/aws-response-set.ads @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2002-2014, AdaCore -- +-- Copyright (C) 2002-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 -- @@ -64,6 +64,11 @@ package AWS.Response.Set is -- Read all header data from the socket and fill appropriate -- data's fields. + procedure Headers + (D : in out Data; + Headers : AWS.Headers.List); + -- Set response's Headers + procedure Status_Code (D : in out Data; Value : Messages.Status_Code) From 097f86eba02eb833b23cfee6a0ad7ccbcf06242e Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:21:30 +0200 Subject: [PATCH 39/51] New routine HTTP_Version to get the connection's protocol version. Part of S507-051. --- src/core/aws-client-http_utils.adb | 10 +++++----- src/core/aws-client.ads | 6 ++++++ 2 files changed, 11 insertions(+), 5 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 9b8adb2f0..ea1cffc90 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -278,7 +278,7 @@ package body AWS.Client.HTTP_Utils is begin Set_Header (Connection.F_Headers, - Messages.Connect_Token, Host_Address & ' ' & HTTP_Version); + Messages.Connect_Token, Host_Address & ' ' & AWS.HTTP_Version); Set_Header (Connection.F_Headers, Messages.Host_Token, Host_Address); end; @@ -1261,7 +1261,7 @@ package body AWS.Client.HTTP_Utils is (Connection.F_Headers, Method, AWS.URL.Pathname_And_Parameters (Connection.Host_URL) - & ' ' & HTTP_Version); + & ' ' & AWS.HTTP_Version); end if; else @@ -1273,7 +1273,7 @@ package body AWS.Client.HTTP_Utils is else Set_Header (Connection.F_Headers, - Method, Encoded_URI & ' ' & HTTP_Version); + Method, Encoded_URI & ' ' & AWS.HTTP_Version); end if; end if; @@ -1291,7 +1291,7 @@ package body AWS.Client.HTTP_Utils is Set_Header (Connection.F_Headers, Method, - AWS.URL.URL (Connection.Host_URL) & ' ' & HTTP_Version); + AWS.URL.URL (Connection.Host_URL) & ' ' & AWS.HTTP_Version); end if; else @@ -1308,7 +1308,7 @@ package body AWS.Client.HTTP_Utils is (Connection.F_Headers, Method, URL.Protocol_Name (Connection.Host_URL) & "://" - & Host_Address & Encoded_URI & ' ' & HTTP_Version); + & Host_Address & Encoded_URI & ' ' & AWS.HTTP_Version); end if; end if; end if; diff --git a/src/core/aws-client.ads b/src/core/aws-client.ads index 984177a17..eda60ba25 100644 --- a/src/core/aws-client.ads +++ b/src/core/aws-client.ads @@ -346,6 +346,9 @@ package AWS.Client is -- the secure connection. User_Agent can be overridden to whatever you want -- the client interface to present itself to the server. + function HTTP_Version (Connection : HTTP_Connection) return HTTP_Protocol; + -- Returns connection HTTP version + function Get_Certificate (Connection : HTTP_Connection) return Net.SSL.Certificate.Object; -- Return the certificate used for the secure connection. If this is not a @@ -674,4 +677,7 @@ private function Get_Socket (Connection : HTTP_Connection) return Net.Socket_Access is (Connection.Socket); + function HTTP_Version (Connection : HTTP_Connection) return HTTP_Protocol + is (Connection.HTTP_Version); + end AWS.Client; From 26779efb2373c422a200e6731e9d042e1c084d75 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:23:38 +0200 Subject: [PATCH 40/51] Fix POST support, nothing to do if the body is empty. Part of S507-051. --- src/core/aws-server-protocol_handler_v2.adb | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/core/aws-server-protocol_handler_v2.adb b/src/core/aws-server-protocol_handler_v2.adb index a339355ed..c1b205938 100644 --- a/src/core/aws-server-protocol_handler_v2.adb +++ b/src/core/aws-server-protocol_handler_v2.adb @@ -730,7 +730,9 @@ is Parameters => Path (Query_First .. Path'Last)); end; - if AWS.Status.Method (Stream.Status.all) = AWS.Status.POST then + if AWS.Status.Method (Stream.Status.all) = AWS.Status.POST + and then AWS.Status.Binary_Size (Stream.Status.all) > 0 + then Handle_POST; end if; From 02bab4e51047dec71f19729ebc8897a75fe0c9f9 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:24:55 +0200 Subject: [PATCH 41/51] Read_Body is only to be used with HTTP/1.x. Part of S507-051. --- src/core/aws-client-http_utils.ads | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/core/aws-client-http_utils.ads b/src/core/aws-client-http_utils.ads index 3f5e4749e..aded395ba 100644 --- a/src/core/aws-client-http_utils.ads +++ b/src/core/aws-client-http_utils.ads @@ -79,7 +79,8 @@ package AWS.Client.HTTP_Utils is procedure Read_Body (Connection : in out HTTP_Connection; Result : out Response.Data; - Store : Boolean); + Store : Boolean) + with Pre => HTTP_Version (Connection) = HTTPv1; -- Read message body and store it into Result if Store is True otherwise -- the content is discarded. From 7452a27a5c7651f7757bd58b4975a13dd68866a2 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:25:27 +0200 Subject: [PATCH 42/51] Send_Request_2: Rewrite to properly handle large request & response. Use Send_H2_Request & Get_H2_Response as done for POST messages. This simplify the code and fix issues when using multiple requests on the same connection. Part of S507-051. --- src/core/aws-client-http_utils.adb | 67 +++++------------------------- 1 file changed, 10 insertions(+), 57 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index ea1cffc90..3f4e1299e 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -1966,15 +1966,12 @@ package body AWS.Client.HTTP_Utils is Headers : Header_List := Empty_Header_List) is use Ada.Real_Time; - use all type HTTP2.Frame.Flags_Type; - use all type HTTP2.Frame.Kind_Type; - use all type HTTP2.Frame.Settings.Settings_Kind; - subtype Byte_4 is HTTP2.Byte_4; + Stamp : constant Time := Clock; + Settings : constant HTTP2.Frame.Settings.Set := + Get_Settings (Connection.Config); - C : AWS.Config.Object renames Connection.Config; Request : HTTP2.Message.Object; - Stamp : constant Time := Clock; Try_Count : Natural := Connection.Retry; Auth_Attempts : Auth_Attempts_Count := (others => 2); Auth_Is_Over : Boolean; @@ -1982,25 +1979,14 @@ package body AWS.Client.HTTP_Utils is H_Connection : aliased HTTP2.Connection.Object; Enc_Table : aliased HTTP2.HPACK.Table.Object; Dec_Table : aliased HTTP2.HPACK.Table.Object; - Settings : constant HTTP2.Frame.Settings.Set := - (1 => (HEADER_TABLE_SIZE, - Byte_4 (C.HTTP2_Header_Table_Size)), - 2 => (ENABLE_PUSH, - 0), - 3 => (MAX_CONCURRENT_STREAMS, - Byte_4 (C.HTTP2_Max_Concurrent_Streams)), - 4 => (INITIAL_WINDOW_SIZE, - Byte_4 (C.HTTP2_Initial_Window_Size)), - 5 => (MAX_FRAME_SIZE, - Byte_4 (C.HTTP2_Max_Frame_Size)), - 6 => (MAX_HEADER_LIST_SIZE, - Byte_4 (C.HTTP2_Max_Header_List_Size))); Ctx : Server.Context.Object (null, 1, Enc_Table'Access, Dec_Table'Access, H_Connection'Access); begin + Connection.F_Headers.Reset; + Retry : loop begin -- Create the request HTTP/2 message out of Status.Data @@ -2017,28 +2003,9 @@ package body AWS.Client.HTTP_Utils is Utils.Image (Stream_Element_Offset'(Data'Length))); end if; - -- Send the HTTP/2 connection preface - - Net.Buffered.Write - (Connection.Socket.all, HTTP2.Client_Connection_Preface); - - -- Send the setting frame (stream id 0) - - HTTP2.Frame.Settings.Create - (Settings).Send (Connection.Socket.all); - - -- We need to read the settings from server - - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - begin - if Frame.Kind /= K_Settings then - raise Constraint_Error with - "server should have answered with a setting frame"; - end if; - end; + if not Connection.H2_Preface_Sent then + Send_H2_Connection_Preface (Connection, Settings, H_Connection); + end if; -- Create frames and send them @@ -2051,9 +2018,7 @@ package body AWS.Client.HTTP_Utils is Request := HTTP2.Message.Create (Connection.F_Headers, Data, Stream.Identifier); - for F of Request.To_Frames (Ctx, Stream) loop - Stream.Send_Frame (F); - end loop; + Send_H2_Request (Connection, Ctx, Stream, Request); -- Get response @@ -2063,19 +2028,7 @@ package body AWS.Client.HTTP_Utils is Next_Stream_Id (Connection); - while not Stream.Is_Message_Ready loop - declare - Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, H_Connection); - Error : HTTP2.Error_Codes; - begin - Stream.Received_Frame (Ctx, Frame, Error); - exit when Frame.Has_Flag (HTTP2.Frame.End_Stream_Flag); - end; - end loop; - - Stream.Append_Body (Result); + Get_H2_Response (Connection, Ctx, Stream, Result); Decrement_Authentication_Attempt (Connection, Auth_Attempts, Auth_Is_Over); From 3fc69da10b0d98e5877764317dec07af4c807483 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:25:54 +0200 Subject: [PATCH 43/51] Rework the handling of headers for HTTP/2 responses. Add corresponding regression tests. Part of S507-051. --- .../h2_client_status.adb | 116 +++++++++++ .../h2_client_status.gpr | 24 +++ regtests/0348_http2_client_status/test.out | 18 ++ regtests/0348_http2_client_status/test.py | 3 + src/core/aws-client-http_utils.adb | 183 ++++++++++++------ src/core/aws-client-http_utils.ads | 9 +- 6 files changed, 289 insertions(+), 64 deletions(-) create mode 100644 regtests/0348_http2_client_status/h2_client_status.adb create mode 100644 regtests/0348_http2_client_status/h2_client_status.gpr create mode 100644 regtests/0348_http2_client_status/test.out create mode 100644 regtests/0348_http2_client_status/test.py diff --git a/regtests/0348_http2_client_status/h2_client_status.adb b/regtests/0348_http2_client_status/h2_client_status.adb new file mode 100644 index 000000000..1bb6d05e7 --- /dev/null +++ b/regtests/0348_http2_client_status/h2_client_status.adb @@ -0,0 +1,116 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with Ada.Streams; +with Ada.Strings.Fixed; +with Ada.Strings.Maps; +with Ada.Strings.Unbounded; +with Ada.Text_IO; + +with AWS.Attachments; +with AWS.Client; +with AWS.Config.Set; +with AWS.Headers; +with AWS.Messages; +with AWS.MIME; +with AWS.Net.Log; +with AWS.Parameters; +with AWS.Response; +with AWS.Server.Log; +with AWS.Server.Status; +with AWS.Status; +with AWS.Translator; +with AWS.Utils; + +procedure H2_Client_Status is + + use Ada; + use Ada.Streams; + use Ada.Strings.Unbounded; + use AWS; + + -------- + -- CB -- + -------- + + function CB (Request : Status.Data) return Response.Data is + URI : constant String := AWS.Status.URI (Request); + Mth : constant String := AWS.Status.Method (Request); + Msg : constant String := URI & " - " & Mth; + begin + if URI = "/c1" then + return Response.Build (MIME.Text_HTML, Msg & " - OK"); + elsif URI = "/c2" then + return Response.Build (MIME.Text_HTML, Msg & " - OK", Messages.S300); + else + return Response.Acknowledge (Messages.S404, Msg & " - not there!"); + end if; + end CB; + + ------------ + -- Output -- + ------------ + + procedure Output (Msg : String; R : Response.Data) is + begin + Text_IO.Put_Line (Msg & " : " & Response.Message_Body (R)); + Text_IO.Put_Line (" status: " & AWS.Response.Status_Code (R)'Img); + Text_IO.New_Line; + end Output; + + CNF : Config.Object; + WS : Server.HTTP; + WC : Client.HTTP_Connection; + R : Response.Data; + +begin + Config.Set.Server_Name (CNF, "H2 Client Data"); + Config.Set.Server_Port (CNF, 0); + Config.Set.Max_Connection (CNF, 5); + Config.Set.Upload_Directory (CNF, "."); + Config.Set.HTTP2_Activated (CNF, True); + + Server.Start (WS, CB'Unrestricted_Access, CNF); + + Server.Log.Start_Error (WS); + + Text_IO.Put_Line ("started"); + Text_IO.Flush; + Text_IO.New_Line; + + Client.Create (WC, Server.Status.Local_URL (WS), HTTP_Version => HTTPv2); + + AWS.Client.Post (WC, R, URI => "/c1", Data => "don't care"); + Output ("R1", R); + + AWS.Client.Get (WC, R, URI => "/c1"); + Output ("R2", R); + + AWS.Client.Post (WC, R, URI => "/c2", Data => "whatever"); + Output ("R3", R); + + AWS.Client.Post (WC, R, URI => "/x", Data => AWS.Client.No_Data); + Output ("R4", R); + + AWS.Client.Get (WC, R, URI => "/x"); + Output ("R5", R); + + Client.Close (WC); + Server.Shutdown (WS); + Text_IO.Put_Line ("shutdown"); +end H2_Client_Status; diff --git a/regtests/0348_http2_client_status/h2_client_status.gpr b/regtests/0348_http2_client_status/h2_client_status.gpr new file mode 100644 index 000000000..bac20a28c --- /dev/null +++ b/regtests/0348_http2_client_status/h2_client_status.gpr @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- Ada Web Server -- +-- -- +-- Copyright (C) 2021, AdaCore -- +-- -- +-- This 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 software 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 -- +-- distributed with this software; see file COPYING3. If not, go -- +-- to http://www.gnu.org/licenses for a complete copy of the license. -- +------------------------------------------------------------------------------ + +with "aws"; + +project H2_Client_Status is + for Source_Dirs use ("."); + for Main use ("h2_client_status.adb"); +end H2_Client_Status; diff --git a/regtests/0348_http2_client_status/test.out b/regtests/0348_http2_client_status/test.out new file mode 100644 index 000000000..c767e4e06 --- /dev/null +++ b/regtests/0348_http2_client_status/test.out @@ -0,0 +1,18 @@ +started + +R1 : /c1 - POST - OK + status: S200 + +R2 : /c1 - GET - OK + status: S200 + +R3 : /c2 - POST - OK + status: S300 + +R4 : /x - POST - not there! + status: S404 + +R5 : /x - GET - not there! + status: S404 + +shutdown diff --git a/regtests/0348_http2_client_status/test.py b/regtests/0348_http2_client_status/test.py new file mode 100644 index 000000000..9a380c304 --- /dev/null +++ b/regtests/0348_http2_client_status/test.py @@ -0,0 +1,3 @@ +from test_support import * + +build_and_run('h2_client_status'); diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 3f4e1299e..f7f6acd1c 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -418,12 +418,19 @@ package body AWS.Client.HTTP_Utils is Stream : in out HTTP2.Stream.Object; Result : out Response.Data) is + Sock : Net.Socket_Type'Class renames Connection.Socket.all; + Keep_Alive : Boolean; begin + Sock.Set_Timeout (Connection.Timeouts.Receive); + + Response.Set.Clear (Result); + + -- Read response frames + while not Stream.Is_Message_Ready loop declare Frame : constant HTTP2.Frame.Object'Class := - HTTP2.Frame.Read - (Connection.Socket.all, Ctx.Settings.all); + HTTP2.Frame.Read (Sock, Ctx.Settings.all); Error : HTTP2.Error_Codes; begin Stream.Received_Frame (Ctx, Frame, Error); @@ -431,9 +438,47 @@ package body AWS.Client.HTTP_Utils is end; end loop; - Response.Set.Clear (Result); - Stream.Append_Body (Result); + + -- Check encoding + + declare + TE : constant String := + Response.Header (Result, Messages.Transfer_Encoding_Token); + CT_Len : constant Response.Content_Length_Type := + Response.Content_Length (Result); + begin + if not Messages.With_Body (Response.Status_Code (Result)) then + -- RFC-2616 4.4 + -- ... + -- Any response message which "MUST NOT" include a message-body + -- (such as the 1xx, 204, and 304 responses and any response to a + -- HEAD request) is always terminated by the first empty line + -- after the header fields, regardless of the entity-header fields + -- present in the message. + + Connection.Transfer := Content_Length; + Connection.Length := 0; + + elsif TE = "chunked" then + raise Protocol_Error with "chunked encoding is not part of HTTP/2"; + + elsif CT_Len = Response.Undefined_Length then + Connection.Transfer := Until_Close; + + else + Connection.Transfer := Content_Length; + Connection.Length := CT_Len; + end if; + end; + + -- Set headers into Answer + + Response.Set.Headers (Result, Stream.Headers); + + -- Then parse headers + + Read_Parse_Header (Connection, Result, Keep_Alive); end Get_H2_Response; ------------------ @@ -469,7 +514,7 @@ package body AWS.Client.HTTP_Utils is Response.Set.Clear (Result); - Parse_Header (Connection, Result, Keep_Alive); + Read_Parse_Header (Connection, Result, Keep_Alive); declare TE : constant String := @@ -1407,22 +1452,52 @@ package body AWS.Client.HTTP_Utils is Method); end Open_Set_Common_Header; - ------------------ - -- Parse_Header -- - ------------------ + --------------- + -- Read_Body -- + --------------- - procedure Parse_Header + procedure Read_Body (Connection : in out HTTP_Connection; - Answer : out Response.Data; - Keep_Alive : out Boolean) + Result : out Response.Data; + Store : Boolean) is - Sock : Net.Socket_Type'Class renames Connection.Socket.all; + use Ada.Real_Time; + Expire : constant Time := Clock + Connection.Timeouts.Response; + begin + loop + declare + Buffer : Stream_Element_Array (1 .. 8192); + Last : Stream_Element_Offset; + begin + Read_Some (Connection, Buffer, Last); + exit when Last < Buffer'First; - Status : Messages.Status_Code; + if Store then + Response.Set.Append_Body + (Result, Buffer (Buffer'First .. Last)); + end if; + end; - Request_Auth_Mode : array (Authentication_Level) of Authentication_Mode - := (others => Any); + if Clock > Expire then + if Store then + Response.Set.Append_Body + (Result, "..." & ASCII.LF & " Response Timeout"); + end if; + Response.Set.Status_Code (Result, Messages.S408); + exit; + end if; + end loop; + end Read_Body; + ----------------------- + -- Read_Parse_Header -- + ----------------------- + + procedure Read_Parse_Header + (Connection : in out HTTP_Connection; + Answer : in out Response.Data; + Keep_Alive : out Boolean) + is procedure Parse_Authenticate_Line (Level : Authentication_Level; Auth_Line : String); @@ -1430,7 +1505,8 @@ package body AWS.Client.HTTP_Utils is -- field with the information read on the line. Handle WWW and Proxy -- authentication. - procedure Read_Status_Line; + procedure Read_Status_Line + with Pre => Connection.HTTP_Version = HTTPv1; -- Read the status line procedure Set_Keep_Alive (Data : String); @@ -1440,6 +1516,12 @@ package body AWS.Client.HTTP_Utils is function "+" (S : String) return Unbounded_String renames To_Unbounded_String; + Sock : Net.Socket_Type'Class renames Connection.Socket.all; + Status : Messages.Status_Code; + + Request_Auth_Mode : array (Authentication_Level) + of Authentication_Mode := (others => Any); + ----------------------------- -- Parse_Authenticate_Line -- ----------------------------- @@ -1636,18 +1718,34 @@ package body AWS.Client.HTTP_Utils is use type Messages.Status_Code; begin + -- Reset authentication information + for Level in Authentication_Level'Range loop Connection.Auth (Level).Requested := False; end loop; - Read_Status_Line; - -- By default we have at least some headers. This value will be -- updated if a message body is read. Response.Set.Mode (Answer, Response.Header); - Response.Set.Read_Header (Sock, Answer); + -- Read headers from server's answer only in HTTP/1.x mode + + if Connection.HTTP_Version = HTTPv1 then + Read_Status_Line; + Response.Set.Read_Header (Sock, Answer); + + else + -- In HTTP/2 the status is encoded in :status pseudo header + + declare + S : constant String := + Response.Header (Answer, Messages.Status_Token); + begin + Status := Messages.Status_Code'Value ('S' & S); + Response.Set.Status_Code (Answer, Status); + end; + end if; declare use AWS.Response; @@ -1697,7 +1795,9 @@ package body AWS.Client.HTTP_Utils is -- deal with 100 status code. -- See [RFC 2616 - 8.2.3] use of the 100 (Continue) Status. - if Status = Messages.S100 then + if Connection.HTTP_Version = HTTPv1 + and then Status = Messages.S100 + then Read_Status_Line; Response.Set.Read_Header (Sock, Answer); end if; @@ -1711,8 +1811,8 @@ package body AWS.Client.HTTP_Utils is declare Set_Cookies : constant Headers.VString_Array := - Response.Header (Answer) - .Get_Values (Messages.Set_Cookie_Token); + Response.Header (Answer).Get_Values + (Messages.Set_Cookie_Token); Cookie : Unbounded_String; I : Natural; begin @@ -1748,44 +1848,7 @@ package body AWS.Client.HTTP_Utils is Parse_Authenticate_Line (Proxy, Response.Header (Answer, Messages.Proxy_Authenticate_Token)); - end Parse_Header; - - --------------- - -- Read_Body -- - --------------- - - procedure Read_Body - (Connection : in out HTTP_Connection; - Result : out Response.Data; - Store : Boolean) - is - use Ada.Real_Time; - Expire : constant Time := Clock + Connection.Timeouts.Response; - begin - loop - declare - Buffer : Stream_Element_Array (1 .. 8192); - Last : Stream_Element_Offset; - begin - Read_Some (Connection, Buffer, Last); - exit when Last < Buffer'First; - - if Store then - Response.Set.Append_Body - (Result, Buffer (Buffer'First .. Last)); - end if; - end; - - if Clock > Expire then - if Store then - Response.Set.Append_Body - (Result, "..." & ASCII.LF & " Response Timeout"); - end if; - Response.Set.Status_Code (Result, Messages.S408); - exit; - end if; - end loop; - end Read_Body; + end Read_Parse_Header; -------------------------------- -- Send_H2_Connection_Preface -- diff --git a/src/core/aws-client-http_utils.ads b/src/core/aws-client-http_utils.ads index aded395ba..4ddf2b25e 100644 --- a/src/core/aws-client-http_utils.ads +++ b/src/core/aws-client-http_utils.ads @@ -54,12 +54,13 @@ package AWS.Client.HTTP_Utils is Mode : Authentication_Mode); -- Internal procedure to set authentication parameters - procedure Parse_Header + procedure Read_Parse_Header (Connection : in out HTTP_Connection; - Answer : out Response.Data; + Answer : in out Response.Data; Keep_Alive : out Boolean); - -- Read server answer and set corresponding variable with the value - -- read. Most of the fields are ignored right now. + -- Read server answer (in HTTP/1.x only) and set corresponding variable + -- with the value read. Most of the fields are ignored right now. For + -- HTTP/2 mode Answer's headers are supposed to have been added already. procedure Connect (Connection : in out HTTP_Connection); -- Open the connection. Raises Connection_Error if it is not possible to From 4979d079d78da2e06ee8201f3bfd3a303adfa85b Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:25:59 +0200 Subject: [PATCH 44/51] Code refactoring, better sharing. Part of S507-051. --- src/core/aws-client-http_utils.adb | 200 ++++++++++++----------------- 1 file changed, 82 insertions(+), 118 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index f7f6acd1c..b22d97a9e 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -158,6 +158,13 @@ package body AWS.Client.HTTP_Utils is Result : out Response.Data); -- Get H2 response + procedure Handle_H2_Request + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + Auth_Is_Over : out Boolean); + -- Send request and get response for HTTP/2 protocol + --------- -- "+" -- --------- @@ -597,6 +604,71 @@ package body AWS.Client.HTTP_Utils is Byte_4 (Config.HTTP2_Max_Header_List_Size))); end Get_Settings; + ----------------------- + -- Handle_H2_Request -- + ----------------------- + + procedure Handle_H2_Request + (Connection : in out HTTP_Connection; + Result : out Response.Data; + Data : Stream_Element_Array; + Auth_Is_Over : out Boolean) + is + Settings : constant HTTP2.Frame.Settings.Set := + Get_Settings (Connection.Config); + + Request : HTTP2.Message.Object; + Auth_Attempts : Auth_Attempts_Count := (others => 2); + Stream : HTTP2.Stream.Object; + H_Connection : aliased HTTP2.Connection.Object; + Enc_Table : aliased HTTP2.HPACK.Table.Object; + Dec_Table : aliased HTTP2.HPACK.Table.Object; + Ctx : Server.Context.Object (null, + 1, + Enc_Table'Access, + Dec_Table'Access, + H_Connection'Access); + begin + -- Create the request HTTP/2 message out of Status.Data + + if Data'Length > 0 then + Set_Header + (Connection.F_Headers, + HN (Messages.Content_Length_Token, True), + Utils.Image (Stream_Element_Offset'(Data'Length))); + end if; + + if not Connection.H2_Preface_Sent then + Send_H2_Connection_Preface (Connection, Settings, H_Connection); + end if; + + -- Create frames and send them + + Stream := HTTP2.Stream.Create + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); + + Request := HTTP2.Message.Create + (Connection.F_Headers, Data, Stream.Identifier); + + Send_H2_Request (Connection, Ctx, Stream, Request); + + -- Get response + + Stream := HTTP2.Stream.Create + (Connection.Socket, + Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); + + Next_Stream_Id (Connection); + + Get_H2_Response (Connection, Ctx, Stream, Result); + + Decrement_Authentication_Attempt + (Connection, Auth_Attempts, Auth_Is_Over); + end Handle_H2_Request; + ----------- -- Image -- ----------- @@ -1122,74 +1194,20 @@ package body AWS.Client.HTTP_Utils is is use Ada.Real_Time; - Stamp : constant Time := Clock; - Settings : constant HTTP2.Frame.Settings.Set := - Get_Settings (Connection.Config); - - Request : HTTP2.Message.Object; - Try_Count : Natural := Connection.Retry; - Auth_Attempts : Auth_Attempts_Count := (others => 2); - Auth_Is_Over : Boolean; - Stream : HTTP2.Stream.Object; - H_Connection : aliased HTTP2.Connection.Object; - Enc_Table : aliased HTTP2.HPACK.Table.Object; - Dec_Table : aliased HTTP2.HPACK.Table.Object; - Ctx : Server.Context.Object (null, - 1, - Enc_Table'Access, - Dec_Table'Access, - H_Connection'Access); + Stamp : constant Time := Clock; + Try_Count : Natural := Connection.Retry; + Auth_Is_Over : Boolean; begin Connection.F_Headers.Reset; Retry : loop begin - -- Post Data with headers - Set_Common_Post (Connection, Data, URI, SOAPAction, Content_Type, Headers); - if Data'Length > 0 then - Set_Header - (Connection.F_Headers, - HN (Messages.Content_Length_Token, True), - Utils.Image (Stream_Element_Offset'(Data'Length))); - end if; - - if not Connection.H2_Preface_Sent then - Send_H2_Connection_Preface (Connection, Settings, H_Connection); - end if; - - -- Create frames and send them - - Stream := HTTP2.Stream.Create - (Connection.Socket, - Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); - - Next_Stream_Id (Connection); - - Request := HTTP2.Message.Create - (Connection.F_Headers, Data, Stream.Identifier); - - Send_H2_Request (Connection, Ctx, Stream, Request); - - -- Get response - - Stream := HTTP2.Stream.Create - (Connection.Socket, - Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); - - Next_Stream_Id (Connection); - - Get_H2_Response (Connection, Ctx, Stream, Result); - - Decrement_Authentication_Attempt - (Connection, Auth_Attempts, Auth_Is_Over); - - if Auth_Is_Over then - exit Retry; - end if; + Handle_H2_Request (Connection, Result, Data, Auth_Is_Over); + exit Retry when Auth_Is_Over; exception when E : Net.Socket_Error | Connection_Error => Error_Processing @@ -2030,75 +2048,21 @@ package body AWS.Client.HTTP_Utils is is use Ada.Real_Time; - Stamp : constant Time := Clock; - Settings : constant HTTP2.Frame.Settings.Set := - Get_Settings (Connection.Config); + Stamp : constant Time := Clock; + Try_Count : Natural := Connection.Retry; + Auth_Is_Over : Boolean; - Request : HTTP2.Message.Object; - Try_Count : Natural := Connection.Retry; - Auth_Attempts : Auth_Attempts_Count := (others => 2); - Auth_Is_Over : Boolean; - Stream : HTTP2.Stream.Object; - H_Connection : aliased HTTP2.Connection.Object; - Enc_Table : aliased HTTP2.HPACK.Table.Object; - Dec_Table : aliased HTTP2.HPACK.Table.Object; - Ctx : Server.Context.Object (null, - 1, - Enc_Table'Access, - Dec_Table'Access, - H_Connection'Access); begin Connection.F_Headers.Reset; Retry : loop begin - -- Create the request HTTP/2 message out of Status.Data - Open_Set_Common_Header (Connection, Method_Kind'Image (Kind), URI, Headers); - -- Add content length if needed - - if Data'Length > 0 then - Set_Header - (Connection.F_Headers, - HN (Messages.Content_Length_Token, True), - Utils.Image (Stream_Element_Offset'(Data'Length))); - end if; - - if not Connection.H2_Preface_Sent then - Send_H2_Connection_Preface (Connection, Settings, H_Connection); - end if; - - -- Create frames and send them - - Stream := HTTP2.Stream.Create - (Connection.Socket, - Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); - - Next_Stream_Id (Connection); - - Request := HTTP2.Message.Create - (Connection.F_Headers, Data, Stream.Identifier); - - Send_H2_Request (Connection, Ctx, Stream, Request); - - -- Get response + Handle_H2_Request (Connection, Result, Data, Auth_Is_Over); - Stream := HTTP2.Stream.Create - (Connection.Socket, - Connection.H2_Stream_Id, H_Connection.Flow_Control_Window); - - Next_Stream_Id (Connection); - - Get_H2_Response (Connection, Ctx, Stream, Result); - - Decrement_Authentication_Attempt - (Connection, Auth_Attempts, Auth_Is_Over); - - if Auth_Is_Over then - exit Retry; - end if; + exit Retry when Auth_Is_Over; exception when E : Net.Socket_Error | Connection_Error => Error_Processing From bc9bdeed96cf02bad673c90268f8cc6b7eecc593 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:26:03 +0200 Subject: [PATCH 45/51] Minor code reformatting and clean-up. Part of S507-051. --- src/core/aws-client-http_utils.adb | 36 +++++++++--------------------- src/core/aws-parameters.adb | 8 ++++--- src/core/aws-resources-streams.adb | 2 +- 3 files changed, 16 insertions(+), 30 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index b22d97a9e..6dc739020 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -32,6 +32,7 @@ pragma Ada_2012; with Ada.Characters.Handling; with Ada.Exceptions; with Ada.Strings.Fixed; +with Ada.Strings.Maps; with AWS.Digest; with AWS.Headers.Values; @@ -772,10 +773,10 @@ package body AWS.Client.HTTP_Utils is Headers : Header_List := Empty_Header_List) is use Real_Time; - Stamp : constant Time := Clock; - Pref_Suf : constant String := "--"; - Boundary : constant String := - "AWS_Attachment-" & Utils.Random_String (8); + Stamp : constant Time := Clock; + Pref_Suf : constant String := "--"; + Boundary : constant String := + "AWS_Attachment-" & Utils.Random_String (8); Root_Content_Id : constant String := ""; Root_Part_Header : AWS.Headers.List; @@ -1081,10 +1082,7 @@ package body AWS.Client.HTTP_Utils is Decrement_Authentication_Attempt (Connection, Auth_Attempts, Auth_Is_Over); - if Auth_Is_Over then - exit Retry; - end if; - + exit Retry when Auth_Is_Over; exception when E : Net.Socket_Error | Connection_Error => Error_Processing @@ -1246,23 +1244,9 @@ package body AWS.Client.HTTP_Utils is -- Returns "Keep-Alive" is we have a persistent connection and "Close" -- otherwise. - function Encoded_URI return String; - -- Returns URI encoded (' ' -> '+') - - ----------------- - -- Encoded_URI -- - ----------------- - function Encoded_URI return String is - E_URI : String := URI; - begin - for K in E_URI'Range loop - if E_URI (K) = ' ' then - E_URI (K) := '+'; - end if; - end loop; - return E_URI; - end Encoded_URI; + (Strings.Fixed.Translate (URI, Strings.Maps.To_Mapping (" ", "+"))); + -- Returns URI encoded (' ' -> '+') ----------------- -- Persistence -- @@ -1501,6 +1485,7 @@ package body AWS.Client.HTTP_Utils is Response.Set.Append_Body (Result, "..." & ASCII.LF & " Response Timeout"); end if; + Response.Set.Status_Code (Result, Messages.S408); exit; end if; @@ -1886,8 +1871,7 @@ package body AWS.Client.HTTP_Utils is -- Send the setting frame (stream id 0) - HTTP2.Frame.Settings.Create - (Settings).Send (Connection.Socket.all); + HTTP2.Frame.Settings.Create (Settings).Send (Connection.Socket.all); -- We need to read the settings from server diff --git a/src/core/aws-parameters.adb b/src/core/aws-parameters.adb index a1678cac7..c6d7e1eb5 100644 --- a/src/core/aws-parameters.adb +++ b/src/core/aws-parameters.adb @@ -154,7 +154,9 @@ package body AWS.Parameters is --------- procedure Add - (Parameter_List : in out List; Name, Value : String; Decode : Boolean) is + (Parameter_List : in out List; + Name, Value : String; + Decode : Boolean) is begin if Decode then Parameter_List.Add (URL.Decode (Name), URL.Decode (Value)); @@ -283,9 +285,9 @@ package body AWS.Parameters is function URI_Format (Parameter_List : List; Limit : Positive := Positive'Last) return String is - Delimiter : Character := '?'; + Delimiter : Character := '?'; Parameters : Unbounded_String; - Size : Positive := 1; + Size : Positive := 1; begin for J in 1 .. Parameter_List.Count loop declare diff --git a/src/core/aws-resources-streams.adb b/src/core/aws-resources-streams.adb index ac09487af..c8ceb67ab 100644 --- a/src/core/aws-resources-streams.adb +++ b/src/core/aws-resources-streams.adb @@ -96,10 +96,10 @@ package body AWS.Resources.Streams is is use type Embedded.Buffer_Access; - Stream : Stream_Access; In_GZip : constant Boolean := GZip; Buffer : constant Embedded.Buffer_Access := Embedded.Get_Buffer (Name, GZip); + Stream : Stream_Access; begin if Buffer /= null then Stream := new Memory.Stream_Type; From 329654af08030a3c83745487f4d14e8cfc8ad28e Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:26:09 +0200 Subject: [PATCH 46/51] Clean-up multiple definitions of CRLF. Part of S507-051. --- src/core/aws-attachments.adb | 3 --- src/core/aws-client-http_utils.adb | 1 - src/core/aws-headers.adb | 4 +--- src/core/aws-net-buffered.adb | 3 ++- src/core/aws-response.ads | 2 -- src/core/aws.ads | 2 ++ src/extended/aws-pop.adb | 4 +--- src/extended/aws-smtp-server.adb | 3 +-- 8 files changed, 7 insertions(+), 15 deletions(-) diff --git a/src/core/aws-attachments.adb b/src/core/aws-attachments.adb index 1b61d3fae..c6553aff6 100644 --- a/src/core/aws-attachments.adb +++ b/src/core/aws-attachments.adb @@ -339,8 +339,6 @@ package body AWS.Attachments is (Attachments : List; Boundary : String) is - CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); - procedure Send_Attachment (Attachment : Element); -- Sends one Attachment, including the start boundary @@ -635,7 +633,6 @@ package body AWS.Attachments is Boundary : out Unbounded_String; Alternative : Boolean := False) is - CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); L_Boundary : constant String := "----=_NextPart_" & Utils.Random_String (10) & "." & Utils.Image (UID.Value); diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index 6dc739020..d9983f891 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -934,7 +934,6 @@ package body AWS.Client.HTTP_Utils is is use Real_Time; - CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); Stamp : constant Time := Clock; Settings : constant HTTP2.Frame.Settings.Set := Get_Settings (Connection.Config); diff --git a/src/core/aws-headers.adb b/src/core/aws-headers.adb index 7c48aeee5..bd16652a4 100644 --- a/src/core/aws-headers.adb +++ b/src/core/aws-headers.adb @@ -79,9 +79,7 @@ package body AWS.Headers is procedure Get_Content (Headers : List; - End_Block : Boolean := False) - is - CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); + End_Block : Boolean := False) is begin for J in 1 .. Count (Headers) loop Data (Get_Line (Headers, J) & CRLF); diff --git a/src/core/aws-net-buffered.adb b/src/core/aws-net-buffered.adb index 907ce34d0..3be78d075 100644 --- a/src/core/aws-net-buffered.adb +++ b/src/core/aws-net-buffered.adb @@ -36,7 +36,8 @@ with AWS.Translator; package body AWS.Net.Buffered is CRLF : constant Stream_Element_Array := - Translator.To_Stream_Element_Array (ASCII.CR & ASCII.LF); + (1 => Character'Pos (ASCII.CR), + 2 => Character'Pos (ASCII.LF)); Input_Limit : Positive := AWS.Default.Input_Line_Size_Limit with Atomic; diff --git a/src/core/aws-response.ads b/src/core/aws-response.ads index ea8a6b72a..e62146452 100644 --- a/src/core/aws-response.ads +++ b/src/core/aws-response.ads @@ -435,8 +435,6 @@ private Default_Moved_Message : constant String := "Page moved
Click here"; - CRLF : constant String := ASCII.CR & ASCII.LF; - Default_Authenticate_Message : constant String := "" & CRLF & "401 Authorization Required" & CRLF diff --git a/src/core/aws.ads b/src/core/aws.ads index 46c6bdd6e..623947a17 100644 --- a/src/core/aws.ads +++ b/src/core/aws.ads @@ -41,4 +41,6 @@ package AWS with Pure is type HTTP_Protocol is (HTTPv1, HTTPv2); + CRLF : constant String := String'(1 => ASCII.CR, 2 => ASCII.LF); + end AWS; diff --git a/src/extended/aws-pop.adb b/src/extended/aws-pop.adb index 048a5aa7b..adbf94183 100644 --- a/src/extended/aws-pop.adb +++ b/src/extended/aws-pop.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2003-2019, AdaCore -- +-- Copyright (C) 2003-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 -- @@ -48,8 +48,6 @@ package body AWS.POP is subtype Stream_Type is AWS.Resources.Streams.Memory.Stream_Type; - CRLF : constant String := ASCII.CR & ASCII.LF; - procedure Check_Response (Response : String); -- Checks server's response, raise POP_Error with server's message diff --git a/src/extended/aws-smtp-server.adb b/src/extended/aws-smtp-server.adb index 7a3b6dc39..13f17cd02 100644 --- a/src/extended/aws-smtp-server.adb +++ b/src/extended/aws-smtp-server.adb @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- Ada Web Server -- -- -- --- Copyright (C) 2008-2017, AdaCore -- +-- Copyright (C) 2008-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 -- @@ -98,7 +98,6 @@ package body AWS.SMTP.Server is is Empty_Line : constant String := ""; - CRLF : constant String := ASCII.CR & ASCII.LF; procedure Read_Message_Body; -- Read message body from the current socket and set the Message_Body From 49c15871cf22867286bf2418e606b7415c56ea61 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Fri, 1 Oct 2021 18:55:38 +0200 Subject: [PATCH 47/51] Properly initialize the connection object based on settings. Part of S507-051. --- src/core/aws-client-http_utils.adb | 28 ++++++++++++++++++++++++++-- 1 file changed, 26 insertions(+), 2 deletions(-) diff --git a/src/core/aws-client-http_utils.adb b/src/core/aws-client-http_utils.adb index d9983f891..ed57b527d 100644 --- a/src/core/aws-client-http_utils.adb +++ b/src/core/aws-client-http_utils.adb @@ -138,7 +138,7 @@ package body AWS.Client.HTTP_Utils is procedure Send_H2_Connection_Preface (Connection : in out HTTP_Connection; Settings : HTTP2.Frame.Settings.Set; - H_Connection : HTTP2.Connection.Object) + H_Connection : in out HTTP2.Connection.Object) with Pre => not Connection.H2_Preface_Sent; -- Send connection preface and get response from server @@ -630,6 +630,10 @@ package body AWS.Client.HTTP_Utils is Dec_Table'Access, H_Connection'Access); begin + -- Set default connection settings + + HTTP2.Connection.Set (H_Connection, Settings); + -- Create the request HTTP/2 message out of Status.Data if Data'Length > 0 then @@ -640,6 +644,7 @@ package body AWS.Client.HTTP_Utils is end if; if not Connection.H2_Preface_Sent then + -- Update H_Connection with server settings Send_H2_Connection_Preface (Connection, Settings, H_Connection); end if; @@ -981,6 +986,10 @@ package body AWS.Client.HTTP_Utils is Build_Root_Part_Header; + -- Set default connection settings + + HTTP2.Connection.Set (H_Connection, Settings); + Retry : loop begin Set_Common_Post @@ -1003,6 +1012,7 @@ package body AWS.Client.HTTP_Utils is end if; if not Connection.H2_Preface_Sent then + -- Update H_Connection with server settings Send_H2_Connection_Preface (Connection, Settings, H_Connection); end if; @@ -1859,7 +1869,7 @@ package body AWS.Client.HTTP_Utils is procedure Send_H2_Connection_Preface (Connection : in out HTTP_Connection; Settings : HTTP2.Frame.Settings.Set; - H_Connection : HTTP2.Connection.Object) + H_Connection : in out HTTP2.Connection.Object) is use all type HTTP2.Frame.Kind_Type; begin @@ -1882,6 +1892,20 @@ package body AWS.Client.HTTP_Utils is if Frame.Kind /= K_Settings then raise Constraint_Error with "server should have answered with a setting frame"; + + else + declare + S_Frame : constant HTTP2.Frame.Settings.Object := + HTTP2.Frame.Settings.Object (Frame); + begin + -- Make sure the settings frame is not an aknowledged, this + -- should not happen anyway. + + if not S_Frame.Has_Flag (HTTP2.Frame.Ack_Flag) then + HTTP2.Connection.Set + (H_Connection, HTTP2.Frame.Settings.Values (S_Frame)); + end if; + end; end if; end; From e533c327d0aa8214782e999d2944bb0963537e03 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 2 Oct 2021 16:30:42 +0200 Subject: [PATCH 48/51] Minor code clean-up. Part of S507-051. --- src/http2/aws-http2-frame-ping.ads | 4 +++- src/http2/aws-http2-frame.ads | 2 -- src/http2/aws-http2-hpack.ads | 4 ---- src/http2/aws-http2-message.ads | 4 ---- src/http2/aws-http2-stream.ads | 4 ---- src/http2/aws-http2.ads | 24 ++++++++++++++++-------- 6 files changed, 19 insertions(+), 23 deletions(-) diff --git a/src/http2/aws-http2-frame-ping.ads b/src/http2/aws-http2-frame-ping.ads index ce59b8077..517d2d30b 100644 --- a/src/http2/aws-http2-frame-ping.ads +++ b/src/http2/aws-http2-frame-ping.ads @@ -39,7 +39,7 @@ package AWS.HTTP2.Frame.Ping is type Opaque_Data is new Stream_Element_Array (1 .. 8); - Default_Data : constant Opaque_Data := (0, 0, 0, 0, 0, 0, 0, 0); + Default_Data : constant Opaque_Data; function Create (Data : Opaque_Data := Default_Data; @@ -57,6 +57,8 @@ package AWS.HTTP2.Frame.Ping is private + Default_Data : constant Opaque_Data := (0, 0, 0, 0, 0, 0, 0, 0); + -- RFC-7540 6.7 -- -- +---------------------------------------------------------------+ diff --git a/src/http2/aws-http2-frame.ads b/src/http2/aws-http2-frame.ads index 38d050e27..70e5ce05c 100644 --- a/src/http2/aws-http2-frame.ads +++ b/src/http2/aws-http2-frame.ads @@ -28,7 +28,6 @@ ------------------------------------------------------------------------------ with Ada.Finalization; -with Ada.Streams; with System; @@ -41,7 +40,6 @@ private with AWS.Utils; package AWS.HTTP2.Frame is use Ada; - use Ada.Streams; type Object is new Finalization.Controlled with private; diff --git a/src/http2/aws-http2-hpack.ads b/src/http2/aws-http2-hpack.ads index 4b2a3657a..7f357e62e 100644 --- a/src/http2/aws-http2-hpack.ads +++ b/src/http2/aws-http2-hpack.ads @@ -29,8 +29,6 @@ -- Support for HAPCK (Header compression) for HTTP/2 protocol -with Ada.Streams; - with AWS.Headers; limited with AWS.HTTP2.HPACK.Table; @@ -38,8 +36,6 @@ limited with AWS.HTTP2.Connection; package AWS.HTTP2.HPACK is - use Ada.Streams; - generic with function End_Of_Stream return Boolean; with function Get_Byte return Stream_Element; diff --git a/src/http2/aws-http2-message.ads b/src/http2/aws-http2-message.ads index 1dbe797e6..54f6a05bc 100644 --- a/src/http2/aws-http2-message.ads +++ b/src/http2/aws-http2-message.ads @@ -27,8 +27,6 @@ -- covered by the GNU Public License. -- ------------------------------------------------------------------------------ -with Ada.Streams; - with AWS.Headers; with AWS.HTTP2.Frame.List; with AWS.Response; @@ -42,8 +40,6 @@ limited with AWS.HTTP2.Stream; package AWS.HTTP2.Message is - use Ada.Streams; - use type AWS.HTTP2.Frame.List.Count_Type; use type Response.Data_Mode; diff --git a/src/http2/aws-http2-stream.ads b/src/http2/aws-http2-stream.ads index abf7f7e1c..c2d3aa6c3 100644 --- a/src/http2/aws-http2-stream.ads +++ b/src/http2/aws-http2-stream.ads @@ -27,8 +27,6 @@ -- covered by the GNU Public License. -- ------------------------------------------------------------------------------ -with Ada.Streams; - with AWS.Net; with AWS.Server.Context; @@ -41,8 +39,6 @@ with AWS.Status; package AWS.HTTP2.Stream is - use Ada.Streams; - type State_Kind is (Idle, Reserved_Local, Reserved_Remote, Open, Half_Closed_Local, Half_Closed_Remote, Closed); -- RFC 7540 5.1 Stream States diff --git a/src/http2/aws-http2.ads b/src/http2/aws-http2.ads index 58eaab433..d1667e704 100644 --- a/src/http2/aws-http2.ads +++ b/src/http2/aws-http2.ads @@ -31,6 +31,8 @@ with Ada.Streams; package AWS.HTTP2 is + use Ada.Streams; + type Bit_1 is mod 2 ** 1 with Size => 1; type Byte_1 is mod 2 ** 8 with Size => 8; @@ -49,16 +51,15 @@ package AWS.HTTP2 is C_Enhance_Your_CALM, C_Inadequate_Security, C_HTTP_1_1_Required); -- Error codes that are used in RST_Stream and GoAway frames - Client_Connection_Preface : constant Ada.Streams.Stream_Element_Array := - (16#50#, 16#52#, 16#49#, 16#20#, 16#2a#, - 16#20#, 16#48#, 16#54#, 16#54#, 16#50#, - 16#2f#, 16#32#, 16#2e#, 16#30#, 16#0d#, - 16#0a#, 16#0d#, 16#0a#, 16#53#, 16#4d#, - 16#0d#, 16#0a#, 16#0d#, 16#0a#); - -- "PRI * HTTP/2.0" & CRLF & CRLF & "SM" & CRLF & CRLF - Client_Connection_Preface_1 : constant String := "PRI * HTTP/2.0"; + -- Connection preface first part + Client_Connection_Preface_2 : constant String := "SM"; + -- Connection preface second part + + Client_Connection_Preface : constant Stream_Element_Array; + -- The full connection preface: + -- "PRI * HTTP/2.0" & CRLF & CRLF & "SM" & CRLF & CRLF function Exception_Message (Error : Error_Codes; Message : String) return String; @@ -74,6 +75,13 @@ package AWS.HTTP2 is private + Client_Connection_Preface : constant Stream_Element_Array := + (16#50#, 16#52#, 16#49#, 16#20#, 16#2a#, + 16#20#, 16#48#, 16#54#, 16#54#, 16#50#, + 16#2f#, 16#32#, 16#2e#, 16#30#, 16#0d#, + 16#0a#, 16#0d#, 16#0a#, 16#53#, 16#4d#, + 16#0d#, 16#0a#, 16#0d#, 16#0a#); + for Error_Codes use (C_No_Error => 16#0#, C_Protocol_Error => 16#1#, C_Internal_Error => 16#2#, From ebdfbdb9320dc26b4b0e19f48fcd50a7c3145f57 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sat, 2 Oct 2021 16:38:58 +0200 Subject: [PATCH 49/51] Add some pre-conditions. Part of S507-051. --- src/http2/aws-http2-frame-continuation.ads | 11 ++++++++--- src/http2/aws-http2-frame-data.ads | 6 ++++-- src/http2/aws-http2-frame-goaway.ads | 3 ++- src/http2/aws-http2-frame-priority.ads | 3 ++- src/http2/aws-http2-frame-push_promise.ads | 6 ++++-- src/http2/aws-http2-frame-rst_stream.ads | 6 ++++-- src/http2/aws-http2-frame.ads | 3 ++- src/http2/aws-http2.ads | 6 ++++-- 8 files changed, 30 insertions(+), 14 deletions(-) diff --git a/src/http2/aws-http2-frame-continuation.ads b/src/http2/aws-http2-frame-continuation.ads index c112f91af..e9ed8c3e9 100644 --- a/src/http2/aws-http2-frame-continuation.ads +++ b/src/http2/aws-http2-frame-continuation.ads @@ -45,7 +45,10 @@ package AWS.HTTP2.Frame.Continuation is Stream_Id : HTTP2.Stream_Id; List : Headers.List; End_Headers : Boolean := True) return Object - with Post => (if End_Headers then Create'Result.Flags = End_Headers_Flag); + with Pre => Stream_Id /= 0, + Post => (if End_Headers then Create'Result.Flags = End_Headers_Flag) + and then Create'Result.Kind = K_Continuation; + -- Create a CONTINUATION frame with given content overriding procedure Send_Payload (Self : Object; Sock : Net.Socket_Type'Class); @@ -56,11 +59,13 @@ package AWS.HTTP2.Frame.Continuation is -- Iterator interface function Content_Length - (Self : Object) return Stream_Element_Count; + (Self : Object) return Stream_Element_Count + with Pre => Self.Is_Defined; function Get (Self : Object; - Index : Stream_Element_Offset) return Stream_Element; + Index : Stream_Element_Offset) return Stream_Element + with Pre => Self.Is_Defined; private diff --git a/src/http2/aws-http2-frame-data.ads b/src/http2/aws-http2-frame-data.ads index 22c0ae08a..b63b89d21 100644 --- a/src/http2/aws-http2-frame-data.ads +++ b/src/http2/aws-http2-frame-data.ads @@ -50,14 +50,16 @@ package AWS.HTTP2.Frame.Data is function Create (Stream_Id : HTTP2.Stream_Id; Content : String) return Object - with Pre => Stream_Id > 0 and then Content'Length > 0; + with Pre => Stream_Id > 0 and then Content'Length > 0, + Post => Create'Result.Kind = K_Data; -- Create a DATA frame with given content and stream id function Create (Stream_Id : HTTP2.Stream_Id; Content : Utils.Stream_Element_Array_Access; End_Stream : Boolean) return Object - with Pre => Stream_Id > 0 and then Content'Length > 0; + with Pre => Stream_Id > 0 and then Content'Length > 0, + Post => Create'Result.Kind = K_Data; -- Create a DATA frame with given content and stream id overriding procedure Send_Payload diff --git a/src/http2/aws-http2-frame-goaway.ads b/src/http2/aws-http2-frame-goaway.ads index 96e613be7..9b40132ed 100644 --- a/src/http2/aws-http2-frame-goaway.ads +++ b/src/http2/aws-http2-frame-goaway.ads @@ -45,7 +45,8 @@ package AWS.HTTP2.Frame.GoAway is function Create (Stream_Id : Stream.Id; - Error : Error_Codes) return Object; + Error : Error_Codes) return Object + with Post => Create'Result.Kind = K_GoAway; -- Create a GOAWAY frame with given content and stream id function Error (Self : Object) return Error_Codes diff --git a/src/http2/aws-http2-frame-priority.ads b/src/http2/aws-http2-frame-priority.ads index 284bb1bc6..af6da6afb 100644 --- a/src/http2/aws-http2-frame-priority.ads +++ b/src/http2/aws-http2-frame-priority.ads @@ -48,7 +48,8 @@ package AWS.HTTP2.Frame.Priority is (Stream_Id : HTTP2.Stream_Id; Stream_Dependency : HTTP2.Stream_Id; Weight : Byte_1) return Object - with Pre => Stream_Id /= Stream_Dependency; + with Pre => Stream_Id /= Stream_Dependency, + Post => Create'Result.Kind = K_Priority; -- Create a PRIORITY frame (stream id is always 0) function Read diff --git a/src/http2/aws-http2-frame-push_promise.ads b/src/http2/aws-http2-frame-push_promise.ads index 7d7993f81..6ec772550 100644 --- a/src/http2/aws-http2-frame-push_promise.ads +++ b/src/http2/aws-http2-frame-push_promise.ads @@ -58,14 +58,16 @@ package AWS.HTTP2.Frame.Push_Promise is Promise_Stream_Id : HTTP2.Stream_Id; List : AWS.Headers.List; End_Headers : Boolean := True) return Object - with Post => (if End_Headers then Create'Result.Flags = End_Headers_Flag); + with Post => (if End_Headers then Create'Result.Flags = End_Headers_Flag) + and then Create'Result.Kind = K_Push_Promise; -- Create an HEADERS frame with given content and stream id function Get (Self : Object; Table : not null access HTTP2.HPACK.Table.Object; Settings : not null access HTTP2.Connection.Object) - return AWS.Headers.List; + return AWS.Headers.List + with Pre => Self.Is_Defined; -- Get the header list out of the HEADERS frame. This reads the content of -- the payload and decode using HPACK. diff --git a/src/http2/aws-http2-frame-rst_stream.ads b/src/http2/aws-http2-frame-rst_stream.ads index d079b5283..510ac0ec1 100644 --- a/src/http2/aws-http2-frame-rst_stream.ads +++ b/src/http2/aws-http2-frame-rst_stream.ads @@ -47,8 +47,10 @@ package AWS.HTTP2.Frame.RST_Stream is function Create (Error : Error_Codes; - Stream_Id : Stream.Id) return Object; - -- Create an RST_Stream frame (stream id is 0) + Stream_Id : Stream.Id) return Object + with Pre => Stream_Id /= 0, + Post => Create'Result.Kind = K_RST_Stream; + -- Create an RST_Stream frame overriding procedure Send_Payload (Self : Object; Sock : Net.Socket_Type'Class) diff --git a/src/http2/aws-http2-frame.ads b/src/http2/aws-http2-frame.ads index 70e5ce05c..de37bb526 100644 --- a/src/http2/aws-http2-frame.ads +++ b/src/http2/aws-http2-frame.ads @@ -124,7 +124,8 @@ package AWS.HTTP2.Frame is (Self : Object'Class; Settings : Connection.Object; Error : out Error_Codes) return Boolean - with Pre => Self.Is_Defined; + with Pre => Self.Is_Defined, + Post => Is_Valid'Result = (Error = C_No_Error); -- Set Error to appropriate value with Validate routine and return True if -- Error became C_No_Error, returns False otherwise. diff --git a/src/http2/aws-http2.ads b/src/http2/aws-http2.ads index d1667e704..18273829f 100644 --- a/src/http2/aws-http2.ads +++ b/src/http2/aws-http2.ads @@ -62,11 +62,13 @@ package AWS.HTTP2 is -- "PRI * HTTP/2.0" & CRLF & CRLF & "SM" & CRLF & CRLF function Exception_Message - (Error : Error_Codes; Message : String) return String; + (Error : Error_Codes; Message : String) return String + with Pre => Message /= ""; -- Build an exception message with the error code endoded at the start of -- the message and surrounded with square brackets. - function Exception_Code (Exception_Message : String) return Error_Codes; + function Exception_Code (Exception_Message : String) return Error_Codes + with Pre => Exception_Message'Length > 2; -- Extract the execption code from an exception message built with the -- Exception_Message routine above. From 12956635324cfe367edf38884fbb8493d4c50214 Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Sun, 3 Oct 2021 19:56:46 +0200 Subject: [PATCH 50/51] Ensure we handle possible corruped data/frames. We don't want to crash, and so if a frame as some invalid format detected by invariant we want to properly report an invalid frame. Part of S507-051. --- src/http2/aws-http2-frame.adb | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/http2/aws-http2-frame.adb b/src/http2/aws-http2-frame.adb index 26317bf13..bd514d56d 100644 --- a/src/http2/aws-http2-frame.adb +++ b/src/http2/aws-http2-frame.adb @@ -178,6 +178,11 @@ package body AWS.HTTP2.Frame is raise Protocol_Error with Exception_Message (C_Protocol_Error, "invalid frame kind"); end case; + + exception + when others => + raise Protocol_Error with + Exception_Message (C_Protocol_Error, "corruput frame"); end Read; ---------- From 36373d7089dd8692a6e2b2e0df603d3928a86c7e Mon Sep 17 00:00:00 2001 From: Pascal Obry Date: Tue, 5 Oct 2021 18:31:23 +0200 Subject: [PATCH 51/51] Simplify code by using To_Lower as in pure HTTP/2 unit. Part of S507-051. --- src/http2/aws-http2-message.adb | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/src/http2/aws-http2-message.adb b/src/http2/aws-http2-message.adb index 62404f088..fc8dacfa1 100644 --- a/src/http2/aws-http2-message.adb +++ b/src/http2/aws-http2-message.adb @@ -28,6 +28,7 @@ ------------------------------------------------------------------------------ with Ada.Calendar; +with Ada.Characters.Handling; with Ada.Strings.Unbounded; with Ada.Text_IO; @@ -45,11 +46,8 @@ package body AWS.HTTP2.Message is use Ada.Strings.Unbounded; - function HN - (Header_Name : String; - Is_H2 : Boolean := True) - return String renames Utils.Normalize_Lower; - -- Fold header name to lower case as required by HTTP/2 protocol + function To_Lower + (Name : String) return String renames Ada.Characters.Handling.To_Lower; ----------------- -- Append_Body -- @@ -127,7 +125,7 @@ package body AWS.HTTP2.Message is if Size /= Resources.Undefined_Length then O.Headers.Add - (HN (Messages.Content_Length_Token), Utils.Image (Size)); + (To_Lower (Messages.Content_Length_Token), Utils.Image (Size)); end if; end Set_Body; @@ -143,7 +141,7 @@ package body AWS.HTTP2.Message is -- Set status code O.Headers.Add - (HN (Messages.Status_Token), + (To_Lower (Messages.Status_Token), Messages.Image (Response.Status_Code (Answer))); if O.Mode /= Response.Header then @@ -197,7 +195,7 @@ package body AWS.HTTP2.Message is (Answer, Messages.Last_Modified_Token) then O.Headers.Add - (HN (Messages.Last_Modified_Token), + (To_Lower (Messages.Last_Modified_Token), Messages.To_HTTP_Date (File_Time)); end if; @@ -374,7 +372,8 @@ package body AWS.HTTP2.Message is begin if Size /= Resources.Undefined_Length then Self.Headers.Add - (HN (Messages.Content_Length_Token), Utils.Image (Size)); + (To_Lower (Messages.Content_Length_Token), + Utils.Image (Size)); end if; end; end if;