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