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

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

1 files changed, 162 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]).
-
-
-%%--------------------------------------------------------------------------
-
-