Skip to content

Commit 996da5e

Browse files
zp-sdZbigniew Pękala
zp-sd
authored and
Zbigniew Pękala
committed
Introduce nat_app and use httpc profile
1 parent 99a0fb9 commit 996da5e

File tree

10 files changed

+383
-196
lines changed

10 files changed

+383
-196
lines changed

‎src/nat.app.src‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
{vsn, "0.3.1"},
44
{modules, []},
55
{registered, []},
6+
{mod, {nat_app, []}},
67
{applications, [kernel,stdlib,inet_cidr,inet_ext,inets,xmerl,rand_compat]},
78
{maintainers, ["Benoit Chesneau"]},
89
{licenses, ["MIT"]},

‎src/nat.erl‎

Lines changed: 204 additions & 45 deletions
Original file line numberDiff line numberDiff line change
@@ -6,79 +6,85 @@
66

77
-module(nat).
88

9+
-behaviour(gen_server).
10+
11+
%% API
912
-export([discover/0]).
1013
-export([get_device_address/1]).
1114
-export([get_external_address/1]).
1215
-export([get_internal_address/1]).
1316
-export([add_port_mapping/4, add_port_mapping/5]).
17+
-export([maintain_port_mapping/4]).
1418
-export([delete_port_mapping/4]).
19+
20+
21+
%% Debug API
22+
-export([get_httpc_profile/0]).
1523
-export([debug_start/1]).
1624
-export([debug_stop/0]).
1725

18-
-include("nat.hrl").
26+
%% gen_server API
27+
-export([start_link/0]).
1928

20-
-define(BACKENDS, [natupnp_v1, natupnp_v2, natpmp]).
21-
-define(DISCOVER_TIMEOUT, 10000).
29+
%% gen_server callbacks
30+
-export([init/1,
31+
handle_call/3,
32+
handle_cast/2,
33+
handle_info/2,
34+
terminate/2,
35+
code_change/3]).
36+
37+
-include("nat.hrl").
2238

2339
-type nat_ctx() :: any().
2440
-type nat_protocol() :: tcp | udp.
2541

2642
-export_type([nat_ctx/0,
2743
nat_protocol/0]).
2844

29-
-spec debug_start(string()) -> ok.
30-
debug_start(File) ->
31-
{ok, _} = nat_cache:start([{file, File}]),
32-
ok = intercept:add(gen_udp, gen_udp_intercepts, [{{send, 4}, send}]),
33-
ok = intercept:add(httpc, httpc_intercepts, [{{request, 1}, request}, {{request, 4}, request}]),
34-
ok = intercept:add(inet_ext, inet_ext_intercepts, [{{get_internal_address, 1}, get_internal_address}]).
45+
-define(BACKENDS, [natupnp_v1, natupnp_v2, natpmp]).
46+
-define(DISCOVER_TIMEOUT, 10000).
3547

36-
-spec debug_stop() -> ok.
37-
debug_stop() ->
38-
ok = intercept:clean(gen_udp),
39-
ok = intercept:clean(httpc),
40-
ok = intercept:clean(inet_ext),
41-
ok = nat_cache:stop().
48+
-define(SERVER, ?MODULE).
49+
50+
%%%===================================================================
51+
%%% API
52+
%%%===================================================================
4253

4354
-spec discover() -> {ok, NatCtx} | no_nat when
4455
NatCtx :: nat_ctx().
4556
%% @doc discover a NAT gateway and return a context that can be used with
46-
%% othe functions.
57+
%% other functions.
4758
discover() ->
48-
_ = application:start(inets),
49-
Self = self(),
50-
Ref = make_ref(),
51-
Workers = spawn_workers(?BACKENDS, Self, Ref, []),
52-
discover_loop(Workers, Ref).
59+
gen_server:call(?SERVER, discover, 50000).
5360

5461
-spec get_device_address(NatCtx) -> {ok, DeviceIp} | {error, Reason} when
5562
NatCtx :: nat_ctx(),
5663
DeviceIp :: string(),
5764
Reason :: any().
5865
%% @doc get the IP address of the gateway.
5966
get_device_address({Mod, Ctx}) ->
60-
Mod:get_device_address(Ctx).
67+
gen_server:call(?SERVER, {get_device_address, Mod, Ctx}, 50000).
6168

6269
-spec get_external_address(NatCtx) -> {ok, ExternalIp} | {error, Reason} when
6370
NatCtx :: nat_ctx(),
6471
ExternalIp :: string(),
6572
Reason :: any().
6673
%% @doc return the external address of the gateway device
6774
get_external_address({Mod, Ctx}) ->
68-
Mod:get_external_address(Ctx).
75+
gen_server:call(?SERVER, {get_external_address, Mod, Ctx}, 50000).
6976

