Merge branch 'peterdmv/inets/autoredirect/ERL-333/OTP-14729'

* peterdmv/inets/autoredirect/ERL-333/OTP-14729:
  inets: Add support for URI-references in Location

2 files changed, 199 insertions, 62 deletions

diff --git a/lib/inets/src/http_client/httpc_response.erl b/lib/inets/src/http_client/httpc_response.erl
index 91638f5d2e..58ab9144df 100644
--- a/lib/inets/src/http_client/httpc_response.erl
+++ b/lib/inets/src/http_client/httpc_response.erl
@@ -190,7 +190,7 @@ parse_status_code(<<?CR, ?LF, Rest/binary>>, StatusCodeStr,
 		  MaxHeaderSize, Result, true) ->
     parse_headers(Rest, [], [], MaxHeaderSize,
  		  [" ", list_to_integer(lists:reverse(
-				     string:strip(StatusCodeStr))) 
+                                          string:trim(StatusCodeStr)))
 		   | Result], true); 
 
 parse_status_code(<<?SP, Rest/binary>>, StatusCodeStr, 
@@ -377,58 +377,173 @@ status_server_error_50x(Response, Request) ->
     {stop, {Request#request.id, Msg}}.
 
 
-redirect(Response = {StatusLine, Headers, Body}, Request) ->
+redirect(Response = {_, Headers, _}, Request) ->
     {_, Data} =  format_response(Response),
     case Headers#http_response_h.location of
-	undefined ->
-	    transparent(Response, Request);
-	RedirUrl ->
-	    UrlParseOpts = [{ipv6_host_with_brackets, 
-			     Request#request.ipv6_host_with_brackets}], 
-	    case uri_parse(RedirUrl, UrlParseOpts) of
-		{error, no_scheme} when
-		(Request#request.settings)#http_options.relaxed ->
-		    NewLocation = fix_relative_uri(Request, RedirUrl),
-		    redirect({StatusLine, Headers#http_response_h{
-					    location = NewLocation},
-			      Body}, Request);
-		{error, Reason} ->
-		    {ok, error(Request, Reason), Data};
-		%% Automatic redirection
-		{ok, {Scheme, _, Host, Port, Path,  Query}} -> 
-		    HostPort = http_request:normalize_host(Scheme, Host, Port),
-		    NewHeaders = 
-			(Request#request.headers)#http_request_h{host = HostPort},
-		    NewRequest = 
-			Request#request{redircount = 
-					Request#request.redircount+1,
-					scheme = Scheme,
-					headers = NewHeaders,
-					address = {Host,Port},
-					path = Path,
-					pquery = Query,
-					abs_uri =
-					atom_to_list(Scheme) ++ "://" ++
-                                        Host ++ ":" ++ 
-					integer_to_list(Port) ++
-					Path ++ Query},
-		    {redirect, NewRequest, Data}
-	    end
+        undefined ->
+            transparent(Response, Request);
+        RedirUrl ->
+            Brackets = Request#request.ipv6_host_with_brackets,
+            case uri_string:parse(RedirUrl) of
+                {error, Reason, _} ->
+                    {ok, error(Request, Reason), Data};
+                %% Automatic redirection
+                URI ->
+                    {Host, Port0} = Request#request.address,
+                    Port = maybe_to_integer(Port0),
+                    Path = Request#request.path,
+                    Scheme = atom_to_list(Request#request.scheme),
+                    Query = Request#request.pquery,
+                    URIMap = resolve_uri(Scheme, Host, Port, Path, Query, URI),
+                    TScheme = list_to_atom(maps:get(scheme, URIMap)),
+                    THost = http_util:maybe_add_brackets(maps:get(host, URIMap), Brackets),
+                    TPort = maps:get(port, URIMap),
+                    TPath = maps:get(path, URIMap),
+                    TQuery = maps:get(query, URIMap, ""),
+                    NewURI = uri_string:normalize(
+                               uri_string:recompose(URIMap)),
+                    HostPort = http_request:normalize_host(TScheme, THost, TPort),
+                    NewHeaders =
+                        (Request#request.headers)#http_request_h{host = HostPort},
+                    NewRequest =
+                        Request#request{redircount =
+                                            Request#request.redircount+1,
+                                        scheme = TScheme,
+                                        headers = NewHeaders,
+                                        address = {THost,TPort},
+                                        path = TPath,
+                                        pquery = TQuery,
+                                        abs_uri = NewURI},
+                    {redirect, NewRequest, Data}
+            end
+    end.
+
+
+%% RFC3986 - 5.2.2.  Transform References
+resolve_uri(Scheme, Host, Port, Path, Query, URI) ->
+    resolve_uri(Scheme, Host, Port, Path, Query, URI, #{}).
+%%
+resolve_uri(Scheme, Host, Port, Path, Query, URI, Map0) ->
+    case maps:is_key(scheme, URI) of
+        true ->
+            Port = get_port(URI),
+            maybe_add_query(
+              Map0#{scheme => maps:get(scheme, URI),
+                   host => maps:get(host, URI),
+                   port => Port,
+                   path => maps:get(path, URI)},
+              URI);
+        false ->
+            Map = Map0#{scheme => Scheme},
+            resolve_authority(Host, Port, Path, Query, URI, Map)
+    end.
+
+
+get_port(URI) ->
+    Scheme = maps:get(scheme, URI),
+    case maps:get(port, URI, undefined) of
+        undefined ->
+            get_default_port(Scheme);
+        Port ->
+            Port
+    end.
+
+
+get_default_port("http") ->
+    80;
+get_default_port("https") ->
+    443.
+
+
+resolve_authority(Host, Port, Path, Query, RelURI, Map) ->
+    case maps:is_key(host, RelURI) of
+        true ->
+            Port = get_port(RelURI),
+            maybe_add_query(
+              Map#{host => maps:get(host, RelURI),
+                   port => Port,
+                   path => maps:get(path, RelURI)},
+              RelURI);
+        false ->
+            Map1 = Map#{host => Host,
+                    port => Port},
+            resolve_path(Path, Query, RelURI, Map1)
+    end.
+
+
+maybe_add_query(Map, RelURI) ->
+     case maps:is_key(query, RelURI) of
+         true ->
+             Map#{query => maps:get(query, RelURI)};
+         false ->
+             Map
+         end.
+
+
+resolve_path(Path, Query, RelURI, Map) ->
+    case maps:is_key(path, RelURI) of
+        true ->
+            Path1 = calculate_path(Path,  maps:get(path, RelURI)),
+            maybe_add_query(
+              Map#{path => Path1},
+              RelURI);
+        false ->
+            Map1 = Map#{path => Path},
+            resolve_query(Query, RelURI, Map1)
+    end.
+
+
+calculate_path(BaseP, RelP) ->
+    case starts_with_slash(RelP) of
+        true ->
+            RelP;
+        false ->
+            merge_paths(BaseP, RelP)
+    end.
+
+
+starts_with_slash([$/|_]) ->
+    true;
+starts_with_slash(<<$/,_/binary>>) ->
+    true;
+starts_with_slash(_) ->
+    false.
+
+
+%% RFC3986 - 5.2.3.  Merge Paths
+merge_paths("", RelP) ->
+    [$/|RelP];
+merge_paths(BaseP, RelP) when is_list(BaseP) ->
+    do_merge_paths(lists:reverse(BaseP), RelP);
+merge_paths(BaseP, RelP) when is_binary(BaseP) ->
+    B = binary_to_list(BaseP),
+    R = binary_to_list(RelP),
+    Res = merge_paths(B, R),
+    list_to_binary(Res).
+
+
+do_merge_paths([$/|_] = L, RelP) ->
+    lists:reverse(L) ++ RelP;
+do_merge_paths([_|T], RelP) ->
+    do_merge_paths(T, RelP).
+
+
+resolve_query(Query, RelURI, Map) ->
+    case maps:is_key(query, RelURI) of
+        true ->
+            Map#{query => maps:get(query, RelURI)};
+        false ->
+            Map#{query => Query}
     end.
 
-maybe_to_list(Port) when is_integer(Port) ->
-    integer_to_list(Port);
-maybe_to_list(Port) when is_list(Port) ->
+
+maybe_to_integer(Port) when is_list(Port) ->
+    {Port1, _} = string:to_integer(Port),
+    Port1;
+maybe_to_integer(Port) when is_integer(Port) ->
     Port.
 
-%%% Guessing that we received a relative URI, fix it to become an absoluteURI
-fix_relative_uri(Request, RedirUrl) ->
-    {Server, Port0} = Request#request.address,
-    Port = maybe_to_list(Port0),
-    Path = Request#request.path,
-    atom_to_list(Request#request.scheme) ++ "://" ++ Server ++ ":" ++ Port
-	++ Path ++ RedirUrl.
-    
+
 error(#request{id = Id}, Reason) ->
     {Id, {error, Reason}}.
 
@@ -478,18 +593,3 @@ format_response({StatusLine, Headers, Body}) ->
 		{Body, <<>>}
 	end,
     {{StatusLine, http_response:header_list(Headers), NewBody}, Data}.
-
-%%--------------------------------------------------------------------------
-%% These functions is just simple wrappers to parse specifically HTTP URIs
-%%--------------------------------------------------------------------------
-
-scheme_defaults() ->
-    [{http, 80}, {https, 443}].
-
-uri_parse(URI, Opts) ->
-    http_uri:parse(URI, [{scheme_defaults, scheme_defaults()} | Opts]).
-
-
-%%--------------------------------------------------------------------------
-
-
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index 954787d7ee..e0e0c6b6e5 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -128,6 +128,7 @@ only_simulated() ->
      redirect_found,
      redirect_see_other,
      redirect_temporary_redirect,
+     redirect_relative_uri,
      port_in_host_header,
      redirect_port_in_host_header,
      relaxed,
@@ -586,7 +587,26 @@ redirect_temporary_redirect(Config) when is_list(Config) ->
     {ok, {{_,200,_}, [_ | _], [_|_]}}
 	= httpc:request(post, {URL307, [],"text/plain", "foobar"},
 			[], []).
+%%-------------------------------------------------------------------------
+redirect_relative_uri() ->
+    [{doc, "The server SHOULD generate a Location header field in the response "
+      "containing a preferred URI reference for the new permanent URI.  The user "
+      "agent MAY use the Location field value for automatic redirection.  The server's "
+      "response payload usually contains a short hypertext note with a "
+      "hyperlink to the new URI(s)."}].
+redirect_relative_uri(Config) when is_list(Config) ->
+
+    URL301 = url(group_name(Config), "/301_rel_uri.html", Config),
+
+    {ok, {{_,200,_}, [_ | _], [_|_]}}
+	= httpc:request(get, {URL301, []}, [], []),
 
+    {ok, {{_,200,_}, [_ | _], []}}
+	= httpc:request(head, {URL301, []}, [], []),
+
+    {ok, {{_,200,_}, [_ | _], [_|_]}}
+	= httpc:request(post, {URL301, [],"text/plain", "foobar"},
+			[], []).
 %%-------------------------------------------------------------------------
 redirect_loop() ->
     [{"doc, Test redirect loop detection"}].
@@ -1790,6 +1810,23 @@ handle_uri(_,"/301.html",Port,_,Socket,_) ->
 	"Content-Length:" ++ integer_to_list(length(Body))
 	++ "\r\n\r\n" ++ Body;
 
+
+handle_uri("HEAD","/301_rel_uri.html",_,_,_,_) ->
+    NewUri = "/dummy.html",
+    "HTTP/1.1 301 Moved Permanently\r\n" ++
+	"Location:" ++ NewUri ++  "\r\n" ++
+	"Content-Length:0\r\n\r\n";
+
+handle_uri(_,"/301_rel_uri.html",_,_,_,_) ->
+    NewUri = "/dummy.html",
+  Body = "<HTML><BODY><a href=" ++ NewUri ++
+	">New place</a></BODY></HTML>",
+    "HTTP/1.1 301 Moved Permanently\r\n" ++
+	"Location:" ++ NewUri ++  "\r\n" ++
+	"Content-Length:" ++ integer_to_list(length(Body))
+	++ "\r\n\r\n" ++ Body;
+
+
 handle_uri("HEAD","/302.html",Port,_,Socket,_) ->
     NewUri = url_start(Socket) ++
 	integer_to_list(Port) ++ "/dummy.html",