diff options
Diffstat (limited to 'lib')
79 files changed, 1563 insertions, 742 deletions
diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 82e9326294..c09b0f47d1 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -47,14 +47,20 @@ dialyzer_suppressions(#gen{erule=per,aligned=Aligned}) -> false -> uper; true -> per end, - case asn1ct_func:is_used({Mod,complete,1}) of + suppress({Mod,complete,1}), + suppress({per_common,to_bitstring,2}), + emit([" ok.",nl]). + +suppress({M,F,A}=MFA) -> + case asn1ct_func:is_used(MFA) of false -> ok; true -> - emit([" _ = complete(Arg),",nl]) - end, - emit([" ok.",nl]). - + Args = + [lists:concat(["element(",I,", Arg)"]) + || I <- lists:seq(1, A)], + emit([" ",{call,M,F,Args},com,nl]) + end. gen_encode(Erules,Type) when is_record(Type,typedef) -> gen_encode_user(Erules,Type). diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index 0aa4aacf16..9becde110b 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -92,7 +92,7 @@ "sasl-2.4.2", "snmp-5.1.2", "ssh-4.0", - "stdlib-3.4", + "stdlib-3.5", "syntax_tools-1.7", "tools-2.8", "xmerl-1.3.8" diff --git a/lib/common_test/src/ct_webtool.erl b/lib/common_test/src/ct_webtool.erl index 82aa78fc4b..c7174b13f5 100644 --- a/lib/common_test/src/ct_webtool.erl +++ b/lib/common_test/src/ct_webtool.erl @@ -771,7 +771,7 @@ fill_out(Nr)-> %Controls whether the user selected a tool to start %---------------------------------------------------------------------- get_tools(Input)-> - case httpd:parse_query(Input) of + case uri_string:dissect_query(Input) of []-> no_tools; Tools-> diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 3a454a1e84..a76c8c12de 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -5739,7 +5739,7 @@ uri_encode_comp([Char|Chars],Encoding) -> Reserved = sets:is_element(Char, reserved()), case (Char>127 andalso Encoding==latin1) orelse Reserved of true -> - [ $% | http_util:integer_to_hexlist(Char)] ++ + [ $% | integer_to_list(Char, 16)] ++ uri_encode_comp(Chars,Encoding); false -> [Char | uri_encode_comp(Chars,Encoding)] diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index 83fcde2f48..2bf3e82ade 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -919,7 +919,7 @@ get_input_data(Input,Key)-> end. parse(Input) -> - httpd:parse_query(Input). + uri_string:dissect_query(Input). vts_integer_to_list(X) when is_atom(X) -> atom_to_list(X); diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index fa919ca862..5ef340c831 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -475,7 +475,7 @@ encode_alloc_list_1([{floats,Floats}|T], Dict, Acc0) -> encode_alloc_list_1([], Dict, Acc) -> {iolist_to_binary(Acc),Dict}. --spec encode(non_neg_integer(), pos_integer()) -> iodata(). +-spec encode(non_neg_integer(), integer()) -> iodata(). encode(Tag, N) when N < 0 -> encode1(Tag, negative_to_bytes(N)); diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 47a2be8ab5..8cd271e1dc 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -363,10 +363,18 @@ opt_tuple_element_1([{set,[D],[S],move}|Is0], I0, {_,S}, Acc) -> case eliminate_use_of_from_reg(Is0, S, D) of no -> no; - {yes,Is} -> + {yes,Is1} -> {set,[S],Ss,Op} = I0, I = {set,[D],Ss,Op}, - {yes,reverse(Acc, [I|Is])} + case opt_move_rev(S, Acc, [I|Is1]) of + not_possible -> + %% Not safe because the move of the + %% get_tuple_element instruction would cause the + %% result of a previous instruction to be ignored. + no; + {_,Is} -> + {yes,Is} + end end; opt_tuple_element_1([{set,Ds,Ss,_}=I|Is], MovedI, {S,D}=Regs, Acc) -> case member(S, Ds) orelse member(D, Ss) of diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index b83ed17b55..28f36db399 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -17,14 +17,15 @@ %% %% %CopyrightEnd% %% -%% Purpose : Type-based optimisations. +%% Purpose: Type-based optimisations. See the comment for verified_type/1 +%% the very end of this file for a description of the types in the +%% type database. -module(beam_type). -export([module/2]). --import(lists, [filter/2,foldl/3,keyfind/3,member/2, - reverse/1,reverse/2,sort/1]). +-import(lists, [foldl/3,member/2,reverse/1,reverse/2,sort/1]). -define(UNICODE_INT, {integer,{0,16#10FFFF}}). @@ -93,22 +94,28 @@ simplify_basic([I0|Is], Ts0, Acc) -> simplify_basic([], Ts, Acc) -> {reverse(Acc),Ts}. +%% simplify_instr(Instruction, Ts) -> [Instruction]. + +%% Simplify a simple instruction using type information. Return an +%% empty list if the instruction should be removed, or a list with +%% the original or modified instruction. + simplify_instr({set,[D],[{integer,Index},Reg],{bif,element,_}}=I, Ts) -> case max_tuple_size(Reg, Ts) of Sz when 0 < Index, Index =< Sz -> [{set,[D],[Reg],{get_tuple_element,Index-1}}]; _ -> [I] end; -simplify_instr({test,is_atom,_,[R]}=I, Ts) -> - case tdb_find(R, Ts) of - boolean -> []; - _ -> [I] - end; -simplify_instr({test,is_integer,_,[R]}=I, Ts) -> +simplify_instr({test,Test,Fail,[R]}=I, Ts) -> case tdb_find(R, Ts) of - integer -> []; - {integer,_} -> []; - _ -> [I] + any -> + [I]; + Type -> + case will_succeed(Test, Type) of + yes -> []; + no -> [{jump,Fail}]; + maybe -> [I] + end end; simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) -> case tdb_find(TupleReg, Ts) of @@ -117,31 +124,17 @@ simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) -> _ -> [I] end; -simplify_instr({test,is_tuple,_,[R]}=I, Ts) -> - case tdb_find(R, Ts) of - {tuple,_,_,_} -> []; - _ -> [I] - end; simplify_instr({test,test_arity,_,[R,Arity]}=I, Ts) -> case tdb_find(R, Ts) of {tuple,exact_size,Arity,_} -> []; _ -> [I] end; -simplify_instr({test,is_map,_,[R]}=I, Ts) -> - case tdb_find(R, Ts) of - map -> []; - _ -> [I] - end; -simplify_instr({test,is_nonempty_list,_,[R]}=I, Ts) -> - case tdb_find(R, Ts) of - nonempty_list -> []; - _ -> [I] - end; -simplify_instr({test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I, Ts) -> +simplify_instr({test,is_eq_exact,Fail,[R,{atom,A}=Atom]}=I, Ts) -> case tdb_find(R, Ts) of {atom,_}=Atom -> []; - {atom,_} -> [{jump,Fail}]; - _ -> [I] + boolean when is_boolean(A) -> [I]; + any -> [I]; + _ -> [{jump,Fail}] end; simplify_instr({test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I, Ts) -> case tdb_find(R, Ts) of @@ -162,16 +155,6 @@ simplify_instr({test,bs_test_unit,_,[Src,Unit]}=I, Ts) -> {binary,U} when U rem Unit =:= 0 -> []; _ -> [I] end; -simplify_instr({test,is_binary,_,[Src]}=I, Ts) -> - case tdb_find(Src, Ts) of - {binary,U} when U rem 8 =:= 0 -> []; - _ -> [I] - end; -simplify_instr({test,is_bitstr,_,[Src]}=I, Ts) -> - case tdb_find(Src, Ts) of - {binary,_} -> []; - _ -> [I] - end; simplify_instr(I, _) -> [I]. simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> @@ -200,6 +183,53 @@ eq_ranges([H], H, H) -> true; eq_ranges([H|T], H, Max) -> eq_ranges(T, H+1, Max); eq_ranges(_, _, _) -> false. +%% will_succeed(TestOperation, Type) -> yes|no|maybe. +%% Test whether TestOperation applied to an argument of type Type +%% will succeed. Return yes, no, or maybe. +%% +%% Type is a type as described in the comment for verified_type/1 at +%% the very end of this file, but it will *never* be 'any'. + +will_succeed(is_atom, Type) -> + case Type of + {atom,_} -> yes; + boolean -> yes; + _ -> no + end; +will_succeed(is_binary, Type) -> + case Type of + {binary,U} when U rem 8 =:= 0 -> yes; + {binary,_} -> maybe; + _ -> no + end; +will_succeed(is_bitstr, Type) -> + case Type of + {binary,_} -> yes; + _ -> no + end; +will_succeed(is_integer, Type) -> + case Type of + integer -> yes; + {integer,_} -> yes; + _ -> no + end; +will_succeed(is_map, Type) -> + case Type of + map -> yes; + _ -> no + end; +will_succeed(is_nonempty_list, Type) -> + case Type of + nonempty_list -> yes; + _ -> no + end; +will_succeed(is_tuple, Type) -> + case Type of + {tuple,_,_,_} -> yes; + _ -> no + end; +will_succeed(_, _) -> maybe. + %% simplify_float([Instruction], TypeDatabase) -> %% {[Instruction],TypeDatabase'} | not_possible %% Simplify floating point operations in blocks. @@ -229,7 +259,7 @@ simplify_float_1([{set,[D0],[A0],{alloc,_,{gc_bif,'-',{f,0}}}}=I|Is]=Is0, {D,Rs} = find_dest(D0, Rs1), Areg = fetch_reg(A, Rs), Acc = [{set,[D],[Areg],{bif,fnegate,{f,0}}}|clearerror(Acc1)], - Ts = tdb_update([{D0,float}], Ts0), + Ts = tdb_store(D0, float, Ts0), simplify_float_1(Is, Ts, Rs, Acc); _Other -> Ts = update(I, Ts0), @@ -252,7 +282,7 @@ simplify_float_1([{set,[D0],[A0,B0],{alloc,_,{gc_bif,Op0,{f,0}}}}=I|Is]=Is0, Areg = fetch_reg(A, Rs), Breg = fetch_reg(B, Rs), Acc = [{set,[D],[Areg,Breg],{bif,Op,{f,0}}}|clearerror(Acc2)], - Ts = tdb_update([{D0,float}], Ts0), + Ts = tdb_store(D0, float, Ts0), simplify_float_1(Is, Ts, Rs, Acc) end; simplify_float_1([{set,_,_,{try_catch,_,_}}=I|Is]=Is0, _Ts, Rs0, Acc0) -> @@ -425,104 +455,100 @@ update({'%anno',_}, Ts) -> Ts; update({set,[D],[S],move}, Ts) -> tdb_copy(S, D, Ts); -update({set,[D],[{integer,I},Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,min_size,I,[]}},{D,kill}], Ts0); -update({set,[D],[_Index,Reg],{bif,element,_}}, Ts0) -> - tdb_update([{Reg,{tuple,min_size,0,[]}},{D,kill}], Ts0); -update({set,[D],Args,{bif,N,_}}, Ts0) -> +update({set,[D],[Index,Reg],{bif,element,_}}, Ts0) -> + MinSize = case Index of + {integer,I} -> I; + _ -> 0 + end, + Ts = tdb_meet(Reg, {tuple,min_size,MinSize,[]}, Ts0), + tdb_store(D, any, Ts); +update({set,[D],Args,{bif,N,_}}, Ts) -> Ar = length(Args), BoolOp = erl_internal:new_type_test(N, Ar) orelse erl_internal:comp_op(N, Ar) orelse erl_internal:bool_op(N, Ar), - case BoolOp of - true -> - tdb_update([{D,boolean}], Ts0); - false -> - tdb_update([{D,kill}], Ts0) + Type = case BoolOp of + true -> boolean; + false -> unary_op_type(N) + end, + tdb_store(D, Type, Ts); +update({set,[D],[S],{get_tuple_element,0}}, Ts0) -> + if + D =:= S -> + tdb_store(D, any, Ts0); + true -> + Ts = tdb_store(D, {tuple_element,S,0}, Ts0), + tdb_store(S, {tuple,min_size,1,[]}, Ts) end; -update({set,[D],[S],{get_tuple_element,0}}, Ts) -> - tdb_update([{D,{tuple_element,S,0}}], Ts); update({set,[D],[S],{alloc,_,{gc_bif,float,{f,0}}}}, Ts0) -> %% Make sure we reject non-numeric literal argument. case possibly_numeric(S) of - true -> tdb_update([{D,float}], Ts0); - false -> Ts0 + true -> tdb_store(D, float, Ts0); + false -> Ts0 end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,'band',{f,0}}}}, Ts) -> - case keyfind(integer, 1, [S1,S2]) of - {integer,N} -> - update_band(N, D, Ts); - false -> - tdb_update([{D,integer}], Ts) - end; -update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts0) -> + Type = band_type(S1, S2, Ts), + tdb_store(D, Type, Ts); +update({set,[D],[S1,S2],{alloc,_,{gc_bif,'/',{f,0}}}}, Ts) -> %% Make sure we reject non-numeric literals. case possibly_numeric(S1) andalso possibly_numeric(S2) of - true -> tdb_update([{D,float}], Ts0); - false -> Ts0 + true -> tdb_store(D, float, Ts); + false -> Ts end; update({set,[D],[S1,S2],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts0) -> case op_type(Op) of integer -> - tdb_update([{D,integer}], Ts0); - {float,_} -> - case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of - {float,_} -> tdb_update([{D,float}], Ts0); - {_,float} -> tdb_update([{D,float}], Ts0); - {_,_} -> tdb_update([{D,kill}], Ts0) - end; - unknown -> - tdb_update([{D,kill}], Ts0) - end; -update({set,[],_Src,_Op}, Ts0) -> Ts0; -update({set,[D],_Src,_Op}, Ts0) -> - tdb_update([{D,kill}], Ts0); + tdb_store(D, integer, Ts0); + {float,_} -> + case {tdb_find(S1, Ts0),tdb_find(S2, Ts0)} of + {float,_} -> tdb_store(D, float, Ts0); + {_,float} -> tdb_store(D, float, Ts0); + {_,_} -> tdb_store(D, any, Ts0) + end; + Type -> + tdb_store(D, Type, Ts0) + end; +update({set,[D],[_],{alloc,_,{gc_bif,Op,{f,0}}}}, Ts) -> + tdb_store(D, unary_op_type(Op), Ts); +update({set,[],_Src,_Op}, Ts) -> + Ts; +update({set,[D],_Src,_Op}, Ts) -> + tdb_store(D, any, Ts); update({kill,D}, Ts) -> - tdb_update([{D,kill}], Ts); + tdb_store(D, any, Ts); %% Instructions outside of blocks. -update({test,is_float,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,float}], Ts0); -update({test,test_arity,_Fail,[Src,Arity]}, Ts0) -> - tdb_update([{Src,{tuple,exact_size,Arity,[]}}], Ts0); -update({test,is_map,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,map}], Ts0); +update({test,test_arity,_Fail,[Src,Arity]}, Ts) -> + tdb_meet(Src, {tuple,exact_size,Arity,[]}, Ts); update({get_map_elements,_,Src,{list,Elems0}}, Ts0) -> + Ts1 = tdb_meet(Src, map, Ts0), {_Ss,Ds} = beam_utils:split_even(Elems0), - Elems = [{Dst,kill} || Dst <- Ds], - tdb_update([{Src,map}|Elems], Ts0); -update({test,is_nonempty_list,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,nonempty_list}], Ts0); -update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> - case tdb_find(Reg, Ts) of - error -> - Ts; - {tuple_element,TupleReg,0} -> - tdb_update([{TupleReg,{tuple,min_size,1,[Atom]}}], Ts); - _ -> - Ts - end; + foldl(fun(Dst, A) -> tdb_store(Dst, any, A) end, Ts1, Ds); +update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts0) -> + Ts = case tdb_find_source_tuple(Reg, Ts0) of + {source_tuple,TupleReg} -> + tdb_meet(TupleReg, {tuple,min_size,1,[Atom]}, Ts0); + none -> + Ts0 + end, + tdb_meet(Reg, Atom, Ts); update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> - tdb_update([{Src,{tuple,exact_size,Arity,[Tag]}}], Ts); + tdb_meet(Src, {tuple,exact_size,Arity,[Tag]}, Ts); %% Binaries and binary matching. -update({test,is_binary,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,{binary,8}}], Ts0); -update({test,is_bitstr,_Fail,[Src]}, Ts0) -> - tdb_update([{Src,{binary,1}}], Ts0); update({test,bs_get_integer2,_,_,Args,Dst}, Ts) -> - tdb_update([{Dst,get_bs_integer_type(Args)}], Ts); + tdb_store(Dst, get_bs_integer_type(Args), Ts); update({test,bs_get_utf8,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,?UNICODE_INT}], Ts); + tdb_store(Dst, ?UNICODE_INT, Ts); update({test,bs_get_utf16,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,?UNICODE_INT}], Ts); + tdb_store(Dst, ?UNICODE_INT, Ts); update({test,bs_get_utf32,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,?UNICODE_INT}], Ts); + tdb_store(Dst, ?UNICODE_INT, Ts); update({bs_init,_,{bs_init2,_,_},_,_,Dst}, Ts) -> - tdb_update([{Dst,{binary,8}}], Ts); + tdb_store(Dst, {binary,8}, Ts); update({bs_init,_,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,{binary,1}}], Ts); + tdb_store(Dst, {binary,1}, Ts); update({bs_put,_,_,_}, Ts) -> Ts; update({bs_save2,_,_}, Ts) -> @@ -530,21 +556,31 @@ update({bs_save2,_,_}, Ts) -> update({bs_restore2,_,_}, Ts) -> Ts; update({bs_context_to_binary,Dst}, Ts) -> - tdb_update([{Dst,kill}], Ts); -update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts) -> - Type = case tdb_find(Src, Ts) of - {binary,_}=Type0 -> Type0; - _ -> {binary,1} - end, - tdb_update([{Dst,Type}], Ts); + tdb_store(Dst, {binary,1}, Ts); +update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts0) -> + Ts = tdb_meet(Src, {binary,1}, Ts0), + tdb_copy(Src, Dst, Ts); update({test,bs_get_binary2,_,_,[_,_,Unit,_],Dst}, Ts) -> true = is_integer(Unit), %Assertion. - tdb_update([{Dst,{binary,Unit}}], Ts); + tdb_store(Dst, {binary,Unit}, Ts); update({test,bs_get_float2,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,float}], Ts); + tdb_store(Dst, float, Ts); update({test,bs_test_unit,_,[Src,Unit]}, Ts) -> - tdb_update([{Src,{binary,Unit}}], Ts); - + tdb_meet(Src, {binary,Unit}, Ts); + +%% Other test instructions +update({test,Test,_Fail,[Src]}, Ts) -> + Type = case Test of + is_binary -> {binary,8}; + is_bitstr -> {binary,1}; + is_boolean -> boolean; + is_float -> float; + is_integer -> integer; + is_map -> map; + is_nonempty_list -> nonempty_list; + _ -> any + end, + tdb_meet(Src, Type, Ts); update({test,_Test,_Fail,_Other}, Ts) -> Ts; @@ -552,7 +588,7 @@ update({test,_Test,_Fail,_Other}, Ts) -> update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> case is_math_bif(Math, Ar) of - true -> tdb_update([{{x,0},float}], Ts); + true -> tdb_store({x,0}, float, Ts); false -> tdb_kill_xregs(Ts) end; update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> @@ -569,7 +605,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> %% first element of the tuple. {tuple,SzKind,Sz,[]} end, - tdb_update([{{x,0},T}], Ts); + tdb_store({x,0}, T, Ts); _ -> Ts end; @@ -585,20 +621,27 @@ update({'%',_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). -update_band(N, Reg, Ts) -> - Type = update_band_1(N, 0), - tdb_update([{Reg,Type}], Ts). +band_type({integer,Int}, Other, Ts) -> + band_type_1(Int, Other, Ts); +band_type(Other, {integer,Int}, Ts) -> + band_type_1(Int, Other, Ts); +band_type(_, _, _) -> integer. + +band_type_1(Int, OtherSrc, Ts) -> + Type = band_type_2(Int, 0), + OtherType = tdb_find(OtherSrc, Ts), + meet(Type, OtherType). -update_band_1(N, Bits) when Bits < 64 -> +band_type_2(N, Bits) when Bits < 64 -> case 1 bsl Bits of P when P =:= N + 1 -> {integer,{0,N}}; P when P > N + 1 -> integer; _ -> - update_band_1(N, Bits+1) + band_type_2(N, Bits+1) end; -update_band_1(_, _) -> +band_type_2(_, _) -> %% Negative or large positive number. Give up. integer. @@ -722,7 +765,15 @@ op_type('bxor') -> integer; op_type('bsl') -> integer; op_type('bsr') -> integer; op_type('div') -> integer; -op_type(_) -> unknown. +op_type(_) -> any. + +unary_op_type(bit_size) -> integer; +unary_op_type(byte_size) -> integer; +unary_op_type(length) -> integer; +unary_op_type(map_size) -> integer; +unary_op_type(size) -> integer; +unary_op_type(tuple_size) -> integer; +unary_op_type(_) -> any. flush(Rs, [{set,[_],[_,_,_],{bif,is_record,_}}|_]=Is0, Acc0) -> Acc = flush_all(Rs, Is0, Acc0), @@ -805,41 +856,39 @@ checkerror_1([], OrigIs) -> OrigIs. checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. -%%% Routines for maintaining a type database. The type database +%%% Routines for maintaining a type database. The type database %%% associates type information with registers. %%% -%%% {tuple,min_size,Size,First} means that the corresponding register contains -%%% a tuple with *at least* Size elements (conversely, exact_size means that it -%%% contains a tuple with *exactly* Size elements). An tuple with unknown size -%%% is represented as {tuple,min_size,0,[]}. First is either [] (meaning that -%%% the tuple's first element is unknown) or [FirstElement] (the contents of -%%% the first element). -%%% -%%% 'float' means that the register contains a float. -%%% -%%% 'integer' or {integer,{Min,Max}} that the register contains an -%%% integer. -%%% -%%% {binary,Unit} means that the register contains a binary/bitstring aligned -%%% to unit Unit. +%%% See the comment for verified_type/1 at the end of module for +%%% a description of the possible types. %% tdb_new() -> EmptyDataBase %% Creates a new, empty type database. tdb_new() -> []. -%% tdb_find(Register, Db) -> Information|error +%% tdb_find(Register, Db) -> Type %% Returns type information or the atom error if there is no type %% information available for Register. +%% +%% See the comment for verified_type/1 at the end of module for +%% a description of the possible types. -tdb_find({x,_}=K, Ts) -> tdb_find_1(K, Ts); -tdb_find({y,_}=K, Ts) -> tdb_find_1(K, Ts); -tdb_find(_, _) -> error. +tdb_find(Reg, Ts) -> + case tdb_find_raw(Reg, Ts) of + {tuple_element,_,_} -> any; + Type -> Type + end. -tdb_find_1(K, Ts) -> - case orddict:find(K, Ts) of - {ok,Val} -> Val; - error -> error +%% tdb_find_source_tuple(Register, Ts) -> {source_tuple,Register} | 'none'. +%% Find the tuple whose first element was fetched to the register Register. + +tdb_find_source_tuple(Reg, Ts) -> + case tdb_find_raw(Reg, Ts) of + {tuple_element,Src,0} -> + {source_tuple,Src}; + _ -> + none end. %% tdb_copy(Source, Dest, Db) -> Db' @@ -847,9 +896,9 @@ tdb_find_1(K, Ts) -> %% as the Source. tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y -> - case tdb_find(S, Ts) of - error -> orddict:erase(D, Ts); - Type -> orddict:store(D, Type, Ts) + case tdb_find_raw(S, Ts) of + any -> orddict:erase(D, Ts); + Type -> orddict:store(D, Type, Ts) end; tdb_copy(Literal, D, Ts) -> Type = case Literal of @@ -861,14 +910,89 @@ tdb_copy(Literal, D, Ts) -> {literal,Tuple} when tuple_size(Tuple) >= 1 -> Lit = tag_literal(element(1, Tuple)), {tuple,exact_size,tuple_size(Tuple),[Lit]}; - _ -> term + _ -> any end, - if - Type =:= term -> - orddict:erase(D, Ts); - true -> - verify_type(Type), - orddict:store(D, Type, Ts) + tdb_store(D, verified_type(Type), Ts). + +%% tdb_store(Register, Type, Ts0) -> Ts. +%% Store a new type for register Register. Return the update type +%% database. Use this function when a new value is assigned to +%% a register. +%% +%% See the comment for verified_type/1 at the end of module for +%% a description of the possible types. + +tdb_store(Reg, any, Ts) -> + erase(Reg, Ts); +tdb_store(Reg, Type, Ts) -> + store(Reg, verified_type(Type), Ts). + +store(Key, New, [{K,_}|_]=Dict) when Key < K -> + [{Key,New}|Dict]; +store(Key, New, [{K,Val}=E|Dict]) when Key > K -> + case Val of + {tuple_element,Key,_} -> store(Key, New, Dict); + _ -> [E|store(Key, New, Dict)] + end; +store(Key, New, [{_K,Old}|Dict]) -> %Key == K + case Old of + {tuple,_,_,_} -> + [{Key,New}|erase_tuple_element(Key, Dict)]; + _ -> + [{Key,New}|Dict] + end; +store(Key, New, []) -> [{Key,New}]. + +erase(Key, [{K,_}=E|Dict]) when Key < K -> + [E|Dict]; +erase(Key, [{K,Val}=E|Dict]) when Key > K -> + case Val of + {tuple_element,Key,_} -> erase(Key, Dict); + _ -> [E|erase(Key, Dict)] + end; +erase(Key, [{_K,Val}|Dict]) -> %Key == K + case Val of + {tuple,_,_,_} -> erase_tuple_element(Key, Dict); + _ -> Dict + end; +erase(_, []) -> []. + +erase_tuple_element(Key, [{_,{tuple_element,Key,_}}|Dict]) -> + erase_tuple_element(Key, Dict); +erase_tuple_element(Key, [E|Dict]) -> + [E|erase_tuple_element(Key, Dict)]; +erase_tuple_element(_Key, []) -> []. + +%% tdb_meet(Register, Type, Ts0) -> Ts. +%% Update information of a register that is used as the source for an +%% instruction. The type Type will be combined using the meet operation +%% with the previous type information for the register, resulting in +%% narrower (more specific) type. +%% +%% For example, if the previous type is {tuple,min_size,2,[]} and the +%% the new type is {tuple,exact_size,5,[]}, the meet of the types will +%% be {tuple,exact_size,5,[]}. +%% +%% See the comment for verified_type/1 at the end of module for +%% a description of the possible types. + +tdb_meet(Reg, NewType, Ts) -> + Update = fun(Type0) -> meet(Type0, NewType) end, + orddict:update(Reg, Update, NewType, Ts). + +%%% +%%% Here follows internal helper functions for accessing and +%%% updating the type database. +%%% + +tdb_find_raw({x,_}=K, Ts) -> tdb_find_raw_1(K, Ts); +tdb_find_raw({y,_}=K, Ts) -> tdb_find_raw_1(K, Ts); +tdb_find_raw(_, _) -> any. + +tdb_find_raw_1(K, Ts) -> + case orddict:find(K, Ts) of + {ok,Val} -> Val; + error -> any end. tag_literal(A) when is_atom(A) -> {atom,A}; @@ -877,45 +1001,6 @@ tag_literal(I) when is_integer(I) -> {integer,I}; tag_literal([]) -> nil; tag_literal(Lit) -> {literal,Lit}. -%% tdb_update([UpdateOp], Db) -> NewDb -%% UpdateOp = {Register,kill}|{Register,NewInfo} -%% Updates a type database. If a 'kill' operation is given, the type -%% information for that register will be removed from the database. -%% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,min_size,5,[]}}] means that the -%% the existing type information, if any, will be discarded, and the -%% the '{tuple,min_size,5,[]}' information ignored. -%% -%% If NewInfo information is given and there exists information about -%% the register, the old and new type information will be merged. -%% For instance, {tuple,min_size,5,_} and {tuple,min_size,10,_} will be merged -%% to produce {tuple,min_size,10,_}. - -tdb_update(Uis0, Ts0) -> - Uis1 = filter(fun ({{x,_},_Op}) -> true; - ({{y,_},_Op}) -> true; - (_) -> false - end, Uis0), - tdb_update1(lists:sort(Uis1), Ts0). - -tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K -> - tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> - verify_type(Type), - [New|tdb_update1(Ops, Db)]; -tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) -> - tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,NewInfo}|Ops], [{Key,OldInfo}|Db]) -> - [{Key,merge_type_info(NewInfo, OldInfo)}|tdb_update1(Ops, Db)]; -tdb_update1([{_,_}|_]=Ops, [Old|Db]) -> - [Old|tdb_update1(Ops, Db)]; -tdb_update1([{Key,kill}|Ops], []) -> - tdb_update1(remove_key(Key, Ops), []); -tdb_update1([{_,Type}=New|Ops], []) -> - verify_type(Type), - [New|tdb_update1(Ops, [])]; -tdb_update1([], Db) -> Db. - %% tdb_kill_xregs(Db) -> NewDb %% Kill all information about x registers. Also kill all tuple_element %% dependencies from y registers to x registers. @@ -924,44 +1009,106 @@ tdb_kill_xregs([{{x,_},_Type}|Db]) -> tdb_kill_xregs(Db); tdb_kill_xregs([{{y,_},{tuple_element,{x,_},_}}|Db]) -> tdb_kill_xregs(Db); tdb_kill_xregs([Any|Db]) -> [Any|tdb_kill_xregs(Db)]; tdb_kill_xregs([]) -> []. - -remove_key(Key, [{Key,_Op}|Ops]) -> remove_key(Key, Ops); -remove_key(_, Ops) -> Ops. -merge_type_info(I, I) -> I; -merge_type_info({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> +%% meet(Type1, Type2) -> Type +%% Returns the "meet" of Type1 and Type2. The meet is a narrower +%% type than Type1 and Type2. For example: +%% +%% meet(integer, {integer,{0,3}}) -> {integer,{0,3}} +%% +%% The meet for two different types result in 'none', which is +%% the bottom element for our type lattice: +%% +%% meet(integer, map) -> none + +meet(T, T) -> + T; +meet({integer,_}=T, integer) -> + T; +meet(integer, {integer,_}=T) -> + T; +meet({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> + {integer,{max(Min1, Min2),min(Max1, Max2)}}; +meet({tuple,min_size,Sz1,Same}, {tuple,min_size,Sz2,Same}=Max) when Sz1 < Sz2 -> Max; -merge_type_info({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> +meet({tuple,min_size,Sz1,Same}=Max, {tuple,min_size,Sz2,Same}) when Sz1 > Sz2 -> Max; -merge_type_info({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> +meet({tuple,exact_size,_,Same}=Exact, {tuple,_,_,Same}) -> Exact; -merge_type_info({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> +meet({tuple,_,_,Same},{tuple,exact_size,_,Same}=Exact) -> Exact; -merge_type_info({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> - merge_type_info({tuple,SzKind1,Sz1,First}, Tuple2); -merge_type_info({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> - merge_type_info(Tuple1, {tuple,SzKind2,Sz2,First}); -merge_type_info(integer, {integer,_}) -> - integer; -merge_type_info({integer,_}, integer) -> - integer; -merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> - {integer,{max(Min1, Min2),min(Max1, Max2)}}; -merge_type_info({binary,U1}, {binary,U2}) -> +meet({tuple,SzKind1,Sz1,[]}, {tuple,_SzKind2,_Sz2,First}=Tuple2) -> + meet({tuple,SzKind1,Sz1,First}, Tuple2); +meet({tuple,_SzKind1,_Sz1,First}=Tuple1, {tuple,SzKind2,Sz2,_}) -> + meet(Tuple1, {tuple,SzKind2,Sz2,First}); +meet({binary,U1}, {binary,U2}) -> {binary,max(U1, U2)}; -merge_type_info(NewType, _) -> - verify_type(NewType), - NewType. - -verify_type({atom,_}) -> ok; -verify_type({binary,U}) when is_integer(U) -> ok; -verify_type(boolean) -> ok; -verify_type(integer) -> ok; -verify_type({integer,{Min,Max}}) - when is_integer(Min), is_integer(Max) -> ok; -verify_type(map) -> ok; -verify_type(nonempty_list) -> ok; -verify_type({tuple,_,Sz,[]}) when is_integer(Sz) -> ok; -verify_type({tuple,_,Sz,[_]}) when is_integer(Sz) -> ok; -verify_type({tuple_element,_,_}) -> ok; -verify_type(float) -> ok. +meet(T1, T2) -> + case is_any(T1) of + true -> + verified_type(T2); + false -> + case is_any(T2) of + true -> + verified_type(T1); + false -> + none %The bottom element. + end + end. + +is_any(any) -> true; +is_any({tuple_element,_,_}) -> true; +is_any(_) -> false. + +%% verified_type(Type) -> Type +%% Returns the passed in type if it is one of the defined types. +%% Crashes if there is anything wrong with the type. +%% +%% Here are all possible types: +%% +%% any Any Erlang term (top element for the type lattice). +%% +%% {atom,Atom} The specific atom Atom. +%% {binary,Unit} Binary/bitstring aligned to unit Unit. +%% boolean 'true' | 'false' +%% float Floating point number. +%% integer Integer. +%% {integer,{Min,Max}} Integer in the inclusive range Min through Max. +%% map Map. +%% nonempty_list Nonempty list. +%% {tuple,_,_,_} Tuple (see below). +%% +%% none No type (bottom element for the type lattice). +%% +%% {tuple,min_size,Size,First} means that the corresponding register +%% contains a tuple with *at least* Size elements (conversely, +%% {tuple,exact_size,Size,First} means that it contains a tuple with +%% *exactly* Size elements). An tuple with unknown size is +%% represented as {tuple,min_size,0,[]}. First is either [] (meaning +%% that the tuple's first element is unknown) or [FirstElement] (the +%% contents of the first element). +%% +%% There is also a pseudo-type called {tuple_element,_,_}: +%% +%% {tuple_element,SrcTuple,ElementNumber} +%% +%% that does not provide any information about the type of the +%% register itself, but provides a link back to the source tuple that +%% the register got its value from. +%% +%% Note that {tuple_element,_,_} will *never* be returned by tdb_find/2. +%% Use tdb_find_source_tuple/2 to locate the source tuple for a register. + +verified_type(any=T) -> T; +verified_type({atom,_}=T) -> T; +verified_type({binary,U}=T) when is_integer(U) -> T; +verified_type(boolean=T) -> T; +verified_type(integer=T) -> T; +verified_type({integer,{Min,Max}}=T) + when is_integer(Min), is_integer(Max) -> T; +verified_type(map=T) -> T; +verified_type(nonempty_list=T) -> T; +verified_type({tuple,_,Sz,[]}=T) when is_integer(Sz) -> T; +verified_type({tuple,_,Sz,[_]}=T) when is_integer(Sz) -> T; +verified_type({tuple_element,_,_}=T) -> T; +verified_type(float=T) -> T. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index e33df809ff..541075af2a 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -122,7 +122,7 @@ do_integers_5(X0, Y0) -> 3 -> three end. -coverage(_Config) -> +coverage(Config) -> {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), {'EXIT',{badarith,_}} = (catch a + 0.5), @@ -133,6 +133,29 @@ coverage(_Config) -> id(id(42) band 387439739874298734983787934283479243879), id(-1 band id(13)), + error = if + is_map(Config), is_integer(Config) -> ok; + true -> error + end, + error = if + is_map(Config), is_atom(Config) -> ok; + true -> error + end, + error = if + is_map(Config), is_tuple(Config) -> ok; + true -> error + end, + error = if + is_integer(Config), is_bitstring(Config) -> ok; + true -> error + end, + + ok = case Config of + <<_>> when is_binary(Config) -> + impossible; + [_|_] -> + ok + end, ok. booleans(_Config) -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 9a3ea07c97..149387bcee 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -479,8 +479,6 @@ static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -568,8 +566,6 @@ static ErlNifFunc nif_funcs[] = { {"pkey_verify_nif", 6, pkey_verify_nif}, {"pkey_crypt_nif", 6, pkey_crypt_nif}, {"rsa_generate_key_nif", 2, rsa_generate_key_nif}, - {"dh_generate_parameters_nif", 2, dh_generate_parameters_nif}, - {"dh_check", 1, dh_check}, {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif}, @@ -3006,70 +3002,6 @@ static ERL_NIF_TERM rsa_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF rsa_generate_key, argc, argv); } -static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (PrimeLen, Generator) */ - int prime_len, generator; - DH* dh_params = NULL; - int p_len, g_len; - unsigned char *p_ptr, *g_ptr; - ERL_NIF_TERM ret_p, ret_g; - const BIGNUM *dh_p, *dh_q, *dh_g; - - if (!enif_get_int(env, argv[0], &prime_len) - || !enif_get_int(env, argv[1], &generator)) { - - return enif_make_badarg(env); - } - - if (DH_generate_parameters_ex(dh_params, prime_len, generator, NULL)) { - return atom_error; - } - DH_get0_pqg(dh_params, &dh_p, &dh_q, &dh_g); - DH_free(dh_params); - p_len = BN_num_bytes(dh_p); - g_len = BN_num_bytes(dh_g); - p_ptr = enif_make_new_binary(env, p_len, &ret_p); - g_ptr = enif_make_new_binary(env, g_len, &ret_g); - BN_bn2bin(dh_p, p_ptr); - BN_bn2bin(dh_g, g_ptr); - ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len); - ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len); - return enif_make_list2(env, ret_p, ret_g); -} - -static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* ([PrimeLen, Generator]) */ - DH* dh_params; - int i; - ERL_NIF_TERM ret, head, tail; - BIGNUM *dh_p, *dh_g; - - if (!enif_get_list_cell(env, argv[0], &head, &tail) - || !get_bn_from_bin(env, head, &dh_p) - || !enif_get_list_cell(env, tail, &head, &tail) - || !get_bn_from_bin(env, head, &dh_g) - || !enif_is_empty_list(env,tail)) { - - return enif_make_badarg(env); - } - - dh_params = DH_new(); - DH_set0_pqg(dh_params, dh_p, NULL, dh_g); - if (DH_check(dh_params, &i)) { - if (i == 0) ret = atom_ok; - else if (i & DH_CHECK_P_NOT_PRIME) ret = atom_not_prime; - else if (i & DH_CHECK_P_NOT_SAFE_PRIME) ret = atom_not_strong_prime; - else if (i & DH_UNABLE_TO_CHECK_GENERATOR) ret = atom_unable_to_check_generator; - else if (i & DH_NOT_SUITABLE_GENERATOR) ret = atom_not_suitable_generator; - else ret = enif_make_tuple2(env, atom_unknown, enif_make_uint(env, i)); - } - else { /* Check Failed */ - ret = enif_make_tuple2(env, atom_error, atom_check_failed); - } - DH_free(dh_params); - return ret; -} - static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */ DH* dh_params; diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index df259d5419..ec2a1dba0a 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -42,7 +42,6 @@ -export([stream_init/2, stream_init/3, stream_encrypt/2, stream_decrypt/2]). -export([public_encrypt/4, private_decrypt/4]). -export([private_encrypt/4, public_decrypt/4]). --export([dh_generate_parameters/2, dh_check/1]). %% Testing see -export([privkey_to_pubkey/2]). -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). @@ -1090,27 +1089,6 @@ rsa_generate_key_nif(_Bits, _Exp) -> ?nif_stub. %% DH Diffie-Hellman functions %% -%% Generate (and check) Parameters is not documented because they are implemented -%% for testing (and offline parameter generation) only. -%% From the openssl doc: -%% DH_generate_parameters() may run for several hours before finding a suitable prime. -%% Thus dh_generate_parameters may in this implementation block -%% the emulator for several hours. -%% -%% usage: dh_generate_parameters(1024, 2 or 5) -> -%% [Prime=mpint(), SharedGenerator=mpint()] -dh_generate_parameters(PrimeLen, Generator) -> - case dh_generate_parameters_nif(PrimeLen, Generator) of - error -> erlang:error(generation_failed, [PrimeLen,Generator]); - Ret -> Ret - end. - -dh_generate_parameters_nif(_PrimeLen, _Generator) -> ?nif_stub. - -%% Checks that the DHParameters are ok. -%% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] -dh_check([_Prime,_Gen]) -> ?nif_stub. - %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% PrivKey = mpint() dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint, _Length) -> ?nif_stub. diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl index f206f967c7..f410542f72 100644 --- a/lib/crypto/test/engine_SUITE.erl +++ b/lib/crypto/test/engine_SUITE.erl @@ -72,7 +72,12 @@ groups() -> init_per_suite(Config) -> try crypto:start() of ok -> - Config; + case crypto:info_lib() of + [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] -> + {skip, "Problem with engine on OpenSSL 1.0.1s-freebsd"}; + _ -> + Config + end; {error,{already_started,crypto}} -> Config catch _:_ -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index b0db8228e5..9840cebc1a 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1033,7 +1033,7 @@ expr({send,Line,To0,Msg0}, Bs0, Ieval0) -> %% Binary expr({bin,Line,Fs}, Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, + Ieval = Ieval0#ieval{line=Line,top=false}, try eval_bits:expr_grp(Fs, Bs0, fun (E, B) -> expr(E, B, Ieval) end, diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index 27ca4852b5..da1d6734f8 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -29,7 +29,8 @@ bifs_outside_erlang/1, spawning/1, applying/1, catch_and_throw/1, external_call/1, test_module_info/1, apply_interpreted_fun/1, apply_uninterpreted_fun/1, - interpreted_exit/1, otp_8310/1, stacktrace/1, maps/1]). + interpreted_exit/1, otp_8310/1, stacktrace/1, maps/1, + call_inside_binary/1]). %% Helpers. -export([applier/3]). @@ -45,7 +46,8 @@ all() -> [bifs_outside_erlang, spawning, applying, catch_and_throw, external_call, test_module_info, apply_interpreted_fun, apply_uninterpreted_fun, - interpreted_exit, otp_8310, stacktrace, maps]. + interpreted_exit, otp_8310, stacktrace, maps, + call_inside_binary]. groups() -> []. @@ -275,6 +277,9 @@ maps(Config) when is_list(Config) -> [#{hello := 0, price := 0}] = spawn_eval(fun () -> ?IM:update_in_fun() end), ok. +call_inside_binary(Config) when is_list(Config) -> + <<"1">> = ?IM:call_inside_binary(fun erlang:integer_to_binary/1), + ok. do_eval(Config, Mod) -> DataDir = proplists:get_value(data_dir, Config), diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index ca7929c10b..384d61f051 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -31,6 +31,7 @@ -export([f/1, f_try/1, f_catch/1]). -export([otp_5837/1, otp_8310/0]). -export([empty_map_update/1, update_in_fun/0]). +-export([call_inside_binary/1]). %% Internal exports. -export([echo/2,my_subtract/2,catch_a_ball/0,throw_a_ball/0]). @@ -248,3 +249,6 @@ empty_map_update(Map) -> Map#{}. update_in_fun() -> lists:map(fun (X) -> X#{price := 0} end, [#{hello => 0, price => nil}]). + +call_inside_binary(Fun) -> + <<(Fun(1))/binary>>. diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index e72c1aecfc..0df15e55f9 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -197,6 +197,10 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) -> false -> [{MFA, Contract}|NewContracts] end; + {error, {extra_range, _, _}} -> + %% do not treat extra range as an error in this check + %% since that prevents discovering other actual errors + [{MFA, Contract}|NewContracts]; {error, _Error} -> NewContracts end; error -> NewContracts diff --git a/lib/dialyzer/test/small_SUITE_data/results/chars b/lib/dialyzer/test/small_SUITE_data/results/chars index 2c1f8f8d17..72fbdb4528 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/chars +++ b/lib/dialyzer/test/small_SUITE_data/results/chars @@ -1,4 +1,4 @@ -chars.erl:29: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' -chars.erl:32: Function t1/0 has no local return -chars.erl:32: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' +chars.erl:37: Invalid type specification for function chars:f/1. The success typing is (#{'b':=50}) -> 'ok' +chars.erl:40: Function t1/0 has no local return +chars.erl:40: The call chars:f(#{'b':=50}) breaks the contract (#{'a':=49,'b'=>50,'c'=>51}) -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/results/extra_range b/lib/dialyzer/test/small_SUITE_data/results/extra_range new file mode 100644 index 0000000000..ec50c95c4e --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/extra_range @@ -0,0 +1,4 @@ + +extra_range.erl:29: The pattern 'ok' can never match the type 'error' +extra_range.erl:43: The pattern 'no' can never match the type 'maybe' | 'yes' +extra_range.erl:58: The pattern 'maybe' can never match the type 'no' | 'yes' diff --git a/lib/dialyzer/test/small_SUITE_data/src/chars.erl b/lib/dialyzer/test/small_SUITE_data/src/chars.erl index 1e9c8ab6b9..62b90cf54d 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/chars.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/chars.erl @@ -12,17 +12,25 @@ -spec t() -> $0-$0..$9-$0| $?. t() -> - c(#r{f = $z - 3}), + r(#r{f = $z - 3}), + r(#r{f = 97}), + c($/), c($z - 3), c($B). -spec c(cs()) -> $3-$0..$9-$0. - -c($A + 1) -> 2; +c($A + 1) -> $9-$0; c(C) -> case C of - $z - 3 -> 3; - #r{f = $z - 3} -> 7 + $z - 3 -> $3-$0; + _ -> $7-$0 + end. + +-spec r(#r{f :: $a..$z}) -> ok | error. +r(R) -> + case R of + #r{f = $z - 3} -> error; + _ -> ok end. %% Display contract with character in warning: diff --git a/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl b/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl new file mode 100644 index 0000000000..9d6ba89c95 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/extra_range.erl @@ -0,0 +1,59 @@ +%% Test that a spec containing more items than actually returned +%% (whether by accident or by benign overspeccing) does not prevent +%% detection of impossible matches. + +-module(extra_range). + +-export([t1/2, t2/2, t3/2, t4/2]). + +-dialyzer([no_return]). + +%% this spec matches the behaviour of the code +-spec normal(integer()) -> ok | error. +normal(1) -> ok; +normal(2) -> error. + +t1(X, Y) when is_integer(X), is_integer(Y) -> + ok = normal(X), + error = normal(Y), + ok. + + +%% this spec has a typo, which should cause anyone trying to match on +%% `ok = typo(X)' to get a warning, because `ok' is not in the spec +-spec typo(integer()) -> ook | error. +typo(1) -> ok; +typo(2) -> error. + +t2(X, Y) when is_integer(X), is_integer(Y) -> + ok = typo(X), % warning expected - not allowed according to spec + error = typo(Y), + ok. + + +%% this is overspecified, and should cause a warning for trying +%% to match on `no = over(X)', because it cannot succeed and either +%% the spec should be updated or the code should be extended +-spec over(integer()) -> yes | no | maybe. +over(1) -> yes; +over(_) -> maybe. + +t3(X, Y) when is_integer(X), is_integer(Y) -> + yes = over(X), + no = over(Y), % warning expected - spec or code needs fixing + maybe = over(X + Y), + ok. + + +%% this is underspecified, which should cause anyone trying to match on +%% `maybe = under(X)' to get a warning, because `maybe' is not in the spec +-spec under(integer()) -> yes | no. +under(1) -> yes; +under(2) -> no; +under(_) -> maybe. + +t4(X, Y) when is_integer(X), is_integer(Y) -> + yes = under(X), + no = under(Y), + maybe = under(X + Y), % warning expected - not in spec + ok. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 6b84b22eb5..6bc7d147c0 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -1865,8 +1865,8 @@ An example return value with for a client service with Origin-Host {raddr,{127,0,0,1}}, {rport,3868}, {reuseaddr,true}]}]}, - {watchdog,{<0.66.0>,{1346,171491,996448},okay}}, - {peer,{<0.67.0>,{1346,171491,999906}}}, + {watchdog,{<0.66.0>,-576460736368485571,okay}}, + {peer,{<0.67.0>,-576460736357885808}}, {apps,[{0,common}]}, {caps,[{origin_host,{"client.example.com","server.example.com"}}, {origin_realm,{"example.com","example.com"}}, @@ -1946,8 +1946,8 @@ connection might look as follows.</p> {transport_config,[{reuseaddr,true}, {ip,{127,0,0,1}}, {port,3868}]}]}, - {accept,[[{watchdog,{<0.56.0>,{1346,171481,226895},okay}}, - {peer,{<0.58.0>,{1346,171491,999511}}}, + {accept,[[{watchdog,{<0.56.0>,-576460739249514012,okay}}, + {peer,{<0.58.0>,-576460638229179167}}, {apps,[{0,common}]}, {caps,[{origin_host,{"server.example.com","client.example.com"}}, {origin_realm,{"example.com","example.com"}}, @@ -1976,7 +1976,7 @@ connection might look as follows.</p> {send_max,148}, {send_avg,87}, {send_pend,0}]}]}], - [{watchdog,{<0.72.0>,{1346,171491,998404},initial}}]]}, + [{watchdog,{<0.72.0>,-576460638229717546,initial}}]]}, {statistics,[{{{0,280,0},recv},7}, {{{0,280,1},send},7}, {{{0,280,0},recv,{'Result-Code',2001}},7}, @@ -2024,8 +2024,8 @@ A return value for the server above might look as follows.</p> {transport_config,[{reuseaddr,true}, {ip,{127,0,0,1}}, {port,3868}]}]}, - {watchdog,{<0.56.0>,{1346,171481,226895},okay}}, - {peer,{<0.58.0>,{1346,171491,999511}}}, + {watchdog,{<0.56.0>,-576460739249514012,okay}}, + {peer,{<0.58.0>,-576460638229179167}}, {apps,[{0,common}]}, {caps,[{origin_host,{"server.example.com","client.example.com"}}, {origin_realm,{"example.com","example.com"}}, diff --git a/lib/diameter/src/base/diameter_reg.erl b/lib/diameter/src/base/diameter_reg.erl index 5b7cfab31a..c1762a07e3 100644 --- a/lib/diameter/src/base/diameter_reg.erl +++ b/lib/diameter/src/base/diameter_reg.erl @@ -246,8 +246,11 @@ handle_call({add, Uniq, Key}, {Pid, _}, S) -> handle_call({remove, Key}, {Pid, _}, S) -> Rec = {Key, Pid}, - ets:delete_object(?TABLE, Rec), - {reply, true, notify(remove, Rec, S)}; + {reply, true, try + notify(remove, Rec, S) + after + ets:delete_object(?TABLE, Rec) + end}; handle_call({wait, Pat}, {Pid, _} = From, S) -> NS = add_monitor(Pid, S), @@ -370,10 +373,12 @@ send({_,_} = From, add, Rec) -> down(Pid, #state{monitors = Ps} = S) -> Recs = match('_', Pid), - ets:match_delete(?TABLE, {'_', Pid}), - lists:foldl(fun(R,NS) -> notify(remove, R, NS) end, - flush(Pid, S#state{monitors = sets:del_element(Pid, Ps)}), - Recs). + Acc0 = flush(Pid, S#state{monitors = sets:del_element(Pid, Ps)}), + try + lists:foldl(fun(R,NS) -> notify(remove, R, NS) end, Acc0, Recs) + after + ets:match_delete(?TABLE, {'_', Pid}) + end. %% flush/3 diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 31dd92f878..cbe66ef27a 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -151,7 +151,7 @@ apps :: match([{0..16#FFFFFFFF, diameter:app_alias()}] %% {Id, Alias} | [diameter:app_alias()]), %% remote caps :: match(#diameter_caps{}), - started = diameter_lib:now(), %% at process start or sharing + started = diameter_lib:now(), %% at connection_up watchdog :: match(pid() %% key into watchdogT | undefined)}). %% undefined if remote @@ -554,15 +554,25 @@ terminate(Reason, #state{service_name = Name, local = {PeerT, _, _}} = S) -> %% wait for watchdog state changes to take care of if. That this %% takes place after deleting the state entry ensures that the %% resulting failover by request processes accomplishes nothing. - ets:foldl(fun(#peer{pid = TPid}, _) -> - diameter_traffic:peer_down(TPid) - end, - ok, - PeerT), + ets:foldl(fun peer_down/2, ok, PeerT), shutdown == Reason %% application shutdown andalso shutdown(application, S). +%% peer_down/1 +%% +%% Entries with watchdog state SUSPECT are already down: ignore the +%% expected failure. This assumes the current implementation, but +%% double the number of lookups (in the typical case) could be the +%% greater evil if there are many peer connections. + +peer_down(#peer{pid = TPid}, _) -> + try + diameter_traffic:peer_down(TPid) + catch + error: {badmatch, []} -> ok + end. + %% --------------------------------------------------------------------------- %% # code_change/3 %% --------------------------------------------------------------------------- diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index 7da59f8b25..05a8c9378e 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2017. All Rights Reserved. +%% Copyright Ericsson AB 2010-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -54,10 +54,10 @@ {"1.12.1", [{restart_application, diameter}]}, %% 19.1 {"1.12.2", [{restart_application, diameter}]}, %% 19.3 {"2.0", [{restart_application, diameter}]}, %% 20.0 - {"2.1", [{load_module, diameter_gen}, %% 20.1 - {update, diameter_reg, {advanced, "2.1"}}]}, - {"2.1.1", [{load_module, diameter_gen}]}, %% 20.1.2 - {"2.1.2", []} %% 20.1.3 + {"2.1", [{restart_application, diameter}]}, %% 20.1 + {"2.1.1", [{restart_application, diameter}]}, %% 20.1.2 + {"2.1.2", [{restart_application, diameter}]}, %% 20.1.3 + {"2.1.3", [{restart_application, diameter}]} %% 20.2 ], [ {"0.9", [{restart_application, diameter}]}, @@ -94,7 +94,8 @@ {"1.12.2", [{restart_application, diameter}]}, {"2.0", [{restart_application, diameter}]}, {"2.1", [{restart_application, diameter}]}, - {"2.1.1", [{load_module, diameter_gen}]}, - {"2.1.2", []} + {"2.1.1", [{restart_application, diameter}]}, + {"2.1.2", [{restart_application, diameter}]}, + {"2.1.3", [{restart_application, diameter}]} ] }. diff --git a/lib/diameter/vsn.mk b/lib/diameter/vsn.mk index 0c852d75cd..b0fb4ada28 100644 --- a/lib/diameter/vsn.mk +++ b/lib/diameter/vsn.mk @@ -1,6 +1,6 @@ # %CopyrightBegin% # -# Copyright Ericsson AB 2010-2017. All Rights Reserved. +# Copyright Ericsson AB 2010-2018. All Rights Reserved. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. @@ -17,5 +17,5 @@ # %CopyrightEnd% APPLICATION = diameter -DIAMETER_VSN = 2.1.3 +DIAMETER_VSN = 2.1.4 APP_VSN = $(APPLICATION)-$(DIAMETER_VSN)$(PRE_VSN) diff --git a/lib/inets/doc/src/http_client.xml b/lib/inets/doc/src/http_client.xml index 212958f17f..15e383ec77 100644 --- a/lib/inets/doc/src/http_client.xml +++ b/lib/inets/doc/src/http_client.xml @@ -97,27 +97,32 @@ 7 > {ok, {{NewVersion, 200, NewReasonPhrase}, NewHeaders, NewBody}} = httpc:request(get, {"http://www.erlang.org", [{"connection", "close"}]}, [], []).</code> - + <p>This sends an HTTP request over a unix domain socket (experimental):</p> + <code type="erl"> + 8 > httpc:set_options([{ipfamily, local}, + {unix_socket,"/tmp/unix_socket/consul_http.sock"}]). + 9 > {ok, {{NewVersion, 200, NewReasonPhrase}, NewHeaders, NewBody}} = + httpc:request(put, {"http:///v1/kv/foo", [], [], "hello"}, [], []).</code> <p>Start an HTTP client profile:</p> <code><![CDATA[ - 8 > {ok, Pid} = inets:start(httpc, [{profile, foo}]). + 10 > {ok, Pid} = inets:start(httpc, [{profile, foo}]). {ok, <0.45.0>} ]]></code> <p>The new profile has no proxy settings, so the connection is refused:</p> <code type="erl"> - 9 > httpc:request("http://www.erlang.org", foo). + 11 > httpc:request("http://www.erlang.org", foo). {error, econnrefused}</code> <p>Stop the HTTP client profile:</p> <code type="erl"> - 10 > inets:stop(httpc, foo). + 12 > inets:stop(httpc, foo). ok</code> <p>Alternative way to stop the HTTP client profile:</p> <code type="erl"> - 10 > inets:stop(httpc, Pid). + 13 > inets:stop(httpc, Pid). ok</code> </section> diff --git a/lib/inets/doc/src/http_uri.xml b/lib/inets/doc/src/http_uri.xml index 20c042c202..f57214a7ce 100644 --- a/lib/inets/doc/src/http_uri.xml +++ b/lib/inets/doc/src/http_uri.xml @@ -45,7 +45,6 @@ this module:</p> <p><c>boolean() = true | false</c></p> <p><c>string()</c> = list of ASCII characters</p> - <p><c>unicode_binary()</c> = binary() with characters encoded in the UTF-8 coding standard</p> </section> @@ -54,22 +53,22 @@ <p>Type definitions that are related to URI:</p> <taglist> - <tag><c>uri() = string() | unicode:unicode_binary()</c></tag> + <tag><c>uri() = string() | binary()</c></tag> <item><p>Syntax according to the URI definition in RFC 3986, for example, "http://www.erlang.org/"</p></item> - <tag><c>user_info() = string() | unicode:unicode_binary()</c></tag> + <tag><c>user_info() = string() | binary()</c></tag> <item><p></p></item> <tag><c>scheme() = atom()</c></tag> <item><p>Example: http, https</p></item> - <tag><c>host() = string() | unicode:unicode_binary()</c></tag> + <tag><c>host() = string() | binary()</c></tag> <item><p></p></item> - <tag><c>port() = pos_integer()</c></tag> + <tag><c>port() = inet:port_number()</c></tag> <item><p></p></item> - <tag><c>path() = string() | unicode:unicode_binary()</c></tag> + <tag><c>path() = string() | binary()</c></tag> <item><p>Represents a file path or directory path</p></item> - <tag><c>query() = string() | unicode:unicode_binary()</c></tag> + <tag><c>query() = string() | binary()</c></tag> <item><p></p></item> - <tag><c>fragment() = string() | unicode:unicode_binary()</c></tag> + <tag><c>fragment() = string() | binary()</c></tag> <item><p></p></item> </taglist> @@ -84,7 +83,7 @@ <fsummary>Decodes a hexadecimal encoded URI.</fsummary> <type> - <v>HexEncodedURI = string() | unicode:unicode_binary() - A possibly hexadecimal encoded URI</v> + <v>HexEncodedURI = string() | binary() - A possibly hexadecimal encoded URI</v> <v>URI = uri()</v> </type> @@ -99,7 +98,7 @@ <fsummary>Encodes a hexadecimal encoded URI.</fsummary> <type> <v>URI = uri()</v> - <v>HexEncodedURI = string() | unicode:unicode_binary() - Hexadecimal encoded URI</v> + <v>HexEncodedURI = string() | binary() - Hexadecimal encoded URI</v> </type> <desc> @@ -119,12 +118,13 @@ <v>Option = {ipv6_host_with_brackets, boolean()} | {scheme_defaults, scheme_defaults()} | {fragment, boolean()} | - {scheme_validation_fun, fun()}]</v> + {scheme_validation_fun, fun()}</v> <v>Result = {Scheme, UserInfo, Host, Port, Path, Query} | {Scheme, UserInfo, Host, Port, Path, Query, Fragment}</v> + <v>Scheme = scheme()</v> <v>UserInfo = user_info()</v> <v>Host = host()</v> - <v>Port = pos_integer()</v> + <v>Port = inet:port_number()</v> <v>Path = path()</v> <v>Query = query()</v> <v>Fragment = fragment()</v> @@ -146,13 +146,20 @@ <p>Scheme validation fun is to be defined as follows:</p> <code> -fun(SchemeStr :: string() | unicode:unicode_binary()) -> +fun(SchemeStr :: string() | binary()) -> valid | {error, Reason :: term()}. </code> <p>It is called before scheme string gets converted into scheme atom and thus possible atom leak could be prevented</p> + <warning> + <p>The scheme portion of the URI gets converted into atom, + meaning that atom leak may occur. Specifying a scheme + validation fun is recommended unless the URI is already + sanitized.</p> + </warning> + <marker id="encode"></marker> </desc> </func> @@ -162,7 +169,7 @@ fun(SchemeStr :: string() | unicode:unicode_binary()) -> <fsummary>A list of the scheme and their default ports.</fsummary> <type> <v>SchemeDefaults = [{scheme(), default_scheme_port_number()}] </v> - <v>default_scheme_port_number() = pos_integer()</v> + <v>default_scheme_port_number() = inet:port_number()</v> </type> <desc> <p>Provides a list of the scheme and their default diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index 58714328c5..14662f257c 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -210,7 +210,8 @@ ip | port | socket_opts | - verbose</v> + verbose | + unix_socket</v> <v>Profile = profile() | pid()</v> <d>When started <c>stand_alone</c> only the pid can used.</d> <v>Values = [{option_item(), term()}]</v> @@ -297,8 +298,8 @@ {full_result, boolean()} | {headers_as_is, boolean() | {socket_opts, socket_opts()} | - {receiver, receiver()}, - {ipv6_host_with_brackets, boolean()}}</v> + {receiver, receiver()} | + {ipv6_host_with_brackets, boolean()}</v> <v>stream_to() = none | self | {self, once} | filename()</v> <v>socket_opts() = [socket_opt()]</v> <v>receiver() = pid() | function()/1 | {Module, Function, Args}</v> @@ -533,7 +534,8 @@ <v>| {ip, IpAddress}</v> <v>| {port, Port}</v> <v>| {socket_opts, socket_opts()}</v> - <v>| {verbose, VerboseMode}</v> + <v>| {verbose, VerboseMode}</v> + <v>| {unix_socket, UnixSocket}</v> <v>Proxy = {Hostname, Port}</v> <v>Hostname = string()</v> <d>Example: "localhost" or "foo.bar.se"</d> @@ -576,7 +578,7 @@ If option <c>verify</c> is used, function <c>store_cookies/2</c> has to be called for the cookies to be saved. Default is <c>disabled</c>.</d> - <v>IpFamily = inet | inet6 </v> + <v>IpFamily = inet | inet6 | local</v> <d>Default is <c>inet</c>.</d> <v>IpAddress = ip_address()</v> <d>If the host has several network interfaces, this option specifies @@ -601,6 +603,12 @@ It is a debug feature.</d> <v>Profile = profile() | pid()</v> <d>When started <c>stand_alone</c> only the pid can be used.</d> + <v>UnixSocket = path()</v> + <d> + Experimental option for sending HTTP requests over a unix domain socket. The value + of <c>unix_socket</c> shall be the full path to a unix domain socket file with read/write + permissions for the erlang process. Default is <c>undefined</c>. + </d> </type> <desc> <p>Sets options to be used for subsequent requests.</p> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index 821eb7f02f..a73503a5ce 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -171,6 +171,7 @@ request(Method, HTTPOptions, Options, Profile) when (Method =:= options) orelse (Method =:= get) orelse + (Method =:= put) orelse (Method =:= head) orelse (Method =:= delete) orelse (Method =:= trace) andalso @@ -531,6 +532,7 @@ handle_request(Method, Url, Stream = proplists:get_value(stream, Options), Receiver = proplists:get_value(receiver, Options), SocketOpts = proplists:get_value(socket_opts, Options), + UnixSocket = proplists:get_value(unix_socket, Options), BracketedHost = proplists:get_value(ipv6_host_with_brackets, Options), @@ -558,6 +560,7 @@ handle_request(Method, Url, headers_as_is = headers_as_is(Headers0, Options), socket_opts = SocketOpts, started = Started, + unix_socket = UnixSocket, ipv6_host_with_brackets = BracketedHost}, case httpc_manager:request(Request, profile_name(Profile)) of {ok, RequestId} -> @@ -823,7 +826,7 @@ request_options_defaults() -> error end, - VerifyBrackets = VerifyBoolean, + VerifyBrackets = VerifyBoolean, [ {sync, true, VerifySync}, @@ -894,11 +897,36 @@ request_options_sanity_check(Opts) -> end, ok. -validate_options(Options) -> - (catch validate_options(Options, [])). - -validate_options([], ValidateOptions) -> - {ok, lists:reverse(ValidateOptions)}; +validate_ipfamily_unix_socket(Options0) -> + IpFamily = proplists:get_value(ipfamily, Options0, inet), + UnixSocket = proplists:get_value(unix_socket, Options0, undefined), + Options1 = proplists:delete(ipfamily, Options0), + Options2 = proplists:delete(ipfamily, Options1), + validate_ipfamily_unix_socket(IpFamily, UnixSocket, Options2, + [{ipfamily, IpFamily}, {unix_socket, UnixSocket}]). +%% +validate_ipfamily_unix_socket(local, undefined, _Options, _Acc) -> + bad_option(unix_socket, undefined); +validate_ipfamily_unix_socket(IpFamily, UnixSocket, _Options, _Acc) + when IpFamily =/= local, UnixSocket =/= undefined -> + bad_option(ipfamily, IpFamily); +validate_ipfamily_unix_socket(IpFamily, UnixSocket, Options, Acc) -> + validate_ipfamily(IpFamily), + validate_unix_socket(UnixSocket), + {Options, Acc}. + + +validate_options(Options0) -> + try + {Options, Acc} = validate_ipfamily_unix_socket(Options0), + validate_options(Options, Acc) + catch + error:Reason -> + {error, Reason} + end. +%% +validate_options([], ValidOptions) -> + {ok, lists:reverse(ValidOptions)}; validate_options([{proxy, Proxy} = Opt| Tail], Acc) -> validate_proxy(Proxy), @@ -958,6 +986,10 @@ validate_options([{verbose, Value} = Opt| Tail], Acc) -> validate_verbose(Value), validate_options(Tail, [Opt | Acc]); +validate_options([{unix_socket, Value} = Opt| Tail], Acc) -> + validate_unix_socket(Value), + validate_options(Tail, [Opt | Acc]); + validate_options([{_, _} = Opt| _], _Acc) -> {error, {not_an_option, Opt}}. @@ -1026,7 +1058,8 @@ validate_ipv6(BadValue) -> bad_option(ipv6, BadValue). validate_ipfamily(Value) - when (Value =:= inet) orelse (Value =:= inet6) orelse (Value =:= inet6fb4) -> + when (Value =:= inet) orelse (Value =:= inet6) orelse + (Value =:= inet6fb4) orelse (Value =:= local) -> Value; validate_ipfamily(BadValue) -> bad_option(ipfamily, BadValue). @@ -1056,6 +1089,15 @@ validate_verbose(Value) validate_verbose(BadValue) -> bad_option(verbose, BadValue). +validate_unix_socket(Value) + when (Value =:= undefined) -> + Value; +validate_unix_socket(Value) + when is_list(Value) andalso length(Value) > 0 -> + Value; +validate_unix_socket(BadValue) -> + bad_option(unix_socket, BadValue). + bad_option(Option, BadValue) -> throw({error, {bad_option, Option, BadValue}}). diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl index e398b4f0aa..9b09832eb8 100644 --- a/lib/inets/src/http_client/httpc_handler.erl +++ b/lib/inets/src/http_client/httpc_handler.erl @@ -754,6 +754,7 @@ connect(SocketType, ToAddress, #options{ipfamily = IpFamily, ip = FromAddress, port = FromPort, + unix_socket = UnixSocket, socket_opts = Opts0}, Timeout) -> Opts1 = case FromPort of @@ -789,6 +790,16 @@ connect(SocketType, ToAddress, OK -> OK end; + local -> + Opts3 = [IpFamily | Opts2], + SocketAddr = {local, UnixSocket}, + case http_transport:connect(SocketType, {SocketAddr, 0}, Opts3, Timeout) of + {error, Reason} -> + {error, {failed_connect, [{to_address, SocketAddr}, + {IpFamily, Opts3, Reason}]}}; + Else -> + Else + end; _ -> Opts3 = [IpFamily | Opts2], case http_transport:connect(SocketType, ToAddress, Opts3, Timeout) of @@ -800,9 +811,23 @@ connect(SocketType, ToAddress, end end. -connect_and_send_first_request(Address, Request, #state{options = Options} = State) -> +handle_unix_socket_options(#request{unix_socket = UnixSocket}, Options) + when UnixSocket =:= undefined -> + Options; + +handle_unix_socket_options(#request{unix_socket = UnixSocket}, + Options = #options{ipfamily = IpFamily}) -> + case IpFamily of + local -> + Options#options{unix_socket = UnixSocket}; + Else -> + error({badarg, [{ipfamily, Else}, {unix_socket, UnixSocket}]}) + end. + +connect_and_send_first_request(Address, Request, #state{options = Options0} = State) -> SocketType = socket_type(Request), ConnTimeout = (Request#request.settings)#http_options.connect_timeout, + Options = handle_unix_socket_options(Request, Options0), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> ClientClose = @@ -841,9 +866,10 @@ connect_and_send_first_request(Address, Request, #state{options = Options} = Sta {ok, State#state{request = Request}} end. -connect_and_send_upgrade_request(Address, Request, #state{options = Options} = State) -> +connect_and_send_upgrade_request(Address, Request, #state{options = Options0} = State) -> ConnTimeout = (Request#request.settings)#http_options.connect_timeout, SocketType = ip_comm, + Options = handle_unix_socket_options(Request, Options0), case connect(SocketType, Address, Options, ConnTimeout) of {ok, Socket} -> SessionType = httpc_manager:session_type(Options), diff --git a/lib/inets/src/http_client/httpc_internal.hrl b/lib/inets/src/http_client/httpc_internal.hrl index 5f8c70f28d..c5fe439722 100644 --- a/lib/inets/src/http_client/httpc_internal.hrl +++ b/lib/inets/src/http_client/httpc_internal.hrl @@ -83,10 +83,11 @@ max_sessions = ?HTTP_MAX_TCP_SESSIONS, cookies = disabled, % enabled | disabled | verify verbose = false, % boolean(), - ipfamily = inet, % inet | inet6 | inet6fb4 + ipfamily = inet, % inet | inet6 | inet6fb4 | local ip = default, % specify local interface port = default, % specify local port - socket_opts = [] % other socket options + socket_opts = [], % other socket options + unix_socket = undefined % Local unix socket } ). -type options() :: #options{}. @@ -115,6 +116,7 @@ % request timer :: undefined | reference(), socket_opts, % undefined | [socket_option()] + unix_socket, % undefined | string() ipv6_host_with_brackets % boolean() } ). diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl index ffdf1603b3..7b8d7875de 100644 --- a/lib/inets/src/http_client/httpc_manager.erl +++ b/lib/inets/src/http_client/httpc_manager.erl @@ -553,7 +553,8 @@ handle_cast({set_options, Options}, State = #state{options = OldOptions}) -> ip = get_ip(Options, OldOptions), port = get_port(Options, OldOptions), verbose = get_verbose(Options, OldOptions), - socket_opts = get_socket_opts(Options, OldOptions) + socket_opts = get_socket_opts(Options, OldOptions), + unix_socket = get_unix_socket_opts(Options, OldOptions) }, case {OldOptions#options.verbose, NewOptions#options.verbose} of {Same, Same} -> @@ -963,7 +964,10 @@ get_option(ip, #options{ip = IP}) -> get_option(port, #options{port = Port}) -> Port; get_option(socket_opts, #options{socket_opts = SocketOpts}) -> - SocketOpts. + SocketOpts; +get_option(unix_socket, #options{unix_socket = UnixSocket}) -> + UnixSocket. + get_proxy(Opts, #options{proxy = Default}) -> proplists:get_value(proxy, Opts, Default). @@ -1016,6 +1020,8 @@ get_verbose(Opts, #options{verbose = Default}) -> get_socket_opts(Opts, #options{socket_opts = Default}) -> proplists:get_value(socket_opts, Opts, Default). +get_unix_socket_opts(Opts, #options{unix_socket = Default}) -> + proplists:get_value(unix_socket, Opts, Default). handle_verbose(debug) -> dbg:p(self(), [call]), diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 7f1ca02014..d02913121c 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -61,19 +61,35 @@ scheme_defaults/0, encode/1, decode/1]). --export_type([scheme/0, default_scheme_port_number/0]). +-export_type([uri/0, + user_info/0, + scheme/0, default_scheme_port_number/0, + host/0, + path/0, + query/0, + fragment/0]). +-type uri() :: string() | binary(). +-type user_info() :: string() | binary(). +-type scheme() :: atom(). +-type host() :: string() | binary(). +-type path() :: string() | binary(). +-type query() :: string() | binary(). +-type fragment() :: string() | binary(). +-type port_number() :: inet:port_number(). +-type default_scheme_port_number() :: port_number(). +-type hex_uri() :: string() | binary(). %% Hexadecimal encoded URI. +-type maybe_hex_uri() :: string() | binary(). %% A possibly hexadecimal encoded URI. + +-type scheme_defaults() :: [{scheme(), default_scheme_port_number()}]. +-type scheme_validation_fun() :: fun((SchemeStr :: string() | binary()) -> + valid | {error, Reason :: term()}). %%%========================================================================= %%% API %%%========================================================================= --type scheme() :: atom(). --type default_scheme_port_number() :: pos_integer(). - --spec scheme_defaults() -> - [{scheme(), default_scheme_port_number()}]. - +-spec scheme_defaults() -> scheme_defaults(). scheme_defaults() -> [{http, 80}, {https, 443}, @@ -82,9 +98,20 @@ scheme_defaults() -> {sftp, 22}, {tftp, 69}]. +-type parse_result() :: + {scheme(), user_info(), host(), port_number(), path(), query()} | + {scheme(), user_info(), host(), port_number(), path(), query(), + fragment()}. + +-spec parse(uri()) -> {ok, parse_result()} | {error, term()}. parse(AbsURI) -> parse(AbsURI, []). +-spec parse(uri(), [Option]) -> {ok, parse_result()} | {error, term()} when + Option :: {ipv6_host_with_brackets, boolean()} | + {scheme_defaults, scheme_defaults()} | + {fragment, boolean()} | + {scheme_validation_fun, scheme_validation_fun() | none}. parse(AbsURI, Opts) -> case parse_scheme(AbsURI, Opts) of {error, Reason} -> @@ -105,6 +132,7 @@ reserved() -> $#, $[, $], $<, $>, $\", ${, $}, $|, %" $\\, $', $^, $%, $ ]). +-spec encode(uri()) -> hex_uri(). encode(URI) when is_list(URI) -> Reserved = reserved(), lists:append([uri_encode(Char, Reserved) || Char <- URI]); @@ -112,6 +140,7 @@ encode(URI) when is_binary(URI) -> Reserved = reserved(), << <<(uri_encode_binary(Char, Reserved))/binary>> || <<Char>> <= URI >>. +-spec decode(maybe_hex_uri()) -> uri(). decode(String) when is_list(String) -> do_decode(String); decode(String) when is_binary(String) -> diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index e24a4a8694..a86413147c 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,14 +18,10 @@ %% %CopyrightEnd% {"%VSN%", [ - {<<"6.4.5">>, [{load_module, httpc_handler, - soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ], [ - {<<"6.4.5">>, [{load_module, httpc_handler, - soft_purge, soft_purge, []}]}, {<<"6\\..*">>,[{restart_application, inets}]}, {<<"5\\..*">>,[{restart_application, inets}]} ] diff --git a/lib/inets/test/http_test_lib.erl b/lib/inets/test/http_test_lib.erl index 38e9e4976e..4e119cce04 100644 --- a/lib/inets/test/http_test_lib.erl +++ b/lib/inets/test/http_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -55,6 +55,25 @@ dummy_server_init(Caller, ip_comm, Inet, Extra) -> ]]}, [], ContentCb, Conf, ListenSocket); +dummy_server_init(Caller, unix_socket, Inet, Extra) -> + ContentCb = proplists:get_value(content_cb, Extra), + UnixSocket = proplists:get_value(unix_socket, Extra), + SocketAddr = {local, UnixSocket}, + BaseOpts = [binary, {packet, 0}, {reuseaddr,true}, {active, false}, {nodelay, true}, + {ifaddr, SocketAddr}], + Conf = proplists:get_value(conf, Extra), + {ok, ListenSocket} = gen_tcp:listen(0, [Inet | BaseOpts]), + {ok, Port} = inet:port(ListenSocket), + Caller ! {port, Port}, + dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}, + {customize, httpd_custom} + ]]}, + [], ContentCb, Conf, ListenSocket); + dummy_server_init(Caller, ssl, Inet, Extra) -> ContentCb = proplists:get_value(content_cb, Extra), SSLOptions = proplists:get_value(ssl, Extra), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 4bb449408f..38705372c9 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -37,6 +37,10 @@ -define(TLS_URL_START, "https://"). -define(NOT_IN_USE_PORT, 8997). +%% Using hardcoded file path to keep it below 107 charaters +%% (maximum length supported by erlang) +-define(UNIX_SOCKET, "/tmp/inets_httpc_SUITE.sock"). + -record(sslsocket, {fd = nil, pid = nil}). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- @@ -51,6 +55,7 @@ all() -> {group, http}, {group, sim_http}, {group, http_internal}, + {group, http_unix_socket}, {group, https}, {group, sim_https}, {group, misc} @@ -64,6 +69,7 @@ groups() -> %% will fail. {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]}, {http_internal, [], real_requests_esi()}, + {http_unix_socket, [], simulated_unix_socket()}, {https, [], real_requests()}, {sim_https, [], only_simulated()}, {misc, [], misc()} @@ -102,6 +108,9 @@ real_requests()-> real_requests_esi() -> [slow_connection]. +simulated_unix_socket() -> + [unix_domain_socket]. + only_simulated() -> [ cookie, @@ -187,15 +196,29 @@ init_per_group(Group, Config0) when Group =:= sim_https; Group =:= https-> _:_ -> {skip, "Crypto did not start"} end; - +init_per_group(http_unix_socket = Group, Config0) -> + case os:type() of + {win32,_} -> + {skip, "Unix Domain Sockets are not supported on Windows"}; + _ -> + file:delete(?UNIX_SOCKET), + start_apps(Group), + Config = proplists:delete(port, Config0), + Port = server_start(Group, server_config(Group, Config)), + [{port, Port} | Config] + end; init_per_group(Group, Config0) -> start_apps(Group), Config = proplists:delete(port, Config0), Port = server_start(Group, server_config(Group, Config)), [{port, Port} | Config]. +end_per_group(http_unix_socket,_Config) -> + file:delete(?UNIX_SOCKET), + ok; end_per_group(_, _Config) -> ok. + do_init_per_group(Group, Config0) -> Config = proplists:delete(port, Config0), Port = server_start(Group, server_config(Group, Config)), @@ -1268,6 +1291,21 @@ slow_connection(Config) when is_list(Config) -> %% in httpc_handler. {ok, _} = httpc:request(post, Request, [], []). +%%------------------------------------------------------------------------- +unix_domain_socket() -> + [{"doc, Test HTTP requests over unix domain sockets"}]. +unix_domain_socket(Config) when is_list(Config) -> + + URL = "http:///v1/kv/foo", + + {ok,[{unix_socket,?UNIX_SOCKET}]} = + httpc:get_options([unix_socket]), + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(put, {URL, [], [], ""}, [], []), + {ok, {{_,200,_}, [_ | _], _}} + = httpc:request(get, {URL, []}, [], []). + + %%-------------------------------------------------------------------- %% Internal Functions ------------------------------------------------ @@ -1383,19 +1421,28 @@ group_name(Config) -> server_start(sim_http, _) -> Inet = inet_version(), - ok = httpc:set_options([{ipfamily, Inet}]), + ok = httpc:set_options([{ipfamily, Inet},{unix_socket, undefined}]), {_Pid, Port} = http_test_lib:dummy_server(ip_comm, Inet, [{content_cb, ?MODULE}]), Port; server_start(sim_https, SslConfig) -> Inet = inet_version(), - ok = httpc:set_options([{ipfamily, Inet}]), + ok = httpc:set_options([{ipfamily, Inet},{unix_socket, undefined}]), {_Pid, Port} = http_test_lib:dummy_server(ssl, Inet, [{ssl, SslConfig}, {content_cb, ?MODULE}]), Port; +server_start(http_unix_socket, Config) -> + Inet = local, + Socket = proplists:get_value(unix_socket, Config), + ok = httpc:set_options([{ipfamily, Inet},{unix_socket, Socket}]), + {_Pid, Port} = http_test_lib:dummy_server(unix_socket, Inet, [{content_cb, ?MODULE}, + {unix_socket, Socket}]), + Port; + server_start(_, HttpdConfig) -> {ok, Pid} = inets:start(httpd, HttpdConfig), Serv = inets:services_info(), + ok = httpc:set_options([{ipfamily, inet_version()},{unix_socket, undefined}]), {value, {_, _, Info}} = lists:keysearch(Pid, 2, Serv), proplists:get_value(port, Info). @@ -1425,6 +1472,10 @@ server_config(https, Config) -> [{socket_type, {essl, ssl_config(Config)}} | server_config(http, Config)]; server_config(sim_https, Config) -> ssl_config(Config); +server_config(http_unix_socket, _Config) -> + Socket = ?UNIX_SOCKET, + [{unix_socket, Socket}]; + server_config(_, _) -> []. @@ -2169,6 +2220,19 @@ handle_uri(_,"/delay_close.html",_,_,Socket,_) -> handle_uri("HEAD",_,_,_,_,_) -> "HTTP/1.1 200 ok\r\n" ++ "Content-Length:0\r\n\r\n"; +handle_uri("PUT","/v1/kv/foo",_,_,_,_) -> + "HTTP/1.1 200 OK\r\n" ++ + "Date: Tue, 20 Feb 2018 14:39:08 GMT\r\n" ++ + "Content-Length: 5\r\n\r\n" ++ + "Content-Type: application/json\r\n\r\n" ++ + "true\n"; +handle_uri("GET","/v1/kv/foo",_,_,_,_) -> + "HTTP/1.1 200 OK\r\n" ++ + "Date: Tue, 20 Feb 2018 14:39:08 GMT\r\n" ++ + "Content-Length: 24\r\n" ++ + "Content-Type: application/json\r\n\r\n" ++ + "[{\"Value\": \"aGVsbG8=\"}]\n"; + handle_uri(_,_,_,_,_,DefaultResponse) -> DefaultResponse. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index dccdbfa94a..1fad9afe33 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.4.6 +INETS_VSN = 6.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index abb045b744..9552332948 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2017</year> + <year>1997</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -277,9 +277,7 @@ fe80::204:acff:fe17:bf38 <p>Returns a <c>hostent</c> record for the host with the specified hostname.</p> <p>If resolver option <c>inet6</c> is <c>true</c>, - an IPv6 address is looked up. If that fails, - the IPv4 address is looked up and returned on - IPv6-mapped IPv4 format.</p> + an IPv6 address is looked up.</p> </desc> </func> @@ -582,6 +580,19 @@ get_tcpi_sacked(Sock) -> </func> <func> + <name name="ipv4_mapped_ipv6_address" arity="1" /> + <fsummary>Convert to and from IPv4-mapped IPv6 address.</fsummary> + <desc> + <p> + Convert an IPv4 address to an IPv4-mapped IPv6 address + or the reverse. When converting from an IPv6 address + all but the 2 low words are ignored so this function also + works on some other types of addresses than IPv4-mapped. + </p> + </desc> + </func> + + <func> <name name="parse_strict_address" arity="1" /> <fsummary>Parse an IPv4 or IPv6 address strict.</fsummary> <desc> diff --git a/lib/kernel/doc/src/inet_res.xml b/lib/kernel/doc/src/inet_res.xml index 3454e3c6f9..351d86a93a 100644 --- a/lib/kernel/doc/src/inet_res.xml +++ b/lib/kernel/doc/src/inet_res.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2009</year><year>2015</year> + <year>2009</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -230,9 +230,7 @@ inet_dns:record_type(_) -> undefined.</pre> <seealso marker="#getbyname/2"><c>getbyname/2,3</c></seealso>. </p> <p>If resolver option <c>inet6</c> is <c>true</c>, - an IPv6 address is looked up. If that fails, - the IPv4 address is looked up and returned on - IPv6-mapped IPv4 format.</p> + an IPv6 address is looked up.</p> </desc> </func> diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml index adec2d9520..fab616e630 100644 --- a/lib/kernel/doc/src/rpc.xml +++ b/lib/kernel/doc/src/rpc.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2016</year> + <year>1996</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -217,7 +217,7 @@ <list type="bulleted"> <item>A list of the nodes that do not exist</item> <item>A list of the nodes where the server does not exist</item> - <item>A list of the nodes where the server terminatd before sending + <item>A list of the nodes where the server terminated before sending any reply.</item> </list> </desc> @@ -268,8 +268,9 @@ on the specified nodes and collects the answers. It returns <c>{<anno>ResL</anno>, <anno>BadNodes</anno>}</c>, where <c><anno>BadNodes</anno></c> is a list - of the nodes that terminated or timed out during computation, - and <c><anno>ResL</anno></c> is a list of the return values. + of the nodes that do not exist, + and <c><anno>ResL</anno></c> is a list of the return values, + or <c>{badrpc, <anno>Reason</anno>}</c> for failing calls. <c><anno>Timeout</anno></c> is a time (integer) in milliseconds, or <c>infinity</c>.</p> <p>The following example is useful when new object code is to @@ -347,7 +348,7 @@ <func> <name name="pmap" arity="3"/> - <fsummary>Parallell evaluation of mapping a function over a + <fsummary>Parallel evaluation of mapping a function over a list.</fsummary> <desc> <p>Evaluates <c>apply(<anno>Module</anno>, <anno>Function</anno>, diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index fe91b0d33e..4bad523dff 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,7 +34,8 @@ ip/1, stats/0, options/0, pushf/3, popf/1, close/1, gethostname/0, gethostname/1, parse_ipv4_address/1, parse_ipv6_address/1, parse_ipv4strict_address/1, - parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, ntoa/1]). + parse_ipv6strict_address/1, parse_address/1, parse_strict_address/1, + ntoa/1, ipv4_mapped_ipv6_address/1]). -export([connect_options/2, listen_options/2, udp_options/2, sctp_options/2]). -export([udp_module/1, tcp_module/1, tcp_module/2, sctp_module/1]). @@ -675,6 +676,14 @@ parse_address(Addr) -> parse_strict_address(Addr) -> inet_parse:strict_address(Addr). +-spec ipv4_mapped_ipv6_address(ip_address()) -> ip_address(). +ipv4_mapped_ipv6_address({D1,D2,D3,D4}) + when (D1 bor D2 bor D3 bor D4) < 256 -> + {0,0,0,0,0,16#ffff,(D1 bsl 8) bor D2,(D3 bsl 8) bor D4}; +ipv4_mapped_ipv6_address({D1,D2,D3,D4,D5,D6,D7,D8}) + when (D1 bor D2 bor D3 bor D4 bor D5 bor D6 bor D7 bor D8) < 65536 -> + {D7 bsr 8,D7 band 255,D8 bsr 8,D8 band 255}. + %% Return a list of available options options() -> [ @@ -1244,9 +1253,7 @@ gethostbyname_string(Name, Type) inet -> inet_parse:ipv4_address(Name); inet6 -> - %% XXX should we really translate IPv4 addresses here - %% even if we do not know if this host can do IPv6? - inet_parse:ipv6_address(Name) + inet_parse:ipv6strict_address(Name) end of {ok,IP} -> {ok,make_hostent(Name, [IP], [], Type)}; diff --git a/lib/kernel/src/inet_hosts.erl b/lib/kernel/src/inet_hosts.erl index 0bdf00ac30..fc653bf0d3 100644 --- a/lib/kernel/src/inet_hosts.erl +++ b/lib/kernel/src/inet_hosts.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -72,9 +72,6 @@ gethostbyname(Name, Type, Byname, Byaddr) -> gethostbyaddr({A,B,C,D}=IP) when ?ip(A,B,C,D) -> gethostbyaddr(IP, inet); -%% ipv4 only ipv6 address -gethostbyaddr({0,0,0,0,0,16#ffff=F,G,H}) when ?ip6(0,0,0,0,0,F,G,H) -> - gethostbyaddr({G bsr 8, G band 255, H bsr 8, H band 255}); gethostbyaddr({A,B,C,D,E,F,G,H}=IP) when ?ip6(A,B,C,D,E,F,G,H) -> gethostbyaddr(IP, inet6); gethostbyaddr(Addr) when is_list(Addr) -> diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index 49aa5f8bda..6454802b04 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -349,9 +349,6 @@ gethostbyaddr_tm({A,B,C,D} = IP, Timer) when ?ip(A,B,C,D) -> {ok, HEnt} -> {ok, HEnt}; _ -> res_gethostbyaddr(dn_in_addr_arpa(A,B,C,D), IP, Timer) end; -%% ipv4 only ipv6 address -gethostbyaddr_tm({0,0,0,0,0,16#ffff,G,H},Timer) when is_integer(G+H) -> - gethostbyaddr_tm({G div 256, G rem 256, H div 256, H rem 256},Timer); gethostbyaddr_tm({A,B,C,D,E,F,G,H} = IP, Timer) when ?ip6(A,B,C,D,E,F,G,H) -> inet_db:res_update_conf(), case inet_db:gethostbyaddr(IP) of @@ -431,28 +428,7 @@ gethostbyname(Name,Family,Timeout) -> gethostbyname_tm(Name,inet,Timer) -> getbyname_tm(Name,?S_A,Timer); gethostbyname_tm(Name,inet6,Timer) -> - case getbyname_tm(Name,?S_AAAA,Timer) of - {ok,HEnt} -> {ok,HEnt}; - {error,nxdomain} -> - case getbyname_tm(Name, ?S_A,Timer) of - {ok, HEnt} -> - %% rewrite to a ipv4 only ipv6 address - {ok, - HEnt#hostent { - h_addrtype = inet6, - h_length = 16, - h_addr_list = - lists:map( - fun({A,B,C,D}) -> - {0,0,0,0,0,16#ffff,A*256+B,C*256+D} - end, HEnt#hostent.h_addr_list) - }}; - Error -> - Error - end; - Error -> - Error - end; + getbyname_tm(Name,?S_AAAA,Timer); gethostbyname_tm(_Name, _Family, _Timer) -> {error, einval}. diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 917e725fd6..d197de942f 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -495,7 +495,7 @@ start_monitor(Node, Name) -> Module :: module(), Function :: atom(), Args :: [term()], - ResL :: [term()], + ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]. multicall(M, F, A) -> @@ -506,14 +506,14 @@ multicall(M, F, A) -> Module :: module(), Function :: atom(), Args :: [term()], - ResL :: [term()], + ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]; (Module, Function, Args, Timeout) -> {ResL, BadNodes} when Module :: module(), Function :: atom(), Args :: [term()], Timeout :: timeout(), - ResL :: [term()], + ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]. multicall(Nodes, M, F, A) when is_list(Nodes) -> @@ -528,7 +528,7 @@ multicall(M, F, A, Timeout) -> Function :: atom(), Args :: [term()], Timeout :: timeout(), - ResL :: [term()], + ResL :: [Res :: term() | {'badrpc', Reason :: term()}], BadNodes :: [node()]. multicall(Nodes, M, F, A, infinity) diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index ba0d075ef2..2e5f8c7d2c 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -40,7 +40,8 @@ lookup_bad_search_option/1, getif/1, getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1, - parse_strict_address/1, simple_netns/1, simple_netns_open/1, + parse_strict_address/1, ipv4_mapped_ipv6_address/1, + simple_netns/1, simple_netns_open/1, simple_bind_to_device/1, simple_bind_to_device_open/1]). -export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, parse_address/1, @@ -667,6 +668,26 @@ parse_strict_address(Config) when is_list(Config) -> {ok, {3089,3106,23603,50240,0,0,119,136}} = inet:parse_strict_address("c11:0c22:5c33:c440::077:0088"). +ipv4_mapped_ipv6_address(Config) when is_list(Config) -> + {D1,D2,D3,D4} = IPv4Address = + {rand:uniform(256) - 1, + rand:uniform(256) - 1, + rand:uniform(256) - 1, + rand:uniform(256) - 1}, + E7 = (D1 bsl 8) bor D2, + E8 = (D3 bsl 8) bor D4, + io:format("IPv4Address: ~p.~n", [IPv4Address]), + {0,0,0,0,0,65535,E7,E8} = inet:ipv4_mapped_ipv6_address(IPv4Address), + IPv6Address = + {rand:uniform(65536) - 1, + rand:uniform(65536) - 1, + rand:uniform(65536) - 1, + rand:uniform(65536) - 1, + rand:uniform(65536) - 1, + rand:uniform(65536) - 1, E7, E8}, + IPv4Address = inet:ipv4_mapped_ipv6_address(IPv6Address), + ok. + t_gethostnative(Config) when is_list(Config) -> %% this will result in 26 bytes sent which causes problem in Windows %% if the port-program has not assured stdin to be read in BINARY mode diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index 4b43b6a840..77a9d3207b 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -94,21 +94,21 @@ handle_event(#wx{event=#wxHtmlLink{type=command_html_link_clicked, case Target of "#Binary?" ++ BinSpec -> [{"offset",Off},{"size",Size},{"pos",Pos}] = - httpd:parse_query(BinSpec), + uri_string:dissect_query(BinSpec), Id = {cdv, {list_to_integer(Off), list_to_integer(Size), list_to_integer(Pos)}}, expand(Id,cdv_bin_cb,State); "#OBSBinary?" ++ BinSpec -> [{"key1",Preview},{"key2",Size},{"key3",Hash}] = - httpd:parse_query(BinSpec), + uri_string:dissect_query(BinSpec), Id = {obs, {Tab, {list_to_integer(Preview), list_to_integer(Size), list_to_integer(Hash)}}}, expand(Id,cdv_bin_cb,State); "#Term?" ++ TermKeys -> [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = - httpd:parse_query(TermKeys), + uri_string:dissect_query(TermKeys), Id = {cdv, {Tab,{list_to_integer(Key1), list_to_integer(Key2), list_to_integer(Key3)}}}, diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index f682e3dc7b..cd4aa2e299 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -65,8 +65,7 @@ {registered, []}, {applications, [kernel, stdlib]}, {env, []}, - {runtime_dependencies, ["wx-1.2","stdlib-3.4","runtime_tools-1.8.14", - "kernel-3.0","inets-5.10","et-1.5", - "erts-7.0"]}]}. + {runtime_dependencies, ["wx-1.2","stdlib-3.5","runtime_tools-1.8.14", + "kernel-3.0","et-1.5","erts-7.0"]}]}. diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 6b761cb2ff..6a85d29c1e 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -148,7 +148,7 @@ handle_event(#wx{event=#wxHtmlLink{linkInfo=#wxHtmlLinkInfo{href=Href}}}, observer ! {open_link, Href}, {noreply, State}; Callback -> - [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = httpd:parse_query(Rest), + [{"key1",Key1},{"key2",Key2},{"key3",Key3}] = uri_string:dissect_query(Rest), Id = {obs, {T,{list_to_integer(Key1), list_to_integer(Key2), list_to_integer(Key3)}}}, diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index aeec335ba7..5118d807e1 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -357,7 +357,7 @@ parse_df_take_word_percent(Input) -> %% and capacity), skip % sign, (optionally for susv3 can also skip IUsed, IFree %% and ICap% fields) then take remaining characters as the mount path -spec parse_df(string(), posix | susv3) -> - {error, parse_df} | {ok, {integer(), integer(), integer()}, string()}. + {error, parse_df} | {ok, {integer(), integer(), list()}, string()}. parse_df(Input0, Flavor) -> %% Format of Posix/Linux df output looks like Header + Lines %% Filesystem 1024-blocks Used Available Capacity Mounted on diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl index c433a96585..c0d7b9be8e 100644 --- a/lib/public_key/src/pubkey_cert.erl +++ b/lib/public_key/src/pubkey_cert.erl @@ -371,23 +371,23 @@ match_name(directoryName, DirName, [PermittedName | Rest]) -> match_name(fun is_rdnSeq/2, DirName, PermittedName, Rest); match_name(uniformResourceIdentifier, URI, [PermittedName | Rest]) -> - case split_uri(URI) of - incomplete -> - false; - {_, _, Host, _, _} -> - PN = case split_uri(PermittedName) of - {_, _, PNhost, _, _} -> PNhost; + case uri_string:normalize(URI, [return_map]) of + #{host := Host} -> + PN = case uri_string:normalize(PermittedName, [return_map]) of + #{host := PNhost} -> PNhost; _X -> PermittedName end, - match_name(fun is_valid_host_or_domain/2, Host, PN, Rest) + match_name(fun is_valid_host_or_domain/2, Host, PN, Rest); + _ -> + false end; match_name(emailAddress, Name, [PermittedName | Rest]) -> Fun = fun(Email, PermittedEmail) -> - is_valid_email_address(Email, PermittedEmail, - string:tokens(PermittedEmail,"@")) - end, - match_name(Fun, Name, PermittedName, Rest); + is_valid_email_address(Email, PermittedEmail, + string:tokens(PermittedEmail,"@")) + end, + match_name(Fun, Name, PermittedName, Rest); match_name(dNSName, Name, [PermittedName | Rest]) -> Fun = fun(Domain, [$.|Domain]) -> true; @@ -868,75 +868,12 @@ is_valid_subject_alt_name({otherName, #'AnotherName'{}}) -> is_valid_subject_alt_name({_, _}) -> false. -is_ip_address(Address) -> - case inet_parse:address(Address) of - {ok, _} -> - true; - _ -> - false - end. - -is_fully_qualified_name(_Name) -> - true. - is_valid_uri(AbsURI) -> - case split_uri(AbsURI) of - incomplete -> - false; - {StrScheme, _, Host, _, _} -> - case string:to_lower(StrScheme) of - Scheme when Scheme =:= "http"; Scheme =:= "ftp" -> - is_valid_host(Host); - _ -> - false - end - end. - -is_valid_host(Host) -> - case is_ip_address(Host) of - true -> - true; - false -> - is_fully_qualified_name(Host) - end. - -%% Could have a more general split URI in stdlib? Maybe when -%% regexs are improved. Needed also in inets! -split_uri(Uri) -> - case split_uri(Uri, ":", {error, no_scheme}, 1, 1) of - {error, no_scheme} -> - incomplete; - {StrScheme, "//" ++ URIPart} -> - {Authority, PathQuery} = - split_auth_path(URIPart), - {UserInfo, HostPort} = - split_uri(Authority, "@", {"", Authority}, 1, 1), - {Host, Port} = - split_uri(HostPort, ":", {HostPort, dummy_port}, 1, 1), - {StrScheme, UserInfo, Host, Port, PathQuery} - end. - -split_auth_path(URIPart) -> - case split_uri(URIPart, "/", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - case split_uri(URIPart, "\\?", URIPart, 1, 0) of - Split = {_, _} -> - Split; - URIPart -> - {URIPart,""} - end - end. - -split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> - case re:run(UriPart, SplitChar) of - {match,[{Start, _}]} -> - StrPos = Start + 1, - {string:substr(UriPart, 1, StrPos - SkipLeft), - string:substr(UriPart, StrPos + SkipRight, length(UriPart))}; - nomatch -> - NoMatchResult + case uri_string:normalize(AbsURI, [return_map]) of + #{scheme := _} -> + true; + _ -> + false end. is_rdnSeq({rdnSequence,[]}, {rdnSequence,[none]}) -> diff --git a/lib/public_key/src/public_key.app.src b/lib/public_key/src/public_key.app.src index dbd732c384..5833141e87 100644 --- a/lib/public_key/src/public_key.app.src +++ b/lib/public_key/src/public_key.app.src @@ -14,7 +14,7 @@ {applications, [asn1, crypto, kernel, stdlib]}, {registered, []}, {env, []}, - {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-6.0","crypto-3.8", + {runtime_dependencies, ["stdlib-3.5","kernel-3.0","erts-6.0","crypto-3.8", "asn1-3.0"]} ] }. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 034126655c..931901640a 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -1456,7 +1456,7 @@ ascii_to_lower(String) -> verify_hostname_extract_fqdn_default({dns_id,S}) -> S; verify_hostname_extract_fqdn_default({uri_id,URI}) -> - {ok,{https,_,Host,_,_,_}} = http_uri:parse(URI), + #{scheme := "https", host := Host} = uri_string:normalize(URI, [return_map]), Host. diff --git a/lib/sasl/doc/src/release_handler.xml b/lib/sasl/doc/src/release_handler.xml index 8f073807fb..975188f489 100644 --- a/lib/sasl/doc/src/release_handler.xml +++ b/lib/sasl/doc/src/release_handler.xml @@ -61,6 +61,7 @@ <list type="bulleted"> <item>A release upgrade file, <c>relup</c></item> <item>A system configuration file, <c>sys.config</c></item> + <item>A system configuration source file, <c>sys.config.src</c></item> </list> <p>The <c>relup</c> file contains instructions for how to upgrade to, or downgrade from, this version of the release.</p> @@ -819,4 +820,3 @@ release_handler:set_unpacked(RelFile, [{myapp,"1.0","/home/user"},...]). <seealso marker="systools"><c>systools(3)</c></seealso></p> </section> </erlref> - diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index e7c3c499da..4842c732b1 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -349,10 +349,11 @@ myapp-1/ebin/myapp.app the release version as specified in <c>Name.rel</c>.</p> <p><c>releases/RelVsn</c> contains the boot script <c>Name.boot</c> renamed to <c>start.boot</c> and, if found, - the files <c>relup</c> and <c>sys.config</c>. These files + the files <c>relup</c> and <c>sys.config</c> or <c>sys.config.src</c>. These files are searched for in the same directory as <c>Name.rel</c>, in the current working directory, and in any directories - specified using option <c>path</c>.</p> + specified using option <c>path</c>. In the case of <c>sys.config</c> + it is not included if <c>sys.config.src</c> is found.</p> <p>If the release package is to contain a new Erlang runtime system, the <c>bin</c> directory of the specified runtime system <c>{erts,Dir}</c> is copied to <c>erts-ErtsVsn/bin</c>.</p> @@ -397,4 +398,3 @@ myapp-1/ebin/myapp.app <seealso marker="script"><c>script(4)</c></seealso></p> </section> </erlref> - diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 9d960b7361..fa3182cc08 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -310,6 +310,7 @@ add_apply_upgrade(Script,Args) -> %% RelVsn/start.boot %% relup %% sys.config +%% sys.config.src %% erts-EVsn[/bin] %%----------------------------------------------------------------- @@ -1552,6 +1553,7 @@ create_kernel_procs(Appls) -> %% RelVsn/start.boot %% relup %% sys.config +%% sys.config.src %% erts-EVsn[/bin] %% %% The VariableN.tar.gz files can also be stored as own files not @@ -1707,14 +1709,18 @@ add_system_files(Tar, RelName, Release, Path1) -> add_to_tar(Tar, Relup, filename:join(RelVsnDir, "relup")) end, - case lookup_file("sys.config", Path) of - false -> - ignore; - Sys -> - check_sys_config(Sys), - add_to_tar(Tar, Sys, filename:join(RelVsnDir, "sys.config")) + case lookup_file("sys.config.src", Path) of + false -> + case lookup_file("sys.config", Path) of + false -> + ignore; + Sys -> + check_sys_config(Sys), + add_to_tar(Tar, Sys, filename:join(RelVsnDir, "sys.config")) + end; + SysSrc -> + add_to_tar(Tar, SysSrc, filename:join(RelVsnDir, "sys.config.src")) end, - ok. lookup_file(Name, [Dir|Path]) -> diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index 07748d975f..c8b2f31120 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -67,7 +67,7 @@ groups() -> otp_3065_circular_dependenies, included_and_used_sort_script]}, {tar, [], [tar_options, normal_tar, no_mod_vsn_tar, system_files_tar, - invalid_system_files_tar, variable_tar, + system_src_file_tar, invalid_system_files_tar, variable_tar, src_tests_tar, var_tar, exref_tar, link_tar, no_sasl_tar, otp_9507_path_ebin]}, {relup, [], @@ -945,12 +945,47 @@ system_files_tar(Config) -> ok. + system_files_tar(cleanup,Config) -> Dir = ?privdir, file:delete(filename:join(Dir,"sys.config")), file:delete(filename:join(Dir,"relup")), ok. +%% make_tar: Check that sys.config.src and not sys.config is included +system_src_file_tar(Config) -> + {ok, OldDir} = file:get_cwd(), + + {LatestDir, LatestName} = create_script(latest,Config), + + DataDir = filename:absname(?copydir), + LibDir = fname([DataDir, d_normal, lib]), + P = [fname([LibDir, 'db-2.1', ebin]), + fname([LibDir, 'fe-3.1', ebin])], + + ok = file:set_cwd(LatestDir), + + %% Add dummy sys.config and sys.config.src + ok = file:write_file("sys.config.src","[${SOMETHING}].\n"), + ok = file:write_file("sys.config","[].\n"), + + {ok, _, _} = systools:make_script(LatestName, [silent, {path, P}]), + ok = systools:make_tar(LatestName, [{path, P}]), + ok = check_tar(fname(["releases","LATEST","sys.config.src"]), LatestName), + {error, _} = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), + {ok, _, _} = systools:make_tar(LatestName, [{path, P}, silent]), + ok = check_tar(fname(["releases","LATEST","sys.config.src"]), LatestName), + {error, _} = check_tar(fname(["releases","LATEST","sys.config"]), LatestName), + + ok = file:set_cwd(OldDir), + + ok. + +system_src_file_tar(cleanup,Config) -> + Dir = ?privdir, + file:delete(filename:join(Dir,"sys.config")), + file:delete(filename:join(Dir,"sys.config.src")), + ok. %% make_tar: Check that make_tar fails if relup or sys.config exist %% but do not have valid content diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index df2e04c92a..f5cb3ec254 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -95,7 +95,6 @@ </list> </section> - <section><title>Improvements and New Features</title> <list> <item> @@ -125,7 +124,6 @@ </section> <section><title>Ssh 4.6.2</title> - <section><title>Fixed Bugs and Malfunctions</title> <list> <item> @@ -421,6 +419,24 @@ </section> +<section><title>Ssh 4.4.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Trailing white space was removed at end of the + hello-string. This caused interoperability problems with + some other ssh-implementations (e.g OpenSSH 7.3p1 on + Solaris 11)</p> + <p> + Own Id: OTP-14763 Aux Id: ERIERL-74 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.4.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -791,6 +807,93 @@ </section> +<section><title>Ssh 4.2.2.5</title> + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Default exec is disabled when a user-defined shell is + enabled.</p> + <p> + Own Id: OTP-14881</p> + </item> + </list> + </section> +</section> + + +<section><title>Ssh 4.2.2.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Trailing white space was removed at end of the + hello-string. This caused interoperability problems with + some other ssh-implementations (e.g OpenSSH 7.3p1 on + Solaris 11)</p> + <p> + Own Id: OTP-14763 Aux Id: ERIERL-74 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.2.2.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The key exchange algorithm + diffie-hellman-group-exchange-sha* has a server-option + <c>{dh_gex_limits,{Min,Max}}</c>. There was a hostkey + signature validation error on the client side if the + option was used and the <c>Min</c> or the <c>Max</c> + differed from the corresponding values obtained from the + client.</p> + <p> + This bug is now corrected.</p> + <p> + Own Id: OTP-14166</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Key exchange algorithms + diffie-hellman-group-exchange-sha* optimized, up to a + factor of 11 for the slowest ( = biggest and safest) one.</p> + <p> + Own Id: OTP-14169 Aux Id: seq-13261 </p> + </item> + </list> + </section> + +</section> + +<section><title>Ssh 4.2.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Upgrade of an established client connection could crash + because the ssh client supervisors children had wrong + type. This is fixed now.</p> + <p> + Own Id: OTP-13782 Aux Id: seq13158 </p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.2.2.1</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl index 032d87bdad..25d537c624 100644 --- a/lib/ssh/src/ssh.erl +++ b/lib/ssh/src/ssh.erl @@ -184,7 +184,6 @@ channel_info(ConnectionRef, ChannelId, Options) -> daemon(Port) -> daemon(Port, []). - daemon(Socket, UserOptions) when is_port(Socket) -> try #{} = Options = ssh_options:handle_options(server, UserOptions), @@ -267,8 +266,6 @@ daemon(Host0, Port0, UserOptions0) when 0 =< Port0, Port0 =< 65535, daemon(_, _, _) -> {error, badarg}. - - %%-------------------------------------------------------------------- -spec daemon_info(daemon_ref()) -> ok_error( [{atom(), term()}] ). diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl index d66a34c58a..27d4242dd4 100644 --- a/lib/ssh/src/ssh_acceptor.erl +++ b/lib/ssh/src/ssh_acceptor.erl @@ -86,7 +86,8 @@ acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) -> acceptor_loop(Callback, Port, Address, Opts, LSock, AcceptTimeout); {error,_} -> % Not open, a restart - {ok,NewLSock} = listen(Port, Opts), + %% Allow gen_tcp:listen to fail 4 times if eaddrinuse: + {ok,NewLSock} = try_listen(Port, Opts, 4), proc_lib:init_ack(Parent, {ok, self()}), Opts1 = ?DELETE_INTERNAL_OPT(lsocket, Opts), {_, Callback, _} = ?GET_OPT(transport, Opts1), @@ -98,6 +99,19 @@ acceptor_init(Parent, Port, Address, Opts, AcceptTimeout) -> end. +try_listen(Port, Opts, NtriesLeft) -> + try_listen(Port, Opts, 1, NtriesLeft). + +try_listen(Port, Opts, N, Nmax) -> + case listen(Port, Opts) of + {error,eaddrinuse} when N<Nmax -> + timer:sleep(10*N), % Sleep 10, 20, 30,... ms + try_listen(Port, Opts, N+1, Nmax); + Other -> + Other + end. + + request_ownership(LSock, SockOwner) -> SockOwner ! {request_control,LSock,self()}, receive diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index c8ac3a9c04..e11d3adee4 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1174,17 +1174,25 @@ handle_event({call,_}, _, StateName, _) when not ?CONNECTED(StateName) -> handle_event({call,From}, {request, ChannelPid, ChannelId, Type, Data, Timeout}, StateName, D0) when ?CONNECTED(StateName) -> - D = handle_request(ChannelPid, ChannelId, Type, Data, true, From, D0), - %% Note reply to channel will happen later when reply is recived from peer on the socket - start_channel_request_timer(ChannelId, From, Timeout), - {keep_state, cache_request_idle_timer_check(D)}; + case handle_request(ChannelPid, ChannelId, Type, Data, true, From, D0) of + {error,Error} -> + {keep_state, D0, {reply,From,{error,Error}}}; + D -> + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)} + end; handle_event({call,From}, {request, ChannelId, Type, Data, Timeout}, StateName, D0) when ?CONNECTED(StateName) -> - D = handle_request(ChannelId, Type, Data, true, From, D0), - %% Note reply to channel will happen later when reply is recived from peer on the socket - start_channel_request_timer(ChannelId, From, Timeout), - {keep_state, cache_request_idle_timer_check(D)}; + case handle_request(ChannelId, Type, Data, true, From, D0) of + {error,Error} -> + {keep_state, D0, {reply,From,{error,Error}}}; + D -> + %% Note reply to channel will happen later when reply is recived from peer on the socket + start_channel_request_timer(ChannelId, From, Timeout), + {keep_state, cache_request_idle_timer_check(D)} + end; handle_event({call,From}, {data, ChannelId, Type, Data, Timeout}, StateName, D0) when ?CONNECTED(StateName) -> @@ -1773,21 +1781,31 @@ is_usable_user_pubkey(A, Ssh) -> %%%---------------------------------------------------------------- handle_request(ChannelPid, ChannelId, Type, Data, WantReply, From, D) -> case ssh_channel:cache_lookup(cache(D), ChannelId) of - #channel{remote_id = Id} = Channel -> + #channel{remote_id = Id, + sent_close = false} = Channel -> update_sys(cache(D), Channel, Type, ChannelPid), send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), add_request(WantReply, ChannelId, From, D)); - undefined -> - D + + _ when WantReply==true -> + {error,closed}; + + _ -> + D end. handle_request(ChannelId, Type, Data, WantReply, From, D) -> case ssh_channel:cache_lookup(cache(D), ChannelId) of - #channel{remote_id = Id} -> + #channel{remote_id = Id, + sent_close = false} -> send_msg(ssh_connection:channel_request_msg(Id, Type, WantReply, Data), add_request(WantReply, ChannelId, From, D)); - undefined -> - D + + _ when WantReply==true -> + {error,closed}; + + _ -> + D end. %%%---------------------------------------------------------------- diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index b818a7f45d..9587c0c251 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -897,11 +897,22 @@ start_subsystem_on_closed_channel(Config) -> {user_interaction, false}, {user_dir, UserDir}]), - {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - ok = ssh_connection:close(ConnectionRef, ChannelId), + {ok, ChannelId1} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:close(ConnectionRef, ChannelId1), + {error, closed} = ssh_connection:ptty_alloc(ConnectionRef, ChannelId1, []), + {error, closed} = ssh_connection:subsystem(ConnectionRef, ChannelId1, "echo_n", 5000), + {error, closed} = ssh_connection:exec(ConnectionRef, ChannelId1, "testing1.\n", 5000), + {error, closed} = ssh_connection:send(ConnectionRef, ChannelId1, "exit().\n", 5000), - {error, closed} = ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity), + %% Test that there could be a gap between close and an operation (Bugfix OTP-14939): + {ok, ChannelId2} = ssh_connection:session_channel(ConnectionRef, infinity), + ok = ssh_connection:close(ConnectionRef, ChannelId2), + timer:sleep(2000), + {error, closed} = ssh_connection:ptty_alloc(ConnectionRef, ChannelId2, []), + {error, closed} = ssh_connection:subsystem(ConnectionRef, ChannelId2, "echo_n", 5000), + {error, closed} = ssh_connection:exec(ConnectionRef, ChannelId2, "testing1.\n", 5000), + {error, closed} = ssh_connection:send(ConnectionRef, ChannelId2, "exit().\n", 5000), ssh:close(ConnectionRef), ssh:stop_daemon(Pid). diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 6aaa22a6b4..480e955ec4 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,4 @@ #-*-makefile-*- ; force emacs to enter makefile-mode SSH_VSN = 4.6.5 - APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 4f72114ae9..7267083e32 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -264,8 +264,9 @@ <item><p>Specifies if to reject renegotiation attempt that does not live up to <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. - By default <c>secure_renegotiate</c> is set to <c>false</c>, - that is, secure renegotiation is used if possible, + By default <c>secure_renegotiate</c> is set to <c>true</c>, + that is, secure renegotiation is enforced. If set to <c>false</c> secure renegotiation + will still be used if possible, but it falls back to insecure renegotiation if the peer does not support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p> diff --git a/lib/ssl/doc/src/ssl_crl_cache.xml b/lib/ssl/doc/src/ssl_crl_cache.xml index 7a67de3971..738487759a 100644 --- a/lib/ssl/doc/src/ssl_crl_cache.xml +++ b/lib/ssl/doc/src/ssl_crl_cache.xml @@ -40,7 +40,7 @@ <name>delete(Entries) -> ok | {error, Reason} </name> <fsummary> </fsummary> <type> - <v> Entries = <seealso marker="inets:http_uri">http_uri:uri() </seealso> | {file, string()} | {der, [<seealso + <v> Entries = <seealso marker="stdlib:uri_string">uri_string:uri_string()</seealso> | {file, string()} | {der, [<seealso marker="public_key:public_key"> public_key:der_encoded() </seealso>]}</v> <v> Reason = term()</v> </type> @@ -55,7 +55,7 @@ <type> <v> CRLSrc = {file, string()} | {der, [ <seealso marker="public_key:public_key"> public_key:der_encoded() </seealso> ]}</v> - <v> URI = <seealso marker="inets:http_uri">http_uri:uri() </seealso> </v> + <v> URI = <seealso marker="stdlib:uri_string">uri_string:uri_string() </seealso> </v> <v> Reason = term()</v> </type> <desc> @@ -63,4 +63,4 @@ </desc> </func> </funcs> -</erlref>
\ No newline at end of file +</erlref> diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 3c6cd254c1..3962d1fc2c 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -62,5 +62,5 @@ {applications, [crypto, public_key, kernel, stdlib]}, {env, []}, {mod, {ssl_app, []}}, - {runtime_dependencies, ["stdlib-3.2","public_key-1.5","kernel-6.0", + {runtime_dependencies, ["stdlib-3.5","public_key-1.5","kernel-6.0", "erts-10.0","crypto-4.2", "inets-5.10.7"]}]}. diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 0b035d31be..82f62b51b9 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -843,7 +843,7 @@ handle_options(Opts0, Role, Host) -> %% Server side option reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun), reuse_sessions = handle_option(reuse_sessions, Opts, true), - secure_renegotiate = handle_option(secure_renegotiate, Opts, false), + secure_renegotiate = handle_option(secure_renegotiate, Opts, true), client_renegotiation = handle_option(client_renegotiation, Opts, default_option_role(server, true, Role), server, Role), diff --git a/lib/ssl/src/ssl_alert.erl b/lib/ssl/src/ssl_alert.erl index 95ab955ad0..fc7b1e6d1c 100644 --- a/lib/ssl/src/ssl_alert.erl +++ b/lib/ssl/src/ssl_alert.erl @@ -48,7 +48,9 @@ decode(Bin) -> decode(Bin, [], 0). %%-------------------------------------------------------------------- --spec reason_code(#alert{}, client | server) -> closed | {essl, string()}. +-spec reason_code(#alert{}, client | server) -> + closed | {tls_alert, unicode:chardata()}. +%-spec reason_code(#alert{}, client | server) -> closed | {essl, string()}. %% %% Description: Returns the error reason that will be returned to the %% user. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 1d645e5782..6e436aa7c0 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -96,7 +96,7 @@ security_parameters(Version, CipherSuite, SecParams) -> expanded_key_material_length = expanded_key_material(Cipher), key_material_length = key_material(Cipher), iv_size = iv_size(Cipher), - mac_algorithm = hash_algorithm(Hash), + mac_algorithm = mac_algorithm(Hash), prf_algorithm = prf_algorithm(PrfHashAlg, Version), hash_size = hash_size(Hash)}. @@ -239,7 +239,7 @@ decipher(?AES_CBC, HashSz, CipherState, Fragment, Version, PaddingCheck) -> %%-------------------------------------------------------------------- -spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) -> - {binary(), binary(), #cipher_state{}} | #alert{}. + {binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and checks the associated data (AAD) MAC using %% cipher described by cipher_enum() and updating the cipher state. @@ -2531,6 +2531,11 @@ prf_algorithm(default_prf, {3, _}) -> prf_algorithm(Algo, _) -> hash_algorithm(Algo). +mac_algorithm(aead) -> + aead; +mac_algorithm(Algo) -> + hash_algorithm(Algo). + hash_algorithm(null) -> ?NULL; hash_algorithm(md5) -> ?MD5; hash_algorithm(sha) -> ?SHA; %% Only sha always refers to "SHA-1" @@ -2561,6 +2566,10 @@ sign_algorithm(Other) when is_integer(Other) andalso ((Other >= 224) and (Other hash_size(null) -> 0; +%% The AEAD MAC hash size is not used in the context +%% of calculating the master secret. See RFC 5246 Section 6.2.3.3. +hash_size(aead) -> + 0; hash_size(md5) -> 16; hash_size(sha) -> diff --git a/lib/ssl/src/ssl_crl_cache.erl b/lib/ssl/src/ssl_crl_cache.erl index 8817b0c884..66f46da75f 100644 --- a/lib/ssl/src/ssl_crl_cache.erl +++ b/lib/ssl/src/ssl_crl_cache.erl @@ -92,8 +92,8 @@ delete({der, CRLs}) -> ssl_manager:delete_crls({?NO_DIST_POINT, CRLs}); delete(URI) -> - case http_uri:parse(URI) of - {ok, {http, _, _ , _, Path,_}} -> + case uri_string:normalize(URI, [return_map]) of + #{scheme := "http", path := Path} -> ssl_manager:delete_crls(string:trim(Path, leading, "/")); _ -> {error, {only_http_distribution_points_supported, URI}} @@ -103,8 +103,8 @@ delete(URI) -> %%% Internal functions %%-------------------------------------------------------------------- do_insert(URI, CRLs) -> - case http_uri:parse(URI) of - {ok, {http, _, _ , _, Path,_}} -> + case uri_string:normalize(URI, [return_map]) of + #{scheme := "http", path := Path} -> ssl_manager:insert_crls(string:trim(Path, leading, "/"), CRLs); _ -> {error, {only_http_distribution_points_supported, URI}} @@ -161,7 +161,7 @@ http_get(URL, Rest, CRLDbInfo, Timeout) -> cache_lookup(_, undefined) -> []; cache_lookup(URL, {{Cache, _}, _}) -> - {ok, {_, _, _ , _, Path,_}} = http_uri:parse(URL), + #{path := Path} = uri_string:normalize(URL, [return_map]), case ssl_pkix_db:lookup(string:trim(Path, leading, "/"), Cache) of undefined -> []; diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 0c55af9174..9e2b12b186 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -189,12 +189,18 @@ certificate_request(CipherSuite, CertDbHandle, CertDbRef, HashSigns, Version) -> {dh, binary()} | {dh, {binary(), binary()}, #'DHParameter'{}, {HashAlgo::atom(), SignAlgo::atom()}, binary(), binary(), public_key:private_key()} | + {ecdh, _, _, _, _, _} | {ecdh, #'ECPrivateKey'{}} | + {psk, _, _, _, _, _} | {psk, binary()} | + {dhe_psk, _, _, _, _, _, _, _} | {dhe_psk, binary(), binary()} | + {ecdhe_psk, _, _, _, _, _, _} | {ecdhe_psk, binary(), #'ECPrivateKey'{}} | {srp, {binary(), binary()}, #srp_user{}, {HashAlgo::atom(), SignAlgo::atom()}, - binary(), binary(), public_key:private_key()}) -> + binary(), binary(), public_key:private_key()} | + {srp, _} | + {psk_premaster_secret, _, _, _}) -> #client_key_exchange{} | #server_key_exchange{}. %% @@ -774,9 +780,8 @@ decode_suites('3_bytes', Dec) -> %%==================================================================== available_suites(UserSuites, Version) -> - lists:filtermap(fun(Suite) -> - lists:member(Suite, ssl_cipher:all_suites(Version)) - end, UserSuites). + VersionSuites = ssl_cipher:all_suites(Version) ++ ssl_cipher:anonymous_suites(Version), + lists:filtermap(fun(Suite) -> lists:member(Suite, VersionSuites) end, UserSuites). available_suites(ServerCert, UserSuites, Version, undefined, Curve) -> ssl_cipher:filter(ServerCert, available_suites(UserSuites, Version)) @@ -1056,7 +1061,9 @@ select_curve(undefined, _, _) -> %% %% Description: Handles signature_algorithms hello extension (server) %%-------------------------------------------------------------------- -select_hashsign(_, undefined, _, _, _Version) -> +select_hashsign(_, _, KeyExAlgo, _, _Version) when KeyExAlgo == dh_anon; + KeyExAlgo == ecdh_anon; + KeyExAlgo == srp_anon -> {null, anon}; %% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have %% negotiated a lower version. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index dd6a3e8521..c0eee466ae 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -326,7 +326,7 @@ cipher_aead(Version, Fragment, %%-------------------------------------------------------------------- -spec decipher(ssl_version(), binary(), connection_state(), boolean()) -> - {binary(), binary(), connection_state} | #alert{}. + {binary(), binary(), connection_state()} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 2781203557..05979d3cfd 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -194,6 +194,7 @@ renegotiate_tests() -> [client_renegotiate, server_renegotiate, client_secure_renegotiate, + client_secure_renegotiate_fallback, client_renegotiate_reused_session, server_renegotiate_reused_session, client_no_wrap_sequence_number, @@ -2898,6 +2899,36 @@ client_secure_renegotiate(Config) when is_list(Config) -> ssl_test_lib:close(Server), ssl_test_lib:close(Client). +%%-------------------------------------------------------------------- +client_secure_renegotiate_fallback() -> + [{doc,"Test that we can set secure_renegotiate to false that is " + "fallback option, we however do not have a insecure server to test against!"}]. +client_secure_renegotiate_fallback(Config) when is_list(Config) -> + ServerOpts = ssl_test_lib:ssl_options(server_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From erlang to erlang", + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, [{secure_renegotiate, false} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + renegotiate, [Data]}}, + {options, [{reuse_sessions, false}, + {secure_renegotiate, false}| ClientOpts]}]), + + ssl_test_lib:check_result(Client, ok, Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). %%-------------------------------------------------------------------- server_renegotiate() -> diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl index bc221d35fd..71891356e8 100644 --- a/lib/ssl/test/ssl_engine_SUITE.erl +++ b/lib/ssl/test/ssl_engine_SUITE.erl @@ -39,23 +39,28 @@ init_per_suite(Config) -> catch crypto:stop(), try crypto:start() of ok -> - ssl_test_lib:clean_start(), - case crypto:get_test_engine() of - {ok, EngineName} -> - try crypto:engine_load(<<"dynamic">>, - [{<<"SO_PATH">>, EngineName}, - <<"LOAD">>], - []) of - {ok, Engine} -> - [{engine, Engine} |Config]; - {error, Reason} -> - ct:pal("Reason ~p", [Reason]), - {skip, "No dynamic engine support"} - catch error:notsup -> - {skip, "No engine support in OpenSSL"} - end; - {error, notexist} -> - {skip, "Test engine not found"} + case crypto:info_lib() of + [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] -> + {skip, "Problem with engine on OpenSSL 1.0.1s-freebsd"}; + _ -> + ssl_test_lib:clean_start(), + case crypto:get_test_engine() of + {ok, EngineName} -> + try crypto:engine_load(<<"dynamic">>, + [{<<"SO_PATH">>, EngineName}, + <<"LOAD">>], + []) of + {ok, Engine} -> + [{engine, Engine} |Config]; + {error, Reason} -> + ct:pal("Reason ~p", [Reason]), + {skip, "No dynamic engine support"} + catch error:notsup -> + {skip, "No engine support in OpenSSL"} + end; + {error, notexist} -> + {skip, "Test engine not found"} + end end catch _:_ -> {skip, "Crypto did not start"} diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index f091c8786e..dcdea6beb5 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -70,6 +70,9 @@ all_versions_tests() -> erlang_server_openssl_client, erlang_client_openssl_server_dsa_cert, erlang_server_openssl_client_dsa_cert, + erlang_client_openssl_server_anon, + erlang_server_openssl_client_anon, + erlang_server_openssl_client_anon_with_cert, erlang_server_openssl_client_reuse_session, erlang_client_openssl_server_renegotiate, erlang_client_openssl_server_nowrap_seqnum, @@ -89,6 +92,9 @@ dtls_all_versions_tests() -> erlang_server_openssl_client, erlang_client_openssl_server_dsa_cert, erlang_server_openssl_client_dsa_cert, + erlang_client_openssl_server_anon, + erlang_server_openssl_client_anon, + erlang_server_openssl_client_anon_with_cert, erlang_server_openssl_client_reuse_session, erlang_client_openssl_server_renegotiate, erlang_client_openssl_server_nowrap_seqnum, @@ -550,7 +556,121 @@ erlang_server_openssl_client_dsa_cert(Config) when is_list(Config) -> ssl_test_lib:close_port(OpenSslPort), process_flag(trap_exit, false). -%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +erlang_client_openssl_server_anon() -> + [{doc,"Test erlang client with openssl server, anonymous"}]. +erlang_client_openssl_server_anon(Config) when is_list(Config) -> + process_flag(trap_exit, true), + %% OpenSSL expects a certificate and key, even if the cipher spec + %% is restructed to aNULL, so we use 'server_rsa_opts' here + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + ClientOpts = ssl_test_lib:ssl_options(client_anon_opts, Config), + VersionTuple = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl_test_lib:anonymous_suites(VersionTuple), + + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + Version = ssl_test_lib:protocol_version(Config), + Exe = "openssl", + Args = ["s_server", "-accept", integer_to_list(Port), + ssl_test_lib:version_flag(Version), + "-cert", CertFile, "-key", KeyFile, + "-cipher", "aNULL", "-msg"], + + OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), + + ssl_test_lib:wait_for_openssl_server(Port, proplists:get_value(protocol, Config)), + + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, + erlang_ssl_receive, [Data]}}, + {options, [{ciphers, Ciphers} | ClientOpts]}]), + + true = port_command(OpensslPort, Data), + + ssl_test_lib:check_result(Client, ok), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close_port(OpensslPort), + ssl_test_lib:close(Client), + process_flag(trap_exit, false), + ok. +%%-------------------------------------------------------------------- +erlang_server_openssl_client_anon() -> + [{doc,"Test erlang server with openssl client, anonymous"}]. +erlang_server_openssl_client_anon(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ssl_test_lib:ssl_options(server_anon_opts, Config), + VersionTuple = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl_test_lib:anonymous_suites(VersionTuple), + + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, [{ciphers, Ciphers} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Version = ssl_test_lib:protocol_version(Config), + Exe = "openssl", + Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port), + ssl_test_lib:version_flag(Version), + "-cipher", "aNULL", "-msg"], + + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), + true = port_command(OpenSslPort, Data), + + ssl_test_lib:check_result(Server, ok), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close(Server), + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + + %%-------------------------------------------------------------------- + erlang_server_openssl_client_anon_with_cert() -> + [{doc,"Test erlang server with openssl client, anonymous (with cert)"}]. + erlang_server_openssl_client_anon_with_cert(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ssl_test_lib:ssl_options(server_rsa_opts, Config), + VersionTuple = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = ssl_test_lib:anonymous_suites(VersionTuple), + + {_, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, erlang_ssl_receive, [Data]}}, + {options, [{ciphers, Ciphers} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Version = ssl_test_lib:protocol_version(Config), + Exe = "openssl", + Args = ["s_client", "-connect", hostname_format(Hostname) ++ ":" ++ integer_to_list(Port), + ssl_test_lib:version_flag(Version), + "-cipher", "aNULL", "-msg"], + + OpenSslPort = ssl_test_lib:portable_open_port(Exe, Args), + true = port_command(OpenSslPort, Data), + + ssl_test_lib:check_result(Server, ok), + + %% Clean close down! Server needs to be closed first !! + ssl_test_lib:close(Server), + ssl_test_lib:close_port(OpenSslPort), + process_flag(trap_exit, false). + +%%-------------------------------------------------------------------- erlang_server_openssl_client_reuse_session() -> [{doc, "Test erlang server with openssl client that reconnects with the" diff --git a/lib/stdlib/doc/src/io.xml b/lib/stdlib/doc/src/io.xml index 72c774e6ef..f1037ec76b 100644 --- a/lib/stdlib/doc/src/io.xml +++ b/lib/stdlib/doc/src/io.xml @@ -137,11 +137,11 @@ Hello world! ok</pre> <p>The general format of a control sequence is <c>~F.P.PadModC</c>.</p> - <p>Character <c>C</c> determines the type of control sequence - to be used, <c>F</c> and <c>P</c> are optional numeric - arguments. If <c>F</c>, <c>P</c>, or <c>Pad</c> is <c>*</c>, - the next argument in <c>Data</c> is used as the numeric value - of <c>F</c> or <c>P</c>.</p> + <p>The character <c>C</c> determines the type of control sequence + to be used. It is the only required field. All of <c>F</c>, + <c>P</c>, <c>Pad</c>, and <c>Mod</c> are optional. For example, + to use a <c>#</c> for <c>Pad</c> but use the default values for + <c>F</c> and <c>P</c>, you can write <c>~..#C</c>.</p> <list type="bulleted"> <item> <p><c>F</c> is the <c>field width</c> of the printed argument. A @@ -167,13 +167,26 @@ ok</pre> The default padding character is <c>' '</c> (space).</p> </item> <item> - <p><c>Mod</c> is the control sequence modifier. It is either a - single character (<c>t</c>, for Unicode - translation, and <c>l</c>, for stopping <c>p</c> and - <c>P</c> from detecting printable characters) - that changes the interpretation of <c>Data</c>.</p> + <p><c>Mod</c> is the control sequence modifier. This is + one or more characters that change the interpretation of + <c>Data</c>. The current modifiers are <c>t</c>, for Unicode + translation, and <c>l</c>, for stopping <c>p</c> and <c>P</c> + from detecting printable characters.</p> </item> </list> + <p>If <c>F</c>, <c>P</c>, or <c>Pad</c> is a <c>*</c> character, + the next argument in <c>Data</c> is used as the value. + For example:</p> + <pre> +1> <input>io:fwrite("~*.*.0f~n",[9, 5, 3.14159265]).</input> +003.14159 +ok</pre> + <p>To use a literal <c>*</c> character as <c>Pad</c>, it must be + passed as an argument:</p> + <pre> +2> <input>io:fwrite("~*.*.*f~n",[9, 5, $*, 3.14159265]).</input> +**3.14159 +ok</pre> <p><em>Available control sequences:</em></p> <taglist> <tag><c>~</c></tag> @@ -277,10 +290,9 @@ ok <c>~w</c>, but breaks terms whose printed representation is longer than one line into many lines and indents each line sensibly. Left-justification is not supported. - It also tries to detect lists of - printable characters and to output these as strings. The - Unicode translation modifier is used for determining - what characters are printable, for example:</p> + It also tries to detect flat lists of + printable characters and output these as strings. + For example:</p> <pre> 1> <input>T = [{attributes,[[{id,age,1.50000},{mode,explicit},</input> <input>{typename,"INTEGER"}], [{id,cho},{mode,explicit},{typename,'Cho'}]]},</input> @@ -302,7 +314,7 @@ ok {mode,implicit}] ok</pre> <p>The field width specifies the maximum line length. - Defaults to 80. The precision specifies the initial + It defaults to 80. The precision specifies the initial indentation of the term. It defaults to the number of characters printed on this line in the <em>same</em> call to <seealso marker="#write/1"><c>write/1</c></seealso> or @@ -332,18 +344,53 @@ ok [{a,[97]}, {b,[98]}] ok</pre> - <p>Binaries that look like UTF-8 encoded strings are - output with the string syntax if the Unicode translation - modifier is specified:</p> + <p>The Unicode translation modifier <c>t</c> specifies how to treat + characters outside the Latin-1 range of codepoints, in + atoms, strings, and binaries. For example, printing an atom + containing a character > 255:</p> + <pre> +8> <input>io:fwrite("~p~n",[list_to_atom([1024])]).</input> +'\x{400}' +ok +9> <input>io:fwrite("~tp~n",[list_to_atom([1024])]).</input> +'Ѐ' +ok</pre> + <p>By default, Erlang only detects lists of characters + in the Latin-1 range as strings, but the <c>+pc unicode</c> + flag can be used to change this (see <seealso + marker="#printable_range/0"> + <c>printable_range/0</c></seealso> for details). For example:</p> + <pre> +10> <input>io:fwrite("~p~n",[[214]]).</input> +"Ö" +ok +11> <input>io:fwrite("~p~n",[[1024]]).</input> +[1024] +ok +12> <input>io:fwrite("~tp~n",[[1024]]).</input> +[1024] +ok +</pre> + <p>but if Erlang was started with <c>+pc unicode</c>:</p> <pre> -9> <input>io:fwrite("~p~n",[[1024]]).</input> +13> <input>io:fwrite("~p~n",[[1024]]).</input> [1024] -10> <input>io:fwrite("~tp~n",[[1024]]).</input> -"\x{400}" -11> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> +ok +14> <input>io:fwrite("~tp~n",[[1024]]).</input> +"Ѐ" +ok</pre> + <p>Similarly, binaries that look like UTF-8 encoded strings + are output with the binary string syntax if the <c>t</c> + modifier is specified:</p> + <pre> +15> <input>io:fwrite("~p~n", [<<208,128>>]).</input> +<<208,128>> +ok +16> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> +<<"Ѐ"/utf8>> +ok +17> <input>io:fwrite("~tp~n", [<<128,128>>]).</input> <<128,128>> -12> <input>io:fwrite("~tp~n", [<<208,128>>]).</input> -<<"\x{400}"/utf8>> ok</pre> </item> <tag><c>W</c></tag> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 1930c462e8..9a62d21d34 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3971,6 +3971,8 @@ extract_sequence(3, [$.,_|Fmt], Need) -> extract_sequence(4, Fmt, Need); extract_sequence(3, Fmt, Need) -> extract_sequence(4, Fmt, Need); +extract_sequence(4, [$t, $l | Fmt], Need) -> + extract_sequence(4, [$l, $t | Fmt], Need); extract_sequence(4, [$t, $c | Fmt], Need) -> extract_sequence(5, [$c|Fmt], Need); extract_sequence(4, [$t, $s | Fmt], Need) -> @@ -3987,8 +3989,14 @@ extract_sequence(4, [$t, C | _Fmt], _Need) -> {error,"invalid control ~t" ++ [C]}; extract_sequence(4, [$l, $p | Fmt], Need) -> extract_sequence(5, [$p|Fmt], Need); +extract_sequence(4, [$l, $t, $p | Fmt], Need) -> + extract_sequence(5, [$p|Fmt], Need); extract_sequence(4, [$l, $P | Fmt], Need) -> extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, $t, $P | Fmt], Need) -> + extract_sequence(5, [$P|Fmt], Need); +extract_sequence(4, [$l, $t, C | _Fmt], _Need) -> + {error,"invalid control ~lt" ++ [C]}; extract_sequence(4, [$l, C | _Fmt], _Need) -> {error,"invalid control ~l" ++ [C]}; extract_sequence(4, Fmt, Need) -> diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index cacd9f2524..e37c13093b 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -931,7 +931,7 @@ limit_term(Term, Depth) -> limit(_, 0) -> '...'; limit([H|T]=L, D) -> if - D =:= 1 -> '...'; + D =:= 1 -> ['...']; true -> case printable_list(L) of true -> L; @@ -944,7 +944,7 @@ limit(Term, D) when is_map(Term) -> limit({}=T, _D) -> T; limit(T, D) when is_tuple(T) -> if - D =:= 1 -> '...'; + D =:= 1 -> {'...'}; true -> list_to_tuple([limit(element(1, T), D-1)| limit_tail(tl(tuple_to_list(T)), D-1)]) @@ -961,32 +961,29 @@ limit_tail(Other, D) -> %% Cannot limit maps properly since there is no guarantee that %% maps:from_list() creates a map with the same internal ordering of -%% the selected associations as in Map. +%% the selected associations as in Map. Instead of subtracting one +%% from the depth as the map associations are traversed (as is done +%% for tuples and lists), the same depth is applied to each and every +%% (returned) association. limit_map(Map, D) -> - limit_map(maps:iterator(Map), D, []). + %% Keep one extra association to make sure the final ',...' is included. + limit_map_body(maps:iterator(Map), D + 1, D, []). -limit_map(_I, 0, Acc) -> +limit_map_body(_I, 0, _D0, Acc) -> maps:from_list(Acc); -limit_map(I, D, Acc) -> +limit_map_body(I, D, D0, Acc) -> case maps:next(I) of {K, V, NextI} -> - limit_map(NextI, D-1, [{K,V} | Acc]); + limit_map_body(NextI, D-1, D0, [limit_map_assoc(K, V, D0) | Acc]); none -> maps:from_list(Acc) end. -%% maps:from_list(limit_map_body(erts_internal:maps_to_list(Map, D), D)). +limit_map_assoc(K, V, D) -> + %% Keep keys as are to avoid creating duplicated keys. + {K, limit(V, D - 1)}. -%% limit_map_body(_, 0) -> [{'...', '...'}]; -%% limit_map_body([], _) -> []; -%% limit_map_body([{K,V}], D) -> [limit_map_assoc(K, V, D)]; -%% limit_map_body([{K,V}|KVs], D) -> -%% [limit_map_assoc(K, V, D) | limit_map_body(KVs, D-1)]. - -%% limit_map_assoc(K, V, D) -> -%% {limit(K, D-1), limit(V, D-1)}. - -limit_bitstring(B, _D) -> B. %% Keeps all printable binaries. +limit_bitstring(B, _D) -> B. % Keeps all printable binaries. test_limit(_, 0) -> throw(limit); test_limit([H|T]=L, D) when is_integer(D) -> @@ -1022,18 +1019,21 @@ test_limit_tuple(T, I, Sz, D) -> test_limit(element(I, T), D-1), test_limit_tuple(T, I+1, Sz, D-1). -test_limit_map(_Map, _D) -> ok. -%% test_limit_map_body(erts_internal:maps_to_list(Map, D), D). +test_limit_map(Map, D) -> + test_limit_map_body(maps:iterator(Map), D). -%% test_limit_map_body(_, 0) -> throw(limit); -%% test_limit_map_body([], _) -> ok; -%% test_limit_map_body([{K,V}], D) -> test_limit_map_assoc(K, V, D); -%% test_limit_map_body([{K,V}|KVs], D) -> -%% test_limit_map_assoc(K, V, D), -%% test_limit_map_body(KVs, D-1). +test_limit_map_body(_I, 0) -> throw(limit); % cannot happen +test_limit_map_body(I, D) -> + case maps:next(I) of + {K, V, NextI} -> + test_limit_map_assoc(K, V, D), + test_limit_map_body(NextI, D-1); + none -> + ok + end. -%% test_limit_map_assoc(K, V, D) -> -%% test_limit(K, D-1), -%% test_limit(V, D-1). +test_limit_map_assoc(K, V, D) -> + test_limit(K, D - 1), + test_limit(V, D - 1). test_limit_bitstring(_, _) -> ok. diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl index e345810ca0..64edbf1824 100644 --- a/lib/stdlib/src/io_lib_format.erl +++ b/lib/stdlib/src/io_lib_format.erl @@ -95,7 +95,7 @@ print([]) -> []. print(C, F, Ad, P, Pad, Encoding, Strings) -> - [$~] ++ print_field_width(F, Ad) ++ print_precision(P) ++ + [$~] ++ print_field_width(F, Ad) ++ print_precision(P, Pad) ++ print_pad_char(Pad) ++ print_encoding(Encoding) ++ print_strings(Strings) ++ [C]. @@ -103,8 +103,9 @@ print_field_width(none, _Ad) -> ""; print_field_width(F, left) -> integer_to_list(-F); print_field_width(F, right) -> integer_to_list(F). -print_precision(none) -> ""; -print_precision(P) -> [$. | integer_to_list(P)]. +print_precision(none, $\s) -> ""; +print_precision(none, _Pad) -> "."; % pad must be second dot +print_precision(P, _Pad) -> [$. | integer_to_list(P)]. print_pad_char($\s) -> ""; % default, no need to make explicit print_pad_char(Pad) -> [$., Pad]. @@ -126,25 +127,23 @@ collect_cseq(Fmt0, Args0) -> {F,Ad,Fmt1,Args1} = field_width(Fmt0, Args0), {P,Fmt2,Args2} = precision(Fmt1, Args1), {Pad,Fmt3,Args3} = pad_char(Fmt2, Args2), - {Encoding,Fmt4,Args4} = encoding(Fmt3, Args3), - {Strings,Fmt5,Args5} = strings(Fmt4, Args4), - {C,As,Fmt6,Args6} = collect_cc(Fmt5, Args5), - FormatSpec = #{control_char => C, args => As, width => F, adjust => Ad, - precision => P, pad_char => Pad, encoding => Encoding, - strings => Strings}, - {FormatSpec,Fmt6,Args6}. - -encoding([$t|Fmt],Args) -> - true = hd(Fmt) =/= $l, - {unicode,Fmt,Args}; -encoding(Fmt,Args) -> - {latin1,Fmt,Args}. - -strings([$l|Fmt],Args) -> - true = hd(Fmt) =/= $t, - {false,Fmt,Args}; -strings(Fmt,Args) -> - {true,Fmt,Args}. + Spec0 = #{width => F, + adjust => Ad, + precision => P, + pad_char => Pad, + encoding => latin1, + strings => true}, + {Spec1,Fmt4} = modifiers(Fmt3, Spec0), + {C,As,Fmt5,Args4} = collect_cc(Fmt4, Args3), + Spec2 = Spec1#{control_char => C, args => As}, + {Spec2,Fmt5,Args4}. + +modifiers([$t|Fmt], Spec) -> + modifiers(Fmt, Spec#{encoding => unicode}); +modifiers([$l|Fmt], Spec) -> + modifiers(Fmt, Spec#{strings => false}); +modifiers(Fmt, Spec) -> + {Spec, Fmt}. field_width([$-|Fmt0], Args0) -> {F,Fmt,Args} = field_value(Fmt0, Args0), diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 45363c0592..6f4e7ad7e0 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1905,29 +1905,61 @@ otp_10836(Suite) when is_list(Suite) -> %% OTP-10755. The 'l' modifier otp_10755(Suite) when is_list(Suite) -> + %% printing plain ascii characters S = "string", "\"string\"" = fmt("~p", [S]), "[115,116,114,105,110,103]" = fmt("~lp", [S]), "\"string\"" = fmt("~P", [S, 2]), "[115|...]" = fmt("~lP", [S, 2]), - {'EXIT',{badarg,_}} = (catch fmt("~ltp", [S])), - {'EXIT',{badarg,_}} = (catch fmt("~tlp", [S])), - {'EXIT',{badarg,_}} = (catch fmt("~ltP", [S])), - {'EXIT',{badarg,_}} = (catch fmt("~tlP", [S])), + %% printing latin1 chars, with and without modifiers + T = {[255],list_to_atom([255]),[a,b,c]}, + "{\"ÿ\",ÿ,[a,b,c]}" = fmt("~p", [T]), + "{\"ÿ\",ÿ,[a,b,c]}" = fmt("~tp", [T]), + "{[255],ÿ,[a,b,c]}" = fmt("~lp", [T]), + "{[255],ÿ,[a,b,c]}" = fmt("~ltp", [T]), + "{[255],ÿ,[a,b,c]}" = fmt("~tlp", [T]), + "{\"ÿ\",ÿ,...}" = fmt("~P", [T,3]), + "{\"ÿ\",ÿ,...}" = fmt("~tP", [T,3]), + "{[255],ÿ,...}" = fmt("~lP", [T,3]), + "{[255],ÿ,...}" = fmt("~ltP", [T,3]), + "{[255],ÿ,...}" = fmt("~tlP", [T,3]), + %% printing unicode chars, with and without modifiers + U = {[666],list_to_atom([666]),[a,b,c]}, + "{[666],'\\x{29A}',[a,b,c]}" = fmt("~p", [U]), + case io:printable_range() of + unicode -> + "{\"ʚ\",'ʚ',[a,b,c]}" = fmt("~tp", [U]), + "{\"ʚ\",'ʚ',...}" = fmt("~tP", [U,3]); + latin1 -> + "{[666],'ʚ',[a,b,c]}" = fmt("~tp", [U]), + "{[666],'ʚ',...}" = fmt("~tP", [U,3]) + end, + "{[666],'\\x{29A}',[a,b,c]}" = fmt("~lp", [U]), + "{[666],'ʚ',[a,b,c]}" = fmt("~ltp", [U]), + "{[666],'ʚ',[a,b,c]}" = fmt("~tlp", [U]), + "{[666],'\\x{29A}',...}" = fmt("~P", [U,3]), + "{[666],'\\x{29A}',...}" = fmt("~lP", [U,3]), + "{[666],'ʚ',...}" = fmt("~ltP", [U,3]), + "{[666],'ʚ',...}" = fmt("~tlP", [U,3]), + %% the compiler should catch uses of ~l with other than pP Text = "-module(l_mod).\n" "-export([t/0]).\n" "t() ->\n" " S = \"string\",\n" - " io:format(\"~ltp\", [S]),\n" - " io:format(\"~tlp\", [S]),\n" - " io:format(\"~ltP\", [S, 1]),\n" - " io:format(\"~tlP\", [S, 1]).\n", + " io:format(\"~lw\", [S]),\n" + " io:format(\"~lW\", [S, 1]),\n" + " io:format(\"~ltw\", [S]),\n" + " io:format(\"~tlw\", [S]),\n" + " io:format(\"~ltW\", [S, 1]),\n" + " io:format(\"~tlW\", [S, 1]).\n", {ok,l_mod,[{_File,Ws}]} = compile_file("l_mod.erl", Text, Suite), - ["format string invalid (invalid control ~lt)", - "format string invalid (invalid control ~tl)", - "format string invalid (invalid control ~lt)", - "format string invalid (invalid control ~tl)"] = + ["format string invalid (invalid control ~lw)", + "format string invalid (invalid control ~lW)", + "format string invalid (invalid control ~ltw)", + "format string invalid (invalid control ~ltw)", + "format string invalid (invalid control ~ltW)", + "format string invalid (invalid control ~ltW)"] = [lists:flatten(M:format_error(E)) || {_L,M,E} <- Ws], ok. @@ -2005,6 +2037,7 @@ writes(N, F1) -> format_string(_Config) -> %% All but padding is tested by fmt/2. + "xxxxxxxsss" = fmt("~10..xs", ["sss"]), "xxxxxxsssx" = fmt("~10.4.xs", ["sss"]), "xxxxxxsssx" = fmt("~10.4.*s", [$x, "sss"]), ok. @@ -2384,19 +2417,36 @@ limit_term(_Config) -> {_, 2} = limt({a,b,c,[d,e]}, 2), {_, 2} = limt({a,b,c,[d,e]}, 3), {_, 2} = limt({a,b,c,[d,e]}, 4), + T0 = [1|{a,b,c}], + {_, 2} = limt(T0, 2), + {_, 2} = limt(T0, 3), + {_, 2} = limt(T0, 4), {_, 1} = limt(<<"foo">>, 18), + {_, 2} = limt({"",[1,2]}, 3), + {_, 2} = limt({"",{1,2}}, 3), + true = limt_pp({"123456789012345678901234567890",{1,2}}, 3), ok = blimt(<<"123456789012345678901234567890">>), + true = limt_pp(<<"123456789012345678901234567890">>, 3), + {_, 2} = limt({<<"kljlkjsl">>,[1,2,3,4]}, 4), {_, 1} = limt(<<7:3>>, 2), {_, 1} = limt(<<7:21>>, 2), {_, 1} = limt([], 2), {_, 1} = limt({}, 2), + {_, 1} = limt({"", ""}, 4), {_, 1} = limt(#{}, 2), - {_, 1} = limt(#{[] => {}}, 2), + {_, 2} = limt(#{[] => {}}, 1), + {_, 2} = limt(#{[] => {}}, 2), {_, 1} = limt(#{[] => {}}, 3), T = #{[] => {},[a] => [b]}, - {_, 1} = limt(T, 2), + {_, 1} = limt(T, 0), + {_, 2} = limt(T, 1), + {_, 2} = limt(T, 2), {_, 1} = limt(T, 3), {_, 1} = limt(T, 4), + T2 = #{[] => {},{} => []}, + {_, 2} = limt(T2, 1), + {_, 2} = limt(T2, 2), + {_, 1} = limt(T2, 3), ok. blimt(Binary) -> @@ -2430,3 +2480,12 @@ limt(Term, Depth) when is_integer(Depth) -> form(Term, Depth) -> lists:flatten(io_lib:format("~W", [Term, Depth])). + +limt_pp(Term, Depth) when is_integer(Depth) -> + T1 = io_lib:limit_term(Term, Depth), + S = pp(Term, Depth), + S1 = pp(T1, Depth), + S1 =:= S. + +pp(Term, Depth) -> + lists:flatten(io_lib:format("~P", [Term, Depth])). |