Skip to content

Use lhttpc instead of httpc #13

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 6 commits into
base: master
Choose a base branch
from
Open

Use lhttpc instead of httpc #13

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
2c95671
Set permanent UPnP lease when required
benoitc Jan 18, 2019
eac093e
add a comment to the code
benoitc Jan 18, 2019
6b6dee6
fix error parsing
benoitc Jan 18, 2019
37e98a3
return infinity for permanent leases
benoitc Jan 18, 2019
b78177a
Use lhttpc instead of httpc
zp-sd Jan 15, 2019
1b5597e
Use lhttpc instead of httpc
zp-sd Jan 15, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion rebar.config
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"}
]}.


Expand Down
2 changes: 2 additions & 0 deletions rebar.lock
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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">>}]}
].
2 changes: 1 addition & 1 deletion src/nat.app.src
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"}]},
Expand Down
4 changes: 2 additions & 2 deletions src/nat.erl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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) ->
Expand All @@ -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) ->
Expand Down
16 changes: 7 additions & 9 deletions src/nat_lib.erl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,22 +24,20 @@ 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
Copy link

@lucafavatella lucafavatella Jan 16, 2019

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Provided that the caller passes a profile not used by concurrent requests, would avoiding to place the httpc process in the supervisor solve the issue? Requires somehow determining profile to use in httpc call.

Refs:

Snippet:

httpc_request(Method, Request, HTTPOptions, Options, Profile) ->
    {ok, Pid} = inets:start(httpc, [{profile, Profile}], stand_alone),
    Response = httpc:request(Method, Request, HTTPOptions, Options, Pid),
    ok = gen_server:stop(Pid, normal, infinity),
    Response.

Past usages that may be referred to:

{ok, {{_, 200, _}, _, Body}} ->
{ok, Body};
OK = {ok, {{_, Status, _}, _, _}} ->
case lhttpc:request(Url, post, Headers, Msg, 5000, Options) of
{ok, {{200, _}, _, Body}} ->
{ok, binary_to_list(Body)};
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), binary_to_list(Body)}};
Error ->
Error
end.
Expand Down
54 changes: 43 additions & 11 deletions src/natupnp_v1.erl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -145,8 +145,10 @@ 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) when is_integer(Lifetime), Lifetime >= 0 ->
Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort),
Msg = "<u:AddPortMapping xmlns:u=\""
"urn:schemas-upnp-org:service:WANIPConnection:1\">"
Expand All @@ -164,14 +166,44 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort,
"</NewLeaseDuration></u:AddPortMapping>",
{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 = Lifetime - (Now - Start),
MappingLifetime = if
Lifetime > 0 ->
Lifetime - (Now - Start);
true ->
infinity
end,
{ok, Now, InternalPort, ExternalPort, 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(),
Expand All @@ -187,7 +219,7 @@ delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort,
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"</u:DeletePortMapping>",
{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.
Expand All @@ -207,7 +239,7 @@ get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) ->
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"</u:GetSpecificPortMappingEntry>",
{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/"
Expand Down Expand Up @@ -281,17 +313,17 @@ 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" ->
get_wan_device(Device, RootUrl);
_ ->
{error, no_gateway_device}
end;
{ok, {{_, StatusCode, _}, _, _}} ->
{ok, {{StatusCode, _}, _, _}} ->
{error, integer_to_list(StatusCode)};
Error ->
Error
Expand Down
46 changes: 36 additions & 10 deletions src/natupnp_v2.erl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -151,8 +151,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) when is_integer(Lifetime), Lifetime >= 0 ->
Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort),
Msg = "<u:AddAnyPortMapping xmlns:u=\""
"urn:schemas-upnp-org:service:WANIPConnection:2\">"
Expand All @@ -170,7 +171,7 @@ add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}, Protocol, InternalPort,
"</NewLeaseDuration></u:AddPortMapping>",
{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}]),

Expand All @@ -185,9 +186,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(),
Expand All @@ -203,7 +229,7 @@ delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort,
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"</u:DeletePortMapping>",
{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.
Expand All @@ -224,7 +250,7 @@ get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) ->
"<NewProtocol>" ++ Protocol ++ "</NewProtocol>"
"</u:GetSpecificPortMappingEntry>",
{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/"
Expand Down Expand Up @@ -299,17 +325,17 @@ 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" ->
get_wan_device(Device, RootUrl);
_ ->
{error, no_gateway_device}
end;
{ok, {{_, StatusCode, _}, _, _}} ->
{ok, {{StatusCode, _}, _, _}} ->
{error, integer_to_list(StatusCode)};
Error ->
Error
Expand Down