7077
-spec get_internal_address(NatCtx) -> {ok, InternalIp} | {error, Reason} when
7178
NatCtx :: nat_ctx(),
7279
InternalIp :: string(),
7380
Reason :: any().
7481
%% @doc return the address address of the local device
7582
get_internal_address({Mod, Ctx}) ->
76-
Mod:get_internal_address(Ctx).
77-
83+
gen_server:call(?SERVER, {get_internal_address, Mod, Ctx}, 50000).
7884

7985
-spec add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) ->
80-
{ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason}
81-
when
86+
{ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason}
87+
when
8288
NatCtx :: nat_ctx(),
8389
Protocol :: nat_protocol(),
8490
InternalPort :: non_neg_integer(),
@@ -89,12 +95,12 @@ get_internal_address({Mod, Ctx}) ->
8995
Reason :: any() | timeout.
9096
%% @doc add a port mapping with default lifetime
9197
add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) ->
92-
add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort,
93-
?RECOMMENDED_MAPPING_LIFETIME_SECONDS).
98+
gen_server:call(?SERVER,
99+
{add_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS}, 50000).
94100

95101
-spec add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest, Lifetime) ->
96-
{ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason}
97-
when
102+
{ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason}
103+
when
98104
NatCtx :: nat_ctx(),
99105
Protocol :: nat_protocol(),
100106
InternalPort :: non_neg_integer(),
@@ -105,24 +111,178 @@ add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) ->
105111
MappingLifetime :: non_neg_integer() | infinity,
106112
Reason :: any() | timeout().
107113
%% @doc add a port mapping
108-
add_port_mapping({Mod, Ctx}, Protocol, InternalPort, ExternalPort, Lifetime) ->
109-
Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, Lifetime).
114+
add_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort, Lifetime) ->
115+
gen_server:call(?SERVER,
116+
{add_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort, Lifetime}, 50000).
110117

118+
-spec maintain_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) ->
119+
{ok, Since, InternalPort, ExternalPort, MappingLifetime} | {error, Reason}
120+
when
121+
NatCtx :: nat_ctx(),
122+
Protocol :: nat_protocol(),
123+
InternalPort :: non_neg_integer(),
124+
ExternalPortRequest :: non_neg_integer(),
125+
MappingLifetime :: non_neg_integer() | infinity,
126+
Since :: non_neg_integer(),
127+
ExternalPort :: non_neg_integer(),
128+
Reason :: any() | timeout.
129+
%% @doc maintain a port mapping
130+
maintain_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) ->
131+
gen_server:call(?SERVER,
132+
{maintain_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort}, 50000).
111133

112134
-spec delete_port_mapping(NatCtx, Protocol, InternalPort, ExternalPortRequest) ->
113-
ok | {error, Reason}
114-
when
135+
ok | {error, Reason}
136+
when
115137
NatCtx :: nat_ctx(),
116138
Protocol :: nat_protocol(),
117139
InternalPort :: non_neg_integer(),
118140
ExternalPortRequest :: non_neg_integer(),
119141
Reason :: any() | timeout.
120142
%% @doc delete a port mapping
121-
delete_port_mapping({Mod, Ctx}, Protocol, InternalPort, ExternalPort) ->
122-
Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort).
143+
delete_port_mapping(NatCtx, Protocol, InternalPort, ExternalPort) ->
144+
gen_server:call(?SERVER,
145+
{delete_port_mapping, NatCtx, Protocol, InternalPort, ExternalPort}, 50000).
146+
147+
%%%===================================================================
148+
%%% Debug API
149+
%%%===================================================================
150+
151+
-spec get_httpc_profile() -> pid().
152+
get_httpc_profile() ->
153+
gen_server:call(?SERVER, get_httpc_profile).
154+
155+
-spec debug_start(string()) -> ok.
156+
debug_start(File) ->
157+
{ok, _} = nat_cache:start([{file, File}]),
158+
ok = intercept:add(gen_udp, gen_udp_intercepts, [{{send, 4}, send}]),
159+
ok = intercept:add(httpc, httpc_intercepts, [{{request, 1}, request}, {{request, 4}, request}]),
160+
ok = intercept:add(inet_ext, inet_ext_intercepts, [{{get_internal_address, 1}, get_internal_address}]).
161+
162+
-spec debug_stop() -> ok.
163+
debug_stop() ->
164+
ok = intercept:clean(gen_udp),
165+
ok = intercept:clean(httpc),
166+
ok = intercept:clean(inet_ext),
167+
ok = nat_cache:stop().
123168

