File 0250-stdlib-normalize-empty-port-in-uri_string.patch of Package erlang

From 3ad7aef13814ed5c497015199d2257de66574bee Mon Sep 17 00:00:00 2001
From: Jakub Witczak <kuba@erlang.org>
Date: Wed, 5 Jan 2022 17:01:19 +0100
Subject: [PATCH 1/2] stdlib: normalize empty port in uri_string

- adjust port normalize functionality
- remove port subcomponent if port value is empty or key in URIMap if undefined
---
 lib/inets/test/httpc_SUITE.erl       | 19 ++++++++---
 lib/stdlib/src/uri_string.erl        | 25 +++++++++-----
 lib/stdlib/test/uri_string_SUITE.erl | 50 ++++++++++++++++++++--------
 3 files changed, 67 insertions(+), 27 deletions(-)

diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 77a56cf1b8..e24370ac9e 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -258,8 +258,8 @@ init_per_group(http_unix_socket = Group, Config0) ->
             file:delete(?UNIX_SOCKET),
             start_apps(Group),
             Config = proplists:delete(port, Config0),
-            Port = server_start(Group, server_config(Group, Config)),
-            [{port, Port} | Config]
+            {Pid, Port} = server_start(Group, server_config(Group, Config)),
+            lists:append([{dummy_server_pid, Pid}, {port, Port}], Config)
     end;
 init_per_group(http_ipv6 = Group, Config0) ->
     case is_ipv6_supported() of
@@ -277,7 +277,16 @@ init_per_group(Group, Config0) ->
     Port = server_start(Group, server_config(Group, Config)),
     [{port, Port} | Config].
 
-end_per_group(http_unix_socket,_Config) ->
+end_per_group(http_unix_socket, Config) ->
+    Pid = ?config(dummy_server_pid, Config),
+    Pid ! {stop, self()},
+    %% request is needed for enforcing dummy server and handlers stop; without a
+    %% it, dummy server waits in gen_tcp:accept and will not process stop request
+    httpc:request(get, {"http://localhost/v1/kv/foo", []}, [], []),
+    receive
+        {stopped, DummyServerPid} ->
+            ok
+    end,
     file:delete(?UNIX_SOCKET),
     ok;
 end_per_group(_, _Config) ->
@@ -1955,9 +1964,9 @@ server_start(http_unix_socket, Config) ->
     Inet = local,
     Socket = proplists:get_value(unix_socket, Config),
     ok = httpc:set_options([{ipfamily, Inet},{unix_socket, Socket}]),
-    {_Pid, Port} = http_test_lib:dummy_server(unix_socket, Inet, [{content_cb, ?MODULE},
+    {Pid, Port} = http_test_lib:dummy_server(unix_socket, Inet, [{content_cb, ?MODULE},
                                                                   {unix_socket, Socket}]),
-    Port;
+    {Pid, Port};
 server_start(http_ipv6, HttpdConfig) ->
     {ok, Pid} = inets:start(httpd, HttpdConfig),
     Serv = inets:services_info(),
diff --git a/lib/stdlib/src/uri_string.erl b/lib/stdlib/src/uri_string.erl
index 3060f2bfaa..05b66c12d6 100644
--- a/lib/stdlib/src/uri_string.erl
+++ b/lib/stdlib/src/uri_string.erl
@@ -2216,8 +2216,9 @@ base10_decode_unicode(<<H,_/binary>>, _, _) ->
 normalize_map(URIMap) ->
     normalize_path_segment(
       normalize_scheme_based(
-        normalize_percent_encoding(
-          normalize_case(URIMap)))).
+        normalize_undefined_port(
+          normalize_percent_encoding(
+            normalize_case(URIMap))))).
 
 
 %% 6.2.2.1.  Case Normalization
@@ -2357,28 +2358,30 @@ normalize_scheme_based(Map, _, _, _) ->
 
 
 normalize_http(Map, Port, Path) ->
-    M1 = normalize_port(Map, Port, 80),
+    M1 = normalize_default_port(Map, Port, 80),
     normalize_http_path(M1, Path).
 
 
 normalize_https(Map, Port, Path) ->
-    M1 = normalize_port(Map, Port, 443),
+    M1 = normalize_default_port(Map, Port, 443),
     normalize_http_path(M1, Path).
 
 
 normalize_ftp(Map, Port) ->
-    normalize_port(Map, Port, 21).
+    normalize_default_port(Map, Port, 21).
 
 
 normalize_ssh_sftp(Map, Port) ->
-    normalize_port(Map, Port, 22).
+    normalize_default_port(Map, Port, 22).
 
 
 normalize_tftp(Map, Port) ->
