From 2c956713b9b8c46c89207e54d75af47be20ea3cd Mon Sep 17 00:00:00 2001 From: Benoit Chesneau Date: Fri, 18 Jan 2019 11:30:31 +0100 Subject: [PATCH 1/6] Set permanent UPnP lease when required fix #14 --- src/nat_lib.erl | 4 ++-- src/natupnp_v1.erl | 29 ++++++++++++++++++++++++++--- 2 files changed, 28 insertions(+), 5 deletions(-) diff --git a/src/nat_lib.erl b/src/nat_lib.erl index d4283ce..84ed556 100644 --- a/src/nat_lib.erl +++ b/src/nat_lib.erl @@ -37,9 +37,9 @@ soap_request(Url, Function, Msg0, Options) -> case httpc:request(post, Req, [], Options) of {ok, {{_, 200, _}, _, Body}} -> {ok, Body}; - OK = {ok, {{_, Status, _}, _, _}} -> + OK = {ok, {{_, Status, _}, _, Body}} -> error_logger:info_msg("UPNP SOAP error: ~p~n", [OK]), - {error, integer_to_list(Status)}; + {error, {http_error, integer_to_list(Status), Body}}; Error -> Error end. diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index f44a57c..a5df6f6 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -145,8 +145,9 @@ random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> Tries -1) end. -add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort, - ExternalPort, Lifetime) -> + +add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, + Protocol, InternalPort, ExternalPort, Lifetime) -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" @@ -169,9 +170,31 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort, Now = nat_lib:timestamp(), MappingLifetime = Lifetime - (Now - Start), {ok, Now, InternalPort, ExternalPort, MappingLifetime}; - Error -> Error + Error when Lifetime > 0 -> + case only_permanent_lease_supported(Error) of + true -> + error_logger:info_msg("UPNP: only permanent lease supported~n", []), + add_port_mapping1(NatCtx, Protocol, InternalPort, ExternalPort, 0); + false -> + Error + end; + Error -> + Error end. +only_permanent_lease_supported({error, {http_error, 500, Body}}) -> + {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + [Error | _] = xmerl_xpath:string("//s:Envelope/s:Body/s:Fault/detail" + "UPnPError", Xml), + ErrorCode = extract_txt( + xmerl_xpath:string("errorCode/text()", Error) + ), + + case ErrorCode of + "725" -> true; + _ -> false + end. + %% @doc Delete a port mapping from the router -spec delete_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), InternalPort :: integer(), From eac093ef1c40e0cf35c4b5e1babfd5dfa6ea2b40 Mon Sep 17 00:00:00 2001 From: Benoit Chesneau Date: Fri, 18 Jan 2019 11:32:33 +0100 Subject: [PATCH 2/6] add a comment to the code --- src/natupnp_v1.erl | 1 + 1 file changed, 1 insertion(+) diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index a5df6f6..d838729 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -171,6 +171,7 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, MappingLifetime = Lifetime - (Now - Start), {ok, Now, InternalPort, ExternalPort, MappingLifetime}; Error when Lifetime > 0 -> + %% Try to repair error code 725 - OnlyPermanentLeasesSupported case only_permanent_lease_supported(Error) of true -> error_logger:info_msg("UPNP: only permanent lease supported~n", []), From 6b6dee60e3e00dd6109bb5e459300a2a27295a0f Mon Sep 17 00:00:00 2001 From: Benoit Chesneau Date: Fri, 18 Jan 2019 12:11:25 +0100 Subject: [PATCH 3/6] fix error parsing test path on amplifi router --- src/natupnp_v1.erl | 8 +++++--- src/natupnp_v2.erl | 31 ++++++++++++++++++++++++++++--- 2 files changed, 33 insertions(+), 6 deletions(-) diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index d838729..5f9e411 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -183,9 +183,9 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, Error end. -only_permanent_lease_supported({error, {http_error, 500, Body}}) -> +only_permanent_lease_supported({error, {http_error, "500", Body}}) -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), - [Error | _] = xmerl_xpath:string("//s:Envelope/s:Body/s:Fault/detail" + [Error | _] = xmerl_xpath:string("//s:Envelope/s:Body/s:Fault/detail/" "UPnPError", Xml), ErrorCode = extract_txt( xmerl_xpath:string("errorCode/text()", Error) @@ -194,7 +194,9 @@ only_permanent_lease_supported({error, {http_error, 500, Body}}) -> case ErrorCode of "725" -> true; _ -> false - end. + end; +only_permanent_lease_supported(_) -> + false. %% @doc Delete a port mapping from the router -spec delete_port_mapping(Context :: nat:nat_upnp(), diff --git a/src/natupnp_v2.erl b/src/natupnp_v2.erl index dbafcfc..4a1a5df 100644 --- a/src/natupnp_v2.erl +++ b/src/natupnp_v2.erl @@ -151,8 +151,8 @@ random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> Tries -1) end. -add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort, - ExternalPort, Lifetime) -> +add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url} = NatCtx, + Protocol, InternalPort, ExternalPort, Lifetime) -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" @@ -185,9 +185,34 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort, Now = nat_lib:timestamp(), MappingLifetime = Lifetime - (Now - Start), {ok, Now, InternalPort, list_to_integer(ReservedPort), MappingLifetime}; - Error -> Error + Error when Lifetime > 0 -> + %% Try to repair error code 725 - OnlyPermanentLeasesSupported + case only_permanent_lease_supported(Error) of + true -> + error_logger:info_msg("UPNP: only permanent lease supported~n", []), + add_port_mapping1(NatCtx, Protocol, InternalPort, ExternalPort, 0); + false -> + Error + end; + Error -> + Error end. +only_permanent_lease_supported({error, {http_error, "500", Body}}) -> + {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + [Error | _] = xmerl_xpath:string("//s:Envelope/s:Body/s:Fault/detail/" + "UPnPError", Xml), + ErrorCode = extract_txt( + xmerl_xpath:string("errorCode/text()", Error) + ), + + case ErrorCode of + "725" -> true; + _ -> false + end; +only_permanent_lease_supported(_) -> + false. + %% @doc Delete a port mapping from the router -spec delete_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), InternalPort :: integer(), From 37e98a3728381aae713728af7eb64f2c30f0fd8b Mon Sep 17 00:00:00 2001 From: Benoit Chesneau Date: Fri, 18 Jan 2019 12:17:59 +0100 Subject: [PATCH 4/6] return infinity for permanent leases --- src/nat.erl | 4 ++-- src/natupnp_v1.erl | 10 ++++++++-- src/natupnp_v2.erl | 3 ++- 3 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/nat.erl b/src/nat.erl index d97ad52..2db64f2 100644 --- a/src/nat.erl +++ b/src/nat.erl @@ -85,7 +85,7 @@ get_internal_address({Mod, Ctx}) -> ExternalPortRequest :: non_neg_integer(), Since :: non_neg_integer(), ExternalPort :: non_neg_integer(), - MappingLifetime :: non_neg_integer(), + MappingLifetime :: non_neg_integer() | infinity, Reason :: any() | timeout. %% @doc add a port mapping with default lifetime add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> @@ -102,7 +102,7 @@ add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> Lifetime :: non_neg_integer(), Since :: non_neg_integer(), ExternalPort :: non_neg_integer(), - MappingLifetime :: non_neg_integer(), + MappingLifetime :: non_neg_integer() | infinity, Reason :: any() | timeout(). %% @doc add a port mapping add_port_mapping({Mod, Ctx}, Protocol, InternalPort, ExternalPort, Lifetime) -> diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index 5f9e411..3a14521 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -147,7 +147,8 @@ random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, - Protocol, InternalPort, ExternalPort, Lifetime) -> + Protocol, InternalPort, ExternalPort, + Lifetime) when is_integer(Lifetime), Lifetime >= 0 -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" @@ -168,7 +169,12 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, case nat_lib:soap_request(Url, "AddPortMapping", Msg, [{socket_opts, [{ip, IAddr}]}]) of {ok, _} -> Now = nat_lib:timestamp(), - MappingLifetime = Lifetime - (Now - Start), + MappingLifetime = if + Lifetime > 0 -> + Lifetime - (Now - Start); + true -> + infinity + end, {ok, Now, InternalPort, ExternalPort, MappingLifetime}; Error when Lifetime > 0 -> %% Try to repair error code 725 - OnlyPermanentLeasesSupported diff --git a/src/natupnp_v2.erl b/src/natupnp_v2.erl index 4a1a5df..3151909 100644 --- a/src/natupnp_v2.erl +++ b/src/natupnp_v2.erl @@ -152,7 +152,8 @@ random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> end. add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url} = NatCtx, - Protocol, InternalPort, ExternalPort, Lifetime) -> + Protocol, InternalPort, ExternalPort, + Lifetime) when is_integer(Lifetime), Lifetime >= 0 -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" From b78177a045d123be11cc0a781b91c9602e9d47cb Mon Sep 17 00:00:00 2001 From: zp-sd Date: Tue, 15 Jan 2019 10:34:55 +0100 Subject: [PATCH 5/6] Use lhttpc instead of httpc * Aviod a crash in http_transport:close/2, happening when setting socket_opts in httpc in OTP 20.1. The fix for the bug is included in OTP 21 - https://bugs.erlang.org/browse/ERL-605. * Avoid crash report when httpc_handler_sup is killing its children after unsuccessful httpc:request/1 function call. It happens in some router softwares, with miniupnpd daemon installed, but UPnP/NAT-PMP functionality turned off. Then, during natupnp_v1/natupnp_v2 discovery, location is returned, but is it not responding (hence httpc:request/1 crash). --- rebar.config | 3 ++- rebar.lock | 2 ++ src/nat.app.src | 2 +- src/nat_lib.erl | 10 ++++------ src/natupnp_v1.erl | 14 +++++++------- src/natupnp_v2.erl | 14 +++++++------- 6 files changed, 23 insertions(+), 22 deletions(-) diff --git a/rebar.config b/rebar.config index 5d12704..b4f15f6 100644 --- a/rebar.config +++ b/rebar.config @@ -9,7 +9,8 @@ rand_compat, {inet_cidr, "1.0.1", {pkg, erl_cidr}}, {inet_ext, "0.4.0"}, - {intercept, "1.0.0"} + {intercept, "1.0.0"}, + {lhttpc, "1.6.2"} ]}. diff --git a/rebar.lock b/rebar.lock index 2bd2813..4a91765 100644 --- a/rebar.lock +++ b/rebar.lock @@ -2,11 +2,13 @@ [{<<"inet_cidr">>,{pkg,<<"erl_cidr">>,<<"1.0.1">>},0}, {<<"inet_ext">>,{pkg,<<"inet_ext">>,<<"0.4.0">>},0}, {<<"intercept">>,{pkg,<<"intercept">>,<<"1.0.0">>},0}, + {<<"lhttpc">>,{pkg,<<"lhttpc">>,<<"1.6.2">>},0}, {<<"rand_compat">>,{pkg,<<"rand_compat">>,<<"0.0.3">>},0}]}. [ {pkg_hash,[ {<<"inet_cidr">>, <<"9EA93F2B885820C1C3ADEC24E7AB5B04AAD829FBF7B3F8F41F1ACD4550D8BF97">>}, {<<"inet_ext">>, <<"EF51FE5EA13DB6B40CBA48E66D9117BBD31E5A4347FA432B83D0C0547C7AB522">>}, {<<"intercept">>, <<"1F6C725E6FC070720643BD4D97EE53B1209365C80E520E1F5A1ACB36712A7EB5">>}, + {<<"lhttpc">>, <<"044F16F0018C7AA7E945E9E9406C7F6035E0B8BC08BF77B00C78CE260E1071E3">>}, {<<"rand_compat">>, <<"011646BC1F0B0C432FE101B816F25B9BBB74A085713CEE1DAFD2D62E9415EAD3">>}]} ]. diff --git a/src/nat.app.src b/src/nat.app.src index c7975d5..95e8654 100644 --- a/src/nat.app.src +++ b/src/nat.app.src @@ -3,7 +3,7 @@ {vsn, "0.3.1"}, {modules, []}, {registered, []}, - {applications, [kernel,stdlib,inet_cidr,inet_ext,inets,xmerl,rand_compat]}, + {applications, [kernel,stdlib,inet_cidr,inet_ext,inets,xmerl,rand_compat,lhttpc]}, {maintainers, ["Benoit Chesneau"]}, {licenses, ["MIT"]}, {links, [{"Github", "https://github.com/benoitc/erlang-nat"}]}, diff --git a/src/nat_lib.erl b/src/nat_lib.erl index 84ed556..5beef97 100644 --- a/src/nat_lib.erl +++ b/src/nat_lib.erl @@ -24,19 +24,17 @@ soap_request(Url, Function, Msg0, Options) -> Action = "\"urn:schemas-upnp-org:service:WANIPConnection:1#" ++ Function ++ "\"", - Headers = [{"Content-Length", integer_to_list(length(Msg))}, + Headers = [{"Content-Type", "text/xml; charset=\"utf-8\""}, + {"Content-Length", integer_to_list(length(Msg))}, {"User-Agent", "Darwin/10.0.0, UPnP/1.0, MiniUPnPc/1.3"}, {"SOAPAction", Action}, {"Connection", "close"}, {"Cache-Control", "no-cache"}, {"Pragma", "no-cache"}], - - Req = {Url, Headers, "text/xml; charset=\"utf-8\"", Msg}, - - case httpc:request(post, Req, [], Options) of + case lhttpc:request(Url, post, Headers, Msg, 5000, Options)of {ok, {{_, 200, _}, _, Body}} -> - {ok, Body}; + {ok, binary_to_list(Body)}; OK = {ok, {{_, Status, _}, _, Body}} -> error_logger:info_msg("UPNP SOAP error: ~p~n", [OK]), {error, {http_error, integer_to_list(Status), Body}}; diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index 3a14521..0c27fc0 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -166,7 +166,7 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, "", {ok, IAddr} = inet:parse_address(Ip), Start = nat_lib:timestamp(), - case nat_lib:soap_request(Url, "AddPortMapping", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "AddPortMapping", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, _} -> Now = nat_lib:timestamp(), MappingLifetime = if @@ -219,7 +219,7 @@ delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, "" ++ Protocol ++ "" "", {ok, IAddr} = inet:parse_address(Ip), - case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, _} -> ok; Error -> Error end. @@ -239,7 +239,7 @@ get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) -> "" ++ Protocol ++ "" "", {ok, IAddr} = inet:parse_address(Ip), - case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" @@ -313,9 +313,9 @@ get_location(Raw) -> end. get_service_url(RootUrl) -> - case httpc:request(RootUrl) of - {ok, {{_, 200, _}, _, Body}} -> - {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + case lhttpc:request(RootUrl, get, [], 5000) of + {ok, {{200, _}, _, Body}} -> + {Xml, _} = xmerl_scan:string(binary_to_list(Body), [{space, normalize}]), [Device | _] = xmerl_xpath:string("//device", Xml), case device_type(Device) of "urn:schemas-upnp-org:device:InternetGatewayDevice:1" -> @@ -323,7 +323,7 @@ get_service_url(RootUrl) -> _ -> {error, no_gateway_device} end; - {ok, {{_, StatusCode, _}, _, _}} -> + {ok, {{StatusCode, _}, _, _}} -> {error, integer_to_list(StatusCode)}; Error -> Error diff --git a/src/natupnp_v2.erl b/src/natupnp_v2.erl index 3151909..8bc4621 100644 --- a/src/natupnp_v2.erl +++ b/src/natupnp_v2.erl @@ -171,7 +171,7 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url} = NatCtx, "", {ok, IAddr} = inet:parse_address(Ip), Start = nat_lib:timestamp(), - case nat_lib:soap_request(Url, "AddAnyPortMapping", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "AddAnyPortMapping", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -229,7 +229,7 @@ delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, "" ++ Protocol ++ "" "", {ok, IAddr} = inet:parse_address(Ip), - case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, _} -> ok; Error -> Error end. @@ -250,7 +250,7 @@ get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) -> "" ++ Protocol ++ "" "", {ok, IAddr} = inet:parse_address(Ip), - case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [{socket_opts, [{ip, IAddr}]}]) of + case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [{connect_options, [{ip, IAddr}]}]) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" @@ -325,9 +325,9 @@ get_location(Raw) -> end. get_service_url(RootUrl) -> - case httpc:request(RootUrl) of - {ok, {{_, 200, _}, _, Body}} -> - {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + case lhttpc:request(RootUrl, get, [], 5000) of + {ok, {{200, _}, _, Body}} -> + {Xml, _} = xmerl_scan:string(binary_to_list(Body), [{space, normalize}]), [Device | _] = xmerl_xpath:string("//device", Xml), case device_type(Device) of "urn:schemas-upnp-org:device:InternetGatewayDevice:2" -> @@ -335,7 +335,7 @@ get_service_url(RootUrl) -> _ -> {error, no_gateway_device} end; - {ok, {{_, StatusCode, _}, _, _}} -> + {ok, {{StatusCode, _}, _, _}} -> {error, integer_to_list(StatusCode)}; Error -> Error From 1b5597e05627725f51bf71c06393375199365272 Mon Sep 17 00:00:00 2001 From: zp-sd Date: Tue, 15 Jan 2019 10:34:55 +0100 Subject: [PATCH 6/6] Use lhttpc instead of httpc * Aviod a crash in http_transport:close/2, happening when setting socket_opts in httpc in OTP 20.1. The fix for the bug is included in OTP 21 - https://bugs.erlang.org/browse/ERL-605. * Avoid crash report when httpc_handler_sup is killing its children after unsuccessful httpc:request/1 function call. It happens in some router softwares, with miniupnpd daemon installed, but UPnP/NAT-PMP functionality turned off. Then, during natupnp_v1/natupnp_v2 discovery, location is returned, but is it not responding (hence httpc:request/1 crash). --- src/nat_lib.erl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/nat_lib.erl b/src/nat_lib.erl index 5beef97..573b486 100644 --- a/src/nat_lib.erl +++ b/src/nat_lib.erl @@ -32,12 +32,12 @@ soap_request(Url, Function, Msg0, Options) -> {"Cache-Control", "no-cache"}, {"Pragma", "no-cache"}], - case lhttpc:request(Url, post, Headers, Msg, 5000, Options)of - {ok, {{_, 200, _}, _, Body}} -> + case lhttpc:request(Url, post, Headers, Msg, 5000, Options) of + {ok, {{200, _}, _, Body}} -> {ok, binary_to_list(Body)}; - OK = {ok, {{_, Status, _}, _, Body}} -> + OK = {ok, {{Status, _}, _, Body}} -> error_logger:info_msg("UPNP SOAP error: ~p~n", [OK]), - {error, {http_error, integer_to_list(Status), Body}}; + {error, {http_error, integer_to_list(Status), binary_to_list(Body)}}; Error -> Error end.