1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2016-2020. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(dtls_socket).
21
22-include("ssl_internal.hrl").
23-include("ssl_api.hrl").
24
25-export([send/3,
26         listen/2,
27         accept/3,
28         connect/4,
29         socket/4,
30         setopts/3,
31         getopts/3,
32         getstat/3,
33	 peername/2,
34         sockname/2,
35         port/2,
36         close/2,
37         close/1
38        ]).
39
40-export([emulated_options/0,
41         emulated_options/1,
42         internal_inet_values/0,
43         default_inet_values/0,
44         default_cb_info/0]).
45
46send(Transport, {{IP,Port},Socket}, Data) ->
47    Transport:send(Socket, IP, Port, Data).
48
49listen(Port, #config{inet_ssl = SockOpts,
50                     ssl = SslOpts,
51                     emulated = EmOpts,
52                     inet_user = Options} = Config) ->
53    IP = proplists:get_value(ip, SockOpts, {0,0,0,0}),
54    case dtls_listener_sup:lookup_listener(IP, Port) of
55        undefined ->
56            start_new_listener(IP, Port, Config);
57        {ok, Listener} ->
58            dtls_packet_demux:new_owner(Listener),
59            dtls_packet_demux:set_all_opts(
60              Listener, {Options,
61                          emulated_socket_options(EmOpts,
62                                                  #socket_options{}),
63                          SslOpts}),
64            dtls_listener_sup:register_listener({self(), Listener},
65                                                IP, Port),
66            {ok, create_dtls_socket(Config, Listener, Port)};
67        Error ->
68            Error
69    end.
70
71accept(dtls, #config{transport_info = {Transport,_,_,_,_},
72                     connection_cb = ConnectionCb,
73                     dtls_handler = {Listner, _}}, _Timeout) ->
74    case dtls_packet_demux:accept(Listner, self()) of
75	{ok, Pid, Socket} ->
76	    {ok, socket([Pid], Transport, {Listner, Socket}, ConnectionCb)};
77	{error, Reason} ->
78	    {error, Reason}
79    end.
80
81connect(Address, Port, #config{transport_info = {Transport, _, _, _, _} = CbInfo,
82				connection_cb = ConnectionCb,
83				ssl = SslOpts,
84				emulated = EmOpts,
85				inet_ssl = SocketOpts}, Timeout) ->
86    case Transport:open(0, SocketOpts ++ internal_inet_values()) of
87	{ok, Socket} ->
88	    ssl_gen_statem:connect(ConnectionCb, Address, Port, {{Address, Port},Socket},
89				   {SslOpts,
90				    emulated_socket_options(EmOpts, #socket_options{}), undefined},
91				   self(), CbInfo, Timeout);
92	{error, _} = Error->
93	    Error
94    end.
95
96close(#sslsocket{pid = {dtls, #config{dtls_handler = {Pid, Port0},
97                                      inet_ssl = SockOpts}}}) ->
98    IP = proplists:get_value(ip, SockOpts, {0,0,0,0}),
99    Port = get_real_port(Pid, Port0),
100    dtls_listener_sup:register_listener({undefined, Pid}, IP, Port),
101    dtls_packet_demux:close(Pid).
102
103close(_, dtls) ->
104    ok;
105close(gen_udp, {_Client, _Socket}) ->
106    ok;
107close(Transport, {_Client, Socket}) ->
108    Transport:close(Socket).
109
110socket(Pids, gen_udp = Transport,
111       PeerAndSock = {{_Host, _Port}, _Socket}, ConnectionCb) ->
112    #sslsocket{pid = Pids,
113	       %% "The name "fd" is keept for backwards compatibility
114	       fd = {Transport, PeerAndSock, ConnectionCb}};
115socket(Pids, Transport, Socket, ConnectionCb) ->
116    #sslsocket{pid = Pids,
117	       %% "The name "fd" is keept for backwards compatibility
118	       fd = {Transport, Socket, ConnectionCb}}.
119setopts(_, Socket = #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) ->
120    SplitOpts = {_, EmOpts} = tls_socket:split_options(Options),
121    check_active_n(EmOpts, Socket),
122    dtls_packet_demux:set_sock_opts(ListenPid, SplitOpts);
123%%% Following clauses will not be called for emulated options, they are  handled in the connection process
124setopts(gen_udp, Socket, Options) ->
125    inet:setopts(Socket, Options);
126setopts(Transport, Socket, Options) ->
127    Transport:setopts(Socket, Options).
128
129check_active_n(EmulatedOpts, Socket = #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}) ->
130    %% We check the resulting options to send an ssl_passive message if necessary.
131    case proplists:lookup(active, EmulatedOpts) of
132        %% The provided value is out of bound.
133        {_, N} when is_integer(N), N < -32768 ->
134            throw(einval);
135        {_, N} when is_integer(N), N > 32767 ->
136            throw(einval);
137        {_, N} when is_integer(N) ->
138            {ok, #socket_options{active = Active}, _} = dtls_packet_demux:get_all_opts(ListenPid),
139            case Active of
140                Atom when is_atom(Atom), N =< 0 ->
141                    self() ! {ssl_passive, Socket};
142                %% The result of the addition is out of bound.
143                %% We do not need to check < -32768 because Active can't be below 1.
144                A when is_integer(A), A + N > 32767 ->
145                    throw(einval);
146                A when is_integer(A), A + N =< 0 ->
147                    self() ! {ssl_passive, Socket};
148                _ ->
149                    ok
150            end;
151        _ ->
152            ok
153    end.
154
155getopts(_, #sslsocket{pid = {dtls, #config{dtls_handler = {ListenPid, _}}}}, Options) ->
156    SplitOpts = tls_socket:split_options(Options),
157    dtls_packet_demux:get_sock_opts(ListenPid, SplitOpts);
158getopts(gen_udp,  #sslsocket{pid = {Socket, #config{emulated = EmOpts}}}, Options) ->
159    {SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options),
160    EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames),
161    SocketOpts = tls_socket:get_socket_opts(Socket, SockOptNames, inet),
162    {ok, EmulatedOpts ++ SocketOpts};
163getopts(_Transport,  #sslsocket{pid = {Socket, #config{emulated = EmOpts}}}, Options) ->
164    {SockOptNames, EmulatedOptNames} = tls_socket:split_options(Options),
165    EmulatedOpts = get_emulated_opts(EmOpts, EmulatedOptNames),
166    SocketOpts = tls_socket:get_socket_opts(Socket, SockOptNames, inet),
167    {ok, EmulatedOpts ++ SocketOpts};
168%%% Following clauses will not be called for emulated options, they are  handled in the connection process
169getopts(gen_udp, {_,{{_, _},Socket}}, Options) ->
170    inet:getopts(Socket, Options);
171getopts(gen_udp, {_,Socket}, Options) ->
172    inet:getopts(Socket, Options);
173getopts(Transport, Socket, Options) ->
174    Transport:getopts(Socket, Options).
175getstat(gen_udp, Pid, Options) when is_pid(Pid) ->
176    dtls_packet_demux:getstat(Pid, Options);
177getstat(gen_udp, {_,{_, Socket}}, Options) ->
178    inet:getstat(Socket, Options);
179getstat(gen_udp, {_, Socket}, Options) ->
180    inet:getstat(Socket, Options);
181getstat(gen_udp, Socket, Options) ->
182    inet:getstat(Socket, Options);
183getstat(Transport, Socket, Options) ->
184	Transport:getstat(Socket, Options).
185
186peername(_, undefined) ->
187    {error, enotconn};
188peername(gen_udp, {_, {Client, _Socket}}) ->
189    {ok, Client};
190peername(gen_udp, {Client, _Socket}) ->
191    {ok, Client};
192peername(Transport, Socket) ->
193    Transport:peername(Socket).
194sockname(gen_udp, {_, {_,Socket}}) ->
195    inet:sockname(Socket);
196sockname(gen_udp, Socket) ->
197    inet:sockname(Socket);
198sockname(Transport, Socket) ->
199    Transport:sockname(Socket).
200
201port(gen_udp, {_,Socket}) ->
202    inet:port(Socket);
203port(Transport, Socket) ->
204    Transport:port(Socket).
205
206emulated_options() ->
207    [mode, active,  packet, packet_size].
208
209emulated_options(Opts) ->
210      emulated_options(Opts, internal_inet_values(), default_inet_values()).
211
212internal_inet_values() ->
213    [{active, false}, {mode,binary}].
214
215default_inet_values() ->
216    [{active, true}, {mode, list}, {packet, 0}, {packet_size, 0}].
217
218default_cb_info() ->
219    {gen_udp, udp, udp_closed, udp_error, udp_passive}.
220
221get_emulated_opts(EmOpts, EmOptNames) ->
222    lists:map(fun(Name) -> {value, Value} = lists:keysearch(Name, 1, EmOpts),
223			   Value end,
224	      EmOptNames).
225
226emulated_socket_options(InetValues, #socket_options{
227				       mode   = Mode,
228                                       packet = Packet,
229                                       packet_size = PacketSize,
230				       active = Active}) ->
231    #socket_options{
232       mode   = proplists:get_value(mode, InetValues, Mode),
233       packet = proplists:get_value(packet, InetValues, Packet),
234       packet_size = proplists:get_value(packet_size, InetValues, PacketSize),
235       active = emulated_active_option(InetValues, Active)
236      }.
237
238emulated_active_option([], Active) ->
239    Active;
240emulated_active_option([{active, Active} | _], _) when Active =< 0 ->
241    false;
242emulated_active_option([{active, Active} | _], _) ->
243    Active;
244emulated_active_option([_|Tail], Active) ->
245    emulated_active_option(Tail, Active).
246
247emulated_options([{mode, Value} = Opt |Opts], Inet, Emulated) ->
248    validate_inet_option(mode, Value),
249    emulated_options(Opts, Inet, [Opt | proplists:delete(mode, Emulated)]);
250emulated_options([{header, _} = Opt | _], _, _) ->
251    throw({error, {options, {not_supported, Opt}}});
252emulated_options([{active, Value} = Opt |Opts], Inet, Emulated) ->
253    validate_inet_option(active, Value),
254    emulated_options(Opts, Inet, [Opt | proplists:delete(active, Emulated)]);
255emulated_options([{packet, _} = Opt | _], _, _) ->
256    throw({error, {options, {not_supported, Opt}}});
257emulated_options([{packet_size, _} = Opt | _], _, _) ->
258    throw({error, {options, {not_supported, Opt}}});
259emulated_options([Opt|Opts], Inet, Emulated) ->
260    emulated_options(Opts, [Opt|Inet], Emulated);
261emulated_options([], Inet,Emulated) ->
262    {Inet, Emulated}.
263
264validate_inet_option(mode, Value)
265  when Value =/= list, Value =/= binary ->
266    throw({error, {options, {mode,Value}}});
267validate_inet_option(active, Value)
268  when Value >= -32768, Value =< 32767 ->
269    ok;
270validate_inet_option(active, Value)
271  when Value =/= true, Value =/= false, Value =/= once ->
272    throw({error, {options, {active,Value}}});
273validate_inet_option(_, _) ->
274    ok.
275
276get_real_port(Listener, Port0) when is_pid(Listener) andalso
277                                    is_integer(Port0) ->
278    case Port0 of
279        0 ->
280            {ok, {_, NewPort}} = dtls_packet_demux:sockname(Listener),
281            NewPort;
282        _ ->
283            Port0
284    end.
285
286start_new_listener(IP, Port0,
287                   #config{transport_info = {TransportModule, _,_,_,_},
288                           inet_user = Options} = Config) ->
289    InetOptions = Options ++ internal_inet_values(),
290    case TransportModule:open(Port0, InetOptions) of
291        {ok, Socket} ->
292            Port = case Port0 of
293                       0 ->
294                           {ok, P} = inet:port(Socket),
295                           P;
296                       _ ->
297                           Port0
298                   end,
299            start_dtls_packet_demux(Config, IP, Port, Socket);
300        {error, eaddrinuse} ->
301            {error, already_listening};
302        Error ->
303            Error
304    end.
305
306start_dtls_packet_demux(#config{
307                           transport_info =
308                               {TransportModule, _,_,_,_} = TransportInfo,
309                           emulated = EmOpts0,
310                           ssl = SslOpts} = Config, IP, Port, Socket) ->
311    EmOpts = emulated_socket_options(EmOpts0, #socket_options{}),
312    case dtls_listener_sup:start_child([Port, TransportInfo, EmOpts,
313                                        SslOpts, Socket]) of
314        {ok, Multiplexer} ->
315            ok = TransportModule:controlling_process(Socket, Multiplexer),
316            dtls_listener_sup:register_listener({self(), Multiplexer},
317                                                IP, Port),
318            DTLSSocket = create_dtls_socket(Config, Multiplexer, Port),
319	    {ok, DTLSSocket};
320        Error ->
321            Error
322    end.
323
324create_dtls_socket(#config{emulated = EmOpts} = Config,
325                   Listener, Port) ->
326    Socket = #sslsocket{
327                pid = {dtls, Config#config{dtls_handler = {Listener, Port}}}},
328    check_active_n(EmOpts, Socket),
329    Socket.
330
331