-    normalize_port(Map, Port, 69).
+    normalize_default_port(Map, Port, 69).
 
 
-normalize_port(Map, Port, Default) ->
+%% RFC 3986, 3.2.3.  Port
+%% RFC 3986, 6.2.3.  Scheme-Based Normalization
+normalize_default_port(Map, Port, Default) ->
     case Port of
         Default ->
             maps:remove(port, Map);
@@ -2387,6 +2390,12 @@ normalize_port(Map, Port, Default) ->
     end.
 
 
+normalize_undefined_port(#{port := undefined} = Map) ->
+    maps:remove(port, Map);
+normalize_undefined_port(#{} = Map) ->
+    Map.
+
+
 normalize_http_path(Map, Path) ->
     case Path of
         "" ->
diff --git a/lib/stdlib/test/uri_string_SUITE.erl b/lib/stdlib/test/uri_string_SUITE.erl
index 96e4a9d41b..04d7a23eab 100644
--- a/lib/stdlib/test/uri_string_SUITE.erl
+++ b/lib/stdlib/test/uri_string_SUITE.erl
@@ -587,18 +587,22 @@ parse_host_ipv6(_Config) ->
     {error,invalid_uri,"G"} = uri_string:parse("//[2001:0db8:0000:0000:0000:0000:1428:G7ab]").
 
 parse_port(_Config) ->
-    #{path:= "/:8042"} =
-        uri_string:parse("/:8042"),
-    #{host:= "", port := 8042} =
-        uri_string:parse("//:8042"),
-    #{host := "example.com", port:= 8042} =
-        uri_string:parse("//example.com:8042"),
-    #{scheme := "foo", path := "/:8042"} =
-        uri_string:parse("foo:/:8042"),
-    #{scheme := "foo", host := "", port := 8042} =
-        uri_string:parse("foo://:8042"),
-    #{scheme := "foo", host := "example.com", port := 8042} =
-        uri_string:parse("foo://example.com:8042").
+    parse_port_with_param("8042", 8042),
+    parse_port_with_param("", undefined).
+
+parse_port_with_param(PortString, Expected) ->
+    #{path:= "/:" ++ PortString} =
+        uri_string:parse("/:" ++ PortString),
+    #{host:= "", port := Expected} =
+        uri_string:parse("//:" ++ PortString),
+    #{host := "example.com", port:= Expected} =
+        uri_string:parse("//example.com:" ++ PortString),
+    #{scheme := "foo", path := "/:" ++ PortString} =
+        uri_string:parse("foo:/:" ++ PortString),
+    #{scheme := "foo", host := "", port := Expected} =
+        uri_string:parse("foo://:" ++ PortString),
+    #{scheme := "foo", host := "example.com", port := Expected} =
+        uri_string:parse("foo://example.com:" ++ PortString).
 
 parse_path(_Config) ->
     #{path := "over/there"} = uri_string:parse("over/there"),
@@ -1016,7 +1020,19 @@ normalize(_Config) ->
     <<"tftp://localhost">> =
         uri_string:normalize(<<"tftp://localhost:69">>),
     <<"/foo/%2F/bar">> =
-        uri_string:normalize(<<"/foo/%2f/%62ar">>).
+        uri_string:normalize(<<"/foo/%2f/%62ar">>),
+    <<"https://localhost/">> =
+        uri_string:normalize(<<"https://localhost">>),
+    <<"https://localhost/">> =
+        uri_string:normalize(<<"https://localhost/">>),
+    <<"https://localhost/">> =
+        uri_string:normalize(<<"https://localhost:/">>),
+    <<"https://localhost/">> =
+        uri_string:normalize(<<"https://localhost:">>),
+    <<"yeti://localhost/">> =
+        uri_string:normalize(<<"yeti://localhost:/">>),
+    <<"yeti://localhost">> =
+        uri_string:normalize(<<"yeti://localhost:">>).
 
 normalize_map(_Config) ->
     "/a/g" = uri_string:normalize(#{path => "/a/b/c/./../../g"}),
@@ -1047,7 +1063,13 @@ normalize_map(_Config) ->
         uri_string:normalize(#{scheme => <<"tftp">>,port => 69,path => <<>>,
                                host => <<"localhost">>}),
     "/foo/%2F/bar" =
-        uri_string:normalize(#{path => "/foo/%2f/%62ar"}).
+        uri_string:normalize(#{path => "/foo/%2f/%62ar"}),
+    <<"https://localhost/">> =
+        uri_string:normalize(#{scheme => <<"https">>,port => undefined,path => <<>>,
+                               host => <<"localhost">>}),
+    <<"yeti://localhost">> =
+        uri_string:normalize(#{scheme => <<"yeti">>,port => undefined,path => <<>>,
+                               host => <<"localhost">>}).
 
 normalize_return_map(_Config) ->
     #{scheme := "http",path := "/a/g",host := "localhost-örebro"} =
-- 
2.31.1

openSUSE Build Service is sponsored by