File 0366-Rewrite-cname-lookups.patch of Package erlang (Revision 1c6d27e874ff4bb28c5c2e74b90a1fc8)
Currently displaying revision 1c6d27e874ff4bb28c5c2e74b90a1fc8 , Show latest
xxxxxxxxxx
1
From 8dd980a138c201e7ee2b099c3bbda7f470c2986a Mon Sep 17 00:00:00 2001
2
From: Raimo Niskanen <raimo@erlang.org>
3
Date: Fri, 18 Jun 2021 18:35:03 +0200
4
Subject: [PATCH 6/8] Rewrite cname lookups
5
6
---
7
lib/kernel/src/inet_db.erl | 284 +++++++++++++++---------------------
8
lib/kernel/src/inet_res.erl | 167 ++++++++++++---------
9
2 files changed, 211 insertions(+), 240 deletions(-)
10
11
diff --git a/lib/kernel/src/inet_db.erl b/lib/kernel/src/inet_db.erl
12
index 0a749030ef..4644bea344 100644
13
--- a/lib/kernel/src/inet_db.erl
14
+++ b/lib/kernel/src/inet_db.erl
15
16
-export([res_option/1, res_option/2, res_check_option/2]).
17
-export([socks_option/1]).
18
-export([getbyname/2, get_searchlist/0]).
19
--export([gethostbyaddr/1]).
20
--export([res_gethostbyaddr/2,res_hostent_by_domain/3]).
21
+-export([gethostbyaddr/2]).
22
+-export([res_gethostbyaddr/3,res_hostent_by_domain/3]).
23
-export([res_update_conf/0, res_update_hosts/0]).
24
%% inet help functions
25
-export([tolower/1, eq_domains/2]).
26
27
end.
28
29
30
+%%
31
+%% hostent_by_domain (cache version)
32
+%%
33
+hostent_by_domain(Domain, Type) ->
34
+ ?dbg("hostent_by_domain: ~p~n", [Domain]),
35
+ case resolve_cnames(stripdot(Domain), Type, fun lookup_cache_data/2) of
36
+ {error, _} = Error ->
37
+ Error;
38
+ {D, Addrs, Aliases} ->
39
+ {ok, make_hostent(D, Addrs, Aliases, Type)}
40
+ end.
41
+
42
+%%
43
+%% hostent_by_domain (newly resolved version)
44
+%% match data field directly and cache RRs.
45
+%%
46
+res_hostent_by_domain(Domain, Type, Rec) ->
47
+ RRs = res_filter_rrs(Type, Rec#dns_rec.anlist),
48
+ ?dbg("res_hostent_by_domain: ~p - ~p~n", [Domain, RRs]),
49
+ LookupFun = res_lookup_fun(RRs),
50
+ case resolve_cnames(stripdot(Domain), Type, LookupFun) of
51
+ {error, _} = Error ->
52
+ Error;
53
+ {D, Addrs, Aliases} ->
54
+ res_cache_answer(RRs),
55
+ {ok, make_hostent(D, Addrs, Aliases, Type)}
56
+ end.
57
+
58
make_hostent(Name, Addrs, Aliases, ?S_A) ->
59
#hostent {
60
h_name = Name,
61
62
h_aliases = Aliases
63
}.
64
65
-hostent_by_domain(Domain, Type) ->
66
- ?dbg("hostent_by_domain: ~p~n", [Domain]),
67
- hostent_by_domain(stripdot(Domain), [], [], Type).
68
-
69
-hostent_by_domain(Domain, Aliases, LAliases, Type) ->
70
- case lookup_type(Domain, Type) of
71
- [] ->
72
- case lookup_cname(Domain) of
73
- [] ->
74
- {error, nxdomain};
75
- [CName | _] ->
76
- LDomain = tolower(Domain),
77
- case lists:member(CName, [LDomain | LAliases]) of
78
- true ->
79
- {error, nxdomain};
80
- false ->
81
- hostent_by_domain(CName, [Domain | Aliases],
82
- [LDomain | LAliases], Type)
83
- end
84
- end;
85
- Addrs ->
86
- {ok, make_hostent(Domain, Addrs, Aliases, Type)}
87
- end.
88
89
-%% lookup canonical name
90
-lookup_cname(Domain) ->
91
- lookup_type(Domain, ?S_CNAME).
92
93
-%% lookup address record
94
-lookup_type(Domain, Type) ->
95
- [R#dns_rr.data || R <- lookup_rr(Domain, in, Type) ].
96
-
97
-%% lookup resource record
98
-lookup_rr(Domain, Class, Type) ->
99
- match_rr(dns_rr_match(tolower(Domain), Class, Type)).
100
-
101
-%%
102
-%% hostent_by_domain (newly resolved version)
103
-%% match data field directly and cache RRs.
104
-%%
105
-res_hostent_by_domain(Domain, Type, Rec) ->
106
- RRs =
107
- [RR#dns_rr{bm = tolower(N)} ||
108
- #dns_rr{
109
- domain = N,
110
- class = in,
111
- type = T} = RR <- Rec#dns_rec.anlist,
112
- T =:= Type orelse T =:= ?S_CNAME],
113
- res_cache_answer(RRs),
114
- ?dbg("res_hostent_by_domain: ~p - ~p~n", [Domain, RRs]),
115
- Domain_1 = stripdot(Domain),
116
- res_hostent_by_domain(Domain_1, tolower(Domain_1), [], [], Type, RRs).
117
-
118
-res_hostent_by_domain(Domain, LcDomain, Aliases, LcAliases, Type, RRs) ->
119
- case res_lookup_type(LcDomain, Type, RRs) of
120
- [] ->
121
- case res_lookup_type(LcDomain, ?S_CNAME, RRs) of
122
- [] ->
123
- {error, nxdomain};
124
- [CName | _] ->
125
- LcCName = tolower(CName),
126
- case lists:member(LcCName, [LcDomain | LcAliases]) of
127
- true ->
128
- %% CNAME loop
129
- {error, nxdomain};
130
- false ->
131
- res_hostent_by_domain(
132
- CName, LcCName,
133
- [Domain | Aliases], [LcDomain | LcAliases],
134
- Type, RRs)
135
- end
136
- end;
137
- Addrs ->
138
- {ok, make_hostent(Domain, Addrs, Aliases, Type)}
139
+res_filter_rrs(Type, RRs) ->
140
+ [RR#dns_rr{bm = tolower(N)} ||
141
+ #dns_rr{
142
+ domain = N,
143
+ class = in,
144
+ type = T} = RR <- RRs,
145
+ T =:= Type orelse T =:= ?S_CNAME].
146
+
147
+res_lookup_fun(RRs) ->
148
+ fun (LcDomain, Type) ->
149
+ [Data
150
+ || #dns_rr{bm = LcD, type = T, data = Data}
151
+ <- RRs,
152
+ LcD =:= LcDomain,
153
+ T =:= Type]
154
end.
155
156
-%% newly resolved lookup address record
157
-res_lookup_type(LcDomain, Type, RRs) ->
158
- [R#dns_rr.data || R <- RRs,
159
- R#dns_rr.bm =:= LcDomain,
160
- R#dns_rr.type =:= Type].
161
162
-%%
163
-%% gethostbyaddr (cache version)
164
-%% match data field directly
165
-%%
166
-gethostbyaddr(IP) ->
167
- case dnip(IP) of
168
- {ok, {IP1, HType, HLen, DnIP}} ->
169
- gethostbyaddr(IP1, HType, HLen, DnIP, []);
170
- Error -> Error
171
- end.
172
+resolve_cnames(Domain, Type, LookupFun) ->
173
+ resolve_cnames(Domain, Type, LookupFun, tolower(Domain), [], []).
174
175
-gethostbyaddr(IP, HType, HLen, DnIP, DnIPs) ->
176
- MatchPtrRR = dns_rr_match(DnIP, in, ptr),
177
- case match_rr(MatchPtrRR) of
178
+resolve_cnames(Domain, Type, LookupFun, LcDomain, Aliases, LcAliases) ->
179
+ case LookupFun(LcDomain, Type) of
180
[] ->
181
- case lookup_cname(DnIP) of
182
- [#dns_rr{data = DnIP_1} | _] ->
183
- DnIPs_1 = [DnIP | DnIPs],
184
- %% CNAME loop protection
185
- case lists:member(DnIP_1, DnIPs_1) of
186
+ case LookupFun(LcDomain, ?S_CNAME) of
187
+ [] ->
188
+ %% Did not find neither Type nor CNAME record
189
+ {error, nxdomain};
190
+ [CName] ->
191
+ LcCname = tolower(CName),
192
+ case lists:member(LcCname, [LcDomain | LcAliases]) of
193
true ->
194
+ %% CNAME loop
195
{error, nxdomain};
196
false ->
197
- gethostbyaddr(IP, HType, HLen, DnIP_1, DnIPs_1)
198
+ %% Repeat with the (more) canonical domain name
199
+ resolve_cnames(
200
+ CName, Type, LookupFun, LcCname,
201
+ [Domain | Aliases], [LcDomain, LcAliases])
202
end;
203
- CNames when is_list(CNames) ->
204
+ [_ | _] = _CNames ->
205
+ ?dbg("resolve_cnames duplicate cnames=~p~n", [_CNames]),
206
{error, nxdomain}
207
end;
208
- RRs when is_list(RRs) ->
209
- ent_gethostbyaddr(RRs, IP, HType, HLen)
210
+ [_ | _] = Results ->
211
+ {Domain, Results, Aliases}
212
+ end.
213
+
214
+
215
+%%
216
+%% gethostbyaddr (cache version)
217
+%% match data field directly
218
+%%
219
+gethostbyaddr(Domain, IP) ->
220
+ ?dbg("gethostbyaddr: ~p~n", [IP]),
221
+ case resolve_cnames(Domain, ?S_PTR, fun lookup_cache_data/2) of
222
+ {error, _} = Error ->
223
+ Error;
224
+ {_D, Domains, _Aliases} ->
225
+ ent_gethostbyaddr(Domains, IP)
226
end.
227
228
%%
229
%% res_gethostbyaddr (newly resolved version)
230
%% match data field directly and cache RRs.
231
%%
232
-res_gethostbyaddr(IP, Rec) ->
233
- {ok, {IP1, HType, HLen}} = dnt(IP),
234
- RRs =
235
- [RR#dns_rr{bm = tolower(N)} ||
236
- #dns_rr{
237
- domain = N,
238
- class = in,
239
- type = T} = RR <- Rec#dns_rec.anlist,
240
- T =:= ?S_PTR orelse T =:= ?S_CNAME],
241
- res_cache_answer(RRs),
242
- case [RR || #dns_rr{type = ?S_PTR} = RR <- RRs] of
243
- [] ->
244
- {error, nxdomain};
245
- PtrRRs ->
246
- ent_gethostbyaddr(PtrRRs, IP1, HType, HLen)
247
+res_gethostbyaddr(Name, IP, Rec) ->
248
+ RRs = res_filter_rrs(?S_PTR, Rec#dns_rec.anlist),
249
+ ?dbg("res_gethostbyaddr: ~p - ~p~n", [IP, RRs]),
250
+ LookupFun = res_lookup_fun(RRs),
251
+ case resolve_cnames(Name, ?S_PTR, LookupFun) of
252
+ {error, _} = Error ->
253
+ Error;
254
+ {_D, Domains, _Aliases} ->
255
+ case ent_gethostbyaddr(Domains, IP) of
256
+ {ok, _HEnt} = Result ->
257
+ res_cache_answer(RRs),
258
+ Result;
259
+ {error, _} = Error ->
260
+ Error
261
+ end
262
end.
263
264
-ent_gethostbyaddr([RR|RRs], IP, AddrType, Length) ->
265
- %% debug
266
- if RRs =/= [] ->
267
- ?dbg("gethostbyaddr found extra=~p~n", [RRs]);
268
- true -> ok
269
- end,
270
- Domain = RR#dns_rr.data,
271
+ent_gethostbyaddr([Domain], IP) ->
272
+ {IP_1, AddrType, Length} = norm_ip(IP),
273
H =
274
#hostent{
275
h_name = Domain,
276
- %% Since a PTR record should point to
277
- %% the canonical name, this Domain should
278
- %% have no CNAME record, so is this really reasonable?
279
- h_aliases = lookup_cname(Domain),
280
- h_addr_list = [IP],
281
+ h_aliases = [],
282
+ h_addr_list = [IP_1],
283
h_addrtype = AddrType,
284
h_length = Length },
285
- {ok, H}.
286
+ {ok, H};
287
+ent_gethostbyaddr([_ | _] = _Domains, _IP) ->
288
+ ?dbg("gethostbyaddr duplicate domains=~p~n", [_Domains]),
289
+ {error, nxdomain}.
290
291
-
292
-dnip(IP) ->
293
- case dnt(IP) of
294
- {ok,{IP1 = {A,B,C,D}, inet, HLen}} ->
295
- {ok,{IP1, inet, HLen, dn_in_addr_arpa(A,B,C,D)}};
296
- {ok,{IP1 = {A,B,C,D,E,F,G,H}, inet6, HLen}} ->
297
- {ok,{IP1, inet6, HLen, dn_ip6_int(A,B,C,D,E,F,G,H)}};
298
- _ ->
299
- {error, formerr}
300
- end.
301
+%% Normalize an IPv4-compatible IPv6 address
302
+%% into a plain IPv4 address
303
+%%
304
+norm_ip(IP) when tuple_size(IP) =:= 4 ->
305
+ {IP, inet, 4};
306
+norm_ip({0,0,0,0,0,16#ffff,G,H}) ->
307
+ A = G bsr 8, B = G band 16#ff, C = H bsr 8, D = H band 16#ff,
308
+ {{A,B,C,D}, inet, 4};
309
+norm_ip(IP) when tuple_size(IP) =:= 8 ->
310
+ {IP, inet6, 16}.
311
312
313
-dnt(IP = {A,B,C,D}) when ?ip(A,B,C,D) ->
314
- {ok, {IP, inet, 4}};
315
-dnt({0,0,0,0,0,16#ffff,G,H}) when is_integer(G+H) ->
316
- A = G div 256, B = G rem 256, C = H div 256, D = H rem 256,
317
- {ok, {{A,B,C,D}, inet, 4}};
318
-dnt(IP = {A,B,C,D,E,F,G,H}) when ?ip6(A,B,C,D,E,F,G,H) ->
319
- {ok, {IP, inet6, 16}};
320
-dnt(_) ->
321
- {error, formerr}.
322
323
%%
324
%% Register socket Modules
325
326
cnt = '_', tm = '_', ttl = '_', bm = LcDomain, func = '_'}.
327
328
329
+lookup_cache_data(LcDomain, Type) ->
330
+ [Data
331
+ || #dns_rr{data = Data}
332
+ <- match_rr(dns_rr_match(LcDomain, in, Type))].
333
+
334
%% We are simultaneously updating the table from all clients
335
%% and the server, so we might get duplicate recource records
336
%% in the table, i.e identical domain, class, type and data.
337
338
false.
339
340
341
-dn_ip6_int(A,B,C,D,E,F,G,H) ->
342
- dnib(H) ++ dnib(G) ++ dnib(F) ++ dnib(E) ++
343
- dnib(D) ++ dnib(C) ++ dnib(B) ++ dnib(A) ++ "ip6.int".
344
-
345
-dn_in_addr_arpa(A,B,C,D) ->
346
- integer_to_list(D) ++ "." ++
347
- integer_to_list(C) ++ "." ++
348
- integer_to_list(B) ++ "." ++
349
- integer_to_list(A) ++ ".in-addr.arpa".
350
-
351
-dnib(X) ->
352
- [hex(X), $., hex(X bsr 4), $., hex(X bsr 8), $., hex(X bsr 12), $.].
353
-
354
-hex(X) ->
355
- X4 = (X band 16#f),
356
- if X4 < 10 -> X4 + $0;
357
- true -> (X4-10) + $a
358
- end.
359
-
360
%% Strip trailing dot, do not produce garbage unless necessary.
361
%%
362
stripdot(Name) ->
363
diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl
364
index e238cfd2a1..f5ab7e6a23 100644
365
--- a/lib/kernel/src/inet_res.erl
366
+++ b/lib/kernel/src/inet_res.erl
367
368
_ = inet:stop_timer(Timer),
369
Res.
370
371
-gethostbyaddr_tm({A,B,C,D} = IP, Timer) when ?ip(A,B,C,D) ->
372
- inet_db:res_update_conf(),
373
- case inet_db:gethostbyaddr(IP) of
374
- {ok, HEnt} -> {ok, HEnt};
375
- _ -> res_gethostbyaddr(dn_in_addr_arpa(A,B,C,D), IP, Timer)
376
- end;
377
-gethostbyaddr_tm({A,B,C,D,E,F,G,H} = IP, Timer) when ?ip6(A,B,C,D,E,F,G,H) ->
378
- inet_db:res_update_conf(),
379
- case inet_db:gethostbyaddr(IP) of
380
- {ok, HEnt} -> {ok, HEnt};
381
- _ -> res_gethostbyaddr(dn_ip6_int(A,B,C,D,E,F,G,H), IP, Timer)
382
- end;
383
-gethostbyaddr_tm(Addr,Timer) when is_list(Addr) ->
384
+gethostbyaddr_tm(Addr, Timer) when is_atom(Addr) ->
385
+ gethostbyaddr_tm(atom_to_list(Addr), Timer);
386
+gethostbyaddr_tm(Addr, Timer) when is_list(Addr) ->
387
case inet_parse:address(Addr) of
388
- {ok, IP} -> gethostbyaddr_tm(IP,Timer);
389
+ {ok, IP} -> gethostbyaddr_tm(IP, Timer);
390
_Error -> {error, formerr}
391
end;
392
-gethostbyaddr_tm(Addr,Timer) when is_atom(Addr) ->
393
- gethostbyaddr_tm(atom_to_list(Addr),Timer);
394
-gethostbyaddr_tm(_,_) -> {error, formerr}.
395
-
396
-%%
397
-%% Send the gethostbyaddr query to:
398
-%% 1. the list of normal names servers
399
-%% 2. the list of alternative name servers
400
-%%
401
-res_gethostbyaddr(Addr, IP, Timer) ->
402
- case res_query(Addr, in, ?S_PTR, [], Timer) of
403
- {ok, Rec} ->
404
- inet_db:res_gethostbyaddr(IP, Rec);
405
- {error,{qfmterror,_}} -> {error,einval};
406
- {error,{Reason,_}} -> {error,Reason};
407
- Error ->
408
- Error
409
+gethostbyaddr_tm(IP, Timer) ->
410
+ case dn_ip(IP) of
411
+ {error, _} = Error ->
412
+ Error;
413
+ Name ->
414
+ %% Try cached first
415
+ inet_db:res_update_conf(),
416
+ case inet_db:gethostbyaddr(Name, IP) of
417
+ {ok, _HEnt} = Result ->
418
+ Result;
419
+ {error, nxdomain} ->
420
+ %% Do a resolver lookup
421
+ case res_query(Name, in, ?S_PTR, [], Timer) of
422
+ {ok, Rec} ->
423
+ %% Process and cache DNS Record
424
+ inet_db:res_gethostbyaddr(Name, IP, Rec);
425
+ {error,{qfmterror,_}} ->
426
+ {error,einval};
427
+ {error,{Reason,_}} ->
428
+ {error,Reason};
429
+ Error ->
430
+ Error
431
+ end
432
+ end
433
end.
434
435
%% --------------------------------------------------------------------------
436
437
case type_p(Type) of
438
true ->
439
case inet_parse:visible_string(Name) of
440
- false -> {error, formerr};
441
+ false ->
442
+ {error, formerr};
443
true ->
444
+ %% Try cached first
445
inet_db:res_update_conf(),
446
case inet_db:getbyname(Name, Type) of
447
- {ok, HEnt} -> {ok, HEnt};
448
- _ -> res_getbyname(Name, Type, Timer)
449
+ {ok, HEnt} ->
450
+ {ok, HEnt};
451
+ _ ->
452
+ %% Do a resolver lookup
453
+ res_getbyname(Name, Type, Timer)
454
end
455
end;
456
false ->
457
458
res_getby_query(Name, Type, Timer) ->
459
case res_query(Name, in, Type, [], Timer) of
460
{ok, Rec} ->
461
+ %% Process and cache DNS Record
462
inet_db:res_hostent_by_domain(Name, Type, Rec);
463
{error,{qfmterror,_}} -> {error,einval};
464
{error,{Reason,_}} -> {error,Reason};
465
466
res_getby_query(Name, Type, Timer, NSs) ->
467
case res_query(Name, in, Type, [], Timer, NSs) of
468
{ok, Rec} ->
469
+ %% Process and cache DNS Record
470
inet_db:res_hostent_by_domain(Name, Type, Rec);
471
{error,{qfmterror,_}} -> {error,einval};
472
{error,{Reason,_}} -> {error,Reason};
473
474
%% 1. "a.b.c" =>
475
%% "a.b.c"
476
%% 2. "1.2.3.4" =>
477
-%% "4.3.2.1.IN-ADDR.ARPA"
478
+%% "4.3.2.1.in-addr.arpa"
479
%% 3. "4321:0:1:2:3:4:567:89ab" =>
480
-%% "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.1.2.3.4.IP6.ARPA"
481
+%% "b.a.9.8.7.6.5.0.4.0.0.0.3.0.0.0.2.0.0.0.1.0.0.0.0.0.0.1.2.3.4.ip6.arpa"
482
%% 4. {1,2,3,4} => as 2.
483
%% 5. {1,2,3,4,5,6,7,8} => as 3.
484
+%% 6. Atom -> Recurse(String(Atom))
485
+%% 7. Term => {error, formerr}
486
%%
487
-nsdname({A,B,C,D}) ->
488
- {ok, dn_in_addr_arpa(A,B,C,D)};
489
-nsdname({A,B,C,D,E,F,G,H}) ->
490
- {ok, dn_ip6_int(A,B,C,D,E,F,G,H)};
491
+nsdname(Name) when is_atom(Name) ->
492
+ nsdname(atom_to_list(Name));
493
nsdname(Name) when is_list(Name) ->
494
case inet_parse:visible_string(Name) of
495
true ->
496
case inet_parse:address(Name) of
497
- {ok, Addr} ->
498
- nsdname(Addr);
499
+ {ok, IP} ->
500
+ dn_ip(IP);
501
_ ->
502
{ok, Name}
503
end;
504
_ -> {error, formerr}
505
end;
506
-nsdname(Name) when is_atom(Name) ->
507
- nsdname(atom_to_list(Name));
508
-nsdname(_) -> {error, formerr}.
509
-
510
-dn_in_addr_arpa(A,B,C,D) ->
511
- integer_to_list(D) ++
512
- ("." ++ integer_to_list(C) ++
513
- ("." ++ integer_to_list(B) ++
514
- ("." ++ integer_to_list(A) ++ ".IN-ADDR.ARPA"))).
515
-
516
-dn_ip6_int(A,B,C,D,E,F,G,H) ->
517
- dnib(H) ++
518
- (dnib(G) ++
519
- (dnib(F) ++
520
- (dnib(E) ++
521
- (dnib(D) ++
522
- (dnib(C) ++
523
- (dnib(B) ++
524
- (dnib(A) ++ "IP6.ARPA"))))))).
525
-
526
-
527
-
528
--compile({inline, [dnib/1, dnib/3]}).
529
-dnib(X) ->
530
- L = erlang:integer_to_list(X, 16),
531
- dnib(4-length(L), L, []).
532
+nsdname(IP) ->
533
+ dn_ip(IP).
534
+
535
+%% Return the domain name for a PTR lookup of
536
+%% the argument IP address
537
%%
538
-dnib(0, [], Acc) -> Acc;
539
-dnib(0, [C|Cs], Acc) ->
540
- dnib(0, Cs, [C,$.|Acc]);
541
-dnib(N, Cs, Acc) ->
542
- dnib(N-1, Cs, [$0,$.|Acc]).
543
+dn_ip({A,B,C,D}) when ?ip(A,B,C,D) ->
544
+ dn_ipv4([A,B,C,D], "in-addr.arpa");
545
+dn_ip({A,B,C,D,E,F,G,H}) when ?ip6(A,B,C,D,E,F,G,H) ->
546
+ dn_ipv6([A,B,C,D,E,F,G,H], "ip6.arpa");
547
+dn_ip(_) ->
548
+ {error, formerr}.
549
+
550
+dn_ipv4([], Dn) ->
551
+ Dn;
552
+dn_ipv4([A | As], Dn_0) when is_integer(A), A =< 255 ->
553
+ Dn = [$. | Dn_0],
554
+ if
555
+ A < 10 ->
556
+ dn_ipv4(As, dn_dec(A, Dn));
557
+ A < 100 ->
558
+ dn_ipv4(As, dn_dec(A div 10, dn_dec(A rem 10, Dn)));
559
+ true ->
560
+ B = A rem 100,
561
+ dn_ipv4(
562
+ As,
563
+ dn_dec(A div 100, dn_dec(B div 10, dn_dec(B rem 10, Dn))))
564
+ end.
565
+
566
+dn_ipv6([], Dn) ->
567
+ Dn;
568
+dn_ipv6([W | Ws], Dn) when is_integer(W), W =< 16#ffff ->
569
+ D = W band 16#f, W_1 = W bsr 4,
570
+ C = W_1 band 16#f, W_2 = W_1 bsr 4,
571
+ B = W_2 band 16#f,
572
+ A = W_2 bsr 4,
573
+ dn_ipv6(Ws, dn_hex(D, dn_hex(C, dn_hex(B, dn_hex(A, Dn))))).
574
+
575
+-compile({inline, [dn_dec/2, dn_hex/2]}).
576
+dn_dec(N, Tail) when is_integer(N) ->
577
+ [N + $0 | Tail].
578
+
579
+dn_hex(N, Tail) when is_integer(N) ->
580
+ if
581
+ N < 10 ->
582
+ [N + $0, $. | Tail];
583
+ true ->
584
+ [(N - 10) + $a, $. | Tail]
585
+end.
586
587
588
589
--
590
2.31.1
591
592