1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2021. 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(gen_udp).
21
22-export([open/1, open/2, close/1]).
23-export([send/2, send/3, send/4, send/5, recv/2, recv/3, connect/3]).
24-export([controlling_process/2]).
25-export([fdopen/2]).
26
27-include("inet_int.hrl").
28
29-define(module_socket(Handler, Handle),
30        {'$inet', (Handler), (Handle)}).
31
32-type option() ::
33        {active,          true | false | once | -32768..32767} |
34        {add_membership,  {inet:ip_address(), inet:ip_address()}} |
35        {broadcast,       boolean()} |
36        {buffer,          non_neg_integer()} |
37        {deliver,         port | term} |
38        {dontroute,       boolean()} |
39        {drop_membership, {inet:ip_address(), inet:ip_address()}} |
40        {header,          non_neg_integer()} |
41        {high_msgq_watermark, pos_integer()} |
42        {low_msgq_watermark, pos_integer()} |
43        {mode,            list | binary} | list | binary |
44        {multicast_if,    inet:ip_address()} |
45        {multicast_loop,  boolean()} |
46        {multicast_ttl,   non_neg_integer()} |
47        {priority,        non_neg_integer()} |
48        {raw,
49         Protocol :: non_neg_integer(),
50         OptionNum :: non_neg_integer(),
51         ValueBin :: binary()} |
52        {read_packets,    non_neg_integer()} |
53        {recbuf,          non_neg_integer()} |
54        {reuseaddr,       boolean()} |
55        {sndbuf,          non_neg_integer()} |
56        {tos,             non_neg_integer()} |
57        {tclass,          non_neg_integer()} |
58        {ttl,             non_neg_integer()} |
59	{recvtos,         boolean()} |
60	{recvtclass,      boolean()} |
61	{recvttl,         boolean()} |
62	{ipv6_v6only,     boolean()}.
63-type option_name() ::
64        active |
65        broadcast |
66        buffer |
67        deliver |
68        dontroute |
69        header |
70        high_msgq_watermark |
71        low_msgq_watermark |
72        mode |
73        multicast_if |
74        multicast_loop |
75        multicast_ttl |
76        priority |
77        {raw,
78         Protocol :: non_neg_integer(),
79         OptionNum :: non_neg_integer(),
80         ValueSpec :: (ValueSize :: non_neg_integer()) |
81                      (ValueBin :: binary())} |
82        read_packets |
83        recbuf |
84        reuseaddr |
85        sndbuf |
86        tos |
87        tclass |
88        ttl |
89        recvtos |
90        recvtclass |
91        recvttl |
92        pktoptions |
93	ipv6_v6only.
94
95-type open_option() :: {ip, inet:socket_address()}
96                     | {fd, non_neg_integer()}
97                     | {ifaddr, inet:socket_address()}
98                     | inet:address_family()
99                     | {port, inet:port_number()}
100                     | {netns, file:filename_all()}
101                     | {bind_to_device, binary()}
102                     | option().
103
104-type socket() :: inet:socket().
105
106-export_type([option/0, open_option/0, option_name/0, socket/0]).
107
108
109%% -- open ------------------------------------------------------------------
110
111-spec open(Port) -> {ok, Socket} | {error, Reason} when
112      Port :: inet:port_number(),
113      Socket :: socket(),
114      Reason :: system_limit | inet:posix().
115
116open(Port) ->
117    open(Port, []).
118
119-spec open(Port, Opts) -> {ok, Socket} | {error, Reason} when
120      Port   :: inet:port_number(),
121      Opts   :: [inet:inet_backend() | open_option()],
122      Socket :: socket(),
123      Reason :: system_limit | inet:posix().
124
125open(Port, Opts0) ->
126    case inet:gen_udp_module(Opts0) of
127	{?MODULE, Opts} ->
128	    open1(Port, Opts);
129	{GenUdpMod, Opts} ->
130	    GenUdpMod:open(Port, Opts)
131    end.
132
133open1(Port, Opts0) ->
134    {Mod, Opts} = inet:udp_module(Opts0),
135    {ok, UP} = Mod:getserv(Port),
136    Mod:open(UP, Opts).
137
138
139%% -- close -----------------------------------------------------------------
140
141-spec close(Socket) -> ok when
142      Socket :: socket().
143
144close(?module_socket(GenUdpMod, _) = S) when is_atom(GenUdpMod) ->
145    GenUdpMod:?FUNCTION_NAME(S);
146close(S) ->
147    inet:udp_close(S).
148
149
150%% -- send ------------------------------------------------------------------
151
152%% Connected send
153
154-spec send(Socket, Packet) -> ok | {error, Reason} when
155      Socket :: socket(),
156      Packet :: iodata(),
157      Reason :: not_owner | inet:posix().
158
159send(?module_socket(GenUdpMod, _) = S, Packet)
160  when is_atom(GenUdpMod) ->
161    GenUdpMod:?FUNCTION_NAME(S, Packet);
162send(S, Packet) when is_port(S) ->
163    case inet_db:lookup_socket(S) of
164	{ok, Mod} ->
165	    Mod:send(S, Packet);
166	Error ->
167	    Error
168    end.
169
170-spec send(Socket, Destination, Packet) -> ok | {error, Reason} when
171      Socket :: socket(),
172      Destination :: {inet:ip_address(), inet:port_number()} |
173		     inet:family_address(),
174      Packet :: iodata(),
175      Reason :: not_owner | inet:posix().
176
177send(?module_socket(GenUdpMod, _) = S, Destination, Packet)
178  when is_atom(GenUdpMod) ->
179    GenUdpMod:?FUNCTION_NAME(S, Destination, Packet);
180send(Socket, Destination, Packet) ->
181    send(Socket, Destination, [], Packet).
182
183-spec send(Socket, Host, Port, Packet) -> ok | {error, Reason} when
184      Socket :: socket(),
185      Host :: inet:hostname() | inet:ip_address(),
186      Port :: inet:port_number() | atom(),
187      Packet :: iodata(),
188      Reason :: not_owner | inet:posix();
189%%%
190          (Socket, Destination, AncData, Packet) -> ok | {error, Reason} when
191      Socket :: socket(),
192      Destination :: {inet:ip_address(), inet:port_number()} |
193                     inet:family_address(),
194      AncData :: inet:ancillary_data(),
195      Packet :: iodata(),
196      Reason :: not_owner | inet:posix();
197%%%
198          (Socket, Destination, PortZero, Packet) -> ok | {error, Reason} when
199      Socket :: socket(),
200      Destination :: {inet:ip_address(), inet:port_number()} |
201                     inet:family_address(),
202      PortZero :: inet:port_number(),
203      Packet :: iodata(),
204      Reason :: not_owner | inet:posix().
205
206send(?module_socket(GenUdpMod, _) = S, Arg2, Arg3, Packet)
207  when is_atom(GenUdpMod) ->
208    GenUdpMod:?FUNCTION_NAME(S, Arg2, Arg3, Packet);
209
210send(S, {_,_} = Destination, PortZero = AncData, Packet) when is_port(S) ->
211    %% Destination is {Family,Addr} | {IP,Port},
212    %% so it is complete - argument PortZero is redundant
213    if
214        PortZero =:= 0 ->
215            case inet_db:lookup_socket(S) of
216                {ok, Mod} ->
217                    Mod:send(S, Destination, [], Packet);
218                Error ->
219                    Error
220            end;
221        is_integer(PortZero) ->
222            %% Redundant PortZero; must be 0
223            {error, einval};
224        is_list(AncData) ->
225            case inet_db:lookup_socket(S) of
226                {ok, Mod} ->
227                    Mod:send(S, Destination, AncData, Packet);
228                Error ->
229                    Error
230            end
231    end;
232send(S, Host, Port, Packet) when is_port(S) ->
233    send(S, Host, Port, [], Packet).
234
235-spec send(Socket, Host, Port, AncData, Packet) -> ok | {error, Reason} when
236      Socket :: socket(),
237      Host :: inet:hostname() | inet:ip_address() | inet:local_address(),
238      Port :: inet:port_number() | atom(),
239      AncData :: inet:ancillary_data(),
240      Packet :: iodata(),
241      Reason :: not_owner | inet:posix().
242
243send(?module_socket(GenUdpMod, _) = S, Host, Port, AncData, Packet)
244  when is_atom(GenUdpMod) ->
245    GenUdpMod:?FUNCTION_NAME(S, Host, Port, AncData, Packet);
246
247send(S, Host, Port, AncData, Packet)
248  when is_port(S), is_list(AncData) ->
249    case inet_db:lookup_socket(S) of
250	{ok, Mod} ->
251	    case Mod:getaddr(Host) of
252		{ok,IP} ->
253		    case Mod:getserv(Port) of
254			{ok,P} -> Mod:send(S, {IP,P}, AncData, Packet);
255			{error,einval} -> exit(badarg);
256			Error -> Error
257		    end;
258		{error,einval} -> exit(badarg);
259		Error -> Error
260	    end;
261	Error ->
262	    Error
263    end.
264
265
266%% -- recv ------------------------------------------------------------------
267
268-spec recv(Socket, Length) ->
269                  {ok, RecvData} | {error, Reason} when
270      Socket :: socket(),
271      Length :: non_neg_integer(),
272      RecvData :: {Address, Port, Packet} | {Address, Port, AncData, Packet},
273      Address :: inet:ip_address() | inet:returned_non_ip_address(),
274      Port :: inet:port_number(),
275      AncData :: inet:ancillary_data(),
276      Packet :: string() | binary(),
277      Reason :: not_owner | inet:posix().
278
279recv(?module_socket(GenUdpMod, _) = S, Len)
280  when is_atom(GenUdpMod) andalso is_integer(Len) ->
281    GenUdpMod:?FUNCTION_NAME(S, Len);
282recv(S, Len) when is_port(S) andalso is_integer(Len) ->
283    case inet_db:lookup_socket(S) of
284	{ok, Mod} ->
285	    Mod:recv(S, Len);
286	Error ->
287	    Error
288    end.
289
290-spec recv(Socket, Length, Timeout) ->
291                  {ok, RecvData} | {error, Reason} when
292      Socket :: socket(),
293      Length :: non_neg_integer(),
294      Timeout :: timeout(),
295      RecvData :: {Address, Port, Packet} | {Address, Port, AncData, Packet},
296      Address :: inet:ip_address() | inet:returned_non_ip_address(),
297      Port :: inet:port_number(),
298      AncData :: inet:ancillary_data(),
299      Packet :: string() | binary(),
300      Reason :: not_owner | timeout | inet:posix().
301
302recv(?module_socket(GenUdpMod, _) = S, Len, Time)
303  when is_atom(GenUdpMod) ->
304    GenUdpMod:?FUNCTION_NAME(S, Len, Time);
305recv(S, Len, Time) when is_port(S) ->
306    case inet_db:lookup_socket(S) of
307	{ok, Mod} ->
308	    Mod:recv(S, Len, Time);
309	Error ->
310	    Error
311    end.
312
313
314%% -- connect ---------------------------------------------------------------
315
316connect(?module_socket(GenUdpMod, _) = S, Address, Port)
317  when is_atom(GenUdpMod) ->
318    GenUdpMod:?FUNCTION_NAME(S, Address, Port);
319
320connect(S, Address, Port) when is_port(S) ->
321    case inet_db:lookup_socket(S) of
322	{ok, Mod} ->
323	    case Mod:getaddr(Address) of
324		{ok, IP} ->
325		    Mod:connect(S, IP, Port);
326		Error ->
327		    Error
328	    end;
329	Error ->
330	    Error
331    end.
332
333
334%% -- controlling_process ---------------------------------------------------
335
336-spec controlling_process(Socket, Pid) -> ok | {error, Reason} when
337      Socket :: socket(),
338      Pid :: pid(),
339      Reason :: closed | not_owner | badarg | inet:posix().
340
341controlling_process(?module_socket(GenUdpMod, _) = S, NewOwner)
342  when is_atom(GenUdpMod) ->
343    GenUdpMod:?FUNCTION_NAME(S, NewOwner);
344
345controlling_process(S, NewOwner) ->
346    inet:udp_controlling_process(S, NewOwner).
347
348
349%% -- fdopen ----------------------------------------------------------------
350
351%%
352%% Create a port/socket from a file descriptor
353%%
354fdopen(Fd, Opts0) ->
355    {Mod,Opts} = inet:udp_module(Opts0),
356    Mod:fdopen(Fd, Opts).
357