169+
%%%===================================================================
170+
%%% Gen server API
171+
%%%===================================================================
172+
173+
start_link() ->
174+
gen_server:start_link({local, ?MODULE}, ?MODULE, [], []).
175+
176+
%%%===================================================================
177+
%%% gen_server callbacks
178+
%%%===================================================================
179+
180+
init(_Args) ->
181+
error_logger:info_msg("Starting UPnP/NAT-PMP service"),
182+
_ = rand_compat:seed(erlang:phash2([node()]),
183+
erlang:monotonic_time(),
184+
erlang:unique_integer()),
185+
{ok, Profile} = inets:start(httpc, [{profile, nat}], stand_alone),
186+
State = #state{httpc_profile = Profile},
187+
erlang:send_after(rand:uniform(1000), self(), renew_port_mappings),
188+
{ok, State}.
189+
190+
handle_call(discover, _From, #state{httpc_profile = HttpcProfile} = State) ->
191+
Result = do_discover(HttpcProfile),
192+
{reply, Result, State};
193+
handle_call({get_device_address, Mod, Ctx}, _From, State) ->
194+
{reply, Mod:get_device_address(Ctx), State};
195+
handle_call({get_external_address, Mod, Ctx}, _From, #state{httpc_profile = HttpcProfile} = State) ->
196+
{reply, Mod:get_external_address(Ctx, HttpcProfile), State};
197+
handle_call({get_internal_address, Mod, Ctx}, _From, State) ->
198+
{reply, Mod:get_internal_address(Ctx), State};
199+
handle_call({add_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort, Lifetime},
200+
_From, #state{httpc_profile = HttpcProfile} = State) ->
201+
{reply, Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, Lifetime, HttpcProfile), State};
202+
handle_call({maintain_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort},
203+
_From, #state{httpc_profile = HttpcProfile, mappings = Mappings0} = State0) ->
204+
Response = Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS, HttpcProfile),
205+
case Response of
206+
{ok, _Since, InternalPort, ExternalPort, _MappingLifetime} ->
207+
State = #state{mappings = [{Protocol, InternalPort, ExternalPort} | Mappings0]},
208+
{reply, Response, State};
209+
{error, _Reason} = Error->
210+
{reply, Error, State0}
211+
end;
212+
handle_call({delete_port_mapping, {Mod, Ctx}, Protocol, InternalPort, ExternalPort},
213+
_From, #state{httpc_profile = HttpcProfile, mappings = Mappings0} = State0) ->
214+
State = State0#state{mappings = lists:delete({Protocol, InternalPort, ExternalPort}, Mappings0)},
215+
{reply, Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, HttpcProfile), State};
216+
handle_call(get_httpc_profile, _From, #state{httpc_profile = HttpcProfile} = State) ->
217+
{reply, HttpcProfile, State};
218+
handle_call(Request, _From, State) ->
219+
error_logger:warning_msg("Received unknown request: ~p", [Request]),
220+
{reply, ok, State}.
221+
222+
handle_cast(Other, State) ->
223+
error_logger:warning_msg("Received unknown cast: ~p", [Other]),
224+
{noreply, State}.
225+
226+
handle_info(renew_port_mappings, #state{mappings = []} = State) ->
227+
%% Give additional 10 secs for UPnP/NAT-PMP discovery and setup, to
228+
%% make sure there is continuity in port mapping.
229+
erlang:send_after(1000 * (?RECOMMENDED_MAPPING_LIFETIME_SECONDS - 10), self(), renew_port_mappings),
230+
{noreply, State};
231+
handle_info(renew_port_mappings, #state{mappings = Mappings, httpc_profile = HttpcProfile} = State) ->
232+
case do_discover(HttpcProfile) of
233+
{ok, {Mod, Ctx}} ->
234+
lists:foreach(
235+
fun({Protocol, InternalPort, ExternalPort}) ->
236+
case Mod:add_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, ?RECOMMENDED_MAPPING_LIFETIME_SECONDS, HttpcProfile) of
237+
{ok, _Since, _InternalPort, _ExternalPort, _MappingLifetime} ->
238+
ok;
239+
{error, _Reason} = Error ->
240+
error_logger:warning_msg("UPnP/NAT-PMP mapping renewal between ~p and ~p failed: ~p",
241+
[InternalPort, ExternalPort, Error])
242+
end
243+
end, Mappings);
244+
no_nat ->
245+
error_logger:warning_msg("UPnP/NAT-PMP discovery failed during lease renewal")
246+
end,
247+
%% Give additional 10 secs for UPnP/NAT-PMP discovery and setup, to
248+
%% make sure there is continuity in port mapping.
249+
erlang:send_after(1000 * (?RECOMMENDED_MAPPING_LIFETIME_SECONDS - 10), self(), renew_port_mappings),
250+
{noreply, State};
251+
handle_info(Other, State) ->
252+
error_logger:warning_msg("Received unknown info message: ~p", [Other]),
253+
{noreply, State}.
254+
255+
terminate(_Reason, #state{httpc_profile = HttpcProfile, mappings = Mappings}) when is_pid(HttpcProfile) ->
256+
case do_discover(HttpcProfile) of
257+
{ok, {Mod, Ctx}} ->
258+
lists:foreach(
259+
fun({Protocol, InternalPort, ExternalPort}) ->
260+
case Mod:delete_port_mapping(Ctx, Protocol, InternalPort, ExternalPort, HttpcProfile) of
261+
ok -> ok;
262+
{error, _Reason} = Error ->
263+
error_logger:warning_msg("UPnP/NAT-PMP mapping removal between ~p and ~p failed: ~p",
264+
[InternalPort, ExternalPort, Error])
265+
end
266+
end, Mappings);
267+
no_nat ->
268+
error_logger:warning_msg("UPnP/NAT-PMP discovery failed during mappings removal")
269+
end,
270+
gen_server:stop(HttpcProfile, normal, infinity),
271+
ok.
272+
273+
code_change(_OldVsn, State, _Extra) ->
274+
{ok, State}.
275+
276+
%%%===================================================================
277+
%%% Internal functions
278+
%%%===================================================================
279+
280+
do_discover(HttpcProfile) ->
281+
Self = self(),
282+
Ref = make_ref(),
283+
Workers = spawn_workers(?BACKENDS, HttpcProfile, Self, Ref, []),
284+
discover_loop(Workers, Ref).
124285

125-
%% internals
126286
discover_loop([], _Ref) ->
127287
no_nat;
128288
discover_loop(Workers, Ref) ->
@@ -140,21 +300,20 @@ discover_loop(Workers, Ref) ->
140300
no_nat
141301
end.
142302

143-
144-
discover_worker(Backend, Parent, Ref) ->
145-
case Backend:discover() of
303+
discover_worker(Backend, HttpcProfile, Parent, Ref) ->
304+
case Backend:discover(HttpcProfile) of
146305
{ok, Ctx} ->
147306
Parent ! {nat, Ref, self(), {Backend, Ctx}};
148307
_Error ->
149308
ok
150309
end.
151310

152-
spawn_workers([], _Parent, _Ref, Workers) ->
311+
spawn_workers([], _HttpcProfile, _Parent, _Ref, Workers) ->
153312
Workers;
154-
spawn_workers([Backend | Rest], Parent, Ref, Acc) ->
155-
Pid = spawn_link(fun() -> discover_worker(Backend, Parent, Ref) end),
313+
spawn_workers([Backend | Rest], HttpcProfile, Parent, Ref, Acc) ->
314+
Pid = spawn_link(fun() -> discover_worker(Backend, HttpcProfile, Parent, Ref) end),
156315
monitor_worker(Pid),
157-
spawn_workers(Rest, Parent, Ref, [Pid | Acc]).
316+
spawn_workers(Rest, HttpcProfile, Parent, Ref, [Pid | Acc]).
158317

159318
monitor_worker(Pid) ->
160319
MRef = erlang:monitor(process, Pid),

‎src/nat.hrl‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,16 @@
11
-define(NAT_TRIES, 5).
22
-define(NAT_INITIAL_MS, 250).
33

4+
%% Port mapping lifetime in seconds.
5+
%% NAT-PMP RFC (https://tools.ietf.org/html/rfc6886) recommends to set it
6+
%% to 7200 seconds (two hours). No recommendation for UPnP found.
47
-define(RECOMMENDED_MAPPING_LIFETIME_SECONDS, 7200).
58

69
-record(nat_upnp, {
710
service_url,
811
ip}).
12+
13+
-record(state, {
14+
mappings = [],
15+
httpc_profile
16+
}).

‎src/nat_app.erl‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,13 @@
1+
-module(nat_app).
2+
3+
-behaviour(application).
4+
5+
-export([start/2,
6+
stop/1]).
7+
8+
%% Application callbacks
9+
start(_StartType, _StartArgs) ->
10+
nat_sup:start_link().
11+
12+
stop(_State) ->
13+
ok.

0 commit comments

Comments
 (0)