diff --git a/src/nat.app.src b/src/nat.app.src index c7975d5..0e386b2 100644 --- a/src/nat.app.src +++ b/src/nat.app.src @@ -3,6 +3,7 @@ {vsn, "0.3.1"}, {modules, []}, {registered, []}, + {mod, {nat_app, []}}, {applications, [kernel,stdlib,inet_cidr,inet_ext,inets,xmerl,rand_compat]}, {maintainers, ["Benoit Chesneau"]}, {licenses, ["MIT"]}, diff --git a/src/nat.erl b/src/nat.erl index 2db64f2..54d7b1a 100644 --- a/src/nat.erl +++ b/src/nat.erl @@ -6,19 +6,35 @@ -module(nat). +-behaviour(gen_server). + +%% API -export([discover/0]). -export([get_device_address/1]). -export([get_external_address/1]). -export([get_internal_address/1]). -export([add_port_mapping/4, add_port_mapping/5]). +-export([maintain_port_mapping/4]). -export([delete_port_mapping/4]). + + +%% Debug API +-export([get_httpc_profile/0]). -export([debug_start/1]). -export([debug_stop/0]). --include("nat.hrl"). +%% gen_server API +-export([start_link/0]). --define(BACKENDS, [natupnp_v1, natupnp_v2, natpmp]). --define(DISCOVER_TIMEOUT, 10000). +%% gen_server callbacks +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). + +-include("nat.hrl"). -type nat_ctx() :: any(). -type nat_protocol() :: tcp | udp. @@ -26,30 +42,21 @@ -export_type([nat_ctx/0, nat_protocol/0]). --spec debug_start(string()) -> ok. -debug_start(File) -> - {ok, _} = nat_cache:start([{file, File}]), - ok = intercept:add(gen_udp, gen_udp_intercepts, [{{send, 4}, send}]), - ok = intercept:add(httpc, httpc_intercepts, [{{request, 1}, request}, {{request, 4}, request}]), - ok = intercept:add(inet_ext, inet_ext_intercepts, [{{get_internal_address, 1}, get_internal_address}]). +-define(BACKENDS, [natupnp_v1, natupnp_v2, natpmp]). +-define(DISCOVER_TIMEOUT, 10000). --spec debug_stop() -> ok. -debug_stop() -> - ok = intercept:clean(gen_udp), - ok = intercept:clean(httpc), - ok = intercept:clean(inet_ext), - ok = nat_cache:stop(). +-define(SERVER, ?MODULE). + +%%%=================================================================== +%%% API +%%%=================================================================== -spec discover() -> {ok, NatCtx} | no_nat when NatCtx :: nat_ctx(). %% @doc discover a NAT gateway and return a context that can be used with -%% othe functions. +%% other functions. discover() -> - _ = application:start(inets), - Self = self(), - Ref = make_ref(), - Workers = spawn_workers(?BACKENDS, Self, Ref, []), - discover_loop(Workers, Ref). + gen_server:call(?SERVER, discover, 50000). -spec get_device_address(NatCtx) -> {ok, DeviceIp} | {error, Reason} when NatCtx :: nat_ctx(), @@ -57,7 +64,7 @@ discover() -> Reason :: any(). %% @doc get the IP address of the gateway. get_device_address({Mod, Ctx}) -> - Mod:get_device_address(Ctx). + gen_server:call(?SERVER, {get_device_address, Mod, Ctx}, 50000). -spec get_external_address(NatCtx) -> {ok, ExternalIp} | {error, Reason} when NatCtx :: nat_ctx(), @@ -65,7 +72,7 @@ get_device_address({Mod, Ctx}) -> Reason :: any(). %% @doc return the external address of the gateway device get_external_address({Mod, Ctx}) -> - Mod:get_external_address(Ctx). + gen_server:call(?SERVER, {get_external_address, Mod, Ctx}, 50000). -spec get_internal_address(NatCtx) -> {ok, InternalIp} | {error, Reason} when NatCtx :: nat_ctx(), @@ -73,12 +80,11 @@ get_external_address({Mod, Ctx}) -> Reason :: any(). %% @doc return the address address of the local device get_internal_address({Mod, Ctx}) -> - Mod:get_internal_address(Ctx). - + gen_server:call(?SERVER, {get_internal_address, Mod, Ctx}, 50000). -spec add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) -> - {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} - when + {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} + when NatCtx :: nat_ctx(), Protocol :: nat_protocol(), InternalPort :: non_neg_integer(), @@ -89,12 +95,12 @@ get_internal_address({Mod, Ctx}) -> Reason :: any() | timeout. %% @doc add a port mapping with default lifetime add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> - add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort, - ?RECOMMENDED_MAPPING_LIFETIME_SECONDS). + gen_server:call(?SERVER, + {add_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS}, 50000). -spec add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest, Lifetime) -> - {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} - when + {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} + when NatCtx :: nat_ctx(), Protocol :: nat_protocol(), InternalPort :: non_neg_integer(), @@ -105,24 +111,178 @@ add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> MappingLifetime :: non_neg_integer() | infinity, Reason :: any() | timeout(). %% @doc add a port mapping -add_port_mapping({Mod, Ctx}, Protocol, InternalPort, ExternalPort, Lifetime) -> - Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, Lifetime). +add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort, Lifetime) -> + gen_server:call(?SERVER, + {add_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort, Lifetime}, 50000). +-spec maintain_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) -> + {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} + when + NatCtx :: nat_ctx(), + Protocol :: nat_protocol(), + InternalPort :: non_neg_integer(), + ExternalPortRequest :: non_neg_integer(), + MappingLifetime :: non_neg_integer() | infinity, + Since :: non_neg_integer(), + ExternalPort :: non_neg_integer(), + Reason :: any() | timeout. +%% @doc maintain a port mapping +maintain_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> + gen_server:call(?SERVER, + {maintain_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort}, 50000). -spec delete_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) -> - ok | {error, Reason} - when + ok | {error, Reason} + when NatCtx :: nat_ctx(), Protocol :: nat_protocol(), InternalPort :: non_neg_integer(), ExternalPortRequest :: non_neg_integer(), Reason :: any() | timeout. %% @doc delete a port mapping -delete_port_mapping({Mod, Ctx}, Protocol, InternalPort, ExternalPort) -> - Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort). +delete_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) -> + gen_server:call(?SERVER, + {delete_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort}, 50000). + +%%%=================================================================== +%%% Debug API +%%%=================================================================== + +-spec get_httpc_profile() -> pid(). +get_httpc_profile() -> + gen_server:call(?SERVER, get_httpc_profile). + +-spec debug_start(string()) -> ok. +debug_start(File) -> + {ok, _} = nat_cache:start([{file, File}]), + ok = intercept:add(gen_udp, gen_udp_intercepts, [{{send, 4}, send}]), + ok = intercept:add(httpc, httpc_intercepts, [{{request, 1}, request}, {{request, 4}, request}]), + ok = intercept:add(inet_ext, inet_ext_intercepts, [{{get_internal_address, 1}, get_internal_address}]). + +-spec debug_stop() -> ok. +debug_stop() -> + ok = intercept:clean(gen_udp), + ok = intercept:clean(httpc), + ok = intercept:clean(inet_ext), + ok = nat_cache:stop(). +%%%=================================================================== +%%% Gen server API +%%%=================================================================== + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +%%%=================================================================== +%%% gen_server callbacks +%%%=================================================================== + +init(_Args) -> + error_logger:info_msg("Starting UPnP/NAT-PMP service"), + _ = rand_compat:seed(erlang:phash2([node()]), + erlang:monotonic_time(), + erlang:unique_integer()), + {ok, Profile} = inets:start(httpc, [{profile, nat}], stand_alone), + State = #state{httpc_profile = Profile}, + erlang:send_after(rand:uniform(1000), self(), renew_port_mappings), + {ok, State}. + +handle_call(discover, _From, #state{httpc_profile = HttpcProfile} = State) -> + Result = do_discover(HttpcProfile), + {reply, Result, State}; +handle_call({get_device_address, Mod, Ctx}, _From, State) -> + {reply, Mod:get_device_address(Ctx), State}; +handle_call({get_external_address, Mod, Ctx}, _From, #state{httpc_profile = HttpcProfile} = State) -> + {reply, Mod:get_external_address(Ctx, HttpcProfile), State}; +handle_call({get_internal_address, Mod, Ctx}, _From, State) -> + {reply, Mod:get_internal_address(Ctx), State}; +handle_call({add_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort, Lifetime}, + _From, #state{httpc_profile = HttpcProfile} = State) -> + {reply, Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile), State}; +handle_call({maintain_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort}, + _From, #state{httpc_profile = HttpcProfile, mappings = Mappings0} = State0) -> + Response = Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS, HttpcProfile), + case Response of + {ok, _Since, InternalPort, ExternalPort, _MappingLifetime} -> + State = #state{mappings = [{Protocol, InternalPort, ExternalPort} | Mappings0]}, + {reply, Response, State}; + {error, _Reason} = Error-> + {reply, Error, State0} + end; +handle_call({delete_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort}, + _From, #state{httpc_profile = HttpcProfile, mappings = Mappings0} = State0) -> + State = State0#state{mappings = lists:delete({Protocol, InternalPort, ExternalPort}, Mappings0)}, + {reply, Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, HttpcProfile), State}; +handle_call(get_httpc_profile, _From, #state{httpc_profile = HttpcProfile} = State) -> + {reply, HttpcProfile, State}; +handle_call(Request, _From, State) -> + error_logger:warning_msg("Received unknown request: ~p", [Request]), + {reply, ok, State}. + +handle_cast(Other, State) -> + error_logger:warning_msg("Received unknown cast: ~p", [Other]), + {noreply, State}. + +handle_info(renew_port_mappings, #state{mappings = []} = State) -> + %% Give additional 10 secs for UPnP/NAT-PMP discovery and setup, to + %% make sure there is continuity in port mapping. + erlang:send_after(1000 * (?RECOMMENDED_MAPPING_LIFETIME_SECONDS - 10), self(), renew_port_mappings), + {noreply, State}; +handle_info(renew_port_mappings, #state{mappings = Mappings, httpc_profile = HttpcProfile} = State) -> + case do_discover(HttpcProfile) of + {ok, {Mod, Ctx}} -> + lists:foreach( + fun({Protocol, InternalPort, ExternalPort}) -> + case Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS, HttpcProfile) of + {ok, _Since, _InternalPort, _ExternalPort, _MappingLifetime} -> + ok; + {error, _Reason} = Error -> + error_logger:warning_msg("UPnP/NAT-PMP mapping renewal between ~p and ~p failed: ~p", + [InternalPort, ExternalPort, Error]) + end + end, Mappings); + no_nat -> + error_logger:warning_msg("UPnP/NAT-PMP discovery failed during lease renewal") + end, + %% Give additional 10 secs for UPnP/NAT-PMP discovery and setup, to + %% make sure there is continuity in port mapping. + erlang:send_after(1000 * (?RECOMMENDED_MAPPING_LIFETIME_SECONDS - 10), self(), renew_port_mappings), + {noreply, State}; +handle_info(Other, State) -> + error_logger:warning_msg("Received unknown info message: ~p", [Other]), + {noreply, State}. + +terminate(_Reason, #state{httpc_profile = HttpcProfile, mappings = Mappings}) when is_pid(HttpcProfile) -> + case do_discover(HttpcProfile) of + {ok, {Mod, Ctx}} -> + lists:foreach( + fun({Protocol, InternalPort, ExternalPort}) -> + case Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, HttpcProfile) of + ok -> ok; + {error, _Reason} = Error -> + error_logger:warning_msg("UPnP/NAT-PMP mapping removal between ~p and ~p failed: ~p", + [InternalPort, ExternalPort, Error]) + end + end, Mappings); + no_nat -> + error_logger:warning_msg("UPnP/NAT-PMP discovery failed during mappings removal") + end, + gen_server:stop(HttpcProfile, normal, infinity), + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +%%%=================================================================== +%%% Internal functions +%%%=================================================================== + +do_discover(HttpcProfile) -> + Self = self(), + Ref = make_ref(), + Workers = spawn_workers(?BACKENDS, HttpcProfile, Self, Ref, []), + discover_loop(Workers, Ref). -%% internals discover_loop([], _Ref) -> no_nat; discover_loop(Workers, Ref) -> @@ -140,21 +300,20 @@ discover_loop(Workers, Ref) -> no_nat end. - -discover_worker(Backend, Parent, Ref) -> - case Backend:discover() of +discover_worker(Backend, HttpcProfile, Parent, Ref) -> + case Backend:discover(HttpcProfile) of {ok, Ctx} -> Parent ! {nat, Ref, self(), {Backend, Ctx}}; _Error -> ok end. -spawn_workers([], _Parent, _Ref, Workers) -> +spawn_workers([], _HttpcProfile, _Parent, _Ref, Workers) -> Workers; -spawn_workers([Backend | Rest], Parent, Ref, Acc) -> - Pid = spawn_link(fun() -> discover_worker(Backend, Parent, Ref) end), +spawn_workers([Backend | Rest], HttpcProfile, Parent, Ref, Acc) -> + Pid = spawn_link(fun() -> discover_worker(Backend, HttpcProfile, Parent, Ref) end), monitor_worker(Pid), - spawn_workers(Rest, Parent, Ref, [Pid | Acc]). + spawn_workers(Rest, HttpcProfile, Parent, Ref, [Pid | Acc]). monitor_worker(Pid) -> MRef = erlang:monitor(process, Pid), diff --git a/src/nat.hrl b/src/nat.hrl index 251e766..0687cee 100644 --- a/src/nat.hrl +++ b/src/nat.hrl @@ -1,8 +1,16 @@ -define(NAT_TRIES, 5). -define(NAT_INITIAL_MS, 250). +%% Port mapping lifetime in seconds. +%% NAT-PMP RFC (https://tools.ietf.org/html/rfc6886) recommends to set it +%% to 7200 seconds (two hours). No recommendation for UPnP found. -define(RECOMMENDED_MAPPING_LIFETIME_SECONDS, 7200). -record(nat_upnp, { service_url, ip}). + +-record(state, { + mappings = [], + httpc_profile + }). diff --git a/src/nat_app.erl b/src/nat_app.erl new file mode 100644 index 0000000..577578c --- /dev/null +++ b/src/nat_app.erl @@ -0,0 +1,13 @@ +-module(nat_app). + +-behaviour(application). + +-export([start/2, + stop/1]). + +%% Application callbacks +start(_StartType, _StartArgs) -> + nat_sup:start_link(). + +stop(_State) -> + ok. diff --git a/src/nat_lib.erl b/src/nat_lib.erl index 84ed556..cbe06f9 100644 --- a/src/nat_lib.erl +++ b/src/nat_lib.erl @@ -7,14 +7,32 @@ -module(nat_lib). -compile(nowarn_deprecated_function). --export([soap_request/3, soap_request/4]). +-export([http_get/2]). +-export([http_request/5]). +-export([soap_request/4, soap_request/5]). -export([random_port/0]). -export([timestamp/0]). -soap_request(Url, Function, Msg0) -> - soap_request(Url, Function, Msg0, []). +http_get(RootUrl, HttpcProfile) -> + http_request(get, {RootUrl, []}, [{timeout, 5000}], [], HttpcProfile). -soap_request(Url, Function, Msg0, Options) -> +http_post(Req, HttpOptions, HttpcProfile) -> + http_request(post, Req, [{timeout, 5000}], HttpOptions, HttpcProfile). + +http_request(Method, Req, ReqOptions, HttpOptions, HttpcProfile) -> + ReturnPid = self(), + Pid = proc_lib:spawn(fun() -> ReturnPid ! httpc:request(Method, Req, ReqOptions, HttpOptions, HttpcProfile) end), + receive + Response -> Response + after 7000 -> + exit(Pid, no_response_from_httpc_client), + {error, httpc_client_timeout} + end. + +soap_request(Url, Function, Msg0, HttpcProfile) -> + soap_request(Url, Function, Msg0, [], HttpcProfile). + +soap_request(Url, Function, Msg0, Options, HttpcProfile) -> Msg = "" " Req = {Url, Headers, "text/xml; charset=\"utf-8\"", Msg}, - case httpc:request(post, Req, [], Options) of + case http_post(Req, Options, HttpcProfile) of {ok, {{_, 200, _}, _, Body}} -> {ok, Body}; OK = {ok, {{_, Status, _}, _, Body}} -> diff --git a/src/nat_scan.erl b/src/nat_scan.erl index 0f5ada7..e83a6a1 100644 --- a/src/nat_scan.erl +++ b/src/nat_scan.erl @@ -29,9 +29,11 @@ start() -> ok = intercept:add(httpc, httpc_intercepts, [{{request, 1}, request}, {{request, 4}, request}]), ok = intercept:add(inet_ext, inet_ext_intercepts, [{{get_internal_address, 1}, get_internal_address}]), - _ = natupnp_v1(), - _ = natupnp_v2(), - _ = natpmp(), + {ok, HttpcProfile} = inets:start(httpc, [{profile, nat}], stand_alone), + _ = natupnp_v1(HttpcProfile), + _ = natupnp_v2(HttpcProfile), + _ = natpmp(HttpcProfile), + gen_server:stop(HttpcProfile, normal, infinity), ok = intercept:clean(gen_udp), ok = intercept:clean(httpc), @@ -39,13 +41,13 @@ start() -> nat_cache:stop(). -natupnp_v1() -> +natupnp_v1(HttpcProfile) -> ?LOG("[natupnp_v1] discovering", []), case natupnp_v1:discover() of {ok, Context} -> ?LOG("[natupnp_v1] discovered ~p", [Context]), - case natupnp_v1:add_port_mapping(Context, tcp, 8333, 8333, 3600) of + case natupnp_v1:add_port_mapping(Context, tcp, 8333, 8333, 3600, HttpcProfile) of {ok, _Since, _InternalPort, _ExternalPort, _MappingLifetime}=OK -> ?LOG("[natupnp_v1] added port mapping ~p", [OK]), case natupnp_v1:delete_port_mapping(Context, tcp, 8333, 8333) of @@ -73,13 +75,13 @@ natupnp_v1() -> ?LOG("[natupnp_v1] failed to discover ~p", [_Reason]) end. -natupnp_v2() -> +natupnp_v2(HttpcProfile) -> ?LOG("[natupnp_v2] discovering", []), case natupnp_v2:discover() of {ok, Context} -> ?LOG("[natupnp_v2] discovered ~p", [Context]), - case natupnp_v2:add_port_mapping(Context, tcp, 8333, 8333, 3600) of + case natupnp_v2:add_port_mapping(Context, tcp, 8333, 8333, 3600, HttpcProfile) of {ok, _Since, _InternalPort, _ExternalPort, _MappingLifetime}=OK -> ?LOG("[natupnp_v2] added port mapping ~p", [OK]), case natupnp_v2:delete_port_mapping(Context, tcp, 8333, 8333) of @@ -107,13 +109,13 @@ natupnp_v2() -> ?LOG("[natupnp_v2] failed to discover ~p", [_Reason]) end. -natpmp() -> +natpmp(HttpcProfile) -> ?LOG("[natpmp] discovering", []), case natpmp:discover() of {ok, Context} -> ?LOG("[natpmp] discovered ~p", [Context]), - case natpmp:add_port_mapping(Context, tcp, 8333, 8333, 3600) of + case natpmp:add_port_mapping(Context, tcp, 8333, 8333, 3600, HttpcProfile) of {ok, _Since, _InternalPort, _ExternalPort, _MappingLifetime}=OK -> ?LOG("[natpmp] added port mapping ~p", [OK]), case natpmp:delete_port_mapping(Context, tcp, 8333, 8333) of diff --git a/src/nat_sup.erl b/src/nat_sup.erl new file mode 100644 index 0000000..1b4d95d --- /dev/null +++ b/src/nat_sup.erl @@ -0,0 +1,16 @@ +-module(nat_sup). + +-behaviour(supervisor). + +-export([start_link/0]). +-export([init/1]). + +-spec start_link() -> {ok, pid()}. +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +init([]) -> + Workers = + [{nat, {nat, start_link, []}, + permanent, 5000, worker, [nat]}], + {ok, {{one_for_one, 1, 5}, Workers}}. diff --git a/src/natpmp.erl b/src/natpmp.erl index 319df73..c8b8d82 100644 --- a/src/natpmp.erl +++ b/src/natpmp.erl @@ -7,11 +7,11 @@ -module(natpmp). -export([get_device_address/1]). --export([get_external_address/1]). +-export([get_external_address/2]). -export([get_internal_address/1]). --export([discover/0]). --export([add_port_mapping/4, add_port_mapping/5]). --export([delete_port_mapping/4]). +-export([discover/1]). +-export([add_port_mapping/6]). +-export([delete_port_mapping/5]). -include("nat.hrl"). @@ -35,11 +35,12 @@ get_device_address(Gateway) -> {ok, Gateway}. %% @doc get external ip --spec get_external_address(Gateway) -> {ok, ExternalIp} | {error, Reason} when +-spec get_external_address(Gateway, HttpcProfile) -> {ok, ExternalIp} | {error, Reason} when Gateway :: inet:ip_address() | inet:hostname(), + HttpcProfile :: pid(), ExternalIp :: inet:ip_address() | inet:hostname(), Reason :: natpmp_error(). -get_external_address(Gateway) -> +get_external_address(Gateway, _HttpcProfile) -> Msg = << 0, 0 >>, nat_rpc(Gateway, Msg, 0). @@ -50,8 +51,8 @@ get_external_address(Gateway) -> get_internal_address(Gateway) -> {ok, inet_ext:get_internal_address(Gateway)}. -discover_with_addr(Parent, Ref, Addr) -> - case (catch natpmp:get_external_address(Addr)) of +discover_with_addr(Parent, Ref, Addr, HttpcProfile) -> + case (catch natpmp:get_external_address(Addr, HttpcProfile)) of {ok, _Ip} -> Parent ! {nat, Ref, self(), Addr}; _Else -> @@ -84,9 +85,10 @@ system_gateways() -> [Ip || {_, Ip} <- inet_ext:gateways()]. %% @doc discover a Nat gateway --spec discover() -> {ok, Gateway} | {error, any()} when +-spec discover(HttpcProfile) -> {ok, Gateway} | {error, any()} when + HttpcProfile :: pid(), Gateway :: inet:ip_address(). -discover() -> +discover(HttpcProfile) -> IPs = case system_gateways() of [] -> potential_gateways(); Gateways -> Gateways @@ -97,7 +99,7 @@ discover() -> Workers = lists:foldl(fun(Ip, Acc) -> Pid = spawn_link(fun() -> - discover_with_addr(Self, Ref, Ip) + discover_with_addr(Self, Ref, Ip, HttpcProfile) end), erlang:monitor(process, Pid), [Pid | Acc] @@ -123,25 +125,8 @@ discover_wait(Workers, Ref) -> end. - -%% @doc add a port mapping with default lifetime --spec add_port_mapping(Gateway, Protocol, InternalPort, ExternalPortRequest) -> - {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} - when - Gateway :: inet:ip_address() | inet:hostname(), - Protocol :: tcp | udp, - InternalPort :: non_neg_integer(), - ExternalPortRequest :: non_neg_integer(), - Since :: non_neg_integer(), - ExternalPort :: non_neg_integer(), - MappingLifetime :: non_neg_integer(), - Reason :: natpmp_error(). -add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort) -> - add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, - ?RECOMMENDED_MAPPING_LIFETIME_SECONDS). - %% @doc add a port mapping --spec add_port_mapping(Gateway, Protocol, InternalPort, ExternalPortRequest, Lifetime) -> +-spec add_port_mapping(Gateway, Protocol, InternalPort, ExternalPortRequest, Lifetime, HttpcProfile) -> {ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason} when Gateway :: inet:ip_address() | inet:hostname(), @@ -149,11 +134,12 @@ add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort) -> InternalPort :: non_neg_integer(), ExternalPortRequest :: non_neg_integer(), Lifetime :: non_neg_integer(), + HttpcProfile :: pid(), Since :: non_neg_integer(), ExternalPort :: non_neg_integer(), MappingLifetime :: non_neg_integer(), Reason :: natpmp_error(). -add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, Lifetime) -> +add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, Lifetime, _HttpcProfile) -> OpCode = case Protocol of udp -> 1; tcp -> 2; @@ -171,16 +157,17 @@ add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, Lifetime) -> %% @doc delete a port mapping --spec delete_port_mapping(Gateway, Protocol, InternalPort, ExternalPortRequest) -> +-spec delete_port_mapping(Gateway, Protocol, InternalPort, ExternalPortRequest, HttpcProfile) -> ok | {error, Reason} when Gateway :: inet:ip_address() | inet:hostname(), Protocol :: tcp | udp, InternalPort :: non_neg_integer(), ExternalPortRequest :: non_neg_integer(), + HttpcProfile :: pid(), Reason :: natpmp_error(). -delete_port_mapping(Gateway, Protocol, InternalPort, ExternalPort) -> - case add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, 0) of +delete_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, HttpcProfile) -> + case add_port_mapping(Gateway, Protocol, InternalPort, ExternalPort, 0, HttpcProfile) of {ok, _, InternalPort, 0, 0} -> ok; {ok, _, _, _, _} -> {error, bad_response}; Error -> Error @@ -194,7 +181,6 @@ delete_port_mapping(Gateway, Protocol, InternalPort, ExternalPort) -> %% nat_rpc(Gateway0, Msg, OpCode) -> - _ = application:start(inets), Gateway = inet_ext:parse_address(Gateway0), {ok, Sock} = gen_udp:open(0, [{active, once}, inet, binary]), try diff --git a/src/natupnp_v1.erl b/src/natupnp_v1.erl index 3a14521..0adad32 100644 --- a/src/natupnp_v1.erl +++ b/src/natupnp_v1.erl @@ -10,26 +10,22 @@ -module(natupnp_v1). --export([discover/0]). +-export([discover/1]). -export([get_device_address/1]). --export([get_external_address/1]). +-export([get_external_address/2]). -export([get_internal_address/1]). --export([add_port_mapping/4, add_port_mapping/5]). --export([delete_port_mapping/4]). --export([get_port_mapping/3]). --export([status_info/1]). +-export([add_port_mapping/6]). +-export([delete_port_mapping/5]). +-export([get_port_mapping/4]). +-export([status_info/2]). -include("nat.hrl"). -include_lib("xmerl/include/xmerl.hrl"). %% @doc discover the gateway and our IP to associate --spec discover() -> {ok, Context:: nat:nat_upnp()} +-spec discover(HttpcProfile :: pid()) -> {ok, Context:: nat:nat_upnp()} | {error, term()}. -discover() -> - _ = application:start(inets), - _ = rand_compat:seed(erlang:phash2([node()]), - erlang:monotonic_time(), - erlang:unique_integer()), +discover(HttpcProfile) -> {ok, Sock} = gen_udp:open(0, [{active, once}, inet, binary]), ST = <<"urn:schemas-upnp-org:device:InternetGatewayDevice:1" >>, @@ -42,15 +38,15 @@ discover() -> "\r\n\r\n">>], try - discover1(Sock, iolist_to_binary(MSearch), 3) + discover1(Sock, iolist_to_binary(MSearch), HttpcProfile, 3) after gen_udp:close(Sock) end. -discover1(_Sock, _MSearch, ?NAT_TRIES) -> +discover1(_Sock, _MSearch, _HttpcProfile, ?NAT_TRIES) -> {error, timeout}; -discover1(Sock, MSearch, Tries) -> +discover1(Sock, MSearch, HttpcProfile, Tries) -> inet:setopts(Sock, [{active, once}]), Timeout = ?NAT_INITIAL_MS bsl Tries, ok = gen_udp:send(Sock, "239.255.255.250", 1900, MSearch), @@ -58,9 +54,9 @@ discover1(Sock, MSearch, Tries) -> {udp, _Sock, Ip, _Port, Packet} -> case get_location(Packet) of error -> - discover1(Sock, MSearch, Tries-1); + discover1(Sock, MSearch, HttpcProfile, Tries-1); Location -> - case get_service_url(binary_to_list(Location)) of + case get_service_url(binary_to_list(Location), HttpcProfile) of {ok, Url} -> MyIp = inet_ext:get_internal_address(Ip), {ok, #nat_upnp{service_url=Url, ip=MyIp}}; @@ -69,7 +65,7 @@ discover1(Sock, MSearch, Tries) -> end end after Timeout -> - discover1(Sock, MSearch, Tries+1) + discover1(Sock, MSearch, HttpcProfile, Tries+1) end. @@ -88,11 +84,11 @@ get_device_address(#nat_upnp{service_url=Url}) -> end. -get_external_address(#nat_upnp{service_url=Url}) -> +get_external_address(#nat_upnp{service_url=Url}, HttpcProfile) -> Message = "" "", - case nat_lib:soap_request(Url, "GetExternalIPAddress", Message) of + case nat_lib:soap_request(Url, "GetExternalIPAddress", Message, HttpcProfile) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -112,43 +108,35 @@ get_external_address(#nat_upnp{service_url=Url}) -> get_internal_address(#nat_upnp{ip=Ip}) -> {ok, Ip}. - -%% @doc Add a port mapping with default lifetime to 0 seconds --spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(), integer(), integer()) -> - {ok, non_neg_integer(), non_neg_integer(), non_neg_integer(), non_neg_integer()} | {error, any()}. -add_port_mapping(Context, Protocol, InternalPort, ExternalPort) -> - add_port_mapping(Context, Protocol, InternalPort, ExternalPort, - ?RECOMMENDED_MAPPING_LIFETIME_SECONDS). - %% @doc Add a port mapping and release after Timeout --spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(),integer(), integer(), integer()) -> +-spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(),integer(), integer(), integer(), pid()) -> {ok, non_neg_integer(), non_neg_integer(), non_neg_integer(), non_neg_integer()} | {error, any()}. -add_port_mapping(Ctx, Protocol0, InternalPort, ExternalPort, Lifetime) -> +add_port_mapping(Ctx, Protocol0, InternalPort, ExternalPort, Lifetime, HttpcProfile) -> Protocol = protocol(Protocol0), case ExternalPort of 0 -> - random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, nil, 3); + random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, nil, HttpcProfile, 3); _ -> - add_port_mapping1(Ctx,Protocol, InternalPort, ExternalPort, Lifetime) + add_port_mapping1(Ctx,Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile) end. -random_port_mapping(_Ctx, _Protocol, _InternalPort, _Lifetime, Error, 0) -> +random_port_mapping(_Ctx, _Protocol, _InternalPort, _Lifetime, Error, _HttpcProfile, 0) -> Error; -random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> +random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, HttpcProfile, Tries) -> ExternalPort = nat_lib:random_port(), - Res = add_port_mapping1(Ctx, Protocol, InternalPort, ExternalPort, Lifetime), + Res = add_port_mapping1(Ctx, Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile), case Res of {ok, _, _, _, _} -> Res; Error -> - random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, Error, + random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, Error, HttpcProfile, Tries -1) end. add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url}=NatCtx, Protocol, InternalPort, ExternalPort, - Lifetime) when is_integer(Lifetime), Lifetime >= 0 -> + Lifetime, HttpcProfile) when is_integer(Lifetime), Lifetime >= 0 -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" @@ -166,28 +154,32 @@ 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 - {ok, _} -> - Now = nat_lib:timestamp(), - 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 - 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. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "AddPortMapping", Msg, [], HttpcProfile) of + {ok, _} -> + Now = nat_lib:timestamp(), + 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 + 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, HttpcProfile); + false -> + Error + end; + Error -> + Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. only_permanent_lease_supported({error, {http_error, "500", Body}}) -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -207,9 +199,9 @@ only_permanent_lease_supported(_) -> %% @doc Delete a port mapping from the router -spec delete_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), InternalPort :: integer(), - ExternalPort :: integer()) + ExternalPort :: integer(), HttpcProfile :: pid()) -> ok | {error, term()}. -delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, ExternalPort) -> +delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, ExternalPort, HttpcProfile) -> Protocol = protocol(Protocol0), Msg = "" @@ -219,17 +211,23 @@ 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 - {ok, _} -> ok; - Error -> Error - end. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [], HttpcProfile) of + {ok, _} -> ok; + Error -> Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. + %% @doc get specific port mapping for a well known port and protocol -spec get_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), - ExternalPort :: integer()) + ExternalPort :: integer(), + HttpcProfile :: pid()) -> {ok, InternalPort :: integer(), InternalAddress :: string()} | {error, any()}. -get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) -> +get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort, HttpcProfile) -> Protocol = protocol(Protocol0), Msg = "" @@ -239,39 +237,43 @@ 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 - {ok, Body} -> - {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), - [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" - "u:GetSpecificPortMappingEntryResponse", Xml), - NewInternalPort = - extract_txt( - xmerl_xpath:string("NewInternalPort/text()", - Infos) - ), - - NewInternalClient = - extract_txt( - xmerl_xpath:string("NewInternalClient/text()", - Infos) - ), - - {IPort, _ } = string:to_integer(NewInternalPort), - {ok, IPort, NewInternalClient}; - Error -> - Error - end. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [], HttpcProfile) of + {ok, Body} -> + {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" + "u:GetSpecificPortMappingEntryResponse", Xml), + NewInternalPort = + extract_txt( + xmerl_xpath:string("NewInternalPort/text()", + Infos) + ), + + NewInternalClient = + extract_txt( + xmerl_xpath:string("NewInternalClient/text()", + Infos) + ), + + {IPort, _ } = string:to_integer(NewInternalPort), + {ok, IPort, NewInternalClient}; + Error -> + Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. %% @doc get router status --spec status_info(Context :: nat:nat_upnp()) +-spec status_info(Context :: nat:nat_upnp(), HttpcProfile :: pid()) -> {Status::string(), LastConnectionError::string(), Uptime::string()} | {error, term()}. -status_info(#nat_upnp{service_url=Url}) -> +status_info(#nat_upnp{service_url=Url}, HttpcProfile) -> Message = "" "", - case nat_lib:soap_request(Url, "GetStatusInfo", Message) of + case nat_lib:soap_request(Url, "GetStatusInfo", Message, HttpcProfile) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -312,8 +314,8 @@ get_location(Raw) -> error end. -get_service_url(RootUrl) -> - case httpc:request(RootUrl) of +get_service_url(RootUrl, HttpcProfile) -> + case nat_lib:http_get(RootUrl, HttpcProfile) of {ok, {{_, 200, _}, _, Body}} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), [Device | _] = xmerl_xpath:string("//device", Xml), diff --git a/src/natupnp_v2.erl b/src/natupnp_v2.erl index 3151909..62f6dcf 100644 --- a/src/natupnp_v2.erl +++ b/src/natupnp_v2.erl @@ -10,27 +10,23 @@ -module(natupnp_v2). --export([discover/0]). +-export([discover/1]). -export([get_device_address/1]). --export([get_external_address/1]). +-export([get_external_address/2]). -export([get_internal_address/1]). --export([add_port_mapping/4, add_port_mapping/5]). --export([delete_port_mapping/4]). --export([get_port_mapping/3]). --export([status_info/1]). +-export([add_port_mapping/6]). +-export([delete_port_mapping/5]). +-export([get_port_mapping/4]). +-export([status_info/2]). -include("nat.hrl"). -include_lib("xmerl/include/xmerl.hrl"). %% @doc discover the gateway and our IP to associate --spec discover() -> {ok, Context:: nat:nat_upnp()} +-spec discover(HttpcProfile :: pid()) -> {ok, Context:: nat:nat_upnp()} | {error, term()}. -discover() -> - _ = application:start(inets), - _ = rand_compat:seed(erlang:phash2([node()]), - erlang:monotonic_time(), - erlang:unique_integer()), +discover(HttpcProfile) -> {ok, Sock} = gen_udp:open(0, [{active, once}, inet, binary]), ST = <<"urn:schemas-upnp-org:device:InternetGatewayDevice:2" >>, @@ -43,14 +39,14 @@ discover() -> "\r\n\r\n">>], try - discover1(Sock, iolist_to_binary(MSearch), 3) + discover1(Sock, iolist_to_binary(MSearch), HttpcProfile, 3) after gen_udp:close(Sock) end. -discover1(_Sock, _MSearch, ?NAT_TRIES) -> +discover1(_Sock, _MSearch, _HttpcProfile, ?NAT_TRIES) -> {error, timeout}; -discover1(Sock, MSearch, Tries) -> +discover1(Sock, MSearch, HttpcProfile, Tries) -> inet:setopts(Sock, [{active, once}]), Timeout = ?NAT_INITIAL_MS bsl Tries, ok = gen_udp:send(Sock, "239.255.255.250", 1900, MSearch), @@ -58,12 +54,12 @@ discover1(Sock, MSearch, Tries) -> {udp, _Sock, Ip, _Port, Packet} -> case get_location(Packet) of error -> - discover1(Sock, MSearch, Tries-1); + discover1(Sock, MSearch, HttpcProfile, Tries-1); Location -> - case get_service_url(binary_to_list(Location)) of + case get_service_url(binary_to_list(Location), HttpcProfile) of {ok, Url} -> MyIp = inet_ext:get_internal_address(Ip), - case get_natrsipstatus(Url) of + case get_natrsipstatus(Url, HttpcProfile) of enabled -> {ok, #nat_upnp{service_url=Url, ip=MyIp}}; disabled -> @@ -76,7 +72,7 @@ discover1(Sock, MSearch, Tries) -> end end after Timeout -> - discover1(Sock, MSearch, Tries+1) + discover1(Sock, MSearch, HttpcProfile, Tries+1) end. get_device_address(#nat_upnp{service_url=Url}) -> @@ -94,11 +90,11 @@ get_device_address(#nat_upnp{service_url=Url}) -> end. -get_external_address(#nat_upnp{service_url=Url}) -> +get_external_address(#nat_upnp{service_url=Url}, HttpcProfile) -> Message = "" "", - case nat_lib:soap_request(Url, "GetExternalIPAddress", Message) of + case nat_lib:soap_request(Url, "GetExternalIPAddress", Message, HttpcProfile) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -118,42 +114,34 @@ get_external_address(#nat_upnp{service_url=Url}) -> get_internal_address(#nat_upnp{ip=Ip}) -> {ok, Ip}. - -%% @doc Add a port mapping with default lifetime to 0 seconds --spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(), integer(), integer()) -> - {ok, non_neg_integer(), non_neg_integer(), non_neg_integer(), non_neg_integer()} | {error, any()}. -add_port_mapping(Context, Protocol, InternalPort, ExternalPort) -> - add_port_mapping(Context, Protocol, InternalPort, ExternalPort, - ?RECOMMENDED_MAPPING_LIFETIME_SECONDS). - %% @doc Add a port mapping and release after Timeout --spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(),integer(), integer(), integer()) -> +-spec add_port_mapping(nat:nat_upnp(), nat:nat_protocol(),integer(), integer(), integer(), pid()) -> {ok, non_neg_integer(), non_neg_integer(), non_neg_integer(), non_neg_integer()} | {error, any()}. -add_port_mapping(Ctx, Protocol0, InternalPort, ExternalPort, Lifetime) -> +add_port_mapping(Ctx, Protocol0, InternalPort, ExternalPort, Lifetime, HttpcProfile) -> Protocol = protocol(Protocol0), case ExternalPort of 0 -> - random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, nil, 3); + random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, nil, HttpcProfile, 3); _ -> - add_port_mapping1(Ctx,Protocol, InternalPort, ExternalPort, Lifetime) + add_port_mapping1(Ctx,Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile) end. -random_port_mapping(_Ctx, _Protocol, _InternalPort, _Lifetime, Error, 0) -> +random_port_mapping(_Ctx, _Protocol, _InternalPort, _Lifetime, Error, _HttpcProfile, 0) -> Error; -random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, Tries) -> +random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, _LastError, HttpcProfile, Tries) -> ExternalPort = nat_lib:random_port(), - Res = add_port_mapping1(Ctx, Protocol, InternalPort, ExternalPort, Lifetime), + Res = add_port_mapping1(Ctx, Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile), case Res of {ok, _, _, _, _} -> Res; Error -> - random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, Error, + random_port_mapping(Ctx, Protocol, InternalPort, Lifetime, Error, HttpcProfile, Tries -1) end. add_port_mapping1(#nat_upnp{ip=Ip, service_url=Url} = NatCtx, Protocol, InternalPort, ExternalPort, - Lifetime) when is_integer(Lifetime), Lifetime >= 0 -> + Lifetime, HttpcProfile) when is_integer(Lifetime), Lifetime >= 0 -> Description = Ip ++ "_" ++ Protocol ++ "_" ++ integer_to_list(InternalPort), Msg = "" @@ -171,33 +159,37 @@ 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 - {ok, Body} -> - {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), - - [Resp | _] = xmerl_xpath:string("//s:Envelope/s:Body/" - "u:AddAnyPortMappingResponse", Xml), - - ReservedPort = extract_txt( - xmerl_xpath:string("NewReservedPort/text()", - Resp) - ), - - Now = nat_lib:timestamp(), - MappingLifetime = Lifetime - (Now - Start), - {ok, Now, InternalPort, list_to_integer(ReservedPort), 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", []), - add_port_mapping1(NatCtx, Protocol, InternalPort, ExternalPort, 0); - false -> - Error - end; - Error -> - Error - end. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "AddAnyPortMapping", Msg, [], HttpcProfile) of + {ok, Body} -> + {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + + [Resp | _] = xmerl_xpath:string("//s:Envelope/s:Body/" + "u:AddAnyPortMappingResponse", Xml), + + ReservedPort = extract_txt( + xmerl_xpath:string("NewReservedPort/text()", + Resp) + ), + + Now = nat_lib:timestamp(), + MappingLifetime = Lifetime - (Now - Start), + {ok, Now, InternalPort, list_to_integer(ReservedPort), 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", []), + add_port_mapping1(NatCtx, Protocol, InternalPort, ExternalPort, 0, HttpcProfile); + false -> + Error + end; + Error -> + Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. only_permanent_lease_supported({error, {http_error, "500", Body}}) -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -217,9 +209,9 @@ only_permanent_lease_supported(_) -> %% @doc Delete a port mapping from the router -spec delete_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), InternalPort :: integer(), - ExternalPort :: integer()) + ExternalPort :: integer(), HttpcProfile :: pid()) -> ok | {error, term()}. -delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, ExternalPort) -> +delete_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, _InternalPort, ExternalPort, HttpcProfile) -> Protocol = protocol(Protocol0), Msg = "" @@ -229,18 +221,23 @@ 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 - {ok, _} -> ok; - Error -> Error - end. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "DeletePortMapping", Msg, [], HttpcProfile) of + {ok, _} -> ok; + Error -> Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. %% @doc get specific port mapping for a well known port and protocol -spec get_port_mapping(Context :: nat:nat_upnp(), Protocol :: nat:nat_protocol(), - ExternalPort :: integer()) + ExternalPort :: integer(), + HttpcProfile :: pid()) -> {ok, InternalPort :: integer(), InternalAddress :: string()} | {error, any()}. -get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort) -> +get_port_mapping(#nat_upnp{ip=Ip, service_url=Url}, Protocol0, ExternalPort, HttpcProfile) -> Protocol = protocol(Protocol0), Msg = "" @@ -250,40 +247,44 @@ 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 - {ok, Body} -> - {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), - [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" - "u:GetSpecificPortMappingEntryResponse", Xml), - NewInternalPort = - extract_txt( - xmerl_xpath:string("NewInternalPort/text()", - Infos) - ), - - NewInternalClient = - extract_txt( - xmerl_xpath:string("NewInternalClient/text()", - Infos) - ), - - {IPort, _ } = string:to_integer(NewInternalPort), - {ok, IPort, NewInternalClient}; - Error -> - Error - end. + ok = httpc:set_option(socket_opts, [{ip, IAddr}], HttpcProfile), + Result = + case nat_lib:soap_request(Url, "GetSpecificPortMappingEntry", Msg, [], HttpcProfile) of + {ok, Body} -> + {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), + [Infos | _] = xmerl_xpath:string("//s:Envelope/s:Body/" + "u:GetSpecificPortMappingEntryResponse", Xml), + NewInternalPort = + extract_txt( + xmerl_xpath:string("NewInternalPort/text()", + Infos) + ), + + NewInternalClient = + extract_txt( + xmerl_xpath:string("NewInternalClient/text()", + Infos) + ), + + {IPort, _ } = string:to_integer(NewInternalPort), + {ok, IPort, NewInternalClient}; + Error -> + Error + end, + ok = httpc:set_option(socket_opts, [], HttpcProfile), + Result. %% @doc get router status --spec status_info(Context :: nat:nat_upnp()) +-spec status_info(Context :: nat:nat_upnp(), HttpcProfile :: pid()) -> {Status::string(), LastConnectionError::string(), Uptime::string()} | {error, term()}. -status_info(#nat_upnp{service_url=Url}) -> +status_info(#nat_upnp{service_url=Url}, HttpcProfile) -> Message = "" "", - case nat_lib:soap_request(Url, "GetStatusInfo", Message) of + case nat_lib:soap_request(Url, "GetStatusInfo", Message, HttpcProfile) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), @@ -324,8 +325,8 @@ get_location(Raw) -> error end. -get_service_url(RootUrl) -> - case httpc:request(RootUrl) of +get_service_url(RootUrl, HttpcProfile) -> + case nat_lib:http_get(RootUrl, HttpcProfile) of {ok, {{_, 200, _}, _, Body}} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]), [Device | _] = xmerl_xpath:string("//device", Xml), @@ -341,11 +342,11 @@ get_service_url(RootUrl) -> Error end. -get_natrsipstatus(Url) -> +get_natrsipstatus(Url, HttpcProfile) -> Message = "" "", - case nat_lib:soap_request(Url, "GetNATRSIPStatus", Message) of + case nat_lib:soap_request(Url, "GetNATRSIPStatus", Message, HttpcProfile) of {ok, Body} -> {Xml, _} = xmerl_scan:string(Body, [{space, normalize}]),