diff options
Diffstat (limited to 'lib')
224 files changed, 7539 insertions, 6124 deletions
diff --git a/lib/Makefile b/lib/Makefile index cdb3f3f3dc..6605c6145c 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -28,7 +28,7 @@ ERTS_APPLICATIONS = stdlib sasl kernel compiler ERLANG_APPLICATIONS = tools common_test runtime_tools inets parsetools # These are only build if -a is given to otp_build or make is used directly -ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp otp_mibs erl_interface \ +ALL_ERLANG_APPLICATIONS = xmerl edoc erl_docgen snmp erl_interface \ asn1 jinterface \ wx debugger reltool \ mnesia crypto os_mon syntax_tools \ diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 5024310788..e0e5bc832b 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -32,6 +32,21 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 7.2.7</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p>Fixed a bug where incorrect code was generated + following a binary match guard.</p> + <p> + Own Id: OTP-15353 Aux Id: ERL-753 </p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 7.2.6</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index d475e5a19a..961dacc6c9 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -69,6 +69,7 @@ MODULES = \ beam_ssa_pp \ beam_ssa_pre_codegen \ beam_ssa_recv \ + beam_ssa_share \ beam_ssa_type \ beam_kernel_to_ssa \ beam_trim \ diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 9d8d5b2b0c..707974b2c1 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -22,7 +22,7 @@ -module(beam_block). -export([module/2]). --import(lists, [reverse/1,splitwith/2]). +-import(lists, [keysort/2,reverse/1,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -53,7 +53,8 @@ blockify([I|Is0]=IsAll, Acc) -> case collect(I) of error -> blockify(Is0, [I|Acc]); Instr when is_tuple(Instr) -> - {Block,Is} = collect_block(IsAll), + {Block0,Is} = collect_block(IsAll), + Block = sort_moves(Block0), blockify(Is, [{block,Block}|Acc]) end; blockify([], Acc) -> reverse(Acc). @@ -117,3 +118,36 @@ embed_lines([{block,B1},{line,_}=Line|T], Acc) -> embed_lines([I|Is], Acc) -> embed_lines(Is, [I|Acc]); embed_lines([], Acc) -> Acc. + +%% sort_moves([Instruction]) -> [Instruction]. +%% Sort move instructions on the Y register to give the loader +%% more opportunities for combining instructions. + +sort_moves([{set,[{x,_}],[{y,_}],move}=I|Is0]) -> + {Moves,Is} = sort_moves_1(Is0, x, y, [I]), + Moves ++ sort_moves(Is); +sort_moves([{set,[{y,_}],[{x,_}],move}=I|Is0]) -> + {Moves,Is} = sort_moves_1(Is0, y, x, [I]), + Moves ++ sort_moves(Is); +sort_moves([I|Is]) -> + [I|sort_moves(Is)]; +sort_moves([]) -> []. + +sort_moves_1([{set,[{x,0}],[_],move}=I|Is], _DTag, _STag, Acc) -> + %% The loader sometimes combines a move to x0 with the + %% instruction that follows, producing, for example, a move_call + %% instruction. Therefore, we don't want include this move + %% instruction in the sorting. + {sort_on_yreg(Acc)++[I],Is}; +sort_moves_1([{set,[{DTag,_}],[{STag,_}],move}=I|Is], DTag, STag, Acc) -> + sort_moves_1(Is, DTag, STag, [I|Acc]); +sort_moves_1(Is, _DTag, _STag, Acc) -> + {sort_on_yreg(Acc),Is}. + +sort_on_yreg([{set,[Dst],[Src],move}|_]=Moves) -> + case {Dst,Src} of + {{y,_},{x,_}} -> + keysort(2, Moves); + {{x,_},{y,_}} -> + keysort(3, Moves) + end. diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index 98831d87a7..49bfb5606f 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -31,7 +31,7 @@ %%% erlang:error(function_clause, Args) => jump FuncInfoLabel %%% --import(lists, [reverse/1,seq/2]). +-import(lists, [reverse/1,seq/2,splitwith/2]). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -74,13 +74,13 @@ translate([I|Is], St, Acc) -> translate([], _, Acc) -> reverse(Acc). -translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> - case dig_out(Ar, Acc1) of +translate_1(Ar, I, Is, #st{arity=Arity}=St, [{line,_}=Line|Acc1]=Acc0) -> + case dig_out(Ar, Arity, Acc1) of no -> translate(Is, St, [I|Acc0]); - {yes,{function_clause,Arity},Acc2} -> + {yes,function_clause,Acc2} -> case {Line,St} of - {{line,Loc},#st{lbl=Fi,loc=Loc,arity=Arity}} -> + {{line,Loc},#st{lbl=Fi,loc=Loc}} -> Instr = {jump,{f,Fi}}, translate(Is, St, [Instr|Acc2]); {_,_} -> @@ -92,9 +92,13 @@ translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> translate(Is, St, [Instr,Line|Acc2]) end. -dig_out(Ar, [{kill,_}|Is]) -> - dig_out(Ar, Is); -dig_out(1, [{block,Bl0}|Is]) -> +dig_out(1, _Arity, Is) -> + dig_out(Is); +dig_out(2, Arity, Is) -> + dig_out_fc(Arity, Is); +dig_out(_, _, _) -> no. + +dig_out([{block,Bl0}|Is]) -> case dig_out_block(reverse(Bl0)) of no -> no; {yes,What,[]} -> @@ -102,12 +106,7 @@ dig_out(1, [{block,Bl0}|Is]) -> {yes,What,Bl} -> {yes,What,[{block,Bl}|Is]} end; -dig_out(2, [{block,Bl}|Is]) -> - case dig_out_block_fc(Bl) of - no -> no; - {yes,What} -> {yes,What,Is} - end; -dig_out(_, _) -> no. +dig_out(_) -> no. dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> {yes,if_end,[]}; @@ -141,33 +140,64 @@ fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> fix_block_1([I|Is], Words) -> [I|fix_block_1(Is, Words)]. -dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> - Regs = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Live-1)]), - dig_out_fc(Bl, Regs); -dig_out_block_fc(_) -> no. -dig_out_fc([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> +dig_out_fc(Arity, Is0) -> + Regs0 = maps:from_list([{{x,X},{arg,X}} || X <- seq(0, Arity-1)]), + {Is,Acc0} = splitwith(fun({label,_}) -> false; + ({test,_,_,_}) -> false; + (_) -> true + end, Is0), + {Regs,Acc} = dig_out_fc_1(reverse(Is), Regs0, Acc0), + case is_fc(Arity, Regs) of + true -> + {yes,function_clause,Acc}; + false -> + no + end. + +dig_out_fc_1([{block,Bl}|Is], Regs0, Acc) -> + Regs = dig_out_fc_block(Bl, Regs0), + dig_out_fc_1(Is, Regs, Acc); +dig_out_fc_1([{bs_set_position,_,_}=I|Is], Regs, Acc) -> + dig_out_fc_1(Is, Regs, [I|Acc]); +dig_out_fc_1([{bs_get_tail,_,_,Live}=I|Is], Regs0, Acc) -> + Regs = prune_xregs(Live, Regs0), + dig_out_fc_1(Is, Regs, [I|Acc]); +dig_out_fc_1([_|_], _Regs, _Acc) -> + {#{},[]}; +dig_out_fc_1([], Regs, Acc) -> + {Regs,Acc}. + +dig_out_fc_block([{set,[],[],{alloc,Live,_}}|Is], Regs0) -> + Regs = prune_xregs(Live, Regs0), + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,[Dst],[Hd,Tl],put_list}|Is], Regs0) -> Regs = Regs0#{Dst=>{cons,get_reg(Hd, Regs0),get_reg(Tl, Regs0)}}, - dig_out_fc(Is, Regs); -dig_out_fc([{set,[Dst],[Src],move}|Is], Regs0) -> + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,[Dst],[Src],move}|Is], Regs0) -> Regs = Regs0#{Dst=>get_reg(Src, Regs0)}, - dig_out_fc(Is, Regs); -dig_out_fc([{set,_,_,_}|_], _Regs) -> - %% Unknown instruction. It is not a function_clause error. - no; -dig_out_fc([], Regs) -> + dig_out_fc_block(Is, Regs); +dig_out_fc_block([{set,_,_,_}|_], _Regs) -> + %% Unknown instruction. Fail. + #{}; +dig_out_fc_block([], Regs) -> Regs. + +prune_xregs(Live, Regs) -> + maps:filter(fun({x,X}, _) -> X < Live end, Regs). + +is_fc(Arity, Regs) -> case Regs of #{{x,0}:={atom,function_clause},{x,1}:=Args} -> - dig_out_fc_1(Args, 0); + is_fc_1(Args, 0) =:= Arity; #{} -> - no + false end. -dig_out_fc_1({cons,{arg,I},T}, I) -> - dig_out_fc_1(T, I+1); -dig_out_fc_1(nil, I) -> - {yes,{function_clause,I}}; -dig_out_fc_1(_, _) -> no. +is_fc_1({cons,{arg,I},T}, I) -> + is_fc_1(T, I+1); +is_fc_1(nil, I) -> + I; +is_fc_1(_, _) -> -1. get_reg(R, Regs) -> case Regs of diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index fbff4cfd79..8b0e3e32f8 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -101,6 +101,10 @@ %%% always keep the label. (beam_clean will remove any unused %%% labels.) %%% +%%% (7) Replace a jump to a return instruction with a return instruction. +%%% Similarly, replace a jump to deallocate + return with those +%%% instructions. +%%% %%% Note: This modules depends on (almost) all branches and jumps only %%% going forward, so that we can remove instructions (including definition %%% of labels) after any label that has not been referenced by the code @@ -144,13 +148,20 @@ module({Mod,Exp,Attr,Fs0,Lc0}, _Opt) -> %% %% NOTE: This function assumes that there are no labels inside blocks. function({function,Name,Arity,CLabel,Asm0}, Lc0) -> - Asm1 = eliminate_moves(Asm0), - {Asm2,Lc} = insert_labels(Asm1, Lc0, []), - Asm3 = share(Asm2), - Asm4 = move(Asm3), - Asm5 = opt(Asm4, CLabel), - Asm = remove_unused_labels(Asm5), - {{function,Name,Arity,CLabel,Asm},Lc}. + try + Asm1 = eliminate_moves(Asm0), + {Asm2,Lc} = insert_labels(Asm1, Lc0, []), + Asm3 = share(Asm2), + Asm4 = move(Asm3), + Asm5 = opt(Asm4, CLabel), + Asm6 = unshare(Asm5), + Asm = remove_unused_labels(Asm6), + {{function,Name,Arity,CLabel,Asm},Lc} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. %%% %%% Scan instructions in execution order and remove redundant 'move' @@ -196,22 +207,19 @@ no_fallthrough([I|_]) -> is_unreachable_after(I). already_has_value(Lit, Lbl, Reg, D) -> - Key = {Lbl,Reg}, case D of - #{Lbl:=unsafe} -> - false; - #{Key:=Lit} -> + #{Lbl:={Reg,Lit}} -> true; #{} -> false end. update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> - Key = {Lbl,Reg}, D = case D0 of - #{Key := inconsistent} -> D0; - #{Key := _} -> D0#{Key := inconsistent}; - _ -> D0#{Key => Lit} + #{Lbl:=unsafe} -> D0; + #{Lbl:={Reg,Lit}} -> D0; + #{Lbl:=_} -> D0#{Lbl:=unsafe}; + #{} -> D0#{Lbl=>{Reg,Lit}} end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. @@ -390,14 +398,13 @@ extract_seq_1(_, _) -> no. { entry :: beam_asm:label(), %Entry label (must not be moved). replace :: #{beam_asm:label() := beam_asm:label()}, %Labels to replace. - labels :: cerl_sets:set(), %Set of referenced labels. - index :: beam_utils:code_index() | {lazy,[beam_utils:instruction()]} %Index built lazily only if needed + labels :: cerl_sets:set() %Set of referenced labels. }). opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> Lbls = initial_labels(Is), - St = #st{entry=CLabel,replace=#{},labels=Lbls,index={lazy,Is}}, + St = #st{entry=CLabel,replace=#{},labels=Lbls}, opt(Is, [], St) end, Is0). @@ -407,7 +414,7 @@ find_fixpoint(OptFun, Is0) -> Is -> find_fixpoint(OptFun, Is) end. -opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> +opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc, St) -> %% We have %% Test Label Ops %% jump Label @@ -416,23 +423,10 @@ opt([{test,_,{f,L}=Lbl,_}=I|[{jump,{f,L}}|_]=Is], Acc0, St0) -> case beam_utils:is_pure_test(I) of false -> %% Test is not pure; we must keep it. - opt(Is, [I|Acc0], label_used(Lbl, St0)); + opt(Is, [I|Acc], label_used(Lbl, St)); true -> %% The test is pure and its failure label is the same %% as in the jump that follows -- thus it is not needed. - %% Check if any of the previous instructions could also be eliminated. - {Acc,St} = opt_useless_loads(Acc0, L, St0), - opt(Is, Acc, St) - end; -opt([{test,_,{f,L}=Lbl,_}=I|[{label,L}|_]=Is], Acc0, St0) -> - %% Similar to the above, except we have a fall-through rather than jump - %% Test Label Ops - %% label Label - case beam_utils:is_pure_test(I) of - false -> - opt(Is, [I|Acc0], label_used(Lbl, St0)); - true -> - {Acc,St} = opt_useless_loads(Acc0, L, St0), opt(Is, Acc, St) end; opt([{test,Test0,{f,L}=Lbl,Ops}=I|[{jump,To}|Is]=Is0], Acc, St) -> @@ -499,46 +493,6 @@ normalize_replace([{From,To0}|Rest], Replace, Acc) -> normalize_replace([], _Replace, Acc) -> maps:from_list(Acc). -%% After eliminating a test, it might happen, that a register was only used -%% in this test. Let's check if that was the case and if it was so, we can -%% eliminate the load into the register completely. -opt_useless_loads([{block,_}|_]=Is, L, #st{index={lazy,FIs}}=St) -> - opt_useless_loads(Is, L, St#st{index=beam_utils:index_labels(FIs)}); -opt_useless_loads([{block,Block0}|Is], L, #st{index=Index}=St) -> - case opt_useless_block_loads(Block0, L, Index) of - [] -> - opt_useless_loads(Is, L, St); - [_|_]=Block -> - {[{block,Block}|Is],St} - end; -%% After eliminating the test and useless blocks, it might happen, -%% that the previous test could also be eliminated. -%% It might be that the label was already marked as used, even if ultimately, -%% it never will be - we can't do much about it at that point, though -opt_useless_loads([{test,_,{f,L},_}=I|Is], L, St) -> - case beam_utils:is_pure_test(I) of - false -> - {[I|Is],St}; - true -> - opt_useless_loads(Is, L, St) - end; -opt_useless_loads(Is, _L, St) -> - {Is,St}. - -opt_useless_block_loads([{set,[Dst],_,_}=I|Is], L, Index) -> - BlockJump = [{block,Is},{jump,{f,L}}], - case beam_utils:is_killed(Dst, BlockJump, Index) of - true -> - %% The register is killed and not used, we can remove the load - opt_useless_block_loads(Is, L, Index); - false -> - [I|opt_useless_block_loads(Is, L, Index)] - end; -opt_useless_block_loads([I|Is], L, Index) -> - [I|opt_useless_block_loads(Is, L, Index)]; -opt_useless_block_loads([], _L, _Index) -> - []. - collect_labels(Is, Label, #st{entry=Entry,replace=Replace} = St) -> collect_labels_1(Is, Label, Entry, Replace, St). @@ -665,6 +619,39 @@ drop_upto_label([{label,_}|_]=Is) -> Is; drop_upto_label([_|Is]) -> drop_upto_label(Is); drop_upto_label([]) -> []. +%% unshare([Instruction]) -> [Instruction]. +%% Replace a jump to a return sequence (a `return` instruction +%% optionally preced by a `deallocate` instruction) with the return +%% sequence. This always saves execution time and may also save code +%% space (depending on the architecture). Eliminating `jump` +%% instructions also gives beam_trim more opportunities to trim the +%% stack. + +unshare(Is) -> + Short = unshare_collect_short(Is, #{}), + unshare_short(Is, Short). + +unshare_collect_short([{label,L},return|Is], Map) -> + unshare_collect_short(Is, Map#{L=>[return]}); +unshare_collect_short([{label,L},{deallocate,_}=D,return|Is], Map) -> + %% `deallocate` and `return` are combined into one instruction by + %% the loader. + unshare_collect_short(Is, Map#{L=>[D,return]}); +unshare_collect_short([_|Is], Map) -> + unshare_collect_short(Is, Map); +unshare_collect_short([], Map) -> Map. + +unshare_short([{jump,{f,F}}=I|Is], Map) -> + case Map of + #{F:=Seq} -> + Seq ++ unshare_short(Is, Map); + #{} -> + [I|unshare_short(Is, Map)] + end; +unshare_short([I|Is], Map) -> + [I|unshare_short(Is, Map)]; +unshare_short([], _Map) -> []. + %% ulbl(Instruction, UsedCerlSet) -> UsedCerlSet' %% Update the cerl_set UsedCerlSet with any function-local labels %% (i.e. not with labels in call instructions) referenced by diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index 8a0ce5b50a..6121593b11 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -66,7 +66,7 @@ module(Stream, [_|_]=Fs) -> foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs). format_asm([{label,L}|Is]) -> - [" {label,",integer_to_list(L),"}.\n"|format_asm(Is)]; + [io_lib:format(" {label,~p}.\n", [L])|format_asm(Is)]; format_asm([I|Is]) -> [io_lib:format(" ~p", [I]),".\n"|format_asm(Is)]; format_asm([]) -> []. diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl index 2323a439e9..5730e9704e 100644 --- a/lib/compiler/src/beam_peep.erl +++ b/lib/compiler/src/beam_peep.erl @@ -94,30 +94,26 @@ peep([{gc_bif,_,_,_,_,Dst}=I|Is], SeenTests0, Acc) -> peep([{jump,{f,L}},{label,L}=I|Is], _, Acc) -> %% Sometimes beam_jump has missed this optimization. peep(Is, gb_sets:empty(), [I|Acc]); -peep([{select,Op,R,F,Vls0}|Is], SeenTests0, Acc0) -> +peep([{select,select_val,R,F,Vls0}|Is], SeenTests0, Acc0) -> case prune_redundant_values(Vls0, F) of [] -> %% No values left. Must convert to plain jump. I = {jump,F}, peep([I|Is], gb_sets:empty(), Acc0); - [{atom,_}=Value,Lbl] when Op =:= select_val -> + [{atom,_}=Value,Lbl] -> %% Single value left. Convert to regular test. Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], peep(Is1, SeenTests0, Acc0); - [{integer,_}=Value,Lbl] when Op =:= select_val -> + [{integer,_}=Value,Lbl] -> %% Single value left. Convert to regular test. Is1 = [{test,is_eq_exact,F,[R,Value]},{jump,Lbl}|Is], peep(Is1, SeenTests0, Acc0); - [Arity,Lbl] when Op =:= select_tuple_arity -> - %% Single value left. Convert to regular test - Is1 = [{test,test_arity,F,[R,Arity]},{jump,Lbl}|Is], - peep(Is1, SeenTests0, Acc0); [{atom,B1},Lbl,{atom,B2},Lbl] when B1 =:= not B2 -> %% Replace with is_boolean test. Is1 = [{test,is_boolean,F,[R]},{jump,Lbl}|Is], peep(Is1, SeenTests0, Acc0); [_|_]=Vls -> - I = {select,Op,R,F,Vls}, + I = {select,select_val,R,F,Vls}, peep(Is, gb_sets:empty(), [I|Acc0]) end; peep([{get_map_elements,Fail,Src,List}=I|Is], _SeenTests, Acc0) -> diff --git a/lib/compiler/src/beam_ssa.erl b/lib/compiler/src/beam_ssa.erl index c5e23d2ae0..b491e340b7 100644 --- a/lib/compiler/src/beam_ssa.erl +++ b/lib/compiler/src/beam_ssa.erl @@ -194,6 +194,7 @@ no_side_effect(#b_set{op=Op}) -> extract -> true; get_hd -> true; get_tl -> true; + get_map_element -> true; get_tuple_element -> true; has_map_field -> true; is_nonempty_list -> true; diff --git a/lib/compiler/src/beam_ssa_codegen.erl b/lib/compiler/src/beam_ssa_codegen.erl index 3c14062d0b..d3facc5911 100644 --- a/lib/compiler/src/beam_ssa_codegen.erl +++ b/lib/compiler/src/beam_ssa_codegen.erl @@ -747,7 +747,16 @@ need_live_anno(Op) -> end. %%% -%%% Add annotations for defined Y registers. +%%% Add the following annotations for Y registers: +%%% +%%% def_yregs An ordset with variables that refer to live Y registers. +%%% That is, Y registers that that have been killed +%%% are not included. This annotation is added to all +%%% instructions that require Y registers to be initialized. +%%% +%%% kill_yregs This annotation is added to call instructions. It is +%%% an ordset containing variables referring to Y registers +%%% that will no longer be used after the call instruction. %%% defined(Linear, #cg{regs=Regs}) -> @@ -863,13 +872,35 @@ opt_allocate(Linear, #cg{regs=Regs}) -> opt_allocate_1([{L,#cg_blk{is=[#cg_alloc{stack=Stk}=I0|Is]}=Blk0}|Bs]=Bs0, Regs) when is_integer(Stk) -> - Yregs = opt_alloc_def(Bs0, gb_sets:singleton(L), []), - I = I0#cg_alloc{def_yregs=Yregs}, - [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)]; + %% Collect the variables that are initialized by copy + %% instruction in this block. + case ordsets:from_list(opt_allocate_defs(Is, Regs)) of + Yregs when length(Yregs) =:= Stk -> + %% Those copy instructions are sufficient to fully + %% initialize the stack frame. + I = I0#cg_alloc{def_yregs=Yregs}, + [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)]; + Yregs0 -> + %% Determine a conservative approximation of the Y + %% registers that are guaranteed to be initialized by all + %% successors of this block, and to it add the variables + %% initialized by copy instructions in this block. + Yregs1 = opt_alloc_def(Bs0, gb_sets:singleton(L), []), + Yregs = ordsets:union(Yregs0, Yregs1), + I = I0#cg_alloc{def_yregs=Yregs}, + [{L,Blk0#cg_blk{is=[I|Is]}}|opt_allocate_1(Bs, Regs)] + end; opt_allocate_1([B|Bs], Regs) -> [B|opt_allocate_1(Bs, Regs)]; opt_allocate_1([], _) -> []. +opt_allocate_defs([#cg_set{op=copy,dst=Dst}|Is], Regs) -> + case is_yreg(Dst, Regs) of + true -> [Dst|opt_allocate_defs(Is, Regs)]; + false -> [] + end; +opt_allocate_defs(_, _Regs) -> []. + opt_alloc_def([{L,#cg_blk{is=Is,last=Last}}|Bs], Ws0, Def0) -> case gb_sets:is_member(L, Ws0) of false -> diff --git a/lib/compiler/src/beam_ssa_dead.erl b/lib/compiler/src/beam_ssa_dead.erl index c20652580d..067d9a6741 100644 --- a/lib/compiler/src/beam_ssa_dead.erl +++ b/lib/compiler/src/beam_ssa_dead.erl @@ -135,7 +135,8 @@ shortcut_terminator(Last, _Is, _Bs, _St) -> Last. shortcut_switch([{Lit,L0}|T], Bool, Bs, St0) -> - St = St0#st{rel_op=normalize_op({bif,'=:='}, [Bool,Lit])}, + RelOp = {'=:=',Bool,Lit}, + St = St0#st{rel_op=RelOp}, #b_br{bool=#b_literal{val=true},succ=L} = shortcut(L0, bind_var(Bool, Lit, Bs), St#st{target=one_way}), [{Lit,L}|shortcut_switch(T, Bool, Bs, St0)]; @@ -388,41 +389,43 @@ eval_terminator(#b_switch{arg=Arg,fail=Fail,list=List}=Sw, Bs, St) -> %% Literal argument. Simplify to a `br`. beam_ssa:normalize(Sw#b_switch{arg=Val}); #b_var{} -> - case St of - #st{rel_op=none} -> - %% No previous relational operator is stored. - %% Give up. + %% Try optimizing the switch. + case eval_switch(List, Arg, St, Fail) of + none -> none; - #st{} -> - %% There is a previous relational operator stored. - %% Try optimizing the switch. - case eval_switch(List, Arg, St, Fail) of - none -> - none; - To when is_integer(To) -> - %% Either one of the values in the switch - %% matched a previous value in a '=:=' test, or - %% none of the values matched a previous test. - #b_br{bool=#b_literal{val=true},succ=To,fail=To} - end + To when is_integer(To) -> + %% Either one of the values in the switch + %% matched a previous value in a '=:=' test, or + %% none of the values matched a previous test. + #b_br{bool=#b_literal{val=true},succ=To,fail=To} end end; eval_terminator(#b_ret{}, _Bs, _St) -> none. -eval_switch([{Lit,Lbl}|T], Arg, St, Fail) -> - case eval_rel_op({bif,'=:='}, [Arg,Lit], St) of - none -> - %% This label could be reached. - eval_switch(T, Arg, St, none); - #b_literal{val=false} -> - %% This branch will never be taken. - eval_switch(T, Arg, St, Fail); - #b_literal{val=true} -> +eval_switch(List, Arg, #st{rel_op={_,Arg,_}=PrevOp}, Fail) -> + %% There is a previous relational operator testing the same variable. + %% Optimization may be possible. + eval_switch_1(List, Arg, PrevOp, Fail); +eval_switch(_, _, _, _) -> + %% There is either no previous relational operator, or it tests + %% a different variable. Nothing to optimize. + none. + +eval_switch_1([{Lit,Lbl}|T], Arg, PrevOp, Fail) -> + RelOp = {'=:=',Arg,Lit}, + case will_succeed(PrevOp, RelOp) of + yes -> %% Success. This branch will always be taken. - Lbl + Lbl; + no -> + %% This branch will never be taken. + eval_switch_1(T, Arg, PrevOp, Fail); + maybe -> + %% This label could be reached. + eval_switch_1(T, Arg, PrevOp, none) end; -eval_switch([], _Arg, _St, Fail) -> +eval_switch_1([], _Arg, _PrevOp, Fail) -> %% Fail is now either the failure label or 'none'. Fail. diff --git a/lib/compiler/src/beam_ssa_opt.erl b/lib/compiler/src/beam_ssa_opt.erl index ac2d943fef..2dda67eac6 100644 --- a/lib/compiler/src/beam_ssa_opt.erl +++ b/lib/compiler/src/beam_ssa_opt.erl @@ -22,7 +22,8 @@ -export([module/2]). -include("beam_ssa.hrl"). --import(lists, [all/2,append/1,foldl/3,keyfind/3,member/2,reverse/1,reverse/2, +-import(lists, [all/2,append/1,foldl/3,keyfind/3,member/2, + reverse/1,reverse/2, splitwith/2,takewhile/2,unzip/1]). -spec module(beam_ssa:b_module(), [compile:option()]) -> @@ -787,15 +788,20 @@ float_flush_regs(#fs{regs=Rs}) -> %%% with a cheaper instructions %%% -ssa_opt_live(#st{ssa=Linear}=St) -> - St#st{ssa=live_opt(reverse(Linear), #{}, [])}. +ssa_opt_live(#st{ssa=Linear0}=St) -> + RevLinear = reverse(Linear0), + Blocks0 = maps:from_list(RevLinear), + Blocks = live_opt(RevLinear, #{}, Blocks0), + Linear = beam_ssa:linearize(Blocks), + St#st{ssa=Linear}. -live_opt([{L,Blk0}|Bs], LiveMap0, Acc) -> - Successors = beam_ssa:successors(Blk0), +live_opt([{L,Blk0}|Bs], LiveMap0, Blocks) -> + Blk1 = beam_ssa_share:block(Blk0, Blocks), + Successors = beam_ssa:successors(Blk1), Live0 = live_opt_succ(Successors, L, LiveMap0), - {Blk,Live} = live_opt_blk(Blk0, Live0), + {Blk,Live} = live_opt_blk(Blk1, Live0), LiveMap = live_opt_phis(Blk#b_blk.is, L, Live, LiveMap0), - live_opt(Bs, LiveMap, [{L,Blk}|Acc]); + live_opt(Bs, LiveMap, Blocks#{L:=Blk}); live_opt([], _, Acc) -> Acc. live_opt_succ([S|Ss], L, LiveMap) -> diff --git a/lib/compiler/src/beam_ssa_pre_codegen.erl b/lib/compiler/src/beam_ssa_pre_codegen.erl index 9175931375..32232e9b9f 100644 --- a/lib/compiler/src/beam_ssa_pre_codegen.erl +++ b/lib/compiler/src/beam_ssa_pre_codegen.erl @@ -1478,6 +1478,10 @@ copy_retval_is([#b_set{op=put_tuple_elements,args=Args0}=I0], false, _Yregs, Copy, Count, Acc) -> I = I0#b_set{args=copy_sub_args(Args0, Copy)}, {reverse(Acc, [I|acc_copy([], Copy)]),Count}; +copy_retval_is([#b_set{op=Op}=I0], false, Yregs, Copy, Count0, Acc0) + when Op =:= call; Op =:= make_fun -> + {I,Count,Acc} = place_retval_copy(I0, Yregs, Copy, Count0, Acc0), + {reverse(Acc, [I]),Count}; copy_retval_is([#b_set{}]=Is, false, _Yregs, Copy, Count, Acc) -> {reverse(Acc, acc_copy(Is, Copy)),Count}; copy_retval_is([#b_set{},#b_set{op=succeeded}]=Is, false, _Yregs, Copy, Count, Acc) -> @@ -2211,7 +2215,13 @@ linear_scan(#st{intervals=Intervals0,res=Res}=St0) -> Free = init_free(maps:to_list(Res)), Intervals1 = [init_interval(Int, Res) || Int <- Intervals0], Intervals = sort(Intervals1), - IsReserved = fun (#i{reg=Reg}) -> Reg =/= none end, + IsReserved = fun(#i{reg=Reg}) -> + case Reg of + none -> false; + {prefer,{_,_}} -> false; + {_,_} -> true + end + end, {UnhandledRes,Unhandled} = partition(IsReserved, Intervals), L = #l{unhandled_res=UnhandledRes, unhandled_any=Unhandled,free=Free}, diff --git a/lib/compiler/src/beam_ssa_share.erl b/lib/compiler/src/beam_ssa_share.erl new file mode 100644 index 0000000000..426efa2cc9 --- /dev/null +++ b/lib/compiler/src/beam_ssa_share.erl @@ -0,0 +1,370 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%% Share code for semantically equivalent blocks referred to +%% to by `br` and `switch` instructions. +%% +%% A similar optimization is done in beam_jump, but doing it here as +%% well is beneficial as it may enable other optimizations. If there +%% are many semantically equivalent clauses, this optimization can +%% substanstially decrease compilation times. +%% +%% block/2 is called from the liveness optimization pass in +%% beam_ssa_opt, as code sharing helps the liveness pass and vice +%% versa. +%% + +-module(beam_ssa_share). +-export([module/2,block/2]). + +-include("beam_ssa.hrl"). + +-import(lists, [keyfind/3,reverse/1,sort/1]). + +-spec module(beam_ssa:b_module(), [compile:option()]) -> + {'ok',beam_ssa:b_module()}. + +module(#b_module{body=Fs0}=Module, _Opts) -> + Fs = [function(F) || F <- Fs0], + {ok,Module#b_module{body=Fs}}. + +-spec block(Blk0, Blocks0) -> Blk when + Blk0 :: beam_ssa:b_blk(), + Blocks0 :: beam_ssa:block_map(), + Blk :: beam_ssa:b_blk(). + +block(#b_blk{last=Last0}=Blk, Blocks) -> + case share_terminator(Last0, Blocks) of + none -> Blk; + Last -> Blk#b_blk{last=beam_ssa:normalize(Last)} + end. + +%%% +%%% Local functions. +%%% + +function(#b_function{anno=Anno,bs=Blocks0}=F) -> + try + PO = reverse(beam_ssa:rpo(Blocks0)), + {Blocks1,Changed} = blocks(PO, Blocks0, false), + Blocks = case Changed of + true -> + beam_ssa:trim_unreachable(Blocks1); + false -> + Blocks0 + end, + F#b_function{bs=Blocks} + catch + Class:Error:Stack -> + #{func_info:={_,Name,Arity}} = Anno, + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +blocks([L|Ls], Blocks, Changed) -> + #b_blk{last=Last0} = Blk0 = map_get(L, Blocks), + case block(Blk0, Blocks) of + #b_blk{last=Last0} -> + blocks(Ls, Blocks, Changed); + #b_blk{}=Blk -> + blocks(Ls, Blocks#{L:=Blk}, true) + end; +blocks([], Blocks, Changed) -> + {Blocks,Changed}. + +share_terminator(#b_br{bool=#b_var{},succ=Succ0,fail=Fail0}=Br, Blocks) -> + {Succ,SuccBlk} = shortcut_nonempty_block(Succ0, Blocks), + {Fail,FailBlk} = shortcut_nonempty_block(Fail0, Blocks), + case are_equivalent(Succ, SuccBlk, Fail, FailBlk, Blocks) of + true -> + %% The blocks are semantically equivalent. + Br#b_br{succ=Succ,fail=Succ}; + false -> + if + Succ =:= Succ0, Fail =:= Fail0 -> + %% None of blocks were cut short. + none; + true -> + %% One or both labels were cut short + %% to avoid jumping to an empty block. + Br#b_br{succ=Succ,fail=Fail} + end + end; +share_terminator(#b_switch{}=Sw, Blocks) -> + share_switch(Sw, Blocks); +share_terminator(_Last, _Blocks) -> none. + +%% Test whether the two blocks are semantically equivalent. This +%% function is specially optimized to return `false` as fast as +%% possible if the blocks are not equivalent, as that is the common +%% case. + +are_equivalent(_Succ, _, ?BADARG_BLOCK, _, _Blocks) -> + %% ?BADARG_BLOCK is special. Sharing could be incorrect. + false; +are_equivalent(_Succ, #b_blk{is=Is1,last=#b_ret{arg=RetVal1}=Ret1}, + _Fail, #b_blk{is=Is2,last=#b_ret{arg=RetVal2}=Ret2}, _Blocks) -> + case {RetVal1,RetVal2} of + {#b_literal{},#b_literal{}} -> + case RetVal1 =:= RetVal2 of + true -> + %% The return values are identical literals. We + %% only need to compare the canonicalized bodies. + Can1 = canonical_is(Is1), + Can2 = canonical_is(Is2), + Can1 =:= Can2; + false -> + %% Non-equal literals. + false + end; + {#b_var{},#b_var{}} -> + %% The return values are varibles. We must canonicalize + %% the blocks (including returns) and compare them. + Can1 = canonical_is(Is1 ++ [Ret1]), + Can2 = canonical_is(Is2 ++ [Ret2]), + Can1 =:= Can2; + {_,_} -> + %% One literal and one variable. + false + end; +are_equivalent(Succ, + #b_blk{is=Is1, + last=#b_br{bool=#b_literal{val=true}, + succ=Target}}, + Fail, + #b_blk{is=Is2, + last=#b_br{bool=#b_literal{val=true}, + succ=Target}}, + Blocks) -> + %% Both blocks end with an unconditional branch to the + %% same target block. If the target block has phi nodes, + %% we must pick up the values from the phi nodes and + %% compare them. + #b_blk{is=Is} = map_get(Target, Blocks), + Phis1 = canonical_terminator_phis(Is, Succ), + Phis2 = canonical_terminator_phis(Is, Fail), + case {Phis1,Phis2} of + {[#b_set{args=[#b_literal{}]}|_],_} when Phis1 =/= Phis2 -> + %% Different values are used in the phi nodes. + false; + {_,[#b_set{args=[#b_literal{}]}|_]} when Phis1 =/= Phis2 -> + %% Different values are used in the phi nodes. + false; + {_,_} -> + %% The values in the phi nodes are variables or identical + %% literals. We must canonicalize the blocks and compare + %% them. + Can1 = canonical_is(Is1 ++ Phis1), + Can2 = canonical_is(Is2 ++ Phis2), + Can1 =:= Can2 + end; +are_equivalent(Succ0, #b_blk{is=Is1,last=#b_br{bool=#b_var{},fail=Same}}, + Fail0, #b_blk{is=Is2,last=#b_br{bool=#b_var{},fail=Same}}, + Blocks) -> + %% Two-way branches with identical failure labels. First compare the + %% canonicalized bodies of the blocks. + case canonical_is(Is1) =:= canonical_is(Is2) of + false -> + %% Different bodies. + false; + true -> + %% Bodies were equal. That is fairly uncommon, so to keep + %% the code simple we will rewrite the `br` to a `switch` + %% and let share_switch/2 do the work of following the + %% branches. + Sw = #b_switch{arg=#b_var{name=not_used},fail=Fail0, + list=[{#b_literal{},Succ0}]}, + #b_switch{fail=Fail,list=[{_,Succ}]} = share_switch(Sw, Blocks), + Fail =:= Succ + end; +are_equivalent(_, _, _, _, _) -> false. + +share_switch(#b_switch{fail=Fail0,list=List0}=Sw, Blocks) -> + Prep = share_prepare_sw([{value,Fail0}|List0], Blocks, 0, []), + Res = do_share_switch(Prep, Blocks, []), + [{_,Fail}|List] = [VL || {_,VL} <- sort(Res)], + Sw#b_switch{fail=Fail,list=List}. + +share_prepare_sw([{V,L0}|T], Blocks, N, Acc) -> + {L,_Blk} = shortcut_nonempty_block(L0, Blocks), + share_prepare_sw(T, Blocks, N+1, [{{L,#{}},{N,{V,L}}}|Acc]); +share_prepare_sw([], _, _, Acc) -> Acc. + +do_share_switch(Prep, Blocks, Acc) -> + Map = share_switch_1(Prep, Blocks, #{}), + share_switch_2(maps:values(Map), Blocks, Acc). + +share_switch_1([{Next0,Res}|T], Blocks, Map) -> + {Can,Next} = canonical_block(Next0, Blocks), + case Map of + #{Can:=Ls} -> + share_switch_1(T, Blocks, Map#{Can:=[{Next,Res}|Ls]}); + #{} -> + share_switch_1(T, Blocks, Map#{Can=>[{Next,Res}]}) + end; +share_switch_1([], _Blocks, Map) -> Map. + +share_switch_2([[{_,{N,Res}}]|T], Blocks, Acc) -> + %% This block is not equivalent to any other block. + share_switch_2(T, Blocks, [{N,Res}|Acc]); +share_switch_2([[{done,{_,{_,Common}}}|_]=Eqs|T], Blocks, Acc0) -> + %% Two or more blocks are semantically equivalent, and all blocks + %% are either terminated with a `ret` or a `br` to the same target + %% block. Replace the labels in the `switch` for all of those + %% blocks with the label for the first of the blocks. + Acc = [{N,{V,Common}} || {done,{N,{V,_}}} <- Eqs] ++ Acc0, + share_switch_2(T, Blocks, Acc); +share_switch_2([[{_,_}|_]=Prep|T], Blocks, Acc0) -> + %% Two or more blocks are semantically equivalent, but they have + %% different successful successor blocks. Now we must check + %% recursively whether the successor blocks are equivalent too. + Acc = do_share_switch(Prep, Blocks, Acc0), + share_switch_2(T, Blocks, Acc); +share_switch_2([], _, Acc) -> Acc. + +canonical_block({L,VarMap0}, Blocks) -> + #b_blk{is=Is,last=Last0} = map_get(L, Blocks), + case canonical_terminator(L, Last0, Blocks) of + none -> + %% The block has a terminator that we don't handle. + {{none,L},done}; + {Last,done} -> + %% The block ends with a `ret` or an unconditional `br` to + %% another block. + {Can,_VarMap} = canonical_is(Is ++ Last, VarMap0, []), + {Can,done}; + {Last,Next} -> + %% The block ends with a conditional branch. + {Can,VarMap} = canonical_is(Is ++ Last, VarMap0, []), + {Can,{Next,VarMap}} + end. + +%% Translate a sequence of instructions to a canonical representation. If the +%% canonical representation of two blocks compare equal, the blocks are +%% semantically equivalent. The following translations are done: +%% +%% * Variables defined in the instruction sequence are replaced with +%% {var,0}, {var,1}, and so on. Free variables are not changed. +%% +%% * `location` annotations that would produce a `line` instruction are +%% kept. All other annotations are cleared. +%% +%% * Instructions are repackaged into tuples instead of into the +%% usual records. The main reason is to avoid violating the types for +%% the SSA records. We can simplify things a little by linking the +%% instructions directly instead of putting them into a list. + +canonical_is(Is) -> + {Can,_} = canonical_is(Is, #{}, []), + Can. + +canonical_is([#b_set{op=Op,dst=Dst,args=Args0}=I|Is], VarMap0, Acc) -> + Args = [canonical_arg(Arg, VarMap0) || Arg <-Args0], + Var = {var,map_size(VarMap0)}, + VarMap = VarMap0#{Dst=>Var}, + LineAnno = case Op of + bs_match -> + %% The location annotation for a bs_match instruction + %% is only used in warnings, never to emit a `line` + %% instruction. Therefore, it should not be included. + []; + _ -> + %% The location annotation will be used in a `line` + %% instruction. It must be included. + beam_ssa:get_anno(location, I, none) + end, + canonical_is(Is, VarMap, {Op,LineAnno,Var,Args,Acc}); +canonical_is([#b_ret{arg=Arg}], VarMap, Acc0) -> + Acc1 = case Acc0 of + {call,_Anno,Var,[#b_local{}|_]=Args,PrevAcc} -> + %% This is a tail-recursive call to a local function. + %% There will be no line instruction generated; + %% thus, the annotation is not significant. + {call,[],Var,Args,PrevAcc}; + _ -> + Acc0 + end, + {{ret,canonical_arg(Arg, VarMap),Acc1},VarMap}; +canonical_is([#b_br{bool=#b_var{},fail=Fail}], VarMap, Acc) -> + {{br,succ,Fail,Acc},VarMap}; +canonical_is([#b_br{succ=Succ}], VarMap, Acc) -> + {{br,Succ,Acc},VarMap}; +canonical_is([], VarMap, Acc) -> + {Acc,VarMap}. + +canonical_terminator(_L, #b_ret{}=Ret, _Blocks) -> + {[Ret],done}; +canonical_terminator(L, #b_br{bool=#b_literal{val=true},succ=Succ}=Br, Blocks) -> + #b_blk{is=Is} = map_get(Succ, Blocks), + case canonical_terminator_phis(Is, L) of + [] -> + {[],Succ}; + [_|_]=Phis -> + {Phis ++ [Br],done} + end; +canonical_terminator(_L, #b_br{bool=#b_var{},succ=Succ}=Br, _Blocks) -> + {[Br],Succ}; +canonical_terminator(_, _, _) -> none. + +canonical_terminator_phis([#b_set{op=phi,args=PhiArgs}=Phi|Is], L) -> + {Value,L} = keyfind(L, 2, PhiArgs), + [Phi#b_set{op=copy,args=[Value]}|canonical_terminator_phis(Is, L)]; +canonical_terminator_phis([#b_set{op=peek_message}=I|_], L) -> + %% We could get stuck into an infinite loop if we allowed the + %% comparisons to continue into this block. Force an unequal + %% compare with all other predecessors of this block. + [I#b_set{op=copy,args=[#b_literal{val=L}]}]; +canonical_terminator_phis(_, _) -> []. + +canonical_arg(#b_var{}=Var, VarMap) -> + case VarMap of + #{Var:=CanonicalVar} -> + CanonicalVar; + #{} -> + Var + end; +canonical_arg(#b_remote{mod=Mod,name=Name}, VarMap) -> + {remote,canonical_arg(Mod, VarMap), + canonical_arg(Name, VarMap)}; +canonical_arg(Other, _VarMap) -> Other. + +%% Shortcut branches to empty blocks if safe. + +shortcut_nonempty_block(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[],last=#b_br{bool=#b_literal{val=true},succ=Succ}}=Blk -> + %% This block is empty. + case is_forbidden(Succ, Blocks) of + false -> + shortcut_nonempty_block(Succ, Blocks); + true -> + {L,Blk} + end; + #b_blk{}=Blk -> + {L,Blk} + end. + +is_forbidden(L, Blocks) -> + case map_get(L, Blocks) of + #b_blk{is=[#b_set{op=phi}|_]} -> true; + #b_blk{is=[#b_set{op=peek_message}|_]} -> true; + #b_blk{} -> false + end. diff --git a/lib/compiler/src/beam_ssa_type.erl b/lib/compiler/src/beam_ssa_type.erl index 18e6e73a46..95fc3bb0e9 100644 --- a/lib/compiler/src/beam_ssa_type.erl +++ b/lib/compiler/src/beam_ssa_type.erl @@ -27,9 +27,10 @@ -define(UNICODE_INT, #t_integer{elements={0,16#10FFFF}}). --record(d, {ds :: #{beam_ssa:var_name():=beam_ssa:b_set()}, +-record(d, {ds :: #{beam_ssa:b_var():=beam_ssa:b_set()}, ls :: #{beam_ssa:label():=type_db()}, - sub :: #{beam_ssa:var_name():=beam_ssa:value()} + once :: cerl_sets:set(beam_ssa:b_var()), + sub :: #{beam_ssa:b_var():=beam_ssa:value()} }). -define(ATOM_SET_SIZE, 5). @@ -56,13 +57,15 @@ Block :: beam_ssa:b_blk(). opt(Linear, Args) -> + UsedOnce = used_once(Linear, Args), Ts = maps:from_list([{V,any} || #b_var{}=V <- Args]), FakeCall = #b_set{op=call,args=[#b_remote{mod=#b_literal{val=unknown}, name=#b_literal{val=unknown}, arity=0}]}, Defs = maps:from_list([{Var,FakeCall#b_set{dst=Var}} || #b_var{}=Var <- Args]), - D = #d{ds=Defs,ls=#{0=>Ts},sub=#{}}, + D = #d{ds=Defs,ls=#{0=>Ts,?BADARG_BLOCK=>#{}}, + once=UsedOnce,sub=#{}}, opt_1(Linear, D). opt_1([{L,Blk}|Bs], #d{ls=Ls}=D) -> @@ -425,16 +428,43 @@ opt_terminator(#b_ret{}=Ret, _Ts, _Ds) -> Ret. update_successors(#b_br{bool=#b_literal{val=true},succ=S}, Ts, D) -> update_successor(S, Ts, D); -update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts, D0) -> - D = update_successor_bool(Bool, false, Fail, Ts, D0), - SuccTs = infer_types(Bool, Ts, D0), - update_successor_bool(Bool, true, Succ, SuccTs, D); -update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts, D0) -> - D = update_successor(Fail, Ts, D0), - foldl(fun({Val,S}, A) -> - T = get_type(Val, Ts), - update_successor(S, Ts#{V=>T}, A) - end, D, List); +update_successors(#b_br{bool=#b_var{}=Bool,succ=Succ,fail=Fail}, Ts0, D0) -> + case cerl_sets:is_element(Bool, D0#d.once) of + true -> + %% This variable is defined in this block and is only + %% referenced by this br terminator. Therefore, there is + %% no need to include the type database passed on to the + %% successors of this block. + Ts = maps:remove(Bool, Ts0), + D = update_successor(Fail, Ts, D0), + SuccTs = infer_types(Bool, Ts, D0), + update_successor(Succ, SuccTs, D); + false -> + D = update_successor_bool(Bool, false, Fail, Ts0, D0), + SuccTs = infer_types(Bool, Ts0, D0), + update_successor_bool(Bool, true, Succ, SuccTs, D) + end; +update_successors(#b_switch{arg=#b_var{}=V,fail=Fail,list=List}, Ts0, D0) -> + case cerl_sets:is_element(V, D0#d.once) of + true -> + %% This variable is defined in this block and is only + %% referenced by this switch terminator. Therefore, there is + %% no need to include the type database passed on to the + %% successors of this block. + Ts = maps:remove(V, Ts0), + D = update_successor(Fail, Ts, D0), + F = fun({_Val,S}, A) -> + update_successor(S, Ts, A) + end, + foldl(F, D, List); + false -> + D = update_successor(Fail, Ts0, D0), + F = fun({Val,S}, A) -> + T = get_type(Val, Ts0), + update_successor(S, Ts0#{V=>T}, A) + end, + foldl(F, D, List) + end; update_successors(#b_ret{}, _Ts, D) -> D. update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> @@ -447,6 +477,11 @@ update_successor_bool(#b_var{}=Var, BoolValue, S, Ts, D) -> update_successor(S, Ts, D) end. +update_successor(?BADARG_BLOCK, _Ts, #d{}=D) -> + %% We KNOW that no variables are used in the ?BADARG_BLOCK, + %% so there is no need to update the type information. That + %% can be a huge timesaver for huge functions. + D; update_successor(S, Ts0, #d{ls=Ls}=D) -> case Ls of #{S:=Ts1} -> @@ -766,6 +801,48 @@ simplify_not(#b_br{bool=#b_var{}=V,succ=Succ,fail=Fail}=Br0, Ts, Ds) -> Br0 end. +%%% +%%% Calculate the set of variables that are only used once in the +%%% block that they are defined in. That will allow us to discard type +%%% information for variables that will never be referenced by the +%%% successor blocks, potentially improving compilation times. +%%% + +used_once(Linear, Args) -> + Map0 = used_once_1(reverse(Linear), #{}), + Map = maps:without(Args, Map0), + cerl_sets:from_list(maps:keys(Map)). + +used_once_1([{L,#b_blk{is=Is,last=Last}}|Bs], Uses0) -> + Uses = used_once_2([Last|reverse(Is)], L, Uses0), + used_once_1(Bs, Uses); +used_once_1([], Uses) -> Uses. + +used_once_2([I|Is], L, Uses0) -> + Uses = used_once_uses(beam_ssa:used(I), L, Uses0), + case I of + #b_set{dst=Dst} -> + case Uses of + #{Dst:=[L]} -> + used_once_2(Is, L, Uses); + #{} -> + used_once_2(Is, L, maps:remove(Dst, Uses)) + end; + _ -> + used_once_2(Is, L, Uses) + end; +used_once_2([], _, Uses) -> Uses. + +used_once_uses([V|Vs], L, Uses) -> + case Uses of + #{V:=Us} -> + used_once_uses(Vs, L, Uses#{V:=[L|Us]}); + #{} -> + used_once_uses(Vs, L, Uses#{V=>[L]}) + end; +used_once_uses([], _, Uses) -> Uses. + + get_types(Values, Ts) -> [get_type(Val, Ts) || Val <- Values]. -spec get_type(beam_ssa:value(), type_db()) -> type(). diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 1acbedd45b..51ff580a7a 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -21,12 +21,11 @@ -module(beam_trim). -export([module/2]). --import(lists, [reverse/1,reverse/2,splitwith/2,sort/1]). +-import(lists, [any/2,member/2,reverse/1,reverse/2,splitwith/2,sort/1]). -record(st, - {safe :: gb_sets:set(beam_asm:label()), %Safe labels. - lbl :: beam_utils:code_index() %Code at each label. - }). + {safe :: cerl_sets:set(beam_asm:label()) %Safe labels. + }). -spec module(beam_utils:module_code(), [compile:option()]) -> {'ok',beam_utils:module_code()}. @@ -36,10 +35,15 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Is0}) -> - %%ok = io:fwrite("~w: ~p\n", [?LINE,{Name,Arity}]), - St = #st{safe=safe_labels(Is0, []),lbl=beam_utils:index_labels(Is0)}, - Is = trim(Is0, St, []), - {function,Name,Arity,CLabel,Is}. + try + St = #st{safe=safe_labels(Is0, [])}, + Is = trim(Is0, St, []), + {function,Name,Arity,CLabel,Is} + catch + Class:Error:Stack -> + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. trim([{kill,_}|_]=Is0, St, Acc) -> {Kills0,Is1} = splitwith(fun({kill,_}) -> true; @@ -47,14 +51,33 @@ trim([{kill,_}|_]=Is0, St, Acc) -> end, Is0), Kills = sort(Kills0), try - {FrameSize,Layout} = frame_layout(Is1, Kills, St), - Configs = trim_instructions(Layout), - try_remap(Configs, Is1, FrameSize) - of + %% Find out the size and layout of the stack frame. + %% Example of a layout: + %% + %% [{kill,{y,0}},{dead,{y,1},{live,{y,2}},{kill,{y,3}}] + %% + %% That means that y0 and y3 are to be killed, that y1 + %% has been killed previously, and that y2 is live. + {FrameSize,Layout} = frame_layout(Is1, Kills, St), + + %% Calculate all recipes that are not worse in terms + %% of estimated execution time. The recipes are ordered + %% in descending order from how much they trim. + Recipes = trim_recipes(Layout), + + %% Try the recipes in order. A recipe may not work out because + %% a register that was previously killed may be + %% resurrected. If that happens, the next recipe, which trims + %% less, will be tried. + try_remap(Recipes, Is1, FrameSize) + of {Is,TrimInstr} -> + %% One of the recipes was applied. trim(Is, St, reverse(TrimInstr)++Acc) catch not_possible -> + %% No recipe worked out. Use the original kill + %% instructions. trim(Is1, St, reverse(Kills, Acc)) end; trim([I|Is], St, Acc) -> @@ -62,34 +85,42 @@ trim([I|Is], St, Acc) -> trim([], _, Acc) -> reverse(Acc). -%% trim_instructions([{kill,R}|{live,R}|{dead,R}]) -> {[Instruction],MapFun} -%% Figure out the sequence of moves and trim to use. +%% trim_recipes([{kill,R}|{live,R}|{dead,R}]) -> [Recipe]. +%% Recipe = {Kills,NumberToTrim,Moves} +%% Kills = [{kill,Y}] +%% Moves = [{move,SrcY,DstY}] +%% +%% Calculate how to best trim the stack and kill the correct +%% Y registers. Return a list of possible recipes. The best +%% recipe (the one that trims the most) is first in the list. +%% All of the recipes are no worse in estimated execution time +%% than the original sequences of kill instructions. -trim_instructions(Layout) -> +trim_recipes(Layout) -> Cost = length([I || {kill,_}=I <- Layout]), - trim_instructions_1(Layout, 0, [], {Cost,[]}). + trim_recipes_1(Layout, 0, [], {Cost,[]}). -trim_instructions_1([{kill,{y,Trim0}}|Ks], Trim0, Moves, Config0) -> +trim_recipes_1([{kill,{y,Trim0}}|Ks], Trim0, Moves, Recipes0) -> Trim = Trim0 + 1, - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config); -trim_instructions_1([{dead,{y,Trim0}}|Ks], Trim0, Moves, Config0) -> + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes); +trim_recipes_1([{dead,{y,Trim0}}|Ks], Trim0, Moves, Recipes0) -> Trim = Trim0 + 1, - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config); -trim_instructions_1([{live,{y,Trim0}=Src}|Ks0], Trim0, Moves0, Config0) -> + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes); +trim_recipes_1([{live,{y,Trim0}=Src}|Ks0], Trim0, Moves0, Recipes0) -> case take_last_dead(Ks0) of none -> - {_,ConfigList} = Config0, - ConfigList; + {_,RecipesList} = Recipes0, + RecipesList; {Dst,Ks} -> Trim = Trim0 + 1, Moves = [{move,Src,Dst}|Moves0], - Config = save_config(Ks, Trim, Moves, Config0), - trim_instructions_1(Ks, Trim, Moves, Config) + Recipes = save_recipe(Ks, Trim, Moves, Recipes0), + trim_recipes_1(Ks, Trim, Moves, Recipes) end; -trim_instructions_1([], _, _, {_,ConfigList}) -> - ConfigList. +trim_recipes_1([], _, _, {_,RecipesList}) -> + RecipesList. take_last_dead(L) -> take_last_dead_1(reverse(L)). @@ -100,28 +131,48 @@ take_last_dead_1([{dead,Reg}|Is]) -> {Reg,reverse(Is)}; take_last_dead_1(_) -> none. -save_config(Ks, Trim, Moves, {MaxCost,Acc}=Config) -> - case config_cost(Ks, Moves) of - Cost when Cost =< MaxCost -> - {MaxCost,[{Ks,Trim,Moves}|Acc]}; +save_recipe(Ks, Trim, Moves, {MaxCost,Acc}=Recipes) -> + case recipe_cost(Ks, Moves) of + Cost when Cost =< MaxCost -> + %% The price is right. + {MaxCost,[{Ks,Trim,Moves}|Acc]}; _Cost -> - Config + %% Too expensive. + Recipes end. -config_cost(Ks, Moves) -> +recipe_cost(Ks, Moves) -> %% We estimate that a {move,{y,_},{y,_}} instruction is roughly twice as %% expensive as a {kill,{y,_}} instruction. A {trim,_} instruction is %% roughly as expensive as a {kill,{y,_}} instruction. - config_cost_1(Ks, 1+2*length(Moves)). + recipe_cost_1(Ks, 1+2*length(Moves)). -config_cost_1([{kill,_}|Ks], Cost) -> - config_cost_1(Ks, Cost+1); -config_cost_1([_|Ks], Cost) -> - config_cost_1(Ks, Cost); -config_cost_1([], Cost) -> Cost. +recipe_cost_1([{kill,_}|Ks], Cost) -> + recipe_cost_1(Ks, Cost+1); +recipe_cost_1([_|Ks], Cost) -> + recipe_cost_1(Ks, Cost); +recipe_cost_1([], Cost) -> Cost. + +%% try_remap([Recipe], [Instruction], FrameSize) -> +%% {[Instruction],[TrimInstruction]}. +%% Try to renumber Y registers in the instruction stream. The +%% first rececipe that works will be used. +%% +%% This function will issue a `not_possible` exception if none +%% of the recipes were possible to apply. + +try_remap([R|Rs], Is, FrameSize) -> + {TrimInstr,Map} = expand_recipe(R, FrameSize), + try + {remap(Is, Map, []),TrimInstr} + catch + throw:not_possible -> + try_remap(Rs, Is, FrameSize) + end; +try_remap([], _, _) -> throw(not_possible). -expand_config({Layout,Trim,Moves}, FrameSize) -> +expand_recipe({Layout,Trim,Moves}, FrameSize) -> Kills = [Kill || {kill,_}=Kill <- Layout], {Kills++reverse(Moves, [{trim,Trim,FrameSize-Trim}]),create_map(Trim, Moves)}. @@ -132,16 +183,16 @@ create_map(Trim, []) -> (Any) -> Any end; create_map(Trim, Moves) -> - GbTree0 = [{Src,Dst-Trim} || {move,{y,Src},{y,Dst}} <- Moves], - GbTree = gb_trees:from_orddict(sort(GbTree0)), - IllegalTargets = gb_sets:from_list([Dst || {move,_,{y,Dst}} <- Moves]), + Map0 = [{Src,Dst-Trim} || {move,{y,Src},{y,Dst}} <- Moves], + Map = maps:from_list(Map0), + IllegalTargets = cerl_sets:from_list([Dst || {move,_,{y,Dst}} <- Moves]), fun({y,Y0}) when Y0 < Trim -> - case gb_trees:lookup(Y0, GbTree) of - {value,Y} -> {y,Y}; - none -> throw(not_possible) - end; + case Map of + #{Y0:=Y} -> {y,Y}; + #{} -> throw(not_possible) + end; ({y,Y}) -> - case gb_sets:is_element(Y, IllegalTargets) of + case cerl_sets:is_element(Y, IllegalTargets) of true -> throw(not_possible); false -> {y,Y-Trim} end; @@ -149,19 +200,15 @@ create_map(Trim, Moves) -> (Any) -> Any end. -try_remap([C|Cs], Is, FrameSize) -> - {TrimInstr,Map} = expand_config(C, FrameSize), - try - {remap(Is, Map, []),TrimInstr} - catch - throw:not_possible -> - try_remap(Cs, Is, FrameSize) - end; -try_remap([], _, _) -> throw(not_possible). - remap([{block,Bl0}|Is], Map, Acc) -> Bl = remap_block(Bl0, Map, []), remap(Is, Map, [{block,Bl}|Acc]); +remap([{bs_get_tail,Src,Dst,Live}|Is], Map, Acc) -> + I = {bs_get_tail,Map(Src),Map(Dst),Live}, + remap(Is, Map, [I|Acc]); +remap([{bs_set_position,Src1,Src2}|Is], Map, Acc) -> + I = {bs_set_position,Map(Src1),Map(Src2)}, + remap(Is, Map, [I|Acc]); remap([{call_fun,_}=I|Is], Map, Acc) -> remap(Is, Map, [I|Acc]); remap([{call,_,_}=I|Is], Map, Acc) -> @@ -205,35 +252,66 @@ remap([return|_]=Is, _, Acc) -> reverse(Acc, Is); remap([{line,_}=I|Is], Map, Acc) -> remap(Is, Map, [I|Acc]). - + remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> Ds = [Map(D) || D <- Ds0], Ss = [Map(S) || S <- Ss0], remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]); remap_block([], _, Acc) -> reverse(Acc). - -safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{line,_},if_end|Is], Acc) -> - safe_labels(Is, [L|Acc]); -safe_labels([{label,L}, - {block,[{set,[{x,0}],[{Tag,_}],move}]}, - {line,_}, - {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y -> - safe_labels(Is, [L|Acc]); + +%% safe_labels([Instruction], Accumulator) -> gb_set() +%% Build a gb_set of safe labels. The code at a safe +%% label does not depend on the values in a specific +%% Y register, only that all Y registers are initialized +%% so that it safe to scan the stack when an exception +%% is generated. +%% +%% In other words, code at a safe label will continue +%% to work if Y registers have been renumbered and +%% the size of the stack frame has changed. + +safe_labels([{label,L}|Is], Acc) -> + case is_safe_label(Is) of + true -> safe_labels(Is, [L|Acc]); + false -> safe_labels(Is, Acc) + end; safe_labels([_|Is], Acc) -> safe_labels(Is, Acc); -safe_labels([], Acc) -> gb_sets:from_list(Acc). +safe_labels([], Acc) -> cerl_sets:from_list(Acc). + +is_safe_label([{line,_}|Is]) -> + is_safe_label(Is); +is_safe_label([{badmatch,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([{case_end,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([{try_case_end,{Tag,_}}|_]) -> + Tag =/= y; +is_safe_label([if_end|_]) -> + true; +is_safe_label([{block,Bl}|Is]) -> + is_safe_label_block(Bl) andalso is_safe_label(Is); +is_safe_label([{call_ext,_,{extfunc,M,F,A}}|_]) -> + erl_bifs:is_exit_bif(M, F, A); +is_safe_label(_) -> false. + +is_safe_label_block([{set,Ds,Ss,_}|Is]) -> + IsYreg = fun({y,_}) -> true; + (_) -> false + end, + %% This instruction is safe if the instruction + %% neither reads or writes Y registers. + not (any(IsYreg, Ss) orelse any(IsYreg, Ds)) andalso + is_safe_label_block(Is); +is_safe_label_block([]) -> true. %% frame_layout([Instruction], [{kill,_}], St) -> %% [{kill,Reg} | {live,Reg} | {dead,Reg}] %% Figure out the layout of the stack frame. -frame_layout(Is, Kills, #st{safe=Safe,lbl=D}) -> +frame_layout(Is, Kills, #st{safe=Safe}) -> N = frame_size(Is, Safe), - IsKilled = fun(R) -> beam_utils:is_not_used(R, Is, D) end, + IsKilled = fun(R) -> is_not_used(R, Is) end, {N,frame_layout_1(Kills, 0, N, IsKilled, [])}. frame_layout_1([{kill,{y,Y}}=I|Ks], Y, N, IsKilled, Acc) -> @@ -253,6 +331,11 @@ frame_layout_2(Is) -> reverse(Is). %% frame_size([Instruction], SafeLabels) -> FrameSize %% Find out the frame size by looking at the code that follows. +%% +%% Implicitly, also check that the instructions are a straight +%% sequence of code that ends in a return. Any branches are +%% to safe labels (i.e., the code at those labels don't depend +%% on the contents of any Y register). frame_size([{block,_}|Is], Safe) -> frame_size(Is, Safe); @@ -285,15 +368,92 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size(Is, Safe); frame_size([{get_map_elements,{f,L},_,_}|Is], Safe) -> frame_size_branch(L, Is, Safe); -frame_size([{deallocate,N}|_], _) -> N; +frame_size([{deallocate,N}|_], _) -> + N; frame_size([{line,_}|Is], Safe) -> frame_size(Is, Safe); +frame_size([{bs_set_position,_,_}|Is], Safe) -> + frame_size(Is, Safe); +frame_size([{bs_get_tail,_,_,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size(_, _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> frame_size(Is, Safe); frame_size_branch(L, Is, Safe) -> - case gb_sets:is_member(L, Safe) of + case cerl_sets:is_element(L, Safe) of false -> throw(not_possible); true -> frame_size(Is, Safe) end. + +%% is_not_used(Y, [Instruction]) -> true|false. +%% Test whether the value of Y is unused in the instruction sequence. +%% Return true if the value of Y is not used, and false if it is used. +%% +%% This function handles the same instructions as frame_size/2. It +%% assumes that any labels in the instructions are safe labels. + +is_not_used(Y, [{apply,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{bif,_,{f,_},Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{block,Bl}|Is]) -> + case is_not_used_block(Y, Bl) of + used -> false; + killed -> true; + transparent -> is_not_used(Y, Is) + end; +is_not_used(Y, [{bs_get_tail,Src,Dst,_}|Is]) -> + is_not_used_ss_dst(Y, [Src], Dst, Is); +is_not_used(Y, [{bs_init,_,_,_,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{bs_put,{f,_},_,Ss}|Is]) -> + not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{bs_set_position,Src1,Src2}|Is]) -> + Y =/= Src1 andalso Y =/= Src2 andalso + is_not_used(Y, Is); +is_not_used(Y, [{call,_,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{call_ext,_,_}=I|Is]) -> + beam_jump:is_exit_instruction(I) orelse is_not_used(Y, Is); +is_not_used(Y, [{call_fun,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(_Y, [{deallocate,_}|_]) -> + true; +is_not_used(Y, [{gc_bif,_,{f,_},_Live,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is); +is_not_used(Y, [{get_map_elements,{f,_},S,{list,List}}|Is]) -> + {Ss,Ds} = beam_utils:split_even(List), + case member(Y, [S|Ss]) of + true -> + false; + false -> + member(Y, Ds) orelse is_not_used(Y, Is) + end; +is_not_used(Y, [{kill,Yreg}|Is]) -> + Y =:= Yreg orelse is_not_used(Y, Is); +is_not_used(Y, [{line,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{make_fun2,_,_,_,_}|Is]) -> + is_not_used(Y, Is); +is_not_used(Y, [{test,_,_,Ss}|Is]) -> + not member(Y, Ss) andalso is_not_used(Y, Is); +is_not_used(Y, [{test,_Op,{f,_},_Live,Ss,Dst}|Is]) -> + is_not_used_ss_dst(Y, Ss, Dst, Is). + +is_not_used_block(Y, [{set,Ds,Ss,_}|Is]) -> + case member(Y, Ss) of + true -> + used; + false -> + case member(Y, Ds) of + true -> + killed; + false -> + is_not_used_block(Y, Is) + end + end; +is_not_used_block(_Y, []) -> transparent. + +is_not_used_ss_dst(Y, Ss, Dst, Is) -> + not member(Y, Ss) andalso (Y =:= Dst orelse is_not_used(Y, Is)). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 5156a04f6b..6e6574c0b3 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -18,23 +18,14 @@ %% %CopyrightEnd% %% %% Purpose : Common utilities used by several optimization passes. -%% +%% -module(beam_utils). --export([is_killed/3,is_killed_at/3,is_not_used/3, - empty_label_index/0,index_label/3,index_labels/1,replace_labels/4, - code_at/2,is_pure_test/1, - split_even/1]). +-export([replace_labels/4,is_pure_test/1,split_even/1]). -export_type([code_index/0,module_code/0,instruction/0]). --import(lists, [map/2,member/2,sort/1,reverse/1]). - --define(is_const(Val), (Val =:= nil orelse - element(1, Val) =:= integer orelse - element(1, Val) =:= float orelse - element(1, Val) =:= atom orelse - element(1, Val) =:= literal)). +-import(lists, [map/2,reverse/1]). %% instruction() describes all instructions that are used during optimization %% (from beam_a to beam_z). @@ -52,97 +43,6 @@ -type fail() :: beam_asm:fail() | 'fail'. -type test() :: {'test',atom(),fail(),[beam_asm:src()]} | {'test',atom(),fail(),integer(),list(),beam_asm:reg()}. --type result_cache() :: gb_trees:tree(beam_asm:label(), 'killed' | 'used'). - --record(live, - {lbl :: code_index(), %Label to code index. - res :: result_cache()}). %Result cache for each label. - -%% is_killed(Register, [Instruction], State) -> true|false -%% Determine whether a register is killed by the instruction sequence. -%% If true is returned, it means that the register will not be -%% referenced in ANY way (not even indirectly by an allocate instruction); -%% i.e. it is OK to enter the instruction sequence with Register -%% containing garbage. -%% -%% The state (constructed by index_instructions/1) is used to allow us -%% to determine the kill state across branches. - --spec is_killed(beam_asm:reg(), [instruction()], code_index()) -> boolean(). - -is_killed(R, Is, D) -> - St = #live{lbl=D,res=gb_trees:empty()}, - case check_liveness(R, Is, St) of - {killed,_} -> true; - {exit_not_used,_} -> false; - {_,_} -> false - end. - -%% is_killed_at(Reg, Lbl, State) -> true|false -%% Determine whether Reg is killed at label Lbl. - --spec is_killed_at(beam_asm:reg(), beam_asm:label(), code_index()) -> boolean(). - -is_killed_at(R, Lbl, D) when is_integer(Lbl) -> - St0 = #live{lbl=D,res=gb_trees:empty()}, - case check_liveness_at(R, Lbl, St0) of - {killed,_} -> true; - {exit_not_used,_} -> false; - {_,_} -> false - end. - -%% is_not_used(Register, [Instruction], State) -> true|false -%% Determine whether a register is never used in the instruction sequence -%% (it could still be referenced by an allocate instruction, meaning that -%% it MUST be initialized, but that its value does not matter). -%% The state is used to allow us to determine the usage state -%% across branches. - --spec is_not_used(beam_asm:reg(), [instruction()], code_index()) -> boolean(). - -is_not_used(R, Is, D) -> - St = #live{lbl=D,res=gb_trees:empty()}, - case check_liveness(R, Is, St) of - {used,_} -> false; - {exit_not_used,_} -> true; - {_,_} -> true - end. - -%% index_labels(FunctionIs) -> State -%% Index the instruction sequence so that we can quickly -%% look up the instruction following a specific label. - --spec index_labels([instruction()]) -> code_index(). - -index_labels(Is) -> - index_labels_1(Is, []). - -%% empty_label_index() -> State -%% Create an empty label index. - --spec empty_label_index() -> code_index(). - -empty_label_index() -> - gb_trees:empty(). - -%% index_label(Label, [Instruction], State) -> State -%% Add an index for a label. - --spec index_label(beam_asm:label(), [instruction()], code_index()) -> - code_index(). - -index_label(Lbl, Is0, Acc) -> - Is = drop_labels(Is0), - gb_trees:enter(Lbl, Is, Acc). - - -%% code_at(Label, State) -> [I]. -%% Retrieve the code at the given label. - --spec code_at(beam_asm:label(), code_index()) -> [instruction()]. - -code_at(L, Ll) -> - gb_trees:get(L, Ll). %% replace_labels(FunctionIs, Tail, ReplaceDb, Fallback) -> FunctionIs. %% Replace all labels in instructions according to the ReplaceDb. @@ -175,7 +75,7 @@ is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; is_pure_test({test,is_bitstr,_,[_]}) -> true; is_pure_test({test,is_function2,_,[_,_]}) -> true; -is_pure_test({test,Op,_,Ops}) -> +is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). %% split_even/1 @@ -189,438 +89,6 @@ split_even(Rs) -> split_even(Rs, [], []). %%% Local functions. %%% - -%% check_liveness(Reg, [Instruction], #live{}) -> -%% {killed | not_used | used, #live{}} -%% Find out whether Reg is used or killed in instruction sequence. -%% -%% killed - Reg is assigned or killed by an allocation instruction. -%% not_used - the value of Reg is not used, but Reg must not be garbage -%% exit_not_used - the value of Reg is not used, but must not be garbage -%% because the stack will be scanned because an -%% exit BIF will raise an exception -%% used - Reg is used - -check_liveness({fr,_}, _, St) -> - %% Conservatively always consider the floating point register used. - {used,St}; -check_liveness(R, [{block,Blk}|Is], St0) -> - case check_liveness_block(R, Blk, St0) of - {transparent,St1} -> - check_liveness(R, Is, St1); - {alloc_used,St1} -> - %% Used by an allocating instruction, but value not referenced. - %% Must check the rest of the instructions. - not_used(check_liveness(R, Is, St1)); - {Other,_}=Res when is_atom(Other) -> - Res - end; -check_liveness(R, [{label,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{test,_,{f,Fail},As}|Is], St0) -> - case member(R, As) of - true -> - {used,St0}; - false -> - case check_liveness_at(R, Fail, St0) of - {killed,St1} -> - check_liveness(R, Is, St1); - {exit_not_used,St1} -> - not_used(check_liveness(R, Is, St1)); - {not_used,St1} -> - not_used(check_liveness(R, Is, St1)); - {used,_}=Used -> - Used - end - end; -check_liveness(R, [{test,Op,Fail,Live,Ss,Dst}|Is], St) -> - %% Check this instruction as a block to get a less conservative - %% result if the caller is is_not_used/3. - Block = [{set,[Dst],Ss,{alloc,Live,{bif,Op,Fail}}}], - check_liveness(R, [{block,Block}|Is], St); -check_liveness(R, [{select,_,R,_,_}|_], St) -> - {used,St}; -check_liveness(R, [{select,_,_,Fail,Branches}|_], St) -> - check_liveness_everywhere(R, [Fail|Branches], St); -check_liveness(R, [{jump,{f,F}}|_], St) -> - check_liveness_at(R, F, St); -check_liveness(R, [{case_end,Used}|_], St) -> - check_liveness_exit(R, Used, St); -check_liveness(R, [{try_case_end,Used}|_], St) -> - check_liveness_exit(R, Used, St); -check_liveness(R, [{badmatch,Used}|_], St) -> - check_liveness_exit(R, Used, St); -check_liveness(R, [if_end|_], St) -> - check_liveness_exit(R, ignore, St); -check_liveness(R, [{func_info,_,_,Ar}|_], St) -> - case R of - {x,X} when X < Ar -> {used,St}; - _ -> {killed,St} - end; -check_liveness(R, [{kill,R}|_], St) -> - {killed,St}; -check_liveness(R, [{kill,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{bs_init,_,_,none,Ss,Dst}|Is], St) -> - case member(R, Ss) of - true -> - {used,St}; - false -> - if - R =:= Dst -> {killed,St}; - true -> check_liveness(R, Is, St) - end - end; -check_liveness(R, [{bs_init,_,_,Live,Ss,Dst}|Is], St) -> - case R of - {x,X} -> - case member(R, Ss) of - true -> - {used,St}; - false -> - if - X < Live -> - not_used(check_liveness(R, Is, St)); - true -> - {killed,St} - end - end; - {y,_} -> - case member(R, Ss) of - true -> {used,St}; - false -> - %% If the exception is taken, the stack may - %% be scanned. Therefore the register is not - %% guaranteed to be killed. - if - R =:= Dst -> {not_used,St}; - true -> not_used(check_liveness(R, Is, St)) - end - end - end; -check_liveness(R, [{deallocate,_}|Is], St) -> - case R of - {y,_} -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness({x,_}=R, [return|_], St) -> - case R of - {x,0} -> {used,St}; - {x,_} -> {killed,St} - end; -check_liveness(R, [{call,Live,_}|Is], St) -> - case R of - {x,X} when X < Live -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -check_liveness(R, [{call_ext,Live,_}=I|Is], St) -> - case R of - {x,X} when X < Live -> - {used,St}; - {x,_} -> - {killed,St}; - {y,_} -> - case beam_jump:is_exit_instruction(I) of - false -> - not_used(check_liveness(R, Is, St)); - true -> - %% We must make sure we don't check beyond this - %% instruction or we will fall through into random - %% unrelated code and get stuck in a loop. - {exit_not_used,St} - end - end; -check_liveness(R, [{call_fun,Live}|Is], St) -> - case R of - {x,X} when X =< Live -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -check_liveness(R, [{apply,Args}|Is], St) -> - case R of - {x,X} when X < Args+2 -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -check_liveness(R, [{bif,Op,Fail,Ss,D}|Is], St) -> - Set = {set,[D],Ss,{bif,Op,Fail}}, - check_liveness(R, [{block,[Set]}|Is], St); -check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St) -> - Set = {set,[D],Ss,{alloc,Live,{gc_bif,Op,Fail}}}, - check_liveness(R, [{block,[Set]}|Is], St); -check_liveness(R, [{bs_put,{f,0},_,Ss}|Is], St) -> - case member(R, Ss) of - true -> {used,St}; - false -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_restore2,S,_}|Is], St) -> - case R of - S -> {used,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{bs_save2,S,_}|Is], St) -> - case R of - S -> {used,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{move,S,D}|Is], St) -> - case R of - S -> {used,St}; - D -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> - case R of - {x,X} when X < NumFree -> {used,St}; - {x,_} -> {killed,St}; - {y,_} -> not_used(check_liveness(R, Is, St)) - end; -check_liveness(R, [{'catch'=Op,Y,Fail}|Is], St) -> - Set = {set,[Y],[],{try_catch,Op,Fail}}, - check_liveness(R, [{block,[Set]}|Is], St); -check_liveness(R, [{'try'=Op,Y,Fail}|Is], St) -> - Set = {set,[Y],[],{try_catch,Op,Fail}}, - check_liveness(R, [{block,[Set]}|Is], St); -check_liveness(R, [{try_end,Y}|Is], St) -> - case R of - Y -> - {killed,St}; - {y,_} -> - %% y registers will be used if an exception occurs and - %% control transfers to the label given in the previous - %% try/2 instruction. - {used,St}; - _ -> - check_liveness(R, Is, St) - end; -check_liveness(R, [{catch_end,Y}|Is], St) -> - case R of - Y -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{get_tuple_element,S,_,D}|Is], St) -> - case R of - S -> {used,St}; - D -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; -check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> - case R of - {x,_} -> - {killed,St}; - _ -> - %% y register. Rarely happens. Be very conversative and - %% assume it's used. - {used,St} - end; -check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> - check_liveness_at(R, Fail, St); -check_liveness(R, [{line,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{get_map_elements,{f,Fail},S,{list,L}}|Is], St0) -> - {Ss,Ds} = split_even(L), - case member(R, [S|Ss]) of - true -> - {used,St0}; - false -> - case check_liveness_at(R, Fail, St0) of - {killed,St}=Killed -> - case member(R, Ds) of - true -> Killed; - false -> check_liveness(R, Is, St) - end; - Other -> - Other - end - end; -check_liveness(R, [{put_map,F,Op,S,D,Live,{list,Puts}}|Is], St) -> - Set = {set,[D],[S|Puts],{alloc,Live,{put_map,Op,F}}}, - check_liveness(R, [{block,[Set]}||Is], St); -check_liveness(R, [{put_tuple,Ar,D}|Is], St) -> - Set = {set,[D],[],{put_tuple,Ar}}, - check_liveness(R, [{block,[Set]}||Is], St); -check_liveness(R, [{put_list,S1,S2,D}|Is], St) -> - Set = {set,[D],[S1,S2],put_list}, - check_liveness(R, [{block,[Set]}||Is], St); -check_liveness(R, [{test_heap,N,Live}|Is], St) -> - I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]}, - check_liveness(R, [I|Is], St); -check_liveness(R, [{allocate_zero,N,Live}|Is], St) -> - I = {block,[{set,[],[],{alloc,Live,{zero,N,0,[]}}}]}, - check_liveness(R, [I|Is], St); -check_liveness(R, [{get_hd,S,D}|Is], St) -> - I = {block,[{set,[D],[S],get_hd}]}, - check_liveness(R, [I|Is], St); -check_liveness(R, [{get_tl,S,D}|Is], St) -> - I = {block,[{set,[D],[S],get_tl}]}, - check_liveness(R, [I|Is], St); -check_liveness(R, [remove_message|Is], St) -> - check_liveness(R, Is, St); -check_liveness({x,X}, [build_stacktrace|_], St) when X > 0 -> - {killed,St}; -check_liveness(R, [{recv_mark,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{recv_set,_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(R, [{'%',_}|Is], St) -> - check_liveness(R, Is, St); -check_liveness(_R, Is, St) when is_list(Is) -> - %% Not implemented. Conservatively assume that the register is used. - {used,St}. - -check_liveness_everywhere(R, Lbls, St0) -> - check_liveness_everywhere_1(R, Lbls, killed, St0). - -check_liveness_everywhere_1(R, [{f,Lbl}|T], Res0, St0) -> - {Res1,St} = check_liveness_at(R, Lbl, St0), - Res = case Res1 of - killed -> Res0; - _ -> Res1 - end, - case Res of - used -> {used,St}; - _ -> check_liveness_everywhere_1(R, T, Res, St) - end; -check_liveness_everywhere_1(R, [_|T], Res, St) -> - check_liveness_everywhere_1(R, T, Res, St); -check_liveness_everywhere_1(_, [], Res, St) -> - {Res,St}. - -check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> - case gb_trees:lookup(Lbl, ResMemorized) of - {value,Res} -> - {Res,St0}; - none -> - {Res,St} = case gb_trees:lookup(Lbl, Ll) of - {value,Is} -> check_liveness(R, Is, St0); - none -> {used,St0} - end, - {Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}} - end. - -not_used({used,_}=Res) -> Res; -not_used({_,St}) -> {not_used,St}. - -check_liveness_exit(R, R, St) -> {used,St}; -check_liveness_exit({x,_}, _, St) -> {killed,St}; -check_liveness_exit({y,_}, _, St) -> {exit_not_used,St}. - -%% check_liveness_block(Reg, [Instruction], State) -> -%% {killed | not_used | used | alloc_used | transparent,State'} -%% Finds out how Reg is used in the instruction sequence inside a block. -%% Returns one of: -%% killed - Reg is assigned a new value or killed by an -%% allocation instruction -%% not_used - The value is not used, but the register is referenced -%% e.g. by an allocation instruction -%% transparent - Reg is neither used nor killed -%% alloc_used - Used only in an allocate instruction -%% used - Reg is explicitly used by an instruction -%% -%% Annotations are not allowed. -%% -%% (Unknown instructions will cause an exception.) - -check_liveness_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St0) -> - if - X >= Live -> - {killed,St0}; - true -> - case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {transparent,St} -> {alloc_used,St}; - {_,_}=Res -> not_used(Res) - end - end; -check_liveness_block({y,_}=R, [{set,Ds,Ss,{alloc,_Live,Op}}|Is], St0) -> - case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {transparent,St} -> {alloc_used,St}; - {_,_}=Res -> not_used(Res) - end; -check_liveness_block({y,_}=R, [{set,Ds,Ss,{try_catch,_,Op}}|Is], St0) -> - case Ds of - [R] -> - {killed,St0}; - _ -> - case check_liveness_block_1(R, Ss, Ds, Op, Is, St0) of - {exit_not_used,St} -> - {used,St}; - {transparent,St} -> - %% Conservatively assumed that it is used. - {used,St}; - {_,_}=Res -> - Res - end - end; -check_liveness_block(R, [{set,Ds,Ss,Op}|Is], St) -> - check_liveness_block_1(R, Ss, Ds, Op, Is, St); -check_liveness_block(_, [], St) -> {transparent,St}. - -check_liveness_block_1(R, Ss, Ds, Op, Is, St0) -> - case member(R, Ss) of - true -> - {used,St0}; - false -> - case check_liveness_block_2(R, Op, Ss, St0) of - {killed,St} -> - case member(R, Ds) of - true -> {killed,St}; - false -> check_liveness_block(R, Is, St) - end; - {exit_not_used,St} -> - case member(R, Ds) of - true -> {exit_not_used,St}; - false -> check_liveness_block(R, Is, St) - end; - {not_used,St} -> - not_used(case member(R, Ds) of - true -> {killed,St}; - false -> check_liveness_block(R, Is, St) - end); - {used,St} -> - {used,St} - end - end. - -check_liveness_block_2(R, {gc_bif,Op,{f,Lbl}}, Ss, St) -> - check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St); -check_liveness_block_2(R, {bif,Op,{f,Lbl}}, Ss, St) -> - Arity = length(Ss), - case erl_internal:comp_op(Op, Arity) orelse - erl_internal:new_type_test(Op, Arity) of - true -> - {killed,St}; - false -> - check_liveness_block_3(R, Lbl, {Op,length(Ss)}, St) - end; -check_liveness_block_2(R, {put_map,_Op,{f,Lbl}}, _Ss, St) -> - check_liveness_block_3(R, Lbl, {unsafe,0}, St); -check_liveness_block_2(_, _, _, St) -> - {killed,St}. - -check_liveness_block_3({x,_}, 0, _FA, St) -> - {killed,St}; -check_liveness_block_3({y,_}, 0, {F,A}, St) -> - %% If the exception is thrown, the stack may be scanned, - %% thus implicitly using the y register. - case erl_bifs:is_safe(erlang, F, A) of - true -> {killed,St}; - false -> {used,St} - end; -check_liveness_block_3(R, Lbl, _FA, St0) -> - check_liveness_at(R, Lbl, St0). - -index_labels_1([{label,Lbl}|Is0], Acc) -> - Is = drop_labels(Is0), - index_labels_1(Is0, [{Lbl,Is}|Acc]); -index_labels_1([_|Is], Acc) -> - index_labels_1(Is, Acc); -index_labels_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). - -drop_labels([{label,_}|Is]) -> drop_labels(Is); -drop_labels(Is) -> Is. - - replace_labels_1([{test,Test,{f,Lbl},Ops}|Is], Acc, D, Fb) -> replace_labels_1(Is, [{test,Test,{f,label(Lbl, D, Fb)},Ops}|Acc], D, Fb); replace_labels_1([{test,Test,{f,Lbl},Live,Ops,Dst}|Is], Acc, D, Fb) -> @@ -676,8 +144,6 @@ label(Old, D, Fb) -> _ -> Fb(Old) end. -%% live_opt/4. - split_even([], Ss, Ds) -> {reverse(Ss),reverse(Ds)}; split_even([S,D|Rs], Ss, Ds) -> diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 27e6e8fe00..14c8c5b4ab 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -823,6 +823,9 @@ kernel_passes() -> {pass,beam_kernel_to_ssa}, {iff,dssa,{listing,"ssa"}}, {iff,ssalint,{pass,beam_ssa_lint}}, + {unless,no_share_opt,{pass,beam_ssa_share}}, + {iff,dssashare,{listing,"ssashare"}}, + {iff,ssalint,{pass,beam_ssa_lint}}, {unless,no_bsm_opt,{pass,beam_ssa_bsm}}, {iff,dssabsm,{listing,"ssabsm"}}, {iff,ssalint,{pass,beam_ssa_lint}}, @@ -868,7 +871,9 @@ asm_passes() -> %% need to do a few clean-ups to code. {iff,no_postopt,[{pass,beam_clean}]}, + {iff,diffable,?pass(diffable)}, {pass,beam_z}, + {iff,diffable,{listing,"S"}}, {iff,dz,{listing,"z"}}, {iff,dopt,{listing,"optimize"}}, {iff,'S',{listing,"S"}}, @@ -1926,6 +1931,39 @@ restore_expand_module([F|Fs]) -> [F|restore_expand_module(Fs)]; restore_expand_module([]) -> []. +%%% +%%% Transform the BEAM code to make it more friendly for +%%% diffing: using function names instead of labels for +%%% local calls and number labels relative to each function. +%%% + +diffable(Code0, St) -> + {Mod,Exp,Attr,Fs0,NumLabels} = Code0, + EntryLabels0 = [{Entry,{Name,Arity}} || + {function,Name,Arity,Entry,_} <- Fs0], + EntryLabels = maps:from_list(EntryLabels0), + Fs = [diffable_fix_function(F, EntryLabels) || F <- Fs0], + Code = {Mod,Exp,Attr,Fs,NumLabels}, + {ok,Code,St}. + +diffable_fix_function({function,Name,Arity,Entry0,Is0}, LabelMap0) -> + Entry = maps:get(Entry0, LabelMap0), + {Is1,LabelMap} = diffable_label_map(Is0, 1, LabelMap0, []), + Fb = fun(Old) -> error({no_fb,Old}) end, + Is = beam_utils:replace_labels(Is1, [], LabelMap, Fb), + {function,Name,Arity,Entry,Is}. + +diffable_label_map([{label,Old}|Is], New, Map, Acc) -> + case Map of + #{Old:=NewLabel} -> + diffable_label_map(Is, New, Map, [{label,NewLabel}|Acc]); + #{} -> + diffable_label_map(Is, New+1, Map#{Old=>New}, [{label,New}|Acc]) + end; +diffable_label_map([I|Is], New, Map, Acc) -> + diffable_label_map(Is, New, Map, [I|Acc]); +diffable_label_map([], _New, Map, Acc) -> + {Acc,Map}. -spec options() -> 'ok'. @@ -2063,6 +2101,7 @@ pre_load() -> beam_ssa_opt, beam_ssa_pre_codegen, beam_ssa_recv, + beam_ssa_share, beam_ssa_type, beam_trim, beam_utils, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 86259270bd..1472e3fde1 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -45,6 +45,7 @@ beam_ssa_pp, beam_ssa_pre_codegen, beam_ssa_recv, + beam_ssa_share, beam_ssa_type, beam_trim, beam_utils, diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 2b4a780899..da61931136 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -83,6 +83,11 @@ coverage(_) -> (catch bar(x)), {'EXIT',{{case_clause,{1}},[{?MODULE,bar,1,[File,{line,9}]}|_]}} = (catch bar(0)), + + Self = self(), + {'EXIT',{{strange,Self},[{?MODULE,foo,[any],[File,{line,14}]}|_]}} = + (catch foo(any)), + ok. -file("fake.erl", 1). @@ -96,3 +101,6 @@ bar(X) -> %Line 8 case {X+1} of %Line 9 1 -> ok %Line 10 end. %Line 11 +%% Cover collection code for function_clause exceptions. +foo(A) -> %Line 13 + error({strange,self()}, [A]). %Line 14 diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl index c61e4ab65c..759d884dc4 100644 --- a/lib/compiler/test/beam_jump_SUITE.erl +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -21,7 +21,9 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - undefined_label/1,ambiguous_catch_try_state/1]). + undefined_label/1,ambiguous_catch_try_state/1, + unsafe_move_elimination/1,build_tuple/1, + coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -32,7 +34,10 @@ all() -> groups() -> [{p,[parallel], [undefined_label, - ambiguous_catch_try_state + ambiguous_catch_try_state, + unsafe_move_elimination, + build_tuple, + coverage ]}]. init_per_suite(Config) -> @@ -72,3 +77,95 @@ river() -> song. checks(Wanted) -> %% Must be one line to cause the unsafe optimization. {catch case river() of sheet -> begin +Wanted, if "da" -> Wanted end end end, catch case river() of sheet -> begin + Wanted, if "da" -> Wanted end end end}. + +unsafe_move_elimination(_Config) -> + {{left,right,false},false} = unsafe_move_elimination(left, right, false), + {{false,right,false},false} = unsafe_move_elimination(false, right, true), + {{true,right,right},right} = unsafe_move_elimination(true, right, true), + ok. + +unsafe_move_elimination(Left, Right, Simple0) -> + id(1), + + %% The move at label 29 would be removed by beam_jump, which is unsafe because + %% the two select_val instructions have different source registers. + %% + %% {select_val,{y,0},{f,25},{list,[{atom,true},{f,27},{atom,false},{f,29}]}}. + %% ^^^^^ ^^^^^^^^^^^^^^^^^^^ + %% {label,27}. + %% {kill,{y,0}}. + %% {move,{y,2},{x,0}}. + %% {line,...}. + %% {call,1,{f,31}}. + %% {select_val,{x,0},{f,33},{list,[{atom,true},{f,35},{atom,false},{f,29}]}}. + %% ^^^^^ ^^^^^^^^^^^^^^^^^^^ + %% {label,29}. + %% {move,{atom,false},{y,0}}. <=== REMOVED (unsafely). + %% {jump,{f,37}}. + + Simple = case case Simple0 of + false -> false; + true -> id(Left) + end + of + false -> + false; + true -> + id(Right) + end, + {id({Left,Right,Simple}),Simple}. + +-record(message2, {id, p1}). +-record(message3, {id, p1, p2}). + +build_tuple(_Config) -> + {'EXIT',{{badrecord,message3},_}} = (catch do_build_tuple(#message2{})), + ok. + +do_build_tuple(Message) -> + if is_record(Message, message2) -> + Res = {res, rand:uniform(100)}, + {Message#message3.id, Res} + end. + +coverage(_Config) -> + ok = coverage_1(ok), + {error,badarg} = coverage_1({error,badarg}), + + gt = coverage_2(100, 42), + le = coverage_2(100, 999), + le = coverage_2([], []), + gt = coverage_2([], xxx), + + ok. + +coverage_1(Var) -> + case id(Var) of + ok -> ok; + Error -> Error + end. + +%% Cover beam_jump:invert_test(is_ne_exact). +coverage_2(Pre1, Pre2) -> + case + case Pre1 == [] of + false -> + false; + true -> + Pre2 /= [] + end + of + true -> + gt; + false -> + case Pre1 > Pre2 of + true -> + gt; + false -> + le + end + end. + + +id(I) -> + I. diff --git a/lib/compiler/test/beam_ssa_SUITE.erl b/lib/compiler/test/beam_ssa_SUITE.erl index 5536abbdde..e32e3eebfc 100644 --- a/lib/compiler/test/beam_ssa_SUITE.erl +++ b/lib/compiler/test/beam_ssa_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, calls/1,tuple_matching/1,recv/1,maps/1, - cover_ssa_dead/1,combine_sw/1]). + cover_ssa_dead/1,combine_sw/1,share_opt/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -36,7 +36,8 @@ groups() -> recv, maps, cover_ssa_dead, - combine_sw + combine_sw, + share_opt ]}]. init_per_suite(Config) -> @@ -467,5 +468,18 @@ do_comb_sw_2(X) -> end, erase(?MODULE). +share_opt(_Config) -> + ok = do_share_opt(0). + +do_share_opt(A) -> + %% The compiler would be stuck in an infinite loop in beam_ssa_share. + case A of + 0 -> a; + 1 -> b; + 2 -> c + end, + receive after 1 -> ok end. + + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index ac19305d69..ff0f72d519 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -26,7 +26,7 @@ select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, y_registers/1,user_predef/1,scan_f/1,cafu/1, receive_label/1,read_size_file_version/1,not_used/1, - is_used_fr/1]). + is_used_fr/1,unsafe_is_function/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -53,7 +53,8 @@ groups() -> cafu, read_size_file_version, not_used, - is_used_fr + is_used_fr, + unsafe_is_function ]}]. init_per_suite(Config) -> @@ -570,6 +571,24 @@ is_used_fr(X, Y) -> end, X ! 1. +%% ERL-778. +unsafe_is_function(Config) -> + {undefined,any} = unsafe_is_function(undefined, any), + {ok,any} = unsafe_is_function(fun() -> ok end, any), + {'EXIT',{{case_clause,_},_}} = (catch unsafe_is_function(fun(_) -> ok end, any)), + ok. + +unsafe_is_function(F, M) -> + %% There would be an internal consistency failure: + %% Instruction: {bif,is_function,{f,0},[{x,0},{integer,0}],{x,2}} + %% Error: {uninitialized_reg,{y,0}}: + + NewValue = case is_function(F, 0) of + true -> F(); + false when F =:= undefined -> undefined + end, + {NewValue,M}. + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 0c6db96081..01f302ad21 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -742,6 +742,10 @@ coverage(Config) when is_list(Config) -> binary = coverage_bitstring(<<7>>), bitstring = coverage_bitstring(<<7:4>>), other = coverage_bitstring([a]), + + {done,<<17,53>>,[253,155,200]} = + coverage_trim(<<253,155,200,17,53>>, e0, e1, e2, e3, []), + ok. coverage_fold(Fun, Acc, <<H,T/binary>>) -> @@ -836,6 +840,14 @@ coverage_bitstring(Bin) when is_binary(Bin) -> binary; coverage_bitstring(<<_/bitstring>>) -> bitstring; coverage_bitstring(_) -> other. +coverage_trim(<<C:8,T/binary>> = Bin, E0, E1, E2, E3, Acc) -> + case id(C > 128) of + true -> + coverage_trim(T, E0, E1, E2, E3, [C|Acc]); + false -> + {done,Bin,lists:reverse(Acc)} + end. + multiple_uses(Config) when is_list(Config) -> {344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>), true = multiple_uses_2(<<0,0,197,18>>), diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 5656743c76..6eae7b1404 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -396,6 +396,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) -> do_listing(Simple, TargetDir, dclean, ".clean"), do_listing(Simple, TargetDir, dpeep, ".peep"), do_listing(Simple, TargetDir, dopt, ".optimize"), + do_listing(Simple, TargetDir, diffable, ".S"), %% First clean up. Listings = filename:join(PrivDir, listings), @@ -1249,7 +1250,6 @@ do_opt_guards_fun([]) -> []. is_exception(guard_SUITE, {'-complex_not/1-fun-4-',1}) -> true; is_exception(guard_SUITE, {'-complex_not/1-fun-5-',1}) -> true; is_exception(guard_SUITE, {bad_guards,1}) -> true; -is_exception(guard_SUITE, {bad_guards_3,2}) -> true; is_exception(guard_SUITE, {nested_not_2b,4}) -> true; is_exception(_, _) -> false. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 229c3093d7..eed2a31f70 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -483,9 +483,8 @@ sel_same_value2(V) when V =:= 42; V =:= 43 -> sel_same_value2(_) -> error. -%% Test deconstruction of select_val instructions in beam_peep into -%% regular tests with just one possible value left. Hitting proper cases -%% in beam_peep relies on unification of labels by beam_jump. +%% Test deconstruction of select_val instructions to regular tests +%% with zero or one values left. deselectify(Config) when is_list(Config) -> one_or_other = desel_tuple_arity({1}), @@ -506,7 +505,31 @@ deselectify(Config) when is_list(Config) -> one_or_other = dsel_atom_typecheck(one), two = dsel_atom_typecheck(two), - one_or_other = dsel_atom_typecheck(three). + one_or_other = dsel_atom_typecheck(three), + + %% Cover deconstruction of select_val instructions in + %% beam_peep. + + stop = dsel_peek_0(stop), + ignore = dsel_peek_0(ignore), + Config = dsel_peek_0(Config), + + stop = dsel_peek_1(stop, any), + Config = dsel_peek_1(ignore, Config), + other = dsel_peek_1(other, ignored), + + 0 = dsel_peek_2(0, any), + Config = dsel_peek_2(1, Config), + 2 = dsel_peek_2(2, ignored), + + true = dsel_peek_3(true), + false = dsel_peek_3(false), + {error,Config} = dsel_peek_3(Config), + + ok. + +%% The following will be optimized by the sharing optimizations +%% in beam_ssa_opt. desel_tuple_arity(Tuple) when is_tuple(Tuple) -> case Tuple of @@ -543,6 +566,39 @@ dsel_atom_typecheck(Val) when is_atom(Val) -> _ -> one_or_other end. +%% The following functions are carefully crafted so that the sharing +%% optimizations in beam_ssa_opt can't be applied. After applying the +%% beam_jump:eliminate_moves/1 optimization and beam_clean:clean_labels/1 +%% has unified labels, beam_peep is able to optimize these functions. + +dsel_peek_0(A0) -> + case id(A0) of + stop -> stop; + ignore -> ignore; + A -> A + end. + +dsel_peek_1(A0, B) -> + case id(A0) of + stop -> stop; + ignore -> B; + A -> A + end. + +dsel_peek_2(A0, B) -> + case id(A0) of + 0 -> 0; + 1 -> B; + A -> A + end. + +dsel_peek_3(A0) -> + case id(A0) of + true -> true; + false -> false; + Other -> {error,Other} + end. + underscore(Config) when is_list(Config) -> case Config of [] -> diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index c9acda2b6d..2a6303ece8 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -183,6 +183,7 @@ silly_coverage(Config) when is_list(Config) -> %% beam_ssa_lint %% beam_ssa_recv + %% beam_ssa_share %% beam_ssa_pre_codegen %% beam_ssa_opt %% beam_ssa_codegen @@ -190,6 +191,7 @@ silly_coverage(Config) when is_list(Config) -> [{b_function,#{func_info=>{mod,foo,0}},args,bad_blocks,0}]}, expect_error(fun() -> beam_ssa_lint:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_recv:module(BadSSA, []) end), + expect_error(fun() -> beam_ssa_share:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_pre_codegen:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_opt:module(BadSSA, []) end), expect_error(fun() -> beam_ssa_codegen:module(BadSSA, []) end), @@ -234,6 +236,10 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_except:module(ExceptInput, []) end), + %% beam_jump + JumpInput = BlockInput, + expect_error(fun() -> beam_jump:module(JumpInput, []) end), + %% beam_clean CleanInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -243,6 +249,10 @@ silly_coverage(Config) when is_list(Config) -> {jump,{f,42}}]}],99}, expect_error(fun() -> beam_clean:module(CleanInput, []) end), + %% beam_jump + TrimInput = BlockInput, + expect_error(fun() -> beam_trim:module(TrimInput, []) end), + %% beam_peep. This is tricky. Use a select instruction with %% an odd number of elements in the list to crash %% prune_redundant_values/2 but not beam_clean:clean_labels/1. @@ -250,7 +260,7 @@ silly_coverage(Config) when is_list(Config) -> [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2},{select,op,r,{f,2},[{f,2}]}]}], + {label,2},{select,select_val,r,{f,2},[{f,2}]}]}], 2}, expect_error(fun() -> beam_peep:module(PeepInput, []) end), diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index ab707885f4..92f8aec424 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 7.2.6 +COMPILER_VSN = 7.2.7 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b2d8123f00..ecb716c98c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -173,10 +173,13 @@ #endif // (test for >= 1.1.1pre8) -#if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1) - 7) \ +#if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1) -7) \ && !defined(HAS_LIBRESSL) \ && defined(HAVE_EC) # define HAVE_ED_CURVE_DH +# if OPENSSL_VERSION_NUMBER >= (PACKED_OPENSSL_VERSION_PLAIN(1,1,1)) +# define HAVE_EDDSA +# endif #endif #if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'c') @@ -632,10 +635,8 @@ static ErlNifFunc nif_funcs[] = { {"rsa_generate_key_nif", 2, rsa_generate_key_nif}, {"dh_generate_key_nif", 4, dh_generate_key_nif}, {"dh_compute_key_nif", 3, dh_compute_key_nif}, - {"evp_compute_key_nif", 3, evp_compute_key_nif}, {"evp_generate_key_nif", 1, evp_generate_key_nif}, - {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif}, {"srp_value_B_nif", 5, srp_value_B_nif}, {"srp_user_secret_nif", 7, srp_user_secret_nif}, @@ -742,6 +743,12 @@ static ERL_NIF_TERM atom_x25519; static ERL_NIF_TERM atom_x448; #endif +static ERL_NIF_TERM atom_eddsa; +#ifdef HAVE_EDDSA +static ERL_NIF_TERM atom_ed25519; +static ERL_NIF_TERM atom_ed448; +#endif + static ERL_NIF_TERM atom_rsa_mgf1_md; static ERL_NIF_TERM atom_rsa_oaep_label; static ERL_NIF_TERM atom_rsa_oaep_md; @@ -1165,6 +1172,7 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_ppbasis = enif_make_atom(env,"ppbasis"); atom_onbasis = enif_make_atom(env,"onbasis"); #endif + atom_aes_cfb8 = enif_make_atom(env, "aes_cfb8"); atom_aes_cfb128 = enif_make_atom(env, "aes_cfb128"); #ifdef HAVE_GCM @@ -1195,6 +1203,11 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info) atom_x25519 = enif_make_atom(env,"x25519"); atom_x448 = enif_make_atom(env,"x448"); #endif + atom_eddsa = enif_make_atom(env,"eddsa"); +#ifdef HAVE_EDDSA + atom_ed25519 = enif_make_atom(env,"ed25519"); + atom_ed448 = enif_make_atom(env,"ed448"); +#endif atom_rsa_mgf1_md = enif_make_atom(env,"rsa_mgf1_md"); atom_rsa_oaep_label = enif_make_atom(env,"rsa_oaep_label"); atom_rsa_oaep_md = enif_make_atom(env,"rsa_oaep_md"); @@ -1336,13 +1349,13 @@ static void unload(ErlNifEnv* env, void* priv_data) static int algo_hash_cnt, algo_hash_fips_cnt; static ERL_NIF_TERM algo_hash[12]; /* increase when extending the list */ static int algo_pubkey_cnt, algo_pubkey_fips_cnt; -static ERL_NIF_TERM algo_pubkey[11]; /* increase when extending the list */ +static ERL_NIF_TERM algo_pubkey[12]; /* increase when extending the list */ static int algo_cipher_cnt, algo_cipher_fips_cnt; static ERL_NIF_TERM algo_cipher[25]; /* increase when extending the list */ static int algo_mac_cnt, algo_mac_fips_cnt; static ERL_NIF_TERM algo_mac[3]; /* increase when extending the list */ static int algo_curve_cnt, algo_curve_fips_cnt; -static ERL_NIF_TERM algo_curve[87]; /* increase when extending the list */ +static ERL_NIF_TERM algo_curve[89]; /* increase when extending the list */ static int algo_rsa_opts_cnt, algo_rsa_opts_fips_cnt; static ERL_NIF_TERM algo_rsa_opts[11]; /* increase when extending the list */ @@ -1394,6 +1407,10 @@ static void init_algorithms_types(ErlNifEnv* env) #endif // Non-validated algorithms follow algo_pubkey_fips_cnt = algo_pubkey_cnt; + // Don't know if Edward curves are fips validated +#if defined(HAVE_EDDSA) + algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "eddsa"); +#endif algo_pubkey[algo_pubkey_cnt++] = enif_make_atom(env, "srp"); // Validated algorithms first @@ -1554,6 +1571,10 @@ static void init_algorithms_types(ErlNifEnv* env) #endif #endif //-- +#ifdef HAVE_EDDSA + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"ed25519"); + algo_curve[algo_curve_cnt++] = enif_make_atom(env,"ed448"); +#endif #ifdef HAVE_ED_CURVE_DH algo_curve[algo_curve_cnt++] = enif_make_atom(env,"x25519"); algo_curve[algo_curve_cnt++] = enif_make_atom(env,"x448"); @@ -3215,6 +3236,36 @@ static int get_rsa_public_key(ErlNifEnv* env, ERL_NIF_TERM key, RSA *rsa) return 1; } +#ifdef HAVE_EDDSA + static int get_eddsa_key(ErlNifEnv* env, int public, ERL_NIF_TERM key, EVP_PKEY **pkey) +{ + /* key=[K] */ + ERL_NIF_TERM head, tail, tail2, algo; + ErlNifBinary bin; + int type; + + if (!enif_get_list_cell(env, key, &head, &tail) + || !enif_inspect_binary(env, head, &bin) + || !enif_get_list_cell(env, tail, &algo, &tail2) + || !enif_is_empty_list(env, tail2)) { + return 0; + } + if (algo == atom_ed25519) type = EVP_PKEY_ED25519; + else if (algo == atom_ed448) type = EVP_PKEY_ED448; + else + return 0; + + if (public) + *pkey = EVP_PKEY_new_raw_public_key(type, NULL, bin.data, bin.size); + else + *pkey = EVP_PKEY_new_raw_private_key(type, NULL, bin.data, bin.size); + + if (!pkey) + return 0; + return 1; +} +#endif + static int get_dss_private_key(ErlNifEnv* env, ERL_NIF_TERM key, DSA *dsa) { /* key=[P,Q,G,KEY] */ @@ -4296,7 +4347,9 @@ static int get_pkey_digest_type(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ *md = NULL; if (type == atom_none && algorithm == atom_rsa) return PKEY_OK; - +#ifdef HAVE_EDDSA + if (algorithm == atom_eddsa) return PKEY_OK; +#endif digp = get_digest_type(type); if (!digp) return PKEY_BADARG; if (!digp->md.p) return PKEY_NOTSUP; @@ -4546,6 +4599,14 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_ #else return PKEY_NOTSUP; #endif + } else if (algorithm == atom_eddsa) { +#if defined(HAVE_EDDSA) + if (!get_eddsa_key(env, 0, key, pkey)) { + return PKEY_BADARG; + } +#else + return PKEY_NOTSUP; +#endif } else if (algorithm == atom_dss) { DSA *dsa = DSA_new(); @@ -4624,6 +4685,14 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T #else return PKEY_NOTSUP; #endif + } else if (algorithm == atom_eddsa) { +#if defined(HAVE_EDDSA) + if (!get_eddsa_key(env, 1, key, pkey)) { + return PKEY_BADARG; + } +#else + return PKEY_NOTSUP; +#endif } else if (algorithm == atom_dss) { DSA *dsa = DSA_new(); @@ -4697,8 +4766,10 @@ printf("\r\n"); ctx = EVP_PKEY_CTX_new(pkey, NULL); if (!ctx) goto badarg; - if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg; - if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + if (argv[0] != atom_eddsa) { + if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg; + if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + } if (argv[0] == atom_rsa) { if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg; @@ -4720,14 +4791,39 @@ printf("\r\n"); #endif } - if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg; - enif_alloc_binary(siglen, &sig_bin); + if (argv[0] == atom_eddsa) { +#ifdef HAVE_EDDSA + EVP_MD_CTX* mdctx = EVP_MD_CTX_new(); + if (!EVP_DigestSignInit(mdctx, NULL, NULL, NULL, pkey)) { + if (mdctx) EVP_MD_CTX_free(mdctx); + goto badarg; + } - if (md != NULL) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); + if (!EVP_DigestSign(mdctx, NULL, &siglen, tbs, tbslen)) { + EVP_MD_CTX_free(mdctx); + goto badarg; + } + enif_alloc_binary(siglen, &sig_bin); + + if (!EVP_DigestSign(mdctx, sig_bin.data, &siglen, tbs, tbslen)) { + EVP_MD_CTX_free(mdctx); + goto badarg; + } +#else + goto badarg; +#endif } - i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen); + else + { + if (EVP_PKEY_sign(ctx, NULL, &siglen, tbs, tbslen) <= 0) goto badarg; + enif_alloc_binary(siglen, &sig_bin); + if (md != NULL) { + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); + } + i = EVP_PKEY_sign(ctx, sig_bin.data, &siglen, tbs, tbslen); + } + EVP_PKEY_CTX_free(ctx); #else /*printf("Old interface\r\n"); @@ -4835,8 +4931,11 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM */ ctx = EVP_PKEY_CTX_new(pkey, NULL); if (!ctx) goto badarg; - if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg; - if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + + if (argv[0] != atom_eddsa) { + if (EVP_PKEY_verify_init(ctx) <= 0) goto badarg; + if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg; + } if (argv[0] == atom_rsa) { if (EVP_PKEY_CTX_set_rsa_padding(ctx, sig_opt.rsa_padding) <= 0) goto badarg; @@ -4856,10 +4955,28 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM } } - if (md != NULL) { - ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); - } - i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen); + if (argv[0] == atom_eddsa) { +#ifdef HAVE_EDDSA + EVP_MD_CTX* mdctx = EVP_MD_CTX_create(); + + if (!EVP_DigestVerifyInit(mdctx, NULL, NULL, NULL, pkey)) { + if (mdctx) EVP_MD_CTX_destroy(mdctx); + goto badarg; + } + + i = EVP_DigestVerify(mdctx, sig_bin.data, sig_bin.size, tbs, tbslen); + EVP_MD_CTX_destroy(mdctx); +#else + goto badarg; +#endif + } + else + { + if (md != NULL) { + ERL_VALGRIND_ASSERT_MEM_DEFINED(tbs, EVP_MD_size(md)); + } + i = EVP_PKEY_verify(ctx, sig_bin.data, sig_bin.size, tbs, tbslen); + } EVP_PKEY_CTX_free(ctx); #else diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 23d2bed057..0cc7dd609d 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -179,6 +179,10 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks) /* This is not really a NIF library, but we use ERL_NIF_INIT in order to * get access to the erl_nif API (on Windows). */ -ERL_NIF_INIT(dummy, (ErlNifFunc*)NULL , NULL, NULL, NULL, NULL) +static struct { + int dummy__; + ErlNifFunc funcv[0]; +} empty; +ERL_NIF_INIT(dummy, empty.funcv, NULL, NULL, NULL, NULL) #endif diff --git a/lib/crypto/doc/src/algorithm_details.xml b/lib/crypto/doc/src/algorithm_details.xml index 4d58d26970..854bfbb4b1 100644 --- a/lib/crypto/doc/src/algorithm_details.xml +++ b/lib/crypto/doc/src/algorithm_details.xml @@ -303,6 +303,20 @@ </section> <section> + <title>EdDSA</title> + <p>EdDSA is available with OpenSSL 1.1.1 or later if not disabled by configuration. + To dynamically check availability, check that the atom <c>eddsa</c> is present in the + list with the <c>public_keys</c> tag in the return value of + <seealso marker="crypto#supports-0">crypto:supports()</seealso>. + </p> + <p>Support for the curves ed25519 and ed448 is implemented. + The actual supported named curves could be checked by examining the list with the + <c>curves</c> tag in the return value of + <seealso marker="crypto#supports-0">crypto:supports()</seealso>. + </p> + </section> + + <section> <title>Diffie-Hellman</title> <p>Diffie-Hellman computations are available with OpenSSL versions compatible with Erlang CRYPTO if not disabled by configuration. diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index b8ec41bea8..96fda34860 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -267,7 +267,8 @@ <datatype_title>Elliptic Curves</datatype_title> <datatype> <name name="ec_named_curve"/> - <name name="edwards_curve"/> + <name name="edwards_curve_dh"/> + <name name="edwards_curve_ed"/> <desc> <p>Note that some curves are disabled if FIPS is enabled.</p> </desc> @@ -347,6 +348,14 @@ </datatype> <datatype> + <name name="eddsa_public"/> + <name name="eddsa_private"/> + <name name="eddsa_params"/> + <desc> + </desc> + </datatype> + + <datatype> <name name="srp_public"/> <name name="srp_private"/> <desc> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 68c0bcef5e..feb02d0f5a 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -121,7 +121,11 @@ -type ecdsa_public() :: key_integer() . -type ecdsa_private() :: key_integer() . --type ecdsa_params() :: ec_named_curve() | edwards_curve() | ec_explicit_curve() . +-type ecdsa_params() :: ec_named_curve() | ec_explicit_curve() . + +-type eddsa_public() :: key_integer() . +-type eddsa_private() :: key_integer() . +-type eddsa_params() :: edwards_curve_ed() . -type srp_public() :: key_integer() . -type srp_private() :: key_integer() . @@ -138,7 +142,7 @@ -type ecdh_public() :: key_integer() . -type ecdh_private() :: key_integer() . --type ecdh_params() :: ec_named_curve() | edwards_curve() | ec_explicit_curve() . +-type ecdh_params() :: ec_named_curve() | edwards_curve_dh() | ec_explicit_curve() . %%% Curves @@ -250,8 +254,9 @@ | wtls9 . --type edwards_curve() :: x25519 - | x448 . +-type edwards_curve_dh() :: x25519 | x448 . + +-type edwards_curve_ed() :: ed25519 | ed448 . %%% -type block_cipher_with_iv() :: cbc_cipher() @@ -331,7 +336,7 @@ stop() -> ], PKs :: [rsa | dss | ecdsa | dh | ecdh | ec_gf2m], Macs :: [hmac | cmac | poly1305], - Curves :: [ec_named_curve() | edwards_curve()], + Curves :: [ec_named_curve() | edwards_curve_dh() | edwards_curve_ed()], RSAopts :: [rsa_sign_verify_opt() | rsa_opt()] . supports()-> {Hashs, PubKeys, Ciphers, Macs, Curves, RsaOpts} = algorithms(), @@ -904,7 +909,7 @@ rand_seed_nif(_Seed) -> ?nif_stub. %%% Sign/verify %%% %%%================================================================ --type pk_sign_verify_algs() :: rsa | dss | ecdsa . +-type pk_sign_verify_algs() :: rsa | dss | ecdsa | eddsa . -type pk_sign_verify_opts() :: [ rsa_sign_verify_opt() ] . @@ -928,7 +933,8 @@ rand_seed_nif(_Seed) -> ?nif_stub. Msg :: binary() | {digest,binary()}, Key :: rsa_private() | dss_private() - | [ecdsa_private()|ecdsa_params()] + | [ecdsa_private() | ecdsa_params()] + | [eddsa_private() | eddsa_params()] | engine_key_ref(), Signature :: binary() . @@ -947,6 +953,7 @@ sign(Algorithm, Type, Data, Key) -> Key :: rsa_private() | dss_private() | [ecdsa_private() | ecdsa_params()] + | [eddsa_private() | eddsa_params()] | engine_key_ref(), Options :: pk_sign_verify_opts(), Signature :: binary() . @@ -969,12 +976,14 @@ pkey_sign_nif(_Algorithm, _Type, _Digest, _Key, _Options) -> ?nif_stub. when Algorithm :: pk_sign_verify_algs(), DigestType :: rsa_digest_type() | dss_digest_type() - | ecdsa_digest_type(), + | ecdsa_digest_type() + | none, Msg :: binary() | {digest,binary()}, Signature :: binary(), - Key :: rsa_private() - | dss_private() - | [ecdsa_private() | ecdsa_params()] + Key :: rsa_public() + | dss_public() + | [ecdsa_public() | ecdsa_params()] + | [eddsa_public() | eddsa_params()] | engine_key_ref(), Result :: boolean(). @@ -992,6 +1001,7 @@ verify(Algorithm, Type, Data, Signature, Key) -> Key :: rsa_public() | dss_public() | [ecdsa_public() | ecdsa_params()] + | [eddsa_public() | eddsa_params()] | engine_key_ref(), Options :: pk_sign_verify_opts(), Result :: boolean(). @@ -1889,7 +1899,9 @@ ec_key_generate(_Curve, _Key) -> ?nif_stub. ecdh_compute_key_nif(_Others, _Curve, _My) -> ?nif_stub. --spec ec_curves() -> [EllipticCurve] when EllipticCurve :: ec_named_curve() | edwards_curve() . +-spec ec_curves() -> [EllipticCurve] when EllipticCurve :: ec_named_curve() + | edwards_curve_dh() + | edwards_curve_ed() . ec_curves() -> crypto_ec_curves:curves(). @@ -2153,7 +2165,7 @@ check_otp_test_engine(LibDir) -> case filelib:wildcard("otp_test_engine*", LibDir) of [] -> {error, notexist}; - [LibName] -> + [LibName|_] -> % In case of Valgrind there could be more than one LibPath = filename:join(LibDir,LibName), case filelib:is_file(LibPath) of true -> diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 0b878f2e5c..8e20304dc9 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1,4 +1,4 @@ -%% +% %% %CopyrightBegin% %% %% Copyright Ericsson AB 1999-2018. All Rights Reserved. @@ -58,6 +58,8 @@ groups() -> {group, rsa}, {group, dss}, {group, ecdsa}, + {group, ed25519}, + {group, ed448}, {group, dh}, {group, ecdh}, {group, srp}, @@ -145,6 +147,12 @@ groups() -> {ecdsa, [], [sign_verify %% Does not work yet: ,public_encrypt, private_encrypt ]}, + {ed25519, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, + {ed448, [], [sign_verify + %% Does not work yet: ,public_encrypt, private_encrypt + ]}, {dh, [], [generate_compute, compute_bug]}, {ecdh, [], [generate_all_supported, compute, generate]}, @@ -572,7 +580,8 @@ generate_all_supported(_Config) -> ct:log("ERROR: Curve ~p exception ~p:~p~n~p", [C,Cls,Err,Stack]), {error,{C,{Cls,Err}}} end - || C <- crypto:ec_curves() + || C <- crypto:ec_curves(), + not lists:member(C, [ed25519, ed448]) ], OK = [C || {ok,C} <- Results], ct:log("Ok (len=~p): ~p", [length(OK), OK]), @@ -884,6 +893,29 @@ aead_cipher({Type, Key, PlainText, IV, AAD, CipherText, CipherTag, TagLen, Info} {got, Other1}}) end. +do_sign_verify({Type, undefined=Hash, Private, Public, Msg, Signature}) -> + case crypto:sign(eddsa, Hash, Msg, [Private,Type]) of + Signature -> + ct:log("OK crypto:sign(eddsa, ~p, Msg, [Private,~p])", [Hash,Type]), + case crypto:verify(eddsa, Hash, Msg, Signature, [Public,Type]) of + true -> + ct:log("OK crypto:verify(eddsa, ~p, Msg, Signature, [Public,~p])", [Hash,Type]), + negative_verify(eddsa, Hash, Msg, <<10,20>>, [Public,Type]); + false -> + ct:log("ERROR crypto:verify(eddsa, ~p, Msg= ~p, Signature= ~p, [Public= ~p,~p])", + [Hash,Msg,Signature,Public,Type]), + ct:fail({{crypto, verify, [eddsa, Hash, Msg, Signature, [Public,Type]]}}) + end; + ErrorSig -> + ct:log("ERROR crypto:sign(~p, ~p, ..., [Private= ~p,~p])", [eddsa,Hash,Private,Type]), + ct:log("ERROR crypto:verify(eddsa, ~p, Msg= ~p, [Public= ~p,~p])~n" + "ErrorSig = ~p~n" + "CorrectSig = ~p~n" + , + [Hash,Msg,Public,Type,ErrorSig,Signature]), + ct:fail({{crypto, sign, [Type, Hash, Msg, ErrorSig, [Private]]}}) + end; + do_sign_verify({Type, Hash, Public, Private, Msg}) -> Signature = crypto:sign(Type, Hash, Msg, Private), case crypto:verify(Type, Hash, Msg, Signature, Public) of @@ -1443,6 +1475,12 @@ group_config(ecdsa = Type, Config) -> MsgPubEnc = <<"7896345786348 Asldi">>, PubPrivEnc = [{ecdsa, Public, Private, MsgPubEnc, []}], [{sign_verify, SignVerify}, {pub_priv_encrypt, PubPrivEnc} | Config]; + +group_config(Type, Config) when Type == ed25519 ; Type == ed448 -> + TestVectors = eddsa(Type), + [{sign_verify,TestVectors} | Config]; + + group_config(srp, Config) -> GenerateCompute = [srp3(), srp6(), srp6a(), srp6a_smaller_prime()], [{generate_compute, GenerateCompute} | Config]; @@ -2702,6 +2740,392 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv ServerPublic, ServerPrivate, {host, [Verifier, Generator, Prime, Version]}, {host, [Verifier, Prime, Version, Scrambler]}, SessionKey}. + +eddsa(ed25519) -> + %% https://tools.ietf.org/html/rfc8032#section-7.1 + %% {ALGORITHM, (SHA)}, SECRET KEY, PUBLIC KEY, MESSAGE, SIGNATURE} + [ + %% TEST 1 + {ed25519, undefined, + hexstr2bin("9d61b19deffd5a60ba844af492ec2cc4" + "4449c5697b326919703bac031cae7f60"), + hexstr2bin("d75a980182b10ab7d54bfed3c964073a" + "0ee172f3daa62325af021a68f707511a"), + hexstr2bin(""), + hexstr2bin("e5564300c360ac729086e2cc806e828a" + "84877f1eb8e5d974d873e06522490155" + "5fb8821590a33bacc61e39701cf9b46b" + "d25bf5f0595bbe24655141438e7a100b")}, + %% TEST 2 + {ed25519, undefined, + hexstr2bin("4ccd089b28ff96da9db6c346ec114e0f" + "5b8a319f35aba624da8cf6ed4fb8a6fb"), + hexstr2bin("3d4017c3e843895a92b70aa74d1b7ebc" + "9c982ccf2ec4968cc0cd55f12af4660c"), + hexstr2bin("72"), + hexstr2bin("92a009a9f0d4cab8720e820b5f642540" + "a2b27b5416503f8fb3762223ebdb69da" + "085ac1e43e15996e458f3613d0f11d8c" + "387b2eaeb4302aeeb00d291612bb0c00")}, + %% TEST 3 + {ed25519, undefined, + hexstr2bin("c5aa8df43f9f837bedb7442f31dcb7b1" + "66d38535076f094b85ce3a2e0b4458f7"), + hexstr2bin("fc51cd8e6218a1a38da47ed00230f058" + "0816ed13ba3303ac5deb911548908025"), + hexstr2bin("af82"), + hexstr2bin("6291d657deec24024827e69c3abe01a3" + "0ce548a284743a445e3680d7db5ac3ac" + "18ff9b538d16f290ae67f760984dc659" + "4a7c15e9716ed28dc027beceea1ec40a")}, + %% TEST 1024 + {ed25519, undefined, + hexstr2bin("f5e5767cf153319517630f226876b86c" + "8160cc583bc013744c6bf255f5cc0ee5"), + hexstr2bin("278117fc144c72340f67d0f2316e8386" + "ceffbf2b2428c9c51fef7c597f1d426e"), + hexstr2bin("08b8b2b733424243760fe426a4b54908" + "632110a66c2f6591eabd3345e3e4eb98" + "fa6e264bf09efe12ee50f8f54e9f77b1" + "e355f6c50544e23fb1433ddf73be84d8" + "79de7c0046dc4996d9e773f4bc9efe57" + "38829adb26c81b37c93a1b270b20329d" + "658675fc6ea534e0810a4432826bf58c" + "941efb65d57a338bbd2e26640f89ffbc" + "1a858efcb8550ee3a5e1998bd177e93a" + "7363c344fe6b199ee5d02e82d522c4fe" + "ba15452f80288a821a579116ec6dad2b" + "3b310da903401aa62100ab5d1a36553e" + "06203b33890cc9b832f79ef80560ccb9" + "a39ce767967ed628c6ad573cb116dbef" + "efd75499da96bd68a8a97b928a8bbc10" + "3b6621fcde2beca1231d206be6cd9ec7" + "aff6f6c94fcd7204ed3455c68c83f4a4" + "1da4af2b74ef5c53f1d8ac70bdcb7ed1" + "85ce81bd84359d44254d95629e9855a9" + "4a7c1958d1f8ada5d0532ed8a5aa3fb2" + "d17ba70eb6248e594e1a2297acbbb39d" + "502f1a8c6eb6f1ce22b3de1a1f40cc24" + "554119a831a9aad6079cad88425de6bd" + "e1a9187ebb6092cf67bf2b13fd65f270" + "88d78b7e883c8759d2c4f5c65adb7553" + "878ad575f9fad878e80a0c9ba63bcbcc" + "2732e69485bbc9c90bfbd62481d9089b" + "eccf80cfe2df16a2cf65bd92dd597b07" + "07e0917af48bbb75fed413d238f5555a" + "7a569d80c3414a8d0859dc65a46128ba" + "b27af87a71314f318c782b23ebfe808b" + "82b0ce26401d2e22f04d83d1255dc51a" + "ddd3b75a2b1ae0784504df543af8969b" + "e3ea7082ff7fc9888c144da2af58429e" + "c96031dbcad3dad9af0dcbaaaf268cb8" + "fcffead94f3c7ca495e056a9b47acdb7" + "51fb73e666c6c655ade8297297d07ad1" + "ba5e43f1bca32301651339e22904cc8c" + "42f58c30c04aafdb038dda0847dd988d" + "cda6f3bfd15c4b4c4525004aa06eeff8" + "ca61783aacec57fb3d1f92b0fe2fd1a8" + "5f6724517b65e614ad6808d6f6ee34df" + "f7310fdc82aebfd904b01e1dc54b2927" + "094b2db68d6f903b68401adebf5a7e08" + "d78ff4ef5d63653a65040cf9bfd4aca7" + "984a74d37145986780fc0b16ac451649" + "de6188a7dbdf191f64b5fc5e2ab47b57" + "f7f7276cd419c17a3ca8e1b939ae49e4" + "88acba6b965610b5480109c8b17b80e1" + "b7b750dfc7598d5d5011fd2dcc5600a3" + "2ef5b52a1ecc820e308aa342721aac09" + "43bf6686b64b2579376504ccc493d97e" + "6aed3fb0f9cd71a43dd497f01f17c0e2" + "cb3797aa2a2f256656168e6c496afc5f" + "b93246f6b1116398a346f1a641f3b041" + "e989f7914f90cc2c7fff357876e506b5" + "0d334ba77c225bc307ba537152f3f161" + "0e4eafe595f6d9d90d11faa933a15ef1" + "369546868a7f3a45a96768d40fd9d034" + "12c091c6315cf4fde7cb68606937380d" + "b2eaaa707b4c4185c32eddcdd306705e" + "4dc1ffc872eeee475a64dfac86aba41c" + "0618983f8741c5ef68d3a101e8a3b8ca" + "c60c905c15fc910840b94c00a0b9d0"), + hexstr2bin("0aab4c900501b3e24d7cdf4663326a3a" + "87df5e4843b2cbdb67cbf6e460fec350" + "aa5371b1508f9f4528ecea23c436d94b" + "5e8fcd4f681e30a6ac00a9704a188a03")}, + %% TEST SHA(abc) + {ed25519, undefined, + hexstr2bin("833fe62409237b9d62ec77587520911e" + "9a759cec1d19755b7da901b96dca3d42"), + hexstr2bin("ec172b93ad5e563bf4932c70e1245034" + "c35467ef2efd4d64ebf819683467e2bf"), + hexstr2bin("ddaf35a193617abacc417349ae204131" + "12e6fa4e89a97ea20a9eeee64b55d39a" + "2192992a274fc1a836ba3c23a3feebbd" + "454d4423643ce80e2a9ac94fa54ca49f"), + hexstr2bin("dc2a4459e7369633a52b1bf277839a00" + "201009a3efbf3ecb69bea2186c26b589" + "09351fc9ac90b3ecfdfbc7c66431e030" + "3dca179c138ac17ad9bef1177331a704")} + ]; + +eddsa(ed448) -> + %% https://tools.ietf.org/html/rfc8032#section-7.4 + [{ed448, undefined, + hexstr2bin("6c82a562cb808d10d632be89c8513ebf" + "6c929f34ddfa8c9f63c9960ef6e348a3" + "528c8a3fcc2f044e39a3fc5b94492f8f" + "032e7549a20098f95b"), + hexstr2bin("5fd7449b59b461fd2ce787ec616ad46a" + "1da1342485a70e1f8a0ea75d80e96778" + "edf124769b46c7061bd6783df1e50f6c" + "d1fa1abeafe8256180"), + hexstr2bin(""), + hexstr2bin("533a37f6bbe457251f023c0d88f976ae" + "2dfb504a843e34d2074fd823d41a591f" + "2b233f034f628281f2fd7a22ddd47d78" + "28c59bd0a21bfd3980ff0d2028d4b18a" + "9df63e006c5d1c2d345b925d8dc00b41" + "04852db99ac5c7cdda8530a113a0f4db" + "b61149f05a7363268c71d95808ff2e65" + "2600")}, + %% 1 octet + {ed448, undefined, + hexstr2bin("c4eab05d357007c632f3dbb48489924d" + "552b08fe0c353a0d4a1f00acda2c463a" + "fbea67c5e8d2877c5e3bc397a659949e" + "f8021e954e0a12274e"), + hexstr2bin("43ba28f430cdff456ae531545f7ecd0a" + "c834a55d9358c0372bfa0c6c6798c086" + "6aea01eb00742802b8438ea4cb82169c" + "235160627b4c3a9480"), + hexstr2bin("03"), + hexstr2bin("26b8f91727bd62897af15e41eb43c377" + "efb9c610d48f2335cb0bd0087810f435" + "2541b143c4b981b7e18f62de8ccdf633" + "fc1bf037ab7cd779805e0dbcc0aae1cb" + "cee1afb2e027df36bc04dcecbf154336" + "c19f0af7e0a6472905e799f1953d2a0f" + "f3348ab21aa4adafd1d234441cf807c0" + "3a00")}, + + %% %% 1 octet (with context) + %% {ed448, undefined, + %% hexstr2bin("c4eab05d357007c632f3dbb48489924d" + %% "552b08fe0c353a0d4a1f00acda2c463a" + %% "fbea67c5e8d2877c5e3bc397a659949e" + %% "f8021e954e0a12274e"), + %% hexstr2bin("43ba28f430cdff456ae531545f7ecd0a" + %% "c834a55d9358c0372bfa0c6c6798c086" + %% "6aea01eb00742802b8438ea4cb82169c" + %% "235160627b4c3a9480"), + %% hexstr2bin("03"), + %% hexstr2bin("666f6f"), % Context + %% hexstr2bin("d4f8f6131770dd46f40867d6fd5d5055" + %% "de43541f8c5e35abbcd001b32a89f7d2" + %% "151f7647f11d8ca2ae279fb842d60721" + %% "7fce6e042f6815ea000c85741de5c8da" + %% "1144a6a1aba7f96de42505d7a7298524" + %% "fda538fccbbb754f578c1cad10d54d0d" + %% "5428407e85dcbc98a49155c13764e66c" + %% "3c00")}, + + %% 11 octets + {ed448, undefined, + hexstr2bin("cd23d24f714274e744343237b93290f5" + "11f6425f98e64459ff203e8985083ffd" + "f60500553abc0e05cd02184bdb89c4cc" + "d67e187951267eb328"), + hexstr2bin("dcea9e78f35a1bf3499a831b10b86c90" + "aac01cd84b67a0109b55a36e9328b1e3" + "65fce161d71ce7131a543ea4cb5f7e9f" + "1d8b00696447001400"), + hexstr2bin("0c3e544074ec63b0265e0c"), + hexstr2bin("1f0a8888ce25e8d458a21130879b840a" + "9089d999aaba039eaf3e3afa090a09d3" + "89dba82c4ff2ae8ac5cdfb7c55e94d5d" + "961a29fe0109941e00b8dbdeea6d3b05" + "1068df7254c0cdc129cbe62db2dc957d" + "bb47b51fd3f213fb8698f064774250a5" + "028961c9bf8ffd973fe5d5c206492b14" + "0e00")}, + %% 12 octets + {ed448, undefined, + hexstr2bin("258cdd4ada32ed9c9ff54e63756ae582" + "fb8fab2ac721f2c8e676a72768513d93" + "9f63dddb55609133f29adf86ec9929dc" + "cb52c1c5fd2ff7e21b"), + hexstr2bin("3ba16da0c6f2cc1f30187740756f5e79" + "8d6bc5fc015d7c63cc9510ee3fd44adc" + "24d8e968b6e46e6f94d19b945361726b" + "d75e149ef09817f580"), + hexstr2bin("64a65f3cdedcdd66811e2915"), + hexstr2bin("7eeeab7c4e50fb799b418ee5e3197ff6" + "bf15d43a14c34389b59dd1a7b1b85b4a" + "e90438aca634bea45e3a2695f1270f07" + "fdcdf7c62b8efeaf00b45c2c96ba457e" + "b1a8bf075a3db28e5c24f6b923ed4ad7" + "47c3c9e03c7079efb87cb110d3a99861" + "e72003cbae6d6b8b827e4e6c143064ff" + "3c00")}, + %% 13 octets + {ed448, undefined, + hexstr2bin("7ef4e84544236752fbb56b8f31a23a10" + "e42814f5f55ca037cdcc11c64c9a3b29" + "49c1bb60700314611732a6c2fea98eeb" + "c0266a11a93970100e"), + hexstr2bin("b3da079b0aa493a5772029f0467baebe" + "e5a8112d9d3a22532361da294f7bb381" + "5c5dc59e176b4d9f381ca0938e13c6c0" + "7b174be65dfa578e80"), + hexstr2bin("64a65f3cdedcdd66811e2915e7"), + hexstr2bin("6a12066f55331b6c22acd5d5bfc5d712" + "28fbda80ae8dec26bdd306743c5027cb" + "4890810c162c027468675ecf645a8317" + "6c0d7323a2ccde2d80efe5a1268e8aca" + "1d6fbc194d3f77c44986eb4ab4177919" + "ad8bec33eb47bbb5fc6e28196fd1caf5" + "6b4e7e0ba5519234d047155ac727a105" + "3100")}, + %% 64 octets + {ed448, undefined, + hexstr2bin("d65df341ad13e008567688baedda8e9d" + "cdc17dc024974ea5b4227b6530e339bf" + "f21f99e68ca6968f3cca6dfe0fb9f4fa" + "b4fa135d5542ea3f01"), + hexstr2bin("df9705f58edbab802c7f8363cfe5560a" + "b1c6132c20a9f1dd163483a26f8ac53a" + "39d6808bf4a1dfbd261b099bb03b3fb5" + "0906cb28bd8a081f00"), + hexstr2bin("bd0f6a3747cd561bdddf4640a332461a" + "4a30a12a434cd0bf40d766d9c6d458e5" + "512204a30c17d1f50b5079631f64eb31" + "12182da3005835461113718d1a5ef944"), + hexstr2bin("554bc2480860b49eab8532d2a533b7d5" + "78ef473eeb58c98bb2d0e1ce488a98b1" + "8dfde9b9b90775e67f47d4a1c3482058" + "efc9f40d2ca033a0801b63d45b3b722e" + "f552bad3b4ccb667da350192b61c508c" + "f7b6b5adadc2c8d9a446ef003fb05cba" + "5f30e88e36ec2703b349ca229c267083" + "3900")}, + %% 256 octets + {ed448, undefined, + hexstr2bin("2ec5fe3c17045abdb136a5e6a913e32a" + "b75ae68b53d2fc149b77e504132d3756" + "9b7e766ba74a19bd6162343a21c8590a" + "a9cebca9014c636df5"), + hexstr2bin("79756f014dcfe2079f5dd9e718be4171" + "e2ef2486a08f25186f6bff43a9936b9b" + "fe12402b08ae65798a3d81e22e9ec80e" + "7690862ef3d4ed3a00"), + hexstr2bin("15777532b0bdd0d1389f636c5f6b9ba7" + "34c90af572877e2d272dd078aa1e567c" + "fa80e12928bb542330e8409f31745041" + "07ecd5efac61ae7504dabe2a602ede89" + "e5cca6257a7c77e27a702b3ae39fc769" + "fc54f2395ae6a1178cab4738e543072f" + "c1c177fe71e92e25bf03e4ecb72f47b6" + "4d0465aaea4c7fad372536c8ba516a60" + "39c3c2a39f0e4d832be432dfa9a706a6" + "e5c7e19f397964ca4258002f7c0541b5" + "90316dbc5622b6b2a6fe7a4abffd9610" + "5eca76ea7b98816af0748c10df048ce0" + "12d901015a51f189f3888145c03650aa" + "23ce894c3bd889e030d565071c59f409" + "a9981b51878fd6fc110624dcbcde0bf7" + "a69ccce38fabdf86f3bef6044819de11"), + hexstr2bin("c650ddbb0601c19ca11439e1640dd931" + "f43c518ea5bea70d3dcde5f4191fe53f" + "00cf966546b72bcc7d58be2b9badef28" + "743954e3a44a23f880e8d4f1cfce2d7a" + "61452d26da05896f0a50da66a239a8a1" + "88b6d825b3305ad77b73fbac0836ecc6" + "0987fd08527c1a8e80d5823e65cafe2a" + "3d00")}, + %% 1023 octets + {ed448, undefined, + hexstr2bin("872d093780f5d3730df7c212664b37b8" + "a0f24f56810daa8382cd4fa3f77634ec" + "44dc54f1c2ed9bea86fafb7632d8be19" + "9ea165f5ad55dd9ce8"), + hexstr2bin("a81b2e8a70a5ac94ffdbcc9badfc3feb" + "0801f258578bb114ad44ece1ec0e799d" + "a08effb81c5d685c0c56f64eecaef8cd" + "f11cc38737838cf400"), + hexstr2bin("6ddf802e1aae4986935f7f981ba3f035" + "1d6273c0a0c22c9c0e8339168e675412" + "a3debfaf435ed651558007db4384b650" + "fcc07e3b586a27a4f7a00ac8a6fec2cd" + "86ae4bf1570c41e6a40c931db27b2faa" + "15a8cedd52cff7362c4e6e23daec0fbc" + "3a79b6806e316efcc7b68119bf46bc76" + "a26067a53f296dafdbdc11c77f7777e9" + "72660cf4b6a9b369a6665f02e0cc9b6e" + "dfad136b4fabe723d2813db3136cfde9" + "b6d044322fee2947952e031b73ab5c60" + "3349b307bdc27bc6cb8b8bbd7bd32321" + "9b8033a581b59eadebb09b3c4f3d2277" + "d4f0343624acc817804728b25ab79717" + "2b4c5c21a22f9c7839d64300232eb66e" + "53f31c723fa37fe387c7d3e50bdf9813" + "a30e5bb12cf4cd930c40cfb4e1fc6225" + "92a49588794494d56d24ea4b40c89fc0" + "596cc9ebb961c8cb10adde976a5d602b" + "1c3f85b9b9a001ed3c6a4d3b1437f520" + "96cd1956d042a597d561a596ecd3d173" + "5a8d570ea0ec27225a2c4aaff26306d1" + "526c1af3ca6d9cf5a2c98f47e1c46db9" + "a33234cfd4d81f2c98538a09ebe76998" + "d0d8fd25997c7d255c6d66ece6fa56f1" + "1144950f027795e653008f4bd7ca2dee" + "85d8e90f3dc315130ce2a00375a318c7" + "c3d97be2c8ce5b6db41a6254ff264fa6" + "155baee3b0773c0f497c573f19bb4f42" + "40281f0b1f4f7be857a4e59d416c06b4" + "c50fa09e1810ddc6b1467baeac5a3668" + "d11b6ecaa901440016f389f80acc4db9" + "77025e7f5924388c7e340a732e554440" + "e76570f8dd71b7d640b3450d1fd5f041" + "0a18f9a3494f707c717b79b4bf75c984" + "00b096b21653b5d217cf3565c9597456" + "f70703497a078763829bc01bb1cbc8fa" + "04eadc9a6e3f6699587a9e75c94e5bab" + "0036e0b2e711392cff0047d0d6b05bd2" + "a588bc109718954259f1d86678a579a3" + "120f19cfb2963f177aeb70f2d4844826" + "262e51b80271272068ef5b3856fa8535" + "aa2a88b2d41f2a0e2fda7624c2850272" + "ac4a2f561f8f2f7a318bfd5caf969614" + "9e4ac824ad3460538fdc25421beec2cc" + "6818162d06bbed0c40a387192349db67" + "a118bada6cd5ab0140ee273204f628aa" + "d1c135f770279a651e24d8c14d75a605" + "9d76b96a6fd857def5e0b354b27ab937" + "a5815d16b5fae407ff18222c6d1ed263" + "be68c95f32d908bd895cd76207ae7264" + "87567f9a67dad79abec316f683b17f2d" + "02bf07e0ac8b5bc6162cf94697b3c27c" + "d1fea49b27f23ba2901871962506520c" + "392da8b6ad0d99f7013fbc06c2c17a56" + "9500c8a7696481c1cd33e9b14e40b82e" + "79a5f5db82571ba97bae3ad3e0479515" + "bb0e2b0f3bfcd1fd33034efc6245eddd" + "7ee2086ddae2600d8ca73e214e8c2b0b" + "db2b047c6a464a562ed77b73d2d841c4" + "b34973551257713b753632efba348169" + "abc90a68f42611a40126d7cb21b58695" + "568186f7e569d2ff0f9e745d0487dd2e" + "b997cafc5abf9dd102e62ff66cba87"), + hexstr2bin("e301345a41a39a4d72fff8df69c98075" + "a0cc082b802fc9b2b6bc503f926b65bd" + "df7f4c8f1cb49f6396afc8a70abe6d8a" + "ef0db478d4c6b2970076c6a0484fe76d" + "76b3a97625d79f1ce240e7c576750d29" + "5528286f719b413de9ada3e8eb78ed57" + "3603ce30d8bb761785dc30dbc320869e" + "1a00")} + ]. + ecdh() -> %% http://csrc.nist.gov/groups/STM/cavp/ Curves = crypto:ec_curves() ++ diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl index 4b3ea10315..3f26493cd3 100644 --- a/lib/crypto/test/engine_SUITE.erl +++ b/lib/crypto/test/engine_SUITE.erl @@ -75,11 +75,18 @@ groups() -> init_per_suite(Config) -> - case crypto:info_lib() of - [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}] -> + case {os:type(), crypto:info_lib()} of + {_, [{_,_, <<"OpenSSL 1.0.1s-freebsd 1 Mar 2016">>}]} -> {skip, "Problem with engine on OpenSSL 1.0.1s-freebsd"}; - Res -> - ct:log("crypto:info_lib() -> ~p\n", [Res]), + + {{unix,darwin}, _} -> + {skip, "Engine unsupported on Darwin"}; + + {{win32,_}, _} -> + {skip, "Engine unsupported on Windows"}; + + {OS, Res} -> + ct:log("crypto:info_lib() -> ~p\nos:type() -> ~p", [Res,OS]), try crypto:start() of ok -> Config; diff --git a/lib/eldap/README b/lib/eldap/README index e1bde9d658..238f140e93 100644 --- a/lib/eldap/README +++ b/lib/eldap/README @@ -23,7 +23,7 @@ system has been configured with SSL. In the test directory there are some hints and examples on how to test the code and how to setup and populate an OpenLDAP server. The 'eldap' code has been tested -agains OpenLDAP, IPlanet and ActiveDirectory servers. +against OpenLDAP, IPlanet and ActiveDirectory servers. If you plan to incorporate this code into your system I suggest that you build a server/supervisor harnesk diff --git a/lib/erl_docgen/doc/src/doc-build.xml b/lib/erl_docgen/doc/src/doc-build.xml index 3ea8798639..17e13bff81 100644 --- a/lib/erl_docgen/doc/src/doc-build.xml +++ b/lib/erl_docgen/doc/src/doc-build.xml @@ -178,7 +178,7 @@ </section> <section> - <title>Upcomming changes</title> + <title>Upcoming changes</title> <p> The output from the <c>erl_docgen</c> documentation build process is now just the OTP style. But in a near future we will for example add the possibility to change logo, color in the PDF and diff --git a/lib/erl_interface/src/README.internal b/lib/erl_interface/src/README.internal index c1f2d6863f..42c45b46a9 100644 --- a/lib/erl_interface/src/README.internal +++ b/lib/erl_interface/src/README.internal @@ -167,12 +167,12 @@ NOTE!!!! Sending a "char" to macros like isupper(), isalpha() where the character is > 127 will cause serios problems on some machines/OS. The reason is that - 'char' may be unsigned, i.e. the Swedish char '�' will + 'char' may be unsigned, i.e. the Swedish char 'ä' will as a number be negativ. The implementation of isupper() and others will on some machines use an array that is indexed with the incoming - character code. The Swedish '�' will then create an access + character code. The Swedish 'ä' will then create an access on memory outside the array! This may give a random value as a result or a segmentation @@ -219,7 +219,7 @@ There are some functions in the 'ei' library that uses the GCC and VC++ "long long" type. Unfortunately this can lead to some trouble. When user code is linked with the "libei.a" the linker will extract -all objects files needed for resolving all symbol referenses +all objects files needed for resolving all symbol references found. This means that you want to follow the rule that * To reduce executable code size we use resonably small C source @@ -252,7 +252,7 @@ example is that in plain R9C the ei_x_encode_longlong() function is located in the file "ei_x_encode.c". So if any "long long" ei_x function is used we have an unessesary dependency on "ei_encode_longlong.o" and then need to link with GNU ld on with the -user code or explicitely link with "libgcc.a". The situation can be +user code or explicitly link with "libgcc.a". The situation can be visible in in plain R9C using % nm -A erl_interface-3.4/lib/libei.a | \ diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index 54c435c127..44f0566379 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -526,8 +526,8 @@ unique_folder(FunName, Arity, Options) -> case proplists:get_bool(llvm_save_temps, Options) of true -> %% Store folder in current directory DirName; - false -> %% Temporarily store folder in tempfs (/dev/shm/) - "/dev/shm/" ++ DirName + false -> %% Temporarily store folder in tempfs or tmp dir + tmpfs_folder() ++ DirName end, %% Make sure it does not exist case dir_exists(Dir) of @@ -537,6 +537,14 @@ unique_folder(FunName, Arity, Options) -> Dir end. +tmpfs_folder() -> + case os:type() of + {unix, linux} -> + "/dev/shm/"; + {unix, _} -> %% Fallback to tmp dir. e.g. FreeBSD + "/tmp/" + end. + %% @doc Function that checks that a given Filename is an existing Directory %% Name (from http://rosettacode.org/wiki/Ensure_that_a_file_exists#Erlang) dir_exists(Filename) -> diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index ac2e6c1e3b..2348e9b1f6 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -196,7 +196,7 @@ file/1, file/2, get_llvm_version/0, - llvm_support_available/0, + erllvm_is_supported/0, load/1, help/0, help_hiper/0, @@ -218,12 +218,11 @@ %% Basic type declaration for exported functions of the 'hipe' module %%------------------------------------------------------------------- --type mod() :: atom(). --type f_unit() :: mod() | binary(). +-type mod() :: module(). +-type file_or_bin() :: file:filename() | binary(). -type ret_rtl() :: [_]. -type c_ret() :: {'ok', mod()} | {'error', term()} | {'ok', mod(), ret_rtl()}. %% The last for debugging only --type compile_file() :: atom() | string() | binary(). -type compile_ret() :: {hipe_architecture(), binary()} | list(). %%------------------------------------------------------------------- @@ -233,26 +232,26 @@ %%------------------------------------------------------------------- -%% @spec load(Mod) -> {module, Mod} | {error, Reason} -%% Mod = mod() +%% @spec load(Module) -> {module, Module} | {error, Reason} +%% Module = mod() %% Reason = term() %% %% @doc Like load/2, but tries to locate a BEAM file automatically. %% %% @see load/2 --spec load(Mod) -> {'module', Mod} | {'error', term()} when Mod :: mod(). +-spec load(Module) -> {'module', Module} | {'error', Reason :: term()} + when Module :: mod(). -load(Mod) -> - load(Mod, beam_file(Mod)). +load(Module) -> + load(Module, beam_file(Module)). -%% @spec load(Mod, BeamFileName) -> {module, Mod} | {error, Reason} -%% Mod = mod() +%% @spec load(Module, BeamFileName) -> {module, Module} | {error, Reason} +%% Module = mod() +%% BeamFileName = file:filename() %% Reason = term() -%% BeamFileName = string() -%% filename() = term() %% -%% @type mod() = atom(). A module name. +%% @type mod() = module(). A module name. %% %% @doc User interface for loading code into memory. The code can be %% given as a native code binary or as the file name of a BEAM file @@ -262,8 +261,8 @@ load(Mod) -> %% %% @see load/1 --spec load(Mod, string()) -> {'module', Mod} | {'error', term()} - when Mod :: mod(). +-spec load(Module, file:filename()) -> {'module', Module} | {'error', term()} + when Module :: mod(). load(Mod, BeamFileName) when is_list(BeamFileName) -> Architecture = erlang:system_info(hipe_architecture), @@ -273,26 +272,22 @@ load(Mod, BeamFileName) when is_list(BeamFileName) -> Error -> {error, Error} end. -%% @spec c(Name) -> {ok, Name} | {error, Reason} -%% Name = mod() +%% @spec c(Mod) -> {ok, Mod} | {error, Reason} +%% Mod = mod() %% Reason = term() %% -%% @equiv c(Name, []) +%% @equiv c(Mod, []) -spec c(mod()) -> c_ret(). -c(Name) -> - c(Name, []). +c(Mod) -> + c(Mod, []). -%% @spec c(Name, options()) -> {ok, Name} | {error, Reason} -%% Name = mod() +%% @spec c(Module, options()) -> {ok, Module} | {error, Reason} +%% Module = mod() %% options() = [option()] %% option() = term() %% Reason = term() -%% -%% @type fun() = atom(). A function identifier. -%% -%% @type arity() = integer(). A function arity; always nonnegative. %% %% @doc User-friendly native code compiler interface. Reads BEAM code %% from the corresponding "Module<code>.beam</code>" file in the @@ -307,12 +302,12 @@ c(Name) -> -spec c(mod(), comp_options()) -> c_ret(). -c(Name, Options) -> - c(Name, beam_file(Name), Options). +c(Module, Options) -> + c(Module, beam_file(Module), Options). -%% @spec c(Name, File, options()) -> {ok, Name} | {error, Reason} -%% Name = mod() -%% File = filename() | binary() +%% @spec c(Module, File, options()) -> {ok, Module} | {error, Reason} +%% Module = mod() +%% File = file:filename() | binary() %% Reason = term() %% %% @doc Like <code>c/2</code>, but reads BEAM code from the specified @@ -321,32 +316,32 @@ c(Name, Options) -> %% @see c/2 %% @see f/2 -c(Name, File, Opts) -> +c(Module, File, Opts) -> Opts1 = user_compile_opts(Opts), - case compile(Name, File, Opts1) of + case compile(Module, File, Opts1) of {ok, Res} -> case proplists:get_bool(to_rtl, Opts1) of - true -> {ok, Name, Res}; - false -> {ok, Name} + true -> {ok, Module, Res}; + false -> {ok, Module} end; Other -> Other end. %% @spec f(File) -> {ok, Name} | {error, Reason} -%% File = filename() | binary() +%% File = file:filename() | binary() %% Name = mod() %% Reason = term() %% %% @equiv f(File, []) --spec f(f_unit()) -> {'ok', mod()} | {'error', term()}. +-spec f(file_or_bin()) -> {'ok', mod()} | {'error', term()}. f(File) -> f(File, []). %% @spec f(File, options()) -> {ok, Name} | {error, Reason} -%% File = filename() | binary() +%% File = file:filename() | binary() %% Name = mod() %% Reason = term() %% @@ -355,7 +350,7 @@ f(File) -> %% %% @see c/3 --spec f(f_unit(), comp_options()) -> {'ok', mod()} | {'error', term()}. +-spec f(file_or_bin(), comp_options()) -> {'ok', mod()} | {'error', term()}. f(File, Opts) -> case file(File, user_compile_opts(Opts)) of @@ -371,20 +366,20 @@ user_compile_opts(Opts) -> Opts ++ ?USER_DEFAULTS. -%% @spec compile(Name) -> {ok, {Target,Binary}} | {error, Reason} -%% Name = mod() +%% @spec compile(Module) -> {ok, {Target,Binary}} | {error, Reason} +%% Module = mod() %% Binary = binary() %% Reason = term() %% -%% @equiv compile(Name, []) +%% @equiv compile(Module, []) -spec compile(mod()) -> {'ok', compile_ret()} | {'error', term()}. -compile(Name) -> - compile(Name, []). +compile(Module) -> + compile(Module, []). -%% @spec compile(Name, options()) -> {ok, {Target,Binary}} | {error, Reason} -%% Name = mod() +%% @spec compile(Module, options()) -> {ok, {Target,Binary}} | {error, Reason} +%% Module = mod() %% Binary = binary() %% Reason = term() %% @@ -403,26 +398,26 @@ compile(Name) -> %% @see file/2 %% @see load/2 --spec compile(mod(), comp_options()) -> {'ok', compile_ret()} | {'error', _}. +-spec compile(mod(), comp_options()) -> {'ok', compile_ret()} | {'error', term()}. -compile(Name, Options) -> - compile(Name, beam_file(Name), Options). +compile(Module, Options) -> + compile(Module, beam_file(Module), Options). --spec beam_file(mod()) -> string(). +-spec beam_file(mod()) -> file:filename(). beam_file(Module) when is_atom(Module) -> case code:which(Module) of non_existing -> - ?error_msg("Cannot find ~w.beam file.",[Module]), + ?error_msg("Cannot find ~w.beam file.", [Module]), ?EXIT({cant_find_beam_file,Module}); - File -> % string() + File when is_list(File) -> File end. %% @spec compile(Name, File, options()) -> %% {ok, {Target, Binary}} | {error, Reason} %% Name = mod() -%% File = filename() | binary() +%% File = file:filename() | binary() %% Binary = binary() %% Reason = term() %% @@ -431,7 +426,7 @@ beam_file(Module) when is_atom(Module) -> %% %% @see compile/2 --spec compile(mod(), compile_file(), comp_options()) -> +-spec compile(mod(), file_or_bin(), comp_options()) -> {'ok', compile_ret()} | {'error', term()}. compile(Name, File, Opts0) when is_atom(Name) -> @@ -475,18 +470,18 @@ compile(Name, File, Opts0) when is_atom(Name) -> run_compiler(Name, DisasmFun, IcodeFun, Opts) end. --spec compile_core(mod(), cerl:c_module(), compile_file(), comp_options()) -> +-spec compile_core(mod(), cerl:c_module(), file_or_bin(), comp_options()) -> {'ok', compile_ret()} | {'error', term()}. compile_core(Name, Core0, File, Opts) -> Core = cerl:from_records(Core0), compile(Name, Core, File, Opts). -%% @spec compile(Name, Core, File, options()) -> +%% @spec compile(Module, Core, File, options()) -> %% {ok, {Target, Binary}} | {error, Reason} -%% Name = mod() +%% Module = mod() %% Core = coreErlang() | [] -%% File = filename() | binary() +%% File = file:filename() | binary() %% Binary = binary() %% Reason = term() %% @@ -499,7 +494,7 @@ compile_core(Name, Core0, File, Opts) -> %% %% @see compile/3 --spec compile(mod(), cerl:c_module() | [], compile_file(), comp_options()) -> +-spec compile(mod(), cerl:c_module() | [], file_or_bin(), comp_options()) -> {'ok', compile_ret()} | {'error', term()}. compile(Name, [], File, Opts) -> @@ -511,37 +506,35 @@ compile(Name, Core, File, Opts) when is_atom(Name) -> end, run_compiler(Name, DisasmFun, IcodeFun, Opts). -%% @spec file(File) -> {ok, Name, {Target, Binary}} | {error, Reason} -%% File = filename() | binary() -%% Name = mod() | mfa() +%% @spec file(File) -> {ok, Mod, {Target, Binary}} | {error, Reason} +%% File = file:filename() +%% Mod = mod() %% Binary = binary() %% Reason = term() %% %% @equiv file(File, []) --spec file(Mod) -> {'ok', Mod, compile_ret()} | {'error', term()} - when Mod :: mod(). +-spec file(file:filename()) -> {'ok', mod(), compile_ret()} | {'error', term()}. file(File) -> file(File, []). -%% @spec file(File, options()) -> {ok, Name, {Target,Binary}} | {error, Reason} -%% File = filename() -%% Name = mod() | mfa() +%% @spec file(File, options()) -> {ok, Mod, {Target, Binary}} | {error, Reason} +%% File = file:filename() +%% Mod = mod() %% Binary = binary() %% Reason = term() %% %% @doc Like <code>compile/2</code>, but takes the module name from the -%% specified <code>File</code>. Returns both the name and the final +%% specified <code>File</code>. Returns both the module name and the final %% binary if successful. %% %% @see file/1 %% @see compile/2 --spec file(Mod, comp_options()) -> {'ok', Mod, compile_ret()} - | {'error', term()} - when Mod :: mod(). -file(File, Options) when is_atom(File) -> +-spec file(file:filename(), comp_options()) -> {'ok', mod(), compile_ret()} + | {'error', Reason :: term()}. +file(File, Options) when is_list(File) -> case beam_lib:info(File) of L when is_list(L) -> {module, Mod} = lists:keyfind(module, 1, L), @@ -653,7 +646,7 @@ run_compiler_1(Name, DisasmFun, IcodeFun, Options) -> get(hipe_target_arch)), Opts = case proplists:get_bool(to_llvm, Opts0) andalso - not llvm_support_available() of + not llvm_version_is_OK() of true -> ?error_msg("No LLVM version 3.9 or greater " "found in $PATH; aborting " @@ -1607,9 +1600,15 @@ check_options(Opts) -> ok end. --spec llvm_support_available() -> boolean(). +-spec erllvm_is_supported() -> boolean(). +erllvm_is_supported() -> + %% XXX: The test should really check the _target_ architecture, + %% (hipe_target_arch), but there's no guarantee it's set. + Arch = erlang:system_info(hipe_architecture), + lists:member(Arch, [amd64, x86]) andalso llvm_version_is_OK(). -llvm_support_available() -> +-spec llvm_version_is_OK() -> boolean(). +llvm_version_is_OK() -> get_llvm_version() >= {3,9}. -type llvm_version() :: {Major :: integer(), Minor :: integer()}. diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 8813af5dfc..c506dd5e1d 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -170,7 +170,7 @@ run(TestCase, Dir, _OutDir) -> {ok, TestCase} = hipe:c(TestCase, [o0|HiPEOpts]), ok = TestCase:test(), ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, - case ToLLVM andalso hipe:llvm_support_available() of + case ToLLVM andalso hipe:erllvm_is_supported() of true -> {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), ok = TestCase:test(); diff --git a/lib/kernel/doc/src/logger.xml b/lib/kernel/doc/src/logger.xml index 2bcf137299..e0b95fa4ad 100644 --- a/lib/kernel/doc/src/logger.xml +++ b/lib/kernel/doc/src/logger.xml @@ -290,7 +290,10 @@ logger:error("error happened because: ~p", [Reason]). % Without macro <section> <title>Macros</title> - <p>The following macros are defined:</p> + <p>The following macros are defined in <c>logger.hrl</c>, which + is included in a module with the directive</p> + <code> + -include_lib("kernel/include/logger.hrl").</code> <list> <item><c>?LOG_EMERGENCY(StringOrReport[,Metadata])</c></item> diff --git a/lib/kernel/doc/src/logger_chapter.xml b/lib/kernel/doc/src/logger_chapter.xml index 8fc52ce0a9..c7e87e6668 100644 --- a/lib/kernel/doc/src/logger_chapter.xml +++ b/lib/kernel/doc/src/logger_chapter.xml @@ -113,7 +113,10 @@ of functions on the form <c>logger:Level/1,2,3</c>, which are all shortcuts for <seealso marker="logger#log-2"> - <c>logger:log(Level,Arg1[,Arg2[,Arg3]])</c></seealso>.</p> + <c>logger:log(Level,Arg1[,Arg2[,Arg3]])</c></seealso>.</p> + <p>The macros are defined in <c>logger.hrl</c>, which is included + in a module with the directive</p> + <code>-include_lib("kernel/include/logger.hrl").</code> <p>The difference between using the macros and the exported functions is that macros add location (originator) information to the metadata, and performs lazy evaluation by wrapping the diff --git a/lib/kernel/src/inet_tcp_dist.erl b/lib/kernel/src/inet_tcp_dist.erl index d1701afdaa..c37212b0f9 100644 --- a/lib/kernel/src/inet_tcp_dist.erl +++ b/lib/kernel/src/inet_tcp_dist.erl @@ -450,7 +450,7 @@ get_tcp_address(Driver, Socket) -> get_address_resolver(EpmdModule) -> case erlang:function_exported(EpmdModule, address_please, 3) of true -> {EpmdModule, address_please}; - _ -> {inet, getaddr} + _ -> {erl_epmd, address_please} end. %% ------------------------------------------------------------ diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 01d809b566..4915193196 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -808,7 +808,8 @@ handle_info({AcceptPid, {accept_pending,MyNode,Node,Address,Type}}, State) -> _:_ -> error_logger:error_msg("~n** Cannot get connection id for node ~w~n", [Node]), - AcceptPid ! {self(),{accept_pending,nok_pending}} + AcceptPid ! {self(),{accept_pending,nok_pending}}, + {noreply, State} end end; diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 1314316c13..64e0b9d8dd 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -525,7 +525,7 @@ upgrade(Config) -> T = [beam, hipe], [upgrade_do(DataDir, Client, T) || Client <- T], - case hipe:llvm_support_available() of + case hipe:erllvm_is_supported() of false -> ok; true -> T2 = [beam, hipe_llvm], @@ -1021,6 +1021,13 @@ mult_lib_remove_prefix([H|T1], [H|T2]) -> mult_lib_remove_prefix([$/|T], []) -> T. bad_erl_libs(Config) when is_list(Config) -> + %% Preserve ERL_LIBS if set. + BadLibs0 = "/no/such/dir", + BadLibs = + case os:getenv("ERL_LIBS") of + false -> BadLibs0; + Libs -> BadLibs0 ++ ":" ++ Libs + end, {ok,Node} = test_server:start_node(bad_erl_libs, slave, []), Code = rpc:call(Node,code,get_path,[]), @@ -1028,10 +1035,9 @@ bad_erl_libs(Config) when is_list(Config) -> {ok,Node2} = test_server:start_node(bad_erl_libs, slave, - [{args,"-env ERL_LIBS /no/such/dir"}]), + [{args,"-env ERL_LIBS " ++ BadLibs}]), Code2 = rpc:call(Node,code,get_path,[]), test_server:stop_node(Node2), - %% Test that code path is not affected by the faulty ERL_LIBS Code = Code2, diff --git a/lib/mnesia/examples/bench/README b/lib/mnesia/examples/bench/README index 5d31b5ba25..3648fb59da 100644 --- a/lib/mnesia/examples/bench/README +++ b/lib/mnesia/examples/bench/README @@ -141,7 +141,7 @@ statistics_detail following atoms: normal, debug and debug2. debug enables a finer grain of statistics to be reported, but since it requires more counters, to be updated by the generator processes it may - cause slightly worse benchmark performace figures than the brief + cause slightly worse benchmark performance figures than the brief default case, that is normal. debug2 prints out the debug info and formats it according to LMC's benchmark program. @@ -160,7 +160,7 @@ n_fragments Defines how many fragments each table should be divided in. Default is 100. The fragments are evenly distributed over - all table nodes. The group table not devided in fragments. + all table nodes. The group table not divided in fragments. n_replicas diff --git a/lib/mnesia/test/README b/lib/mnesia/test/README index e0ced7399d..30a0d2fd64 100644 --- a/lib/mnesia/test/README +++ b/lib/mnesia/test/README @@ -51,7 +51,7 @@ stated as test suite configuration parameters, but by default the extra node names are generated. In this example the names will be: a, a1 and a2. It is enough to start the first node manually, the extra nodes will automatically be started if -neccessary. +necessary. The attached UNIX shell script mt, does not work on all platforms, but it may be used as a source for inspiration. It @@ -63,7 +63,7 @@ test cases (i.e. test cases that encountered an error). During development we want to be able to run the test cases in the debugger. This demands a little bit of preparations: - - Start the neccessary number of nodes (normally 3). + - Start the necessary number of nodes (normally 3). This may either be done by running the mt script or by starting the main node and then invoke mt:start_nodes() to start the extra nodes with slave. @@ -73,7 +73,7 @@ in the debugger. This demands a little bit of preparations: - Load all files that needs to be interpreted. This is typically all Mnesia files plus the test case. By invoking mnesia:ni() - and mnesia:ni([TestModule]) the neccessary modules will be + and mnesia:ni([TestModule]) the necessary modules will be loaded on all CONNECTED nodes. The test case execution is supervised in order to ensure that no test diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile index ff2bcbdb99..f9f239db37 100644 --- a/lib/observer/src/Makefile +++ b/lib/observer/src/Makefile @@ -50,6 +50,7 @@ MODULES= \ cdv_mem_cb \ cdv_mod_cb \ cdv_multi_wx \ + cdv_persistent_cb \ cdv_port_cb \ cdv_proc_cb \ cdv_sched_cb \ diff --git a/lib/observer/src/cdv_html_wx.erl b/lib/observer/src/cdv_html_wx.erl index d9efa7fc2f..ffef83227c 100644 --- a/lib/observer/src/cdv_html_wx.erl +++ b/lib/observer/src/cdv_html_wx.erl @@ -33,13 +33,17 @@ {panel, app, %% which tool is the user expand_table, - expand_wins=[]}). + expand_wins=[], + delayed_fetch, + trunc_warn=[]}). start_link(ParentWin, Info) -> wx_object:start_link(?MODULE, [ParentWin, Info], []). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +init([ParentWin, Callback]) when is_atom(Callback) -> + init(ParentWin, Callback); init([ParentWin, {App, Fun}]) when is_function(Fun) -> init([ParentWin, {App, Fun()}]); init([ParentWin, {expand,HtmlText,Tab}]) -> @@ -60,9 +64,29 @@ init(ParentWin, HtmlText, Tab, App) -> wx_misc:endBusyCursor(), {HtmlWin, #state{panel=HtmlWin,expand_table=Tab,app=App}}. +init(ParentWin, Callback) -> + {HtmlWin, State} = init(ParentWin, "", undefined, cdv), + {HtmlWin, State#state{delayed_fetch=Callback}}. + %%%%%%%%%%%%%%%%%%%%%%% Callbacks %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +handle_info(active, #state{panel=HtmlWin,delayed_fetch=Callback}=State) + when Callback=/=undefined -> + observer_lib:display_progress_dialog(HtmlWin, + "Crashdump Viewer", + "Reading data"), + {{expand,HtmlText,Tab},TW} = Callback:get_info(), + observer_lib:sync_destroy_progress_dialog(), + wx_misc:beginBusyCursor(), + wxHtmlWindow:setPage(HtmlWin,HtmlText), + cdv_wx:set_status(TW), + wx_misc:endBusyCursor(), + {noreply, State#state{expand_table=Tab, + delayed_fetch=undefined, + trunc_warn=TW}}; + handle_info(active, State) -> + cdv_wx:set_status(State#state.trunc_warn), {noreply, State}; handle_info(Info, State) -> diff --git a/lib/otp_mibs/src/otp_mibs.appup.src b/lib/observer/src/cdv_persistent_cb.erl index 9437ae2222..d5da18f7fc 100644 --- a/lib/otp_mibs/src/otp_mibs.appup.src +++ b/lib/observer/src/cdv_persistent_cb.erl @@ -1,8 +1,8 @@ -%% -*- erlang -*- +%% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2016. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 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. %% You may obtain a copy of the License at @@ -14,9 +14,19 @@ %% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %% See the License for the specific language governing permissions and %% limitations under the License. -%% +%% %% %CopyrightEnd% -{"%VSN%", - [{<<".*">>,[{restart_application, otp_mibs}]}], - [{<<".*">>,[{restart_application, otp_mibs}]}] -}. + +-module(cdv_persistent_cb). + +-export([get_info/0]). + +-include_lib("wx/include/wx.hrl"). + +get_info() -> + Tab = ets:new(pt_expand,[set,public]), + {ok,PT,TW} = crashdump_viewer:persistent_terms(), + {{expand, + observer_html_lib:expandable_term("Persistent Terms",PT,Tab), + Tab}, + TW}. diff --git a/lib/observer/src/cdv_wx.erl b/lib/observer/src/cdv_wx.erl index e546997879..f64a278a64 100644 --- a/lib/observer/src/cdv_wx.erl +++ b/lib/observer/src/cdv_wx.erl @@ -51,6 +51,7 @@ -define(DIST_STR, "Nodes"). -define(MOD_STR, "Modules"). -define(MEM_STR, "Memory"). +-define(PERSISTENT_STR, "Persistent Terms"). -define(INT_STR, "Internal Tables"). %% Records @@ -74,6 +75,7 @@ dist_panel, mod_panel, mem_panel, + persistent_panel, int_panel, active_tab }). @@ -193,6 +195,10 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> %% Memory Panel MemPanel = add_page(Notebook, ?MEM_STR, cdv_multi_wx, cdv_mem_cb), + %% Persistent Terms Panel + PersistentPanel = add_page(Notebook, ?PERSISTENT_STR, + cdv_html_wx, cdv_persistent_cb), + %% Memory Panel IntPanel = add_page(Notebook, ?INT_STR, cdv_multi_wx, cdv_int_tab_cb), @@ -215,6 +221,7 @@ setup(#state{frame=Frame, notebook=Notebook}=State) -> dist_panel = DistPanel, mod_panel = ModPanel, mem_panel = MemPanel, + persistent_panel = PersistentPanel, int_panel = IntPanel, active_tab = GenPid }}. @@ -250,6 +257,7 @@ handle_event(#wx{id = ?wxID_OPEN, State#state.dist_panel, State#state.mod_panel, State#state.mem_panel, + State#state.persistent_panel, State#state.int_panel], _ = [wx_object:call(Panel,new_dump) || Panel<-Panels], wxNotebook:setSelection(State#state.notebook,0), @@ -343,8 +351,8 @@ check_page_title(Notebook) -> get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, port_panel=Ports, ets_panel=Ets, timer_panel=Timers, fun_panel=Funs, atom_panel=Atoms, dist_panel=Dist, - mod_panel=Mods, mem_panel=Mem, int_panel=Int, - sched_panel=Sched + mod_panel=Mods, mem_panel=Mem, persistent_panel=Persistent, + int_panel=Int, sched_panel=Sched }) -> Panel = case check_page_title(Notebook) of ?GEN_STR -> Gen; @@ -358,6 +366,7 @@ get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, ?DIST_STR -> Dist; ?MOD_STR -> Mods; ?MEM_STR -> Mem; + ?PERSISTENT_STR -> Persistent; ?INT_STR -> Int end, wx_object:get_pid(Panel). @@ -365,7 +374,7 @@ get_active_pid(#state{notebook=Notebook, gen_panel=Gen, pro_panel=Pro, pid2panel(Pid, #state{gen_panel=Gen, pro_panel=Pro, port_panel=Ports, ets_panel=Ets, timer_panel=Timers, fun_panel=Funs, atom_panel=Atoms, dist_panel=Dist, mod_panel=Mods, - mem_panel=Mem, int_panel=Int}) -> + mem_panel=Mem, persistent_panel=Persistent, int_panel=Int}) -> case Pid of Gen -> ?GEN_STR; Pro -> ?PRO_STR; @@ -377,6 +386,7 @@ pid2panel(Pid, #state{gen_panel=Gen, pro_panel=Pro, port_panel=Ports, Dist -> ?DIST_STR; Mods -> ?MOD_STR; Mem -> ?MEM_STR; + ?PERSISTENT_STR -> Persistent; Int -> ?INT_STR; _ -> "unknown" end. diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index 14b086ff58..97bb344cbf 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -74,6 +74,7 @@ loaded_modules/0, loaded_mod_details/1, memory/0, + persistent_terms/0, allocated_areas/0, allocator_info/0, hash_tables/0, @@ -139,6 +140,7 @@ -define(node,node). -define(not_connected,not_connected). -define(old_instr_data,old_instr_data). +-define(persistent_terms,persistent_terms). -define(port,port). -define(proc,proc). -define(proc_dictionary,proc_dictionary). @@ -293,6 +295,8 @@ loaded_mod_details(Mod) -> call({loaded_mod_details,Mod}). memory() -> call(memory). +persistent_terms() -> + call(persistent_terms). allocated_areas() -> call(allocated_areas). allocator_info() -> @@ -471,6 +475,11 @@ handle_call(memory,_From,State=#state{file=File}) -> Memory=memory(File), TW = truncated_warning([?memory]), {reply,{ok,Memory,TW},State}; +handle_call(persistent_terms,_From,State=#state{file=File,dump_vsn=DumpVsn}) -> + TW = truncated_warning([?persistent_terms,?literals]), + DecodeOpts = get_decode_opts(DumpVsn), + Terms = persistent_terms(File, DecodeOpts), + {reply,{ok,Terms,TW},State}; handle_call(allocated_areas,_From,State=#state{file=File}) -> AllocatedAreas=allocated_areas(File), TW = truncated_warning([?allocated_areas]), @@ -580,9 +589,9 @@ truncated_here(Tag) -> case get(truncated) of true -> case get(last_tag) of - Tag -> % Tag == {TagType,Id} + {Tag,_Pos} -> % Tag == {TagType,Id} true; - {Tag,_Id} -> + {{Tag,_Id},_Pos} -> true; _LastTag -> truncated_earlier(Tag) @@ -837,8 +846,8 @@ do_read_file(File) -> case check_dump_version(Id) of {ok,DumpVsn} -> reset_tables(), - insert_index(Tag,Id,N1+1), - put_last_tag(Tag,""), + insert_index(Tag,Id,Pos=N1+1), + put_last_tag(Tag,"",Pos), DecodeOpts = get_decode_opts(DumpVsn), indexify(Fd,DecodeOpts,Rest,N1), end_progress(), @@ -906,23 +915,11 @@ indexify(Fd,DecodeOpts,Bin,N) -> _ -> insert_index(Tag,Id,NewPos) end, - case put_last_tag(Tag,Id) of - {?proc_heap,LastId} -> - [{_,LastPos}] = lookup_index(?proc_heap,LastId), + case put_last_tag(Tag,Id,NewPos) of + {{?proc_heap,LastId},LastPos} -> ets:insert(cdv_heap_file_chars,{LastId,N+Start+1-LastPos}); - {?literals,[]} -> - case get(truncated_reason) of - undefined -> - [{_,LastPos}] = lookup_index(?literals,[]), - ets:insert(cdv_heap_file_chars, - {literals,N+Start+1-LastPos}); - _ -> - %% Literals are truncated. Make sure we never - %% attempt to read in the literals. (Heaps that - %% references literals will show markers for - %% incomplete heaps, but will otherwise work.) - delete_index(?literals, []) - end; + {{?literals,[]},LastPos} -> + ets:insert(cdv_heap_file_chars,{literals,N+Start+1-LastPos}); _ -> ok end, indexify(Fd,DecodeOpts,Rest,N1); @@ -964,10 +961,18 @@ tag(Fd,<<>>,N,Gat,Di,Now) -> check_if_truncated() -> case get(last_tag) of - {?ende,_} -> + {{?ende,_},_} -> put(truncated,false), put(truncated_proc,false); - TruncatedTag -> + {{?literals,[]},_} -> + put(truncated,true), + put(truncated_proc,false), + %% Literals are truncated. Make sure we never + %% attempt to read in the literals. (Heaps that + %% references literals will show markers for + %% incomplete heaps, but will otherwise work.) + delete_index(?literals, []); + {TruncatedTag,_} -> put(truncated,true), find_truncated_proc(TruncatedTag) end. @@ -975,7 +980,6 @@ check_if_truncated() -> find_truncated_proc({Tag,_Id}) when Tag==?atoms; Tag==?binary; Tag==?instr_data; - Tag==?literals; Tag==?memory_status; Tag==?memory_map -> put(truncated_proc,false); @@ -1444,15 +1448,7 @@ maybe_other_node2(Channel) -> expand_memory(Fd,Pid,DumpVsn) -> DecodeOpts = get_decode_opts(DumpVsn), put(fd,Fd), - Dict0 = case get(?literals) of - undefined -> - Literals = read_literals(Fd,DecodeOpts), - put(?literals,Literals), - put(fd,Fd), - Literals; - Literals -> - Literals - end, + Dict0 = get_literals(Fd,DecodeOpts), Dict = read_heap(Fd,Pid,DecodeOpts,Dict0), Expanded = {read_stack_dump(Fd,Pid,DecodeOpts,Dict), read_messages(Fd,Pid,DecodeOpts,Dict), @@ -1468,6 +1464,18 @@ expand_memory(Fd,Pid,DumpVsn) -> end, {Expanded,IncompleteWarning}. +get_literals(Fd,DecodeOpts) -> + case get(?literals) of + undefined -> + OldFd = put(fd,Fd), + Literals = read_literals(Fd,DecodeOpts), + put(fd,OldFd), + put(?literals,Literals), + Literals; + Literals -> + Literals + end. + read_literals(Fd,DecodeOpts) -> case lookup_index(?literals,[]) of [{_,Start}] -> @@ -1594,31 +1602,92 @@ read_heap(Fd,Pid,DecodeOpts,Dict0) -> Dict0 end. -read_heap(DecodeOpts,Dict0) -> - %% This function is never called if the dump is truncated in {?proc_heap,Pid} - case get(fd) of - end_of_heap -> +read_heap(DecodeOpts, Dict0) -> + %% This function is never called if the dump is truncated in + %% {?proc_heap,Pid}. + %% + %% It is not always possible to reconstruct the heap terms + %% in a single pass, especially if maps are involved. + %% See crashdump_helper:literal_map/0 for an example. + %% + %% Therefore, we need two passes. In the first pass + %% we collect all lines without parsing them, and in the + %% second pass we parse them. + %% + %% The first pass follows. + + Lines0 = read_heap_lines(), + + %% Save a map of all unprocessed lines so that deref_ptr() can + %% access any line when there are references to terms not yet + %% built. + + LineMap = maps:from_list(Lines0), + put(line_map, LineMap), + + %% Refc binaries (tag "Yc") must be processed before any sub + %% binaries (tag "Ys") referencing them, so we make sure to + %% process all the refc binaries first. + %% + %% The other lines can be processed in any order, but processing + %% them in the reverse order compared to how they are printed in + %% the crash dump seems to minimize the number of references to + %% terms that have not yet been built. That happens to be the + %% order of the line list as returned by read_heap_lines/0. + + RefcBins = [Refc || {_,<<"Yc",_/binary>>}=Refc <- Lines0], + Lines = RefcBins ++ Lines0, + + %% Second pass. + + init_progress("Processing terms", map_size(LineMap)), + Dict = parse_heap_terms(Lines, DecodeOpts, Dict0), + erase(line_map), + end_progress(), + Dict. + +read_heap_lines() -> + read_heap_lines_1(get(fd), []). + +read_heap_lines_1(Fd, Acc) -> + case bytes(Fd) of + "=" ++ _next_tag -> end_progress(), - Dict0; - Fd -> - case bytes(Fd) of - "=" ++ _next_tag -> - end_progress(), - put(fd, end_of_heap), - Dict0; - Line -> - update_progress(length(Line)+1), - Dict = parse(Line,DecodeOpts,Dict0), - read_heap(DecodeOpts,Dict) - end + put(fd, end_of_heap), + Acc; + Line0 -> + update_progress(length(Line0)+1), + {Addr,":"++Line1} = get_hex(Line0), + + %% Reduce the memory consumption by converting the + %% line to a binary. Measurements show that it may also + %% be benefical for performance, too, because it makes the + %% garbage collections cheaper. + + Line = list_to_binary(Line1), + read_heap_lines_1(Fd, [{Addr,Line}|Acc]) end. -parse(Line0, DecodeOpts, Dict0) -> - {Addr,":"++Line1} = get_hex(Line0), - {_Term,Line,Dict} = parse_heap_term(Line1, Addr, DecodeOpts, Dict0), - [] = skip_blanks(Line), +parse_heap_terms([{Addr,Line0}|T], DecodeOpts, Dict0) -> + case gb_trees:is_defined(Addr, Dict0) of + true -> + %% Already parsed (by a recursive call from do_deref_ptr() + %% to parse_line()). Nothing to do. + parse_heap_terms(T, DecodeOpts, Dict0); + false -> + %% Parse this previously unparsed term. + Dict = parse_line(Addr, Line0, DecodeOpts, Dict0), + parse_heap_terms(T, DecodeOpts, Dict) + end; +parse_heap_terms([], _DecodeOpts, Dict) -> Dict. +parse_line(Addr, Line0, DecodeOpts, Dict0) -> + update_progress(1), + Line1 = binary_to_list(Line0), + {_Term,Line,Dict} = parse_heap_term(Line1, Addr, DecodeOpts, Dict0), + [] = skip_blanks(Line), %Assertion. + Dict. %%----------------------------------------------------------------- %% Page with one port @@ -2142,6 +2211,56 @@ get_atom(Atom) when is_binary(Atom) -> {Atom,nq}. % not quoted %%----------------------------------------------------------------- +%% Page with list of all persistent terms +persistent_terms(File, DecodeOpts) -> + case lookup_index(?persistent_terms) of + [{_Id,Start}] -> + Fd = open(File), + pos_bof(Fd,Start), + Terms = get_persistent_terms(Fd), + Dict = get_literals(Fd,DecodeOpts), + parse_persistent_terms(Terms,DecodeOpts,Dict); + _ -> + [] + end. + +parse_persistent_terms([[Name0,Val0]|Terms],DecodeOpts,Dict) -> + {Name,_,_} = parse_term(binary_to_list(Name0),DecodeOpts,Dict), + {Val,_,_} = parse_term(binary_to_list(Val0),DecodeOpts,Dict), + [{Name,Val}|parse_persistent_terms(Terms,DecodeOpts,Dict)]; +parse_persistent_terms([],_,_) -> []. + +get_persistent_terms(Fd) -> + case get_chunk(Fd) of + {ok,Bin} -> + get_persistent_terms(Fd,Bin,[]); + eof -> + [] + end. + + +%% Persistent_Terms are written one per line in the crash dump. +get_persistent_terms(Fd,Bin,PersistentTerms) -> + Bins = binary:split(Bin,<<"\n">>,[global]), + get_persistent_terms1(Fd,Bins,PersistentTerms). + +get_persistent_terms1(_Fd,[<<"=",_/binary>>|_],PersistentTerms) -> + PersistentTerms; +get_persistent_terms1(Fd,[LastBin],PersistentTerms) -> + case get_chunk(Fd) of + {ok,Bin0} -> + get_persistent_terms(Fd,<<LastBin/binary,Bin0/binary>>,PersistentTerms); + eof -> + [get_persistent_term(LastBin)|PersistentTerms] + end; +get_persistent_terms1(Fd,[Bin|Bins],Persistent_Terms) -> + get_persistent_terms1(Fd,Bins,[get_persistent_term(Bin)|Persistent_Terms]). + +get_persistent_term(Bin) -> + binary:split(Bin,<<"|">>). + + +%%----------------------------------------------------------------- %% Page with memory information memory(File) -> case lookup_index(?memory) of @@ -2746,12 +2865,12 @@ parse_heap_term("Yc"++Line0, Addr, DecodeOpts, D0) -> %Reference-counted binary. SymbolicBin = {'#CDVBin',Start}, Term = cdvbin(Offset, Sz, SymbolicBin), D1 = gb_trees:insert(Addr, Term, D0), - D = gb_trees:insert(Binp, SymbolicBin, D1), + D = gb_trees:enter(Binp, SymbolicBin, D1), {Term,Line,D}; [] -> Term = '#CDVNonexistingBinary', D1 = gb_trees:insert(Addr, Term, D0), - D = gb_trees:insert(Binp, Term, D1), + D = gb_trees:enter(Binp, Term, D1), {Term,Line,D} end; parse_heap_term("Ys"++Line0, Addr, DecodeOpts, D0) -> %Sub binary. @@ -2763,12 +2882,17 @@ parse_heap_term("Ys"++Line0, Addr, DecodeOpts, D0) -> %Sub binary. {Term,Line,D}; parse_heap_term("Mf"++Line0, Addr, DecodeOpts, D0) -> %Flatmap. {Size,":"++Line1} = get_hex(Line0), - {Keys,":"++Line2,D1} = parse_term(Line1, DecodeOpts, D0), - {Values,Line,D2} = parse_tuple(Size, Line2, Addr,DecodeOpts, D1, []), - Pairs = zip_tuples(tuple_size(Keys), Keys, Values, []), - Map = maps:from_list(Pairs), - D = gb_trees:update(Addr, Map, D2), - {Map,Line,D}; + case parse_term(Line1, DecodeOpts, D0) of + {Keys,":"++Line2,D1} when is_tuple(Keys) -> + {Values,Line,D2} = parse_tuple(Size, Line2, Addr,DecodeOpts, D1, []), + Pairs = zip_tuples(tuple_size(Keys), Keys, Values, []), + Map = maps:from_list(Pairs), + D = gb_trees:update(Addr, Map, D2), + {Map,Line,D}; + {Incomplete,_Line,D1} -> + D = gb_trees:insert(Addr, Incomplete, D1), + {Incomplete,"",D} + end; parse_heap_term("Mh"++Line0, Addr, DecodeOpts, D0) -> %Head node in a hashmap. {MapSize,":"++Line1} = get_hex(Line0), {N,":"++Line2} = get_hex(Line1), @@ -2871,16 +2995,18 @@ parse_atom_translation_table(N, Line0, As) -> deref_ptr(Ptr, Line, DecodeOpts, D) -> - Lookup = fun(D0) -> - gb_trees:lookup(Ptr, D0) - end, + Lookup0 = fun(D0) -> + gb_trees:lookup(Ptr, D0) + end, + Lookup = wrap_line_map(Ptr, Lookup0), do_deref_ptr(Lookup, Line, DecodeOpts, D). deref_bin(Binp0, Offset, Sz, Line, DecodeOpts, D) -> Binp = Binp0 bor DecodeOpts#dec_opts.bin_addr_adj, - Lookup = fun(D0) -> - lookup_binary(Binp, Offset, Sz, D0) - end, + Lookup0 = fun(D0) -> + lookup_binary(Binp, Offset, Sz, D0) + end, + Lookup = wrap_line_map(Binp, Lookup0), do_deref_ptr(Lookup, Line, DecodeOpts, D). lookup_binary(Binp, Offset, Sz, D) -> @@ -2899,26 +3025,36 @@ lookup_binary(Binp, Offset, Sz, D) -> end end. +wrap_line_map(Ptr, Lookup) -> + wrap_line_map_1(get(line_map), Ptr, Lookup). + +wrap_line_map_1(#{}=LineMap, Ptr, Lookup) -> + fun(D) -> + case Lookup(D) of + {value,_}=Res -> + Res; + none -> + case LineMap of + #{Ptr:=Line} -> + {line,Ptr,Line}; + #{} -> + none + end + end + end; +wrap_line_map_1(undefined, _Ptr, Lookup) -> + Lookup. + do_deref_ptr(Lookup, Line, DecodeOpts, D0) -> case Lookup(D0) of {value,Term} -> {Term,Line,D0}; none -> - case get(fd) of - end_of_heap -> - put(incomplete_heap,true), - {['#CDVIncompleteHeap'],Line,D0}; - Fd -> - case bytes(Fd) of - "="++_ -> - put(fd, end_of_heap), - do_deref_ptr(Lookup, Line, DecodeOpts, D0); - L -> - update_progress(length(L)+1), - D = parse(L, DecodeOpts, D0), - do_deref_ptr(Lookup, Line, DecodeOpts, D) - end - end + put(incomplete_heap, true), + {'#CDVIncompleteHeap',Line,D0}; + {line,Addr,NewLine} -> + D = parse_line(Addr, NewLine, DecodeOpts, D0), + do_deref_ptr(Lookup, Line, DecodeOpts, D) end. get_hex(L) -> @@ -3119,6 +3255,7 @@ tag_to_atom("literals") -> ?literals; tag_to_atom("loaded_modules") -> ?loaded_modules; tag_to_atom("memory") -> ?memory; tag_to_atom("mod") -> ?mod; +tag_to_atom("persistent_terms") -> ?persistent_terms; tag_to_atom("no_distribution") -> ?no_distribution; tag_to_atom("node") -> ?node; tag_to_atom("not_connected") -> ?not_connected; @@ -3138,13 +3275,13 @@ tag_to_atom(UnknownTag) -> %%%----------------------------------------------------------------- %%% Store last tag for use when truncated, and reason if aborted -put_last_tag(?abort,Reason) -> - %% Don't overwrite the real last tag, and make sure to return - %% the previous last tag. - put(truncated_reason,Reason), - get(last_tag); -put_last_tag(Tag,Id) -> - put(last_tag,{Tag,Id}). +put_last_tag(?abort,Reason,_Pos) -> + %% Don't overwrite the real last tag, and don't return it either, + %% since that would make the caller of this function believe that + %% the tag was complete. + put(truncated_reason,Reason); +put_last_tag(Tag,Id,Pos) -> + put(last_tag,{{Tag,Id},Pos}). %%%----------------------------------------------------------------- %%% Fetch next chunk from crashdump file diff --git a/lib/observer/src/observer.app.src b/lib/observer/src/observer.app.src index d73293a5f9..d48b846ad2 100644 --- a/lib/observer/src/observer.app.src +++ b/lib/observer/src/observer.app.src @@ -34,6 +34,7 @@ cdv_mem_cb, cdv_mod_cb, cdv_multi_wx, + cdv_persistent_cb, cdv_port_cb, cdv_proc_cb, cdv_table_wx, diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index 0c4e32af49..c67fa28c6d 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -62,7 +62,8 @@ expandable_term_body(Heading,[],_Tab) -> "Dictionary" -> "No dictionary was found"; "ProcState" -> "Information could not be retrieved," " system messages may not be handled by this process."; - "SaslLog" -> "No log entry was found" + "SaslLog" -> "No log entry was found"; + "Persistent Terms" -> "No persistent terms were found" end]; expandable_term_body(Heading,Expanded,Tab) -> Attr = "BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH=100%", diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 145ff56b71..a71e8fc29c 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -21,7 +21,9 @@ -module(crashdump_helper). -export([n1_proc/2,remote_proc/2, dump_maps/0,create_maps/0, - create_binaries/0,create_sub_binaries/1]). + create_binaries/0,create_sub_binaries/1, + dump_persistent_terms/0, + create_persistent_terms/0]). -compile(r18). -include_lib("common_test/include/ct.hrl"). @@ -62,6 +64,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) -> put(ref,Ref), put(pid,Pid), put(bin,Bin), + put(proc_bins,create_proc_bins()), put(bins,create_binaries()), put(sub_bin,SubBin), put(sub_bins,create_sub_binaries(get(bins))), @@ -117,6 +120,23 @@ create_sub_binary(Bin, Start, LenSub) -> <<_:Start/bytes,Sub:Len/bytes,_/bytes>> = Bin, Sub. +create_proc_bins() -> + Parent = self(), + Pid = + spawn( + fun() -> + %% Just reverse the list here, so this binary is not + %% confused with the one created in n1_proc/5 above, + %% which is used for testing truncation (see + %% crashdump_viewer_SUITE:truncate_dump_binary/1) + Bin = list_to_binary(lists:reverse(lists:seq(1, 255))), + <<A:65/bytes,B:65/bytes,C/bytes>> = Bin, + Parent ! {self(),{A,B,C}} + end), + receive + {Pid,ProcBins} -> ProcBins + end. + %%% %%% Test dumping of maps. Dumping of maps only from OTP 20.2. %%% @@ -142,4 +162,46 @@ create_maps() -> Map3 = lists:foldl(fun(I, A) -> A#{I=>I*I} end, Map2, lists:seq(-10, 0)), - #{a=>Map0,b=>Map1,c=>Map2,d=>Map3,e=>#{}}. + #{a=>Map0,b=>Map1,c=>Map2,d=>Map3,e=>#{},literal=>literal_map()}. + +literal_map() -> + %% A literal map such as the one below will produce a heap dump + %% like this: + %% + %% Address1:t4:H<Address3>,H<Address4>,H<Address5>,H<Address6> + %% Address2:Mf4:H<Adress1>:I1,I2,I3,I4 + %% Address3: ... % "one" + %% Address4: ... % "two" + %% Address5: ... % "three" + %% Address6: ... % "four" + %% + %% The map cannot be reconstructed in a single sequential pass. + %% + %% To reconstruct the map, first the string keys "one" + %% through "four" must be reconstructed, then the tuple at + %% Adress1, then the map at Address2. + + #{"one"=>1,"two"=>2,"three"=>3,"four"=>4}. + +%%% +%%% Test dumping of persistent terms (from OTP 21.2). +%%% + +dump_persistent_terms() -> + Parent = self(), + F = fun() -> + register(aaaaaaaa_persistent_terms, self()), + put(pts, create_persistent_terms()), + Parent ! {self(),done}, + receive _ -> ok end + end, + Pid = spawn_link(F), + receive + {Pid,done} -> + {ok,Pid} + end. + +create_persistent_terms() -> + persistent_term:put({?MODULE,first}, {pid,42.0}), + persistent_term:put({?MODULE,second}, [1,2,3]), + persistent_term:get(). diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl index 864454cdff..8c5e618f4a 100644 --- a/lib/observer/test/crashdump_viewer_SUITE.erl +++ b/lib/observer/test/crashdump_viewer_SUITE.erl @@ -345,6 +345,7 @@ browse_file(File) -> {ok,_AllocINfo,_AllocInfoTW} = crashdump_viewer:allocator_info(), {ok,_HashTabs,_HashTabsTW} = crashdump_viewer:hash_tables(), {ok,_IndexTabs,_IndexTabsTW} = crashdump_viewer:index_tables(), + {ok,_PTs,_PTsTW} = crashdump_viewer:persistent_terms(), io:format(" info read",[]), @@ -399,6 +400,13 @@ special(File,Procs) -> crashdump_viewer:expand_binary({SOffset,SSize,SPos}), io:format(" expand binary ok",[]), + ProcBins = proplists:get_value(proc_bins,Dict), + {['#CDVBin',0,65,ProcBin], + ['#CDVBin',65,65,ProcBin], + ['#CDVBin',130,125,ProcBin]} = ProcBins, + io:format(" ProcBins ok",[]), + + Binaries = crashdump_helper:create_binaries(), verify_binaries(Binaries, proplists:get_value(bins,Dict)), io:format(" binaries ok",[]), @@ -595,6 +603,23 @@ special(File,Procs) -> Maps = proplists:get_value(maps,Dict), io:format(" maps ok",[]), ok; + ".persistent_terms" -> + %% I registered a process as aaaaaaaa_persistent_term in + %% the dump to make sure it will be the first in the list + %% when sorted on names. + [#proc{pid=Pid0,name=Name}|_Rest] = lists:keysort(#proc.name,Procs), + "aaaaaaaa_persistent_terms" = Name, + Pid = pid_to_list(Pid0), + {ok,ProcDetails=#proc{},[]} = crashdump_viewer:proc_details(Pid), + io:format(" process details ok",[]), + + #proc{dict=Dict} = ProcDetails, + %% io:format("~p\n", [Dict]), + Pts1 = crashdump_helper:create_persistent_terms(), + Pts2 = proplists:get_value(pts,Dict), + true = lists:sort(Pts1) =:= lists:sort(Pts2), + io:format(" persistent terms ok",[]), + ok; _ -> ok end, @@ -679,9 +704,11 @@ do_create_dumps(DataDir,Rel) -> CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"), CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"), CD7 = dump_with_maps(DataDir,Rel,"maps"), + CD8 = dump_with_persistent_terms(DataDir,Rel,"persistent_terms"), TruncDumpMod = truncate_dump_mod(CD1), TruncatedDumpsBinary = truncate_dump_binary(CD1), - {[CD1,CD2,CD3,CD4,CD5,CD6,CD7,TruncDumpMod|TruncatedDumpsBinary], + {[CD1,CD2,CD3,CD4,CD5,CD6,CD7,CD8, + TruncDumpMod|TruncatedDumpsBinary], DosDump}; _ -> {[CD1,CD2], DosDump} @@ -850,6 +877,16 @@ dump_with_maps(DataDir,Rel,DumpName) -> ?t:stop_node(n1), CD. +dump_with_persistent_terms(DataDir,Rel,DumpName) -> + Opt = rel_opt(Rel), + Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"", + PzOpt = [{args,Pz}], + {ok,N1} = ?t:start_node(n1,peer,Opt ++ PzOpt), + {ok,_Pid} = rpc:call(N1,crashdump_helper,dump_persistent_terms,[]), + CD = dump(N1,DataDir,Rel,DumpName), + ?t:stop_node(n1), + CD. + dump(Node,DataDir,Rel,DumpName) -> Crashdump = filename:join(DataDir, dump_prefix(Rel)++DumpName), rpc:call(Node,os,putenv,["ERL_CRASH_DUMP",Crashdump]), diff --git a/lib/os_mon/Makefile b/lib/os_mon/Makefile index 1eff8a785a..40ce94e0c7 100644 --- a/lib/os_mon/Makefile +++ b/lib/os_mon/Makefile @@ -23,11 +23,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk # # Macros # -ifeq ($(findstring win32,$(TARGET)),win32) -SUB_DIRECTORIES = src c_src mibs doc/src -else -SUB_DIRECTORIES = src c_src mibs doc/src -endif +SUB_DIRECTORIES = src c_src doc/src include vsn.mk VSN = $(OS_MON_VSN) diff --git a/lib/os_mon/c_src/cpu_sup.c b/lib/os_mon/c_src/cpu_sup.c index 17ef48c26e..c96a5c9f7c 100644 --- a/lib/os_mon/c_src/cpu_sup.c +++ b/lib/os_mon/c_src/cpu_sup.c @@ -152,6 +152,8 @@ static void util_measure(unsigned int **result_vec, int *result_sz); #if defined(__sun__) static unsigned int misc_measure(char* name); +#elif defined(__linux__) +static unsigned int misc_measure(char cmd); #endif static void sendi(unsigned int data); static void sendv(unsigned int data[], int ints); @@ -231,6 +233,11 @@ int main(int argc, char** argv) { case AVG1: sendi(misc_measure("avenrun_1min")); break; case AVG5: sendi(misc_measure("avenrun_5min")); break; case AVG15: sendi(misc_measure("avenrun_15min")); break; +#elif defined(__linux__) + case NPROCS: + case AVG1: + case AVG5: + case AVG15: sendi(misc_measure(cmd)); break; #elif defined(__OpenBSD__) || (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__) || defined(__DragonFly__) case NPROCS: bsd_count_procs(); break; case AVG1: bsd_loadavg(0); break; @@ -238,7 +245,7 @@ int main(int argc, char** argv) { case AVG15: bsd_loadavg(2); break; #endif #if defined(__sun__) || defined(__linux__) || (defined(__APPLE__) && defined(__MACH__)) || defined(__FreeBSD__) - case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; + case UTIL: util_measure(&rv,&sz); sendv(rv, sz); break; #endif case QUIT: free((void*)rv); return 0; default: error("Bad command"); break; @@ -329,6 +336,22 @@ static void bsd_count_procs(void) { #if defined(__linux__) +static unsigned int misc_measure(char cmd) { + struct sysinfo info; + + if (sysinfo(&info)) + error(strerror(errno)); + + switch (cmd) { + case AVG1: return (unsigned int)(info.loads[0] / 256); + case AVG5: return (unsigned int)(info.loads[1] / 256); + case AVG15: return (unsigned int)(info.loads[2] / 256); + case NPROCS: return info.procs; + } + + return -1; +} + static cpu_t *read_procstat(FILE *fp, cpu_t *cpu) { char buffer[BUFFERSIZE]; @@ -357,8 +380,24 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { FILE *fp; unsigned int *rv = NULL; cpu_t cpu; - + + rv = *result_vec; + rv[0] = no_of_cpus; + if ( (fp = fopen(PROCSTAT,"r")) == NULL) { + if (errno == EACCES) { /* SELinux */ + rv[1] = 1; /* just the cpu id */ + ++rv; /* first value is number of cpus */ + ++rv; /* second value is number of entries */ + for (i = 0; i < no_of_cpus; ++i) { + rv[0] = CU_CPU_ID; + rv[1] = i; + rv += 1*2; + } + *result_sz = 2 + 2*1 * no_of_cpus; + return; + } + /* Check if procfs is mounted, * otherwise: * try and try again, bad procsfs. @@ -367,20 +406,19 @@ static void util_measure(unsigned int **result_vec, int *result_sz) { return; } - /*ignore read*/ + /*ignore read*/ if (fgets(buffer, BUFFERSIZE, fp) == NULL) { *result_sz = 0; return; } - rv = *result_vec; - rv[0] = no_of_cpus; + rv[1] = CU_VALUES; ++rv; /* first value is number of cpus */ ++rv; /* second value is number of entries */ for (i = 0; i < no_of_cpus; ++i) { read_procstat(fp, &cpu); - + rv[ 0] = CU_CPU_ID; rv[ 1] = cpu.id; rv[ 2] = CU_USER; rv[ 3] = cpu.user; rv[ 4] = CU_NICE_USER; rv[ 5] = cpu.nice_user; diff --git a/lib/os_mon/doc/src/Makefile b/lib/os_mon/doc/src/Makefile index 354f8ed26b..8e9a4c333c 100644 --- a/lib/os_mon/doc/src/Makefile +++ b/lib/os_mon/doc/src/Makefile @@ -39,7 +39,6 @@ XML_APPLICATION_FILES = ref_man.xml XML_REF3_FILES = cpu_sup.xml \ disksup.xml \ memsup.xml \ - os_mon_mib.xml \ os_sup.xml \ nteventlog.xml diff --git a/lib/os_mon/doc/src/os_mon_app.xml b/lib/os_mon/doc/src/os_mon_app.xml index 99492a2021..c77a9d0411 100644 --- a/lib/os_mon/doc/src/os_mon_app.xml +++ b/lib/os_mon/doc/src/os_mon_app.xml @@ -88,33 +88,6 @@ </section> <section> - <title>SNMP MIBs</title> - <p>The following MIBs are defined in OS_Mon:</p> - <taglist> - <tag>OTP-OS-MON-MIB</tag> - <item> - <p>This MIB contains objects for instrumentation of disk, - memory and CPU usage of the nodes in the system.</p> - </item> - </taglist> - <p>The MIB is stored in the <c>mibs</c> directory. It is defined - in SNMPv2 SMI syntax. An SNMPv1 version of the MIB is delivered - in the <c>mibs/v1</c> directory.</p> - <p>The compiled MIB is located under <c>priv/mibs</c>, and - the generated <c>.hrl</c> file under the <c>include</c> directory. - To compile a MIB that IMPORTS the <c>OTP-OS-MON-MIB</c>, give - the option <c>{il, ["os_mon/priv/mibs"]}</c> to the MIB compiler.</p> - <p>If the MIB should be used in a system, it should be loaded into - an agent with a call to <c>os_mon_mib:load(Agent)</c>, where - <c>Agent</c> is the pid or registered name of an SNMP agent. Use - <c>os_mon_mib:unload(Agent)</c> to unload the MIB. - The implementation of this MIB uses Mnesia to store a cache with - data needed, which implicates that Mnesia must be up and running. - The MIB also use functions defined for the <c>OTP-MIB</c>, thus - that MIB must be loaded as well.</p> - </section> - - <section> <title>See Also</title> <p><seealso marker="cpu_sup">cpu_sup(3)</seealso>, <seealso marker="disksup">disksup(3)</seealso>, diff --git a/lib/os_mon/doc/src/os_mon_mib.xml b/lib/os_mon/doc/src/os_mon_mib.xml deleted file mode 100644 index e995bf3de1..0000000000 --- a/lib/os_mon/doc/src/os_mon_mib.xml +++ /dev/null @@ -1,74 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2004</year><year>2018</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>os_mon_mib</title> - <prepared>Ingela Andin</prepared> - <responsible></responsible> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>os_mon_mib</module> - <modulesummary>Loading and Unloading of OTP-OS-MON-MIB</modulesummary> - <description> - <p>Functions for loading and unloading the OTP-OS-MON-MIB into/from - an SNMP agent. The instrumentation of the OTP-OS-MON-MIB uses - Mnesia, hence Mnesia must be started prior to loading - the OTP-OS-MON-MIB.</p> - <warning> - <p>This module has been deprecated and will be removed in a furture release.</p> - </warning> - </description> - <funcs> - <func> - <name>load(Agent) -> ok | {error, Reason}</name> - <fsummary>Load the OTP-OS-MON-MIB</fsummary> - <type> - <v>Agent = pid() | atom()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Loads the OTP-OS-MON-MIB.</p> - </desc> - </func> - <func> - <name>unload(Agent) -> ok | {error, Reason}</name> - <fsummary>Unload the OTP-OS-MON-MIB</fsummary> - <type> - <v>Agent = pid() | atom() </v> - <v>Reason = term()</v> - </type> - <desc> - <p>Unloads the OTP-OS-MON-MIB.</p> - </desc> - </func> - </funcs> - - <section> - <title>See Also</title> - <p><seealso marker="os_mon_app">os_mon(6)</seealso>, - <seealso marker="snmp:snmp">snmp(3)</seealso></p> - </section> -</erlref> - diff --git a/lib/os_mon/doc/src/ref_man.xml b/lib/os_mon/doc/src/ref_man.xml index a8f847a8ba..57dd5c5f0b 100644 --- a/lib/os_mon/doc/src/ref_man.xml +++ b/lib/os_mon/doc/src/ref_man.xml @@ -36,7 +36,6 @@ <xi:include href="cpu_sup.xml"/> <xi:include href="disksup.xml"/> <xi:include href="memsup.xml"/> - <xi:include href="os_mon_mib.xml"/> <xi:include href="os_sup.xml"/> <xi:include href="nteventlog.xml"/> </application> diff --git a/lib/os_mon/mibs/Makefile b/lib/os_mon/mibs/Makefile deleted file mode 100644 index dbc105ee3d..0000000000 --- a/lib/os_mon/mibs/Makefile +++ /dev/null @@ -1,101 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. 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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(OS_MON_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/os_mon-$(VSN) - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MIB_FILES= OTP-OS-MON-MIB.mib -FUNCS_FILES = OTP-OS-MON-MIB.funcs - -BIN_TARGETS= $(MIB_FILES:%.mib=$(SNMP_BIN_TARGET_DIR)/%.bin) -HRL_TARGETS= $(MIB_FILES:%.mib=$(SNMP_HRL_TARGET_DIR)/%.hrl) -V1_MIB_FILES= $(MIB_FILES:%.mib=v1/%.mib.v1) - -TARGET_FILES= $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin \ - $(SNMP_BIN_TARGET_DIR)/OTP-TC.bin \ - $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin \ - $(BIN_TARGETS) $(HRL_TARGETS) $(V1_MIB_FILES) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -SNMP_FLAGS = -I $(SNMP_BIN_TARGET_DIR) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f core - -docs: - -OTP_MIBDIR = $(shell if test -d ../../otp_mibs; then echo otp_mibs; \ - else echo sasl; fi) - -$(SNMP_BIN_TARGET_DIR)/OTP-REG.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-REG.mib - $(snmp_verbose)$(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< - -$(SNMP_BIN_TARGET_DIR)/OTP-TC.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-TC.mib - $(snmp_verbose)$(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< - -$(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-MIB.mib - $(snmp_verbose)$(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< - -v1/%.mib.v1: %.mib - $(gen_verbose)$(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< - -$(SNMP_BIN_TARGET_DIR)/OTP-OS-MON-MIB.bin: \ - $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin \ - $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin \ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/mibs" - $(INSTALL_DIR) "$(RELSYSDIR)/mibs/v1" - $(INSTALL_DATA) $(MIB_FILES) $(FUNCS_FILES) "$(RELSYSDIR)/mibs" - $(INSTALL_DATA) $(V1_MIB_FILES) "$(RELSYSDIR)/mibs/v1" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(HRL_TARGETS) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/mibs" - $(INSTALL_DATA) $(BIN_TARGETS) "$(RELSYSDIR)/priv/mibs" - -release_docs_spec: diff --git a/lib/os_mon/mibs/OTP-OS-MON-MIB.funcs b/lib/os_mon/mibs/OTP-OS-MON-MIB.funcs deleted file mode 100644 index 7ed76517b9..0000000000 --- a/lib/os_mon/mibs/OTP-OS-MON-MIB.funcs +++ /dev/null @@ -1,5 +0,0 @@ -{loadMemorySystemWatermark, {os_mon_mib, mem_sys_mark, []}}. -{loadMemoryErlProcWatermark, {os_mon_mib, mem_proc_mark, []}}. -{loadTable, {os_mon_mib, load_table, []}}. -{diskAlmostFullThreshold, {os_mon_mib, disk_threshold, []}}. -{diskTable, {os_mon_mib, disk_table, []}}. diff --git a/lib/os_mon/mibs/OTP-OS-MON-MIB.mib b/lib/os_mon/mibs/OTP-OS-MON-MIB.mib deleted file mode 100644 index e027e96154..0000000000 --- a/lib/os_mon/mibs/OTP-OS-MON-MIB.mib +++ /dev/null @@ -1,423 +0,0 @@ --- --- %CopyrightBegin% --- --- Copyright Ericsson AB 1997-2016. 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. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. --- --- %CopyrightEnd% --- - -OTP-OS-MON-MIB DEFINITIONS ::= BEGIN - -IMPORTS - MODULE-IDENTITY, NOTIFICATION-TYPE, OBJECT-TYPE, - Counter32, Gauge32, Integer32, Unsigned32, Counter64 - FROM SNMPv2-SMI - TEXTUAL-CONVENTION, DisplayString - FROM SNMPv2-TC - MODULE-COMPLIANCE, NOTIFICATION-GROUP, OBJECT-GROUP - FROM SNMPv2-CONF - otpModules, otpApplications - FROM OTP-REG - erlNodeId - FROM OTP-MIB - ; - - -otpOsMonModule MODULE-IDENTITY - LAST-UPDATED "0305090900Z" - ORGANIZATION "Ericsson" - CONTACT-INFO - "Contact: Erlang Support see license agreement for Erlang/OTP." - - DESCRIPTION - "This MIB is part of the OTP MIB. It defines MIB objects - for the os_mon application in OTP." - - REVISION "0508260900Z" - DESCRIPTION - "Removed dependeny on EVA." - REVISION "0305090900Z" - DESCRIPTION - "Changed CONTACT-INFO as it was outdated, made it more generic - to avoid such changes in the future." - - REVISION "9807080900Z" - DESCRIPTION - "Changed MAX-ACCESS for diskDescr from not-accessible to - read-only." - - REVISION "9801270900Z" - DESCRIPTION - "Changed erroneous name of this module to otpOsMonModule." - - REVISION "9712010900Z" - DESCRIPTION - "Converted to v2 SMI and placed in the OTP tree." - - REVISION "9608191700Z" - DESCRIPTION - "The initial revision of MIB module OTP-OS-MON-MIB." - ::= { otpModules 4 } - -OTPCounterBasedGauge64 ::= TEXTUAL-CONVENTION - STATUS current - DESCRIPTION - "The CounterBasedGauge64 type represents a non-negative - integer, which may increase or decrease, but shall never - exceed a maximum value, nor fall below a minimum value. The - maximum value can not be greater than 2^64-1 - (18446744073709551615 decimal), and the minimum value can - - not be smaller than 0. The value of a CounterBasedGauge64 - has its maximum value whenever the information being modeled - is greater than or equal to its maximum value, and has its - minimum value whenever the information being modeled is - smaller than or equal to its minimum value. If the - information being modeled subsequently decreases below - (increases above) the maximum (minimum) value, the - CounterBasedGauge64 also decreases (increases). - - Note that this TC is not strictly supported in SMIv2, - because the 'always increasing' and 'counter wrap' semantics - associated with the Counter64 base type are not preserved. - It is possible that management applications which rely - solely upon the (Counter64) ASN.1 tag to determine object - semantics will mistakenly operate upon objects of this type - as they would for Counter64 objects. - - This textual convention represents a limited and short-term - solution, and may be deprecated as a long term solution is - defined and deployed to replace it." - SYNTAX Counter64 - -otpOsMonMIB OBJECT IDENTIFIER ::= { otpApplications 2 } -otpOsMonMIBConformance - OBJECT IDENTIFIER ::= { otpOsMonMIB 1 } -otpOsMonMIBObjects - OBJECT IDENTIFIER ::= { otpOsMonMIB 2 } -otpOsMonMIBAlarms - OBJECT IDENTIFIER ::= { otpOsMonMIB 4 } -otpOsMonMIBAlarmsV2 - OBJECT IDENTIFIER ::= { otpOsMonMIBAlarms 0 } - - --- Datatypes - --- Managed Objects - -load OBJECT IDENTIFIER ::= { otpOsMonMIBObjects 1 } -disk OBJECT IDENTIFIER ::= { otpOsMonMIBObjects 2 } - -loadMemorySystemWatermark OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Threshold in percent of the total available system - memory, which specifies how much memory can be allocated - by the system before an alarm is sent." - ::= { load 1 } - -loadMemoryErlProcWatermark OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Threshold in percent of the total available system - memory, which specifies how much memory can be allocated - by one Erlang process before an alarm is sent." - ::= { load 2 } - -loadTable OBJECT-TYPE - SYNTAX SEQUENCE OF LoadEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A table with load and memory information - for each node." - ::= { load 3 } - -loadEntry OBJECT-TYPE - SYNTAX LoadEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A conceptual row in the loadTable." - INDEX { loadErlNodeName } - ::= { loadTable 1 } - -LoadEntry ::= SEQUENCE { - loadErlNodeName DisplayString, - loadSystemTotalMemory Gauge32, - loadSystemUsedMemory Gauge32, - loadLargestErlProcess DisplayString, - loadLargestErlProcessUsedMemory Gauge32, - loadCpuLoad Integer32, - loadCpuLoad5 Integer32, - loadCpuLoad15 Integer32, - loadOsWordsize Unsigned32, - loadSystemTotalMemory64 OTPCounterBasedGauge64, - loadSystemUsedMemory64 OTPCounterBasedGauge64, - loadLargestErlProcessUsedMemory64 OTPCounterBasedGauge64 - } - -loadErlNodeName OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "The name of the erlang node, e.g. erlnode@host1." - ::= { loadEntry 1 } - -loadSystemTotalMemory OBJECT-TYPE - SYNTAX Gauge32 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of total memory in the system." - ::= { loadEntry 2 } - -loadSystemUsedMemory OBJECT-TYPE - SYNTAX Gauge32 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of used memory." - ::= { loadEntry 3 } - -loadLargestErlProcess OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The process identifier (Pid) of the largest Erlang - process." - ::= { loadEntry 4 } - -loadLargestErlProcessUsedMemory OBJECT-TYPE - SYNTAX Gauge32 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of memory used by the largest Erlang - process." - ::= { loadEntry 5 } - -loadCpuLoad OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The average load the last minute in percent of the CPU - where the Erlang node runs." - ::= { loadEntry 6 } - -loadCpuLoad5 OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The average load the last 5 minutes in percent of the CPU - where the Erlang node runs." - ::= { loadEntry 7} - -loadCpuLoad15 OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The average load the last 15 minutes in percent of the CPU - where the Erlang node runs." - ::= { loadEntry 8} - -loadOsWordsize OBJECT-TYPE - SYNTAX Unsigned32 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The wordsize of the operating operating system." - ::= { loadEntry 9 } - -loadSystemTotalMemory64 OBJECT-TYPE - SYNTAX OTPCounterBasedGauge64 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of total memory in the system for 64-bit operating system." - ::= { loadEntry 10 } - -loadSystemUsedMemory64 OBJECT-TYPE - SYNTAX OTPCounterBasedGauge64 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of used memory for 64-bit operating system." - ::= { loadEntry 11 } - -loadLargestErlProcessUsedMemory64 OBJECT-TYPE - SYNTAX OTPCounterBasedGauge64 - UNITS "bytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of memory used by the largest Erlang - process for 64-bit operating system.." - ::= { loadEntry 12 } - -diskAlmostFullThreshold OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Threshold in percent of the available disk space, - which specifies how much disk space can be used by - a disk or partition before an alarm is sent." - ::= { disk 1 } - -diskTable OBJECT-TYPE - SYNTAX SEQUENCE OF DiskEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A table with all local disks or partitions on each - node." - ::= { disk 2 } - -diskEntry OBJECT-TYPE - SYNTAX DiskEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A conceptual row in the diskTable." - INDEX { erlNodeId, diskId } - ::= { diskTable 1 } - -DiskEntry ::= SEQUENCE { - diskId Integer32, - diskDescr DisplayString, - diskKBytes Gauge32, - diskCapacity Integer32 - } - -diskId OBJECT-TYPE - SYNTAX Integer32 - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "An integer that uniquely identifies the disk - or partition." - ::= { diskEntry 1 } - -diskDescr OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "A string that identifies the disk or partition." - ::= { diskEntry 2 } - -diskKBytes OBJECT-TYPE - SYNTAX Gauge32 - UNITS "kbytes" - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The amount of total disk/partition space. " - ::= { diskEntry 3 } - -diskCapacity OBJECT-TYPE - SYNTAX Integer32 (0..100) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "How much of the disk's/partition's total capacity has - been used, in percent." - ::= { diskEntry 4 } - - --- conformance information - -otpOsMonMIBCompliances - OBJECT IDENTIFIER ::= { otpOsMonMIBConformance 1 } -otpOsMonMIBGroups - OBJECT IDENTIFIER ::= { otpOsMonMIBConformance 2 } - - --- compliance statements - -otpOsMonBasicCompliance MODULE-COMPLIANCE - STATUS current - DESCRIPTION - "The compliance statement for SNMPv2 entities which - implement the OTP-OS-MON-MIB." - MODULE -- this module - GROUP loadGroup - DESCRIPTION - "This group is mandatory for systems implementing the - load supervison functionality." - GROUP loadAlarmsGroup - DESCRIPTION - "This group is optional for systems implementing the - load supervison functionality." - GROUP diskGroup - DESCRIPTION - "This group is mandatory for system implementing the - disk supervison functionality." - GROUP diskAlarmsGroup - DESCRIPTION - "This group is optional for systems implementing the - disk supervison functionality." - ::= { otpOsMonMIBCompliances 1 } - - --- units of conformance - -loadGroup OBJECT-GROUP - OBJECTS { loadMemorySystemWatermark, - loadMemoryErlProcWatermark, - loadSystemTotalMemory, - loadSystemUsedMemory, - loadLargestErlProcess, - loadLargestErlProcessUsedMemory, - loadCpuLoad, - loadCpuLoad5, - loadCpuLoad15, - loadOsWordsize, - loadSystemTotalMemory64, - loadSystemUsedMemory64, - loadLargestErlProcessUsedMemory64} - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - of the load of the OTP system." - ::= { otpOsMonMIBGroups 1 } - -diskGroup OBJECT-GROUP - OBJECTS { diskAlmostFullThreshold, - diskDescr, - diskKBytes, - diskCapacity } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - of the disks in the OTP system." - ::= { otpOsMonMIBGroups 3 } - -END diff --git a/lib/os_mon/mibs/v1/.gitignore b/lib/os_mon/mibs/v1/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/os_mon/mibs/v1/.gitignore +++ /dev/null diff --git a/lib/os_mon/src/Makefile b/lib/os_mon/src/Makefile index fc2eb22393..923a31f290 100644 --- a/lib/os_mon/src/Makefile +++ b/lib/os_mon/src/Makefile @@ -34,8 +34,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/os_mon-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES= disksup memsup cpu_sup os_mon os_mon_mib os_sup os_mon_sysinfo \ - nteventlog +MODULES= disksup memsup cpu_sup os_mon os_sup os_mon_sysinfo nteventlog INCLUDE=../include CSRC=../c_src diff --git a/lib/os_mon/src/cpu_sup.erl b/lib/os_mon/src/cpu_sup.erl index 81e049ef22..ba2d89313e 100644 --- a/lib/os_mon/src/cpu_sup.erl +++ b/lib/os_mon/src/cpu_sup.erl @@ -220,17 +220,21 @@ code_change(_OldVsn, State, _Extra) -> %% internal functions %%---------------------------------------------------------------------- -get_uint32_measurement(Request, #internal{os_type = {unix, linux}}) -> - {ok,F} = file:open("/proc/loadavg",[read,raw]), - {ok,D} = file:read_line(F), - ok = file:close(F), - {ok,[Load1,Load5,Load15,_PRun,PTotal],_} = io_lib:fread("~f ~f ~f ~d/~d", D), - case Request of - ?avg1 -> sunify(Load1); - ?avg5 -> sunify(Load5); - ?avg15 -> sunify(Load15); - ?ping -> 4711; - ?nprocs -> PTotal +get_uint32_measurement(Request, #internal{port = P, os_type = {unix, linux}}) -> + case file:open("/proc/loadavg",[read,raw]) of + {ok,F} -> + {ok,D} = file:read_line(F), + ok = file:close(F), + {ok,[Load1,Load5,Load15,_PRun,PTotal],_} = io_lib:fread("~f ~f ~f ~d/~d", D), + case Request of + ?avg1 -> sunify(Load1); + ?avg5 -> sunify(Load5); + ?avg15 -> sunify(Load15); + ?ping -> 4711; + ?nprocs -> PTotal + end; + {error,_} -> + port_server_call(P, Request) end; get_uint32_measurement(Request, #internal{port = P, os_type = {unix, Sys}}) when Sys == sunos; diff --git a/lib/os_mon/src/os_mon.app.src b/lib/os_mon/src/os_mon.app.src index 8be94f65d4..6c9b0d7576 100644 --- a/lib/os_mon/src/os_mon.app.src +++ b/lib/os_mon/src/os_mon.app.src @@ -21,7 +21,7 @@ {application, os_mon, [{description, "CPO CXC 138 46"}, {vsn, "%VSN%"}, - {modules, [os_mon, os_mon_mib, os_sup, + {modules, [os_mon, os_sup, disksup, memsup, cpu_sup, os_mon_sysinfo, nteventlog]}, {registered, [os_mon_sup, os_mon_sysinfo, disksup, memsup, cpu_sup, os_sup_server]}, @@ -31,6 +31,4 @@ {start_memsup, true}, {start_os_sup, false}]}, {mod, {os_mon, []}}, - {runtime_dependencies, ["stdlib-2.0","snmp-4.25.1","sasl-2.4", - "otp_mibs-1.0.9","mnesia-4.12","kernel-3.0", - "erts-6.0"]}]}. + {runtime_dependencies, ["stdlib-2.0","sasl-2.4","kernel-3.0","erts-6.0"]}]}. diff --git a/lib/os_mon/src/os_mon_mib.erl b/lib/os_mon/src/os_mon_mib.erl deleted file mode 100644 index 9b5d2fbba6..0000000000 --- a/lib/os_mon/src/os_mon_mib.erl +++ /dev/null @@ -1,251 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2016. 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(os_mon_mib). -%%%----------------------------------------------------------------- -%%% Description: This module implements the OS-MON-MIB. -%%% The tables are implemented as shadow tables with the module -%%% snmp_shadow_table. Here the update functions are implemented. -%%%----------------------------------------------------------------- - --include("../../otp_mibs/include/OTP-MIB.hrl"). - -%% API --export([load/1, unload/1]). - -%% Deprecated API --export([init/1, stop/1]). - --deprecated([{init,1,eventually}, - {stop,1,eventually}]). - -%% SNMP instrumentation --export([load_table/1, load_table/3, disk_table/1, disk_table/3, - mem_sys_mark/1, mem_proc_mark/1, disk_threshold/1]). - -%% SNMP shadow functions --export([update_load_table/0, update_disk_table/0]). - -%% Exported for internal use via rpc --export([get_load/1, get_disks/1]). - -%% Shadow tables --record(loadTable, { - loadErlNodeName, - loadSystemTotalMemory, - loadSystemUsedMemory, - loadLargestErlProcess, - loadLargestErlProcessUsedMemory, - loadCpuLoad, - loadCpuLoad5, - loadCpuLoad15, - loadOsWordsize, - loadSystemTotalMemory64, - loadSystemUsedMemory64, - loadLargestErlProcessUsedMemory64}). - --record(diskTable, - {key, diskDescr, diskKBytes, diskCapacity}). - -%% Shadow argument macros --define(loadShadowArgs, - {loadTable, string, record_info(fields, loadTable), 5000, - fun os_mon_mib:update_load_table/0}). - --define(diskShadowArgs, - {diskTable, {integer, integer}, record_info(fields, diskTable), 5000, - fun os_mon_mib:update_disk_table/0}). - -%% Misc --record(diskAlloc, {diskDescr, diskId}). - -%%%========================================================================= -%%% API -%%%========================================================================= - -%%------------------------------------------------------------------------- -%% load(Agent) -> ok | {error, Reason} -%% Agent - pid() | atom() -%% Reason - term() -%% Description: Loads the OTP-OS-MON-MIB -%%------------------------------------------------------------------------- -load(Agent) -> - MibDir = filename:join(code:priv_dir(os_mon), "mibs"), - snmpa:load_mibs(Agent, [filename:join(MibDir, "OTP-OS-MON-MIB")]). - -%%------------------------------------------------------------------------- -%% unload(Agent) -> ok | {error, Reason} -%% Agent - pid() | atom() -%% Reason - term() -%% Description: Unloads the OTP-OS-MON-MIB -%%------------------------------------------------------------------------- -unload(Agent) -> - snmpa:unload_mibs(Agent, ["OTP-OS-MON-MIB"]). - -%% To be backwards compatible -init(Agent) -> - load(Agent). -stop(Agent) -> - unload(Agent). - -%%%========================================================================= -%%% SNMP instrumentation -%%%========================================================================= -load_table(Op) -> - snmp_shadow_table:table_func(Op, ?loadShadowArgs). -load_table(Op, RowIndex, Cols) -> - snmp_shadow_table:table_func(Op, RowIndex, Cols, ?loadShadowArgs). - -disk_table(new) -> - Tab = diskAlloc, - Storage = ram_copies, - case lists:member(Tab, mnesia:system_info(tables)) of - true -> - case mnesia:table_info(Tab, storage_type) of - unknown -> - {atomic, ok}=mnesia:add_table_copy(Tab, node(), Storage); - Storage -> - catch delete_all(Tab) - end; - false -> - Nodes = [node()], - Props = [{type, set}, - {attributes, record_info(fields, diskAlloc)}, - {local_content, true}, - {Storage, Nodes}], - {atomic, ok} = mnesia:create_table(Tab, Props) - - end, - Rec = #diskAlloc{diskDescr = next_index, diskId = 1}, - ok = mnesia:dirty_write(Rec), - snmp_shadow_table:table_func(new, ?diskShadowArgs). - -disk_table(Op, RowIndex, Cols) -> - snmp_shadow_table:table_func(Op, RowIndex, Cols, ?diskShadowArgs). - -mem_sys_mark(get) -> - {value, memsup:get_sysmem_high_watermark()}; -mem_sys_mark(_) -> - ok. - -mem_proc_mark(get) -> - {value, memsup:get_procmem_high_watermark()}; -mem_proc_mark(_) -> - ok. - -disk_threshold(get) -> - {value, disksup:get_almost_full_threshold()}; -disk_threshold(_) -> - ok. - -%%%========================================================================= -%%% SNMP shadow functions -%%%========================================================================= -update_load_table() -> - delete_all(loadTable), - lists:foreach( - fun(Node) -> - case rpc:call(Node, os_mon_mib, get_load, [Node]) of - Load when is_record(Load,loadTable) -> - ok = mnesia:dirty_write(Load); - _Else -> - ok - end - end, [node() | nodes()]). - - -update_disk_table() -> - delete_all(diskTable), - node_update_disk_table( - otp_mib:erl_node_table(get_next, [], [?erlNodeName,?erlNodeOutBytes])). - -%%%======================================================================== -%%% Exported for internal use via rpc -%%%======================================================================== -get_load(Node) -> - {Total, Allocated, PidString, PidAllocated} = case memsup:get_memory_data() of - {MemTot, MemAlloc, undefined} -> {MemTot, MemAlloc, "undefined", 0}; - {MemTot, MemAlloc, {Pid, PidMem}} -> {MemTot, MemAlloc, pid_to_str(Pid), PidMem} - end, - OsWordsize = case memsup:get_os_wordsize() of - WS when is_integer(WS) -> WS; - _ -> 0 - end, - #loadTable{ - loadErlNodeName = atom_to_list(Node), - loadSystemTotalMemory = mask_int32(Total), - loadSystemUsedMemory = mask_int32(Allocated), - loadLargestErlProcess = PidString, - loadLargestErlProcessUsedMemory = mask_int32(PidAllocated), - loadCpuLoad = get_cpu_load(avg1), - loadCpuLoad5 = get_cpu_load(avg5), - loadCpuLoad15 = get_cpu_load(avg15), - loadOsWordsize = OsWordsize, - loadSystemTotalMemory64 = Total, - loadSystemUsedMemory64 = Allocated, - loadLargestErlProcessUsedMemory64 = PidAllocated - }. - -mask_int32(Value) -> Value band ((1 bsl 32) - 1). - -get_disks(NodeId) -> - element(1, - lists:mapfoldl( - fun({Descr, KByte, Capacity}, DiskId) -> - {#diskTable{key = {NodeId, DiskId}, - diskDescr = Descr, - diskKBytes = KByte, - diskCapacity = Capacity}, - DiskId + 1} - end, 1, disksup:get_disk_data())). - - -%%%======================================================================== -%%% Internal functions -%%%======================================================================== -node_update_disk_table([_, endOfTable]) -> - ok; - -node_update_disk_table([{[?erlNodeName | IndexList], NodeStr}, _]) -> - Disks = rpc:call(list_to_atom(NodeStr), os_mon_mib, get_disks, - IndexList), - lists:foreach(fun(Disk) -> - mnesia:dirty_write(Disk) - end, Disks), - node_update_disk_table(otp_mib:erl_node_table(get_next, - IndexList, - [?erlNodeName, - ?erlNodeOutBytes])). - -get_cpu_load(X) when X == avg1; X == avg5; X == avg15 -> - case erlang:round(apply(cpu_sup, X, [])/2.56) of - Large when Large > 100 -> - 100; - Load -> - Load - end. - -delete_all(Name) -> delete_all(mnesia:dirty_first(Name), Name). -delete_all('$end_of_table', _Name) -> done; -delete_all(Key, Name) -> - Next = mnesia:dirty_next(Name, Key), - ok = mnesia:dirty_delete({Name, Key}), - delete_all(Next, Name). - -pid_to_str(Pid) -> lists:flatten(io_lib:format("~w", [Pid])). diff --git a/lib/os_mon/test/Makefile b/lib/os_mon/test/Makefile index 6ac67e6bae..03c73b95ec 100644 --- a/lib/os_mon/test/Makefile +++ b/lib/os_mon/test/Makefile @@ -30,7 +30,6 @@ MODULES= \ disksup_SUITE \ memsup_SUITE \ cpu_sup_SUITE \ - os_mon_mib_SUITE \ os_sup_SUITE \ os_mon_conf @@ -87,7 +86,6 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) os_mon.spec os_mon.cover os_mon_smoke.spec \ $(EMAKEFILE) $(SOURCE) "$(RELSYSDIR)" - $(INSTALL_DATA) os_mon_mib_SUITE.cfg "$(RELSYSDIR)" ## tar chf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/os_mon/test/os_mon.spec b/lib/os_mon/test/os_mon.spec index 4b4286b313..d292b258f3 100644 --- a/lib/os_mon/test/os_mon.spec +++ b/lib/os_mon/test/os_mon.spec @@ -1,2 +1 @@ {suites,"../os_mon_test",all}. -{config,"os_mon_mib_SUITE.cfg"}.
\ No newline at end of file diff --git a/lib/os_mon/test/os_mon_mib_SUITE.cfg b/lib/os_mon/test/os_mon_mib_SUITE.cfg deleted file mode 100644 index a33c23530b..0000000000 --- a/lib/os_mon/test/os_mon_mib_SUITE.cfg +++ /dev/null @@ -1,8 +0,0 @@ -%% -*- erlang -*- -{snmp, [{start_agent,true}, - {users,[{os_mon_mib_test,[snmpm_user_default,[]]}]}, - {managed_agents,[{os_mon_mib_test, - [os_mon_mib_test, {127,0,0,1}, 4000, []]}]}, - {agent_sysname,"Test os_mon_mibs"}, - {mgr_port,5001} - ]}. diff --git a/lib/os_mon/test/os_mon_mib_SUITE.erl b/lib/os_mon/test/os_mon_mib_SUITE.erl deleted file mode 100644 index f40d5f442c..0000000000 --- a/lib/os_mon/test/os_mon_mib_SUITE.erl +++ /dev/null @@ -1,578 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(os_mon_mib_SUITE). - -%%----------------------------------------------------------------- -%% This suite can no longer be executed standalone, i.e. it must be -%% executed with common test. The reason is that ct_snmp is used -%% instead of the snmp application directly. The suite requires a -%% config file, os_mon_mib_SUITE.cfg, found in the same directory as -%% the suite. -%% -%% Execute with: -%% > ct_run -suite os_mon_mib_SUITE -config os_mon_mib_SUITE.cfg -%%----------------------------------------------------------------- - --include_lib("common_test/include/ct.hrl"). --include_lib("os_mon/include/OTP-OS-MON-MIB.hrl"). --include_lib("snmp/include/snmp_types.hrl"). - -% Test server specific exports --export([all/0, suite/0, groups/0, - init_per_suite/1, end_per_suite/1]). - - -% Test cases must be exported. --export([update_load_table/1]). - --export([get_mem_sys_mark/1, get_mem_proc_mark/1, get_disk_threshold/1, - get_load_table/1, get_disk_table/1, - real_snmp_request/1, load_unload/1]). - --export([sys_tot_mem/1, sys_used_mem/1, large_erl_process/1, - large_erl_process_mem/1, cpu_load/1, cpu_load5/1, cpu_load15/1, - os_wordsize/1, sys_tot_mem64/1, sys_used_mem64/1, - large_erl_process_mem64/1, disk_descr/1, disk_kbytes/1, - disk_capacity/1]). - --export([otp_6351/1, otp_7441/1]). - --define(TRAP_UDP, 5000). --define(AGENT_UDP, 4000). --define(CONF_FILE_VER, [v2]). --define(SYS_NAME, "Test os_mon_mibs"). --define(MAX_MSG_SIZE, 484). --define(ENGINE_ID, "mgrEngine"). --define(MGR_PORT, 5001). - -%%--------------------------------------------------------------------- - -suite() -> - [{ct_hooks,[ts_install_cth]}, - {timetrap,{minutes,6}}, - {require, snmp_mgr_agent, snmp}]. - -all() -> - [load_unload, get_mem_sys_mark, get_mem_proc_mark, - get_disk_threshold, get_load_table, - {group, get_next_load_table}, get_disk_table, - {group, get_next_disk_table}, real_snmp_request, - update_load_table, {group, tickets}]. - -groups() -> - [{tickets, [], [otp_6351, otp_7441]}, - {get_next_load_table, [], - [sys_tot_mem, sys_used_mem, large_erl_process, - large_erl_process_mem, cpu_load, cpu_load5, cpu_load15, - os_wordsize, sys_tot_mem64, sys_used_mem64, - large_erl_process_mem64]}, - {get_next_disk_table, [], - [disk_descr, disk_kbytes, disk_capacity]}]. - - -%%--------------------------------------------------------------------- -%%-------------------------------------------------------------------- -%% Function: init_per_suite(Config) -> Config -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Initiation before the whole suite -%% -%% Note: This function is free to add any key/value pairs to the Config -%% variable, but should NOT alter/remove any existing entries. -%%-------------------------------------------------------------------- -init_per_suite(Config) -> - application:start(sasl), - application:start(mnesia), - application:start(os_mon), - - ok = ct_snmp:start(Config,snmp_mgr_agent), - - %% Load the mibs that should be tested - otp_mib:load(snmp_master_agent), - os_mon_mib:load(snmp_master_agent), - - Config. -%%-------------------------------------------------------------------- -%% Function: end_per_suite(Config) -> _ -%% Config - [tuple()] -%% A list of key/value pairs, holding the test case configuration. -%% Description: Cleanup after the whole suite -%%-------------------------------------------------------------------- -end_per_suite(Config) -> - PrivDir = proplists:get_value(priv_dir, Config), - ConfDir = filename:join(PrivDir,"conf"), - DbDir = filename:join(PrivDir,"db"), - MgrDir = filename:join(PrivDir, "mgr"), - - %% Uload mibs - snmpa:unload_mibs(snmp_master_agent,["OTP-OS-MON-MIB"]), - otp_mib:unload(snmp_master_agent), - - %% Clean up - application:stop(snmp), - application:stop(mnesia), - application:stop(os_mon), - - del_dir(ConfDir), - del_dir(DbDir), - (catch del_dir(MgrDir)), - ok. - -%%--------------------------------------------------------------------- -%% Test cases -%%--------------------------------------------------------------------- - -%% Test to unload and the reload the OTP.mib -load_unload(Config) when is_list(Config) -> - os_mon_mib:unload(snmp_master_agent), - os_mon_mib:load(snmp_master_agent), - ok. -%%--------------------------------------------------------------------- - -%% check os_mon_mib:update_load_table error handling -update_load_table(Config) when is_list(Config) -> - Node = start_node(), - ok = rpc:call(Node,application,start,[sasl]), - ok = rpc:call(Node,application,start,[os_mon]), - ok = os_mon_mib:update_load_table(), - rpc:call(Node,application,stop,[os_mon]), - ok = os_mon_mib:update_load_table(), - stop_node(Node), - ok. - -%% like update_load_table, when memsup_system_only==true -otp_6351(Config) when is_list(Config) -> - Node = start_node(), - ok = rpc:call(Node,application,start,[sasl]), - ok = rpc:call(Node,application,load,[os_mon]), - ok = rpc:call(Node,application,set_env, - [os_mon,memsup_system_only,true]), - ok = rpc:call(Node,application,start,[os_mon]), - Res = rpc:call(Node,os_mon_mib,get_load,[Node]), - if - is_tuple(Res), element(1, Res)==loadTable -> - ok; - true -> - ct:fail(Res) - end, - rpc:call(Node,application,stop,[os_mon]), - stop_node(Node), - ok. - - -%%--------------------------------------------------------------------- -%% Simulates a get call to test the instrumentation function -%% for the loadMemorySystemWatermark variable. -get_mem_sys_mark(Config) when is_list(Config) -> - case os_mon_mib:mem_sys_mark(get) of - {value, SysMark} when is_integer(SysMark) -> - ok; - _ -> - ct:fail(sys_mark_value_not_integer) - end. -%%--------------------------------------------------------------------- -%% Simulates a get call to test the instrumentation function -%% for the loadMemoryErlProcWatermark variable. -get_mem_proc_mark(Config) when is_list(Config) -> - case os_mon_mib:mem_proc_mark(get) of - {value, ProcMark} when is_integer(ProcMark) -> - ok; - _ -> - ct:fail(proc_mark_value_not_integer) - end. -%%--------------------------------------------------------------------- -%% Simulates a get call to test the instrumentation function -%% for the diskAlmostFullThreshold variable. -get_disk_threshold(Config) when is_list(Config) -> - case os_mon_mib:disk_threshold(get) of - {value, ProcMark} when is_integer(ProcMark) -> - ok; - _ -> - ct:fail(disk_threshold_value_not_integer) - end. -%%--------------------------------------------------------------------- - -%%% Note that when we have a string key, as in loadTable, the -%%% instrumentation will deal with the [length(String), String]. We -%%% have to know about this, when short cutting SNMP and calling -%%% instrumentation functions directly as done in most test cases in -%%% this test suite - -%% Simulates get calls to test the instrumentation function -%% for the loadTable -get_load_table(Config) when is_list(Config) -> - - NodeStr = atom_to_list(node()), - NodeLen = length(NodeStr), - - {_, _, {Pid, _}} = memsup:get_memory_data(), - PidStr = lists:flatten(io_lib:format("~w", [Pid])), - [{value, NodeStr},{value, PidStr}] = - os_mon_mib:load_table(get, [NodeLen | NodeStr], - [?loadErlNodeName, ?loadLargestErlProcess]), - - Values = os_mon_mib:load_table(get, [NodeLen | NodeStr] , - [?loadSystemTotalMemory, - ?loadSystemUsedMemory, - ?loadLargestErlProcessUsedMemory, - ?loadCpuLoad, - ?loadCpuLoad5, - ?loadCpuLoad15, - ?loadOsWordsize, - ?loadSystemTotalMemory64, - ?loadSystemUsedMemory64, - ?loadLargestErlProcessUsedMemory64]), - - IsInt = fun({value, Val}) when is_integer(Val) -> - true; - (_) -> - false - end, - - NewValues = lists:filter(IsInt, Values), - - case length(NewValues) of - 10 -> - ok; - _ -> - ct:fail(value_not_integer) - end, - - [{noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}] = - os_mon_mib:load_table(get, [3, 102, 111, 111], - [?loadErlNodeName, - ?loadSystemTotalMemory, - ?loadSystemUsedMemory, - ?loadLargestErlProcess, - ?loadLargestErlProcessUsedMemory, - ?loadCpuLoad, - ?loadCpuLoad5, - ?loadCpuLoad15, - ?loadOsWordsize, - ?loadSystemTotalMemory64, - ?loadSystemUsedMemory64, - ?loadLargestErlProcessUsedMemory64]), - - ok. -%%--------------------------------------------------------------------- - -sys_tot_mem(Config) when is_list(Config) -> - [{[?loadSystemTotalMemory, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next, [], [?loadSystemTotalMemory]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(sys_tot_mem_value_not_integer) - end. - -sys_used_mem(Config) when is_list(Config) -> - [{[?loadSystemUsedMemory, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next,[], [?loadSystemUsedMemory]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(sys_used_mem_value_not_integer) - end. - -large_erl_process(Config) when is_list(Config) -> - {_, _, {Pid, _}} = memsup:get_memory_data(), - PidStr = lists:flatten(io_lib:format("~w", [Pid])), - [{[?loadLargestErlProcess, Len | NodeStr], PidStr}] = - os_mon_mib:load_table(get_next,[], [?loadLargestErlProcess]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - ok. - -large_erl_process_mem(Config) when is_list(Config) -> - - [{[?loadLargestErlProcessUsedMemory, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next,[], - [?loadLargestErlProcessUsedMemory]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(erl_pid_mem_value_not_integer) - end. - -cpu_load(Config) when is_list(Config) -> - [{[?loadCpuLoad, Len | NodeStr], Load}] = - os_mon_mib:load_table(get_next,[], [?loadCpuLoad]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Load of - Load when is_integer(Load) -> - ok; - _ -> - ct:fail(cpu_load_value_not_integer) - end. - -cpu_load5(Config) when is_list(Config) -> - [{[?loadCpuLoad5, Len | NodeStr], Load}] = - os_mon_mib:load_table(get_next,[], [?loadCpuLoad5]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Load of - Load when is_integer(Load) -> - ok; - _ -> - ct:fail(cpu_load5_value_not_integer) - end. - -cpu_load15(Config) when is_list(Config) -> - [{[?loadCpuLoad15, Len | NodeStr], Load}] = - os_mon_mib:load_table(get_next,[], [?loadCpuLoad15]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Load of - Load when is_integer(Load) -> - ok; - _ -> - ct:fail(cpu_load15_value_not_integer) - end. - -os_wordsize(Config) when is_list(Config) -> - [{[?loadOsWordsize, Len | NodeStr], Wordsize}] = - os_mon_mib:load_table(get_next,[], [?loadOsWordsize]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Wordsize of - Wordsize when is_integer(Wordsize) -> - ok; - _ -> - ct:fail(os_wordsize_value_not_integer) - end. - -sys_tot_mem64(Config) when is_list(Config) -> - [{[?loadSystemTotalMemory64, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next, [], [?loadSystemTotalMemory64]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(sys_tot_mem_value_not_integer) - end. - -sys_used_mem64(Config) when is_list(Config) -> - [{[?loadSystemUsedMemory64, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next,[], [?loadSystemUsedMemory64]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(sys_used_mem_value_not_integer) - end. - -large_erl_process_mem64(Config) when is_list(Config) -> - - [{[?loadLargestErlProcessUsedMemory64, Len | NodeStr], Mem}] = - os_mon_mib:load_table(get_next,[], - [?loadLargestErlProcessUsedMemory64]), - Len = length(NodeStr), - true = lists:member(list_to_atom(NodeStr), [node() | nodes()]), - - case Mem of - Mem when is_integer(Mem) -> - ok; - _ -> - ct:fail(erl_pid_mem_value_not_integer) - end. -%%--------------------------------------------------------------------- -%% Simulates get calls to test the instrumentation function -%% for the diskTable. -get_disk_table(Config) when is_list(Config) -> - - DiskData = disksup:get_disk_data(), - DiskDataLen = length(DiskData), - - if - DiskDataLen > 0 -> - [{value, Value}] = - os_mon_mib:disk_table(get, [1,1], [?diskDescr]), - - case is_list(Value) of - true -> - ok; - false -> - ct:fail(value_not_a_string) - end, - - Values = os_mon_mib:disk_table(get, [1,1], - [?diskId, - ?diskKBytes, - ?diskCapacity]), - - IsInt = fun({value, Val}) when is_integer(Val) -> - true; - (_) -> - false - end, - - NewValues = lists:filter(IsInt, Values), - - case length(NewValues) of - 3 -> - ok; - _ -> - ct:fail(value_not_integer) - end - end, - - [{noValue,noSuchInstance}, {noValue,noSuchInstance}, - {noValue,noSuchInstance}, {noValue,noSuchInstance}] = - os_mon_mib:disk_table(get, [1, DiskDataLen + 1], [?diskId, - ?diskDescr, - ?diskKBytes, - ?diskCapacity]), - - ok. - -%%--------------------------------------------------------------------- - -disk_descr(Config) when is_list(Config) -> - [{[?diskDescr, 1,1], Descr}] = - os_mon_mib:disk_table(get_next, [], [?diskDescr]), - - case Descr of - Descr when is_list(Descr) -> - ok; - _ -> - ct:fail(disk_descr_value_not_a_string) - end. - -disk_kbytes(Config) when is_list(Config) -> - [{[?diskKBytes, 1,1], Kbytes}] = - os_mon_mib:disk_table(get_next,[], [?diskKBytes]), - - case Kbytes of - Kbytes when is_integer(Kbytes) -> - ok; - _ -> - ct:fail(disk_kbytes_value_not_integer) - end. - - -disk_capacity(Config) when is_list(Config) -> - [{[?diskCapacity, 1,1], Capacity}] = - os_mon_mib:disk_table(get_next,[], [?diskCapacity]), - - case Capacity of - Capacity when is_integer(Capacity) -> - ok; - _ -> - ct:fail(disk_capacity_value_not_integer) - end. - -%%--------------------------------------------------------------------- -%% Starts an snmp manager and sends a real snmp-request. i.e. -%% sends a udp message on the correct format. -real_snmp_request(Config) when is_list(Config) -> - NodStr = atom_to_list(node()), - Len = length(NodStr), - {_, _, {Pid, _}} = memsup:get_memory_data(), - PidStr = lists:flatten(io_lib:format("~w", [Pid])), - io:format("FOO: ~p~n", [PidStr]), - ok = snmp_get([?loadEntry ++ - [?loadLargestErlProcess, Len | NodStr]], - PidStr), - ok = snmp_get_next([?loadEntry ++ - [?loadSystemUsedMemory, Len | NodStr]], - ?loadEntry ++ [?loadSystemUsedMemory + 1, Len - | NodStr], PidStr), - ok = snmp_set([?loadEntry ++ [?loadLargestErlProcess, Len | NodStr]], - s, "<0.101.0>", Config), - ok. - -%% Starts an snmp manager and requests total memory. Was previously -%% integer32 which was errornous on 64 bit machines. -otp_7441(Config) when is_list(Config) -> - NodStr = atom_to_list(node()), - Len = length(NodStr), - Oids = [Oid|_] = [?loadEntry ++ [?loadSystemTotalMemory, Len | NodStr]], - {noError,0,[#varbind{oid = Oid, variabletype = 'Unsigned32'}]} = - ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent), - - ok. - -%%--------------------------------------------------------------------- -%% Internal functions -%%--------------------------------------------------------------------- -start_node() -> - Pa = filename:dirname(code:which(?MODULE)), - {ok,Node} = test_server:start_node(testnisse, slave, [{args, " -pa " ++ Pa}]), - Node. - -stop_node(Node) -> - test_server:stop_node(Node). - -del_dir(Dir) -> - io:format("Deleting: ~s~n",[Dir]), - {ok, Files} = file:list_dir(Dir), - FullPathFiles = lists:map(fun(File) -> filename:join(Dir, File) end, - Files), - lists:foreach(fun file:delete/1, FullPathFiles), - file:del_dir(Dir). - -%%--------------------------------------------------------------------- -snmp_get(Oids = [Oid |_], Result) -> - {noError,0,[#varbind{oid = Oid, - variabletype = 'OCTET STRING', - value = Result}]} = - ct_snmp:get_values(os_mon_mib_test, Oids, snmp_mgr_agent), - ok. - -snmp_get_next(Oids, NextOid, Result) -> - {noError,0,[#varbind{oid = NextOid, - variabletype = 'OCTET STRING', - value = Result}]} = - ct_snmp:get_next_values(os_mon_mib_test, Oids, snmp_mgr_agent), - ok. - -snmp_set(Oid, ValuType, Value, Config) -> - {notWritable, _, _} = - ct_snmp:set_values(os_mon_mib_test, [{Oid, ValuType, Value}], - snmp_mgr_agent, Config), - ok. diff --git a/lib/otp_mibs/AUTHORS b/lib/otp_mibs/AUTHORS deleted file mode 100644 index 3f570082f4..0000000000 --- a/lib/otp_mibs/AUTHORS +++ /dev/null @@ -1,8 +0,0 @@ -Original Authors and Contributors: - -Martin Bj�rklund -Lars Thorsen -Claes Wikstr�m -Kent Boortz -Bj�rn Gustavsson -Ingela Anderton - Created otp_mibs app. to eliminate SASL's SNMP dependence. diff --git a/lib/otp_mibs/Makefile b/lib/otp_mibs/Makefile deleted file mode 100644 index 64bd683c7a..0000000000 --- a/lib/otp_mibs/Makefile +++ /dev/null @@ -1,37 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-2016. 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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Macros -# ---------------------------------------------------- - -SUB_DIRECTORIES = src mibs doc/src - -include vsn.mk -VSN = $(OTP_MIBS_VSN) - -SPECIAL_TARGETS = - -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/otp_mibs/doc/html/.gitignore b/lib/otp_mibs/doc/html/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/doc/html/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/doc/man3/.gitignore b/lib/otp_mibs/doc/man3/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/doc/man3/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/doc/pdf/.gitignore b/lib/otp_mibs/doc/pdf/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/doc/pdf/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/doc/src/Makefile b/lib/otp_mibs/doc/src/Makefile deleted file mode 100644 index 22c3c127ac..0000000000 --- a/lib/otp_mibs/doc/src/Makefile +++ /dev/null @@ -1,116 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../../vsn.mk -VSN=$(OTP_MIBS_VSN) -APPLICATION=otp_mibs - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = otp_mib.xml - -XML_PART_FILES = part.xml -XML_CHAPTER_FILES = \ - introduction.xml \ - mibs.xml \ - notes.xml - -BOOK_FILES = book.xml - -XML_FILES = \ - $(BOOK_FILES) $(XML_CHAPTER_FILES) \ - $(XML_PART_FILES) $(XML_REF3_FILES) $(XML_APPLICATION_FILES) - -GIF_FILES = - -# ---------------------------------------------------- - -HTML_FILES = $(XML_APPLICATION_FILES:%.xml=$(HTMLDIR)/%.html) \ - $(XML_PART_FILES:%.xml=$(HTMLDIR)/%.html) - -INFO_FILE = ../../info - -MAN3_FILES = $(XML_REF3_FILES:%.xml=$(MAN3DIR)/%.3) - -HTML_REF_MAN_FILE = $(HTMLDIR)/index.html - -TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -XML_FLAGS += -DVIPS_FLAGS += - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- -$(HTMLDIR)/%.gif: %.gif - $(INSTALL_DATA) $< $@ - -docs: pdf html man - -$(TOP_PDF_FILE): $(XML_FILES) - -pdf: $(TOP_PDF_FILE) - -html: gifs $(HTML_REF_MAN_FILE) - -man: $(MAN3_FILES) - -gifs: $(GIF_FILES:%=$(HTMLDIR)/%) - -debug opt: - -clean clean_docs: - rm -rf $(HTMLDIR)/* - rm -rf $(XMLDIR) - rm -f $(MAN3DIR)/* - rm -f $(TOP_PDF_FILE) $(TOP_PDF_FILE:%.pdf=%.fo) - rm -f errs core *~ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_docs_spec: docs - $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" - $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(HTMLDIR)/* \ - "$(RELSYSDIR)/doc/html" - $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" - $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" - $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" - -release_spec: diff --git a/lib/otp_mibs/doc/src/book.xml b/lib/otp_mibs/doc/src/book.xml deleted file mode 100644 index 482da46876..0000000000 --- a/lib/otp_mibs/doc/src/book.xml +++ /dev/null @@ -1,49 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE book SYSTEM "book.dtd"> - -<book xmlns:xi="http://www.w3.org/2001/XInclude"> - <header titlestyle="normal"> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OTP_Mibs</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date>2003-04-15</date> - <rev>A</rev> - </header> - <insidecover> - </insidecover> - <pagetext>OTP_Mibs application</pagetext> - <preamble> - <contents level="2"></contents> - </preamble> - <parts lift="no"> - <xi:include href="part.xml"/> - </parts> - <applications> - <xi:include href="ref_man.xml"/> - </applications> - <releasenotes> - <xi:include href="notes.xml"/> - </releasenotes> - <index></index> -</book> - - diff --git a/lib/otp_mibs/doc/src/introduction.xml b/lib/otp_mibs/doc/src/introduction.xml deleted file mode 100644 index 7046cbb8ae..0000000000 --- a/lib/otp_mibs/doc/src/introduction.xml +++ /dev/null @@ -1,47 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Introduction</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date>2003-05-19</date> - <rev>A</rev> - <file>introduction.xml</file> - </header> - - <section> - <title>Purpose</title> - <p>The purpose of the OTP_Mibs application is to provide an SNMP - management information base for Erlang nodes.</p> - </section> - - <section> - <title>Pre-requisites</title> - <p>It is assumed that the reader is familiar with the Erlang - programming language, concepts of OTP and has a basic knowledge - of SNMP.</p> - </section> -</chapter> - - diff --git a/lib/otp_mibs/doc/src/mibs.xml b/lib/otp_mibs/doc/src/mibs.xml deleted file mode 100644 index a32d5ea5f5..0000000000 --- a/lib/otp_mibs/doc/src/mibs.xml +++ /dev/null @@ -1,71 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>Mibs</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date>2003-05-19</date> - <rev>A</rev> - <file>mibs.xml</file> - </header> - - <section> - <title>Structure</title> - <p>The OTP mibs are stored in the - <c>$OTP_ROOT/lib/otp_mibs/mibs/</c> directory. They - are defined in SNMPv2 SMI syntax. An SNMPv1 version of the mib is - delivered in the <c>mibs/v1</c> directory. The compiled MIB is - located under <c>priv/mibs</c>, and the generated <c>.hrl</c> - file under the <c>include</c> directory. To compile a MIB that - IMPORTS a MIB in the OTP_Mibs application, give the option - <c>{il, ["otp_mibs/priv/mibs"]}</c> to the MIB compiler.</p> - </section> - - <section> - <title>OTP-MIB</title> - <p>The OTP-MIB mib represents information about Erlang nodes such as - node name, number of running processes, virtual machine version - etc. If the MIB should be used in a system, it should be - loaded into an SNMP agent by using the API function - <c>otp_mib:load/1</c>.</p> - </section> - - <section> - <title>OTP-REG</title> - <p>The OTP-REG mib defines the unique OTP subtree of object - identifiers under the Ericsson subtree. Under the OTP subtree - several object identifiers are defined. This module is typically - included by OTP applications defining their own mibs, or ASN.1 - modules in general, that require unique object identifiers under - the OTP subtree.</p> - </section> - - <section> - <title>OTP-TC</title> - <p>The OTP-TC mib provides the textual convention datatype - <c>OwnerString</c>.</p> - </section> -</chapter> - - diff --git a/lib/otp_mibs/doc/src/notes.xml b/lib/otp_mibs/doc/src/notes.xml deleted file mode 100644 index 443f08f1e1..0000000000 --- a/lib/otp_mibs/doc/src/notes.xml +++ /dev/null @@ -1,327 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE chapter SYSTEM "chapter.dtd"> - -<chapter> - <header> - <copyright> - <year>2004</year><year>2018</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OTP_Mibs Release Notes</title> - <prepared>otp_appnotes</prepared> - <docno>nil</docno> - <date>nil</date> - <rev>nil</rev> - <file>notes.xml</file> - </header> - <p>This document describes the changes made to the OTP_Mibs - application.</p> - -<section><title>Otp_Mibs 1.2.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Improved documentation.</p> - <p> - Own Id: OTP-15190</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The otp_mibs application has been deprecated and will be - removed in a future release.</p> - <p> - Own Id: OTP-15141</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.1.2</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> Removed all old unused files in the documentation. - </p> - <p> - Own Id: OTP-14475 Aux Id: ERL-409, PR-1493 </p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.1.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Internal changes</p> - <p> - Own Id: OTP-13551</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.1</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Change license text from Erlang Public License to Apache - Public License v2</p> - <p> - Own Id: OTP-12845</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Make sure the clean rule for ssh, ssl, eunit and otp_mibs - actually removes generated files.</p> - <p> - Own Id: OTP-12200</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Add type based integer value truncation/reset.</p> - <p> - This fixes errors when querying e.g. the - erlNodeReductions, erlNodeInBytes and erlNodeOutBytes - objects in long-running Erlang/OTP systems.</p> - <p> - Update types of applicable MIB objects to 64bit based - types.</p> - <p> - Potential incompatibility: Type change of Counter32 to - Counter64 in OTP-MIB.mib</p> - <p> - (Thanks to Tobias Schlager)</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-11203</p> - </item> - <item> - <p> - Application upgrade (appup) files are corrected for the - following applications: </p> - <p> - <c>asn1, common_test, compiler, crypto, debugger, - dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, - inets, observer, odbc, os_mon, otp_mibs, parsetools, - percept, public_key, reltool, runtime_tools, ssh, - syntax_tools, test_server, tools, typer, webtool, wx, - xmerl</c></p> - <p> - A new test utility for testing appup files is added to - test_server. This is now used by most applications in - OTP.</p> - <p> - (Thanks to Tobias Schlager)</p> - <p> - Own Id: OTP-11744</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.8</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Misc build updates</p> - <p> - Own Id: OTP-10784</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Tuple funs (a two-element tuple with a module name and a - function) are now officially deprecated and will be - removed in R16. Use '<c>fun M:F/A</c>' instead. To make - you aware that your system uses tuple funs, the very - first time a tuple fun is applied, a warning will be sent - to the error logger.</p> - <p> - Own Id: OTP-9649</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.6</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - The documentation is now built with open source tools - (xsltproc and fop) that exists on most platforms. One - visible change is that the frames are removed.</p> - <p> - Own Id: OTP-8201</p> - </item> - </list> - </section> - -</section> - -<section><title>Otp_Mibs 1.0.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p>The copyright notices have been updated.</p> - <p> - Own Id: OTP-7851</p> - </item> - </list> - </section> - -</section> - - <section> - <title>Otp_Mibs 1.0.4.1</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Minor Makefile changes.</p> - <p>Own Id: OTP-6689</p> - </item> - </list> - </section> - </section> - - <section> - <title>OTP_Mibs 1.0.4</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>Replaced calls to deprecated functions in <c>snmp</c> - with calls to the equivalent functions in <c>snmpa</c>.</p> - <p>Own Id: OTP-6112</p> - </item> - </list> - </section> - </section> - - <section> - <title>OTP_Mibs 1.0.3</title> - - <section> - <title>Improvements and New Features</title> - <list type="bulleted"> - <item> - <p>The <c>otp_mib</c> module has been cleaned up to improve the - maintainability. It should have no effect on the - functionality of the OTP_Mibs application.</p> - <p>Own Id: OTP-4982</p> - </item> - </list> - </section> - </section> - - <section> - <title>OTP_Mibs 1.0.2</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>Incorrect <c>.app</c> file (missing mandatory - <c>registered</c>).</p> - <p>Own Id: OTP-4823 Aux Id: Seq8145, OTP-4801 </p> - </item> - </list> - </section> - </section> - - <section> - <title>OTP_Mibs 1.0.1</title> - - <section> - <title>Fixed Bugs and Malfunctions</title> - <list type="bulleted"> - <item> - <p>Missing <c>.app</c> and <c>appup</c> files in <c>ebin</c>.</p> - <p>Own Id: OTP-4801 Aux Id: Seq8145 </p> - </item> - </list> - </section> - </section> - - <section> - <title>OTP_Mibs 1.0</title> - <p>The OTP mibs that where included in the SASL application - have been moved to this new application OTP_Mibs. The OTP - mibs had no real connection to SASL and it is desirable that - the core of Erlang/OTP is not dependent on SNMP.</p> - <p>Own Id: OTP-4686</p> - </section> -</chapter> - - diff --git a/lib/otp_mibs/doc/src/otp_mib.xml b/lib/otp_mibs/doc/src/otp_mib.xml deleted file mode 100644 index 530c529c69..0000000000 --- a/lib/otp_mibs/doc/src/otp_mib.xml +++ /dev/null @@ -1,73 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE erlref SYSTEM "erlref.dtd"> - -<erlref> - <header> - <copyright> - <year>2003</year><year>2018</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>otp_mib</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date></date> - <rev></rev> - </header> - <module>otp_mib</module> - <modulesummary>Handles the OTP-MIB</modulesummary> - <description> - <p>The SNMP application should be used to start an SNMP agent. Then - the API functions below can be used to load/unload the OTP-MIB - into/from the agent. The instrumentation of the OTP-MIB uses - Mnesia, hence Mnesia must be started prior to loading the OTP-MIB.</p> - <warning> - <p>This application has been deprecated and will be removed in a furture release.</p> - </warning> - </description> - <funcs> - <func> - <name>load(Agent) -> ok | {error, Reason}</name> - <fsummary>Load the OTP-MIB</fsummary> - <type> - <v>Agent = pid() | atom()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Loads the OTP-MIB.</p> - </desc> - </func> - <func> - <name>unload(Agent) -> ok | {error, Reason}</name> - <fsummary>Unload the OTP-MIB</fsummary> - <type> - <v>Agent = pid() | atom()</v> - <v>Reason = term()</v> - </type> - <desc> - <p>Unloads the OTP-MIB.</p> - </desc> - </func> - </funcs> - - <section> - <title>See Also</title> - <p>snmp(3)</p> - </section> -</erlref> - - diff --git a/lib/otp_mibs/doc/src/part.xml b/lib/otp_mibs/doc/src/part.xml deleted file mode 100644 index 0a8ddce268..0000000000 --- a/lib/otp_mibs/doc/src/part.xml +++ /dev/null @@ -1,39 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE part SYSTEM "part.dtd"> - -<part xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OTP_Mibs User's Guide</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date>2002-09-17</date> - <rev>A</rev> - </header> - <description> - <p>The <em>OTP_Mibs</em> application provides an SNMP management - information base for Erlang nodes.</p> - </description> - <xi:include href="introduction.xml"/> - <xi:include href="mibs.xml"/> -</part> - - diff --git a/lib/otp_mibs/doc/src/ref_man.xml b/lib/otp_mibs/doc/src/ref_man.xml deleted file mode 100644 index 06c5aadcd9..0000000000 --- a/lib/otp_mibs/doc/src/ref_man.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="utf-8" ?> -<!DOCTYPE application SYSTEM "application.dtd"> - -<application xmlns:xi="http://www.w3.org/2001/XInclude"> - <header> - <copyright> - <year>2003</year><year>2016</year> - <holder>Ericsson AB. All Rights Reserved.</holder> - </copyright> - <legalnotice> - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. - - </legalnotice> - - <title>OTP_Mibs Reference Manual</title> - <prepared>Ingela Anderton</prepared> - <docno></docno> - <date>2002-09-13</date> - <rev>A</rev> - </header> - <description> - <p>The <em>OTP_Mibs</em> application provides an SNMP management - information base for Erlang nodes.</p> - </description> - <xi:include href="otp_mib.xml"/> -</application> - - diff --git a/lib/otp_mibs/ebin/.gitignore b/lib/otp_mibs/ebin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/ebin/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/include/.gitignore b/lib/otp_mibs/include/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/include/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/info b/lib/otp_mibs/info deleted file mode 100644 index aedd1c883b..0000000000 --- a/lib/otp_mibs/info +++ /dev/null @@ -1,2 +0,0 @@ -group: oam Operation & Maintenance Applications -short: SNMP management information base for Erlang/OTP nodes. diff --git a/lib/otp_mibs/mibs/Makefile b/lib/otp_mibs/mibs/Makefile deleted file mode 100644 index 11d790d014..0000000000 --- a/lib/otp_mibs/mibs/Makefile +++ /dev/null @@ -1,89 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. 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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# - -include $(ERL_TOP)/make/target.mk -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# Release directory specification -# ---------------------------------------------------- -include ../vsn.mk -ifdef SASL_VSN -VSN=$(SASL_VSN) -RELSYSDIR = $(RELEASE_PATH)/lib/sasl-$(VSN) -else -VSN=$(OTP_MIBS_VSN) -RELSYSDIR = $(RELEASE_PATH)/lib/otp_mibs-$(VSN) -endif - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MIB_FILES= OTP-REG.mib OTP-TC.mib OTP-MIB.mib -FUNCS_FILES = OTP-MIB.funcs - -BIN_TARGETS= $(MIB_FILES:%.mib=$(SNMP_BIN_TARGET_DIR)/%.bin) -HRL_TARGETS= $(MIB_FILES:%.mib=$(SNMP_HRL_TARGET_DIR)/%.hrl) -V1_MIB_FILES= $(MIB_FILES:%.mib=v1/%.mib.v1) - -TARGET_FILES= $(BIN_TARGETS) $(HRL_TARGETS) $(V1_MIB_FILES) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -SNMP_FLAGS = -I ../priv/mibs - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGET_FILES) - -clean: - rm -f $(TARGET_FILES) - rm -f core - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -v1/%.mib.v1: %.mib - $(gen_verbose)$(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/mibs" - $(INSTALL_DIR) "$(RELSYSDIR)/mibs/v1" - $(INSTALL_DATA) $(MIB_FILES) $(FUNCS_FILES) "$(RELSYSDIR)/mibs" - $(INSTALL_DATA) $(V1_MIB_FILES) "$(RELSYSDIR)/mibs/v1" - $(INSTALL_DIR) "$(RELSYSDIR)/include" - $(INSTALL_DATA) $(HRL_TARGETS) "$(RELSYSDIR)/include" - $(INSTALL_DIR) "$(RELSYSDIR)/priv/mibs" - $(INSTALL_DATA) $(BIN_TARGETS) "$(RELSYSDIR)/priv/mibs" - -release_docs_spec: diff --git a/lib/otp_mibs/mibs/OTP-EVA-MIB.mib b/lib/otp_mibs/mibs/OTP-EVA-MIB.mib deleted file mode 100644 index 4d0c53ed95..0000000000 --- a/lib/otp_mibs/mibs/OTP-EVA-MIB.mib +++ /dev/null @@ -1,569 +0,0 @@ --- --- %CopyrightBegin% --- --- Copyright Ericsson AB 2004-2016. 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. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. --- --- %CopyrightEnd% --- - -OTP-EVA-MIB DEFINITIONS ::= BEGIN - -IMPORTS - MODULE-IDENTITY, OBJECT-TYPE, NOTIFICATION-TYPE, - Counter32, Gauge32, Integer32 - FROM SNMPv2-SMI - TEXTUAL-CONVENTION, DisplayString, DateAndTime - FROM SNMPv2-TC - MODULE-COMPLIANCE, OBJECT-GROUP, NOTIFICATION-GROUP - FROM SNMPv2-CONF - otpModules, otpApplications - FROM OTP-REG - OwnerString - FROM OTP-TC - ; - -otpEvaModule MODULE-IDENTITY - LAST-UPDATED "200305090900Z" - ORGANIZATION "Ericsson" - CONTACT-INFO - "Contact: Erlang Support see license agreement for Erlang/OTP." - DESCRIPTION - "This MIB is part of the OTP MIB. It defines MIB objects - for the eva application in OTP." - - REVISION "200305090900Z" - DESCRIPTION - "Changed CONTACT-INFO as it was outdated, made it more generic - to avoid such changes in the future." - - REVISION "199801270900Z" - DESCRIPTION - "Changed erroneous defintion of alarmCleared notification. - Changed erroneous name of this module to otpEvaModule." - REVISION "199712010900Z" - DESCRIPTION - "Converted to v2 SMI and placed in the OTP tree." - REVISION "199705020900Z" - DESCRIPTION - "The initial version of this MIB module. It is very much - inspired by the ANS-ALM-MIB and Axd301Eva-OMS mibs." - ::= { otpModules 6 } - -otpEvaMIB OBJECT IDENTIFIER ::= { otpApplications 4 } -otpEvaMIBConformance - OBJECT IDENTIFIER ::= { otpEvaMIB 1 } -otpEvaMIBObjects - OBJECT IDENTIFIER ::= { otpEvaMIB 2 } -otpEvaMIBEvents OBJECT IDENTIFIER ::= { otpEvaMIB 3 } -otpEvaMIBEventsV2 - OBJECT IDENTIFIER ::= { otpEvaMIBEvents 0 } - - --- Datatypes - -AlarmSeverity ::= TEXTUAL-CONVENTION - STATUS current - DESCRIPTION - "The AlarmSeverity defines six severity levels, - which provide an indication of how it is perceived that the - capability of the managed object has been affected. Those - severity levels which represent service affecting conditions - ordered from most severe to least severe are critical, - major, minor and warning. The levels used are as defined - in X.733, ITU Alarm Reporting Function: - - o The Indeterminate severity level indicates that the - severity level cannot be determined. - - o The Critical severity level indicates that a service - affecting condition has occurred and an immediate - corrective action is required. Such a severity can be - reported, for example, when a managed object becomes - totally out of service and its capability must be restored. - - o The Major severity level indicates that a service - affecting condition has developed and an urgent corrective - action is required. Such a severity can be reported, for - example, when there is a severe degradation in the - capability of the managed object and its full capability - must be restored. - - o The Minor severity level indicates the existence of a - non-service affecting fault condition and that corrective - action should be taken in order to prevent a more serious - (for example, service affecting) fault. Such a severity - can be reported, for example, when the detected alarm - condition is not currently degrading the capacity of the - managed object. - - o The Warning severity level indicates the detection of a - potential or impending service affecting fault, before any - significant effects have been felt. Action should be taken - to further diagnose (if necessary) and correct the problem - in order to prevent it from becoming a more serious service - affecting fault. - - When an alarm is cleared, an alarmCleared event is generated. - This event clears the alarm with the currentAlarmFaultId - contained in the event. It is not required that the clearing - of previously reported alarms are reported. Therefore, a managing - system cannot assume that the absence of an alarmedCleared event - for a fault means that the condition that caused the generation - of previous alarms is still present. Managed object definers - shall state if, and under which conditions, the alarmedCleared - event is used. - - The clear value of AlarmSeverity is an action which is used when - a management station wants to clear an active alarm. This is not - possible on all systems, and thus an agent does not have support - write access for this value." - REFERENCE - "X.733, ITU Alarm Reporting Function" - SYNTAX INTEGER { - indeterminate (0), - critical (1), - major (2), - minor (3), - warning (4), - clear (5) -- Written, not read - } - -AlarmClass ::= TEXTUAL-CONVENTION - STATUS current - DESCRIPTION - "The AlarmClass type categorizes the alarm, and is - defined when the alarm is registered. It is as defined in - X.733, ITU Alarm Reporting Function: - - o communications. An alarm of this class is principally - associated with the procedures or processes required - to convey information from one point to another. - - o qos. An alarm of this class is principally associated - with a degradation in the quality of service. - - o processing. An alarm of this class is principally - associated with a software or processing fault. - - o equipment. An alarm of this class is principally - associated with an equipment fault. - - o environmental. An alarm of this class is principally - associated with a condition relating to an enclosure in - with equipment resides." - REFERENCE - "X.733, ITU Alarm Reporting Function" - SYNTAX INTEGER { - unknown (0), - communications (1), - qos (2), - processing (3), - equipment (4), - environmental (5) - } - - --- Managed Objects - -event OBJECT IDENTIFIER ::= { otpEvaMIBObjects 1 } -alarm OBJECT IDENTIFIER ::= { otpEvaMIBObjects 2 } -currentAlarm OBJECT IDENTIFIER ::= { otpEvaMIBObjects 3 } - --- The Event group --- --- The Event group controls the generation of notifications of --- events from the system. - -eventTable OBJECT-TYPE - SYNTAX SEQUENCE OF EventEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A list of events defined by the system. This table is used - to control the sending of traps and to whom the traps are - sent." - ::= { event 1 } - -eventEntry OBJECT-TYPE - SYNTAX EventEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A set of parameters that describe an event to be - generated when certain conditions are met." - INDEX { eventIndex } - ::= { eventTable 1 } - -EventEntry ::= SEQUENCE { - eventIndex Integer32 (1..2147483647), - eventTrapName DisplayString, - eventTreatment INTEGER, - eventCommunity OCTET STRING (SIZE (0..127)), - eventSentTraps Counter32, - eventOwner OwnerString - } - -eventIndex OBJECT-TYPE - SYNTAX Integer32 (1..2147483647) - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "An index that uniquely identifies an entry in the - event table. Each such entry defines one event that - is to be generated when the appropriate conditions - occur. The value for each eventIndex must remain - constant, at least from one re-initialization of the - entity's network management system to the next - re-initialization." - ::= { eventEntry 1 } - -eventTrapName OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The identifier of the corresponding trap. - NOTE: this should be an OID in SNMPv2, but must be - a string in v1." - ::= { eventEntry 2 } - -eventTreatment OBJECT-TYPE - SYNTAX INTEGER { - none(1), - log(2), - snmpTrap(3), - logAndTrap(4) - } - MAX-ACCESS read-write - STATUS current - DESCRIPTION - "Defines how the system shall treat this event. In the - case of snmpTrap, an SNMP trap is sent to one or more - management stations. In the case of log, the event is - guaranteed to be logged in a log according to some log - strategy. Each such log strategy may define a MIB module - for control and examination of logs." - ::= { eventEntry 3 } - -eventCommunity OBJECT-TYPE - SYNTAX OCTET STRING (SIZE (0..127)) - MAX-ACCESS read-write - STATUS current - DESCRIPTION - "If an SNMP trap is to be sent, it will be sent to - the SNMP community specified by this octet string." - ::= { eventEntry 4 } - -eventSentTraps OBJECT-TYPE - SYNTAX Counter32 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The number of times this event has been sent as a trap." - ::= { eventEntry 5 } - -eventOwner OBJECT-TYPE - SYNTAX OwnerString - MAX-ACCESS read-write - STATUS current - DESCRIPTION - "The manager entity that 'owns' this event entry, and is - therefore responsible for its contents." - ::= { eventEntry 6 } - -eventTime OBJECT-TYPE - SYNTAX DateAndTime - MAX-ACCESS accessible-for-notify - STATUS current - DESCRIPTION - "This object may be included in a trap definition for an event. - It specifies the time the event was generated." - ::= { event 2 } - - --- The Alarm group --- --- The Alarm group extends the Event group with objects for alarms. - -alarmTable OBJECT-TYPE - SYNTAX SEQUENCE OF AlarmEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "Contains additional information for alarm events." - ::= { alarm 1 } - -alarmEntry OBJECT-TYPE - SYNTAX AlarmEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A set of parameters for alarms." - INDEX { eventIndex } - ::= { alarmTable 1 } - -AlarmEntry ::= SEQUENCE { - alarmClass AlarmClass, - alarmSeverity AlarmSeverity - } - -alarmClass OBJECT-TYPE - SYNTAX AlarmClass - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The class of this alarm." - ::= { alarmEntry 1 } - -alarmSeverity OBJECT-TYPE - SYNTAX AlarmSeverity - MAX-ACCESS read-write - STATUS current - DESCRIPTION - "The perceived severity that shall apply to the - associated alarms." - ::= { alarmEntry 2 } - - --- The CurrentAlarm group --- --- The CurrentAlarm group is a collection of objects for monitoring of --- active alarms in the system. - -numberOfCurrentAlarms OBJECT-TYPE - SYNTAX Gauge32 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Number of currently active alarms in the system." - ::= { currentAlarm 1 } - -currentAlarmLastTimeChanged OBJECT-TYPE - SYNTAX DateAndTime - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The time an entry in the currentAlarmTable was changed. - It may be used by a management station as a value to - poll. If the value is changed, the management station - knows that the currentAlarmTable has been updated." - ::= { currentAlarm 2 } - -currentAlarmTable OBJECT-TYPE - SYNTAX SEQUENCE OF CurrentAlarmEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A list of currently active alarms in the system." - ::= { currentAlarm 3 } - -currentAlarmEntry OBJECT-TYPE - SYNTAX CurrentAlarmEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A set of parameters that describe a currently active - alarm." - INDEX { currentAlarmFaultId } - ::= { currentAlarmTable 1 } - -CurrentAlarmEntry ::= SEQUENCE { - currentAlarmFaultId Integer32 (1..2147483647), - currentAlarmEventIndex Integer32 (1..2147483647), - currentAlarmObject OBJECT IDENTIFIER, - currentAlarmCause OBJECT IDENTIFIER, - currentAlarmSeverity AlarmSeverity, - currentAlarmTime DateAndTime, - currentAlarmInformation DisplayString, - currentAlarmExtra1 OBJECT IDENTIFIER, - currentAlarmExtra2 OBJECT IDENTIFIER - } - -currentAlarmFaultId OBJECT-TYPE - SYNTAX Integer32 (1..2147483647) - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "An id that uniquely identifies a fault. Each fault is - represented as one an entry in the currentAlarmTable." - ::= { currentAlarmEntry 1 } - -currentAlarmEventIndex OBJECT-TYPE - SYNTAX Integer32 (1..2147483647) - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "A pointer into the eventTable. Points to the event - corresponding to this alarm." - ::= { currentAlarmEntry 2 } - -currentAlarmObject OBJECT-TYPE - SYNTAX OBJECT IDENTIFIER - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The alarming object." - ::= { currentAlarmEntry 3 } - -currentAlarmCause OBJECT-TYPE - SYNTAX OBJECT IDENTIFIER - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The probable cause of the alarm." - ::= { currentAlarmEntry 4 } - -currentAlarmSeverity OBJECT-TYPE - SYNTAX AlarmSeverity - MAX-ACCESS read-write - STATUS current - DESCRIPTION - "The perceived severity of the fault. A manager can set - this value to clear only. When set to clear, the alarm - is removed from this table, and a 'clearAlarm' event is - generated." - ::= { currentAlarmEntry 5 } - -currentAlarmTime OBJECT-TYPE - SYNTAX DateAndTime - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The time the fault was detected." - ::= { currentAlarmEntry 6 } - -currentAlarmInformation OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Additional information pin-pointing the problem." - ::= { currentAlarmEntry 7 } - -currentAlarmExtra1 OBJECT-TYPE - SYNTAX OBJECT IDENTIFIER - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "An extra parameter used for some alarms at their own - discretion. Can be used for example to identify - additional objects in the alarm, or instead of - currentAlarmInformation to pin-point the problem, if the - additional information is defined in some MIB." - ::= { currentAlarmEntry 8 } - -currentAlarmExtra2 OBJECT-TYPE - SYNTAX OBJECT IDENTIFIER - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "An extra parameter used for some alarms at their own - discretion. Can be used for example to identify - additional objects in the alarm, or instead of - currentAlarmInformation to pin-point the problem, if the - additional information is defined in some MIB." - ::= { currentAlarmEntry 9 } - - --- Events - -alarmCleared NOTIFICATION-TYPE - OBJECTS { - currentAlarmEventIndex, - eventTime - } - STATUS current - DESCRIPTION - "This event is sent when an alarm has been cleared, - either by the application or by an operator. Note that the - currentAlarmFaultId is implicitly sent as the instance identifier - for currentAlarmEventIndex." - ::= { otpEvaMIBEventsV2 1 } - - --- conformance information - -otpEvaMIBCompliances - OBJECT IDENTIFIER ::= { otpEvaMIBConformance 1 } -otpEvaMIBGroups - OBJECT IDENTIFIER ::= { otpEvaMIBConformance 2 } - - --- compliance statements - -otpEvaBasicCompliance MODULE-COMPLIANCE - STATUS current - DESCRIPTION - "The compliance statement for SNMPv2 entities which - implement the OTP-EVA-MIB." - MODULE -- this module - MANDATORY-GROUPS { eventGroup, - alarmGroup, - currentAlarmGroup, - evaEventsGroup } - - ::= { otpEvaMIBCompliances 1 } - - --- units of conformance - -eventGroup OBJECT-GROUP - OBJECTS { eventTrapName, - eventTreatment, - eventCommunity, - eventSentTraps, - eventOwner, - eventTime } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - and control of the events defined in the OTP system." - ::= { otpEvaMIBGroups 1 } - -alarmGroup OBJECT-GROUP - OBJECTS { alarmClass, - alarmSeverity } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - and control of the alarms defined the OTP system." - ::= { otpEvaMIBGroups 2 } - -currentAlarmGroup OBJECT-GROUP - OBJECTS { numberOfCurrentAlarms, - currentAlarmLastTimeChanged, - currentAlarmEventIndex, - currentAlarmObject, - currentAlarmCause, - currentAlarmSeverity, - currentAlarmTime, - currentAlarmInformation, - currentAlarmExtra1, - currentAlarmExtra2 } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - of the activa alarm list in the OTP system." - ::= { otpEvaMIBGroups 3 } - -evaEventsGroup NOTIFICATION-GROUP - NOTIFICATIONS { alarmCleared } - STATUS current - DESCRIPTION - "The notification which is generated from EVA." - ::= { otpEvaMIBGroups 4 } - - -END diff --git a/lib/otp_mibs/mibs/OTP-MIB.funcs b/lib/otp_mibs/mibs/OTP-MIB.funcs deleted file mode 100644 index 9f9d69c3d1..0000000000 --- a/lib/otp_mibs/mibs/OTP-MIB.funcs +++ /dev/null @@ -1,2 +0,0 @@ -{erlNodeTable, {otp_mib, erl_node_table, []}}. -{applTable, {otp_mib, appl_table, []}}. diff --git a/lib/otp_mibs/mibs/OTP-MIB.mib b/lib/otp_mibs/mibs/OTP-MIB.mib deleted file mode 100644 index 693319eae4..0000000000 --- a/lib/otp_mibs/mibs/OTP-MIB.mib +++ /dev/null @@ -1,318 +0,0 @@ --- --- %CopyrightBegin% --- --- Copyright Ericsson AB 1996-2016. 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. --- You may obtain a copy of the License at --- --- http://www.apache.org/licenses/LICENSE-2.0 --- --- Unless required by applicable law or agreed to in writing, software --- distributed under the License is distributed on an "AS IS" BASIS, --- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. --- See the License for the specific language governing permissions and --- limitations under the License. --- --- %CopyrightEnd% --- - -OTP-MIB DEFINITIONS ::= BEGIN - -IMPORTS - MODULE-IDENTITY, OBJECT-TYPE, - Counter64, Gauge32, Integer32 - FROM SNMPv2-SMI - TEXTUAL-CONVENTION, DisplayString - FROM SNMPv2-TC - MODULE-COMPLIANCE, OBJECT-GROUP - FROM SNMPv2-CONF - otpModules, otpApplications - FROM OTP-REG - ; - -otpModule MODULE-IDENTITY - LAST-UPDATED "201307160700Z" - ORGANIZATION "Ericsson" - CONTACT-INFO - "Contact: Erlang Support see license agreement for Erlang/OTP." - DESCRIPTION - "This is a MIB for a distributed OTP system, with one SNMP - agent executing at one node only. Each Erlang node in the - OTP system is represented by one row in the erlNodeTable." - - REVISION "201307160700Z" - DESCRIPTION - "Updated various types to be able to reflect larger values. - The objects erlNodeReductions, erlNodeInBytes, erlNodeOutBytes as well - as the type MilliSeconds have been updated to Counter64." - - REVISION "200305090900Z" - DESCRIPTION - "Changed CONTACT-INFO as it was outdated, made it more generic - to avoid such changes in the future." - - REVISION "199712010900Z" - DESCRIPTION - "Converted to v2 SMI and placed in the OTP tree." - - REVISION "199608191700Z" - DESCRIPTION - "The initial revision of MIB module OTP-MIB." - - ::= { otpModules 3 } - -otpMIB OBJECT IDENTIFIER ::= { otpApplications 1 } -otpMIBConformance - OBJECT IDENTIFIER ::= { otpMIB 1 } -otpMIBObjects OBJECT IDENTIFIER ::= { otpMIB 2 } - --- Datatypes - -MilliSeconds ::= TEXTUAL-CONVENTION - STATUS current - DESCRIPTION - "The MilliSeconds type represents a Counter which represents - the time, in milliseconds between two epochs. When objects - are defined which use this type, the description of the object - identifies both of the reference epochs." - SYNTAX Counter64 - - --- Managed Objects - -erlang OBJECT IDENTIFIER ::= { otpMIBObjects 1 } -appls OBJECT IDENTIFIER ::= { otpMIBObjects 2 } - -erlNodeTable OBJECT-TYPE - SYNTAX SEQUENCE OF ErlNodeEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A table with info on each erlang node in the system." - ::= { erlang 1 } - -erlNodeEntry OBJECT-TYPE - SYNTAX ErlNodeEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A conceptual row in the erlNodeTable." - INDEX { erlNodeId } - ::= { erlNodeTable 1 } - -ErlNodeEntry ::= SEQUENCE { - erlNodeId Integer32, - erlNodeName DisplayString, - erlNodeMachine DisplayString, - erlNodeVersion DisplayString, - erlNodeRunQueue Gauge32, - erlNodeRunTime MilliSeconds, - erlNodeWallClock MilliSeconds, - erlNodeReductions Counter64, - erlNodeProcesses Gauge32, - erlNodeInBytes Counter64, - erlNodeOutBytes Counter64 -} - -erlNodeId OBJECT-TYPE - SYNTAX Integer32 - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "An integer that uniquely identifies the erlang node." - ::= { erlNodeEntry 1 } - -erlNodeName OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The symbolic name of the erlang node." - ::= { erlNodeEntry 2 } - -erlNodeMachine OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The virtual machine executing the erlang node" - ::= { erlNodeEntry 3 } - -erlNodeVersion OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The version number of the virtual machine" - ::= { erlNodeEntry 4 } - -erlNodeRunQueue OBJECT-TYPE - SYNTAX Gauge32 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Number of processes scheduled to run" - ::= { erlNodeEntry 5 } - -erlNodeRunTime OBJECT-TYPE - SYNTAX MilliSeconds - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Total cpu time in milliseconds since the - system started" - ::= { erlNodeEntry 6 } - -erlNodeWallClock OBJECT-TYPE - SYNTAX MilliSeconds - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Total real time in milliseconds since the - system started" - ::= { erlNodeEntry 7 } - -erlNodeReductions OBJECT-TYPE - SYNTAX Counter64 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Number of function calls since the system started" - ::= { erlNodeEntry 8 } - -erlNodeProcesses OBJECT-TYPE - SYNTAX Gauge32 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "Number of running processes in the system." - ::= { erlNodeEntry 9 } - -erlNodeInBytes OBJECT-TYPE - SYNTAX Counter64 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The total number of bytes delivered to the system" - ::= { erlNodeEntry 10 } - -erlNodeOutBytes OBJECT-TYPE - SYNTAX Counter64 - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The total number of bytes delivered from the system" - ::= { erlNodeEntry 11 } - - -applTable OBJECT-TYPE - SYNTAX SEQUENCE OF ApplEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A table with all currently running applications - for each node." - ::= { appls 1 } - -applEntry OBJECT-TYPE - SYNTAX ApplEntry - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "A conceptual row in the applTable." - INDEX { erlNodeId, applId } - ::= { applTable 1 } - -ApplEntry ::= SEQUENCE { - applId Integer32, - applName DisplayString, - applDescr DisplayString, - applVsn DisplayString -} - -applId OBJECT-TYPE - SYNTAX Integer32 - MAX-ACCESS not-accessible - STATUS current - DESCRIPTION - "An integer that uniquely identifies the application." - ::= { applEntry 1 } - -applName OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The name of the application." - ::= { applEntry 2 } - -applDescr OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "A short description of the application." - ::= { applEntry 3 } - -applVsn OBJECT-TYPE - SYNTAX DisplayString - MAX-ACCESS read-only - STATUS current - DESCRIPTION - "The version of the application." - ::= { applEntry 4 } - - --- conformance information - -otpMIBCompliances - OBJECT IDENTIFIER ::= { otpMIBConformance 1 } -otpMIBGroups OBJECT IDENTIFIER ::= { otpMIBConformance 2 } - - --- compliance statements - -otpBasicCompliance MODULE-COMPLIANCE - STATUS current - DESCRIPTION - "The compliance statement for SNMPv2 entities which - implement the OTP-MIB." - MODULE -- this module - MANDATORY-GROUPS { erlGroup, applGroup } - - ::= { otpMIBCompliances 1 } - - --- units of conformance - -erlGroup OBJECT-GROUP - OBJECTS { erlNodeName, - erlNodeMachine, - erlNodeVersion, - erlNodeRunQueue, - erlNodeRunTime, - erlNodeWallClock, - erlNodeReductions, - erlNodeProcesses, - erlNodeInBytes, - erlNodeOutBytes } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - of the Erlang runtime system." - ::= { otpMIBGroups 1 } - -applGroup OBJECT-GROUP - OBJECTS { applName, - applDescr, - applVsn } - STATUS current - DESCRIPTION - "A collection of objects providing basic instrumentation - of the applications in the OTP system." - ::= { otpMIBGroups 2 } - - -END diff --git a/lib/otp_mibs/mibs/v1/.gitignore b/lib/otp_mibs/mibs/v1/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/mibs/v1/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/priv/bin/.gitignore b/lib/otp_mibs/priv/bin/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/priv/bin/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/priv/mibs/.gitignore b/lib/otp_mibs/priv/mibs/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/priv/mibs/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/priv/obj/.gitignore b/lib/otp_mibs/priv/obj/.gitignore deleted file mode 100644 index e69de29bb2..0000000000 --- a/lib/otp_mibs/priv/obj/.gitignore +++ /dev/null diff --git a/lib/otp_mibs/src/Makefile b/lib/otp_mibs/src/Makefile deleted file mode 100644 index 5c7af39c3f..0000000000 --- a/lib/otp_mibs/src/Makefile +++ /dev/null @@ -1,106 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 2003-2016. 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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk - -ifeq ($(TYPE),debug) -ERL_COMPILE_FLAGS += -Ddebug -W -endif - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Application version -# ---------------------------------------------------- -include ../vsn.mk -VSN=$(OTP_MIBS_VSN) - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/lib/otp_mibs-$(VSN) -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- -MODULES = \ - otp_mib - -INCLUDE=../include - -HRL_FILES = - -INTERNAL_HRL_FILES = - -ERL_FILES = $(MODULES:%=%.erl) - -APP_FILE = otp_mibs.app -APP_SRC = $(APP_FILE).src -APP_TARGET = $(EBIN)/$(APP_FILE) - -APPUP_FILE = otp_mibs.appup -APPUP_SRC = $(APPUP_FILE).src -APPUP_TARGET = $(EBIN)/$(APPUP_FILE) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -TARGETS = $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_COMPILE_FLAGS += -I$(INCLUDE) - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -debug opt: $(TARGETS) - -clean: - rm -f $(TARGET_FILES) - rm -f $(APP_TARGET) - rm -f $(APPUP_TARGET) - rm -f core - -docs: - -# ---------------------------------------------------- -# Special Build Targets -# ---------------------------------------------------- - -$(APP_TARGET): $(APP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -$(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk - $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: opt - $(INSTALL_DIR) "$(RELSYSDIR)/src" - $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)/src" - $(INSTALL_DIR) "$(RELSYSDIR)/ebin" - $(INSTALL_DATA) $(TARGETS) "$(RELSYSDIR)/ebin" - -release_docs_spec: - - diff --git a/lib/otp_mibs/src/otp_mib.erl b/lib/otp_mibs/src/otp_mib.erl deleted file mode 100644 index ca868f2817..0000000000 --- a/lib/otp_mibs/src/otp_mib.erl +++ /dev/null @@ -1,219 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_mib). -%%%----------------------------------------------------------------- -%%% Description: This module implements the OTP-MIB. -%%% The tables are implemented as shadow tables with the module -%%% snmp_shadow_table. -%%%----------------------------------------------------------------- - -%% API --export([load/1, unload/1]). - -%% SNMP instrumentation --export([erl_node_table/1, erl_node_table/3, appl_table/1, appl_table/3]). - -%% SNMP shadow functions --export([update_erl_node_table/0, update_appl_table/0]). - -%% Exported for internal use via rpc --export([get_erl_node/1, get_appls/1]). - --deprecated([{load,1,eventually}, - {unload,1,eventually}]). - -%% Shadow tables --record(erlNodeTable, - {erlNodeId, erlNodeName, erlNodeMachine, erlNodeVersion, - erlNodeRunQueue, - erlNodeRunTime, erlNodeWallClock, erlNodeReductions, - erlNodeProcesses, erlNodeInBytes, erlNodeOutBytes}). - --record(applTable, {key = '_', applName = '_', applDescr = '_', - applVsn = '_'}). - -%% Shadow argument macros --define(erlNodeShadowArgs, - {erlNodeTable, integer, record_info(fields, erlNodeTable), 5000, - fun otp_mib:update_erl_node_table/0}). - --define(applShadowArgs, - {applTable, {integer, integer}, record_info(fields, applTable), - 5000, fun otp_mib:update_appl_table/0}). - -%% Misc --record(erlNodeAlloc, {nodeName, nodeId}). - -%%%========================================================================= -%%% API -%%%========================================================================= - -%%------------------------------------------------------------------------- -%% load(Agent) -> ok | {error, Reason} -%% Agent - pid() | atom() -%% Reason - term() -%% Description: Loads the OTP-MIB -%%------------------------------------------------------------------------- -load(Agent) -> - MibDir = code:priv_dir(otp_mibs) ++ "/mibs", - snmpa:load_mibs(Agent, [MibDir ++ "/OTP-MIB"]). - -%%------------------------------------------------------------------------- -%% unload(Agent) -> ok | {error, Reason} -%% Agent - pid() | atom() -%% Reason - term() -%% Description: Loads the OTP-MIB -%%------------------------------------------------------------------------- -unload(Agent) -> - snmpa:unload_mibs(Agent, ["OTP-MIB"]). - - -%%%========================================================================= -%%% SNMP instrumentation -%%%========================================================================= -erl_node_table(new) -> - Tab = erlNodeAlloc, - Storage = ram_copies, - case lists:member(Tab, mnesia:system_info(tables)) of - true -> - case mnesia:table_info(Tab, storage_type) of - unknown -> - {atomic, ok} = mnesia:add_table_copy(Tab, node(), Storage); - Storage -> - catch delete_all(Tab) - end; - false -> - Nodes = [node()], - Props = [{type, set}, - {attributes, record_info(fields, erlNodeAlloc)}, - {local_content, true}, - {Storage, Nodes}], - {atomic, ok} = mnesia:create_table(Tab, Props) - end, - ok = mnesia:dirty_write({erlNodeAlloc, next_index, 1}), - update_node_alloc([node() | nodes()]), - snmp_shadow_table:table_func(new, ?erlNodeShadowArgs). - -erl_node_table(Op, RowIndex, Cols) -> - snmp_shadow_table:table_func(Op, RowIndex, Cols, ?erlNodeShadowArgs). - - -appl_table(Op) -> - snmp_shadow_table:table_func(Op, ?applShadowArgs). -appl_table(Op, RowIndex, Cols) -> - snmp_shadow_table:table_func(Op, RowIndex, Cols, ?applShadowArgs). - - -%%%========================================================================= -%%% SNMP shadow functions -%%%========================================================================= -update_erl_node_table() -> - delete_all(erlNodeTable), - Nodes = [node() | nodes()], - update_node_alloc(Nodes), - lists:foreach( - fun(Node) -> - [{_,_,Idx}] = mnesia:dirty_read({erlNodeAlloc, Node}), - ErlNode = rpc:call(Node, otp_mib, get_erl_node, [Idx]), - ok = mnesia:dirty_write(ErlNode) - end, Nodes). - -update_appl_table() -> - delete_all(applTable), - Nodes = [node() | nodes()], - update_node_alloc(Nodes), - lists:foreach( - fun(Node) -> - [{_,_,Idx}] = mnesia:dirty_read({erlNodeAlloc, Node}), - Appls = rpc:call(Node, otp_mib, get_appls, [Idx]), - lists:foreach(fun(Appl) -> - ok = mnesia:dirty_write(Appl) - end, Appls) - end, Nodes). - -%%%======================================================================== -%%% Exported for internal use via rpc -%%%======================================================================== -get_erl_node(Id) -> - RunQueue = erlang:statistics(run_queue), - RunTime = element(1, erlang:statistics(runtime)), - WallClock = element(1, erlang:statistics(wall_clock)), - Reductions = element(1, erlang:statistics(reductions)), - Processes = length(processes()), - IO = erlang:statistics(io), - InBytes = element(2, element(1, IO)), - OutBytes = element(2, element(2, IO)), - #erlNodeTable{erlNodeId = truncate_int('Integer32', Id), - erlNodeName = atom_to_list(node()), - erlNodeVersion = erlang:system_info(version), - erlNodeMachine = erlang:system_info(machine), - erlNodeRunQueue = truncate_int('Unsigned32', RunQueue), - erlNodeRunTime = truncate_int('Counter64', RunTime), - erlNodeWallClock = truncate_int('Counter64', WallClock), - erlNodeReductions = truncate_int('Counter64', Reductions), - erlNodeProcesses = truncate_int('Unsigned32', Processes), - erlNodeInBytes = truncate_int('Counter64', InBytes), - erlNodeOutBytes = truncate_int('Counter64', OutBytes)}. - -get_appls(NodeId) -> - element(1, - lists:mapfoldl( - fun({ApplName, ApplDescr, ApplVsn}, ApplId) -> - {#applTable{key = {NodeId, ApplId}, - applName = atom_to_list(ApplName), - applDescr = ApplDescr, - applVsn = ApplVsn}, - ApplId + 1} - end, 1, application:which_applications())). - -%%%======================================================================== -%%% Internal functions -%%%======================================================================== -update_node_alloc([Node | T]) -> - case mnesia:dirty_read({erlNodeAlloc, Node}) of - [] -> - [{_, _, Idx}] = mnesia:dirty_read({erlNodeAlloc, next_index}), - ok = mnesia:dirty_write(#erlNodeAlloc{nodeName = Node, - nodeId = Idx}), - ok = mnesia:dirty_write({erlNodeAlloc, next_index, Idx + 1}); - _ -> - ok - end, - update_node_alloc(T); -update_node_alloc([]) -> ok. - -delete_all(Name) -> delete_all(mnesia:dirty_first(Name), Name). -delete_all('$end_of_table', _Name) -> done; -delete_all(Key, Name) -> - Next = mnesia:dirty_next(Name, Key), - ok = mnesia:dirty_delete({Name, Key}), - delete_all(Next, Name). - -%% This will return a value limited to fit into the specified type. -%% While counter types will be resetted, other integer types will -%% only be restricted to the valid range. -truncate_int('Counter64', Value) when Value < 0 -> 0; -truncate_int('Counter64', Value) -> Value rem 18446744073709551615; -truncate_int('Unsigned32', Value) when Value < 0 -> 0; -truncate_int('Unsigned32', Value) when Value > 4294967295 -> 4294967295; -truncate_int('Unsigned32', Value) -> Value; -truncate_int('Integer32', Value) when Value < -2147483648 -> -2147483648; -truncate_int('Integer32', Value) when Value > 2147483647 -> 2147483647; -truncate_int('Integer32', Value) -> Value. diff --git a/lib/otp_mibs/src/otp_mibs.app.src b/lib/otp_mibs/src/otp_mibs.app.src deleted file mode 100644 index 75ef25c366..0000000000 --- a/lib/otp_mibs/src/otp_mibs.app.src +++ /dev/null @@ -1,30 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2016. 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - -{application, otp_mibs, - [{description, "SNMP managment information base for Erlang/OTP nodes."}, - {vsn, "%VSN%"}, - {modules, [otp_mib]}, - {registered, []}, - {applications, [kernel, stdlib, snmp]}, - {env,[]}, - {runtime_dependencies, ["stdlib-2.0","snmp-4.25.1","mnesia-4.12", - "kernel-3.0","erts-6.0"]}]}. - diff --git a/lib/otp_mibs/test/Makefile b/lib/otp_mibs/test/Makefile deleted file mode 100644 index 9736cf8bce..0000000000 --- a/lib/otp_mibs/test/Makefile +++ /dev/null @@ -1,85 +0,0 @@ -# -# %CopyrightBegin% -# -# Copyright Ericsson AB 1997-2016. 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. -# You may obtain a copy of the License at -# -# http://www.apache.org/licenses/LICENSE-2.0 -# -# Unless required by applicable law or agreed to in writing, software -# distributed under the License is distributed on an "AS IS" BASIS, -# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -# See the License for the specific language governing permissions and -# limitations under the License. -# -# %CopyrightEnd% -# -include $(ERL_TOP)/make/target.mk - -include $(ERL_TOP)/make/$(TARGET)/otp.mk - -# ---------------------------------------------------- -# Target Specs -# ---------------------------------------------------- - -MODULES= otp_mibs_SUITE - -EBIN = . - -HRL_FILES= - -ERL_FILES= $(MODULES:%=%.erl) - -TARGET_FILES = $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -SOURCE = $(ERL_FILES) $(HRL_FILES) - -EMAKEFILE=Emakefile - -# ---------------------------------------------------- -# Release directory specification -# ---------------------------------------------------- -RELSYSDIR = $(RELEASE_PATH)/otp_mibs_test - -# ---------------------------------------------------- -# FLAGS -# ---------------------------------------------------- -ERL_MAKE_FLAGS += -ERL_COMPILE_FLAGS += \ - -I$(ERL_TOP)/lib/snmp/include - -# ---------------------------------------------------- -# Targets -# ---------------------------------------------------- - -make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES)\ - > $(EMAKEFILE) - -tests debug opt: make_emakefile - erl $(ERL_MAKE_FLAGS) -make - -clean: - rm -f $(EMAKEFILE) - rm -f $(TARGET_FILES) - rm -f core *~ - -docs: - - -# ---------------------------------------------------- -# Release Target -# ---------------------------------------------------- -include $(ERL_TOP)/make/otp_release_targets.mk - -release_spec: - -release_tests_spec: make_emakefile - $(INSTALL_DIR) "$(RELSYSDIR)" - $(INSTALL_DATA) $(EMAKEFILE) $(SOURCE) "$(RELSYSDIR)" - $(INSTALL_DATA) otp_mibs_SUITE.cfg "$(RELSYSDIR)" - -release_docs_spec: diff --git a/lib/otp_mibs/test/otp_mibs_SUITE.cfg b/lib/otp_mibs/test/otp_mibs_SUITE.cfg deleted file mode 100644 index d01cf92104..0000000000 --- a/lib/otp_mibs/test/otp_mibs_SUITE.cfg +++ /dev/null @@ -1,15 +0,0 @@ -%% -*- erlang -*- -{snmp, - [ - {start_agent,true}, - {users, - [ - {otp_mibs_test,[snmpm_user_default,[]]} - ]}, - {managed_agents, - [ - {otp_mibs_test, [otp_mibs_test, {127,0,0,1}, 4000, []]} - ]}, - {agent_sysname,"Test otp_mibs"}, - {mgr_port,5001} - ]}. diff --git a/lib/otp_mibs/test/otp_mibs_SUITE.erl b/lib/otp_mibs/test/otp_mibs_SUITE.erl deleted file mode 100644 index cb3cd28200..0000000000 --- a/lib/otp_mibs/test/otp_mibs_SUITE.erl +++ /dev/null @@ -1,255 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. 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. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(otp_mibs_SUITE). - -%%----------------------------------------------------------------- -%% This suite can no longer be executed standalone, i.e. it must be -%% executed with common test. The reason is that ct_snmp is used -%% instead of the snmp application directly. The suite requires a -%% config file, otp_mibs_SUITE.cfg, found in the same directory as -%% the suite. -%% -%% Execute with: -%% > ct_run -suite otp_mibs_SUITE -config otp_mibs_SUITE.cfg -%%----------------------------------------------------------------- - --include_lib("common_test/include/ct.hrl"). --include_lib("otp_mibs/include/OTP-MIB.hrl"). --include_lib("snmp/include/snmp_types.hrl"). - -% Test server specific exports --export([all/0, - suite/0, - groups/0, - init_per_group/2, - end_per_group/2, - init_per_suite/1, - end_per_suite/1, - init_per_testcase/2, - end_per_testcase/2]). - -% Test cases must be exported. --export([app/1, appup/1, nt_basic_types/1, nt_high_reduction_count/1]). - --define(TRAP_UDP, 5000). --define(AGENT_UDP, 4000). --define(CONF_FILE_VER, [v2]). --define(SYS_NAME, "Test otp_mibs"). --define(MAX_MSG_SIZE, 484). --define(ENGINE_ID, "mgrEngine"). --define(MGR_PORT, 5001). - -%% Since some cases are only interested in single entries of the OTP-MIB's -%% node table, one row must be chosen. The first row should be sufficient -%% for this. --define(NODE_ENTRY, 1). - -%%--------------------------------------------------------------------- -%% CT setup -%%--------------------------------------------------------------------- - -init_per_testcase(_Case, Config) when is_list(Config) -> - Dog = test_server:timetrap(test_server:minutes(6)), - [{watchdog, Dog}|Config]. - -end_per_testcase(_Case, Config) when is_list(Config) -> - Dog = ?config(watchdog, Config), - test_server:timetrap_cancel(Dog), - Config. - -suite() -> [{ct_hooks,[ts_install_cth]}, {require, snmp_mgr_agent, snmp}]. - -all() -> [{group, app}, {group, node_table}]. - -groups() -> [{app, [], [app, appup]}, - {node_table, [], [nt_basic_types, nt_high_reduction_count]}]. - -init_per_group(_GroupName, Config) -> Config. - -end_per_group(_GroupName, Config) -> Config. - -init_per_suite(Config) -> - ?line application:start(sasl), - ?line application:start(mnesia), - ?line application:start(otp_mibs), - - ok = ct_snmp:start(Config,snmp_mgr_agent), - - %% Load the mibs that should be tested - otp_mib:load(snmp_master_agent), - - Config. - -end_per_suite(Config) -> - PrivDir = ?config(priv_dir, Config), - ConfDir = filename:join(PrivDir,"conf"), - DbDir = filename:join(PrivDir,"db"), - MgrDir = filename:join(PrivDir, "mgr"), - - %% Uload mibs - otp_mib:unload(snmp_master_agent), - - %% Clean up - application:stop(snmp), - application:stop(mnesia), - application:stop(otp_mibs), - - del_dir(ConfDir), - del_dir(DbDir), - (catch del_dir(MgrDir)), - ok. - -%%--------------------------------------------------------------------- -%% Test cases -%%--------------------------------------------------------------------- - -%% Test that the otp_mibs app file is ok -app(Config) when is_list(Config) -> - ok = ?t:app_test(otp_mibs). - -%% Test that the otp_mibs appup file is ok -appup(Config) when is_list(Config) -> - ok = ?t:appup_test(otp_mibs). - -nt_basic_types(suite) -> - []; -nt_basic_types(doc) -> - ["Query every item of the node table and check its variable " - "type and content for sensible values."]; -nt_basic_types(Config) when is_list(Config) -> - ok = otp_mib:update_erl_node_table(), - - NodeNameId = ?erlNodeEntry ++ [?erlNodeName, ?NODE_ENTRY], - {noError, 0, [NodeNameVal]} = snmp_get([NodeNameId]), - #varbind{variabletype = 'OCTET STRING'} = NodeNameVal, - true = is_list(NodeNameVal#varbind.value), - - NodeMachineId = ?erlNodeEntry ++ [?erlNodeMachine, ?NODE_ENTRY], - {noError, 0, [NodeMachineVal]} = snmp_get([NodeMachineId]), - #varbind{variabletype = 'OCTET STRING'} = NodeMachineVal, - true = is_list(NodeMachineVal#varbind.value), - - NodeVersionId = ?erlNodeEntry ++ [?erlNodeVersion, ?NODE_ENTRY], - {noError, 0, [NodeVersionVal]} = snmp_get([NodeVersionId]), - #varbind{variabletype = 'OCTET STRING'} = NodeVersionVal, - true = is_list(NodeVersionVal#varbind.value), - - NodeRunQueueId = ?erlNodeEntry ++ [?erlNodeRunQueue, ?NODE_ENTRY], - {noError, 0, [NodeRunQueueVal]} = snmp_get([NodeRunQueueId]), - #varbind{variabletype = 'Unsigned32'} = NodeRunQueueVal, - true = is_integer(NodeRunQueueVal#varbind.value), - NodeRunQueueVal#varbind.value >= 0, - NodeRunQueueVal#varbind.value =< 4294967295, - - NodeRunTimeId = ?erlNodeEntry ++ [?erlNodeRunTime, ?NODE_ENTRY], - {noError, 0, [NodeRunTimeVal]} = snmp_get([NodeRunTimeId]), - #varbind{variabletype = 'Counter64'} = NodeRunTimeVal, - true = is_integer(NodeRunTimeVal#varbind.value), - NodeRunTimeVal#varbind.value >= 0, - NodeRunTimeVal#varbind.value =< 18446744073709551615, - - NodeWallClockId = ?erlNodeEntry ++ [?erlNodeWallClock, ?NODE_ENTRY], - {noError, 0, [NodeWallClockVal]} = snmp_get([NodeWallClockId]), - #varbind{variabletype = 'Counter64'} = NodeWallClockVal, - true = is_integer(NodeWallClockVal#varbind.value), - NodeWallClockVal#varbind.value >= 0, - NodeWallClockVal#varbind.value =< 18446744073709551615, - - NodeReductionsId = ?erlNodeEntry ++ [?erlNodeReductions, ?NODE_ENTRY], - {noError, 0, [NodeReductionsVal]} = snmp_get([NodeReductionsId]), - #varbind{variabletype = 'Counter64'} = NodeReductionsVal, - true = is_integer(NodeReductionsVal#varbind.value), - NodeReductionsVal#varbind.value >= 0, - NodeReductionsVal#varbind.value =< 18446744073709551615, - - NodeProcessesId = ?erlNodeEntry ++ [?erlNodeProcesses, ?NODE_ENTRY], - {noError, 0, [NodeProcessesVal]} = snmp_get([NodeProcessesId]), - #varbind{variabletype = 'Unsigned32'} = NodeProcessesVal, - true = is_integer(NodeProcessesVal#varbind.value), - NodeProcessesVal#varbind.value >= 0, - NodeProcessesVal#varbind.value =< 4294967295, - - NodeInBytesId = ?erlNodeEntry ++ [?erlNodeInBytes, ?NODE_ENTRY], - {noError, 0, [NodeInBytesVal]} = snmp_get([NodeInBytesId]), - #varbind{variabletype = 'Counter64'} = NodeInBytesVal, - true = is_integer(NodeInBytesVal#varbind.value), - NodeInBytesVal#varbind.value >= 0, - NodeInBytesVal#varbind.value =< 18446744073709551615, - - NodeOutBytesId = ?erlNodeEntry ++ [?erlNodeOutBytes, ?NODE_ENTRY], - {noError, 0, [NodeOutBytesVal]} = snmp_get([NodeOutBytesId]), - #varbind{variabletype = 'Counter64'} = NodeOutBytesVal, - true = is_integer(NodeOutBytesVal#varbind.value), - NodeOutBytesVal#varbind.value >= 0, - NodeOutBytesVal#varbind.value =< 18446744073709551615, - - ok. - -nt_high_reduction_count(suite) -> - []; -nt_high_reduction_count(doc) -> - ["Check that no error occurs when the erlNodeReductions field" - "exceeds the 32bit boundary, this may take about 10min."]; -nt_high_reduction_count(Config) when is_list(Config) -> - NodeReductions = ?erlNodeEntry ++ [?erlNodeReductions, ?NODE_ENTRY], - - BumpFun = fun(F, Limit) -> - case erlang:statistics(reductions) of - {Total, _} when Total < Limit -> - F(F, Limit); - _ -> - ok - end - end, - - ok = otp_mib:update_erl_node_table(), - - {noError, 0, [StartVal]} = snmp_get([NodeReductions]), - #varbind{variabletype = 'Counter64'} = StartVal, - true = is_integer(StartVal#varbind.value), - StartVal#varbind.value >= 0, - case StartVal#varbind.value =< 4294967295 of - true -> - ok = otp_mib:update_erl_node_table(), - BumpFun(BumpFun, 4294967295), - {noError, 0, [EndVal]} = snmp_get([NodeReductions]), - #varbind{variabletype = 'Counter64'} = EndVal, - true = is_integer(EndVal#varbind.value), - EndVal#varbind.value >= 4294967295, - EndVal#varbind.value =< 18446744073709551615; - false -> - %% no need to bump more reductions, since the initial get - %% command already returned successfully with a large value - ok - end. - -%%--------------------------------------------------------------------- -%% Internal functions -%%--------------------------------------------------------------------- - -snmp_get(OIdList) -> - ct_snmp:get_values(otp_mibs_test, OIdList, snmp_mgr_agent). - -del_dir(Dir) -> - io:format("Deleting: ~s~n",[Dir]), - {ok, Files} = file:list_dir(Dir), - FullPathFiles = lists:map(fun(File) -> filename:join(Dir, File) end, Files), - lists:foreach(fun file:delete/1, FullPathFiles), - file:del_dir(Dir). diff --git a/lib/otp_mibs/vsn.mk b/lib/otp_mibs/vsn.mk deleted file mode 100644 index 1b0444afcd..0000000000 --- a/lib/otp_mibs/vsn.mk +++ /dev/null @@ -1,5 +0,0 @@ -OTP_MIBS_VSN = 1.2.1 - -# Note: The branch 'otp_mibs' is defunct as of otp_mibs-1.0.4 and -# should NOT be used again. - diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1 index 37196bb9bf..9bcd99fba3 100644 --- a/lib/public_key/asn1/OTP-PKIX.asn1 +++ b/lib/public_key/asn1/OTP-PKIX.asn1 @@ -326,8 +326,13 @@ PublicKeyAlgorithm ::= SEQUENCE { OPTIONAL } SupportedSignatureAlgorithms SIGNATURE-ALGORITHM-CLASS ::= { - dsa-with-sha1 | dsaWithSHA1 | md2-with-rsa-encryption | - md5-with-rsa-encryption | sha1-with-rsa-encryption | sha-1with-rsa-encryption | + dsa-with-sha1 | dsaWithSHA1 | + dsa-with-sha224 | + dsa-with-sha256 | + md2-with-rsa-encryption | + md5-with-rsa-encryption | + sha1-with-rsa-encryption | + sha-1with-rsa-encryption | sha224-with-rsa-encryption | sha256-with-rsa-encryption | sha384-with-rsa-encryption | @@ -368,6 +373,21 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= { ID id-dsaWithSHA1 TYPE DSAParams } + dsa-with-sha224 SIGNATURE-ALGORITHM-CLASS ::= { + ID id-dsa-with-sha224 + TYPE DSAParams } + + dsa-with-sha256 SIGNATURE-ALGORITHM-CLASS ::= { + ID id-dsa-with-sha256 + TYPE DSAParams } + + id-dsa-with-sha224 OBJECT IDENTIFIER ::= { + joint-iso-ccitt(2) country(16) us(840) organization(1) gov(101) + csor(3) algorithms(4) id-dsa-with-sha2(3) 1 } + + id-dsa-with-sha256 OBJECT IDENTIFIER ::= { + joint-iso-ccitt(2) country(16) us(840) organization(1) gov(101) + csor(3) algorithms(4) id-dsa-with-sha2(3) 2 } -- -- RSA Keys and Signatures -- diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml index 62b4b4ca1b..7ed60ed3ca 100644 --- a/lib/public_key/doc/src/notes.xml +++ b/lib/public_key/doc/src/notes.xml @@ -35,6 +35,22 @@ <file>notes.xml</file> </header> +<section><title>Public_Key 1.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add DSA SHA2 oids in public_keys ASN1-spec and + public_key:pkix_sign_types/1</p> + <p> + Own Id: OTP-15367</p> + </item> + </list> + </section> + +</section> + <section><title>Public_Key 1.6.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 1b588018e4..9523a3b7c2 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -109,6 +109,13 @@ </datatype> <datatype> + <name name="ed_public_key"/> + <desc> + <warning><p>This format of the EdDSA curves is temporary and may change without prior notice!</p></warning> + </desc> + </datatype> + + <datatype> <name name="private_key"/> <name name="rsa_private_key"/> <name name="dsa_private_key"/> @@ -118,6 +125,14 @@ </datatype> <datatype> + <name name="ed_private_key"/> + <desc> + <warning><p>This format of the EdDSA curves is temporary and may change without prior notice!</p></warning> + </desc> + </datatype> + + + <datatype> <name name="key_params"/> <desc> </desc> diff --git a/lib/public_key/src/pubkey_pem.erl b/lib/public_key/src/pubkey_pem.erl index b92790554f..d7e5bc3ad8 100644 --- a/lib/public_key/src/pubkey_pem.erl +++ b/lib/public_key/src/pubkey_pem.erl @@ -222,7 +222,9 @@ pem_start('CertificateList') -> pem_start('EcpkParameters') -> <<"-----BEGIN EC PARAMETERS-----">>; pem_start('ECPrivateKey') -> - <<"-----BEGIN EC PRIVATE KEY-----">>. + <<"-----BEGIN EC PRIVATE KEY-----">>; +pem_start({no_asn1, new_openssh}) -> %% Temporarily in the prototype of this format + <<"-----BEGIN OPENSSH PRIVATE KEY-----">>. pem_end(<<"-----BEGIN CERTIFICATE-----">>) -> <<"-----END CERTIFICATE-----">>; @@ -250,6 +252,8 @@ pem_end(<<"-----BEGIN EC PARAMETERS-----">>) -> <<"-----END EC PARAMETERS-----">>; pem_end(<<"-----BEGIN EC PRIVATE KEY-----">>) -> <<"-----END EC PRIVATE KEY-----">>; +pem_end(<<"-----BEGIN OPENSSH PRIVATE KEY-----">>) -> + <<"-----END OPENSSH PRIVATE KEY-----">>; pem_end(_) -> undefined. @@ -278,7 +282,10 @@ asn1_type(<<"-----BEGIN X509 CRL-----">>) -> asn1_type(<<"-----BEGIN EC PARAMETERS-----">>) -> 'EcpkParameters'; asn1_type(<<"-----BEGIN EC PRIVATE KEY-----">>) -> - 'ECPrivateKey'. + 'ECPrivateKey'; +asn1_type(<<"-----BEGIN OPENSSH PRIVATE KEY-----">>) -> + {no_asn1, new_openssh}. %% Temporarily in the prototype of this format + pem_decrypt() -> <<"Proc-Type: 4,ENCRYPTED">>. diff --git a/lib/public_key/src/pubkey_ssh.erl b/lib/public_key/src/pubkey_ssh.erl index 02c061efc9..d0ef4abfb1 100644 --- a/lib/public_key/src/pubkey_ssh.erl +++ b/lib/public_key/src/pubkey_ssh.erl @@ -25,7 +25,8 @@ -export([decode/2, encode/2, dh_gex_group/4, - dh_gex_group_sizes/0 + dh_gex_group_sizes/0, +pad/2, new_openssh_encode/1, new_openssh_decode/1 % For test and experiments ]). -define(UINT32(X), X:32/unsigned-big-integer). @@ -67,6 +68,8 @@ decode(Bin, rfc4716_public_key) -> rfc4716_decode(Bin); decode(Bin, ssh2_pubkey) -> ssh2_pubkey_decode(Bin); +decode(Bin, new_openssh) -> + new_openssh_decode(Bin); decode(Bin, Type) -> openssh_decode(Bin, Type). @@ -177,6 +180,70 @@ join_entry([Line | Lines], Entry) -> rfc4716_pubkey_decode(BinKey) -> ssh2_pubkey_decode(BinKey). +%% From https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.key +new_openssh_decode(<<"openssh-key-v1",0, + ?DEC_BIN(CipherName, _L1), + ?DEC_BIN(KdfName, _L2), + ?DEC_BIN(KdfOptions, _L3), + ?UINT32(N), % number of keys + ?DEC_BIN(PublicKey, _L4), + ?DEC_BIN(Encrypted, _L5), + _Rest/binary + >>) -> + %%io:format("CipherName = ~p~nKdfName = ~p~nKdfOptions = ~p~nPublicKey = ~p~nN = ~p~nEncrypted = ~p~nRest = ~p~n", [CipherName, KdfName, KdfOptions, PublicKey, N, Encrypted, _Rest]), + new_openssh_decode(CipherName, KdfName, KdfOptions, PublicKey, N, Encrypted). + +new_openssh_decode(<<"none">>, <<"none">>, <<"">>, _PublicKey, 1, + <<?UINT32(CheckInt), + ?UINT32(CheckInt), + ?DEC_BIN(Type, _Lt), + ?DEC_BIN(PubKey, _Lpu), + ?DEC_BIN(PrivPubKey, _Lpripub), + ?DEC_BIN(_Comment, _C1), + _Pad/binary>>) -> + case {Type,PrivPubKey} of + {<<"ssh-ed25519">>, + <<PrivKey:32/binary, PubKey:32/binary>>} -> + {ed_pri, ed25519, PubKey, PrivKey}; + + {<<"ssh-ed448">>, + <<PrivKey:57/binary, PubKey/binary>>} -> % "Intelligent" guess from + % https://tools.ietf.org/html/draft-ietf-curdle-ssh-ed25519-ed448 + {ed_pri, ed448, PubKey, PrivKey} + end. + + +new_openssh_encode({ed_pri,_,PubKey,PrivKey}=Key) -> + Type = key_type(Key), + CheckInt = 17*256+17, %crypto:strong_rand_bytes(4), + Comment = <<>>, + PublicKey = <<?STRING(Type),?STRING(PubKey)>>, + CipherName = <<"none">>, + KdfName = <<"none">>, + KdfOptions = <<>>, + BlockSize = 8, % Crypto dependent + NumKeys = 1, + Encrypted0 = <<?UINT32(CheckInt), + ?UINT32(CheckInt), + ?STRING(Type), + ?STRING(PubKey), + ?STRING(<<PrivKey/binary,PubKey/binary>>), + ?STRING(Comment) + >>, + Pad = pad(size(Encrypted0), BlockSize), + Encrypted = <<Encrypted0/binary, Pad/binary>>, + <<"openssh-key-v1",0, + ?STRING(CipherName), + ?STRING(KdfName), + ?STRING(KdfOptions), + ?UINT32(NumKeys), + ?STRING(PublicKey), + ?STRING(Encrypted)>>. + +pad(N, BlockSize) when N>BlockSize -> pad(N rem BlockSize, BlockSize); +pad(N, BlockSize) -> list_to_binary(lists:seq(1,BlockSize-N)). + + openssh_decode(Bin, FileType) -> Lines = binary:split(Bin, <<"\n">>, [global]), do_openssh_decode(FileType, Lines, []). @@ -235,6 +302,8 @@ do_openssh_decode(openssh_public_key = FileType, [Line | Lines], Acc) -> <<"ssh-rsa">> -> true; <<"ssh-dss">> -> true; <<"ecdsa-sha2-",Curve/binary>> -> is_ssh_curvename(Curve); + <<"ssh-ed25519">> -> true; + <<"ssh-ed448">> -> true; _ -> false end, @@ -247,7 +316,9 @@ do_openssh_decode(openssh_public_key = FileType, [Line | Lines], Acc) -> Comment = string:strip(string_decode(iolist_to_binary(Comment0)), right, $\n), do_openssh_decode(FileType, Lines, [{openssh_pubkey_decode(KeyType, Base64Enc), - [{comment, Comment}]} | Acc]) + [{comment, Comment}]} | Acc]); + _ when KnownKeyType==false -> + do_openssh_decode(FileType, Lines, Acc) end. @@ -386,6 +457,10 @@ line_end(Comment) -> key_type(#'RSAPublicKey'{}) -> <<"ssh-rsa">>; key_type({_, #'Dss-Parms'{}}) -> <<"ssh-dss">>; +key_type({ed_pub,ed25519,_}) -> <<"ssh-ed25519">>; +key_type({ed_pub,ed448,_}) -> <<"ssh-ed448">>; +key_type({ed_pri,ed25519,_,_}) -> <<"ssh-ed25519">>; +key_type({ed_pri,ed448,_,_}) -> <<"ssh-ed448">>; key_type({#'ECPoint'{}, {namedCurve,Curve}}) -> <<"ecdsa-sha2-", (public_key:oid2ssh_curvename(Curve))/binary>>. comma_list_encode([Option], []) -> @@ -404,7 +479,12 @@ ssh2_pubkey_encode({Y, #'Dss-Parms'{p = P, q = Q, g = G}}) -> <<?STRING(<<"ssh-dss">>), ?Empint(P), ?Empint(Q), ?Empint(G), ?Empint(Y)>>; ssh2_pubkey_encode(Key={#'ECPoint'{point = Q}, {namedCurve,OID}}) -> Curve = public_key:oid2ssh_curvename(OID), - <<?STRING(key_type(Key)), ?Estring(Curve), ?Estring(Q)>>. + <<?STRING(key_type(Key)), ?Estring(Curve), ?Estring(Q)>>; +ssh2_pubkey_encode({ed_pub, ed25519, Key}) -> + <<?STRING(<<"ssh-ed25519">>), ?Estring(Key)>>; +ssh2_pubkey_encode({ed_pub, ed448, Key}) -> + <<?STRING(<<"ssh-ed448">>), ?Estring(Key)>>. + ssh2_pubkey_decode(<<?DEC_BIN(Type,_TL), Bin/binary>>) -> @@ -430,12 +510,23 @@ ssh2_pubkey_decode(<<"ssh-dss">>, ssh2_pubkey_decode(<<"ecdsa-sha2-",Id/binary>>, <<?DEC_BIN(Id, _IL), ?DEC_BIN(Q, _QL)>>) -> - {#'ECPoint'{point = Q}, {namedCurve,public_key:ssh_curvename2oid(Id)}}. + {#'ECPoint'{point = Q}, {namedCurve,public_key:ssh_curvename2oid(Id)}}; + +ssh2_pubkey_decode(<<"ssh-ed25519">>, + <<?DEC_BIN(Key, _L)>>) -> + {ed_pub, ed25519, Key}; + +ssh2_pubkey_decode(<<"ssh-ed448">>, + <<?DEC_BIN(Key, _L)>>) -> + {ed_pub, ed448, Key}. + is_key_field(<<"ssh-dss">>) -> true; is_key_field(<<"ssh-rsa">>) -> true; +is_key_field(<<"ssh-ed25519">>) -> true; +is_key_field(<<"ssh-ed448">>) -> true; is_key_field(<<"ecdsa-sha2-",Id/binary>>) -> is_ssh_curvename(Id); is_key_field(_) -> false. diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl index 3f609ce6c6..75d40d2e8a 100644 --- a/lib/public_key/src/public_key.erl +++ b/lib/public_key/src/public_key.erl @@ -68,8 +68,8 @@ pki_asn1_type/0, asn1_type/0, ssh_file/0, der_encoded/0, key_params/0, digest_type/0]). --type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key(). --type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key(). +-type public_key() :: rsa_public_key() | dsa_public_key() | ec_public_key() | ed_public_key() . +-type private_key() :: rsa_private_key() | dsa_private_key() | ec_private_key() | ed_private_key() . -type rsa_public_key() :: #'RSAPublicKey'{}. -type rsa_private_key() :: #'RSAPrivateKey'{}. @@ -79,6 +79,9 @@ -type ecpk_parameters_api() :: ecpk_parameters() | #'ECParameters'{} | {namedCurve, Name::crypto:ec_named_curve()}. -type ec_public_key() :: {#'ECPoint'{}, ecpk_parameters_api()}. -type ec_private_key() :: #'ECPrivateKey'{}. +-type ed_public_key() :: {ed_pub, ed25519|ed448, Key::binary()}. +-type ed_private_key() :: {ed_pri, ed25519|ed448, Pub::binary(), Priv::binary()}. + -type key_params() :: #'DHParameter'{} | {namedCurve, oid()} | #'ECParameters'{} | {rsa, Size::integer(), PubExp::integer()}. -type der_encoded() :: binary(). @@ -166,6 +169,8 @@ pem_entry_decode({'SubjectPublicKeyInfo', Der, _}) -> ECCParams = der_decode('EcpkParameters', Params), {#'ECPoint'{point = Key0}, ECCParams} end; +pem_entry_decode({{no_asn1,new_openssh}, Special, not_encrypted}) -> + ssh_decode(Special, new_openssh); pem_entry_decode({Asn1Type, Der, not_encrypted}) when is_atom(Asn1Type), is_binary(Der) -> der_decode(Asn1Type, Der). @@ -609,6 +614,10 @@ pkix_sign_types(?'id-dsa-with-sha1') -> {sha, dsa}; pkix_sign_types(?'id-dsaWithSHA1') -> {sha, dsa}; +pkix_sign_types(?'id-dsa-with-sha224') -> + {sha224, dsa}; +pkix_sign_types(?'id-dsa-with-sha256') -> + {sha256, dsa}; pkix_sign_types(?'ecdsa-with-SHA1') -> {sha, ecdsa}; pkix_sign_types(?'ecdsa-with-SHA256') -> @@ -1066,8 +1075,9 @@ pkix_verify_hostname_match_fun(https) -> -spec ssh_decode(SshBin, Type) -> Decoded when SshBin :: binary(), - Type :: ssh2_pubkey | OtherType, + Type :: ssh2_pubkey | OtherType | InternalType, OtherType :: public_key | ssh_file(), + InternalType :: new_openssh, Decoded :: Decoded_ssh2_pubkey | Decoded_OtherType, Decoded_ssh2_pubkey :: public_key(), @@ -1086,7 +1096,8 @@ ssh_decode(SshBin, Type) when is_binary(SshBin), Type == openssh_public_key; Type == auth_keys; Type == known_hosts; - Type == ssh2_pubkey -> + Type == ssh2_pubkey; + Type == new_openssh -> pubkey_ssh:decode(SshBin, Type). %%-------------------------------------------------------------------- @@ -1229,6 +1240,8 @@ format_sign_key(#'DSAPrivateKey'{p = P, q = Q, g = G, x = X}) -> {dss, [P, Q, G, X]}; format_sign_key(#'ECPrivateKey'{privateKey = PrivKey, parameters = Param}) -> {ecdsa, [PrivKey, ec_curve_spec(Param)]}; +format_sign_key({ed_pri, Curve, _Pub, Priv}) -> + {eddsa, [Priv,Curve]}; format_sign_key(_) -> badarg. @@ -1238,6 +1251,8 @@ format_verify_key({#'ECPoint'{point = Point}, Param}) -> {ecdsa, [Point, ec_curve_spec(Param)]}; format_verify_key({Key, #'Dss-Parms'{p = P, q = Q, g = G}}) -> {dss, [P, Q, G, Key]}; +format_verify_key({ed_pub, Curve, Key}) -> + {eddsa, [Key,Curve]}; %% Convert private keys to public keys format_verify_key(#'RSAPrivateKey'{modulus = Mod, publicExponent = Exp}) -> format_verify_key(#'RSAPublicKey'{modulus = Mod, publicExponent = Exp}); diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl index 1955e9e119..878489eb0f 100644 --- a/lib/public_key/test/public_key_SUITE.erl +++ b/lib/public_key/test/public_key_SUITE.erl @@ -44,7 +44,9 @@ all() -> encrypt_decrypt, {group, sign_verify}, pkix, pkix_countryname, pkix_emailaddress, pkix_path_validation, - pkix_iso_rsa_oid, pkix_iso_dsa_oid, pkix_crl, general_name, + pkix_iso_rsa_oid, pkix_iso_dsa_oid, + pkix_dsa_sha2_oid, + pkix_crl, general_name, pkix_verify_hostname_cn, pkix_verify_hostname_subjAltName, pkix_verify_hostname_subjAltName_IP, @@ -1114,6 +1116,13 @@ pkix_iso_dsa_oid(Config) when is_list(Config) -> {_, dsa} = public_key:pkix_sign_types(SigAlg#'SignatureAlgorithm'.algorithm). %%-------------------------------------------------------------------- +pkix_dsa_sha2_oid() -> + [{doc, "Test support dsa_sha2 oid"}]. +pkix_dsa_sha2_oid(Config) when is_list(Config) -> + {sha224, dsa} = public_key:pkix_sign_types(?'id-dsa-with-sha224'), + {sha256, dsa} = public_key:pkix_sign_types(?'id-dsa-with-sha256'). + +%%-------------------------------------------------------------------- pkix_crl() -> [{doc, "test pkix_crl_* functions"}]. diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index 4e52028c36..96eaf4f962 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 1.6.2 +PUBLIC_KEY_VSN = 1.6.3 diff --git a/lib/reltool/src/reltool_utils.erl b/lib/reltool/src/reltool_utils.erl index 060a0912f9..2afa386cb3 100644 --- a/lib/reltool/src/reltool_utils.erl +++ b/lib/reltool/src/reltool_utils.erl @@ -47,6 +47,9 @@ call/2, cast/2, reply/3]). +%% For testing +-export([erl_libs/2]). + -include_lib("kernel/include/file.hrl"). -include_lib("wx/include/wx.hrl"). -include("reltool.hrl"). @@ -55,7 +58,15 @@ root_dir() -> code:root_dir(). erl_libs() -> - string:lexemes(os:getenv("ERL_LIBS", ""), ":;"). + erl_libs(os:getenv("ERL_LIBS", ""), os:type()). + +erl_libs(ErlLibs, OsType) when is_list(ErlLibs) -> + Sep = + case OsType of + {win32, _} -> ";"; + _ -> ":" + end, + string:lexemes(ErlLibs, Sep). lib_dirs(Dir) -> case erl_prim_loader:list_dir(Dir) of diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl index fc976bfb94..990bd5c217 100644 --- a/lib/reltool/test/reltool_server_SUITE.erl +++ b/lib/reltool/test/reltool_server_SUITE.erl @@ -142,7 +142,8 @@ all() -> use_selected_vsn, use_selected_vsn_relative_path, non_standard_vsn_id, - undefined_regexp]. + undefined_regexp, + windows_erl_libs]. groups() -> []. @@ -2546,10 +2547,21 @@ undefined_regexp(_Config) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Checks that reltool_utils can correctly read Windows ERL_LIBS + +windows_erl_libs(_Config) -> + WinErlLibs = + "C:\\Program Files\\Erlang Libs;C:\\Program Files\\More Erlang Libs", + Ret = reltool_utils:erl_libs(WinErlLibs, {win32, nt}), + ?m(["C:\\Program Files\\Erlang Libs","C:\\Program Files\\More Erlang Libs"], + Ret), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Library functions erl_libs() -> - string:lexemes(os:getenv("ERL_LIBS", ""), ":;"). + reltool_utils:erl_libs(). datadir(Config) -> %% Removes the trailing slash... diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 688aff16f1..5d45af0b50 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -43,5 +43,5 @@ {env, []}, {mod, {sasl, []}}, {runtime_dependencies, ["tools-2.6.14","stdlib-3.4","kernel-5.3", - "erts-9.0"]}]}. + "erts-@OTP-13468@"]}]}. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index a0331fafd1..101701cec6 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1562,10 +1562,10 @@ mandatory_modules() -> preloaded() -> %% Sorted - [erl_init,erl_prim_loader,erl_tracer,erlang, + [atomics,counters,erl_init,erl_prim_loader,erl_tracer,erlang, erts_code_purger,erts_dirty_process_signal_handler, erts_internal,erts_literal_area_collector, - init,prim_buffer,prim_eval,prim_file, + init,persistent_term,prim_buffer,prim_eval,prim_file, prim_inet,prim_zip,zlib]. %%______________________________________________________________________ diff --git a/lib/snmp/mibs/Makefile.in b/lib/snmp/mibs/Makefile.in index 2350194077..77893cbdc8 100644 --- a/lib/snmp/mibs/Makefile.in +++ b/lib/snmp/mibs/Makefile.in @@ -41,14 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/snmp-$(VSN) # Common macros # ---------------------------------------------------- -# NOTE: -# The OTP-REG mib actually belongs to another -# application (otp_mibs), and is exported by this -# app. But since that app is built later, we have -# to built it here in order to be able to build -# OTP-SNMPEA-MIB (that needs otpModules and -# otpApplications). -MIBS_A = \ +MIBS = \ RFC1213-MIB \ STANDARD-MIB \ SNMPv2-TM \ @@ -62,16 +55,10 @@ MIBS_A = \ SNMP-VIEW-BASED-ACM-MIB \ SNMP-USM-AES-MIB \ INET-ADDRESS-MIB \ - TRANSPORT-ADDRESS-MIB - -MIBS_B = OTP-SNMPEA-MIB - -BUILD_MIBS = \ - $(MIBS_A) \ + TRANSPORT-ADDRESS-MIB \ OTP-REG \ - $(MIBS_B) - -MIBS = $(MIBS_A) $(MIBS_B) + OTP-TC \ + OTP-SNMPEA-MIB STD_v1_MIB_FILES = \ RFC1155-SMI.mib \ @@ -100,8 +87,8 @@ HRL_FILES = $(SNMP_HRL_TARGET_DIR)/SNMPv2-TC.hrl \ TARGET_FILES = \ $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 \ - $(BUILD_MIBS:%=$(SNMP_BIN_TARGET_DIR)/%.bin) \ - $(HRL_TARGETS) \ + $(MIBS:%=$(SNMP_BIN_TARGET_DIR)/%.bin) \ + $(HRL_TARGETS) \ $(V1_MIB_FILES) @@ -136,21 +123,18 @@ endif # Targets # ---------------------------------------------------- -OTP_MIBDIR = $(shell if test -d ../../otp_mibs; then echo otp_mibs; \ - else echo sasl; fi) - debug opt: $(TARGET_FILES) $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1: $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1.src $(gen_verbose)$(PERL) -p -e 's?%PERL%?$(PERL)? ' < $< > $@ $(V_at)chmod 755 $@ -$(SNMP_BIN_TARGET_DIR)/OTP-REG.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-REG.mib - $(snmp_verbose)$(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< - # To support parallel make, we'll need explicit dependencies # to ensure that an imported MIB has been compiled when it's needed. +$(SNMP_BIN_TARGET_DIR)/OTP-TC.bin: \ + $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin + $(SNMP_BIN_TARGET_DIR)/STANDARD-MIB.bin: \ $(SNMP_BIN_TARGET_DIR)/RFC1213-MIB.bin @@ -208,8 +192,6 @@ info: @echo "" @echo "TARGET_FILES = $(TARGET_FILES)" @echo "" - @echo "OTP_MIBDIR = $(OTP_MIBDIR)" - @echo "" @echo "SNMP_VSN = $(SNMP_VSN)" @echo "VSN = $(VSN)" @echo "RELSYSDIR = "$(RELSYSDIR)"" diff --git a/lib/otp_mibs/mibs/OTP-REG.mib b/lib/snmp/mibs/OTP-REG.mib index bf1585061c..bf1585061c 100644 --- a/lib/otp_mibs/mibs/OTP-REG.mib +++ b/lib/snmp/mibs/OTP-REG.mib diff --git a/lib/otp_mibs/mibs/OTP-TC.mib b/lib/snmp/mibs/OTP-TC.mib index efe5451f0c..efe5451f0c 100644 --- a/lib/otp_mibs/mibs/OTP-TC.mib +++ b/lib/snmp/mibs/OTP-TC.mib diff --git a/lib/snmp/test/snmp_compiler_test.erl b/lib/snmp/test/snmp_compiler_test.erl index 0a7b729d1f..2e48d5134d 100644 --- a/lib/snmp/test/snmp_compiler_test.erl +++ b/lib/snmp/test/snmp_compiler_test.erl @@ -234,14 +234,14 @@ agent_capabilities(Config) when is_list(Config) -> AcMib = join(Dir,"AC-TEST-MIB.mib"), ?line {ok, MibFile1} = snmpc:compile(AcMib, [options, version, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib1} = snmp_misc:read_mib(MibFile1), ?line {ok, MibFile2} = snmpc:compile(AcMib, [options, version, agent_capabilities, - {i, [SnmpMibsDir, OtpMibsMibsDir]}, + {i, [SnmpMibsDir]}, {outdir, Dir}, {verbosity, trace}]), ?line {ok, Mib2} = snmp_misc:read_mib(MibFile2), @@ -290,7 +290,7 @@ module_compliance(Config) when is_list(Config) -> ?line {ok, Mib2} = snmp_misc:read_mib(MibFile2), MEDiff = Mib2#mib.mes -- Mib1#mib.mes, %% This is a rather pathetic test, but it is somthing... - io:format("agent_capabilities -> " + io:format("module_compliance -> " "~n MEDiff: ~p" "~n Mib1: ~p" "~n Mib2: ~p" diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 4d5a0fbce8..f305497cd3 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = snmp -SNMP_VSN = 5.2.12 +SNMP_VSN = 5.3 PRE_VSN = APP_VSN = "$(APPLICATION)-$(SNMP_VSN)$(PRE_VSN)" diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile index 77fa356092..4e32dd9976 100644 --- a/lib/ssh/doc/src/Makefile +++ b/lib/ssh/doc/src/Makefile @@ -45,6 +45,7 @@ XML_REF3_FILES = \ ssh_connection.xml \ ssh_server_channel.xml \ ssh_server_key_api.xml \ + ssh_file.xml \ ssh_sftp.xml \ ssh_sftpd.xml \ @@ -56,8 +57,8 @@ XML_CHAPTER_FILES = \ notes.xml \ introduction.xml \ using_ssh.xml \ + terminology.xml \ configure_algos.xml -# ssh_protocol.xml \ BOOK_FILES = book.xml diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index c9809ce1e3..1012c80fb1 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -230,6 +230,22 @@ </section> </section> +<section><title>Ssh 4.6.9.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Incompatibility with newer OpenSSH fixed. Previously + versions 7.8 and later could cause Erlang SSH to exit.</p> + <p> + Own Id: OTP-15413</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.6.9.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> @@ -3869,4 +3885,3 @@ </section> </chapter> - diff --git a/lib/ssh/doc/src/ref_man.xml b/lib/ssh/doc/src/ref_man.xml index df37b0244f..60572b985b 100644 --- a/lib/ssh/doc/src/ref_man.xml +++ b/lib/ssh/doc/src/ref_man.xml @@ -40,6 +40,7 @@ <xi:include href="ssh_connection.xml"/> <xi:include href="ssh_client_key_api.xml"/> <xi:include href="ssh_server_key_api.xml"/> + <xi:include href="ssh_file.xml"/> <xi:include href="ssh_sftp.xml"/> <xi:include href="ssh_sftpd.xml"/> </application> diff --git a/lib/ssh/doc/src/specs.xml b/lib/ssh/doc/src/specs.xml index acdbe2ddfd..a6517f3660 100644 --- a/lib/ssh/doc/src/specs.xml +++ b/lib/ssh/doc/src/specs.xml @@ -6,6 +6,7 @@ <xi:include href="../specs/specs_ssh_connection.xml"/> <xi:include href="../specs/specs_ssh_server_channel.xml"/> <xi:include href="../specs/specs_ssh_server_key_api.xml"/> + <xi:include href="../specs/specs_ssh_file.xml"/> <xi:include href="../specs/specs_ssh_sftp.xml"/> <xi:include href="../specs/specs_ssh_sftpd.xml"/> </specs> diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 3bc62073a2..fcf79969d3 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -99,8 +99,8 @@ </p> <p>The paths could easily be changed by options: - <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> and - <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>. + <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> and + <seealso marker="ssh_file#type-system_dir_daemon_option"><c>system_dir</c></seealso>. </p> <p>A completly different storage could be interfaced by writing call-back modules using the behaviours @@ -123,12 +123,12 @@ <item><c>ssh_host_ecdsa_key</c> and <c>ssh_host_ecdsa_key.pub</c></item> </list> <p>The host keys directory could be changed with the option - <seealso marker="#type-system_dir_daemon_option"><c>system_dir</c></seealso>.</p> + <seealso marker="ssh_file#type-system_dir_daemon_option"><c>system_dir</c></seealso>.</p> </item> <item>Optional: one or more <i>User's public key</i> in case of <c>publickey</c> authorization. Default is to store them concatenated in the file <c>.ssh/authorized_keys</c> in the user's home directory. <p>The user keys directory could be changed with the option - <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>.</p> + <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso>.</p> </item> </list> </section> @@ -138,7 +138,7 @@ <p>The keys and some other data are by default stored in files in the directory <c>.ssh</c> in the user's home directory.</p> <p>The directory could be changed with the option - <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso>. + <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso>. </p> <list> <item>Optional: a list of <i>Host public key(s)</i> for previously connected hosts. This list @@ -183,31 +183,6 @@ </datatype> <datatype> - <name name="pref_public_key_algs_client_option"/> - <desc> - <p>List of user (client) public key algorithms to try to use.</p> - <p>The default value is the <c>public_key</c> entry in the list returned by - <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. - </p> - <p>If there is no public key of a specified type available, the corresponding entry is ignored. - Note that the available set is dependent on the underlying cryptolib and current user's public keys. - </p> - <p>See also the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> - for specifying the path to the user's keys. - </p> - </desc> - </datatype> - - <datatype> - <name name="pubkey_passphrase_client_options"/> - <desc> - <p>If the user's DSA, RSA or ECDSA key is protected by a passphrase, it can be - supplied with thoose options. - </p> - </desc> - </datatype> - - <datatype> <name name="host_accepting_client_options"/> <name name="accept_hosts"/> <name name="fp_digest_alg"/> @@ -220,7 +195,7 @@ <p>This option guides the <c>connect</c> function on how to act when the connected server presents a Host Key that the client has not seen before. The default is to ask the user with a question on stdio of whether to accept or reject the new Host Key. - See the option <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> + See the option <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> for specifying the path to the file <c>known_hosts</c> where previously accepted Host Keys are recorded. See also the option <seealso marker="#type-key_cb_common_option">key_cb</seealso> @@ -276,7 +251,7 @@ accept question the next time the same host is connected. If the option <seealso marker="#type-key_cb_common_option"><c>key_cb</c></seealso> is not present, the key is saved in the file "known_hosts". See option - <seealso marker="#type-user_dir_common_option"><c>user_dir</c></seealso> for + <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> for the location of that file. </p> <p>If <c>false</c>, the key is not saved and the key will still be unknown @@ -406,9 +381,20 @@ <datatype> <name name="exec_daemon_option"/> + <name name="exec_spec"/> + <desc/> + </datatype> + <datatype> + <name name="exec_fun"/> + <desc/> + </datatype> + <datatype> <name name="'exec_fun/1'"/> <name name="'exec_fun/2'"/> <name name="'exec_fun/3'"/> + <desc/> + </datatype> + <datatype> <name name="exec_result"/> <desc> <p>This option changes how the daemon execute exec-requests from clients. The term in the return value @@ -478,18 +464,6 @@ <name name="pwdfun_4"/> <desc> <taglist> - <tag><marker id="type-system_dir_daemon_option"/><c>system_dir</c></tag> - <item> - <p>Sets the system directory, containing the host key files - that identify the host keys for <c>ssh</c>. Defaults to - <c>/etc/ssh</c>.</p> - <p>For security reasons, this directory is normally accessible only to the root user.</p> - <p>See also the option - <seealso marker="#type-key_cb_common_option">key_cb</seealso> - for the general way to handle keys. - </p> - </item> - <tag><c>auth_method_kb_interactive_data</c></tag> <item> <p>Sets the text strings that the daemon sends to the client for presentation to the user when @@ -502,7 +476,7 @@ </p> </item> - <tag><c>user_passwords</c></tag> + <tag><marker id="option-user_passwords"/><c>user_passwords</c></tag> <item> <p>Provides passwords for password authentication. The passwords are used when someone tries to connect to the server and public key user-authentication fails. The option provides @@ -510,7 +484,7 @@ </p> </item> - <tag><c>password</c></tag> + <tag><marker id="option-password"/><c>password</c></tag> <item> <p>Provides a global password that authenticates any user.</p> <warning> @@ -519,7 +493,9 @@ </warning> </item> - <tag><c>pwdfun</c> with <c>pwdfun_4()</c></tag> + <tag><marker id="option-pwdfun"/><c>pwdfun</c> with + <seealso marker="#type-pwdfun_4"><c>pwdfun_4()</c></seealso> + </tag> <item> <p>Provides a function for password validation. This could used for calling an external system or handeling passwords stored as hash values. @@ -546,7 +522,9 @@ can be used for this. The return value <c>disconnect</c> is useful for this.</p> </item> - <tag><c>pwdfun</c> with <c>pwdfun_2()</c></tag> + <tag><c>pwdfun</c> with + <seealso marker="#type-pwdfun_2"><c>pwdfun_2()</c></seealso> + </tag> <item> <p>Provides a function for password validation. This function is called with user and password as strings, and returns:</p> @@ -725,21 +703,6 @@ </datatype> <datatype> - <name name="user_dir_common_option"/> - <desc> - <p>Sets the user directory. That is, the directory containing <c>ssh</c> configuration - files for the user, such as - <c>known_hosts</c>, <c>id_rsa</c>, <c>id_dsa</c>>, <c>id_ecdsa</c> and <c>authorized_key</c>. - Defaults to the directory normally referred to as <c>~/.ssh</c>. - </p> - <p>See also the option - <seealso marker="#type-key_cb_common_option">key_cb</seealso> - for the general way to handle keys. - </p> - </desc> - </datatype> - - <datatype> <name name="profile_common_option"/> <desc> <p>Used together with <c>ip-address</c> and <c>port</c> to @@ -795,7 +758,8 @@ </p> <p>The <c>Opts</c> defaults to <c>[]</c> when only the <c>Module</c> is specified. </p> - <p>The default value of this option is <c>{ssh_file, []}</c>. + <p>The default value of this option is <c>{ssh_file, []}</c>. See also the manpage of + <seealso marker="ssh:ssh_file">ssh_file</seealso>. </p> <p>A call to the call-back function <c>F</c> will be</p> <code> @@ -804,13 +768,32 @@ <p>where <c>...</c> are arguments to <c>F</c> as in <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and/or <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. - The <c>UserOptions</c> are the options given to <c>ssh:connect</c>, <c>ssh:shell</c> or <c>ssh:daemon</c>. + The <c>UserOptions</c> are the options given to + <seealso marker="ssh:ssh#connect-3">ssh:connect</seealso>, + <seealso marker="ssh:ssh#shell-1">ssh:shell</seealso> or + <seealso marker="ssh:ssh#daemon-2">ssh:daemon</seealso>. </p> </desc> </datatype> <datatype> + <name name="pref_public_key_algs_common_option"/> + <desc> + <p>List of user (client) public key algorithms to try to use.</p> + <p>The default value is the <c>public_key</c> entry in the list returned by + <seealso marker="#default_algorithms/0">ssh:default_algorithms/0</seealso>. + </p> + <p>If there is no public key of a specified type available, the corresponding entry is ignored. + Note that the available set is dependent on the underlying cryptolib and current user's public keys. + </p> + <p>See also the option <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> + for specifying the path to the user's keys. + </p> + </desc> + </datatype> + + <datatype> <name name="disconnectfun_common_option"/> <desc> <p>Provides a fun to implement your own logging when the peer disconnects.</p> diff --git a/lib/ssh/doc/src/ssh_app.xml b/lib/ssh/doc/src/ssh_app.xml index e80bb1853d..0c22a50c3f 100644 --- a/lib/ssh/doc/src/ssh_app.xml +++ b/lib/ssh/doc/src/ssh_app.xml @@ -74,13 +74,18 @@ <c>id_ecdsa_key</c>, <c>known_hosts</c>, and <c>authorized_keys</c> in ~/.ssh, and for the host key files in <c>/etc/ssh</c>. These locations can be changed - by the options <c>user_dir</c> and <c>system_dir</c>. + by the options + <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> and + <seealso marker="ssh_file#type-system_dir_daemon_option"><c>system_dir</c></seealso>. </p> <p>Public key handling can also be customized through a callback module that implements the behaviors <seealso marker="ssh_client_key_api">ssh_client_key_api</seealso> and <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>. </p> + <p>See also the default callback module documentation in + <seealso marker="ssh_file">ssh_file</seealso>. + </p> </section> <section> @@ -170,6 +175,8 @@ <item>ecdsa-sha2-nistp384</item> <item>ecdsa-sha2-nistp521</item> <item>ecdsa-sha2-nistp256</item> + <item>ssh-ed25519</item> + <item>ssh-ed448</item> <item>ssh-rsa</item> <item>rsa-sha2-256</item> <item>rsa-sha2-512</item> @@ -373,7 +380,11 @@ <item> <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-curves">Secure Shell (SSH) Key Exchange Method using Curve25519 and Curve448 (work in progress)</url> </item> - + + <item> + <url href="https://tools.ietf.org/html/draft-ietf-curdle-ssh-ed25519-ed448">Ed25519 and Ed448 public key algorithms for the Secure Shell (SSH) protocol (work in progress)</url> + </item> + </list> </section> diff --git a/lib/ssh/doc/src/ssh_file.xml b/lib/ssh/doc/src/ssh_file.xml new file mode 100644 index 0000000000..6681d9c306 --- /dev/null +++ b/lib/ssh/doc/src/ssh_file.xml @@ -0,0 +1,285 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2018</year><year>2018</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>ssh_file</title> + <prepared></prepared> + <docno></docno> + <date></date> + <rev></rev> + </header> + <module>ssh_file</module> + <modulesummary>Default callback module for the client's and server's database operations in the ssh application</modulesummary> + <description> + <p>This module is the default callback handler for the client's and the server's user and host "database" operations. + All data, for instance key pairs, are stored in files in the normal file system. This page documents the files, where they + are stored and configuration options for this callback module. + </p> + <p>The intention is to be compatible with the + <url href="http://www.openssh.com">OpenSSH</url> + storage in files. Therefore it mimics directories and filenames of + <url href="http://www.openssh.com">OpenSSH</url>. + </p> + + <p>Ssh_file implements the <seealso marker="ssh:ssh_server_key_api">ssh_server_key_api</seealso> and + the <seealso marker="ssh:ssh_client_key_api">ssh_client_key_api</seealso>. + This enables the user to make an own interface using for example a database handler. + </p> + <p>Such another callback module could be used by setting the option + <seealso marker="ssh:ssh#type-key_cb_common_option"><c>key_cb</c></seealso> + when starting a client or a server (with for example + <seealso marker="ssh:ssh#connect-3">ssh:connect</seealso>, + <seealso marker="ssh:ssh#daemon-2">ssh:daemon</seealso> of + <seealso marker="ssh:ssh#shell-1">ssh:shell</seealso> + ). + </p> + + <note> + <p>The functions are <i>Callbacks</i> for the SSH app. They are not intended to be called from the user's code! + </p> + </note> + </description> + + <section> + <title>Files, directories and who uses them</title> + <section> + <title>Daemons</title> + <p>Daemons uses all files stored in the <seealso marker="#SYSDIR">SYSDIR</seealso> directory. + </p> + <p>Optionaly, in case of <c>publickey</c> authorization, one or more of the remote user's public keys + in the <seealso marker="#USERDIR">USERDIR</seealso> directory are used. + See the files + <seealso marker="#USERDIR-authorized_keys"><c>USERDIR/authorized_keys</c></seealso> and + <seealso marker="#USERDIR-authorized_keys2"><c>USERDIR/authorized_keys2</c></seealso>. + </p> + </section> + + <section> + <title>Clients</title> + <p>Clients uses all files stored in the <seealso marker="#USERDIR">USERDIR</seealso> directory. + </p> + </section> + + <section> + <title>Directory contents</title> + <taglist> + <tag><marker id="LOCALUSER"/>LOCALUSER</tag> + <item><p>The user name of the OS process running the Erlang virtual machine (emulator).</p> + </item> + + <tag><marker id="SYSDIR"/>SYSDIR</tag> + <item><p>This is the directory holding the server's files:</p> + <list> + <item><marker id="SYSDIR-ssh_host_dsa_key"/><c>ssh_host_dsa_key</c> - private dss host key (optional)</item> + <item><marker id="SYSDIR-ssh_host_rsa_key"/><c>ssh_host_rsa_key</c> - private rsa host key (optional)</item> + <item><marker id="SYSDIR-ssh_host_ecdsa_key"/><c>ssh_host_ecdsa_key</c> - private ecdsa host key (optional)</item> + <item><marker id="SYSDIR-ssh_host_ed25519_key"/><c>ssh_host_ed25519_key</c> - private eddsa host key for curve 25519 (optional)</item> + <item><marker id="SYSDIR-ssh_host_ed448_key"/><c>ssh_host_ed448_key</c> - private eddsa host key for curve 448 (optional)</item> + </list> + <p>At least one host key must be defined. The default value of SYSDIR is <marker id="#/etc/ssh"/><c>/etc/ssh</c>. + </p> + <p>For security reasons, this directory is normally accessible only to the root user. + </p> + <p>To change the SYSDIR, see the <seealso marker="#type-system_dir_daemon_option">system_dir</seealso> option. + </p> + </item> + + <tag><marker id="USERDIR"/>USERDIR</tag> + <item><p>This is the directory holding the files:</p> + <list> + <item><marker id="USERDIR-authorized_keys"/><c>authorized_keys</c> + and, as second alternative + <marker id="USERDIR-authorized_keys2"/><c>authorized_keys2</c> - + the user's public keys are stored concatenated in one of those files. + </item> + <item><marker id="USERDIR-known_hosts"/><c>known_hosts</c> - host keys from hosts visited + concatenated. The file is created and used by the client.</item> + <item><marker id="USERDIR-id_dsa"/><c>id_dsa</c> - private dss user key (optional)</item> + <item><marker id="USERDIR-id_rsa"/><c>id_rsa</c> - private rsa user key (optional)</item> + <item><marker id="USERDIR-id_ecdsa"/><c>id_ecdsa</c> - private ecdsa user key (optional)</item> + <item><marker id="USERDIR-id_ed25519"/><c>id_ed25519</c> - private eddsa user key for curve 25519 (optional)</item> + <item><marker id="USERDIR-id_ed448"/><c>id_ed448</c> - private eddsa user key for curve 448 (optional)</item> + </list> + <p>The default value of USERDIR is <c>/home/</c><seealso marker="#LOCALUSER"><c>LOCALUSER</c></seealso><c>/.ssh</c>. + </p> + <p>To change the USERDIR, see the <seealso marker="#type-user_dir_common_option">user_dir</seealso> option + </p> + </item> + </taglist> + </section> + </section> + + <datatypes> + <datatype_title>Options for the default ssh_file callback module</datatype_title> + <datatype> + <name name="user_dir_common_option"/> + <desc> + <p>Sets the <seealso marker="#USERDIR">user directory</seealso>.</p> + </desc> + </datatype> + + <datatype> + <name name="user_dir_fun_common_option"/> + <name name="user2dir"/> + <desc> + <p>Sets the <seealso marker="#USERDIR">user directory</seealso> dynamically + by evaluating the <c>user2dir</c> function. + </p> + </desc> + </datatype> + + <datatype> + <name name="system_dir_daemon_option"/> + <desc> + <p>Sets the <seealso marker="#SYSDIR">system directory</seealso>.</p> + </desc> + </datatype> + + <datatype> + <name name="pubkey_passphrase_client_options"/> + <desc> + <p>If the user's DSA, RSA or ECDSA key is protected by a passphrase, it can be + supplied with thoose options. + </p> + <p>Note that EdDSA passhrases (Curves 25519 and 448) are not implemented.</p> + </desc> + </datatype> + + </datatypes> + + <funcs> + <func> + <name>host_key(Algorithm, DaemonOptions) -> {ok, Key} | {error, Reason}</name> + <fsummary></fsummary> + <desc> + <p><strong>Types and description</strong></p> + <p>See the api description in + <seealso marker="ssh:ssh_server_key_api#Module:host_key-2">ssh_server_key_api, Module:host_key/2</seealso>. + </p> + <p><strong>Options</strong></p> + <list> + <item><seealso marker="#type-system_dir_daemon_option">system_dir</seealso></item> + <!-- item>dsa_pass_phrase</item --> + <!-- item>rsa_pass_phrase</item --> + <!-- item>ecdsa_pass_phrase</item --> + </list> + <p><strong>Files</strong></p> + <list> + <item><seealso marker="#SYSDIR-ssh_host_rsa_key"><c>SYSDIR/ssh_host_rsa_key</c></seealso></item> + <item><seealso marker="#SYSDIR-ssh_host_dsa_key"><c>SYSDIR/ssh_host_dsa_key</c></seealso></item> + <item><seealso marker="#SYSDIR-ssh_host_ecdsa_key"><c>SYSDIR/ssh_host_ecdsa_key</c></seealso></item> + <item><seealso marker="#SYSDIR-ssh_host_ed25519_key"><c>SYSDIR/ssh_host_ed25519_key</c></seealso></item> + <item><seealso marker="#SYSDIR-ssh_host_ed448_key"><c>SYSDIR/ssh_host_ed448_key</c>c></seealso></item> + </list> + </desc> + </func> + + <func> + <name>is_auth_key(PublicUserKey, User, DaemonOptions) -> Result</name> + <fsummary></fsummary> + <desc> + <p><strong>Types and description</strong></p> + <p>See the api description in + <seealso marker="ssh:ssh_server_key_api#Module:is_auth_key-3">ssh_server_key_api: Module:is_auth_key/3</seealso>. + </p> + <p><strong>Options</strong></p> + <list> + <item><seealso marker="#type-user_dir_fun_common_option">user_dir_fun</seealso></item> + <item><seealso marker="#type-user_dir_common_option">user_dir</seealso></item> + </list> + <p><strong>Files</strong></p> + <list> + <item><seealso marker="#USERDIR-authorized_keys"><c>USERDIR/authorized_keys</c></seealso></item> + <item><seealso marker="#USERDIR-authorized_keys2"><c>USERDIR/authorized_keys2</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name>add_host_key(HostNames, PublicHostKey, ConnectOptions) -> ok | {error, Reason}</name> + <fsummary></fsummary> + <desc> + <p><strong>Types and description</strong></p> + <p>See the api description in + <seealso marker="ssh:ssh_client_key_api#Module:add_host_key-3">ssh_client_key_api, Module:add_host_key/3</seealso>. + </p> + <p><strong>Option</strong></p> + <list> + <item><seealso marker="#type-user_dir_common_option">user_dir</seealso></item> + </list> + <p><strong>File</strong></p> + <list> + <item><seealso marker="#USERDIR-known_hosts"><c>USERDIR/known_hosts</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name>is_host_key(Key, Host, Algorithm, ConnectOptions) -> Result</name> + <fsummary></fsummary> + <desc> + <p><strong>Types and description</strong></p> + <p>See the api description in + <seealso marker="ssh:ssh_client_key_api#Module:is_host_key-4">ssh_client_key_api, Module:is_host_key/4</seealso>. + </p> + <p><strong>Option</strong></p> + <list> + <item><seealso marker="#type-user_dir_common_option">user_dir</seealso></item> + </list> + <p><strong>File</strong></p> + <list> + <item><seealso marker="#USERDIR-known_hosts"><c>USERDIR/known_hosts</c></seealso></item> + </list> + </desc> + </func> + + <func> + <name>user_key(Algorithm, ConnectOptions) -> {ok, PrivateKey} | {error, Reason}</name> + <fsummary></fsummary> + <desc> + <p><strong>Types and description</strong></p> + <p>See the api description in + <seealso marker="ssh:ssh_client_key_api#Module:user_key-2">ssh_client_key_api, Module:user_key/2</seealso>. + </p> + <p><strong>Options</strong></p> + <list> + <item><seealso marker="#type-user_dir_common_option">user_dir</seealso></item> + <item><seealso marker="#type-pubkey_passphrase_client_options">dsa_pass_phrase</seealso></item> + <item><seealso marker="#type-pubkey_passphrase_client_options">rsa_pass_phrase</seealso></item> + <item><seealso marker="#type-pubkey_passphrase_client_options">ecdsa_pass_phrase</seealso></item> + </list> + <p>Note that EdDSA passhrases (Curves 25519 and 448) are not implemented.</p> + <p><strong>Files</strong></p> + <list> + <item><seealso marker="#USERDIR-id_dsa"><c>USERDIR/id_dsa</c></seealso></item> + <item><seealso marker="#USERDIR-id_rsa"><c>USERDIR/id_rsa</c></seealso></item> + <item><seealso marker="#USERDIR-id_ecdsa"><c>USERDIR/id_ecdsa</c></seealso></item> + <item><seealso marker="#USERDIR-id_ed25519"><c>USERDIR/id_ed25519</c></seealso></item> + <item><seealso marker="#USERDIR-id_ed448"><c>USERDIR/id_ed448</c></seealso></item> + </list> + </desc> + </func> + + </funcs> + +</erlref> diff --git a/lib/ssh/doc/src/ssh_sftp.xml b/lib/ssh/doc/src/ssh_sftp.xml index ea55126cb3..8c105147d6 100644 --- a/lib/ssh/doc/src/ssh_sftp.xml +++ b/lib/ssh/doc/src/ssh_sftp.xml @@ -425,7 +425,6 @@ <type> <v>ChannelPid = pid()</v> <v>Handle = term()</v> - <v>Position = integer()</v> <v>Len = integer()</v> <v>Timeout = timeout()</v> <v>Data = string() | binary()</v> diff --git a/lib/ssh/doc/src/terminology.xml b/lib/ssh/doc/src/terminology.xml new file mode 100644 index 0000000000..db1e08970d --- /dev/null +++ b/lib/ssh/doc/src/terminology.xml @@ -0,0 +1,185 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE chapter SYSTEM "chapter.dtd"> + +<chapter> + <header> + <copyright> + <year>2018</year> + <year>2018</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + </legalnotice> + + <title>Terminology</title> + <prepared></prepared> + <docno></docno> + <approved></approved> + <date></date> + <rev></rev> + <file>terminology.xml</file> + </header> + + <section> + <title>General Information</title> + <p>In the following terms that may cause confusion are explained. + </p> + </section> + + <section> + <title>The term "user"</title> + <p>A "user" is a term that everyone understands intuitively. However, the understandings may differ which can + cause confusion. + </p> + <p>The term is used differently in <url href="http://www.openssh.com">OpenSSH</url> and SSH in Erlang/OTP. + The reason is the different environments and use cases that are not immediatly obvious. + </p> + <p>This chapter aims at explaining the differences and giving a rationale for why Erlang/OTP handles "user" as + it does. + </p> + + <section> + <title>In OpenSSH</title> + <p>Many have been in contact with the command 'ssh' on a Linux machine (or similar) to remotly log in on + another machine. One types + </p> + <code>ssh host</code> + <p>to log in on the machine named <c>host</c>. The command prompts for your password on the remote <c>host</c> and + then you can read, write and execute as your <i>user name</i> has rights on the remote <c>host</c>. There are + stronger variants with pre-distributed keys or certificates, but that are for now just details in the + authentication process. + </p> + <p>You could log in as the user <c>anotheruser</c> with + </p> + <code>ssh anotheruser@host</code> + <p>and you will then be enabled to act as <c>anotheruser</c> on the <c>host</c> if authorized correctly. + </p> + <p>So what does <i>"your user name has rights"</i> mean? In a UNIX/Linux/etc context it is exactly as that context: + The <i>user</i> could read, write and execute programs according to the OS rules. + In addition, the user has a home directory (<c>$HOME</c>) and there is a <c>$HOME/.ssh/</c> directory + with ssh-specific files. + </p> + <section> + <title>SSH password authentication</title> + <p>When SSH tries to log in to a host, the ssh protocol communicates the user name (as a string) and a password. + The remote ssh server checks that there is such a user defined and that the provided password is acceptable. + </p> + <p>If so, the user is authorized. + </p> + </section> + <section> + <title>SSH public key authentication</title> + <p>This is a stronger method where the ssh protocol brings the user name, the user's public key and some + cryptographic information which we could ignore here. + </p> + <p>The ssh server on the remote host checks: + </p> + <list> + <item>That the <i>user</i> has a home directory,</item> + <item>that home directory contains a .ssh/ directory and</item> + <item>the .ssh/ directory contains the public key just received in the <c>authorized_keys</c> file</item> + </list> + <p>if so, the user is authorized. + </p> + </section> + <section> + <title>The SSH server on UNIX/Linux/etc after a succesful authentication</title> + <p>After a succesful incoming authentication, a new process runs as the just authenticated user.</p> + <p>Next step is to start a service according to the ssh request. In case of a request of a shell, + a new one is started which handles the OS-commands that arrives from the client (that's "you"). + </p> + <p>In case of a sftp request, an sftp server is started in with the user's rights. So it could read, write or delete + files if allowed for that user. + </p> + </section> + </section> + + <section> + <title>In Erlang/OTP SSH</title> + <p>For the Erlang/OTP SSH server the situation is different. The server executes in an Erlang process + in the Erlang emulator which in turn executes in an OS process. The emulator does not try to change its + user when authenticated over the SSH protocol. + So the remote user name is only for authentication purposes in the Erlang/OTP SSH application. + </p> + <section> + <title>Password authentication in Erlang SSH</title> + <p>The Erlang/OTP SSH server checks the user name and password in the following order: + </p> + <list type="ordered"> + <item>If a + <seealso marker="ssh:ssh#option-pwdfun"><c>pwdfun</c></seealso> + is defined, that one is called and the returned boolean is the authentication result. + </item> + <item>Else, if the + <seealso marker="ssh:ssh#option-user_passwords"><c>user_passwords</c></seealso> + option is defined and the username and the password matches, the authentication is a success. + </item> + <item>Else, if the option + <seealso marker="ssh:ssh#option-password"><c>password</c></seealso> + is defined and matches the password the authentication is a success. + Note that the use of this option is not recommended in non-test code. + </item> + </list> + </section> + <section> + <title>Public key authentication in Erlang SSH</title> + <p>The user name, public key and cryptographic data (a signature) that is sent by the client, are used as follows + (some steps left out for clearity): + </p> + <list type="ordered"> + <item>A callback module is selected using the options + <seealso marker="ssh:ssh#type-key_cb_common_option"><c>key_cb</c></seealso>. + </item> + <item>The callback module is used to check that the provided public key is one of the user's pre-stored. + In case of the default callback module, the files <c>authorized_keys</c> and <c>authorized_keys2</c> + are searched in a directory found in the following order: + <list> + <item>If the option + <seealso marker="ssh:ssh_file#type-user_dir_fun_common_option"><c>user_dir_fun</c></seealso> + is defined, that fun is called and the returned directory is used, + </item> + <item>Else, If the option + <seealso marker="ssh:ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> + is defined, that directory is used, + </item> + <item>Else the subdirectory <c>.ssh</c> in the home directory of the user executing + the OS process of the Erlang emulator is used. + </item> + </list> + If the provided public key is not found, the authentication fails. + </item> + <item>Finally, if the provided public key is found, the signature provided by the client is checked with + the public key. + </item> + </list> + </section> + <section> + <title>The Erlang/OTP SSH server after a succesful authentication</title> + <p>After a successful authentication an <i>Erlang process</i> is handling the service request from the remote + ssh client. The rights of that process are those of the user of the OS process running the Erlang emulator. + </p> + <p>If a shell service request arrives to the server, an <i>Erlang shell</i> is opened in the server's emulator. + The rights in that shell is independent of the just authenticated user. + </p> + <p>In case of an sftp request, an sftp server is started with the rights of the user of the Erlang emulator's OS + process. So with sftp the authenticated user does not influence the rights. + </p> + <p>So after an authentication, the user name is not used anymore and has no influence. + </p> + </section> + </section> + </section> +</chapter> + diff --git a/lib/ssh/doc/src/usersguide.xml b/lib/ssh/doc/src/usersguide.xml index 38ffa48cde..8a4df208d8 100644 --- a/lib/ssh/doc/src/usersguide.xml +++ b/lib/ssh/doc/src/usersguide.xml @@ -36,5 +36,6 @@ </description> <xi:include href="introduction.xml"/> <xi:include href="using_ssh.xml"/> + <xi:include href="terminology.xml"/> <xi:include href="configure_algos.xml"/> </part> diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 80662e9a70..4455d5ecc5 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -74,16 +74,17 @@ <marker id="Running an Erlang ssh Daemon"></marker> <title>Running an Erlang ssh Daemon</title> - <p>The <c>system_dir</c> option must be a directory containing a host - key file and it defaults to <c>/etc/ssh</c>. For details, see Section - Configuration Files in <seealso - marker="SSH_app">ssh(6)</seealso>. + <p>The + <seealso marker="ssh_file#type-system_dir_daemon_option"><c>system_dir</c></seealso> + option must be a directory containing a host key file and it defaults to <c>/etc/ssh</c>. + For details, see Section Configuration Files in <seealso marker="SSH_app">ssh(6)</seealso>. </p> <note><p>Normally, the <c>/etc/ssh</c> directory is only readable by root.</p> </note> - <p>The option <c>user_dir</c> defaults to directory <c>users ~/.ssh</c>.</p> + <p>The option <seealso marker="ssh_file#type-user_dir_common_option"><c>user_dir</c></seealso> + defaults to directory <c>users ~/.ssh</c>.</p> <p><em>Step 1.</em> To run the example without root privileges, generate new keys and host keys:</p> diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl index 94b9f3a196..923e9309f4 100644 --- a/lib/ssh/src/ssh.hrl +++ b/lib/ssh/src/ssh.hrl @@ -129,6 +129,8 @@ -type pubkey_alg() :: 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' | + 'ssh-ed25519' | + 'ssh-ed448' | 'rsa-sha2-256' | 'rsa-sha2-512' | 'ssh-dss' | @@ -173,7 +175,7 @@ -type common_options() :: [ common_option() ]. -type common_option() :: - user_dir_common_option() + ssh_file:user_dir_common_option() | profile_common_option() | max_idle_time_common_option() | key_cb_common_option() @@ -182,6 +184,7 @@ | ssh_msg_debug_fun_common_option() | rekey_limit_common_option() | id_string_common_option() + | pref_public_key_algs_common_option() | preferred_algorithms_common_option() | modify_algorithms_common_option() | auth_methods_common_option() @@ -191,8 +194,6 @@ -define(COMMON_OPTION, common_option()). - --type user_dir_common_option() :: {user_dir, false | string()}. -type profile_common_option() :: {profile, atom() }. -type max_idle_time_common_option() :: {idle_time, timeout()}. -type rekey_limit_common_option() :: {rekey_limit, Bytes::limit_bytes() | @@ -211,6 +212,7 @@ {ssh_msg_debug_fun, fun((ssh:connection_ref(),AlwaysDisplay::boolean(),Msg::binary(),LanguageTag::binary()) -> any()) } . -type id_string_common_option() :: {id_string, string() | random | {random,Nmin::pos_integer(),Nmax::pos_integer()} }. +-type pref_public_key_algs_common_option() :: {pref_public_key_algs, [pubkey_alg()] } . -type preferred_algorithms_common_option():: {preferred_algorithms, algs_list()}. -type modify_algorithms_common_option() :: {modify_algorithms, modify_algs_list()}. -type auth_methods_common_option() :: {auth_methods, string() }. @@ -223,14 +225,13 @@ {transport, {atom(),atom(),atom()} } | {vsn, {non_neg_integer(),non_neg_integer()} } | {tstflg, list(term())} - | {user_dir_fun, fun()} + | ssh_file:user_dir_fun_common_option() | {max_random_length_padding, non_neg_integer()} . -type client_option() :: - pref_public_key_algs_client_option() - | pubkey_passphrase_client_options() + ssh_file:pubkey_passphrase_client_options() | host_accepting_client_options() | authentication_client_options() | diffie_hellman_group_exchange_client_option() @@ -241,15 +242,14 @@ | ?COMMON_OPTION . -type opaque_client_options() :: - {keyboard_interact_fun, fun((term(),term(),term()) -> term())} + {keyboard_interact_fun, fun((Name::iodata(), + Instruction::iodata(), + Prompts::[{Prompt::iodata(),Echo::boolean()}] + ) -> + [Response::iodata()] + )} | opaque_common_options(). --type pref_public_key_algs_client_option() :: {pref_public_key_algs, [pubkey_alg()] } . - --type pubkey_passphrase_client_options() :: {dsa_pass_phrase, string()} - | {rsa_pass_phrase, string()} - | {ecdsa_pass_phrase, string()} . - -type host_accepting_client_options() :: {silently_accept_hosts, accept_hosts()} | {user_interaction, boolean()} @@ -299,8 +299,9 @@ -type 'shell_fun/1'() :: fun((User::string()) -> pid()) . -type 'shell_fun/2'() :: fun((User::string(), PeerAddr::inet:ip_address()) -> pid()). --type exec_daemon_option() :: {exec, 'exec_fun/1'() | 'exec_fun/2'() | 'exec_fun/3'() }. - +-type exec_daemon_option() :: {exec, exec_spec()} . +-type exec_spec() :: {direct, exec_fun()} . +-type exec_fun() :: 'exec_fun/1'() | 'exec_fun/2'() | 'exec_fun/3'(). -type 'exec_fun/1'() :: fun((Cmd::string()) -> exec_result()) . -type 'exec_fun/2'() :: fun((Cmd::string(), User::string()) -> exec_result()) . -type 'exec_fun/3'() :: fun((Cmd::string(), User::string(), ClientAddr::ip_port()) -> exec_result()) . @@ -311,7 +312,7 @@ -type send_ext_info_daemon_option() :: {send_ext_info, boolean()} . -type authentication_daemon_options() :: - {system_dir, string()} + ssh_file:system_dir_daemon_option() | {auth_method_kb_interactive_data, prompt_texts() } | {user_passwords, [{UserName::string(),Pwd::string()}]} | {password, string()} @@ -386,9 +387,6 @@ algorithms, %% #alg{} - key_cb, %% Private/Public key callback module - io_cb, %% Interaction callback module - send_mac = none, %% send MAC algorithm send_mac_key, %% key used in send MAC algorithm send_mac_size = 0, diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index 4e4aa440de..9632168e65 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -91,8 +91,10 @@ unique(L) -> %%%---- userauth_request_msg "callbacks" -password_msg([#ssh{opts = Opts, io_cb = IoCb, - user = User, service = Service} = Ssh0]) -> +password_msg([#ssh{opts = Opts, + user = User, + service = Service} = Ssh0]) -> + IoCb = ?GET_INTERNAL_OPT(io_cb, Opts), {Password,Ssh} = case ?GET_OPT(password, Opts) of undefined when IoCb == ssh_no_io -> @@ -137,9 +139,7 @@ keyboard_interactive_msg([#ssh{user = User, get_public_key(SigAlg, #ssh{opts = Opts}) -> KeyAlg = key_alg(SigAlg), - {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), - UserOpts = ?GET_OPT(user_options, Opts), - case KeyCb:user_key(KeyAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of + case ssh_transport:call_KeyCb(user_key, [KeyAlg], Opts) of {ok, PrivKey} -> try %% Check the key - the KeyCb may be a buggy plugin @@ -387,11 +387,9 @@ handle_userauth_info_request(#ssh_msg_userauth_info_request{name = Name, instruction = Instr, num_prompts = NumPrompts, data = Data}, - #ssh{opts = Opts, - io_cb = IoCb - } = Ssh) -> + #ssh{opts=Opts} = Ssh) -> PromptInfos = decode_keyboard_interactive_prompts(NumPrompts,Data), - case keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos) of + case keyboard_interact_get_responses(Opts, Name, Instr, PromptInfos) of not_ok -> not_ok; Responses -> @@ -498,9 +496,7 @@ get_password_option(Opts, User) -> pre_verify_sig(User, KeyBlob, Opts) -> try Key = public_key:ssh_decode(KeyBlob, ssh2_pubkey), % or exception - {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), - UserOpts = ?GET_OPT(user_options, Opts), - KeyCb:is_auth_key(Key, User, [{key_cb_private,KeyCbOpts}|UserOpts]) + ssh_transport:call_KeyCb(is_auth_key, [Key, User], Opts) catch _:_ -> false @@ -509,10 +505,8 @@ pre_verify_sig(User, KeyBlob, Opts) -> verify_sig(SessionId, User, Service, AlgBin, KeyBlob, SigWLen, #ssh{opts = Opts} = Ssh) -> try Alg = binary_to_list(AlgBin), - {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), - UserOpts = ?GET_OPT(user_options, Opts), Key = public_key:ssh_decode(KeyBlob, ssh2_pubkey), % or exception - true = KeyCb:is_auth_key(Key, User, [{key_cb_private,KeyCbOpts}|UserOpts]), + true = ssh_transport:call_KeyCb(is_auth_key, [Key, User], Opts), PlainText = build_sig_data(SessionId, User, Service, KeyBlob, Alg), <<?UINT32(AlgSigLen), AlgSig:AlgSigLen/binary>> = SigWLen, <<?UINT32(AlgLen), _Alg:AlgLen/binary, @@ -536,56 +530,78 @@ build_sig_data(SessionId, User, Service, KeyBlob, Alg) -> +key_alg('rsa-sha2-256') -> 'ssh-rsa'; +key_alg('rsa-sha2-512') -> 'ssh-rsa'; +key_alg(Alg) -> Alg. + +%%%================================================================ +%%% +%%% Keyboard-interactive +%%% + decode_keyboard_interactive_prompts(_NumPrompts, Data) -> ssh_message:decode_keyboard_interactive_prompts(Data, []). -keyboard_interact_get_responses(IoCb, Opts, Name, Instr, PromptInfos) -> - NumPrompts = length(PromptInfos), +keyboard_interact_get_responses(Opts, Name, Instr, PromptInfos) -> keyboard_interact_get_responses(?GET_OPT(user_interaction, Opts), ?GET_OPT(keyboard_interact_fun, Opts), - ?GET_OPT(password, Opts), IoCb, Name, - Instr, PromptInfos, Opts, NumPrompts). + ?GET_OPT(password, Opts), + Name, + Instr, + PromptInfos, + Opts). -keyboard_interact_get_responses(_, _, not_ok, _, _, _, _, _, _) -> +%% Don't re-try an already rejected password. This could happen if both keyboard-interactive +%% and password methods are tried: +keyboard_interact_get_responses(_, _, not_ok, _, _, _, _) -> not_ok; -keyboard_interact_get_responses(_, undefined, Password, _, _, _, _, _, - 1) when Password =/= undefined -> - [Password]; %% Password auth implemented with keyboard-interaction and passwd is known -keyboard_interact_get_responses(_, _, _, _, _, _, _, _, 0) -> + +%% Only one password requestedm and we have got one via the 'password' option for the daemon: +keyboard_interact_get_responses(_, undefined, Pwd, _, _, [_], _) when Pwd =/= undefined -> + [Pwd]; %% Password auth implemented with keyboard-interaction and passwd is known + +%% No password requested (keyboard-interactive): +keyboard_interact_get_responses(_, _, _, _, _, [], _) -> []; -keyboard_interact_get_responses(false, undefined, undefined, _, _, _, [Prompt|_], Opts, _) -> - ssh_no_io:read_line(Prompt, Opts); %% Throws error as keyboard interaction is not allowed -keyboard_interact_get_responses(true, undefined, _,IoCb, Name, Instr, PromptInfos, Opts, _) -> - keyboard_interact(IoCb, Name, Instr, PromptInfos, Opts); -keyboard_interact_get_responses(true, Fun, _Pwd, _IoCb, Name, Instr, PromptInfos, _Opts, NumPrompts) -> - keyboard_interact_fun(Fun, Name, Instr, PromptInfos, NumPrompts). - -keyboard_interact(IoCb, Name, Instr, Prompts, Opts) -> + +%% user_interaction is forbidden (by option user_interaction) and we have to ask +%% the user for one or more. +%% Throw an error: +keyboard_interact_get_responses(false, undefined, undefined, _, _, [Prompt|_], Opts) -> + ssh_no_io:read_line(Prompt, Opts); + +%% One or more passwords are requested, we may prompt the user and no fun is used +%% to get the responses: +keyboard_interact_get_responses(true, undefined, _, Name, Instr, PromptInfos, Opts) -> + prompt_user_for_passwords(Name, Instr, PromptInfos, Opts); + +%% The passwords are provided with a fun. Use that one! +keyboard_interact_get_responses(true, Fun, _Pwd, Name, Instr, PromptInfos, _Opts) -> + keyboard_interact_fun(Fun, Name, Instr, PromptInfos). + + + +prompt_user_for_passwords(Name, Instr, PromptInfos, Opts) -> + IoCb = ?GET_INTERNAL_OPT(io_cb, Opts), write_if_nonempty(IoCb, Name), write_if_nonempty(IoCb, Instr), lists:map(fun({Prompt, true}) -> IoCb:read_line(Prompt, Opts); ({Prompt, false}) -> IoCb:read_password(Prompt, Opts) end, - Prompts). + PromptInfos). -write_if_nonempty(_, "") -> ok; -write_if_nonempty(_, <<>>) -> ok; -write_if_nonempty(IoCb, Text) -> IoCb:format("~s~n",[Text]). - - -keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos, NumPrompts) -> - Prompts = lists:map(fun({Prompt, _Echo}) -> Prompt end, - PromptInfos), - case KbdInteractFun(Name, Instr, Prompts) of - Rs when length(Rs) == NumPrompts -> - Rs; - _Rs -> +keyboard_interact_fun(KbdInteractFun, Name, Instr, PromptInfos) -> + case KbdInteractFun(Name, Instr, PromptInfos) of + Responses when is_list(Responses), + length(Responses) == length(PromptInfos) -> + Responses; + _ -> nok end. -key_alg('rsa-sha2-256') -> 'ssh-rsa'; -key_alg('rsa-sha2-512') -> 'ssh-rsa'; -key_alg(Alg) -> Alg. +write_if_nonempty(_, "") -> ok; +write_if_nonempty(_, <<>>) -> ok; +write_if_nonempty(IoCb, Text) -> IoCb:format("~s~n",[Text]). diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 4b41c10cbb..7c87591cf2 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -447,7 +447,6 @@ init_ssh_record(Role, Socket, Opts) -> init_ssh_record(Role, Socket, PeerAddr, Opts) -> AuthMethods = ?GET_OPT(auth_methods, Opts), S0 = #ssh{role = Role, - key_cb = ?GET_OPT(key_cb, Opts), opts = Opts, userauth_supported_methods = AuthMethods, available_host_keys = available_hkey_algorithms(Role, Opts), @@ -472,10 +471,11 @@ init_ssh_record(Role, Socket, PeerAddr, Opts) -> S1 = S0#ssh{c_vsn = Vsn, c_version = Version, - io_cb = case ?GET_OPT(user_interaction, Opts) of - true -> ssh_io; - false -> ssh_no_io - end, + opts = ?PUT_INTERNAL_OPT({io_cb, case ?GET_OPT(user_interaction, Opts) of + true -> ssh_io; + false -> ssh_no_io + end}, + Opts), userauth_quiet_mode = ?GET_OPT(quiet_mode, Opts), peer = {PeerName, PeerAddr}, local = LocalName @@ -488,7 +488,6 @@ init_ssh_record(Role, Socket, PeerAddr, Opts) -> server -> S0#ssh{s_vsn = Vsn, s_version = Version, - io_cb = ?GET_INTERNAL_OPT(io_cb, Opts, ssh_io), userauth_methods = string:tokens(AuthMethods, ","), kb_tries_left = 3, peer = {undefined, PeerAddr}, @@ -983,6 +982,10 @@ handle_event(_, #ssh_msg_userauth_info_request{}, {userauth_keyboard_interactive %%% ######## {connected, client|server} #### +%% Skip ext_info messages in connected state (for example from OpenSSH >= 7.7) +handle_event(_, #ssh_msg_ext_info{}, {connected,_Role}, D) -> + {keep_state, D}; + handle_event(_, {#ssh_msg_kexinit{},_}, {connected,Role}, D0) -> {KeyInitMsg, SshPacket, Ssh} = ssh_transport:key_exchange_init_msg(D0#data.ssh_params), D = D0#data{ssh_params = Ssh, @@ -1682,18 +1685,19 @@ peer_role(client) -> server; peer_role(server) -> client. %%-------------------------------------------------------------------- -available_hkey_algorithms(Role, Options) -> - KeyCb = ?GET_OPT(key_cb, Options), - case [A || A <- available_hkey_algos(Options), - (Role==client) orelse available_host_key(KeyCb, A, Options) - ] of - - [] when Role==client -> - error({shutdown, "No public key algs"}); - - [] when Role==server -> - error({shutdown, "No host key available"}); +available_hkey_algorithms(client, Options) -> + case available_hkey_algos(Options) of + [] -> + error({shutdown, "No public key algs"}); + Algs -> + [atom_to_list(A) || A<-Algs] + end; +available_hkey_algorithms(server, Options) -> + case [A || A <- available_hkey_algos(Options), + is_usable_host_key(A, Options)] of + [] -> + error({shutdown, "No host key available"}); Algs -> [atom_to_list(A) || A<-Algs] end. @@ -1709,18 +1713,6 @@ available_hkey_algos(Options) -> AvailableAndSupported. -%% Alg :: atom() -available_host_key({KeyCb,KeyCbOpts}, Alg, Opts) -> - UserOpts = ?GET_OPT(user_options, Opts), - case KeyCb:host_key(Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {ok,Key} -> - %% Check the key - the KeyCb may be a buggy plugin - ssh_transport:valid_key_sha_alg(Key, Alg); - _ -> - false - end. - - send_msg(Msg, State=#data{ssh_params=Ssh0}) when is_tuple(Msg) -> {Bytes, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), send_bytes(Bytes, State), @@ -1840,10 +1832,21 @@ ext_info(_, D0) -> D0. %%%---------------------------------------------------------------- -is_usable_user_pubkey(A, Ssh) -> - case ssh_auth:get_public_key(A, Ssh) of +is_usable_user_pubkey(Alg, Ssh) -> + try ssh_auth:get_public_key(Alg, Ssh) of {ok,_} -> true; _ -> false + catch + _:_ -> false + end. + +%%%---------------------------------------------------------------- +is_usable_host_key(Alg, Opts) -> + try ssh_transport:get_host_key(Alg, Opts) + of + _PrivHostKey -> true + catch + _:_ -> false end. %%%---------------------------------------------------------------- diff --git a/lib/ssh/src/ssh_file.erl b/lib/ssh/src/ssh_file.erl index 832952ed52..510269bbb1 100644 --- a/lib/ssh/src/ssh_file.erl +++ b/lib/ssh/src/ssh_file.erl @@ -39,6 +39,24 @@ is_auth_key/3]). +-export_type([system_dir_daemon_option/0, + user_dir_common_option/0, + user_dir_fun_common_option/0, + pubkey_passphrase_client_options/0 + ]). + +-type system_dir_daemon_option() :: {system_dir, string()}. +-type user_dir_common_option() :: {user_dir, string()}. +-type user_dir_fun_common_option() :: {user_dir_fun, user2dir()}. +-type user2dir() :: fun((RemoteUserName::string()) -> UserDir :: string()) . + +-type pubkey_passphrase_client_options() :: {dsa_pass_phrase, string()} + | {rsa_pass_phrase, string()} +%% Not yet implemented: | {ed25519_pass_phrase, string()} +%% Not yet implemented: | {ed448_pass_phrase, string()} + | {ecdsa_pass_phrase, string()} . + + -define(PERM_700, 8#700). -define(PERM_644, 8#644). @@ -103,6 +121,8 @@ file_base_name('ssh-dss' ) -> "ssh_host_dsa_key"; file_base_name('ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; file_base_name('ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; file_base_name('ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key"; +file_base_name('ssh-ed25519' ) -> "ssh_host_ed25519_key"; +file_base_name('ssh-ed448' ) -> "ssh_host_ed448_key"; file_base_name(_ ) -> "ssh_host_key". decode(File, Password) -> @@ -240,6 +260,8 @@ identity_key_filename('ssh-rsa' ) -> "id_rsa"; identity_key_filename('rsa-sha2-256' ) -> "id_rsa"; identity_key_filename('rsa-sha2-384' ) -> "id_rsa"; identity_key_filename('rsa-sha2-512' ) -> "id_rsa"; +identity_key_filename('ssh-ed25519' ) -> "id_ed25519"; +identity_key_filename('ssh-ed448' ) -> "id_ed448"; identity_key_filename('ecdsa-sha2-nistp256') -> "id_ecdsa"; identity_key_filename('ecdsa-sha2-nistp384') -> "id_ecdsa"; identity_key_filename('ecdsa-sha2-nistp521') -> "id_ecdsa". @@ -249,9 +271,12 @@ identity_pass_phrase("ssh-rsa" ) -> rsa_pass_phrase; identity_pass_phrase("rsa-sha2-256" ) -> rsa_pass_phrase; identity_pass_phrase("rsa-sha2-384" ) -> rsa_pass_phrase; identity_pass_phrase("rsa-sha2-512" ) -> rsa_pass_phrase; +%% Not yet implemented: identity_pass_phrase("ssh-ed25519" ) -> ed25519_pass_phrase; +%% Not yet implemented: identity_pass_phrase("ssh-ed448" ) -> ed448_pass_phrase; identity_pass_phrase("ecdsa-sha2-"++_) -> ecdsa_pass_phrase; identity_pass_phrase(P) when is_atom(P) -> - identity_pass_phrase(atom_to_list(P)). + identity_pass_phrase(atom_to_list(P)); +identity_pass_phrase(_) -> undefined. lookup_host_key_fd(Fd, KeyToMatch, Host, KeyType) -> case io:get_line(Fd, '') of @@ -301,6 +326,10 @@ key_match({#'ECPoint'{},{namedCurve,Curve}}, Alg) -> _ -> false end; +key_match({ed_pub,ed25519,_}, 'ssh-ed25519') -> + true; +key_match({ed_pub,ed448,_}, 'ssh-ed448') -> + true; key_match(_, _) -> false. diff --git a/lib/ssh/src/ssh_message.erl b/lib/ssh/src/ssh_message.erl index da4027a763..d95e58c1bb 100644 --- a/lib/ssh/src/ssh_message.erl +++ b/lib/ssh/src/ssh_message.erl @@ -611,7 +611,13 @@ encode_signature({_, #'Dss-Parms'{}}, _SigAlg, Signature) -> <<?Ebinary(<<"ssh-dss">>), ?Ebinary(Signature)>>; encode_signature({#'ECPoint'{}, {namedCurve,OID}}, _SigAlg, Signature) -> CurveName = public_key:oid2ssh_curvename(OID), - <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>. + <<?Ebinary(<<"ecdsa-sha2-",CurveName/binary>>), ?Ebinary(Signature)>>; +encode_signature({ed_pub, ed25519,_}, _SigAlg, Signature) -> + <<?Ebinary(<<"ssh-ed25519">>), ?Ebinary(Signature)>>; +encode_signature({ed_pub, ed448,_}, _SigAlg, Signature) -> + <<?Ebinary(<<"ssh-ed448">>), ?Ebinary(Signature)>>. + + %%%################################################################ %%%# diff --git a/lib/ssh/src/ssh_options.erl b/lib/ssh/src/ssh_options.erl index bc9f2156bc..1010c9be55 100644 --- a/lib/ssh/src/ssh_options.erl +++ b/lib/ssh/src/ssh_options.erl @@ -434,6 +434,18 @@ default(client) -> class => user_options }, +%%% Not yet implemented {ed25519_pass_phrase, def} => +%%% Not yet implemented #{default => undefined, +%%% Not yet implemented chk => fun check_string/1, +%%% Not yet implemented class => user_options +%%% Not yet implemented }, +%%% Not yet implemented +%%% Not yet implemented {ed448_pass_phrase, def} => +%%% Not yet implemented #{default => undefined, +%%% Not yet implemented chk => fun check_string/1, +%%% Not yet implemented class => user_options +%%% Not yet implemented }, +%%% Not yet implemented {silently_accept_hosts, def} => #{default => false, chk => fun check_silently_accept_hosts/1, @@ -452,12 +464,6 @@ default(client) -> class => user_options }, - {pref_public_key_algs, def} => - #{default => ssh_transport:default_algorithms(public_key), - chk => fun check_pref_public_key_algs/1, - class => user_options - }, - {dh_gex_limits, def} => #{default => {1024, 6144, 8192}, % FIXME: Is this true nowadays? chk => fun({Min,I,Max}) -> @@ -523,6 +529,12 @@ default(common) -> class => user_options }, + {pref_public_key_algs, def} => + #{default => ssh_transport:default_algorithms(public_key), + chk => fun check_pref_public_key_algs/1, + class => user_options + }, + {preferred_algorithms, def} => #{default => ssh:default_algorithms(), chk => fun check_preferred_algorithms/1, diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl index c5b0704925..9ff20454cd 100644 --- a/lib/ssh/src/ssh_transport.erl +++ b/lib/ssh/src/ssh_transport.erl @@ -51,7 +51,9 @@ extract_public_key/1, ssh_packet/2, pack/2, valid_key_sha_alg/2, - sha/1, sign/3, verify/5]). + sha/1, sign/3, verify/5, + get_host_key/2, + call_KeyCb/3]). -export([dbg_trace/3]). @@ -147,6 +149,8 @@ supported_algorithms(public_key) -> {'ecdsa-sha2-nistp384', [{public_keys,ecdsa}, {hashs,sha384}, {curves,secp384r1}]}, {'ecdsa-sha2-nistp521', [{public_keys,ecdsa}, {hashs,sha512}, {curves,secp521r1}]}, {'ecdsa-sha2-nistp256', [{public_keys,ecdsa}, {hashs,sha256}, {curves,secp256r1}]}, + {'ssh-ed25519', [{public_keys,eddsa}, {curves,ed25519} ]}, + {'ssh-ed448', [{public_keys,eddsa}, {curves,ed448} ]}, {'ssh-rsa', [{public_keys,rsa}, {hashs,sha} ]}, {'rsa-sha2-256', [{public_keys,rsa}, {hashs,sha256} ]}, {'rsa-sha2-512', [{public_keys,rsa}, {hashs,sha512} ]}, @@ -431,7 +435,8 @@ key_exchange_first_msg(Kex, Ssh0) when Kex == 'ecdh-sha2-nistp256' ; %%% handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Ssh0 = #ssh{algorithms = #alg{kex=Kex, - hkey=SignAlg} = Algs}) -> + hkey=SignAlg} = Algs, + opts = Opts}) -> %% server {G, P} = dh_group(Kex), if @@ -439,7 +444,7 @@ handle_kexdh_init(#ssh_msg_kexdh_init{e = E}, Sz = dh_bits(Algs), {Public, Private} = generate_key(dh, [P,G,2*Sz]), K = compute_key(dh, E, Private, [P,G]), - MyPrivHostKey = get_host_key(Ssh0, SignAlg), + MyPrivHostKey = get_host_key(SignAlg, Opts), MyPubHostKey = extract_public_key(MyPrivHostKey), H = kex_hash(Ssh0, MyPubHostKey, sha(Kex), {E,Public,K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), @@ -578,14 +583,15 @@ handle_kex_dh_gex_init(#ssh_msg_kex_dh_gex_init{e = E}, #ssh{keyex_key = {{Private, Public}, {G, P}}, keyex_info = {Min, Max, NBits}, algorithms = #alg{kex=Kex, - hkey=SignAlg}} = Ssh0) -> + hkey=SignAlg}, + opts = Opts} = Ssh0) -> %% server if 1=<E, E=<(P-1) -> K = compute_key(dh, E, Private, [P,G]), if 1<K, K<(P-1) -> - MyPrivHostKey = get_host_key(Ssh0, SignAlg), + MyPrivHostKey = get_host_key(SignAlg, Opts), MyPubHostKey = extract_public_key(MyPrivHostKey), H = kex_hash(Ssh0, MyPubHostKey, sha(Kex), {Min,NBits,Max,P,G,E,Public,K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), @@ -653,7 +659,8 @@ handle_kex_dh_gex_reply(#ssh_msg_kex_dh_gex_reply{public_host_key = PeerPubHostK %%% handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, Ssh0 = #ssh{algorithms = #alg{kex=Kex, - hkey=SignAlg}}) -> + hkey=SignAlg}, + opts = Opts}) -> %% at server Curve = ecdh_curve(Kex), {MyPublic, MyPrivate} = generate_key(ecdh, Curve), @@ -661,7 +668,7 @@ handle_kex_ecdh_init(#ssh_msg_kex_ecdh_init{q_c = PeerPublic}, compute_key(ecdh, PeerPublic, MyPrivate, Curve) of K -> - MyPrivHostKey = get_host_key(Ssh0, SignAlg), + MyPrivHostKey = get_host_key(SignAlg, Opts), MyPubHostKey = extract_public_key(MyPrivHostKey), H = kex_hash(Ssh0, MyPubHostKey, sha(Curve), {PeerPublic, MyPublic, K}), H_SIG = sign(H, sha(SignAlg), MyPrivHostKey), @@ -759,8 +766,7 @@ ext_info_message(#ssh{role=server, send_ext_info=true, opts = Opts} = Ssh0) -> AlgsList = lists:map(fun erlang:atom_to_list/1, - proplists:get_value(public_key, - ?GET_OPT(preferred_algorithms, Opts))), + ?GET_OPT(pref_public_key_algs, Opts)), Msg = #ssh_msg_ext_info{nr_extensions = 1, data = [{"server-sig-algs", string:join(AlgsList,",")}] }, @@ -778,10 +784,8 @@ sid(#ssh{session_id = Id}, _) -> Id. %% %% The host key should be read from storage %% -get_host_key(SSH, SignAlg) -> - #ssh{key_cb = {KeyCb,KeyCbOpts}, opts = Opts} = SSH, - UserOpts = ?GET_OPT(user_options, Opts), - case KeyCb:host_key(SignAlg, [{key_cb_private,KeyCbOpts}|UserOpts]) of +get_host_key(SignAlg, Opts) -> + case call_KeyCb(host_key, [SignAlg], Opts) of {ok, PrivHostKey} -> %% Check the key - the KeyCb may be a buggy plugin case valid_key_sha_alg(PrivHostKey, SignAlg) of @@ -792,6 +796,11 @@ get_host_key(SSH, SignAlg) -> exit({error, {Result, unsupported_key_type}}) end. +call_KeyCb(F, Args, Opts) -> + {KeyCb,KeyCbOpts} = ?GET_OPT(key_cb, Opts), + UserOpts = ?GET_OPT(user_options, Opts), + apply(KeyCb, F, Args ++ [[{key_cb_private,KeyCbOpts}|UserOpts]]). + extract_public_key(#'RSAPrivateKey'{modulus = N, publicExponent = E}) -> #'RSAPublicKey'{modulus = N, publicExponent = E}; extract_public_key(#'DSAPrivateKey'{y = Y, p = P, q = Q, g = G}) -> @@ -799,6 +808,8 @@ extract_public_key(#'DSAPrivateKey'{y = Y, p = P, q = Q, g = G}) -> extract_public_key(#'ECPrivateKey'{parameters = {namedCurve,OID}, publicKey = Q}) -> {#'ECPoint'{point=Q}, {namedCurve,OID}}; +extract_public_key({ed_pri, Alg, Pub, _Priv}) -> + {ed_pub, Alg, Pub}; extract_public_key(#{engine:=_, key_id:=_, algorithm:=Alg} = M) -> case {Alg, crypto:privkey_to_pubkey(Alg, M)} of {rsa, [E,N]} -> @@ -858,29 +869,30 @@ accepted_host(Ssh, PeerName, Public, Opts) -> end. -yes_no(Ssh, Prompt) -> - (Ssh#ssh.io_cb):yes_no(Prompt, Ssh#ssh.opts). +yes_no(#ssh{opts=Opts}, Prompt) -> + IoCb = ?GET_INTERNAL_OPT(io_cb, Opts, ssh_io), + IoCb:yes_no(Prompt, Opts). fmt_hostkey('ssh-rsa') -> "RSA"; fmt_hostkey('ssh-dss') -> "DSA"; +fmt_hostkey('ssh-ed25519') -> "ED25519"; +fmt_hostkey('ssh-ed448') -> "ED448"; fmt_hostkey(A) when is_atom(A) -> fmt_hostkey(atom_to_list(A)); fmt_hostkey("ecdsa"++_) -> "ECDSA"; fmt_hostkey(X) -> X. -known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_}} = Ssh, +known_host_key(#ssh{opts = Opts, peer = {PeerName,_}} = Ssh, Public, Alg) -> - UserOpts = ?GET_OPT(user_options, Opts), - case is_host_key(KeyCb, Public, PeerName, Alg, [{key_cb_private,KeyCbOpts}|UserOpts]) of - {_,true} -> + case call_KeyCb(is_host_key, [Public, PeerName, Alg], Opts) of + true -> ok; - {_,false} -> + false -> DoAdd = ?GET_OPT(save_accepted_host, Opts), case accepted_host(Ssh, PeerName, Public, Opts) of true when DoAdd == true -> - {_,R} = add_host_key(KeyCb, PeerName, Public, [{key_cb_private,KeyCbOpts}|UserOpts]), - R; + call_KeyCb(add_host_key, [PeerName, Public], Opts); true when DoAdd == false -> ok; false -> @@ -890,13 +902,6 @@ known_host_key(#ssh{opts = Opts, key_cb = {KeyCb,KeyCbOpts}, peer = {PeerName,_} end end. -is_host_key(KeyCb, Public, PeerName, Alg, Data) -> - {KeyCb, KeyCb:is_host_key(Public, PeerName, Alg, Data)}. - -add_host_key(KeyCb, PeerName, Public, Data) -> - {KeyCb, KeyCb:add_host_key(PeerName, Public, Data)}. - - %% Each of the algorithm strings MUST be a comma-separated list of %% algorithm names (see ''Algorithm Naming'' in [SSH-ARCH]). Each %% supported (allowed) algorithm MUST be listed in order of preference. @@ -1937,6 +1942,11 @@ valid_key_sha_alg(#'RSAPrivateKey'{}, 'ssh-rsa' ) -> true; valid_key_sha_alg({_, #'Dss-Parms'{}}, 'ssh-dss') -> true; valid_key_sha_alg(#'DSAPrivateKey'{}, 'ssh-dss') -> true; +valid_key_sha_alg({ed_pub, ed25519,_}, 'ssh-ed25519') -> true; +valid_key_sha_alg({ed_pri, ed25519,_,_},'ssh-ed25519') -> true; +valid_key_sha_alg({ed_pub, ed448,_}, 'ssh-ed448') -> true; +valid_key_sha_alg({ed_pri, ed448,_,_}, 'ssh-ed448') -> true; + valid_key_sha_alg({#'ECPoint'{},{namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); valid_key_sha_alg(#'ECPrivateKey'{parameters = {namedCurve,OID}}, Alg) -> valid_key_sha_alg_ec(OID, Alg); valid_key_sha_alg(_, _) -> false. @@ -1946,12 +1956,17 @@ valid_key_sha_alg_ec(OID, Alg) -> Alg == list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). +-dialyzer({no_match, public_algo/1}). + public_algo(#'RSAPublicKey'{}) -> 'ssh-rsa'; % FIXME: Not right with draft-curdle-rsa-sha2 public_algo({_, #'Dss-Parms'{}}) -> 'ssh-dss'; +public_algo({ed_pub, ed25519,_}) -> 'ssh-ed25519'; +public_algo({ed_pub, ed448,_}) -> 'ssh-ed448'; public_algo({#'ECPoint'{},{namedCurve,OID}}) -> Curve = public_key:oid2ssh_curvename(OID), list_to_atom("ecdsa-sha2-" ++ binary_to_list(Curve)). + sha('ssh-rsa') -> sha; sha('rsa-sha2-256') -> sha256; sha('rsa-sha2-384') -> sha384; @@ -1960,6 +1975,8 @@ sha('ssh-dss') -> sha; sha('ecdsa-sha2-nistp256') -> sha(secp256r1); sha('ecdsa-sha2-nistp384') -> sha(secp384r1); sha('ecdsa-sha2-nistp521') -> sha(secp521r1); +sha('ssh-ed25519') -> undefined; % Included in the spec of ed25519 +sha('ssh-ed448') -> undefined; % Included in the spec of ed448 sha(secp256r1) -> sha256; sha(secp384r1) -> sha384; sha(secp521r1) -> sha512; @@ -2054,7 +2071,6 @@ ecdh_curve('curve448-sha512' ) -> x448; ecdh_curve('curve25519-sha256' ) -> x25519; ecdh_curve('[email protected]' ) -> x25519. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% %% Utils for default_algorithms/1 and supported_algorithms/1 diff --git a/lib/ssh/test/.gitignore b/lib/ssh/test/.gitignore new file mode 100644 index 0000000000..c9d5f086b3 --- /dev/null +++ b/lib/ssh/test/.gitignore @@ -0,0 +1,5 @@ + + +property_test/ssh_eqc_client_server_dirs/system +property_test/ssh_eqc_client_server_dirs/user + diff --git a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl index 6d0d8f5d99..f4b521356f 100644 --- a/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl +++ b/lib/ssh/test/property_test/ssh_eqc_client_info_timing.erl @@ -58,6 +58,7 @@ %%% Properties: prop_seq(Config) -> + error_logger:tty(false), {ok,Pid} = ssh_eqc_event_handler:add_report_handler(), {_, _, Port} = init_daemon(Config), numtests(1000, @@ -66,16 +67,25 @@ prop_seq(Config) -> send_bad_sequence(Port, Delay, Pid), not any_relevant_error_report(Pid) catch - C:E -> io:format('~p:~p~n',[C,E]), + C:E:S -> ct:log("~p:~p~n~p",[C,E,S]), false end )). send_bad_sequence(Port, Delay, Pid) -> - {ok,S} = gen_tcp:connect("localhost",Port,[]), - gen_tcp:send(S,"Illegal info-string\r\n"), - ssh_test_lib:sleep_microsec(Delay), - gen_tcp:close(S). + send_bad_sequence(Port, Delay, Pid, 10). + +send_bad_sequence(Port, Delay, Pid, N) -> + case gen_tcp:connect("localhost",Port,[]) of + {ok,S} -> + gen_tcp:send(S,"Illegal info-string\r\n"), + ssh_test_lib:sleep_microsec(Delay), + gen_tcp:close(S); + + {error,econnreset} when N>0 -> + timer:sleep(1), + send_bad_sequence(Port, Delay, Pid, N-1) + end. any_relevant_error_report(Pid) -> {ok, Reports} = ssh_eqc_event_handler:get_reports(Pid), diff --git a/lib/ssh/test/property_test/ssh_eqc_client_server.erl b/lib/ssh/test/property_test/ssh_eqc_client_server.erl index 39d0b4e410..acb0faa0c7 100644 --- a/lib/ssh/test/property_test/ssh_eqc_client_server.erl +++ b/lib/ssh/test/property_test/ssh_eqc_client_server.erl @@ -22,25 +22,27 @@ -module(ssh_eqc_client_server). -compile(export_all). + +-proptest([proper]). --include_lib("common_test/include/ct.hrl"). - --ifdef(PROPER). -%% Proper is not supported. --else. --ifdef(TRIQ). -%% Proper is not supported. +-ifndef(PROPER). -else. +%% Only use proper +%% +%% Previously only EQC was supported, but the changes to support PROPER is not +%% just a wrapper. Since we do not have access to eqc we can't test the changes +%% so therefore eqc is disabeled. +%% However, with access to eqc it ought to be quite easy to re-enable eqc by +%% studying the diff. +-include_lib("proper/include/proper.hrl"). +-define(MOD_eqc,proper). + +-include_lib("common_test/include/ct.hrl"). %% Limit the testing time on CI server... this needs to be improved in % from total budget. -define(TESTINGTIME(Prop), eqc:testing_time(30,Prop)). - --include_lib("eqc/include/eqc.hrl"). --include_lib("eqc/include/eqc_statem.hrl"). --eqc_group_commands(true). - -define(SSH_DIR,"ssh_eqc_client_server_dirs"). -define(sec, *1000). @@ -51,10 +53,6 @@ port }). --record(conn,{ref, - srvr_ref - }). - -record(chan, {ref, conn_ref, subsystem, @@ -65,7 +63,7 @@ initialized = false, servers = [], % [#srvr{}] clients = [], - connections = [], % [#conn{}] + connections = [], channels = [], % [#chan{}] data_dir }). @@ -80,9 +78,8 @@ -define(SUBSYSTEMS, ["echo1", "echo2", "echo3", "echo4"]). --define(SERVER_ADDRESS, { {127,1,0,choose(1,254)}, % IP - choose(1024,65535) % Port - }). +-define(SERVER_ADDRESS, {127,0,0,1}). % Server listening IP. Darwin, Solaris & FreeBSD + % dislikes all other in 127.0.0.0/24 -define(SERVER_EXTRA_OPTIONS, [{parallel_login,bool()}] ). @@ -104,10 +101,12 @@ %% To be called as eqc:quickcheck( ssh_eqc_client_server:prop_seq() ). prop_seq() -> - ?TESTINGTIME(do_prop_seq(?SSH_DIR)). + error_logger:tty(false), + ?TESTINGTIME(do_prop_seq(?SSH_DIR)). %% To be called from a common_test test suite prop_seq(CT_Config) -> + error_logger:tty(false), do_prop_seq(full_path(?SSH_DIR, CT_Config)). @@ -124,10 +123,12 @@ full_path(SSHdir, CT_Config) -> SSHdir). %%%---- prop_parallel() -> + error_logger:tty(false), ?TESTINGTIME(do_prop_parallel(?SSH_DIR)). %% To be called from a common_test test suite prop_parallel(CT_Config) -> + error_logger:tty(false), do_prop_parallel(full_path(?SSH_DIR, CT_Config)). do_prop_parallel(DataDir) -> @@ -139,22 +140,22 @@ do_prop_parallel(DataDir) -> end). %%%---- -prop_parallel_multi() -> - ?TESTINGTIME(do_prop_parallel_multi(?SSH_DIR)). - -%% To be called from a common_test test suite -prop_parallel_multi(CT_Config) -> - do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). - -do_prop_parallel_multi(DataDir) -> - setup_rsa(DataDir), - ?FORALL(Repetitions,?SHRINK(1,[10]), - ?FORALL(Cmds,parallel_commands(?MODULE), - ?ALWAYS(Repetitions, - begin - {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds,[{data_dir,DataDir}]), - present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) - end))). +%% prop_parallel_multi() -> +%% ?TESTINGTIME(do_prop_parallel_multi(?SSH_DIR)). + +%% %% To be called from a common_test test suite +%% prop_parallel_multi(CT_Config) -> +%% do_prop_parallel_multi(full_path(?SSH_DIR, CT_Config)). + +%% do_prop_parallel_multi(DataDir) -> +%% setup_rsa(DataDir), +%% ?FORALL(Repetitions,?SHRINK(1,[10]), +%% ?FORALL(Cmds,parallel_commands(?MODULE), +%% ?ALWAYS(Repetitions, +%% begin +%% {H,Sf,Result} = run_parallel_commands(?MODULE,Cmds,[{data_dir,DataDir}]), +%% present_result(?MODULE, Cmds, {H,Sf,Result}, Result==ok) +%% end))). %%%================================================================ %%% State machine spec @@ -169,13 +170,50 @@ initial_state(DataDir) -> ssh:start(). %%%---------------- -weight(S, ssh_send) -> 5*length([C || C<-S#state.channels, has_subsyst(C)]); -weight(S, ssh_start_subsyst) -> 3*length([C || C<-S#state.channels, no_subsyst(C)]); +weight(S, ssh_send) -> 20*length([C || C<-S#state.channels, has_subsyst(C)]); +weight(S, ssh_start_subsyst) -> 10*length([C || C<-S#state.channels, no_subsyst(C)]); weight(S, ssh_close_channel) -> 2*length([C || C<-S#state.channels, has_subsyst(C)]); -weight(S, ssh_open_channel) -> length(S#state.connections); +weight(S, ssh_open_channel) -> 2*length(S#state.connections); weight(_S, _) -> 1. %%%---------------- +fns() -> [initial_state, + ssh_server, + ssh_client, + ssh_open_connection, + ssh_close_connection, + ssh_open_channel, + ssh_close_channel, + ssh_start_subsyst, + ssh_send + ]. + +call_f(Name, Sfx) -> + case get({Name,Sfx}) of + undefined -> F = list_to_atom(lists:concat([Name,"_",Sfx])), + put({Name,Sfx}, F), + F; + F when is_atom(F) -> F + end. + +-define(call(Name, What, Args), apply(?MODULE, call_f(Name,What), Args)). + +symbolic_call(S,Name) -> {call, ?MODULE, Name, ?call(Name,args,[S])}. + +may_generate(S, F) -> ?call(F,pre,[S]). + +command(S) -> + frequency([{weight(S,F), symbolic_call(S,F)} || F <- fns(), + may_generate(S, F)] + ). + +precondition(S, {call,_M,F,As}) -> try ?call(F, pre, [S,As]) + catch _:undef -> try ?call(F,pre,[S]) catch _:undef -> true end + end. +next_state(S, Res, {call,_M,F,As}) -> try ?call(F, next, [S,Res,As]) catch _:undef -> S end. +postcondition(S, {call,_M,F,As}, Res) -> try ?call(F, post, [S,As,Res]) catch _:undef -> true end. + +%%%---------------- %%% Initialize initial_state_pre(S) -> not S#state.initialized. @@ -200,24 +238,34 @@ ssh_server_pre(S) -> S#state.initialized andalso ssh_server_args(_) -> [?SERVER_ADDRESS, {var,data_dir}, ?SERVER_EXTRA_OPTIONS]. -ssh_server({IP,Port}, DataDir, ExtraOptions) -> - ok(ssh:daemon(IP, Port, - [ - {system_dir, system_dir(DataDir)}, - {user_dir, user_dir(DataDir)}, - {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} - | ExtraOptions - ])). - -ssh_server_post(_S, _Args, {error,eaddrinuse}) -> true; -ssh_server_post(_S, _Args, Result) -> is_ok(Result). - -ssh_server_next(S, {error,eaddrinuse}, _) -> S; -ssh_server_next(S, Result, [{IP,Port},_,_]) -> - S#state{servers=[#srvr{ref = Result, - address = IP, - port = Port} - | S#state.servers]}. +ssh_server(IP0, DataDir, ExtraOptions) -> + case ssh:daemon(IP0, 0, + [ + {system_dir, system_dir(DataDir)}, + {user_dir, user_dir(DataDir)}, + {subsystems, [{SS, {ssh_eqc_subsys, [SS]}} || SS <- ?SUBSYSTEMS]} + | ExtraOptions + ]) of + {ok,DaemonRef} -> + case ssh:daemon_info(DaemonRef) of + {ok, Props} -> + Port = proplists:get_value(port,Props), + IP = proplists:get_value(ip,Props), + #srvr{ref = DaemonRef, + address = IP, + port = Port}; + Other -> + Other + end; + Other -> + Other + end. + +ssh_server_post(_S, _Args, #srvr{port=Port}) -> (0 < Port) andalso (Port < 65536); +ssh_server_post(_S, _Args, _) -> false. + +ssh_server_next(S, Srvr, _) -> + S#state{servers=[Srvr | S#state.servers]}. %%%---------------- %%% Start a new client @@ -271,8 +319,7 @@ ssh_open_connection(#srvr{address=Ip, port=Port}, DataDir) -> ssh_open_connection_post(_S, _Args, Result) -> is_ok(Result). -ssh_open_connection_next(S, ConnRef, [#srvr{ref=SrvrRef},_]) -> - S#state{connections=[#conn{ref=ConnRef, srvr_ref=SrvrRef}|S#state.connections]}. +ssh_open_connection_next(S, ConnRef, [_,_]) -> S#state{connections=[ConnRef|S#state.connections]}. %%%---------------- %%% Stop a new connection @@ -282,12 +329,12 @@ ssh_close_connection_pre(S) -> S#state.connections /= []. ssh_close_connection_args(S) -> [oneof(S#state.connections)]. -ssh_close_connection(#conn{ref=ConnectionRef}) -> ssh:close(ConnectionRef). +ssh_close_connection(ConnectionRef) -> ssh:close(ConnectionRef). -ssh_close_connection_next(S, _, [Conn=#conn{ref=ConnRef}]) -> - S#state{connections = S#state.connections--[Conn], - channels = [C || C <- S#state.channels, - C#chan.conn_ref /= ConnRef] +ssh_close_connection_next(S, _, [ConnRef]) -> + S#state{connections = S#state.connections--[ConnRef], + channels = [C || C <- S#state.channels, + C#chan.conn_ref /= ConnRef] }. %%%---------------- @@ -299,14 +346,14 @@ ssh_open_channel_pre(S) -> S#state.connections /= []. ssh_open_channel_args(S) -> [oneof(S#state.connections)]. %%% For re-arrangement in parallel tests. -ssh_open_channel_pre(S,[C]) -> lists:member(C,S#state.connections). +ssh_open_channel_pre(S,[C]) when is_record(S,state) -> lists:member(C,S#state.connections). -ssh_open_channel(#conn{ref=ConnectionRef}) -> +ssh_open_channel(ConnectionRef) -> ok(ssh_connection:session_channel(ConnectionRef, 20?sec)). ssh_open_channel_post(_S, _Args, Result) -> is_ok(Result). -ssh_open_channel_next(S, ChannelRef, [#conn{ref=ConnRef}]) -> +ssh_open_channel_next(S, ChannelRef, [ConnRef]) -> S#state{channels=[#chan{ref=ChannelRef, conn_ref=ConnRef} | S#state.channels]}. @@ -326,9 +373,7 @@ ssh_close_channel_next(S, _, [C]) -> S#state{channels = [Ci || Ci <- S#state.channels, sig(C) /= sig(Ci)]}. - sig(C) -> {C#chan.ref, C#chan.conn_ref}. - %%%---------------- %%% Start a sub system on a channel @@ -361,9 +406,10 @@ ssh_start_subsyst_next(S, _Result, [C,SS,Pid|_]) -> ssh_send_pre(S) -> lists:any(fun has_subsyst/1, S#state.channels). -ssh_send_args(S) -> [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), - choose(0,1), - message()]. +ssh_send_args(S) -> + [oneof(lists:filter(fun has_subsyst/1, S#state.channels)), + choose(0,1), + message()]. %% For re-arrangement in parallel tests. ssh_send_pre(S, [C|_]) -> lists:member(C, S#state.channels). @@ -388,17 +434,17 @@ ssh_send(C=#chan{conn_ref=ConnectionRef, ref=ChannelRef, client_pid=Pid}, Type, end). ssh_send_blocking(_S, _Args) -> - true. + true. ssh_send_post(_S, [C,_,Msg], Response) when is_binary(Response) -> - Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), + Expected = ssh_eqc_subsys:response(modify_msg(C,Msg), C#chan.subsystem), case Response of Expected -> true; _ -> {send_failed, size(Response), size(Expected)} end; ssh_send_post(_S, _Args, Response) -> - {error,Response}. + {error,Response}. modify_msg(_, <<>>) -> <<>>; @@ -440,7 +486,11 @@ present_result(_Module, Cmds, _Triple, true) -> true))))); present_result(Module, Cmds, Triple, false) -> - pretty_commands(Module, Cmds, Triple, [{show_states,true}], false). + pretty_comands(Module, Cmds, Triple, [{show_states,true}], false), + false. % Proper dislikes non-boolean results while eqc treats non-true as false. + +pretty_comands(Module, Cmds, Triple, Opts, Bool) -> + ct:log("Module = ~p,~n Cmds = ~p,~n Triple = ~p,~n Opts = ~p,~n Bool = ~p",[Module, Cmds, Triple, Opts, Bool]). @@ -476,23 +526,35 @@ traverse_commands(Fseq, Fpar, {Seq, ParLs}) -> lists:append([Fseq(Seq)|Fpar(ParL print_frequencies() -> print_frequencies(10). print_frequencies(Ngroups) -> fun([]) -> io:format('Empty list!~n',[]); - (L ) -> print_frequencies(L,Ngroups,0,element(1,lists:last(L))) + (L ) -> + try + M = lists:last(L), + Max = if is_integer(M) -> M; + is_tuple(M) -> element(1,L) + end, + print_frequencies(L,Ngroups,0,Max) + catch + C:E:S -> + ct:pal("~p:~p ~p:~p~n~p~n~p",[?MODULE,?LINE,C,E,S,L]) + end end. + print_frequencies(Ngroups, MaxValue) -> fun(L) -> print_frequencies(L,Ngroups,0,MaxValue) end. print_frequencies(L, N, Min, Max) when N>Max -> print_frequencies(L++[{N,0}], N, Min, N); -print_frequencies(L, N, Min, Max) -> -%%io:format('L=~p~n',[L]), +print_frequencies(L, N, Min, Max0) -> try + Interval = round((Max0-Min)/N), + Max = Max0 + (Max0 rem Interval), IntervalUpperLimits = lists:reverse( - [Max | tl(lists:reverse(lists:seq(Min,Max,round((Max-Min)/N))))] + [Max | tl(lists:reverse(lists:seq(Min,Max,Interval)))] ), {Acc0,_} = lists:mapfoldl(fun(Upper,Lower) -> {{{Lower,Upper},0}, Upper+1} end, hd(IntervalUpperLimits), tl(IntervalUpperLimits)), - Fs0 = get_frequencies(L, Acc0), + Fs0 = get_frequencies(L, Acc0), SumVal = lists:sum([V||{_,V}<-Fs0]), Fs = with_percentage(Fs0, SumVal), Mean = mean(L), @@ -517,7 +579,6 @@ print_frequencies(L, N, Min, Max) -> || {Interval={Rlow,Rhigh},Val,Percent} <- Fs], io:format('~*c ~*c~n',[2*Npos_range,32,Npos_value+2,$-]), io:format('~*c ~*w~n',[2*Npos_range,32,Npos_value,SumVal]) - %%,io:format('L=~p~n',[L]) catch C:E -> io:format('*** Faild printing (~p:~p) for~n~p~n',[C,E,L]) @@ -527,6 +588,8 @@ get_frequencies([{I,Num}|T], [{{Lower,Upper},Cnt}|Acc]) when Lower=<I,I=<Upper - get_frequencies(T, [{{Lower,Upper},Cnt+Num}|Acc]); get_frequencies(L=[{I,_Num}|_], [Ah={{_Lower,Upper},_Cnt}|Acc]) when I>Upper -> [Ah | get_frequencies(L,Acc)]; +get_frequencies([I|T], Acc) when is_integer(I) -> + get_frequencies([{I,1}|T], Acc); get_frequencies([], Acc) -> Acc. @@ -616,4 +679,3 @@ erase_dir(Dir) -> file:del_dir(Dir). -endif. --endif. diff --git a/lib/ssh/test/ssh_algorithms_SUITE.erl b/lib/ssh/test/ssh_algorithms_SUITE.erl index 5e589e585f..02e5f40c38 100644 --- a/lib/ssh/test/ssh_algorithms_SUITE.erl +++ b/lib/ssh/test/ssh_algorithms_SUITE.erl @@ -184,12 +184,15 @@ init_per_testcase(TC, {public_key,Alg}, Config) -> | ExtraOpts], [{extra_daemon,true}|Config]); {{ok,_}, {error,Err}} -> + ct:log("Alg = ~p~nOpts = ~p",[Alg,Opts]), {skip, io_lib:format("No host key: ~p",[Err])}; {{error,Err}, {ok,_}} -> + ct:log("Alg = ~p~nOpts = ~p",[Alg,Opts]), {skip, io_lib:format("No user key: ~p",[Err])}; _ -> + ct:log("Alg = ~p~nOpts = ~p",[Alg,Opts]), {skip, "Neither host nor user key"} end; @@ -470,7 +473,9 @@ setup_pubkey(Alg, Config) -> 'rsa-sha2-512' -> ssh_test_lib:setup_rsa(DataDir, UserDir); 'ecdsa-sha2-nistp256' -> ssh_test_lib:setup_ecdsa("256", DataDir, UserDir); 'ecdsa-sha2-nistp384' -> ssh_test_lib:setup_ecdsa("384", DataDir, UserDir); - 'ecdsa-sha2-nistp521' -> ssh_test_lib:setup_ecdsa("521", DataDir, UserDir) + 'ecdsa-sha2-nistp521' -> ssh_test_lib:setup_ecdsa("521", DataDir, UserDir); + 'ssh-ed25519' -> ssh_test_lib:setup_eddsa(ed25519, DataDir, UserDir); + 'ssh-ed448' -> ssh_test_lib:setup_eddsa(ed448, DataDir, UserDir) end, Config. diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519 b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519 new file mode 100644 index 0000000000..401a3e4a9a --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519 @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnwAAAJg3+6xpN/us +aQAAAAtzc2gtZWQyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnw +AAAEBzC/Z2WGJhZ3l3tIBnUc6DCbp+lXY2yc2RRpWQTdf8sub0/z+ALQg4qbActK+SYS1L +ZfHRFGpQOoLrBjpSANWfAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519.pub new file mode 100644 index 0000000000..a5c03b19c1 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed25519.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOb0/z+ALQg4qbActK+SYS1LZfHRFGpQOoLrBjpSANWf uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448 b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448 new file mode 100644 index 0000000000..8ecfd710dc --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448 @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA53OqeePNaG/NJmoMbELhskKrAHNhLZ6AQm1WjbpMoseNl/OFh +1xznExpUPqTLX36fHYsAaWRHABQAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtf +fp8diwBpZEcAFAAAAAByzSPST3FCdOdENDI3uTKQ9RH2Ql+Y5kRZ/yA+iYUIP/32 +BQBVOrwOBc0CGEvbicTM1n4YeVEmfrMo3OqeePNaG/NJmoMbELhskKrAHNhLZ6AQ +m1WjbpMoseNl/OFh1xznExpUPqTLX36fHYsAaWRHABQAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448.pub new file mode 100644 index 0000000000..cec0765a5d --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/id_ed448.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtffp8diwBpZEcAFAA= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key new file mode 100644 index 0000000000..13a8fcf491 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQAAAJi+h4O7voeD +uwAAAAtzc2gtZWQyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQ +AAAEBaOcJfGPNemKc1wPHTCmM4Kwvh6dZ0CqY14UT361UnN0lI66JgZZo72XJ7wGBp+h3W +TDw/pxXddvaomAIHrIl9AAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key.pub new file mode 100644 index 0000000000..156ef4045c --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed25519_key.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIElI66JgZZo72XJ7wGBp+h3WTDw/pxXddvaomAIHrIl9 uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key new file mode 100644 index 0000000000..31a7e4e8c3 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA5X9dEm1m0Yf0s54fsYWrUah2hNCSFpw4fig6nXYDpZ3jt8SR2 +m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHl +D2zR+hq+r+glYYAAAABybIKlYsuAjRDWMr6JyFE+v2ySnzTd+oyfY8mWDvbjSKNS +jIo/zC8ETjmj/FuUSS+PAy51SaIAmPlbX9dEm1m0Yf0s54fsYWrUah2hNCSFpw4f +ig6nXYDpZ3jt8SR2m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key.pub b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key.pub new file mode 100644 index 0000000000..8c390dcb58 --- /dev/null +++ b/lib/ssh/test/ssh_algorithms_SUITE_data/ssh_host_ed448_key.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHlD2zR+hq+r+glYYA= diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 778ae1e7b6..da94b5722f 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -56,6 +56,8 @@ groups() -> {group, ecdsa_sha2_nistp256_key}, {group, ecdsa_sha2_nistp384_key}, {group, ecdsa_sha2_nistp521_key}, + {group, ed25519_key}, + {group, ed448_key}, {group, dsa_pass_key}, {group, rsa_pass_key}, {group, ecdsa_sha2_nistp256_pass_key}, @@ -94,6 +96,8 @@ groups() -> {ecdsa_sha2_nistp256_key, [], [{group, basic}]}, {ecdsa_sha2_nistp384_key, [], [{group, basic}]}, {ecdsa_sha2_nistp521_key, [], [{group, basic}]}, + {ed25519_key, [], [{group, basic}]}, + {ed448_key, [], [{group, basic}]}, {rsa_host_key_is_actualy_ecdsa, [], [fail_daemon_start]}, {host_user_key_differs, [parallel], [exec_key_differs1, exec_key_differs2, @@ -222,6 +226,28 @@ init_per_group(ecdsa_sha2_nistp521_key, Config) -> false -> {skip, unsupported_pub_key} end; +init_per_group(ed25519_key, Config) -> + case lists:member('ssh-ed25519', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_eddsa(ed25519, DataDir, PrivDir), + Config; + false -> + {skip, unsupported_pub_key} + end; +init_per_group(ed448_key, Config) -> + case lists:member('ssh-ed448', + ssh_transport:default_algorithms(public_key)) of + true -> + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), + ssh_test_lib:setup_eddsa(ed448, DataDir, PrivDir), + Config; + false -> + {skip, unsupported_pub_key} + end; init_per_group(rsa_pass_key, Config) -> case lists:member('ssh-rsa', ssh_transport:default_algorithms(public_key)) of diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519 b/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519 new file mode 100644 index 0000000000..401a3e4a9a --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519 @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnwAAAJg3+6xpN/us +aQAAAAtzc2gtZWQyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnw +AAAEBzC/Z2WGJhZ3l3tIBnUc6DCbp+lXY2yc2RRpWQTdf8sub0/z+ALQg4qbActK+SYS1L +ZfHRFGpQOoLrBjpSANWfAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519.pub b/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519.pub new file mode 100644 index 0000000000..a5c03b19c1 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/id_ed25519.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOb0/z+ALQg4qbActK+SYS1LZfHRFGpQOoLrBjpSANWf uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_ed448 b/lib/ssh/test/ssh_basic_SUITE_data/id_ed448 new file mode 100644 index 0000000000..8ecfd710dc --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/id_ed448 @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA53OqeePNaG/NJmoMbELhskKrAHNhLZ6AQm1WjbpMoseNl/OFh +1xznExpUPqTLX36fHYsAaWRHABQAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtf +fp8diwBpZEcAFAAAAAByzSPST3FCdOdENDI3uTKQ9RH2Ql+Y5kRZ/yA+iYUIP/32 +BQBVOrwOBc0CGEvbicTM1n4YeVEmfrMo3OqeePNaG/NJmoMbELhskKrAHNhLZ6AQ +m1WjbpMoseNl/OFh1xznExpUPqTLX36fHYsAaWRHABQAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_basic_SUITE_data/id_ed448.pub b/lib/ssh/test/ssh_basic_SUITE_data/id_ed448.pub new file mode 100644 index 0000000000..cec0765a5d --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/id_ed448.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtffp8diwBpZEcAFAA= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key new file mode 100644 index 0000000000..13a8fcf491 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQAAAJi+h4O7voeD +uwAAAAtzc2gtZWQyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQ +AAAEBaOcJfGPNemKc1wPHTCmM4Kwvh6dZ0CqY14UT361UnN0lI66JgZZo72XJ7wGBp+h3W +TDw/pxXddvaomAIHrIl9AAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key.pub b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key.pub new file mode 100644 index 0000000000..156ef4045c --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed25519_key.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIElI66JgZZo72XJ7wGBp+h3WTDw/pxXddvaomAIHrIl9 uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key new file mode 100644 index 0000000000..31a7e4e8c3 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA5X9dEm1m0Yf0s54fsYWrUah2hNCSFpw4fig6nXYDpZ3jt8SR2 +m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHl +D2zR+hq+r+glYYAAAABybIKlYsuAjRDWMr6JyFE+v2ySnzTd+oyfY8mWDvbjSKNS +jIo/zC8ETjmj/FuUSS+PAy51SaIAmPlbX9dEm1m0Yf0s54fsYWrUah2hNCSFpw4f +ig6nXYDpZ3jt8SR2m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key.pub b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key.pub new file mode 100644 index 0000000000..8c390dcb58 --- /dev/null +++ b/lib/ssh/test/ssh_basic_SUITE_data/ssh_host_ed448_key.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHlD2zR+hq+r+glYYA= diff --git a/lib/ssh/test/ssh_compat_SUITE.erl b/lib/ssh/test/ssh_compat_SUITE.erl index 1c607bebe8..f4eef2dc77 100644 --- a/lib/ssh/test/ssh_compat_SUITE.erl +++ b/lib/ssh/test/ssh_compat_SUITE.erl @@ -648,6 +648,7 @@ setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> {silently_accept_hosts,true}, {user_interaction,false} ]), + rm_id_in_remote_dir(Ch, ".ssh"), _ = ssh_sftp:make_dir(Ch, ".ssh"), DstFile = filename:join(".ssh", dst_filename(user,KeyAlg)), ok = ssh_sftp:write_file(Ch, DstFile, Priv), @@ -658,6 +659,18 @@ setup_remote_priv_and_local_auth_keys(KeyAlg, IP, Port, UserDir, Config) -> ok = ssh:close(Cc), UserDir. +rm_id_in_remote_dir(Ch, Dir) -> + case ssh_sftp:list_dir(Ch, Dir) of + {error,_Error} -> + ok; + {ok,FileNames} -> + lists:foreach(fun("id_"++_ = F) -> + ok = ssh_sftp:delete(Ch, filename:join(Dir,F)); + (_) -> + leave + end, FileNames) + end. + user_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("users_keys", user, Config, KeyAlg). host_priv_pub_keys(Config, KeyAlg) -> priv_pub_keys("host_keys", host, Config, KeyAlg). @@ -673,6 +686,8 @@ src_filename(user, 'ssh-rsa' ) -> "id_rsa"; src_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; src_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; src_filename(user, 'ssh-dss' ) -> "id_dsa"; +src_filename(user, 'ssh-ed25519' ) -> "id_ed25519"; +src_filename(user, 'ssh-ed448' ) -> "id_ed448"; src_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa256"; src_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa384"; src_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa521"; @@ -680,6 +695,8 @@ src_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; src_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; src_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; src_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +src_filename(host, 'ssh-ed25519' ) -> "ssh_host_ed25519_key"; +src_filename(host, 'ssh-ed448' ) -> "ssh_host_ed448_key"; src_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key256"; src_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key384"; src_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key521". @@ -688,6 +705,8 @@ dst_filename(user, 'ssh-rsa' ) -> "id_rsa"; dst_filename(user, 'rsa-sha2-256' ) -> "id_rsa"; dst_filename(user, 'rsa-sha2-512' ) -> "id_rsa"; dst_filename(user, 'ssh-dss' ) -> "id_dsa"; +dst_filename(user, 'ssh-ed25519' ) -> "id_ed25519"; +dst_filename(user, 'ssh-ed448' ) -> "id_ed448"; dst_filename(user, 'ecdsa-sha2-nistp256') -> "id_ecdsa"; dst_filename(user, 'ecdsa-sha2-nistp384') -> "id_ecdsa"; dst_filename(user, 'ecdsa-sha2-nistp521') -> "id_ecdsa"; @@ -695,6 +714,8 @@ dst_filename(host, 'ssh-rsa' ) -> "ssh_host_rsa_key"; dst_filename(host, 'rsa-sha2-256' ) -> "ssh_host_rsa_key"; dst_filename(host, 'rsa-sha2-512' ) -> "ssh_host_rsa_key"; dst_filename(host, 'ssh-dss' ) -> "ssh_host_dsa_key"; +dst_filename(host, 'ssh-ed25519' ) -> "ssh_host_ed25519_key"; +dst_filename(host, 'ssh-ed448' ) -> "ssh_host_ed448_key"; dst_filename(host, 'ecdsa-sha2-nistp256') -> "ssh_host_ecdsa_key"; dst_filename(host, 'ecdsa-sha2-nistp384') -> "ssh_host_ecdsa_key"; dst_filename(host, 'ecdsa-sha2-nistp521') -> "ssh_host_ecdsa_key". diff --git a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all index 0dcf8cb570..c2e77fcc79 100755 --- a/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all +++ b/lib/ssh/test/ssh_compat_SUITE_data/build_scripts/create_all @@ -18,6 +18,12 @@ SSH_SSL_VERSIONS=(\ openssh 7.6p1 openssl 1.0.2n \ \ openssh 7.6p1 libressl 2.6.4 \ + \ + openssh 7.7p1 openssl 1.0.2p \ + openssh 7.8p1 openssl 1.0.2p \ + openssh 7.9p1 openssl 1.0.2p \ + \ + openssh 7.9p1 libressl 2.6.4 \ ) if [ "x$1" == "x-b" ] diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key new file mode 100644 index 0000000000..13a8fcf491 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQAAAJi+h4O7voeD +uwAAAAtzc2gtZWQyNTUxOQAAACBJSOuiYGWaO9lye8Bgafod1kw8P6cV3Xb2qJgCB6yJfQ +AAAEBaOcJfGPNemKc1wPHTCmM4Kwvh6dZ0CqY14UT361UnN0lI66JgZZo72XJ7wGBp+h3W +TDw/pxXddvaomAIHrIl9AAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key.pub new file mode 100644 index 0000000000..156ef4045c --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed25519_key.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIElI66JgZZo72XJ7wGBp+h3WTDw/pxXddvaomAIHrIl9 uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key new file mode 100644 index 0000000000..31a7e4e8c3 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA5X9dEm1m0Yf0s54fsYWrUah2hNCSFpw4fig6nXYDpZ3jt8SR2 +m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHl +D2zR+hq+r+glYYAAAABybIKlYsuAjRDWMr6JyFE+v2ySnzTd+oyfY8mWDvbjSKNS +jIo/zC8ETjmj/FuUSS+PAy51SaIAmPlbX9dEm1m0Yf0s54fsYWrUah2hNCSFpw4f +ig6nXYDpZ3jt8SR2m0bHBhvWeD3x5Q9s0foavq/oJWGAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key.pub b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key.pub new file mode 100644 index 0000000000..8c390dcb58 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/host_keys/ssh_host_ed448_key.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADlf10SbWbRh/Sznh+xhatRqHaE0JIWnDh+KDqddgOlneO3xJHabRscGG9Z4PfHlD2zR+hq+r+glYYA= diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519 new file mode 100644 index 0000000000..401a3e4a9a --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519 @@ -0,0 +1,7 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAAMwAAAAtzc2gtZW +QyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnwAAAJg3+6xpN/us +aQAAAAtzc2gtZWQyNTUxOQAAACDm9P8/gC0IOKmwHLSvkmEtS2Xx0RRqUDqC6wY6UgDVnw +AAAEBzC/Z2WGJhZ3l3tIBnUc6DCbp+lXY2yc2RRpWQTdf8sub0/z+ALQg4qbActK+SYS1L +ZfHRFGpQOoLrBjpSANWfAAAAE3VhYmhuaWxAZWx4YWRsajNxMzIBAg== +-----END OPENSSH PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519.pub new file mode 100644 index 0000000000..a5c03b19c1 --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed25519.pub @@ -0,0 +1 @@ +ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIOb0/z+ALQg4qbActK+SYS1LZfHRFGpQOoLrBjpSANWf uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448 b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448 new file mode 100644 index 0000000000..8ecfd710dc --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448 @@ -0,0 +1,10 @@ +-----BEGIN OPENSSH PRIVATE KEY----- +b3BlbnNzaC1rZXktdjEAAAAABG5vbmUAAAAEbm9uZQAAAAAAAAABAAAASgAAAAlz +c2gtZWQ0NDgAAAA53OqeePNaG/NJmoMbELhskKrAHNhLZ6AQm1WjbpMoseNl/OFh +1xznExpUPqTLX36fHYsAaWRHABQAAAAA0AAAEREAABERAAAACXNzaC1lZDQ0OAAA +ADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtf +fp8diwBpZEcAFAAAAAByzSPST3FCdOdENDI3uTKQ9RH2Ql+Y5kRZ/yA+iYUIP/32 +BQBVOrwOBc0CGEvbicTM1n4YeVEmfrMo3OqeePNaG/NJmoMbELhskKrAHNhLZ6AQ +m1WjbpMoseNl/OFh1xznExpUPqTLX36fHYsAaWRHABQAAAAAAAECAwQ= +-----END OPENSSH PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448.pub b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448.pub new file mode 100644 index 0000000000..cec0765a5d --- /dev/null +++ b/lib/ssh/test/ssh_compat_SUITE_data/users_keys/id_ed448.pub @@ -0,0 +1 @@ +ssh-ed448 AAAACXNzaC1lZDQ0OAAAADnc6p5481ob80magxsQuGyQqsAc2EtnoBCbVaNukyix42X84WHXHOcTGlQ+pMtffp8diwBpZEcAFAA= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl index daf62483cd..60d0da2a39 100644 --- a/lib/ssh/test/ssh_options_SUITE.erl +++ b/lib/ssh/test/ssh_options_SUITE.erl @@ -49,7 +49,7 @@ server_userpassword_option/1, server_pwdfun_option/1, server_pwdfun_4_option/1, - server_pwdfun_4_option_repeat/1, + server_keyboard_interactive/1, ssh_connect_arg4_timeout/1, ssh_connect_negtimeout_parallel/1, ssh_connect_negtimeout_sequential/1, @@ -99,7 +99,7 @@ all() -> server_userpassword_option, server_pwdfun_option, server_pwdfun_4_option, - server_pwdfun_4_option_repeat, + server_keyboard_interactive, {group, dir_options}, ssh_connect_timeout, ssh_connect_arg4_timeout, @@ -381,7 +381,7 @@ server_pwdfun_4_option(Config) -> %%-------------------------------------------------------------------- -server_pwdfun_4_option_repeat(Config) -> +server_keyboard_interactive(Config) -> UserDir = proplists:get_value(user_dir, Config), SysDir = proplists:get_value(data_dir, Config), %% Test that the state works @@ -396,19 +396,28 @@ server_pwdfun_4_option_repeat(Config) -> {pwdfun,PWDFUN}]), %% Try with passwords "incorrect", "Bad again" and finally "bar" - KIFFUN = fun(_,_,_) -> + KIFFUN = fun(_Name, _Instr, _PromptInfos) -> K={k,self()}, - case get(K) of - undefined -> - put(K,1), - ["incorrect"]; - 2 -> - put(K,3), - ["bar"]; - S-> - put(K,S+1), - ["Bad again"] - end + Answer = + case get(K) of + undefined -> + put(K,1), + ["incorrect"]; + 2 -> + put(K,3), + ["bar"]; + S-> + put(K,S+1), + ["Bad again"] + end, + ct:log("keyboard_interact_fun:~n" + " Name = ~p~n" + " Instruction = ~p~n" + " Prompts = ~p~n" + "~nAnswer:~n ~p~n", + [_Name, _Instr, _PromptInfos, Answer]), + + Answer end, ConnectionRef2 = diff --git a/lib/ssh/test/ssh_property_test_SUITE.erl b/lib/ssh/test/ssh_property_test_SUITE.erl index 3318b86d39..9aaac898a0 100644 --- a/lib/ssh/test/ssh_property_test_SUITE.erl +++ b/lib/ssh/test/ssh_property_test_SUITE.erl @@ -46,8 +46,9 @@ groups() -> [{messages, [], [decode, decode_encode]}, {client_server, [], [client_server_sequential, - client_server_parallel, - client_server_parallel_multi]} + client_server_parallel + %% client_server_parallel_multi + ]} ]. @@ -62,7 +63,7 @@ end_per_suite(Config) -> %%% if we run proper. init_per_group(client_server, Config) -> case proplists:get_value(property_test_tool,Config) of - eqc -> Config; + proper -> Config; X -> {skip, lists:concat([X," is not supported"])} end; init_per_group(_, Config) -> diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index 416cc301db..a1a7eebcde 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -408,6 +408,21 @@ ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file setup_ecdsa_known_host(Size, System, UserDir), setup_ecdsa_auth_keys(Size, DataDir, UserDir). +setup_eddsa(Alg, DataDir, UserDir) -> + {IdPriv, IdPub, HostPriv, HostPub} = + case Alg of + ed25519 -> {"id_ed25519", "id_ed25519.pub", "ssh_host_ed25519_key", "ssh_host_ed25519_key.pub"}; + ed448 -> {"id_ed448", "id_ed448.pub", "ssh_host_ed448_key", "ssh_host_ed448_key.pub"} + end, + file:copy(filename:join(DataDir, IdPriv), filename:join(UserDir, IdPriv)), + System = filename:join(UserDir, "system"), + file:make_dir(System), + file:copy(filename:join(DataDir, HostPriv), filename:join(System, HostPriv)), + file:copy(filename:join(DataDir, HostPub), filename:join(System, HostPub)), +ct:log("DataDir ~p:~n ~p~n~nSystDir ~p:~n ~p~n~nUserDir ~p:~n ~p",[DataDir, file:list_dir(DataDir), System, file:list_dir(System), UserDir, file:list_dir(UserDir)]), + setup_eddsa_known_host(HostPub, DataDir, UserDir), + setup_eddsa_auth_keys(IdPriv, DataDir, UserDir). + clean_dsa(UserDir) -> del_dirs(filename:join(UserDir, "system")), file:delete(filename:join(UserDir,"id_dsa")), @@ -487,6 +502,11 @@ setup_ecdsa_known_host(_Size, SystemDir, UserDir) -> [{Key, _}] = public_key:ssh_decode(SshBin, public_key), setup_known_hosts(Key, UserDir). +setup_eddsa_known_host(HostPub, SystemDir, UserDir) -> + {ok, SshBin} = file:read_file(filename:join(SystemDir, HostPub)), + [{Key, _}] = public_key:ssh_decode(SshBin, public_key), + setup_known_hosts(Key, UserDir). + setup_known_hosts(Key, UserDir) -> {ok, Hostname} = inet:gethostname(), {ok, {A, B, C, D}} = inet:getaddr(Hostname, inet), @@ -529,6 +549,11 @@ setup_ecdsa_auth_keys(Size, Dir, UserDir) -> PKey = #'ECPoint'{point = Q}, setup_auth_keys([{ {PKey,Param}, [{comment, "Test"}]}], UserDir). +setup_eddsa_auth_keys(IdPriv, Dir, UserDir) -> + {ok, Pem} = file:read_file(filename:join(Dir, IdPriv)), + {ed_pri, Alg, Pub, _} = public_key:pem_entry_decode(hd(public_key:pem_decode(Pem))), + setup_auth_keys([{{ed_pub,Alg,Pub}, [{comment, "Test"}]}], UserDir). + setup_auth_keys(Keys, Dir) -> AuthKeys = public_key:ssh_encode(Keys, auth_keys), AuthKeysFile = filename:join(Dir, "authorized_keys"), diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml index d117641496..4baedf7431 100644 --- a/lib/ssl/doc/src/notes.xml +++ b/lib/ssl/doc/src/notes.xml @@ -333,6 +333,38 @@ </section> +<section><title>SSL 8.2.6.4</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Add engine support for RSA key exchange</p> + <p> + Own Id: OTP-15420</p> + </item> + </list> + </section> + +</section> + +<section><title>SSL 8.2.6.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Extend check for undelivered data at closing, could under + some circumstances fail to deliverd all data that was + acctualy recivied.</p> + <p> + Own Id: OTP-15412</p> + </item> + </list> + </section> + +</section> + <section><title>SSL 8.2.6.2</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -3163,5 +3195,3 @@ </section> </section> </chapter> - - diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index af36d04a99..8dc76f2638 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -39,63 +39,80 @@ RELSYSDIR = $(RELEASE_PATH)/lib/ssl-$(VSN) # ---------------------------------------------------- BEHAVIOUR_MODULES= \ - ssl_session_cache_api \ - ssl_crl_cache_api + ssl_crl_cache_api \ + ssl_session_cache_api + MODULES= \ - ssl \ - ssl_alert \ - ssl_app \ - ssl_sup \ - ssl_admin_sup\ - tls_connection_sup \ - ssl_connection_sup \ - ssl_listen_tracker_sup\ + dtls_connection \ dtls_connection_sup \ - dtls_packet_demux \ + dtls_handshake \ dtls_listener_sup \ - ssl_dist_sup\ - ssl_dist_admin_sup\ - ssl_dist_connection_sup\ + dtls_packet_demux \ + dtls_record \ + dtls_socket \ + dtls_v1 \ inet_tls_dist \ inet6_tls_dist \ - ssl_certificate\ - ssl_pkix_db\ + ssl \ + ssl_admin_sup \ + ssl_alert \ + ssl_app \ + ssl_certificate \ ssl_cipher \ ssl_cipher_format \ - ssl_srp_primes \ - tls_connection \ - dtls_connection \ - tls_sender\ ssl_config \ ssl_connection \ - tls_handshake \ - tls_handshake_1_3\ - dtls_handshake\ - ssl_handshake\ - ssl_manager \ - ssl_session \ - ssl_session_cache \ - ssl_pem_cache \ - ssl_crl\ + ssl_connection_sup \ + ssl_crl \ ssl_crl_cache \ ssl_crl_hash_dir \ - tls_socket \ - dtls_socket \ - tls_record \ - dtls_record \ + ssl_dh_groups \ + ssl_dist_admin_sup \ + ssl_dist_connection_sup \ + ssl_dist_sup \ + ssl_handshake \ + ssl_listen_tracker_sup \ + ssl_logger \ + ssl_manager \ + ssl_pem_cache \ + ssl_pkix_db \ ssl_record \ + ssl_session \ + ssl_session_cache \ + ssl_srp_primes \ + ssl_sup \ ssl_v3 \ - tls_v1 \ - dtls_v1 \ - ssl_logger + tls_connection \ + tls_connection_sup \ + tls_connection_1_3 \ + tls_handshake \ + tls_handshake_1_3 \ + tls_record \ + tls_record_1_3 \ + tls_sender \ + tls_socket \ + tls_v1 + INTERNAL_HRL_FILES = \ - ssl_alert.hrl ssl_cipher.hrl \ - tls_connection.hrl dtls_connection.hrl ssl_connection.hrl \ - ssl_handshake.hrl tls_handshake.hrl tls_handshake_1_3.hrl dtls_handshake.hrl \ - ssl_api.hrl ssl_internal.hrl \ - ssl_record.hrl tls_record.hrl dtls_record.hrl ssl_srp.hrl + dtls_connection.hrl \ + dtls_handshake.hrl \ + dtls_record.hrl \ + ssl_alert.hrl \ + ssl_api.hrl \ + ssl_cipher.hrl \ + ssl_connection.hrl \ + ssl_handshake.hrl \ + ssl_internal.hrl \ + ssl_record.hrl \ + ssl_srp.hrl \ + tls_connection.hrl \ + tls_handshake.hrl \ + tls_handshake_1_3.hrl \ + tls_record.hrl \ + tls_record_1_3.hrl + ERL_FILES= \ $(MODULES:%=%.erl) \ @@ -114,6 +131,10 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) +DEPDIR=$(ERL_TOP)/lib/ssl/src/deps +DEP_FILE=$(DEPDIR)/ssl.d +$(shell mkdir -p $(dir $(DEP_FILE)) >/dev/null) + # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- @@ -130,11 +151,22 @@ ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/kernel/src \ $(TARGET_FILES): $(BEHAVIOUR_TARGET_FILES) -debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) +$(DEP_FILE): $(ERL_FILES) + $(gen_verbose)erlc -M $(ERL_FILES) \ + | sed "s@$(ERL_TOP)@../../..@g" \ + | sed "s/\.$(EMULATOR)/\.$$\(EMULATOR\)/" \ + | sed 's@^dtls_@$$(EBIN)/dtls_@' \ + | sed 's@^inet_@$$(EBIN)/inet_@' \ + | sed 's@^ssl_@$$(EBIN)/ssl_@' \ + | sed 's@^tls_@$$(EBIN)/tls_@' \ + > $(DEP_FILE) + +debug opt: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(DEP_FILE) clean: rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET) $(BEHAVIOUR_TARGET_FILES) rm -f errs core *~ + rm -rf $(DEPDIR) $(APP_TARGET): $(APP_SRC) ../vsn.mk $(vsn_verbose)sed -e 's;%VSN%;$(VSN);' $< > $@ @@ -144,7 +176,6 @@ $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk docs: - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -162,23 +193,4 @@ release_docs_spec: # ---------------------------------------------------- # Dependencies # ---------------------------------------------------- -$(EBIN)/inet_tls_dist.$(EMULATOR): ../../kernel/include/net_address.hrl ../../kernel/include/dist.hrl ../../kernel/include/dist_util.hrl -$(EBIN)/tls.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl -$(EBIN)/ssl_alert.$(EMULATOR): ssl_alert.hrl ssl_record.hrl -$(EBIN)/ssl_certificate.$(EMULATOR): ssl_internal.hrl ssl_alert.hrl ssl_handshake.hrl ../../public_key/include/public_key.hrl -$(EBIN)/ssl_certificate_db.$(EMULATOR): ssl_internal.hrl ../../public_key/include/public_key.hrl ../../kernel/include/file.hrl -$(EBIN)/ssl_cipher.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/tls_connection.$(EMULATOR): ssl_internal.hrl tls_connection.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/dtls_connection.$(EMULATOR): ssl_internal.hrl dtls_connection.hrl dtls_record.hrl ssl_cipher.hrl dtls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl tls_record.hrl ssl_cipher.hrl tls_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/tls_handshake.$(EMULATOR): ssl_internal.hrl ssl_connection.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl ../../public_key/include/public_key.hrl -$(EBIN)/tls_handshake_1_3.$(EMULATOR): tls_handshake_1_3.hrl tls_handshake.hrl ssl_internal.hrl -$(EBIN)/ssl_manager.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl ../../kernel/include/file.hrl -$(EBIN)/ssl_record.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl ssl_handshake.hrl ssl_alert.hrl -$(EBIN)/ssl_session.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl -$(EBIN)/ssl_session_cache.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl -$(EBIN)/ssl_session_cache_api.$(EMULATOR): ssl_internal.hrl ssl_handshake.hrl -$(EBIN)/ssl_ssl3.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl -$(EBIN)/ssl_tls1.$(EMULATOR): ssl_internal.hrl ssl_record.hrl ssl_cipher.hrl -$(EBIN)/ssl_cache.$(EMULATOR): ssl_cache.erl ssl_internal.hrl ../../public_key/include/public_key.hrl - +-include $(DEP_FILE) diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl index 55aa8174a3..3dbda2c91b 100644 --- a/lib/ssl/src/dtls_handshake.erl +++ b/lib/ssl/src/dtls_handshake.erl @@ -79,7 +79,7 @@ client_hello(Host, Port, Cookie, ConnectionStates, Extensions = ssl_handshake:client_hello_extensions(TLSVersion, CipherSuites, SslOpts, ConnectionStates, - Renegotiation), + Renegotiation, undefined), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #client_hello{session_id = Id, diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 7f1a77f601..ce771343fe 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -568,7 +568,7 @@ gen_close(Driver, Socket) -> get_address_resolver(EpmdModule, Driver) -> case erlang:function_exported(EpmdModule, address_please, 3) of true -> {EpmdModule, address_please}; - _ -> {Driver, getaddr} + _ -> {erl_epmd, address_please} end. %% ------------------------------------------------------------ diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index 17173d7c79..e7a4d73ec4 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -4,14 +4,17 @@ {modules, [ %% TLS/SSL tls_connection, + tls_connection_1_3, tls_handshake, tls_handshake_1_3, tls_record, + tls_record_1_3, tls_socket, tls_v1, ssl_v3, tls_connection_sup, tls_sender, + ssl_dh_groups, %% DTLS dtls_connection, dtls_handshake, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 3319aadd68..2c3f8bc20f 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -51,7 +51,7 @@ %% SSL/TLS protocol handling -export([cipher_suites/0, cipher_suites/1, cipher_suites/2, filter_cipher_suites/2, prepend_cipher_suites/2, append_cipher_suites/2, - eccs/0, eccs/1, versions/0, + eccs/0, eccs/1, versions/0, groups/0, groups/1, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc @@ -578,6 +578,20 @@ eccs_filter_supported(Curves) -> Curves). %%-------------------------------------------------------------------- +-spec groups() -> tls_v1:supported_groups(). +%% Description: returns all supported groups (TLS 1.3 and later) +%%-------------------------------------------------------------------- +groups() -> + tls_v1:groups(4). + +%%-------------------------------------------------------------------- +-spec groups(default) -> tls_v1:supported_groups(). +%% Description: returns the default groups (TLS 1.3 and later) +%%-------------------------------------------------------------------- +groups(default) -> + tls_v1:default_groups(4). + +%%-------------------------------------------------------------------- -spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> {ok, [gen_tcp:option()]} | {error, reason()}. %% @@ -980,14 +994,18 @@ handle_options(Opts0, Role, Host) -> HighestVersion), eccs = handle_eccs_option(proplists:get_value(eccs, Opts, eccs()), HighestVersion), + supported_groups = handle_supported_groups_option( + proplists:get_value(supported_groups, Opts, groups(default)), + HighestVersion), signature_algs = handle_hashsigns_option( proplists:get_value( signature_algs, Opts, - default_option_role(server, + default_option_role_sign_algs(server, tls_v1:default_signature_algs(HighestVersion), - Role)), + Role, + HighestVersion)), tls_version(HighestVersion)), signature_algs_cert = handle_signature_algorithms_option( @@ -1058,7 +1076,8 @@ handle_options(Opts0, Role, Host) -> client_preferred_next_protocols, log_alert, log_level, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, fallback, signature_algs, signature_algs_cert, eccs, honor_ecc_order, - beast_mitigation, max_handshake_size, handshake, customize_hostname_check], + beast_mitigation, max_handshake_size, handshake, customize_hostname_check, + supported_groups], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) end, Opts, SslOptions), @@ -1319,15 +1338,25 @@ validate_option(customize_hostname_check, Value) when is_list(Value) -> validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). +handle_hashsigns_option(Value, Version) when is_list(Value) + andalso Version >= {3, 4} -> + case tls_v1:signature_schemes(Version, Value) of + [] -> + throw({error, {options, + no_supported_signature_schemes, + {signature_algs, Value}}}); + _ -> + Value + end; handle_hashsigns_option(Value, Version) when is_list(Value) - andalso Version >= {3, 3} -> + andalso Version =:= {3, 3} -> case tls_v1:signature_algs(Version, Value) of [] -> throw({error, {options, no_supported_algorithms, {signature_algs, Value}}}); _ -> Value end; -handle_hashsigns_option(_, Version) when Version >= {3, 3} -> +handle_hashsigns_option(_, Version) when Version =:= {3, 3} -> handle_hashsigns_option(tls_v1:default_signature_algs(Version), Version); handle_hashsigns_option(_, _Version) -> undefined. @@ -1492,6 +1521,16 @@ handle_eccs_option(Value, Version) when is_list(Value) -> error:_ -> throw({error, {options, {eccs, Value}}}) end. +handle_supported_groups_option(Value, Version) when is_list(Value) -> + {_Major, Minor} = tls_version(Version), + try tls_v1:groups(Minor, Value) of + Groups -> #supported_groups{supported_groups = Groups} + catch + exit:_ -> throw({error, {options, {supported_groups, Value}}}); + error:_ -> throw({error, {options, {supported_groups, Value}}}) + end. + + unexpected_format(Error) -> lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). @@ -1653,6 +1692,12 @@ new_ssl_options([{eccs, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> handle_eccs_option(Value, RecordCB:highest_protocol_version()) }, RecordCB); +new_ssl_options([{supported_groups, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, + Opts#ssl_options{supported_groups = + handle_supported_groups_option(Value, RecordCB:highest_protocol_version()) + }, + RecordCB); new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{signature_algs = @@ -1728,11 +1773,20 @@ handle_verify_options(Opts, CaCerts) -> throw({error, {options, {verify, Value}}}) end. +%% Added to handle default values for signature_algs in TLS 1.3 +default_option_role_sign_algs(_, Value, _, Version) when Version >= {3,4} -> + Value; +default_option_role_sign_algs(Role, Value, Role, _) -> + Value; +default_option_role_sign_algs(_, _, _, _) -> + undefined. + default_option_role(Role, Value, Role) -> Value; default_option_role(_,_,_) -> undefined. + default_cb_info(tls) -> {gen_tcp, tcp, tcp_closed, tcp_error}; default_cb_info(dtls) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index cfcdcb8ac5..c4b8e2172a 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -34,7 +34,7 @@ -include("tls_handshake_1_3.hrl"). -include_lib("public_key/include/public_key.hrl"). --export([security_parameters/2, security_parameters/3, +-export([security_parameters/2, security_parameters/3, security_parameters_1_3/3, cipher_init/3, nonce_seed/2, decipher/6, cipher/5, aead_encrypt/5, aead_decrypt/6, suites/1, all_suites/1, crypto_support_filters/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, psk_suites_anon/1, @@ -44,7 +44,10 @@ hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, is_stream_ciphersuite/1, signature_scheme/1, - scheme_to_components/1]). + scheme_to_components/1, hash_size/1]). + +%% RFC 8446 TLS 1.3 +-export([generate_client_shares/1, generate_server_share/1]). -compile(inline). @@ -85,6 +88,24 @@ security_parameters(Version, CipherSuite, SecParams) -> prf_algorithm = prf_algorithm(PrfHashAlg, Version), hash_size = hash_size(Hash)}. +security_parameters_1_3(SecParams, ClientRandom, CipherSuite) -> + #{cipher := Cipher, + mac := Hash, + prf := PrfHashAlg} = ssl_cipher_format:suite_definition(CipherSuite), + SecParams#security_parameters{ + client_random = ClientRandom, + cipher_suite = CipherSuite, + bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), + cipher_type = type(Cipher), + key_size = effective_key_bits(Cipher), + expanded_key_material_length = expanded_key_material(Cipher), + key_material_length = key_material(Cipher), + iv_size = iv_size(Cipher), + mac_algorithm = mac_algorithm(Hash), + prf_algorithm =prf_algorithm(PrfHashAlg, {3,4}), + hash_size = hash_size(Hash), + compression_algorithm = 0}. + %%-------------------------------------------------------------------- -spec cipher_init(cipher_enum(), binary(), binary()) -> #cipher_state{}. %% @@ -651,6 +672,29 @@ is_stream_ciphersuite(#{cipher := rc4_128}) -> true; is_stream_ciphersuite(_) -> false. + +-spec hash_size(atom()) -> integer(). +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) -> + 20; +%% Uncomment when adding cipher suite that needs it +%hash_size(sha224) -> +% 28; +hash_size(sha256) -> + 32; +hash_size(sha384) -> + 48. +%% Uncomment when adding cipher suite that needs it +%hash_size(sha512) -> +% 64. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -861,29 +905,6 @@ scheme_to_components(rsa_pss_pss_sha512) -> {sha512, rsa_pss_pss, undefined}; scheme_to_components(rsa_pkcs1_sha1) -> {sha1, rsa_pkcs1, undefined}; scheme_to_components(ecdsa_sha1) -> {sha1, ecdsa, undefined}. - - -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) -> - 20; -%% Uncomment when adding cipher suite that needs it -%hash_size(sha224) -> -% 28; -hash_size(sha256) -> - 32; -hash_size(sha384) -> - 48. -%% Uncomment when adding cipher suite that needs it -%hash_size(sha512) -> -% 64. - %% RFC 5246: 6.2.3.2. CBC Block Cipher %% %% Implementation note: Canvel et al. [CBCTIME] have demonstrated a @@ -994,7 +1015,7 @@ filter_suites_pubkey(ec, Ciphers, _, OtpCert) -> ec_ecdhe_suites(Ciphers)), filter_keyuse_suites(keyAgreement, Uses, CiphersSuites, ec_ecdh_suites(Ciphers)). -filter_suites_signature(rsa, Ciphers, {3, N}) when N >= 3 -> +filter_suites_signature(_, Ciphers, {3, N}) when N >= 3 -> Ciphers; filter_suites_signature(rsa, Ciphers, Version) -> (Ciphers -- ecdsa_signed_suites(Ciphers, Version)) -- dsa_signed_suites(Ciphers, Version); @@ -1188,3 +1209,36 @@ filter_keyuse_suites(Use, KeyUse, CipherSuits, Suites) -> false -> CipherSuits -- Suites end. + +generate_server_share(Group) -> + Key = generate_key_exchange(Group), + #key_share_server_hello{ + server_share = #key_share_entry{ + group = Group, + key_exchange = Key + }}. + +generate_client_shares([]) -> + #key_share_client_hello{client_shares = []}; +generate_client_shares(Groups) -> + generate_client_shares(Groups, []). +%% +generate_client_shares([], Acc) -> + #key_share_client_hello{client_shares = lists:reverse(Acc)}; +generate_client_shares([Group|Groups], Acc) -> + Key = generate_key_exchange(Group), + KeyShareEntry = #key_share_entry{ + group = Group, + key_exchange = Key + }, + generate_client_shares(Groups, [KeyShareEntry|Acc]). + + +generate_key_exchange(secp256r1) -> + public_key:generate_key({namedCurve, secp256r1}); +generate_key_exchange(secp384r1) -> + public_key:generate_key({namedCurve, secp384r1}); +generate_key_exchange(secp521r1) -> + public_key:generate_key({namedCurve, secp521r1}); +generate_key_exchange(FFDHE) -> + public_key:generate_key(ssl_dh_groups:dh_params(FFDHE)). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 6e602eac23..2abc678ed9 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -627,8 +627,10 @@ init({call, From}, {start, {Opts, EmOpts}, Timeout}, catch throw:Error -> stop_and_reply(normal, {reply, From, {error, Error}}, State0) end; -init({call, From}, Msg, State, Connection) -> +init({call, From}, {new_user, _} = Msg, State, Connection) -> handle_call(Msg, From, ?FUNCTION_NAME, State, Connection); +init({call, From}, _Msg, _State, _Connection) -> + {keep_state_and_data, [{reply, From, {error, notsup_on_transport_accept_socket}}]}; init(_Type, _Event, _State, _Connection) -> {keep_state_and_data, [postpone]}. diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl index 66e3182313..91467e9b26 100644 --- a/lib/ssl/src/ssl_connection.hrl +++ b/lib/ssl/src/ssl_connection.hrl @@ -96,7 +96,8 @@ %% The mecahnism is also usefull in TLS although we do not %% need to worry about packet loss in TLS. In DTLS we need to track DTLS handshake seqnr flight_state = reliable, %% reliable | {retransmit, integer()}| {waiting, ref(), integer()} - last two is used in DTLS over udp. - protocol_specific = #{} :: map() + protocol_specific = #{} :: map(), + key_share }). -define(DEFAULT_DIFFIE_HELLMAN_PARAMS, #'DHParameter'{prime = ?DEFAULT_DIFFIE_HELLMAN_PRIME, diff --git a/lib/ssl/src/ssl_dh_groups.erl b/lib/ssl/src/ssl_dh_groups.erl new file mode 100644 index 0000000000..20d53de430 --- /dev/null +++ b/lib/ssl/src/ssl_dh_groups.erl @@ -0,0 +1,467 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssl_dh_groups). + +-include_lib("public_key/include/public_key.hrl"). + +-export([modp2048_generator/0, modp2048_prime/0, + ffdhe2048_generator/0, ffdhe2048_prime/0, + ffdhe3072_generator/0, ffdhe3072_prime/0, + ffdhe4096_generator/0, ffdhe4096_prime/0, + ffdhe6144_generator/0, ffdhe6144_prime/0, + ffdhe8192_generator/0, ffdhe8192_prime/0, + dh_params/1]). + +%% RFC3526 - 2048-bit MODP Group +%% This group is assigned id 14. +%% +%% This prime is: 2^2048 - 2^1984 - 1 + 2^64 * { [2^1918 pi] + 124476 } +%% +%% Its hexadecimal value is: +%% +%% FFFFFFFF FFFFFFFF C90FDAA2 2168C234 C4C6628B 80DC1CD1 +%% 29024E08 8A67CC74 020BBEA6 3B139B22 514A0879 8E3404DD +%% EF9519B3 CD3A431B 302B0A6D F25F1437 4FE1356D 6D51C245 +%% E485B576 625E7EC6 F44C42E9 A637ED6B 0BFF5CB6 F406B7ED +%% EE386BFB 5A899FA5 AE9F2411 7C4B1FE6 49286651 ECE45B3D +%% C2007CB8 A163BF05 98DA4836 1C55D39A 69163FA8 FD24CF5F +%% 83655D23 DCA3AD96 1C62F356 208552BB 9ED52907 7096966D +%% 670C354E 4ABC9804 F1746C08 CA18217C 32905E46 2E36CE3B +%% E39E772C 180E8603 9B2783A2 EC07A28F B5C55DF0 6F4C52C9 +%% DE2BCBF6 95581718 3995497C EA956AE5 15D22618 98FA0510 +%% 15728E5A 8AACAA68 FFFFFFFF FFFFFFFF +%% +%% The generator is: 2. +modp2048_generator() -> + 2. + +modp2048_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "C90FDAA2" "2168C234" "C4C6628B" "80DC1CD1" + "29024E08" "8A67CC74" "020BBEA6" "3B139B22" "514A0879" "8E3404DD" + "EF9519B3" "CD3A431B" "302B0A6D" "F25F1437" "4FE1356D" "6D51C245" + "E485B576" "625E7EC6" "F44C42E9" "A637ED6B" "0BFF5CB6" "F406B7ED" + "EE386BFB" "5A899FA5" "AE9F2411" "7C4B1FE6" "49286651" "ECE45B3D" + "C2007CB8" "A163BF05" "98DA4836" "1C55D39A" "69163FA8" "FD24CF5F" + "83655D23" "DCA3AD96" "1C62F356" "208552BB" "9ED52907" "7096966D" + "670C354E" "4ABC9804" "F1746C08" "CA18217C" "32905E46" "2E36CE3B" + "E39E772C" "180E8603" "9B2783A2" "EC07A28F" "B5C55DF0" "6F4C52C9" + "DE2BCBF6" "95581718" "3995497C" "EA956AE5" "15D22618" "98FA0510" + "15728E5A" "8AACAA68" "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% RFC8446 - TLS 1.3 +%%% RFC7919 - Negotiated FFDHE for TLS +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% ffdhe2048 +%% --------- +%% The 2048-bit group has registry value 256 and is calculated from the +%% following formula: +%% +%% The modulus is: +%% +%% p = 2^2048 - 2^1984 + {[2^1918 * e] + 560316 } * 2^64 - 1 +%% +%% The hexadecimal representation of p is: +%% +%% FFFFFFFF FFFFFFFF ADF85458 A2BB4A9A AFDC5620 273D3CF1 +%% D8B9C583 CE2D3695 A9E13641 146433FB CC939DCE 249B3EF9 +%% 7D2FE363 630C75D8 F681B202 AEC4617A D3DF1ED5 D5FD6561 +%% 2433F51F 5F066ED0 85636555 3DED1AF3 B557135E 7F57C935 +%% 984F0C70 E0E68B77 E2A689DA F3EFE872 1DF158A1 36ADE735 +%% 30ACCA4F 483A797A BC0AB182 B324FB61 D108A94B B2C8E3FB +%% B96ADAB7 60D7F468 1D4F42A3 DE394DF4 AE56EDE7 6372BB19 +%% 0B07A7C8 EE0A6D70 9E02FCE1 CDF7E2EC C03404CD 28342F61 +%% 9172FE9C E98583FF 8E4F1232 EEF28183 C3FE3B1B 4C6FAD73 +%% 3BB5FCBC 2EC22005 C58EF183 7D1683B2 C6F34A26 C1B2EFFA +%% 886B4238 61285C97 FFFFFFFF FFFFFFFF +%% +%% The generator is: g = 2 +%% +%% The group size is: q = (p-1)/2 +%% +%% The estimated symmetric-equivalent strength of this group is 103 +%% bits. +ffdhe2048_generator() -> + 2. + +ffdhe2048_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "ADF85458" "A2BB4A9A" "AFDC5620" "273D3CF1" + "D8B9C583" "CE2D3695" "A9E13641" "146433FB" "CC939DCE" "249B3EF9" + "7D2FE363" "630C75D8" "F681B202" "AEC4617A" "D3DF1ED5" "D5FD6561" + "2433F51F" "5F066ED0" "85636555" "3DED1AF3" "B557135E" "7F57C935" + "984F0C70" "E0E68B77" "E2A689DA" "F3EFE872" "1DF158A1" "36ADE735" + "30ACCA4F" "483A797A" "BC0AB182" "B324FB61" "D108A94B" "B2C8E3FB" + "B96ADAB7" "60D7F468" "1D4F42A3" "DE394DF4" "AE56EDE7" "6372BB19" + "0B07A7C8" "EE0A6D70" "9E02FCE1" "CDF7E2EC" "C03404CD" "28342F61" + "9172FE9C" "E98583FF" "8E4F1232" "EEF28183" "C3FE3B1B" "4C6FAD73" + "3BB5FCBC" "2EC22005" "C58EF183" "7D1683B2" "C6F34A26" "C1B2EFFA" + "886B4238" "61285C97" "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + + +%% ffdhe3072 +%% --------- +%% The 3072-bit prime has registry value 257 and is calculated from the +%% following formula: +%% +%% The modulus is: +%% +%% p = 2^3072 - 2^3008 + {[2^2942 * e] + 2625351} * 2^64 - 1 +%% +%% The hexadecimal representation of p is: +%% +%% FFFFFFFF FFFFFFFF ADF85458 A2BB4A9A AFDC5620 273D3CF1 +%% D8B9C583 CE2D3695 A9E13641 146433FB CC939DCE 249B3EF9 +%% 7D2FE363 630C75D8 F681B202 AEC4617A D3DF1ED5 D5FD6561 +%% 2433F51F 5F066ED0 85636555 3DED1AF3 B557135E 7F57C935 +%% 984F0C70 E0E68B77 E2A689DA F3EFE872 1DF158A1 36ADE735 +%% 30ACCA4F 483A797A BC0AB182 B324FB61 D108A94B B2C8E3FB +%% B96ADAB7 60D7F468 1D4F42A3 DE394DF4 AE56EDE7 6372BB19 +%% 0B07A7C8 EE0A6D70 9E02FCE1 CDF7E2EC C03404CD 28342F61 +%% 9172FE9C E98583FF 8E4F1232 EEF28183 C3FE3B1B 4C6FAD73 +%% 3BB5FCBC 2EC22005 C58EF183 7D1683B2 C6F34A26 C1B2EFFA +%% 886B4238 611FCFDC DE355B3B 6519035B BC34F4DE F99C0238 +%% 61B46FC9 D6E6C907 7AD91D26 91F7F7EE 598CB0FA C186D91C +%% AEFE1309 85139270 B4130C93 BC437944 F4FD4452 E2D74DD3 +%% 64F2E21E 71F54BFF 5CAE82AB 9C9DF69E E86D2BC5 22363A0D +%% ABC52197 9B0DEADA 1DBF9A42 D5C4484E 0ABCD06B FA53DDEF +%% 3C1B20EE 3FD59D7C 25E41D2B 66C62E37 FFFFFFFF FFFFFFFF +%% +%% The generator is: g = 2 +%% +%% The group size is: q = (p-1)/2 +%% +%% The estimated symmetric-equivalent strength of this group is 125 +%% bits. +ffdhe3072_generator() -> + 2. + +ffdhe3072_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "ADF85458" "A2BB4A9A" "AFDC5620" "273D3CF1" + "D8B9C583" "CE2D3695" "A9E13641" "146433FB" "CC939DCE" "249B3EF9" + "7D2FE363" "630C75D8" "F681B202" "AEC4617A" "D3DF1ED5" "D5FD6561" + "2433F51F" "5F066ED0" "85636555" "3DED1AF3" "B557135E" "7F57C935" + "984F0C70" "E0E68B77" "E2A689DA" "F3EFE872" "1DF158A1" "36ADE735" + "30ACCA4F" "483A797A" "BC0AB182" "B324FB61" "D108A94B" "B2C8E3FB" + "B96ADAB7" "60D7F468" "1D4F42A3" "DE394DF4" "AE56EDE7" "6372BB19" + "0B07A7C8" "EE0A6D70" "9E02FCE1" "CDF7E2EC" "C03404CD" "28342F61" + "9172FE9C" "E98583FF" "8E4F1232" "EEF28183" "C3FE3B1B" "4C6FAD73" + "3BB5FCBC" "2EC22005" "C58EF183" "7D1683B2" "C6F34A26" "C1B2EFFA" + "886B4238" "611FCFDC" "DE355B3B" "6519035B" "BC34F4DE" "F99C0238" + "61B46FC9" "D6E6C907" "7AD91D26" "91F7F7EE" "598CB0FA" "C186D91C" + "AEFE1309" "85139270" "B4130C93" "BC437944" "F4FD4452" "E2D74DD3" + "64F2E21E" "71F54BFF" "5CAE82AB" "9C9DF69E" "E86D2BC5" "22363A0D" + "ABC52197" "9B0DEADA" "1DBF9A42" "D5C4484E" "0ABCD06B" "FA53DDEF" + "3C1B20EE" "3FD59D7C" "25E41D2B" "66C62E37" "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + + +%% ffdhe4096 +%% --------- +%% The 4096-bit group has registry value 258 and is calculated from the +%% following formula: +%% +%% The modulus is: +%% +%% p = 2^4096 - 2^4032 + {[2^3966 * e] + 5736041} * 2^64 - 1 +%% +%% The hexadecimal representation of p is: +%% +%% FFFFFFFF FFFFFFFF ADF85458 A2BB4A9A AFDC5620 273D3CF1 +%% D8B9C583 CE2D3695 A9E13641 146433FB CC939DCE 249B3EF9 +%% 7D2FE363 630C75D8 F681B202 AEC4617A D3DF1ED5 D5FD6561 +%% 2433F51F 5F066ED0 85636555 3DED1AF3 B557135E 7F57C935 +%% 984F0C70 E0E68B77 E2A689DA F3EFE872 1DF158A1 36ADE735 +%% 30ACCA4F 483A797A BC0AB182 B324FB61 D108A94B B2C8E3FB +%% B96ADAB7 60D7F468 1D4F42A3 DE394DF4 AE56EDE7 6372BB19 +%% 0B07A7C8 EE0A6D70 9E02FCE1 CDF7E2EC C03404CD 28342F61 +%% 9172FE9C E98583FF 8E4F1232 EEF28183 C3FE3B1B 4C6FAD73 +%% 3BB5FCBC 2EC22005 C58EF183 7D1683B2 C6F34A26 C1B2EFFA +%% 886B4238 611FCFDC DE355B3B 6519035B BC34F4DE F99C0238 +%% 61B46FC9 D6E6C907 7AD91D26 91F7F7EE 598CB0FA C186D91C +%% AEFE1309 85139270 B4130C93 BC437944 F4FD4452 E2D74DD3 +%% 64F2E21E 71F54BFF 5CAE82AB 9C9DF69E E86D2BC5 22363A0D +%% ABC52197 9B0DEADA 1DBF9A42 D5C4484E 0ABCD06B FA53DDEF +%% 3C1B20EE 3FD59D7C 25E41D2B 669E1EF1 6E6F52C3 164DF4FB +%% 7930E9E4 E58857B6 AC7D5F42 D69F6D18 7763CF1D 55034004 +%% 87F55BA5 7E31CC7A 7135C886 EFB4318A ED6A1E01 2D9E6832 +%% A907600A 918130C4 6DC778F9 71AD0038 092999A3 33CB8B7A +%% 1A1DB93D 7140003C 2A4ECEA9 F98D0ACC 0A8291CD CEC97DCF +%% 8EC9B55A 7F88A46B 4DB5A851 F44182E1 C68A007E 5E655F6A +%% FFFFFFFF FFFFFFFF +%% +%% The generator is: g = 2 +%% +%% The group size is: q = (p-1)/2 +%% +%% The estimated symmetric-equivalent strength of this group is 150 +%% bits. +ffdhe4096_generator() -> + 2. + +ffdhe4096_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "ADF85458" "A2BB4A9A" "AFDC5620" "273D3CF1" + "D8B9C583" "CE2D3695" "A9E13641" "146433FB" "CC939DCE" "249B3EF9" + "7D2FE363" "630C75D8" "F681B202" "AEC4617A" "D3DF1ED5" "D5FD6561" + "2433F51F" "5F066ED0" "85636555" "3DED1AF3" "B557135E" "7F57C935" + "984F0C70" "E0E68B77" "E2A689DA" "F3EFE872" "1DF158A1" "36ADE735" + "30ACCA4F" "483A797A" "BC0AB182" "B324FB61" "D108A94B" "B2C8E3FB" + "B96ADAB7" "60D7F468" "1D4F42A3" "DE394DF4" "AE56EDE7" "6372BB19" + "0B07A7C8" "EE0A6D70" "9E02FCE1" "CDF7E2EC" "C03404CD" "28342F61" + "9172FE9C" "E98583FF" "8E4F1232" "EEF28183" "C3FE3B1B" "4C6FAD73" + "3BB5FCBC" "2EC22005" "C58EF183" "7D1683B2" "C6F34A26" "C1B2EFFA" + "886B4238" "611FCFDC" "DE355B3B" "6519035B" "BC34F4DE" "F99C0238" + "61B46FC9" "D6E6C907" "7AD91D26" "91F7F7EE" "598CB0FA" "C186D91C" + "AEFE1309" "85139270" "B4130C93" "BC437944" "F4FD4452" "E2D74DD3" + "64F2E21E" "71F54BFF" "5CAE82AB" "9C9DF69E" "E86D2BC5" "22363A0D" + "ABC52197" "9B0DEADA" "1DBF9A42" "D5C4484E" "0ABCD06B" "FA53DDEF" + "3C1B20EE" "3FD59D7C" "25E41D2B" "669E1EF1" "6E6F52C3" "164DF4FB" + "7930E9E4" "E58857B6" "AC7D5F42" "D69F6D18" "7763CF1D" "55034004" + "87F55BA5" "7E31CC7A" "7135C886" "EFB4318A" "ED6A1E01" "2D9E6832" + "A907600A" "918130C4" "6DC778F9" "71AD0038" "092999A3" "33CB8B7A" + "1A1DB93D" "7140003C" "2A4ECEA9" "F98D0ACC" "0A8291CD" "CEC97DCF" + "8EC9B55A" "7F88A46B" "4DB5A851" "F44182E1" "C68A007E" "5E655F6A" + "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + + +%% ffdhe6144 +%% --------- +%% The 6144-bit group has registry value 259 and is calculated from the +%% following formula: +%% +%% The modulus is: +%% +%% p = 2^6144 - 2^6080 + {[2^6014 * e] + 15705020} * 2^64 - 1 +%% +%% The hexadecimal representation of p is: +%% +%% FFFFFFFF FFFFFFFF ADF85458 A2BB4A9A AFDC5620 273D3CF1 +%% D8B9C583 CE2D3695 A9E13641 146433FB CC939DCE 249B3EF9 +%% 7D2FE363 630C75D8 F681B202 AEC4617A D3DF1ED5 D5FD6561 +%% 2433F51F 5F066ED0 85636555 3DED1AF3 B557135E 7F57C935 +%% 984F0C70 E0E68B77 E2A689DA F3EFE872 1DF158A1 36ADE735 +%% 30ACCA4F 483A797A BC0AB182 B324FB61 D108A94B B2C8E3FB +%% B96ADAB7 60D7F468 1D4F42A3 DE394DF4 AE56EDE7 6372BB19 +%% 0B07A7C8 EE0A6D70 9E02FCE1 CDF7E2EC C03404CD 28342F61 +%% 9172FE9C E98583FF 8E4F1232 EEF28183 C3FE3B1B 4C6FAD73 +%% 3BB5FCBC 2EC22005 C58EF183 7D1683B2 C6F34A26 C1B2EFFA +%% 886B4238 611FCFDC DE355B3B 6519035B BC34F4DE F99C0238 +%% 61B46FC9 D6E6C907 7AD91D26 91F7F7EE 598CB0FA C186D91C +%% AEFE1309 85139270 B4130C93 BC437944 F4FD4452 E2D74DD3 +%% 64F2E21E 71F54BFF 5CAE82AB 9C9DF69E E86D2BC5 22363A0D +%% ABC52197 9B0DEADA 1DBF9A42 D5C4484E 0ABCD06B FA53DDEF +%% 3C1B20EE 3FD59D7C 25E41D2B 669E1EF1 6E6F52C3 164DF4FB +%% 7930E9E4 E58857B6 AC7D5F42 D69F6D18 7763CF1D 55034004 +%% 87F55BA5 7E31CC7A 7135C886 EFB4318A ED6A1E01 2D9E6832 +%% A907600A 918130C4 6DC778F9 71AD0038 092999A3 33CB8B7A +%% 1A1DB93D 7140003C 2A4ECEA9 F98D0ACC 0A8291CD CEC97DCF +%% 8EC9B55A 7F88A46B 4DB5A851 F44182E1 C68A007E 5E0DD902 +%% 0BFD64B6 45036C7A 4E677D2C 38532A3A 23BA4442 CAF53EA6 +%% 3BB45432 9B7624C8 917BDD64 B1C0FD4C B38E8C33 4C701C3A +%% CDAD0657 FCCFEC71 9B1F5C3E 4E46041F 388147FB 4CFDB477 +%% A52471F7 A9A96910 B855322E DB6340D8 A00EF092 350511E3 +%% 0ABEC1FF F9E3A26E 7FB29F8C 183023C3 587E38DA 0077D9B4 +%% 763E4E4B 94B2BBC1 94C6651E 77CAF992 EEAAC023 2A281BF6 +%% B3A739C1 22611682 0AE8DB58 47A67CBE F9C9091B 462D538C +%% D72B0374 6AE77F5E 62292C31 1562A846 505DC82D B854338A +%% E49F5235 C95B9117 8CCF2DD5 CACEF403 EC9D1810 C6272B04 +%% 5B3B71F9 DC6B80D6 3FDD4A8E 9ADB1E69 62A69526 D43161C1 +%% A41D570D 7938DAD4 A40E329C D0E40E65 FFFFFFFF FFFFFFFF +%% +%% The generator is: g = 2 +%% +%% The group size is: q = (p-1)/2 +%% +%% The estimated symmetric-equivalent strength of this group is 175 +%% bits. +ffdhe6144_generator() -> + 2. + +ffdhe6144_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "ADF85458" "A2BB4A9A" "AFDC5620" "273D3CF1" + "D8B9C583" "CE2D3695" "A9E13641" "146433FB" "CC939DCE" "249B3EF9" + "7D2FE363" "630C75D8" "F681B202" "AEC4617A" "D3DF1ED5" "D5FD6561" + "2433F51F" "5F066ED0" "85636555" "3DED1AF3" "B557135E" "7F57C935" + "984F0C70" "E0E68B77" "E2A689DA" "F3EFE872" "1DF158A1" "36ADE735" + "30ACCA4F" "483A797A" "BC0AB182" "B324FB61" "D108A94B" "B2C8E3FB" + "B96ADAB7" "60D7F468" "1D4F42A3" "DE394DF4" "AE56EDE7" "6372BB19" + "0B07A7C8" "EE0A6D70" "9E02FCE1" "CDF7E2EC" "C03404CD" "28342F61" + "9172FE9C" "E98583FF" "8E4F1232" "EEF28183" "C3FE3B1B" "4C6FAD73" + "3BB5FCBC" "2EC22005" "C58EF183" "7D1683B2" "C6F34A26" "C1B2EFFA" + "886B4238" "611FCFDC" "DE355B3B" "6519035B" "BC34F4DE" "F99C0238" + "61B46FC9" "D6E6C907" "7AD91D26" "91F7F7EE" "598CB0FA" "C186D91C" + "AEFE1309" "85139270" "B4130C93" "BC437944" "F4FD4452" "E2D74DD3" + "64F2E21E" "71F54BFF" "5CAE82AB" "9C9DF69E" "E86D2BC5" "22363A0D" + "ABC52197" "9B0DEADA" "1DBF9A42" "D5C4484E" "0ABCD06B" "FA53DDEF" + "3C1B20EE" "3FD59D7C" "25E41D2B" "669E1EF1" "6E6F52C3" "164DF4FB" + "7930E9E4" "E58857B6" "AC7D5F42" "D69F6D18" "7763CF1D" "55034004" + "87F55BA5" "7E31CC7A" "7135C886" "EFB4318A" "ED6A1E01" "2D9E6832" + "A907600A" "918130C4" "6DC778F9" "71AD0038" "092999A3" "33CB8B7A" + "1A1DB93D" "7140003C" "2A4ECEA9" "F98D0ACC" "0A8291CD" "CEC97DCF" + "8EC9B55A" "7F88A46B" "4DB5A851" "F44182E1" "C68A007E" "5E0DD902" + "0BFD64B6" "45036C7A" "4E677D2C" "38532A3A" "23BA4442" "CAF53EA6" + "3BB45432" "9B7624C8" "917BDD64" "B1C0FD4C" "B38E8C33" "4C701C3A" + "CDAD0657" "FCCFEC71" "9B1F5C3E" "4E46041F" "388147FB" "4CFDB477" + "A52471F7" "A9A96910" "B855322E" "DB6340D8" "A00EF092" "350511E3" + "0ABEC1FF" "F9E3A26E" "7FB29F8C" "183023C3" "587E38DA" "0077D9B4" + "763E4E4B" "94B2BBC1" "94C6651E" "77CAF992" "EEAAC023" "2A281BF6" + "B3A739C1" "22611682" "0AE8DB58" "47A67CBE" "F9C9091B" "462D538C" + "D72B0374" "6AE77F5E" "62292C31" "1562A846" "505DC82D" "B854338A" + "E49F5235" "C95B9117" "8CCF2DD5" "CACEF403" "EC9D1810" "C6272B04" + "5B3B71F9" "DC6B80D6" "3FDD4A8E" "9ADB1E69" "62A69526" "D43161C1" + "A41D570D" "7938DAD4" "A40E329C" "D0E40E65" "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + + +%% ffdhe8192 +%% --------- +%% The 8192-bit group has registry value 260 and is calculated from the +%% following formula: +%% +%% The modulus is: +%% +%% p = 2^8192 - 2^8128 + {[2^8062 * e] + 10965728} * 2^64 - 1 +%% +%% The hexadecimal representation of p is: +%% +%% FFFFFFFF FFFFFFFF ADF85458 A2BB4A9A AFDC5620 273D3CF1 +%% D8B9C583 CE2D3695 A9E13641 146433FB CC939DCE 249B3EF9 +%% 7D2FE363 630C75D8 F681B202 AEC4617A D3DF1ED5 D5FD6561 +%% 2433F51F 5F066ED0 85636555 3DED1AF3 B557135E 7F57C935 +%% 984F0C70 E0E68B77 E2A689DA F3EFE872 1DF158A1 36ADE735 +%% 30ACCA4F 483A797A BC0AB182 B324FB61 D108A94B B2C8E3FB +%% B96ADAB7 60D7F468 1D4F42A3 DE394DF4 AE56EDE7 6372BB19 +%% 0B07A7C8 EE0A6D70 9E02FCE1 CDF7E2EC C03404CD 28342F61 +%% 9172FE9C E98583FF 8E4F1232 EEF28183 C3FE3B1B 4C6FAD73 +%% 3BB5FCBC 2EC22005 C58EF183 7D1683B2 C6F34A26 C1B2EFFA +%% 886B4238 611FCFDC DE355B3B 6519035B BC34F4DE F99C0238 +%% 61B46FC9 D6E6C907 7AD91D26 91F7F7EE 598CB0FA C186D91C +%% AEFE1309 85139270 B4130C93 BC437944 F4FD4452 E2D74DD3 +%% 64F2E21E 71F54BFF 5CAE82AB 9C9DF69E E86D2BC5 22363A0D +%% ABC52197 9B0DEADA 1DBF9A42 D5C4484E 0ABCD06B FA53DDEF +%% 3C1B20EE 3FD59D7C 25E41D2B 669E1EF1 6E6F52C3 164DF4FB +%% 7930E9E4 E58857B6 AC7D5F42 D69F6D18 7763CF1D 55034004 +%% 87F55BA5 7E31CC7A 7135C886 EFB4318A ED6A1E01 2D9E6832 +%% A907600A 918130C4 6DC778F9 71AD0038 092999A3 33CB8B7A +%% 1A1DB93D 7140003C 2A4ECEA9 F98D0ACC 0A8291CD CEC97DCF +%% 8EC9B55A 7F88A46B 4DB5A851 F44182E1 C68A007E 5E0DD902 +%% 0BFD64B6 45036C7A 4E677D2C 38532A3A 23BA4442 CAF53EA6 +%% 3BB45432 9B7624C8 917BDD64 B1C0FD4C B38E8C33 4C701C3A +%% CDAD0657 FCCFEC71 9B1F5C3E 4E46041F 388147FB 4CFDB477 +%% A52471F7 A9A96910 B855322E DB6340D8 A00EF092 350511E3 +%% 0ABEC1FF F9E3A26E 7FB29F8C 183023C3 587E38DA 0077D9B4 +%% 763E4E4B 94B2BBC1 94C6651E 77CAF992 EEAAC023 2A281BF6 +%% B3A739C1 22611682 0AE8DB58 47A67CBE F9C9091B 462D538C +%% D72B0374 6AE77F5E 62292C31 1562A846 505DC82D B854338A +%% E49F5235 C95B9117 8CCF2DD5 CACEF403 EC9D1810 C6272B04 +%% 5B3B71F9 DC6B80D6 3FDD4A8E 9ADB1E69 62A69526 D43161C1 +%% A41D570D 7938DAD4 A40E329C CFF46AAA 36AD004C F600C838 +%% 1E425A31 D951AE64 FDB23FCE C9509D43 687FEB69 EDD1CC5E +%% 0B8CC3BD F64B10EF 86B63142 A3AB8829 555B2F74 7C932665 +%% CB2C0F1C C01BD702 29388839 D2AF05E4 54504AC7 8B758282 +%% 2846C0BA 35C35F5C 59160CC0 46FD8251 541FC68C 9C86B022 +%% BB709987 6A460E74 51A8A931 09703FEE 1C217E6C 3826E52C +%% 51AA691E 0E423CFC 99E9E316 50C1217B 624816CD AD9A95F9 +%% D5B80194 88D9C0A0 A1FE3075 A577E231 83F81D4A 3F2FA457 +%% 1EFC8CE0 BA8A4FE8 B6855DFE 72B0A66E DED2FBAB FBE58A30 +%% FAFABE1C 5D71A87E 2F741EF8 C1FE86FE A6BBFDE5 30677F0D +%% 97D11D49 F7A8443D 0822E506 A9F4614E 011E2A94 838FF88C +%% D68C8BB7 C5C6424C FFFFFFFF FFFFFFFF +%% +%% The generator is: g = 2 +%% +%% The group size is: q = (p-1)/2 +%% +%% The estimated symmetric-equivalent strength of this group is 192 +%% bits. +ffdhe8192_generator() -> + 2. + +ffdhe8192_prime() -> + P = "FFFFFFFF" "FFFFFFFF" "ADF85458" "A2BB4A9A" "AFDC5620" "273D3CF1" + "D8B9C583" "CE2D3695" "A9E13641" "146433FB" "CC939DCE" "249B3EF9" + "7D2FE363" "630C75D8" "F681B202" "AEC4617A" "D3DF1ED5" "D5FD6561" + "2433F51F" "5F066ED0" "85636555" "3DED1AF3" "B557135E" "7F57C935" + "984F0C70" "E0E68B77" "E2A689DA" "F3EFE872" "1DF158A1" "36ADE735" + "30ACCA4F" "483A797A" "BC0AB182" "B324FB61" "D108A94B" "B2C8E3FB" + "B96ADAB7" "60D7F468" "1D4F42A3" "DE394DF4" "AE56EDE7" "6372BB19" + "0B07A7C8" "EE0A6D70" "9E02FCE1" "CDF7E2EC" "C03404CD" "28342F61" + "9172FE9C" "E98583FF" "8E4F1232" "EEF28183" "C3FE3B1B" "4C6FAD73" + "3BB5FCBC" "2EC22005" "C58EF183" "7D1683B2" "C6F34A26" "C1B2EFFA" + "886B4238" "611FCFDC" "DE355B3B" "6519035B" "BC34F4DE" "F99C0238" + "61B46FC9" "D6E6C907" "7AD91D26" "91F7F7EE" "598CB0FA" "C186D91C" + "AEFE1309" "85139270" "B4130C93" "BC437944" "F4FD4452" "E2D74DD3" + "64F2E21E" "71F54BFF" "5CAE82AB" "9C9DF69E" "E86D2BC5" "22363A0D" + "ABC52197" "9B0DEADA" "1DBF9A42" "D5C4484E" "0ABCD06B" "FA53DDEF" + "3C1B20EE" "3FD59D7C" "25E41D2B" "669E1EF1" "6E6F52C3" "164DF4FB" + "7930E9E4" "E58857B6" "AC7D5F42" "D69F6D18" "7763CF1D" "55034004" + "87F55BA5" "7E31CC7A" "7135C886" "EFB4318A" "ED6A1E01" "2D9E6832" + "A907600A" "918130C4" "6DC778F9" "71AD0038" "092999A3" "33CB8B7A" + "1A1DB93D" "7140003C" "2A4ECEA9" "F98D0ACC" "0A8291CD" "CEC97DCF" + "8EC9B55A" "7F88A46B" "4DB5A851" "F44182E1" "C68A007E" "5E0DD902" + "0BFD64B6" "45036C7A" "4E677D2C" "38532A3A" "23BA4442" "CAF53EA6" + "3BB45432" "9B7624C8" "917BDD64" "B1C0FD4C" "B38E8C33" "4C701C3A" + "CDAD0657" "FCCFEC71" "9B1F5C3E" "4E46041F" "388147FB" "4CFDB477" + "A52471F7" "A9A96910" "B855322E" "DB6340D8" "A00EF092" "350511E3" + "0ABEC1FF" "F9E3A26E" "7FB29F8C" "183023C3" "587E38DA" "0077D9B4" + "763E4E4B" "94B2BBC1" "94C6651E" "77CAF992" "EEAAC023" "2A281BF6" + "B3A739C1" "22611682" "0AE8DB58" "47A67CBE" "F9C9091B" "462D538C" + "D72B0374" "6AE77F5E" "62292C31" "1562A846" "505DC82D" "B854338A" + "E49F5235" "C95B9117" "8CCF2DD5" "CACEF403" "EC9D1810" "C6272B04" + "5B3B71F9" "DC6B80D6" "3FDD4A8E" "9ADB1E69" "62A69526" "D43161C1" + "A41D570D" "7938DAD4" "A40E329C" "CFF46AAA" "36AD004C" "F600C838" + "1E425A31" "D951AE64" "FDB23FCE" "C9509D43" "687FEB69" "EDD1CC5E" + "0B8CC3BD" "F64B10EF" "86B63142" "A3AB8829" "555B2F74" "7C932665" + "CB2C0F1C" "C01BD702" "29388839" "D2AF05E4" "54504AC7" "8B758282" + "2846C0BA" "35C35F5C" "59160CC0" "46FD8251" "541FC68C" "9C86B022" + "BB709987" "6A460E74" "51A8A931" "09703FEE" "1C217E6C" "3826E52C" + "51AA691E" "0E423CFC" "99E9E316" "50C1217B" "624816CD" "AD9A95F9" + "D5B80194" "88D9C0A0" "A1FE3075" "A577E231" "83F81D4A" "3F2FA457" + "1EFC8CE0" "BA8A4FE8" "B6855DFE" "72B0A66E" "DED2FBAB" "FBE58A30" + "FAFABE1C" "5D71A87E" "2F741EF8" "C1FE86FE" "A6BBFDE5" "30677F0D" + "97D11D49" "F7A8443D" "0822E506" "A9F4614E" "011E2A94" "838FF88C" + "D68C8BB7" "C5C6424C" "FFFFFFFF" "FFFFFFFF", + list_to_integer(P, 16). + +dh_params(ffdhe2048) -> + #'DHParameter'{ + prime = ffdhe2048_prime(), + base = ffdhe2048_generator()}; +dh_params(ffdhe3072) -> + #'DHParameter'{ + prime = ffdhe3072_prime(), + base = ffdhe3072_generator()}; +dh_params(ffdhe4096) -> + #'DHParameter'{ + prime = ffdhe4096_prime(), + base = ffdhe4096_generator()}; +dh_params(ffdhe6144) -> + #'DHParameter'{ + prime = ffdhe6144_prime(), + base = ffdhe6144_generator()}; +dh_params(ffdhe8192) -> + #'DHParameter'{ + prime = ffdhe8192_prime(), + base = ffdhe8192_generator()}. diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 1e57dfd710..417e5d9eb6 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -30,6 +30,7 @@ -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). -include("ssl_srp.hrl"). +-include("tls_handshake_1_3.hrl"). -include_lib("public_key/include/public_key.hrl"). -export_type([ssl_handshake/0, ssl_handshake_history/0, @@ -60,7 +61,7 @@ -export([encode_handshake/2, encode_hello_extensions/1, encode_extensions/1, encode_extensions/2, encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1]). %% Decode --export([decode_handshake/3, decode_vector/1, decode_hello_extensions/3, decode_extensions/1, +-export([decode_handshake/3, decode_vector/1, decode_hello_extensions/3, decode_extensions/3, decode_server_key/3, decode_client_key/3, decode_suites/2 ]). @@ -71,13 +72,15 @@ premaster_secret/2, premaster_secret/3, premaster_secret/4]). %% Extensions handling --export([client_hello_extensions/5, +-export([client_hello_extensions/6, handle_client_hello_extensions/9, %% Returns server hello extensions handle_server_hello_extensions/9, select_curve/2, select_curve/3, select_hashsign/4, select_hashsign/5, - select_hashsign_algs/3 + select_hashsign_algs/3, empty_extensions/2, add_server_share/2 ]). +-export([get_cert_params/1]). + %%==================================================================== %% Create handshake messages %%==================================================================== @@ -620,6 +623,14 @@ encode_extensions([#elliptic_curves{elliptic_curve_list = EllipticCurves} | Rest Len = ListLen + 2, encode_extensions(Rest, <<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), ?UINT16(ListLen), EllipticCurveList/binary, Acc/binary>>); +encode_extensions([#supported_groups{supported_groups = SupportedGroups} | Rest], Acc) -> + + SupportedGroupList = << <<(tls_v1:group_to_enum(X)):16>> || X <- SupportedGroups>>, + ListLen = byte_size(SupportedGroupList), + Len = ListLen + 2, + encode_extensions(Rest, <<?UINT16(?ELLIPTIC_CURVES_EXT), + ?UINT16(Len), ?UINT16(ListLen), + SupportedGroupList/binary, Acc/binary>>); encode_extensions([#ec_point_formats{ec_point_format_list = ECPointFormats} | Rest], Acc) -> ECPointFormatList = list_to_binary(ECPointFormats), ListLen = byte_size(ECPointFormatList), @@ -638,7 +649,15 @@ encode_extensions([#hash_sign_algos{hash_sign_algos = HashSignAlgos} | Rest], Ac Len = ListLen + 2, encode_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), ?UINT16(ListLen), SignAlgoList/binary, Acc/binary>>); -encode_extensions([#signature_scheme_list{ +encode_extensions([#signature_algorithms{ + signature_scheme_list = SignatureSchemes} | Rest], Acc) -> + SignSchemeList = << <<(ssl_cipher:signature_scheme(SignatureScheme)):16 >> || + SignatureScheme <- SignatureSchemes >>, + ListLen = byte_size(SignSchemeList), + Len = ListLen + 2, + encode_extensions(Rest, <<?UINT16(?SIGNATURE_ALGORITHMS_EXT), + ?UINT16(Len), ?UINT16(ListLen), SignSchemeList/binary, Acc/binary>>); +encode_extensions([#signature_algorithms_cert{ signature_scheme_list = SignatureSchemes} | Rest], Acc) -> SignSchemeList = << <<(ssl_cipher:signature_scheme(SignatureScheme)):16 >> || SignatureScheme <- SignatureSchemes >>, @@ -663,12 +682,29 @@ encode_extensions([#client_hello_versions{versions = Versions0} | Rest], Acc) -> VerLen = byte_size(Versions), Len = VerLen + 2, encode_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), - ?UINT16(Len), ?UINT16(VerLen), Versions/binary, Acc/binary>>); + ?UINT16(Len), ?UINT16(VerLen), Versions/binary, Acc/binary>>); encode_extensions([#server_hello_selected_version{selected_version = Version0} | Rest], Acc) -> Version = encode_versions([Version0]), Len = byte_size(Version), %% 2 encode_extensions(Rest, <<?UINT16(?SUPPORTED_VERSIONS_EXT), - ?UINT16(Len), Version/binary, Acc/binary>>). + ?UINT16(Len), Version/binary, Acc/binary>>); +encode_extensions([#key_share_client_hello{client_shares = ClientShares0} | Rest], Acc) -> + ClientShares = encode_client_shares(ClientShares0), + ClientSharesLen = byte_size(ClientShares), + Len = ClientSharesLen + 2, + encode_extensions(Rest, <<?UINT16(?KEY_SHARE_EXT), + ?UINT16(Len), ?UINT16(ClientSharesLen), + ClientShares/binary, Acc/binary>>); +encode_extensions([#key_share_server_hello{server_share = ServerShare0} | Rest], Acc) -> + ServerShare = encode_key_share_entry(ServerShare0), + Len = byte_size(ServerShare), + encode_extensions(Rest, <<?UINT16(?KEY_SHARE_EXT), + ?UINT16(Len), ServerShare/binary, Acc/binary>>); +encode_extensions([#key_share_hello_retry_request{selected_group = Group0} | Rest], Acc) -> + Group = tls_v1:group_to_enum(Group0), + encode_extensions(Rest, <<?UINT16(?KEY_SHARE_EXT), + ?UINT16(2), ?UINT16(Group), Acc/binary>>). + encode_client_protocol_negotiation(undefined, _) -> undefined; @@ -703,14 +739,14 @@ decode_handshake(Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32 session_id = Session_ID, cipher_suite = Cipher_suite, compression_method = Comp_method, - extensions = empty_hello_extensions(Version, server)}; + extensions = empty_extensions(Version, server_hello)}; decode_handshake(Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, ?BYTE(SID_length), Session_ID:SID_length/binary, Cipher_suite:2/binary, ?BYTE(Comp_method), ?UINT16(ExtLen), Extensions:ExtLen/binary>>) -> - HelloExtensions = decode_hello_extensions(Extensions, Version, server), + HelloExtensions = decode_hello_extensions(Extensions, Version, server_hello), #server_hello{ server_version = {Major,Minor}, @@ -767,20 +803,27 @@ decode_vector(<<?UINT16(Len), Vector:Len/binary>>) -> Vector. %%-------------------------------------------------------------------- --spec decode_hello_extensions(binary(), ssl_record:ssl_version(), client | server) -> map(). +-spec decode_hello_extensions(binary(), ssl_record:ssl_version(), atom()) -> map(). %% %% Description: Decodes TLS hello extensions %%-------------------------------------------------------------------- -decode_hello_extensions(Extensions, Version, Role) -> - decode_extensions(Extensions, empty_hello_extensions(Version, Role)). +decode_hello_extensions(Extensions, Version, MessageType0) -> + %% Convert legacy atoms + MessageType = + case MessageType0 of + client -> client_hello; + server -> server_hello; + T -> T + end, + decode_extensions(Extensions, Version, MessageType, empty_extensions(Version, MessageType)). %%-------------------------------------------------------------------- --spec decode_extensions(binary()) -> map(). +-spec decode_extensions(binary(),tuple(), atom()) -> map(). %% %% Description: Decodes TLS hello extensions %%-------------------------------------------------------------------- -decode_extensions(Extensions) -> - decode_extensions(Extensions, empty_extensions()). +decode_extensions(Extensions, Version, MessageType) -> + decode_extensions(Extensions, Version, MessageType, empty_extensions()). %%-------------------------------------------------------------------- -spec decode_server_key(binary(), ssl_cipher_format:key_algo(), ssl_record:ssl_version()) -> @@ -979,52 +1022,158 @@ premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) -> catch _:_ -> throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) + end; +premaster_secret(EncSecret, #{algorithm := rsa} = Engine) -> + try crypto:private_decrypt(rsa, EncSecret, maps:remove(algorithm, Engine), + [{rsa_pad, rsa_pkcs1_padding}]) + catch + _:_ -> + throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR)) end. %%==================================================================== %% Extensions handling %%==================================================================== -client_hello_extensions(Version, CipherSuites, - #ssl_options{signature_algs = SupportedHashSigns, - signature_algs_cert = SignatureSchemes, - eccs = SupportedECCs, - versions = Versions} = SslOpts, ConnectionStates, Renegotiation) -> - {EcPointFormats, EllipticCurves} = - case advertises_ec_ciphers(lists:map(fun ssl_cipher_format:suite_definition/1, CipherSuites)) of - true -> - client_ecc_extensions(SupportedECCs); - false -> - {undefined, undefined} - end, +client_hello_extensions(Version, CipherSuites, SslOpts, ConnectionStates, Renegotiation, KeyShare) -> + HelloExtensions0 = add_tls12_extensions(Version, SslOpts, ConnectionStates, Renegotiation), + HelloExtensions1 = add_common_extensions(Version, HelloExtensions0, CipherSuites, SslOpts), + maybe_add_tls13_extensions(Version, HelloExtensions1, SslOpts, KeyShare). + + +add_tls12_extensions(_Version, + SslOpts, + ConnectionStates, + Renegotiation) -> SRP = srp_user(SslOpts), + #{renegotiation_info => renegotiation_info(tls_record, client, + ConnectionStates, Renegotiation), + srp => SRP, + alpn => encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), + next_protocol_negotiation => + encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, + Renegotiation), + sni => sni(SslOpts#ssl_options.server_name_indication) + }. - HelloExtensions = #{renegotiation_info => renegotiation_info(tls_record, client, - ConnectionStates, Renegotiation), - srp => SRP, - signature_algs => available_signature_algs(SupportedHashSigns, Version), - ec_point_formats => EcPointFormats, - elliptic_curves => EllipticCurves, - alpn => encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation), - next_protocol_negotiation => - encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector, - Renegotiation), - sni => sni(SslOpts#ssl_options.server_name_indication) - }, - - %% Add "supported_versions" extension if TLS 1.3 - case Version of - {3,4} -> - HelloExtensions#{client_hello_versions => - #client_hello_versions{versions = Versions}, - signature_algs_cert => - signature_scheme_list(SignatureSchemes)}; - _Else -> - HelloExtensions - end. -signature_scheme_list(undefined) -> +add_common_extensions({3,4}, + HelloExtensions, + _CipherSuites, + #ssl_options{eccs = SupportedECCs, + supported_groups = Groups, + signature_algs = SignatureSchemes}) -> + {EcPointFormats, _} = + client_ecc_extensions(SupportedECCs), + HelloExtensions#{ec_point_formats => EcPointFormats, + elliptic_curves => Groups, + signature_algs => signature_algs_ext(SignatureSchemes)}; + +add_common_extensions(Version, + HelloExtensions, + CipherSuites, + #ssl_options{eccs = SupportedECCs, + signature_algs = SupportedHashSigns}) -> + + {EcPointFormats, EllipticCurves} = + case advertises_ec_ciphers( + lists:map(fun ssl_cipher_format:suite_definition/1, + CipherSuites)) of + true -> + client_ecc_extensions(SupportedECCs); + false -> + {undefined, undefined} + end, + HelloExtensions#{ec_point_formats => EcPointFormats, + elliptic_curves => EllipticCurves, + signature_algs => available_signature_algs(SupportedHashSigns, Version)}. + + +maybe_add_tls13_extensions({3,4}, + HelloExtensions0, + #ssl_options{signature_algs_cert = SignatureSchemes, + versions = SupportedVersions}, + KeyShare) -> + HelloExtensions = + HelloExtensions0#{client_hello_versions => + #client_hello_versions{versions = SupportedVersions}, + signature_algs_cert => + signature_algs_cert(SignatureSchemes)}, + maybe_add_key_share(HelloExtensions, KeyShare); +maybe_add_tls13_extensions(_, HelloExtensions, _, _) -> + HelloExtensions. + + +%% TODO: Add support for PSK key establishment + +%% RFC 8446 (TLS 1.3) - 4.2.8. Key Share +%% +%% 4.2.8.1. Diffie-Hellman Parameters +%% Diffie-Hellman [DH76] parameters for both clients and servers are +%% encoded in the opaque key_exchange field of a KeyShareEntry in a +%% KeyShare structure. The opaque value contains the Diffie-Hellman +%% public value (Y = g^X mod p) for the specified group (see [RFC7919] +%% for group definitions) encoded as a big-endian integer and padded to +%% the left with zeros to the size of p in bytes. +%% +%% 4.2.8.2. ECDHE Parameters +%% +%% ECDHE parameters for both clients and servers are encoded in the +%% opaque key_exchange field of a KeyShareEntry in a KeyShare structure. +%% +%% For secp256r1, secp384r1, and secp521r1, the contents are the +%% serialized value of the following struct: +%% +%% struct { +%% uint8 legacy_form = 4; +%% opaque X[coordinate_length]; +%% opaque Y[coordinate_length]; +%% } UncompressedPointRepresentation; +%% +%% X and Y, respectively, are the binary representations of the x and y +%% values in network byte order. There are no internal length markers, +%% so each number representation occupies as many octets as implied by +%% the curve parameters. For P-256, this means that each of X and Y use +%% 32 octets, padded on the left by zeros if necessary. For P-384, they +%% take 48 octets each. For P-521, they take 66 octets each. +maybe_add_key_share(HelloExtensions, undefined) -> + HelloExtensions; +maybe_add_key_share(HelloExtensions, KeyShare) -> + #key_share_client_hello{client_shares = ClientShares0} = KeyShare, + %% Keep only public keys + ClientShares = lists:map(fun kse_remove_private_key/1, ClientShares0), + HelloExtensions#{key_share => #key_share_client_hello{ + client_shares = ClientShares}}. + +add_server_share(Extensions, KeyShare) -> + #key_share_server_hello{server_share = ServerShare0} = KeyShare, + %% Keep only public keys + ServerShare = kse_remove_private_key(ServerShare0), + Extensions#{key_share => #key_share_server_hello{ + server_share = ServerShare}}. + +kse_remove_private_key(#key_share_entry{ + group = Group, + key_exchange = + #'ECPrivateKey'{publicKey = PublicKey}}) -> + #key_share_entry{ + group = Group, + key_exchange = PublicKey}; +kse_remove_private_key(#key_share_entry{ + group = Group, + key_exchange = + {PublicKey, _}}) -> + #key_share_entry{ + group = Group, + key_exchange = PublicKey}. + +signature_algs_ext(undefined) -> + undefined; +signature_algs_ext(SignatureSchemes) -> + #signature_algorithms{signature_scheme_list = SignatureSchemes}. + +signature_algs_cert(undefined) -> undefined; -signature_scheme_list(SignatureSchemes) -> - #signature_scheme_list{signature_scheme_list = SignatureSchemes}. +signature_algs_cert(SignatureSchemes) -> + #signature_algorithms_cert{signature_scheme_list = SignatureSchemes}. handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, Exts, Version, @@ -1039,7 +1188,7 @@ handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites, ClientCipherSuites, Compression, ConnectionStates0, Renegotiation, SecureRenegotation), - Empty = empty_hello_extensions(Version, client), + Empty = empty_extensions(Version, server_hello), ServerHelloExtensions = Empty#{renegotiation_info => renegotiation_info(RecordCB, server, ConnectionStates, Renegotiation), ec_point_formats => server_ecc_extension(Version, maps:get(ec_point_formats, Exts, undefined)) @@ -1247,7 +1396,7 @@ get_cert_params(Cert) -> get_signature_scheme(undefined) -> undefined; -get_signature_scheme(#signature_scheme_list{ +get_signature_scheme(#signature_algorithms_cert{ signature_scheme_list = ClientSignatureSchemes}) -> ClientSignatureSchemes. @@ -1299,6 +1448,8 @@ extension_value(#ec_point_formats{ec_point_format_list = List}) -> List; extension_value(#elliptic_curves{elliptic_curve_list = List}) -> List; +extension_value(#supported_groups{supported_groups = SupportedGroups}) -> + SupportedGroups; extension_value(#hash_sign_algos{hash_sign_algos = Algos}) -> Algos; extension_value(#alpn{extension_data = Data}) -> @@ -1894,6 +2045,20 @@ encode_versions([], Acc) -> encode_versions([{M,N}|T], Acc) -> encode_versions(T, <<?BYTE(M),?BYTE(N),Acc/binary>>). +encode_client_shares(ClientShares) -> + encode_client_shares(ClientShares, <<>>). +%% +encode_client_shares([], Acc) -> + Acc; +encode_client_shares([KeyShareEntry0|T], Acc) -> + KeyShareEntry = encode_key_share_entry(KeyShareEntry0), + encode_client_shares(T, <<Acc/binary,KeyShareEntry/binary>>). + +encode_key_share_entry(#key_share_entry{ + group = Group, + key_exchange = KeyExchange}) -> + Len = byte_size(KeyExchange), + <<?UINT16((tls_v1:group_to_enum(Group))),?UINT16(Len),KeyExchange/binary>>. hello_extensions_list(HelloExtensions) -> [Ext || {_, Ext} <- maps:to_list(HelloExtensions), Ext =/= undefined]. @@ -2036,16 +2201,19 @@ dec_server_key_signature(Params, <<?UINT16(Len), Signature:Len/binary>>, _) -> dec_server_key_signature(_, _, _) -> throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, failed_to_decrypt_server_key_sign)). -decode_extensions(<<>>, Acc) -> +decode_extensions(<<>>, _Version, _MessageType, Acc) -> Acc; -decode_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) - when Len + 2 =:= ExtLen -> +decode_extensions(<<?UINT16(?ALPN_EXT), ?UINT16(ExtLen), ?UINT16(Len), + ExtensionData:Len/binary, Rest/binary>>, Version, MessageType, Acc) + when Len + 2 =:= ExtLen -> ALPN = #alpn{extension_data = ExtensionData}, - decode_extensions(Rest, Acc#{alpn => ALPN}); -decode_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), ExtensionData:Len/binary, Rest/binary>>, Acc) -> + decode_extensions(Rest, Version, MessageType, Acc#{alpn => ALPN}); +decode_extensions(<<?UINT16(?NEXTPROTONEG_EXT), ?UINT16(Len), + ExtensionData:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> NextP = #next_protocol_negotiation{extension_data = ExtensionData}, - decode_extensions(Rest, Acc#{next_protocol_negotiation => NextP}); -decode_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, Rest/binary>>, Acc) -> + decode_extensions(Rest, Version, MessageType, Acc#{next_protocol_negotiation => NextP}); +decode_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), + Info:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> RenegotiateInfo = case Len of 1 -> % Initial handshake Info; % should be <<0>> will be matched in handle_renegotiation_info @@ -2054,35 +2222,54 @@ decode_extensions(<<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), Info:Len/binary, <<?BYTE(VerifyLen), VerifyInfo/binary>> = Info, VerifyInfo end, - decode_extensions(Rest, Acc#{renegotiation_info => - #renegotiation_info{renegotiated_connection = - RenegotiateInfo}}); + decode_extensions(Rest, Version, MessageType, + Acc#{renegotiation_info => + #renegotiation_info{renegotiated_connection = + RenegotiateInfo}}); -decode_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), SRP:SRPLen/binary, Rest/binary>>, Acc) +decode_extensions(<<?UINT16(?SRP_EXT), ?UINT16(Len), ?BYTE(SRPLen), + SRP:SRPLen/binary, Rest/binary>>, Version, MessageType, Acc) when Len == SRPLen + 2 -> - decode_extensions(Rest, Acc#{srp => #srp{username = SRP}}); + decode_extensions(Rest, Version, MessageType, Acc#{srp => #srp{username = SRP}}); decode_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) + when Version < {3,4} -> SignAlgoListLen = Len - 2, <<?UINT16(SignAlgoListLen), SignAlgoList/binary>> = ExtData, HashSignAlgos = [{ssl_cipher:hash_algorithm(Hash), ssl_cipher:sign_algorithm(Sign)} || <<?BYTE(Hash), ?BYTE(Sign)>> <= SignAlgoList], - decode_extensions(Rest, Acc#{signature_algs => - #hash_sign_algos{hash_sign_algos = HashSignAlgos}}); + decode_extensions(Rest, Version, MessageType, + Acc#{signature_algs => + #hash_sign_algos{hash_sign_algos = + HashSignAlgos}}); + +decode_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) + when Version =:= {3,4} -> + SignSchemeListLen = Len - 2, + <<?UINT16(SignSchemeListLen), SignSchemeList/binary>> = ExtData, + SignSchemes = [ssl_cipher:signature_scheme(SignScheme) || + <<?UINT16(SignScheme)>> <= SignSchemeList], + decode_extensions(Rest, Version, MessageType, + Acc#{signature_algs => + #signature_algorithms{ + signature_scheme_list = SignSchemes}}); decode_extensions(<<?UINT16(?SIGNATURE_ALGORITHMS_CERT_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> SignSchemeListLen = Len - 2, <<?UINT16(SignSchemeListLen), SignSchemeList/binary>> = ExtData, SignSchemes = [ssl_cipher:signature_scheme(SignScheme) || <<?UINT16(SignScheme)>> <= SignSchemeList], - decode_extensions(Rest, Acc#{signature_algs_cert => - #signature_scheme_list{ - signature_scheme_list = SignSchemes}}); + decode_extensions(Rest, Version, MessageType, + Acc#{signature_algs_cert => + #signature_algorithms_cert{ + signature_scheme_list = SignSchemes}}); decode_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) + when Version < {3,4} -> <<?UINT16(_), EllipticCurveList/binary>> = ExtData, %% Ignore unknown curves Pick = fun(Enum) -> @@ -2094,42 +2281,103 @@ decode_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), end end, EllipticCurves = lists:filtermap(Pick, [ECC || <<ECC:16>> <= EllipticCurveList]), - decode_extensions(Rest, Acc#{elliptic_curves => - #elliptic_curves{elliptic_curve_list = - EllipticCurves}}); + decode_extensions(Rest, Version, MessageType, + Acc#{elliptic_curves => + #elliptic_curves{elliptic_curve_list = + EllipticCurves}}); + +decode_extensions(<<?UINT16(?ELLIPTIC_CURVES_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) + when Version =:= {3,4} -> + <<?UINT16(_), GroupList/binary>> = ExtData, + %% Ignore unknown curves + Pick = fun(Enum) -> + case tls_v1:enum_to_group(Enum) of + undefined -> + false; + Group -> + {true, Group} + end + end, + SupportedGroups = lists:filtermap(Pick, [Group || <<Group:16>> <= GroupList]), + decode_extensions(Rest, Version, MessageType, + Acc#{elliptic_curves => + #supported_groups{supported_groups = + SupportedGroups}}); + decode_extensions(<<?UINT16(?EC_POINT_FORMATS_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> <<?BYTE(_), ECPointFormatList/binary>> = ExtData, ECPointFormats = binary_to_list(ECPointFormatList), - decode_extensions(Rest, Acc#{ec_point_formats => - #ec_point_formats{ec_point_format_list = - ECPointFormats}}); + decode_extensions(Rest, Version, MessageType, + Acc#{ec_point_formats => + #ec_point_formats{ec_point_format_list = + ECPointFormats}}); -decode_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), Rest/binary>>, Acc) when Len == 0 -> - decode_extensions(Rest, Acc#{sni => #sni{hostname = ""}}); %% Server may send an empy SNI +decode_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), + Rest/binary>>, Version, MessageType, Acc) when Len == 0 -> + decode_extensions(Rest, Version, MessageType, + Acc#{sni => #sni{hostname = ""}}); %% Server may send an empy SNI decode_extensions(<<?UINT16(?SNI_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> <<?UINT16(_), NameList/binary>> = ExtData, - decode_extensions(Rest, Acc#{sni => dec_sni(NameList)}); + decode_extensions(Rest, Version, MessageType, + Acc#{sni => dec_sni(NameList)}); decode_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), - ExtData:Len/binary, Rest/binary>>, Acc) when Len > 2 -> + ExtData:Len/binary, Rest/binary>>, Version, MessageType, Acc) when Len > 2 -> <<?UINT16(_),Versions/binary>> = ExtData, - decode_extensions(Rest, Acc#{client_hello_versions => - #client_hello_versions{versions = decode_versions(Versions)}}); + decode_extensions(Rest, Version, MessageType, + Acc#{client_hello_versions => + #client_hello_versions{ + versions = decode_versions(Versions)}}); decode_extensions(<<?UINT16(?SUPPORTED_VERSIONS_EXT), ?UINT16(Len), - ?UINT16(Version), Rest/binary>>, Acc) when Len =:= 2, Version =:= 16#0304 -> - decode_extensions(Rest, Acc#{server_hello_selected_version => - #server_hello_selected_version{selected_version = {3,4}}}); + ?UINT16(SelectedVersion), Rest/binary>>, Version, MessageType, Acc) + when Len =:= 2, SelectedVersion =:= 16#0304 -> + decode_extensions(Rest, Version, MessageType, + Acc#{server_hello_selected_version => + #server_hello_selected_version{selected_version = + {3,4}}}); + +decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, + Version, MessageType = client_hello, Acc) -> + <<?UINT16(_),ClientShares/binary>> = ExtData, + decode_extensions(Rest, Version, MessageType, + Acc#{key_share => + #key_share_client_hello{ + client_shares = decode_client_shares(ClientShares)}}); + +decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, + Version, MessageType = server_hello, Acc) -> + <<?UINT16(Group),?UINT16(KeyLen),KeyExchange:KeyLen/binary>> = ExtData, + decode_extensions(Rest, Version, MessageType, + Acc#{key_share => + #key_share_server_hello{ + server_share = + #key_share_entry{ + group = tls_v1:enum_to_group(Group), + key_exchange = KeyExchange}}}); + +decode_extensions(<<?UINT16(?KEY_SHARE_EXT), ?UINT16(Len), + ExtData:Len/binary, Rest/binary>>, + Version, MessageType = hello_retry_request, Acc) -> + <<?UINT16(Group),Rest/binary>> = ExtData, + decode_extensions(Rest, Version, MessageType, + Acc#{key_share => + #key_share_hello_retry_request{ + selected_group = tls_v1:enum_to_group(Group)}}); + %% Ignore data following the ClientHello (i.e., %% extensions) if not understood. -decode_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Acc) -> - decode_extensions(Rest, Acc); +decode_extensions(<<?UINT16(_), ?UINT16(Len), _Unknown:Len/binary, Rest/binary>>, Version, MessageType, Acc) -> + decode_extensions(Rest, Version, MessageType, Acc); %% This theoretically should not happen if the protocol is followed, but if it does it is ignored. -decode_extensions(_, Acc) -> +decode_extensions(_, _, _, Acc) -> Acc. dec_hashsign(<<?BYTE(HashAlgo), ?BYTE(SignAlgo)>>) -> @@ -2156,6 +2404,17 @@ decode_versions(<<?BYTE(M),?BYTE(N),Rest/binary>>, Acc) -> decode_versions(Rest, [{M,N}|Acc]). +decode_client_shares(ClientShares) -> + decode_client_shares(ClientShares, []). +%% +decode_client_shares(<<>>, Acc) -> + lists:reverse(Acc); +decode_client_shares(<<?UINT16(Group),?UINT16(Len),KeyExchange:Len/binary,Rest/binary>>, Acc) -> + decode_client_shares(Rest, [#key_share_entry{ + group = tls_v1:enum_to_group(Group), + key_exchange= KeyExchange + }|Acc]). + decode_next_protocols({next_protocol_negotiation, Protocols}) -> decode_protocols(Protocols, []). @@ -2520,6 +2779,11 @@ client_ecc_extensions(SupportedECCs) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> + %% RFC 8422 - 5.1. Client Hello Extensions + %% Clients SHOULD send both the Supported Elliptic Curves Extension and the + %% Supported Point Formats Extension. If the Supported Point Formats + %% Extension is indeed sent, it MUST contain the value 0 (uncompressed) + %% as one of the items in the list of point formats. EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, EllipticCurves = SupportedECCs, {EcPointFormats, EllipticCurves}; @@ -2687,27 +2951,37 @@ cert_curve(Cert, ECCCurve0, CipherSuite) -> {ECCCurve0, CipherSuite} end. -empty_hello_extensions({3, 4}, server) -> - #{server_hello_selected_version => undefined, - key_share => undefined, - pre_shared_key => undefined, - sni => undefined - }; -empty_hello_extensions({3, 4}, client) -> - #{client_hello_versions => undefined, - signature_algs => undefined, - signature_algs_cert => undefined, +empty_extensions() -> + #{}. + +empty_extensions({3,4}, client_hello) -> + #{ sni => undefined, + %% max_fragment_length => undefined, + %% status_request => undefined, + elliptic_curves => undefined, + signature_algs => undefined, + %% use_srtp => undefined, + %% heartbeat => undefined, alpn => undefined, + %% signed_cert_timestamp => undefined, + %% client_cert_type => undefined, + %% server_cert_type => undefined, + %% padding => undefined, key_share => undefined, - pre_shared_key => undefined + pre_shared_key => undefined, + %% psk_key_exhange_modes => undefined, + %% early_data => undefined, + %% cookie => undefined, + client_hello_versions => undefined, + %% cert_authorities => undefined, + %% post_handshake_auth => undefined, + signature_algs_cert => undefined }; -empty_hello_extensions({3, 3}, client) -> - Ext = empty_hello_extensions({3,2}, client), - Ext#{client_hello_versions => undefined, - signature_algs => undefined, - signature_algs_cert => undefined}; -empty_hello_extensions(_, client) -> +empty_extensions({3, 3}, client_hello) -> + Ext = empty_extensions({3,2}, client_hello), + Ext#{signature_algs => undefined}; +empty_extensions(_, client_hello) -> #{renegotiation_info => undefined, alpn => undefined, next_protocol_negotiation => undefined, @@ -2715,11 +2989,13 @@ empty_hello_extensions(_, client) -> ec_point_formats => undefined, elliptic_curves => undefined, sni => undefined}; -empty_hello_extensions(_, server) -> +empty_extensions({3,4}, server_hello) -> + #{server_hello_selected_version => undefined, + key_share => undefined, + pre_shared_key => undefined + }; +empty_extensions(_, server_hello) -> #{renegotiation_info => undefined, alpn => undefined, next_protocol_negotiation => undefined, - ec_point_formats => undefined, - sni => undefined}. -empty_extensions() -> - #{}. + ec_point_formats => undefined}. diff --git a/lib/ssl/src/ssl_handshake.hrl b/lib/ssl/src/ssl_handshake.hrl index 36aefd5e22..d4233bea9b 100644 --- a/lib/ssl/src/ssl_handshake.hrl +++ b/lib/ssl/src/ssl_handshake.hrl @@ -52,9 +52,8 @@ -define(NUM_OF_SESSION_ID_BYTES, 32). % TSL 1.1 & SSL 3 -define(NUM_OF_PREMASTERSECRET_BYTES, 48). --define(DEFAULT_DIFFIE_HELLMAN_GENERATOR, 2). --define(DEFAULT_DIFFIE_HELLMAN_PRIME, - 16#FFFFFFFFFFFFFFFFC90FDAA22168C234C4C6628B80DC1CD129024E088A67CC74020BBEA63B139B22514A08798E3404DDEF9519B3CD3A431B302B0A6DF25F14374FE1356D6D51C245E485B576625E7EC6F44C42E9A637ED6B0BFF5CB6F406B7EDEE386BFB5A899FA5AE9F24117C4B1FE649286651ECE45B3DC2007CB8A163BF0598DA48361C55D39A69163FA8FD24CF5F83655D23DCA3AD961C62F356208552BB9ED529077096966D670C354E4ABC9804F1746C08CA18217C32905E462E36CE3BE39E772C180E86039B2783A2EC07A28FB5C55DF06F4C52C9DE2BCBF6955817183995497CEA956AE515D2261898FA051015728E5A8AACAA68FFFFFFFFFFFFFFFF). +-define(DEFAULT_DIFFIE_HELLMAN_GENERATOR, ssl_dh_groups:modp2048_generator()). +-define(DEFAULT_DIFFIE_HELLMAN_PRIME, ssl_dh_groups:modp2048_prime()). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Handsake protocol - RFC 4346 section 7.4 @@ -108,7 +107,8 @@ sni, client_hello_versions, server_hello_selected_version, - signature_algs_cert + signature_algs_cert, + key_share }). -record(server_hello, { @@ -316,9 +316,9 @@ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(SIGNATURE_ALGORITHMS_EXT, 13). --record(hash_sign_algos, { - hash_sign_algos - }). +-record(hash_sign_algos, {hash_sign_algos}). +%% RFC 8446 (TLS 1.3) +-record(signature_algorithms, {signature_scheme_list}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RFC 7301 Application-Layer Protocol Negotiation @@ -341,9 +341,8 @@ -record(next_protocol, {selected_protocol}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% ECC Extensions RFC 8422 section 4 and 5 (RFC 7919 not supported) +%% ECC Extensions RFC 8422 section 4 and 5 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - -define(ELLIPTIC_CURVES_EXT, 10). -define(EC_POINT_FORMATS_EXT, 11). @@ -351,11 +350,18 @@ elliptic_curve_list }). +%% RFC 8446 (TLS 1.3) renamed the "elliptic_curve" extension. +-record(supported_groups, { + supported_groups + }). + -record(ec_point_formats, { ec_point_format_list }). -define(ECPOINT_UNCOMPRESSED, 0). +%% Defined in RFC 4492, deprecated by RFC 8422 +%% RFC 8422 compliant implementations MUST not support the two formats below -define(ECPOINT_ANSIX962_COMPRESSED_PRIME, 1). -define(ECPOINT_ANSIX962_COMPRESSED_CHAR2, 2). @@ -401,7 +407,7 @@ %% Datagram Transport Layer Security (DTLS) Heartbeat Extension %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Not supported --define(HEARTBEAT, 15). +-define(HS_HEARTBEAT, 15). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RFC 6962 Certificate Transparency @@ -431,6 +437,6 @@ -define(SIGNATURE_ALGORITHMS_CERT_EXT, 50). --record(signature_scheme_list, {signature_scheme_list}). +-record(signature_algorithms_cert, {signature_scheme_list}). -endif. % -ifdef(ssl_handshake). diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 5a18f6aa99..48798799f7 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -170,6 +170,7 @@ signature_algs, signature_algs_cert, eccs, + supported_groups, %% RFC 8422, RFC 8446 honor_ecc_order :: boolean(), max_handshake_size :: integer(), handshake, diff --git a/lib/ssl/src/ssl_pem_cache.erl b/lib/ssl/src/ssl_pem_cache.erl index b7d23ef01e..41bca2f7b5 100644 --- a/lib/ssl/src/ssl_pem_cache.erl +++ b/lib/ssl/src/ssl_pem_cache.erl @@ -45,7 +45,7 @@ -record(state, { pem_cache, - last_pem_check :: erlang:timestamp(), + last_pem_check :: integer(), clear :: integer() }). @@ -134,8 +134,9 @@ init([Name]) -> PemCache = ssl_pkix_db:create_pem_cache(Name), Interval = pem_check_interval(), erlang:send_after(Interval, self(), clear_pem_cache), + erlang:system_time(second), {ok, #state{pem_cache = PemCache, - last_pem_check = os:timestamp(), + last_pem_check = erlang:convert_time_unit(os:system_time(), native, second), clear = Interval }}. @@ -183,7 +184,7 @@ handle_cast({invalidate_pem, File}, #state{pem_cache = Db} = State) -> handle_info(clear_pem_cache, #state{pem_cache = PemCache, clear = Interval, last_pem_check = CheckPoint} = State) -> - NewCheckPoint = os:timestamp(), + NewCheckPoint = erlang:convert_time_unit(os:system_time(), native, second), start_pem_cache_validator(PemCache, CheckPoint), erlang:send_after(Interval, self(), clear_pem_cache), {noreply, State#state{last_pem_check = NewCheckPoint}}; @@ -229,24 +230,14 @@ init_pem_cache_validator([CacheName, PemCache, CheckPoint]) -> CheckPoint, PemCache). pem_cache_validate({File, _}, CheckPoint) -> - case file:read_file_info(File, []) of - {ok, #file_info{mtime = Time}} -> - case is_before_checkpoint(Time, CheckPoint) of - true -> - ok; - false -> - invalidate_pem(File) - end; + case file:read_file_info(File, [{time, posix}]) of + {ok, #file_info{mtime = Time}} when Time < CheckPoint -> + ok; _ -> invalidate_pem(File) end, CheckPoint. -is_before_checkpoint(Time, CheckPoint) -> - calendar:datetime_to_gregorian_seconds( - calendar:now_to_datetime(CheckPoint)) - - calendar:datetime_to_gregorian_seconds(Time) > 0. - pem_check_interval() -> case application:get_env(ssl, ssl_pem_cache_clean) of {ok, Interval} when is_integer(Interval) -> diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index eefcf3598d..ddc83821b4 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -451,7 +451,7 @@ decrypt_nonce(?AES_GCM, #cipher_state{iv = <<Salt:4/bytes, _/binary>>}, <<Explic aead_ciphertext_split(?CHACHA20_POLY1305, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> CipherLen = size(CipherTextFragment) - Len, <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, - {end_additional_data(AAD, Len), CipherText, CipherTag}; + {end_additional_data(AAD, CipherLen), CipherText, CipherTag}; aead_ciphertext_split(?AES_GCM, #cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> CipherLen = size(CipherTextFragment) - (Len + 8), %% 8 is length of explicit Nonce << _:8/bytes, CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, diff --git a/lib/ssl/src/ssl_record.hrl b/lib/ssl/src/ssl_record.hrl index e8ce50040f..4cb19d9d0d 100644 --- a/lib/ssl/src/ssl_record.hrl +++ b/lib/ssl/src/ssl_record.hrl @@ -140,6 +140,7 @@ -define(ALERT, 21). -define(HANDSHAKE, 22). -define(APPLICATION_DATA, 23). +-define(HEARTBEAT, 24). -define(MAX_PLAIN_TEXT_LENGTH, 16384). -define(MAX_COMPRESSED_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+1024)). -define(MAX_CIPHER_TEXT_LENGTH, (?MAX_PLAIN_TEXT_LENGTH+2048)). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 8ded2cbff7..5e6ba652f0 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -69,9 +69,26 @@ -export([init/3, error/3, downgrade/3, %% Initiation and take down states hello/3, user_hello/3, certify/3, cipher/3, abbreviated/3, %% Handshake states connection/3]). +%% TLS 1.3 state functions (server) +-export([start/3, %% common state with client + negotiated/3, + recvd_ch/3, + wait_cert/3, %% common state with client + wait_cv/3, %% common state with client + wait_eoed/3, + wait_finished/3, %% common state with client + wait_flight2/3, + connected/3 %% common state with client + ]). +%% TLS 1.3 state functions (client) +-export([wait_cert_cr/3, + wait_ee/3, + wait_sh/3 + ]). %% gen_statem callbacks -export([callback_mode/0, terminate/3, code_change/4, format_status/2]). +-export([encode_handshake/4]). -define(DIST_CNTRL_SPAWN_OPTS, [{priority, max}]). @@ -152,9 +169,10 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, connection_states = ConnStates0, + negotiated_version = Version, ssl_options = #ssl_options{padding_check = Check}} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0, Check) of + case tls_record:decode_cipher_text(Version, CT, ConnStates0, Check) of {Plain, ConnStates} -> {Plain, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = Rest}, @@ -208,7 +226,8 @@ handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data}, negotiated_version = Version, ssl_options = Options} = State0) -> try - {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options), + EffectiveVersion = effective_version(Version, Options), + {Packets, Buf} = tls_handshake:get_tls_handshake(EffectiveVersion,Data,Buf0, Options), State1 = State0#state{protocol_buffers = Buffers#protocol_buffers{tls_handshake_buffer = Buf}}, @@ -481,12 +500,12 @@ init({call, From}, {start, Timeout}, session_cache = Cache, session_cache_cb = CacheCb } = State0) -> + KeyShare = maybe_generate_client_shares(SslOpts), Timer = ssl_connection:start_or_recv_cancel_timer(Timeout, From), Hello = tls_handshake:client_hello(Host, Port, ConnectionStates0, SslOpts, - Cache, CacheCb, Renegotiation, Cert), - - Version = Hello#client_hello.client_version, - HelloVersion = tls_record:hello_version(Version, SslOpts#ssl_options.versions), + Cache, CacheCb, Renegotiation, Cert, KeyShare), + + HelloVersion = tls_record:hello_version(SslOpts#ssl_options.versions), Handshake0 = ssl_handshake:init_handshake_history(), {BinMsg, ConnectionStates, Handshake} = encode_handshake(Hello, HelloVersion, ConnectionStates0, Handshake0), @@ -500,12 +519,13 @@ init({call, From}, {start, Timeout}, ssl_logger:debug(SslOpts#ssl_options.log_level, HelloMsg, #{domain => [otp,ssl,handshake]}), ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), State1 = State0#state{connection_states = ConnectionStates, - negotiated_version = Version, %% Requested version + negotiated_version = HelloVersion, %% Requested version session = Session0#session{session_id = Hello#client_hello.session_id}, tls_handshake_history = Handshake, start_or_recv_from = From, - timer = Timer}, + timer = Timer, + key_share = KeyShare}, {Record, State} = next_record(State1), next_event(hello, Record, State); init(Type, Event, State) -> @@ -552,25 +572,36 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello, negotiated_protocol = CurrentProtocol, key_algorithm = KeyExAlg, ssl_options = SslOpts} = State) -> - case tls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb, - ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of - #alert{} = Alert -> - ssl_connection:handle_own_alert(Alert, ClientVersion, hello, - State#state{negotiated_version - = ClientVersion}); - {Version, {Type, Session}, - ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> - Protocol = case Protocol0 of - undefined -> CurrentProtocol; - _ -> Protocol0 - end, - gen_handshake(?FUNCTION_NAME, internal, {common_client_hello, Type, ServerHelloExt}, - State#state{connection_states = ConnectionStates, - negotiated_version = Version, - hashsign_algorithm = HashSign, - client_hello_version = ClientVersion, - session = Session, - negotiated_protocol = Protocol}) + case choose_tls_version(SslOpts, Hello) of + 'tls_v1.3' -> + %% Continue in TLS 1.3 'start' state + {next_state, start, State, [{next_event, internal, Hello}]}; + 'tls_v1.2' -> + case tls_handshake:hello(Hello, + SslOpts, + {Port, Session0, Cache, CacheCb, + ConnectionStates0, Cert, KeyExAlg}, + Renegotiation) of + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, ClientVersion, hello, + State#state{negotiated_version + = ClientVersion}); + {Version, {Type, Session}, + ConnectionStates, Protocol0, ServerHelloExt, HashSign} -> + Protocol = case Protocol0 of + undefined -> CurrentProtocol; + _ -> Protocol0 + end, + gen_handshake(?FUNCTION_NAME, + internal, + {common_client_hello, Type, ServerHelloExt}, + State#state{connection_states = ConnectionStates, + negotiated_version = Version, + hashsign_algorithm = HashSign, + client_hello_version = ClientVersion, + session = Session, + negotiated_protocol = Protocol}) + end end; hello(internal, #server_hello{} = Hello, #state{connection_states = ConnectionStates0, @@ -641,7 +672,7 @@ connection(internal, #hello_request{}, ssl_options = SslOpts, connection_states = ConnectionStates} = State0) -> Hello = tls_handshake:client_hello(Host, Port, ConnectionStates, SslOpts, - Cache, CacheCb, Renegotiation, Cert), + Cache, CacheCb, Renegotiation, Cert, undefined), {State1, Actions} = send_handshake(Hello, State0), {Record, State} = next_record( @@ -682,6 +713,117 @@ connection(Type, Event, State) -> downgrade(Type, Event, State) -> ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE). +%%-------------------------------------------------------------------- +%% TLS 1.3 state functions +%%-------------------------------------------------------------------- +%%-------------------------------------------------------------------- +-spec start(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +start(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +start(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec negotiated(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +negotiated(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +negotiated(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec recvd_ch(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +recvd_ch(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +recvd_ch(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_cert(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_cert(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_cert(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_cv(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_cv(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_cv(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_eoed(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_eoed(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_eoed(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_finished(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_finished(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_finished(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_flight2(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_flight2(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_flight2(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec connected(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +connected(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +connected(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_cert_cr(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_cert_cr(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_cert_cr(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_ee(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_ee(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_ee(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + +%%-------------------------------------------------------------------- +-spec wait_sh(gen_statem:event_type(), term(), #state{}) -> + gen_statem:state_function_result(). +%%-------------------------------------------------------------------- +wait_sh(info, Event, State) -> + gen_info_1_3(Event, ?FUNCTION_NAME, State); +wait_sh(Type, Event, State) -> + gen_handshake_1_3(?FUNCTION_NAME, Type, Event, State). + %-------------------------------------------------------------------- %% gen_statem callbacks %%-------------------------------------------------------------------- @@ -706,7 +848,6 @@ initial_state(Role, Sender, Host, Port, Socket, {SSLOptions, SocketOptions, Trac #ssl_options{beast_mitigation = BeastMitigation, erl_dist = IsErlDist} = SSLOptions, ConnectionStates = tls_record:init_connection_states(Role, BeastMitigation), - ErlDistData = erl_dist_data(IsErlDist), SessionCacheCb = case application:get_env(ssl, session_cb) of {ok, Cb} when is_atom(Cb) -> @@ -756,7 +897,8 @@ initialize_tls_sender(#state{role = Role, protocol_cb = Connection, transport_cb = Transport, negotiated_version = Version, - ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}, + ssl_options = #ssl_options{renegotiate_at = RenegotiateAt, + log_level = LogLevel}, connection_states = #{current_write := ConnectionWriteState}, protocol_specific = #{sender := Sender}}) -> Init = #{current_write => ConnectionWriteState, @@ -767,7 +909,8 @@ initialize_tls_sender(#state{role = Role, protocol_cb => Connection, transport_cb => Transport, negotiated_version => Version, - renegotiate_at => RenegotiateAt}, + renegotiate_at => RenegotiateAt, + log_level => LogLevel}, tls_sender:initialize(Sender, Init). next_tls_record(Data, StateName, #state{protocol_buffers = @@ -821,6 +964,7 @@ handle_info({CloseTag, Socket}, StateName, #state{socket = Socket, close_tag = CloseTag, socket_options = #socket_options{active = Active}, protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs}, + user_data_buffer = Buffer, negotiated_version = Version} = State) -> %% Note that as of TLS 1.1, @@ -828,7 +972,7 @@ handle_info({CloseTag, Socket}, StateName, %% session not be resumed. This is a change from TLS 1.0 to conform %% with widespread implementation practice. - case (Active == false) andalso (CTs =/= []) of + case (Active == false) andalso ((CTs =/= []) or (Buffer =/= <<>>)) of false -> case Version of {1, N} when N >= 1 -> @@ -889,6 +1033,18 @@ gen_handshake(StateName, Type, Event, Version, StateName, State) end. +gen_handshake_1_3(StateName, Type, Event, + #state{negotiated_version = Version} = State) -> + try tls_connection_1_3:StateName(Type, Event, State, ?MODULE) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data), + Version, StateName, State) + end. + gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) -> try handle_info(Event, StateName, State) of Result -> @@ -910,6 +1066,29 @@ gen_info(Event, StateName, #state{negotiated_version = Version} = State) -> malformed_handshake_data), Version, StateName, State) end. + +gen_info_1_3(Event, connected = StateName, #state{negotiated_version = Version} = State) -> + try handle_info(Event, StateName, State) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR, + malformed_data), + Version, StateName, State) + end; + +gen_info_1_3(Event, StateName, #state{negotiated_version = Version} = State) -> + try handle_info(Event, StateName, State) of + Result -> + Result + catch + _:_ -> + ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, + malformed_handshake_data), + Version, StateName, State) + end. + unprocessed_events(Events) -> %% The first handshake event will be processed immediately @@ -954,3 +1133,34 @@ ensure_sender_terminate(_, #state{protocol_specific = #{sender := Sender}}) -> end end, spawn(Kill). + +maybe_generate_client_shares(#ssl_options{ + versions = [Version|_], + supported_groups = + #supported_groups{ + supported_groups = Groups}}) + when Version =:= {3,4} -> + ssl_cipher:generate_client_shares(Groups); +maybe_generate_client_shares(_) -> + undefined. + +choose_tls_version(#ssl_options{versions = Versions}, + #client_hello{ + extensions = #{client_hello_versions := + #client_hello_versions{versions = ClientVersions} + } + }) -> + case ssl_handshake:select_supported_version(ClientVersions, Versions) of + {3,4} -> + 'tls_v1.3'; + _Else -> + 'tls_v1.2' + end; +choose_tls_version(_, _) -> + 'tls_v1.2'. + + +effective_version(undefined, #ssl_options{versions = [Version|_]}) -> + Version; +effective_version(Version, _) -> + Version. diff --git a/lib/ssl/src/tls_connection_1_3.erl b/lib/ssl/src/tls_connection_1_3.erl new file mode 100644 index 0000000000..04bcea1e1b --- /dev/null +++ b/lib/ssl/src/tls_connection_1_3.erl @@ -0,0 +1,200 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: TODO +%%---------------------------------------------------------------------- + +%% RFC 8446 +%% A.1. Client +%% +%% START <----+ +%% Send ClientHello | | Recv HelloRetryRequest +%% [K_send = early data] | | +%% v | +%% / WAIT_SH ----+ +%% | | Recv ServerHello +%% | | K_recv = handshake +%% Can | V +%% send | WAIT_EE +%% early | | Recv EncryptedExtensions +%% data | +--------+--------+ +%% | Using | | Using certificate +%% | PSK | v +%% | | WAIT_CERT_CR +%% | | Recv | | Recv CertificateRequest +%% | | Certificate | v +%% | | | WAIT_CERT +%% | | | | Recv Certificate +%% | | v v +%% | | WAIT_CV +%% | | | Recv CertificateVerify +%% | +> WAIT_FINISHED <+ +%% | | Recv Finished +%% \ | [Send EndOfEarlyData] +%% | K_send = handshake +%% | [Send Certificate [+ CertificateVerify]] +%% Can send | Send Finished +%% app data --> | K_send = K_recv = application +%% after here v +%% CONNECTED +%% +%% A.2. Server +%% +%% START <-----+ +%% Recv ClientHello | | Send HelloRetryRequest +%% v | +%% RECVD_CH ----+ +%% | Select parameters +%% v +%% NEGOTIATED +%% | Send ServerHello +%% | K_send = handshake +%% | Send EncryptedExtensions +%% | [Send CertificateRequest] +%% Can send | [Send Certificate + CertificateVerify] +%% app data | Send Finished +%% after --> | K_send = application +%% here +--------+--------+ +%% No 0-RTT | | 0-RTT +%% | | +%% K_recv = handshake | | K_recv = early data +%% [Skip decrypt errors] | +------> WAIT_EOED -+ +%% | | Recv | | Recv EndOfEarlyData +%% | | early data | | K_recv = handshake +%% | +------------+ | +%% | | +%% +> WAIT_FLIGHT2 <--------+ +%% | +%% +--------+--------+ +%% No auth | | Client auth +%% | | +%% | v +%% | WAIT_CERT +%% | Recv | | Recv Certificate +%% | empty | v +%% | Certificate | WAIT_CV +%% | | | Recv +%% | v | CertificateVerify +%% +-> WAIT_FINISHED <---+ +%% | Recv Finished +%% | K_recv = application +%% v +%% CONNECTED + +-module(tls_connection_1_3). + +-include("ssl_alert.hrl"). +-include("ssl_connection.hrl"). +-include("tls_handshake.hrl"). +-include("tls_handshake_1_3.hrl"). + +%% gen_statem helper functions +-export([start/4, + negotiated/4 + ]). + +start(internal, + #client_hello{} = Hello, + #state{connection_states = _ConnectionStates0, + ssl_options = #ssl_options{ciphers = _ServerCiphers, + signature_algs = _ServerSignAlgs, + signature_algs_cert = _SignatureSchemes, %% TODO: Check?? + supported_groups = _ServerGroups0, + versions = _Versions} = SslOpts, + session = #session{own_certificate = Cert}} = State0, + _Module) -> + + Env = #{cert => Cert}, + case tls_handshake_1_3:handle_client_hello(Hello, SslOpts, Env) of + #alert{} = Alert -> + ssl_connection:handle_own_alert(Alert, {3,4}, start, State0); + M -> + %% update connection_states with cipher + State = update_state(State0, M), + {next_state, negotiated, State, [{next_event, internal, M}]} + + end. + +%% TODO: move these functions +update_state(#state{connection_states = ConnectionStates0, + session = Session} = State, + #{client_random := ClientRandom, + cipher := Cipher, + key_share := KeyShare, + session_id := SessionId}) -> + #{security_parameters := SecParamsR0} = PendingRead = + maps:get(pending_read, ConnectionStates0), + #{security_parameters := SecParamsW0} = PendingWrite = + maps:get(pending_write, ConnectionStates0), + SecParamsR = ssl_cipher:security_parameters_1_3(SecParamsR0, ClientRandom, Cipher), + SecParamsW = ssl_cipher:security_parameters_1_3(SecParamsW0, ClientRandom, Cipher), + ConnectionStates = + ConnectionStates0#{pending_read => PendingRead#{security_parameters => SecParamsR}, + pending_write => PendingWrite#{security_parameters => SecParamsW}}, + State#state{connection_states = ConnectionStates, + key_share = KeyShare, + session = Session#session{session_id = SessionId}}. + + +negotiated(internal, + Map, + #state{connection_states = ConnectionStates0, + session = #session{session_id = SessionId}, + ssl_options = #ssl_options{} = SslOpts, + key_share = KeyShare, + tls_handshake_history = HHistory0, + transport_cb = Transport, + socket = Socket}, _Module) -> + + %% Create server_hello + %% Extensions: supported_versions, key_share, (pre_shared_key) + ServerHello = tls_handshake_1_3:server_hello(SessionId, KeyShare, + ConnectionStates0, Map), + + %% Update handshake_history (done in encode!) + %% Encode handshake + {BinMsg, _ConnectionStates, _HHistory} = + tls_connection:encode_handshake(ServerHello, {3,4}, ConnectionStates0, HHistory0), + %% Send server_hello + tls_connection:send(Transport, Socket, BinMsg), + Report = #{direction => outbound, + protocol => 'tls_record', + message => BinMsg}, + Msg = #{direction => outbound, + protocol => 'handshake', + message => ServerHello}, + ssl_logger:debug(SslOpts#ssl_options.log_level, Msg, #{domain => [otp,ssl,handshake]}), + ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + ok. + + %% K_send = handshake ??? + %% (Send EncryptedExtensions) + %% ([Send CertificateRequest]) + %% [Send Certificate + CertificateVerify] + %% Send Finished + %% K_send = application ??? + + %% Will be called implicitly + %% {Record, State} = Connection:next_record(State2#state{session = Session}), + %% Connection:next_event(wait_flight2, Record, State, Actions), + %% OR + %% Connection:next_event(WAIT_EOED, Record, State, Actions) diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index b39a7732e7..5aca4bf8c8 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -26,6 +26,7 @@ -module(tls_handshake). -include("tls_handshake.hrl"). +-include("tls_handshake_1_3.hrl"). -include("tls_record.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). @@ -34,7 +35,7 @@ -include_lib("kernel/include/logger.hrl"). %% Handshake handling --export([client_hello/8, hello/4]). +-export([client_hello/9, hello/4]). %% Handshake encoding -export([encode_handshake/2]). @@ -49,7 +50,8 @@ %%==================================================================== %%-------------------------------------------------------------------- -spec client_hello(host(), inet:port_number(), ssl_record:connection_states(), - #ssl_options{}, integer(), atom(), boolean(), der_cert()) -> + #ssl_options{}, integer(), atom(), boolean(), der_cert(), + #key_share_client_hello{} | undefined) -> #client_hello{}. %% %% Description: Creates a client hello message. @@ -59,7 +61,7 @@ client_hello(Host, Port, ConnectionStates, ciphers = UserSuites, fallback = Fallback } = SslOpts, - Cache, CacheCb, Renegotiation, OwnCert) -> + Cache, CacheCb, Renegotiation, OwnCert, KeyShare) -> Version = tls_record:highest_protocol_version(Versions), %% In TLS 1.3, the client indicates its version preferences in the @@ -79,7 +81,8 @@ client_hello(Host, Port, ConnectionStates, Extensions = ssl_handshake:client_hello_extensions(Version, AvailableCipherSuites, SslOpts, ConnectionStates, - Renegotiation), + Renegotiation, + KeyShare), CipherSuites = ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation, Fallback), Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert), #client_hello{session_id = Id, @@ -341,26 +344,19 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite, do_hello(undefined, _Versions, _CipherSuites, _Hello, _SslOpts, _Info, _Renegotiation) -> ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); do_hello(Version, Versions, CipherSuites, Hello, SslOpts, Info, Renegotiation) -> - case tls_record:is_higher({3,4}, Version) of - true -> %% TLS 1.2 and older - case ssl_cipher:is_fallback(CipherSuites) of + case ssl_cipher:is_fallback(CipherSuites) of + true -> + Highest = tls_record:highest_protocol_version(Versions), + case tls_record:is_higher(Highest, Version) of true -> - Highest = tls_record:highest_protocol_version(Versions), - case tls_record:is_higher(Highest, Version) of - true -> - ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK); - false -> - handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) - end; + ?ALERT_REC(?FATAL, ?INAPPROPRIATE_FALLBACK); false -> handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) end; false -> - %% Implement TLS 1.3 statem ??? - ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION) + handle_client_hello(Version, Hello, SslOpts, Info, Renegotiation) end. - %%-------------------------------------------------------------------- enc_handshake(#hello_request{}, {3, N}) when N < 4 -> {?HELLO_REQUEST, <<>>}; @@ -414,7 +410,7 @@ decode_handshake(Version, ?CLIENT_HELLO, ?BYTE(Cm_length), Comp_methods:Cm_length/binary, Extensions/binary>>) -> Exts = ssl_handshake:decode_vector(Extensions), - DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, client), + DecodedExtensions = ssl_handshake:decode_hello_extensions(Exts, Version, client_hello), #client_hello{ client_version = {Major,Minor}, random = Random, diff --git a/lib/ssl/src/tls_handshake_1_3.erl b/lib/ssl/src/tls_handshake_1_3.erl index 199054b43b..f381e038cf 100644 --- a/lib/ssl/src/tls_handshake_1_3.erl +++ b/lib/ssl/src/tls_handshake_1_3.erl @@ -28,11 +28,46 @@ -include("tls_handshake_1_3.hrl"). -include("ssl_alert.hrl"). -include("ssl_internal.hrl"). +-include("ssl_record.hrl"). -include_lib("public_key/include/public_key.hrl"). %% Encode -export([encode_handshake/1, decode_handshake/2]). +%% Handshake +-export([handle_client_hello/3]). + +%% Create handshake messages +-export([server_hello/4]). + +%%==================================================================== +%% Create handshake messages +%%==================================================================== + +server_hello(SessionId, KeyShare, ConnectionStates, _Map) -> + #{security_parameters := SecParams} = + ssl_record:pending_connection_state(ConnectionStates, read), + Extensions = server_hello_extensions(KeyShare), + #server_hello{server_version = {3,3}, %% legacy_version + cipher_suite = SecParams#security_parameters.cipher_suite, + compression_method = + SecParams#security_parameters.compression_algorithm, + random = SecParams#security_parameters.server_random, + session_id = SessionId, + extensions = Extensions + }. + +server_hello_extensions(KeyShare) -> + SupportedVersions = #server_hello_selected_version{selected_version = {3,4}}, + Extensions = #{server_hello_selected_version => SupportedVersions}, + ssl_handshake:add_server_share(Extensions, KeyShare). + + + +%%==================================================================== +%% Encode handshake +%%==================================================================== + encode_handshake(#certificate_request_1_3{ certificate_request_context = Context, extensions = Exts})-> @@ -65,14 +100,19 @@ encode_handshake(#key_update{request_update = Update}) -> encode_handshake(HandshakeMsg) -> ssl_handshake:encode_handshake(HandshakeMsg, {3,4}). + +%%==================================================================== +%% Decode handshake +%%==================================================================== + decode_handshake(?CERTIFICATE_REQUEST, <<?BYTE(0), ?UINT16(Size), EncExts:Size/binary>>) -> - Exts = decode_extensions(EncExts), + Exts = decode_extensions(EncExts, certificate_request), #certificate_request_1_3{ certificate_request_context = <<>>, extensions = Exts}; decode_handshake(?CERTIFICATE_REQUEST, <<?BYTE(CSize), Context:CSize/binary, ?UINT16(Size), EncExts:Size/binary>>) -> - Exts = decode_extensions(EncExts), + Exts = decode_extensions(EncExts, certificate_request), #certificate_request_1_3{ certificate_request_context = Context, extensions = Exts}; @@ -91,12 +131,12 @@ decode_handshake(?CERTIFICATE, <<?BYTE(CSize), Context:CSize/binary, }; decode_handshake(?ENCRYPTED_EXTENSIONS, <<?UINT16(Size), EncExts:Size/binary>>) -> #encrypted_extensions{ - extensions = decode_extensions(EncExts) + extensions = decode_extensions(EncExts, encrypted_extensions) }; decode_handshake(?NEW_SESSION_TICKET, <<?UINT32(LifeTime), ?UINT32(Age), ?BYTE(Nonce), ?UINT16(TicketSize), Ticket:TicketSize/binary, BinExts/binary>>) -> - Exts = decode_extensions(BinExts), + Exts = decode_extensions(BinExts, encrypted_extensions), #new_session_ticket{ticket_lifetime = LifeTime, ticket_age_add = Age, ticket_nonce = Nonce, @@ -140,14 +180,271 @@ decode_cert_entries(<<>>, Acc) -> lists:reverse(Acc); decode_cert_entries(<<?UINT24(DSize), Data:DSize/binary, ?UINT16(Esize), BinExts:Esize/binary, Rest/binary>>, Acc) -> - Exts = decode_extensions(BinExts), + Exts = decode_extensions(BinExts, certificate_request), decode_cert_entries(Rest, [#certificate_entry{data = Data, extensions = Exts} | Acc]). encode_extensions(Exts)-> ssl_handshake:encode_extensions(extensions_list(Exts)). -decode_extensions(Exts) -> - ssl_handshake:decode_extensions(Exts). +decode_extensions(Exts, MessageType) -> + ssl_handshake:decode_extensions(Exts, {3,4}, MessageType). extensions_list(HelloExtensions) -> [Ext || {_, Ext} <- maps:to_list(HelloExtensions)]. + + +%%==================================================================== +%% Handle handshake messages +%%==================================================================== + +handle_client_hello(#client_hello{cipher_suites = ClientCiphers, + random = Random, + session_id = SessionId, + extensions = Extensions} = _Hello, + #ssl_options{ciphers = ServerCiphers, + signature_algs = ServerSignAlgs, + signature_algs_cert = _SignatureSchemes, %% TODO: Check?? + supported_groups = ServerGroups0} = _SslOpts, + Env) -> + + Cert = maps:get(cert, Env, undefined), + + ClientGroups0 = maps:get(elliptic_curves, Extensions, undefined), + ClientGroups = get_supported_groups(ClientGroups0), + ServerGroups = get_supported_groups(ServerGroups0), + + ClientShares0 = maps:get(key_share, Extensions, undefined), + ClientShares = get_key_shares(ClientShares0), + + ClientSignAlgs = get_signature_scheme_list( + maps:get(signature_algs, Extensions, undefined)), + ClientSignAlgsCert = get_signature_scheme_list( + maps:get(signature_algs_cert, Extensions, undefined)), + + %% TODO: use library function if it exists + %% Init the maybe "monad" + {Ref,Maybe} = maybe(), + + try + %% If the server does not select a PSK, then the server independently selects a + %% cipher suite, an (EC)DHE group and key share for key establishment, + %% and a signature algorithm/certificate pair to authenticate itself to + %% the client. + Cipher = Maybe(select_cipher_suite(ClientCiphers, ServerCiphers)), + Group = Maybe(select_server_group(ServerGroups, ClientGroups)), + Maybe(validate_key_share(ClientGroups, ClientShares)), + _ClientPubKey = Maybe(get_client_public_key(Group, ClientShares)), + + %% Handle certificate + {PublicKeyAlgo, SignAlgo} = get_certificate_params(Cert), + + %% Check if client supports signature algorithm of server certificate + Maybe(check_cert_sign_algo(SignAlgo, ClientSignAlgs, ClientSignAlgsCert)), + + %% Check if server supports + SelectedSignAlg = Maybe(select_sign_algo(PublicKeyAlgo, ClientSignAlgs, ServerSignAlgs)), + + %% Generate server_share + KeyShare = ssl_cipher:generate_server_share(Group), + + _Ret = #{cipher => Cipher, + group => Group, + sign_alg => SelectedSignAlg, + %% client_share => ClientPubKey, + key_share => KeyShare, + client_random => Random, + session_id => SessionId} + + %% TODO: + %% - session handling + %% - handle extensions: ALPN + %% (do not handle: NPN, srp, renegotiation_info, ec_point_formats) + + catch + {Ref, {insufficient_security, no_suitable_groups}} -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_groups); + {Ref, illegal_parameter} -> + ?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER); + {Ref, {client_hello_retry_request, _Group0}} -> + %% TODO + exit({client_hello_retry_request, not_implemented}); + {Ref, no_suitable_cipher} -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_cipher); + {Ref, {insufficient_security, no_suitable_signature_algorithm}} -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm); + {Ref, {insufficient_security, no_suitable_public_key}} -> + ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_public_key) + end. + + +%% If there is no overlap between the received +%% "supported_groups" and the groups supported by the server, then the +%% server MUST abort the handshake with a "handshake_failure" or an +%% "insufficient_security" alert. +select_server_group(_, []) -> + {error, {insufficient_security, no_suitable_groups}}; +select_server_group(ServerGroups, [C|ClientGroups]) -> + case lists:member(C, ServerGroups) of + true -> + {ok, C}; + false -> + select_server_group(ServerGroups, ClientGroups) + end. + + +%% RFC 8446 - 4.2.8. Key Share +%% This vector MAY be empty if the client is requesting a +%% HelloRetryRequest. Each KeyShareEntry value MUST correspond to a +%% group offered in the "supported_groups" extension and MUST appear in +%% the same order. However, the values MAY be a non-contiguous subset +%% of the "supported_groups" extension and MAY omit the most preferred +%% groups. +%% +%% Clients can offer as many KeyShareEntry values as the number of +%% supported groups it is offering, each representing a single set of +%% key exchange parameters. +%% +%% Clients MUST NOT offer multiple KeyShareEntry values +%% for the same group. Clients MUST NOT offer any KeyShareEntry values +%% for groups not listed in the client's "supported_groups" extension. +%% Servers MAY check for violations of these rules and abort the +%% handshake with an "illegal_parameter" alert if one is violated. +validate_key_share(_ ,[]) -> + ok; +validate_key_share([], _) -> + {error, illegal_parameter}; +validate_key_share([G|ClientGroups], [{_, G, _}|ClientShares]) -> + validate_key_share(ClientGroups, ClientShares); +validate_key_share([_|ClientGroups], [_|_] = ClientShares) -> + validate_key_share(ClientGroups, ClientShares). + + +get_client_public_key(Group, ClientShares) -> + case lists:keysearch(Group, 2, ClientShares) of + {value, {_, _, ClientPublicKey}} -> + {ok, ClientPublicKey}; + false -> + %% ClientHelloRetryRequest + {error, {client_hello_retry_request, Group}} + end. + +select_cipher_suite([], _) -> + {error, no_suitable_cipher}; +select_cipher_suite([Cipher|ClientCiphers], ServerCiphers) -> + case lists:member(Cipher, ServerCiphers) of + true -> + {ok, Cipher}; + false -> + select_cipher_suite(ClientCiphers, ServerCiphers) + end. + +%% RFC 8446 (TLS 1.3) +%% TLS 1.3 provides two extensions for indicating which signature +%% algorithms may be used in digital signatures. The +%% "signature_algorithms_cert" extension applies to signatures in +%% certificates and the "signature_algorithms" extension, which +%% originally appeared in TLS 1.2, applies to signatures in +%% CertificateVerify messages. +%% +%% If no "signature_algorithms_cert" extension is +%% present, then the "signature_algorithms" extension also applies to +%% signatures appearing in certificates. +check_cert_sign_algo(SignAlgo, ClientSignAlgs, undefined) -> + maybe_lists_member(SignAlgo, ClientSignAlgs, + {insufficient_security, no_suitable_signature_algorithm}); +check_cert_sign_algo(SignAlgo, _, ClientSignAlgsCert) -> + maybe_lists_member(SignAlgo, ClientSignAlgsCert, + {insufficient_security, no_suitable_signature_algorithm}). + + +%% DSA keys are not supported by TLS 1.3 +select_sign_algo(dsa, _ClientSignAlgs, _ServerSignAlgs) -> + {error, {insufficient_security, no_suitable_public_key}}; +%% TODO: Implement check for ellipctic curves! +select_sign_algo(PublicKeyAlgo, [C|ClientSignAlgs], ServerSignAlgs) -> + {_, S, _} = ssl_cipher:scheme_to_components(C), + case PublicKeyAlgo =:= rsa andalso + ((S =:= rsa_pkcs1) orelse (S =:= rsa_pss_rsae) orelse (S =:= rsa_pss_pss)) andalso + lists:member(C, ServerSignAlgs) of + true -> + {ok, C}; + false -> + select_sign_algo(PublicKeyAlgo, ClientSignAlgs, ServerSignAlgs) + end. + + +maybe_lists_member(Elem, List, Error) -> + case lists:member(Elem, List) of + true -> + ok; + false -> + {error, Error} + end. + +%% TODO: test with ecdsa, rsa_pss_rsae, rsa_pss_pss +get_certificate_params(Cert) -> + {SignAlgo0, _Param, PublicKeyAlgo0} = ssl_handshake:get_cert_params(Cert), + SignAlgo = public_key:pkix_sign_types(SignAlgo0), + PublicKeyAlgo = public_key_algo(PublicKeyAlgo0), + Scheme = sign_algo_to_scheme(SignAlgo), + {PublicKeyAlgo, Scheme}. + +sign_algo_to_scheme({Hash0, Sign0}) -> + SupportedSchemes = tls_v1:default_signature_schemes({3,4}), + Hash = case Hash0 of + sha -> + sha1; + H -> + H + end, + Sign = case Sign0 of + rsa -> + rsa_pkcs1; + S -> + S + end, + sign_algo_to_scheme(Hash, Sign, SupportedSchemes). +%% +sign_algo_to_scheme(_, _, []) -> + not_found; +sign_algo_to_scheme(H, S, [Scheme|T]) -> + {Hash, Sign, _Curve} = ssl_cipher:scheme_to_components(Scheme), + case H =:= Hash andalso S =:= Sign of + true -> + Scheme; + false -> + sign_algo_to_scheme(H, S, T) + end. + + +%% Note: copied from ssl_handshake +public_key_algo(?rsaEncryption) -> + rsa; +public_key_algo(?'id-ecPublicKey') -> + ecdsa; +public_key_algo(?'id-dsa') -> + dsa. + +get_signature_scheme_list(undefined) -> + undefined; +get_signature_scheme_list(#signature_algorithms_cert{ + signature_scheme_list = ClientSignatureSchemes}) -> + ClientSignatureSchemes; +get_signature_scheme_list(#signature_algorithms{ + signature_scheme_list = ClientSignatureSchemes}) -> + ClientSignatureSchemes. + +get_supported_groups(#supported_groups{supported_groups = Groups}) -> + Groups. + +get_key_shares(#key_share_client_hello{client_shares = ClientShares}) -> + ClientShares. + +maybe() -> + Ref = erlang:make_ref(), + Ok = fun(ok) -> ok; + ({ok,R}) -> R; + ({error,Reason}) -> + throw({Ref,Reason}) + end, + {Ref,Ok}. diff --git a/lib/ssl/src/tls_handshake_1_3.hrl b/lib/ssl/src/tls_handshake_1_3.hrl index 9ee0e0f845..6ef5364399 100644 --- a/lib/ssl/src/tls_handshake_1_3.hrl +++ b/lib/ssl/src/tls_handshake_1_3.hrl @@ -59,7 +59,7 @@ key_exchange %key_exchange<1..2^16-1>; }). -record(key_share_client_hello, { - entries %% KeyShareEntry client_shares<0..2^16-1>; + client_shares %% KeyShareEntry client_shares<0..2^16-1>; }). -record(key_share_hello_retry_request, { selected_group %% NamedGroup diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 938b95b7da..50fad2e680 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -41,13 +41,13 @@ -export([encode_plain_text/4]). %% Decoding --export([decode_cipher_text/3]). +-export([decode_cipher_text/4]). %% Protocol version handling -export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2, highest_protocol_version/1, highest_protocol_version/2, is_higher/2, supported_protocol_versions/0, - is_acceptable_version/1, is_acceptable_version/2, hello_version/2]). + is_acceptable_version/1, is_acceptable_version/2, hello_version/1]). -export_type([tls_version/0, tls_atom_version/0]). @@ -106,6 +106,8 @@ get_tls_records(Data, Versions, Buffer, SslOpts) -> % %% Description: Encodes a handshake message to send on the ssl-socket. %%-------------------------------------------------------------------- +encode_handshake(Frag, {3, 4}, ConnectionStates) -> + tls_record_1_3:encode_handshake(Frag, ConnectionStates); encode_handshake(Frag, Version, #{current_write := #{beast_mitigation := BeastMitigation, @@ -126,6 +128,8 @@ encode_handshake(Frag, Version, %% %% Description: Encodes an alert message to send on the ssl-socket. %%-------------------------------------------------------------------- +encode_alert_record(Alert, {3, 4}, ConnectionStates) -> + tls_record_1_3:encode_handshake(Alert, ConnectionStates); encode_alert_record(#alert{level = Level, description = Description}, Version, ConnectionStates) -> encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>, @@ -146,6 +150,8 @@ encode_change_cipher_spec(Version, ConnectionStates) -> %% %% Description: Encodes data to send on the ssl-socket. %%-------------------------------------------------------------------- +encode_data(Data, {3, 4}, ConnectionStates) -> + tls_record_1_3:encode_data(Data, ConnectionStates); encode_data(Frag, Version, #{current_write := #{beast_mitigation := BeastMitigation, security_parameters := @@ -159,12 +165,14 @@ encode_data(Frag, Version, %%==================================================================== %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) -> +-spec decode_cipher_text(tls_version(), #ssl_tls{}, ssl_record:connection_states(), boolean()) -> {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. %% %% Description: Decode cipher text %%-------------------------------------------------------------------- -decode_cipher_text(#ssl_tls{type = Type, version = Version, +decode_cipher_text({3,4}, CipherTextRecord, ConnectionStates, _) -> + tls_record_1_3:decode_cipher_text(CipherTextRecord, ConnectionStates); +decode_cipher_text(_, #ssl_tls{type = Type, version = Version, fragment = CipherFragment} = CipherText, #{current_read := #{compression_state := CompressionS0, @@ -193,7 +201,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, Alert end; -decode_cipher_text(#ssl_tls{type = Type, version = Version, +decode_cipher_text(_, #ssl_tls{type = Type, version = Version, fragment = CipherFragment} = CipherText, #{current_read := #{compression_state := CompressionS0, @@ -378,10 +386,10 @@ is_acceptable_version({N,_} = Version, Versions) is_acceptable_version(_,_) -> false. --spec hello_version(tls_version(), [tls_version()]) -> tls_version(). -hello_version(Version, _) when Version >= {3, 3} -> - Version; -hello_version(_, Versions) -> +-spec hello_version([tls_version()]) -> tls_version(). +hello_version([Highest|_]) when Highest >= {3,3} -> + Highest; +hello_version(Versions) -> lowest_protocol_version(Versions). %%-------------------------------------------------------------------- diff --git a/lib/ssl/src/tls_record_1_3.erl b/lib/ssl/src/tls_record_1_3.erl new file mode 100644 index 0000000000..d424336187 --- /dev/null +++ b/lib/ssl/src/tls_record_1_3.erl @@ -0,0 +1,287 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% + +-module(tls_record_1_3). + +-include("tls_record.hrl"). +-include("tls_record_1_3.hrl"). +-include("ssl_internal.hrl"). +-include("ssl_alert.hrl"). +-include("ssl_cipher.hrl"). + +%% Encoding +-export([encode_handshake/2, encode_alert_record/2, + encode_data/2]). +-export([encode_plain_text/3]). + +%% Decoding +-export([decode_cipher_text/2]). + +%%==================================================================== +%% Encoding +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec encode_handshake(iolist(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +% +%% Description: Encodes a handshake message to send on the tls-1.3-socket. +%%-------------------------------------------------------------------- +encode_handshake(Frag, ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + %% TODO: Consider padding here + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH), + encode_iolist(?HANDSHAKE, Data, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Frag, ConnectionStates) + end. + +%%-------------------------------------------------------------------- +-spec encode_alert_record(#alert{}, ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes an alert message to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_alert_record(#alert{level = Level, description = Description}, + ConnectionStates) -> + encode_plain_text(?ALERT, <<?BYTE(Level), ?BYTE(Description)>>, + ConnectionStates). +%%-------------------------------------------------------------------- +-spec encode_data(binary(), ssl_record:connection_states()) -> + {iolist(), ssl_record:connection_states()}. +%% +%% Description: Encodes data to send on the ssl-socket. +%%-------------------------------------------------------------------- +encode_data(Frag, ConnectionStates) -> + Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, {3,4}), + encode_iolist(?APPLICATION_DATA, Data, ConnectionStates). + +encode_plain_text(Type, Data0, #{current_write := Write0} = ConnectionStates) -> + PadLen = 0, %% TODO where to specify PadLen? + Data = inner_plaintext(Type, Data0, PadLen), + {CipherFragment, Write1} = encode_plain_text(Data, Write0), + {CipherText, Write} = encode_tls_cipher_text(CipherFragment, Write1), + {CipherText, ConnectionStates#{current_write => Write}}. + +encode_iolist(Type, Data, ConnectionStates0) -> + {ConnectionStates, EncodedMsg} = + lists:foldl(fun(Text, {CS0, Encoded}) -> + {Enc, CS1} = + encode_plain_text(Type, Text, CS0), + {CS1, [Enc | Encoded]} + end, {ConnectionStates0, []}, Data), + {lists:reverse(EncodedMsg), ConnectionStates}. + +%%==================================================================== +%% Decoding +%%==================================================================== + +%%-------------------------------------------------------------------- +-spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states()) -> + {#ssl_tls{}, ssl_record:connection_states()}| #alert{}. +%% +%% Description: Decode cipher text, use legacy type ssl_tls instead of tls_cipher_text +%% in decoding context so that we can reuse the code from erlier versions. +%%-------------------------------------------------------------------- +decode_cipher_text(#ssl_tls{type = ?OPAQUE_TYPE, + version = ?LEGACY_VERSION, + fragment = CipherFragment}, + #{current_read := + #{sequence_number := Seq, + cipher_state := CipherS0, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD, + bulk_cipher_algorithm = + BulkCipherAlgo} + } = ReadState0} = ConnectionStates0) -> + AAD = start_additional_data(), + CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), + case decipher_aead(BulkCipherAlgo, CipherS1, AAD, CipherFragment) of + {PlainFragment, CipherS1} -> + ConnectionStates = + ConnectionStates0#{current_read => + ReadState0#{cipher_state => CipherS1, + sequence_number => Seq + 1}}, + decode_inner_plaintext(PlainFragment, ConnectionStates); + #alert{} = Alert -> + Alert + end; +decode_cipher_text(#ssl_tls{type = Type, + version = ?LEGACY_VERSION, + fragment = CipherFragment}, + #{current_read := + #{security_parameters := + #security_parameters{ + cipher_suite = ?TLS_NULL_WITH_NULL_NULL} + }} = ConnnectionStates0) -> + {#ssl_tls{type = Type, + version = {3,4}, %% Internally use real version + fragment = CipherFragment}, ConnnectionStates0}; +decode_cipher_text(#ssl_tls{type = Type}, _) -> + %% Version mismatch is already asserted + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, {record_typ_mismatch, Type}). + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +split_bin(Bin, ChunkSize) -> + split_bin(Bin, ChunkSize, []). +split_bin(Bin, ChunkSize, _) -> + do_split_bin(Bin, ChunkSize, []). + +do_split_bin(<<>>, _, Acc) -> + lists:reverse(Acc); +do_split_bin(Bin, ChunkSize, Acc) -> + case Bin of + <<Chunk:ChunkSize/binary, Rest/binary>> -> + do_split_bin(Rest, ChunkSize, [Chunk | Acc]); + _ -> + lists:reverse(Acc, [Bin]) + end. + +inner_plaintext(Type, Data, Length) -> + #inner_plaintext{ + content = Data, + type = Type, + zeros = zero_padding(Length) + }. +zero_padding(Length)-> + binary:copy(<<?BYTE(0)>>, Length). + +encode_plain_text(#inner_plaintext{ + content = Data, + type = Type, + zeros = Zeros + }, #{cipher_state := CipherS0, + sequence_number := Seq, + security_parameters := + #security_parameters{ + cipher_type = ?AEAD} + } = WriteState0) -> + PlainText = <<Data/binary, ?BYTE(Type), Zeros/binary>>, + AAD = start_additional_data(), + CipherS1 = ssl_cipher:nonce_seed(<<?UINT64(Seq)>>, CipherS0), + {Encoded, WriteState} = cipher_aead(PlainText, WriteState0#{cipher_state => CipherS1}, AAD), + {#tls_cipher_text{opaque_type = Type, + legacy_version = {3,3}, + encoded_record = Encoded}, WriteState}; +encode_plain_text(#inner_plaintext{ + content = Data, + type = Type + }, #{security_parameters := + #security_parameters{ + cipher_suite = ?TLS_NULL_WITH_NULL_NULL} + } = WriteState0) -> + %% RFC8446 - 5.1. Record Layer + %% When record protection has not yet been engaged, TLSPlaintext + %% structures are written directly onto the wire. + {#tls_cipher_text{opaque_type = Type, + legacy_version = {3,3}, + encoded_record = Data}, WriteState0}; + +encode_plain_text(_, CS) -> + exit({cs, CS}). + +start_additional_data() -> + {MajVer, MinVer} = ?LEGACY_VERSION, + <<?BYTE(?OPAQUE_TYPE), ?BYTE(MajVer), ?BYTE(MinVer)>>. + +end_additional_data(AAD, Len) -> + <<AAD/binary, ?UINT16(Len)>>. + +nonce(#cipher_state{nonce = Nonce, iv = IV}) -> + Len = size(IV), + crypto:exor(<<Nonce:Len/bytes>>, IV). + +cipher_aead(Fragment, + #{cipher_state := CipherS0, + security_parameters := + #security_parameters{bulk_cipher_algorithm = + BulkCipherAlgo} + } = WriteState0, AAD) -> + {CipherFragment, CipherS1} = + cipher_aead(BulkCipherAlgo, CipherS0, AAD, Fragment), + {CipherFragment, WriteState0#{cipher_state => CipherS1}}. + +cipher_aead(Type, #cipher_state{key=Key} = CipherState, AAD0, Fragment) -> + AAD = end_additional_data(AAD0, erlang:iolist_size(Fragment)), + Nonce = nonce(CipherState), + {Content, CipherTag} = ssl_cipher:aead_encrypt(Type, Key, Nonce, Fragment, AAD), + {<<Content/binary, CipherTag/binary>>, CipherState}. + +encode_tls_cipher_text(#tls_cipher_text{opaque_type = Type, + legacy_version = {MajVer, MinVer}, + encoded_record = Encoded}, #{sequence_number := Seq} = Write) -> + Length = erlang:iolist_size(Encoded), + {[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Encoded], + Write#{sequence_number => Seq +1}}. + +decipher_aead(Type, #cipher_state{key = Key} = CipherState, AAD0, CipherFragment) -> + try + Nonce = nonce(CipherState), + {AAD, CipherText, CipherTag} = aead_ciphertext_split(CipherState, CipherFragment, AAD0), + case ssl_cipher:aead_decrypt(Type, Key, Nonce, CipherText, CipherTag, AAD) of + Content when is_binary(Content) -> + {Content, CipherState}; + _ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) + end + catch + _:_ -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC, decryption_failed) + end. + +aead_ciphertext_split(#cipher_state{tag_len = Len}, CipherTextFragment, AAD) -> + CipherLen = size(CipherTextFragment) - Len, + <<CipherText:CipherLen/bytes, CipherTag:Len/bytes>> = CipherTextFragment, + {end_additional_data(AAD, CipherLen), CipherText, CipherTag}. + +decode_inner_plaintext(PlainText, ConnnectionStates) -> + case remove_padding(PlainText) of + #alert{} = Alert -> + Alert; + {Data, Type} -> + {#ssl_tls{type = Type, + version = {3,4}, %% Internally use real version + fragment = Data}, ConnnectionStates} + end. + +remove_padding(PlainText)-> + case binary:split(PlainText, <<0>>, [global, trim]) of + [] -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, padding_error); + [Content] -> + Type = binary:last(Content), + split_content(Type, Content, erlang:byte_size(Content) - 1) + end. + +split_content(?HANDSHAKE, _, 0) -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_handshake); +split_content(?ALERT, _, 0) -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_alert); +%% For special middlebox compatible case! +split_content(?CHANGE_CIPHER_SPEC, _, 0) -> + ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE, empty_change_cipher_spec); +split_content(?APPLICATION_DATA = Type, _, 0) -> + {Type, <<>>}; +split_content(Type, Content, N) -> + <<Data:N/bytes, ?BYTE(Type)>> = Content, + {Type, Data}. diff --git a/lib/ssl/src/tls_record_1_3.hrl b/lib/ssl/src/tls_record_1_3.hrl new file mode 100644 index 0000000000..273427a34e --- /dev/null +++ b/lib/ssl/src/tls_record_1_3.hrl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018-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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +%%---------------------------------------------------------------------- +%% Purpose: Record and constant defenitions for the TLS-1.3-record protocol +%% see RFC 8446 not present in earlier versions +%%---------------------------------------------------------------------- + +-ifndef(tls_record_1_3). +-define(tls_record_1_3, true). + +%% enum { +%% invalid(0), +%% %% defined in ssl_record.hrl +%% change_cipher_spec(20), +%% alert(21), +%% handshake(22), +%% application_data(23), +%% heartbeat(24), /* RFC 6520 */ +%% (255) +%% } ContentType; + +-define(INVALID, 0). +-define(LEGACY_VERSION, {3,3}). +-define(OPAQUE_TYPE, 23). + +-record(inner_plaintext, { + content, %% data + type, %% Contentype + zeros %% padding "uint8 zeros[length_of_padding]" + }). +-record(tls_cipher_text, { %% Equivalent of encrypted version of #ssl_tls from previous versions + %% decrypted version will still use #ssl_tls for code reuse purposes + %% with real values for content type and version + opaque_type = ?OPAQUE_TYPE, + legacy_version = ?LEGACY_VERSION, + encoded_record + }). + +-endif. % -ifdef(tls_record_1_3). diff --git a/lib/ssl/src/tls_sender.erl b/lib/ssl/src/tls_sender.erl index 1c3c44cfe5..75409143a8 100644 --- a/lib/ssl/src/tls_sender.erl +++ b/lib/ssl/src/tls_sender.erl @@ -49,7 +49,8 @@ negotiated_version, renegotiate_at, connection_monitor, - dist_handle + dist_handle, + log_level }). %%%=================================================================== @@ -171,7 +172,8 @@ init({call, From}, {Pid, #{current_write := WriteState, protocol_cb := Connection, transport_cb := Transport, negotiated_version := Version, - renegotiate_at := RenegotiateAt}}, + renegotiate_at := RenegotiateAt, + log_level := LogLevel}}, #data{connection_states = ConnectionStates} = StateData0) -> Monitor = erlang:monitor(process, Pid), StateData = @@ -186,7 +188,8 @@ init({call, From}, {Pid, #{current_write := WriteState, protocol_cb = Connection, transport_cb = Transport, negotiated_version = Version, - renegotiate_at = RenegotiateAt}, + renegotiate_at = RenegotiateAt, + log_level = LogLevel}, {next_state, handshake, StateData, [{reply, From, ok}]}; init(info, Msg, StateData) -> handle_info(Msg, ?FUNCTION_NAME, StateData). @@ -319,21 +322,21 @@ handle_info({'DOWN', Monitor, _, _, _}, _, #data{connection_monitor = Monitor} = StateData) -> {stop, normal, StateData}; handle_info(_,_,_) -> - {keep_state_and_data}. + keep_state_and_data. send_tls_alert(Alert, #data{negotiated_version = Version, socket = Socket, protocol_cb = Connection, transport_cb = Transport, - connection_states = ConnectionStates0} = StateData0) -> + connection_states = ConnectionStates0, + log_level = LogLevel} = StateData0) -> {BinMsg, ConnectionStates} = Connection:encode_alert(Alert, Version, ConnectionStates0), Connection:send(Transport, Socket, BinMsg), - %% TODO: fix ssl_options for this process - %% Report = #{direction => outbound, - %% protocol => 'tls_record', - %% message => BinMsg}, - %% ssl_logger:debug(SslOpts#ssl_options.log_level, Report, #{domain => [otp,ssl,tls_record]}), + Report = #{direction => outbound, + protocol => 'tls_record', + message => BinMsg}, + ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), StateData0#data{connection_states = ConnectionStates}. send_application_data(Data, From, StateName, @@ -344,7 +347,8 @@ send_application_data(Data, From, StateName, protocol_cb = Connection, transport_cb = Transport, connection_states = ConnectionStates0, - renegotiate_at = RenegotiateAt} = StateData0) -> + renegotiate_at = RenegotiateAt, + log_level = LogLevel} = StateData0) -> case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of true -> ssl_connection:internal_renegotiation(Pid, ConnectionStates0), @@ -356,10 +360,18 @@ send_application_data(Data, From, StateName, StateData = StateData0#data{connection_states = ConnectionStates}, case Connection:send(Transport, Socket, Msgs) of ok when DistHandle =/= undefined -> + Report = #{direction => outbound, + protocol => 'tls_record', + message => Msgs}, + ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), {next_state, StateName, StateData, []}; Reason when DistHandle =/= undefined -> {next_state, death_row, StateData, [{state_timeout, 5000, Reason}]}; ok -> + Report = #{direction => outbound, + protocol => 'tls_record', + message => Msgs}, + ssl_logger:debug(LogLevel, Report, #{domain => [otp,ssl,tls_record]}), {next_state, StateName, StateData, [{reply, From, ok}]}; Result -> {next_state, StateName, StateData, [{reply, From, Result}]} diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 7d28962d2d..83dd7585dd 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -33,7 +33,10 @@ setup_keys/8, suites/1, prf/5, ecc_curves/1, ecc_curves/2, oid_to_enum/1, enum_to_oid/1, default_signature_algs/1, signature_algs/2, - default_signature_schemes/1, signature_schemes/2]). + default_signature_schemes/1, signature_schemes/2, + groups/1, groups/2, group_to_enum/1, enum_to_group/1, default_groups/1]). + +-export([derive_secret/4, hkdf_expand_label/5, hkdf_extract/3, hkdf_expand/4]). -type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | @@ -42,12 +45,53 @@ sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1 | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2. -type curves() :: [named_curve()]. --export_type([curves/0, named_curve/0]). +-type group() :: secp256r1 | secp384r1 | secp521r1 | ffdhe2048 | + ffdhe3072 | ffdhe4096 | ffdhe6144 | ffdhe8192. +-type supported_groups() :: [group()]. +-export_type([curves/0, named_curve/0, group/0, supported_groups/0]). %%==================================================================== %% Internal application API %%==================================================================== +%% TLS 1.3 --------------------------------------------------- +-spec derive_secret(Secret::binary(), Label::binary(), + Messages::binary(), Algo::ssl_cipher_format:hash()) -> Key::binary(). +derive_secret(Secret, Label, Messages, Algo) -> + Hash = crypto:hash(mac_algo(Algo), Messages), + hkdf_expand_label(Secret, Label, + Hash, ssl_cipher:hash_size(Algo), Algo). + +-spec hkdf_expand_label(Secret::binary(), Label0::binary(), + Context::binary(), Length::integer(), + Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary(). +hkdf_expand_label(Secret, Label0, Context, Length, Algo) -> + %% struct { + %% uint16 length = Length; + %% opaque label<7..255> = "tls13 " + Label; + %% opaque context<0..255> = Context; + %% } HkdfLabel; + Content = << <<"tls13">>/binary, Label0/binary, Context/binary>>, + Len = size(Content), + HkdfLabel = <<?UINT16(Len), Content/binary>>, + hkdf_expand(Secret, HkdfLabel, Length, Algo). + +-spec hkdf_extract(MacAlg::ssl_cipher_format:hash(), Salt::binary(), + KeyingMaterial::binary()) -> PseudoRandKey::binary(). + +hkdf_extract(MacAlg, Salt, KeyingMaterial) -> + hmac_hash(MacAlg, Salt, KeyingMaterial). + + +-spec hkdf_expand(PseudoRandKey::binary(), ContextInfo::binary(), + Length::integer(), Algo::ssl_cipher_format:hash()) -> KeyingMaterial::binary(). + +hkdf_expand(PseudoRandKey, ContextInfo, Length, Algo) -> + Iterations = erlang:ceil(Length / ssl_cipher:hash_size(Algo)), + hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, 1, Iterations, <<>>, <<>>). +%% TLS 1.3 --------------------------------------------------- + +%% TLS 1.0 -1.2 --------------------------------------------------- -spec master_secret(integer(), binary(), binary(), binary()) -> binary(). master_secret(PrfAlgo, PreMasterSecret, ClientRandom, ServerRandom) -> @@ -57,9 +101,10 @@ master_secret(PrfAlgo, PreMasterSecret, ClientRandom, ServerRandom) -> prf(PrfAlgo, PreMasterSecret, <<"master secret">>, [ClientRandom, ServerRandom], 48). +%% TLS 1.0 -1.2 --------------------------------------------------- -spec finished(client | server, integer(), integer(), binary(), [binary()]) -> binary(). - +%% TLS 1.0 -1.1 --------------------------------------------------- finished(Role, Version, PrfAlgo, MasterSecret, Handshake) when Version == 1; Version == 2; PrfAlgo == ?MD5SHA -> %% RFC 2246 & 4346 - 7.4.9. Finished @@ -73,9 +118,11 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) MD5 = crypto:hash(md5, Handshake), SHA = crypto:hash(sha, Handshake), prf(?MD5SHA, MasterSecret, finished_label(Role), [MD5, SHA], 12); +%% TLS 1.0 -1.1 --------------------------------------------------- +%% TLS 1.2 --------------------------------------------------- finished(Role, Version, PrfAlgo, MasterSecret, Handshake) - when Version == 3; Version == 4 -> + when Version == 3 -> %% RFC 5246 - 7.4.9. Finished %% struct { %% opaque verify_data[12]; @@ -85,22 +132,28 @@ finished(Role, Version, PrfAlgo, MasterSecret, Handshake) %% PRF(master_secret, finished_label, Hash(handshake_messages)) [0..11]; Hash = crypto:hash(mac_algo(PrfAlgo), Handshake), prf(PrfAlgo, MasterSecret, finished_label(Role), Hash, 12). +%% TLS 1.2 --------------------------------------------------- +%% TODO 1.3 finished -spec certificate_verify(md5sha | sha, integer(), [binary()]) -> binary(). +%% TLS 1.0 -1.1 --------------------------------------------------- certificate_verify(md5sha, _Version, Handshake) -> MD5 = crypto:hash(md5, Handshake), SHA = crypto:hash(sha, Handshake), <<MD5/binary, SHA/binary>>; +%% TLS 1.0 -1.1 --------------------------------------------------- +%% TLS 1.2 --------------------------------------------------- certificate_verify(HashAlgo, _Version, Handshake) -> crypto:hash(HashAlgo, Handshake). +%% TLS 1.2 --------------------------------------------------- -spec setup_keys(integer(), integer(), binary(), binary(), binary(), integer(), integer(), integer()) -> {binary(), binary(), binary(), binary(), binary(), binary()}. - +%% TLS v1.0 --------------------------------------------------- setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen, IVSize) when Version == 1 -> @@ -125,8 +178,9 @@ setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize ClientIV:IVSize/binary, ServerIV:IVSize/binary>> = KeyBlock, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}; +%% TLS v1.0 --------------------------------------------------- -%% TLS v1.1 +%% TLS v1.1 --------------------------------------------------- setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen, IVSize) when Version == 2 -> @@ -152,8 +206,9 @@ setup_keys(Version, _PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize ClientIV:IVSize/binary, ServerIV:IVSize/binary>> = KeyBlock, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}; +%% TLS v1.1 --------------------------------------------------- -%% TLS v1.2 +%% TLS v1.2 --------------------------------------------------- setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen, IVSize) when Version == 3; Version == 4 -> @@ -178,8 +233,10 @@ setup_keys(Version, PrfAlgo, MasterSecret, ServerRandom, ClientRandom, HashSize, ClientIV:IVSize/binary, ServerIV:IVSize/binary>> = KeyBlock, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. +%% TLS v1.2 --------------------------------------------------- --spec mac_hash(integer(), binary(), integer(), integer(), tls_record:tls_version(), +%% TLS 1.0 -1.2 --------------------------------------------------- +-spec mac_hash(integer() | atom(), binary(), integer(), integer(), tls_record:tls_version(), integer(), binary()) -> binary(). mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, @@ -193,6 +250,9 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, ?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>, Fragment]), Mac. +%% TLS 1.0 -1.2 --------------------------------------------------- + +%% TODO 1.3 same as above? -spec suites(1|2|3|4) -> [ssl_cipher_format:cipher_suite()]. @@ -286,8 +346,8 @@ signature_algs({3, 3}, HashSigns) -> end, [], HashSigns), lists:reverse(Supported). -default_signature_algs({3, 4}) -> - default_signature_algs({3, 3}); +default_signature_algs({3, 4} = Version) -> + default_signature_schemes(Version); default_signature_algs({3, 3} = Version) -> Default = [%% SHA2 {sha512, ecdsa}, @@ -341,7 +401,6 @@ signature_schemes(Version, SignatureSchemes) when is_tuple(Version) signature_schemes(_, _) -> []. - default_signature_schemes(Version) -> Default = [ rsa_pkcs1_sha256, @@ -367,12 +426,21 @@ default_signature_schemes(Version) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- +hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, N, N, Prev, Acc) -> + Keyingmaterial = hmac_hash(Algo, PseudoRandKey, <<Prev/binary, ContextInfo/binary, ?BYTE(N)>>), + binary:part(<<Acc/binary, Keyingmaterial/binary>>, {0, Length}); +hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, M, N, Prev, Acc) -> + Keyingmaterial = hmac_hash(Algo, PseudoRandKey, <<Prev/binary, ContextInfo/binary, ?BYTE(M)>>), + hkdf_expand(Algo, PseudoRandKey, ContextInfo, Length, M + 1, N, Keyingmaterial, <<Acc/binary, Keyingmaterial/binary>>). + %%%% HMAC and the Pseudorandom Functions RFC 2246 & 4346 - 5.%%%% hmac_hash(?NULL, _, _) -> <<>>; hmac_hash(Alg, Key, Value) -> crypto:hmac(mac_algo(Alg), Key, Value). +mac_algo(Alg) when is_atom(Alg) -> + Alg; mac_algo(?MD5) -> md5; mac_algo(?SHA) -> sha; mac_algo(?SHA256) -> sha256; @@ -468,6 +536,7 @@ ecc_curves(all) -> sect239k1,sect233k1,sect233r1,secp224k1,secp224r1, sect193r1,sect193r2,secp192k1,secp192r1,sect163k1, sect163r1,sect163r2,secp160k1,secp160r1,secp160r2]; + ecc_curves(Minor) -> TLSCurves = ecc_curves(all), ecc_curves(Minor, TLSCurves). @@ -482,6 +551,53 @@ ecc_curves(_Minor, TLSCurves) -> end end, [], TLSCurves). +-spec groups(4 | all | default) -> [group()]. +groups(all) -> + [secp256r1, + secp384r1, + secp521r1, + ffdhe2048, + ffdhe3072, + ffdhe4096, + ffdhe6144, + ffdhe8192]; +groups(default) -> + [secp256r1, + secp384r1, + secp521r1, + ffdhe2048]; +groups(Minor) -> + TLSGroups = groups(all), + groups(Minor, TLSGroups). +%% +-spec groups(4, [group()]) -> [group()]. +groups(_Minor, TLSGroups) -> + %% TODO: Adding FFDHE groups to crypto? + CryptoGroups = crypto:ec_curves() ++ [ffdhe2048,ffdhe3072,ffdhe4096,ffdhe6144,ffdhe8192], + lists:filter(fun(Group) -> proplists:get_bool(Group, CryptoGroups) end, TLSGroups). + +default_groups(Minor) -> + TLSGroups = groups(default), + groups(Minor, TLSGroups). + +group_to_enum(secp256r1) -> 23; +group_to_enum(secp384r1) -> 24; +group_to_enum(secp521r1) -> 25; +group_to_enum(ffdhe2048) -> 256; +group_to_enum(ffdhe3072) -> 257; +group_to_enum(ffdhe4096) -> 258; +group_to_enum(ffdhe6144) -> 259; +group_to_enum(ffdhe8192) -> 260. + +enum_to_group(23) -> secp256r1; +enum_to_group(24) -> secp384r1; +enum_to_group(25) -> secp521r1; +enum_to_group(256) -> ffdhe2048; +enum_to_group(257) -> ffdhe3072; +enum_to_group(258) -> ffdhe4096; +enum_to_group(259) -> ffdhe6144; +enum_to_group(260) -> ffdhe8192; +enum_to_group(_) -> undefined. %% ECC curves from draft-ietf-tls-ecc-12.txt (Oct. 17, 2005) oid_to_enum(?sect163k1) -> 1; diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index d5ba105478..a4adc7561b 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -62,6 +62,7 @@ MODULES = \ ssl_upgrade_SUITE\ ssl_sni_SUITE \ ssl_eqc_SUITE \ + ssl_rfc_5869_SUITE \ make_certs\ x509_test diff --git a/lib/ssl/test/property_test/ssl_eqc_handshake.erl b/lib/ssl/test/property_test/ssl_eqc_handshake.erl index 99c6554f15..6ffb6d311f 100644 --- a/lib/ssl/test/property_test/ssl_eqc_handshake.erl +++ b/lib/ssl/test/property_test/ssl_eqc_handshake.erl @@ -85,17 +85,14 @@ prop_tls_hs_encode_decode() -> ). %%-------------------------------------------------------------------- -%% Message Generators -------------------------------------------------- +%% Message Generators ----------------------------------------------- %%-------------------------------------------------------------------- -tls_version() -> - oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). - tls_msg(?'TLS_v1.3'= Version) -> oneof([client_hello(Version), server_hello(Version), %%new_session_ticket() - #end_of_early_data{}, + #end_of_early_data{}, encrypted_extensions(), certificate_1_3(), %%certificate_request_1_3, @@ -104,7 +101,8 @@ tls_msg(?'TLS_v1.3'= Version) -> key_update() ]); tls_msg(Version) -> - oneof([#hello_request{}, + oneof([ + #hello_request{}, client_hello(Version), server_hello(Version), certificate(), @@ -116,6 +114,9 @@ tls_msg(Version) -> finished() ]). +%% +%% Shared messages +%% client_hello(?'TLS_v1.3' = Version) -> #client_hello{session_id = session_id(), client_version = ?'TLS_v1.2', @@ -150,10 +151,6 @@ server_hello(Version) -> extensions = server_hello_extensions(Version) }. -encrypted_extensions() -> - ?LET(Exts, extensions(?'TLS_v1.3'), - #encrypted_extensions{extensions = Exts}). - certificate() -> #certificate{ asn1_certificates = certificate_chain() @@ -166,17 +163,35 @@ certificate_1_3() -> entries = certificate_entries(Certs, []) }). -key_update() -> - #key_update{request_update = request_update()}. - finished() -> ?LET(Size, digest_size(), #finished{verify_data = crypto:strong_rand_bytes(Size)}). +%% +%% TLS 1.0-1.2 messages +%% + + + +%% +%% TLS 1.3 messages +%% + +encrypted_extensions() -> + ?LET(Exts, extensions(?'TLS_v1.3', encrypted_extensions), + #encrypted_extensions{extensions = Exts}). + + +key_update() -> + #key_update{request_update = request_update()}. + + %%-------------------------------------------------------------------- %% Messge Data Generators ------------------------------------------- %%-------------------------------------------------------------------- +tls_version() -> + oneof([?'TLS_v1.3', ?'TLS_v1.2', ?'TLS_v1.1', ?'TLS_v1', ?'SSL_v3']). cipher_suite(Version) -> oneof(cipher_suites(Version)). @@ -200,52 +215,14 @@ server_random(_) -> crypto:strong_rand_bytes(32). -client_hello_extensions(?'TLS_v1.3' = Version) -> - ?LET({Versions, Ext}, {supported_versions(Version), c_hello_extensions(Version)}, - maps:merge(Ext, #{client_hello_versions => client_hello_versions(Versions)}) - ); -client_hello_extensions(?'TLS_v1.2' = Version) -> - ?LET({Versions, Exts}, {supported_versions(Version), c_hello_extensions(Version)}, - maps:merge(Exts, #{client_hello_versions => client_hello_versions(Versions)}) - ); client_hello_extensions(Version) -> - ?LET(Exts, - c_hello_extensions(Version), - maps:merge(empty_hello_extensions(Version, client), Exts)). - -server_hello_extensions(?'TLS_v1.3' = Version) -> - ?LET(Exts, - s_hello_extensions(Version), - maps:merge(Exts, #{server_hello_selected_version => server_hello_selected_version(Version)})); -server_hello_extensions(Version) -> - ?LET(Exts, - s_hello_extensions(Version), - Exts). - -c_hello_extensions(?'TLS_v1.3'= Version) -> - ?LET({KeyShare, PreShare}, {key_share_client_hello(), - pre_shared_keyextension()}, - maps:merge(empty_hello_extensions(Version, client), - #{key_share => KeyShare, - pre_shared_key => PreShare - }) - ); -c_hello_extensions(Version) -> - ?LET(Exts, extensions(Version), - maps:merge(empty_hello_extensions(Version, client), + ?LET(Exts, extensions(Version, client_hello), + maps:merge(ssl_handshake:empty_extensions(Version, client_hello), Exts)). -s_hello_extensions(?'TLS_v1.3'= Version) -> - ?LET({KeyShare, PreShare}, {key_share_server_hello(), - pre_shared_keyextension()}, - maps:merge(empty_hello_extensions(Version, server), - #{key_share => KeyShare, - pre_shared_key => PreShare - }) - ); -s_hello_extensions(Version) -> - ?LET(Exts, extensions(Version), - maps:merge(empty_hello_extensions(Version, server), +server_hello_extensions(Version) -> + ?LET(Exts, extensions(Version, server_hello), + maps:merge(ssl_handshake:empty_extensions(Version, server_hello), Exts)). key_share_client_hello() -> @@ -260,83 +237,260 @@ pre_shared_keyextension() -> oneof([undefined]). %%oneof([#pre_shared_keyextension{},undefined]). -extensions(?'TLS_v1.3') -> - ?LET({Ext_1_3, Exts}, {extensions_1_3(), extensions(?'TLS_v1.2')}, maps:merge(Ext_1_3, Exts)); -extensions(?'SSL_v3') -> +%% +--------------------------------------------------+-------------+ +%% | Extension | TLS 1.3 | +%% +--------------------------------------------------+-------------+ +%% | server_name [RFC6066] | CH, EE | +%% | | | +%% | max_fragment_length [RFC6066] | CH, EE | +%% | | | +%% | status_request [RFC6066] | CH, CR, CT | +%% | | | +%% | supported_groups [RFC7919] | CH, EE | +%% | | | +%% | signature_algorithms (RFC 8446) | CH, CR | +%% | | | +%% | use_srtp [RFC5764] | CH, EE | +%% | | | +%% | heartbeat [RFC6520] | CH, EE | +%% | | | +%% | application_layer_protocol_negotiation [RFC7301] | CH, EE | +%% | | | +%% | signed_certificate_timestamp [RFC6962] | CH, CR, CT | +%% | | | +%% | client_certificate_type [RFC7250] | CH, EE | +%% | | | +%% | server_certificate_type [RFC7250] | CH, EE | +%% | | | +%% | padding [RFC7685] | CH | +%% | | | +%% | key_share (RFC 8446) | CH, SH, HRR | +%% | | | +%% | pre_shared_key (RFC 8446) | CH, SH | +%% | | | +%% | psk_key_exchange_modes (RFC 8446) | CH | +%% | | | +%% | early_data (RFC 8446) | CH, EE, NST | +%% | | | +%% | cookie (RFC 8446) | CH, HRR | +%% | | | +%% | supported_versions (RFC 8446) | CH, SH, HRR | +%% | | | +%% | certificate_authorities (RFC 8446) | CH, CR | +%% | | | +%% | oid_filters (RFC 8446) | CR | +%% | | | +%% | post_handshake_auth (RFC 8446) | CH | +%% | | | +%% | signature_algorithms_cert (RFC 8446) | CH, CR | +%% +--------------------------------------------------+-------------+ +extensions(?'TLS_v1.3' = Version, client_hello) -> + ?LET({ + ServerName, + %% MaxFragmentLength, + %% StatusRequest, + SupportedGroups, + SignatureAlgorithms, + %% UseSrtp, + %% Heartbeat, + ALPN, + %% SignedCertTimestamp, + %% ClientCertiticateType, + %% ServerCertificateType, + %% Padding, + KeyShare, + %% PreSharedKey, + %% PSKKeyExchangeModes, + %% EarlyData, + %% Cookie, + SupportedVersions, + %% CertAuthorities, + %% PostHandshakeAuth, + SignatureAlgorithmsCert + }, + { + oneof([server_name(), undefined]), + %% oneof([max_fragment_length(), undefined]), + %% oneof([status_request(), undefined]), + oneof([supported_groups(Version), undefined]), + oneof([signature_algs(Version), undefined]), + %% oneof([use_srtp(), undefined]), + %% oneof([heartbeat(), undefined]), + oneof([alpn(), undefined]), + %% oneof([signed_cert_timestamp(), undefined]), + %% oneof([client_cert_type(), undefined]), + %% oneof([server_cert_type(), undefined]), + %% oneof([padding(), undefined]), + oneof([key_share(client_hello), undefined]), + %% oneof([pre_shared_key(), undefined]), + %% oneof([psk_key_exchange_modes(), undefined]), + %% oneof([early_data(), undefined]), + %% oneof([cookie(), undefined]), + oneof([client_hello_versions(Version), undefined]), + %% oneof([cert_authorities(), undefined]), + %% oneof([post_handshake_auth(), undefined]), + oneof([signature_algs_cert(), undefined]) + }, + maps:filter(fun(_, undefined) -> + false; + (_,_) -> + true + end, + #{ + sni => ServerName, + %% max_fragment_length => MaxFragmentLength, + %% status_request => StatusRequest, + elliptic_curves => SupportedGroups, + signature_algs => SignatureAlgorithms, + %% use_srtp => UseSrtp, + %% heartbeat => Heartbeat, + alpn => ALPN, + %% signed_cert_timestamp => SignedCertTimestamp, + %% client_cert_type => ClientCertificateType, + %% server_cert_type => ServerCertificateType, + %% padding => Padding, + key_share => KeyShare, + %% pre_shared_key => PreSharedKey, + %% psk_key_exhange_modes => PSKKeyExchangeModes, + %% early_data => EarlyData, + %% cookie => Cookie, + client_hello_versions => SupportedVersions, + %% cert_authorities => CertAuthorities, + %% post_handshake_auth => PostHandshakeAuth, + signature_algs_cert => SignatureAlgorithmsCert + })); +extensions(?'SSL_v3', client_hello) -> #{}; -extensions(Version) -> - ?LET({SNI, ECPoitF, ECCurves, ALPN, NextP, SRP}, - {oneof([sni(), undefined]), - oneof([ec_poit_formats(), undefined]), +extensions(Version, client_hello) -> + ?LET({ + SNI, + ECPoitF, + ECCurves, + ALPN, + NextP, + SRP + %% RenegotiationInfo + }, + { + oneof([sni(), undefined]), + oneof([ec_point_formats(), undefined]), oneof([elliptic_curves(Version), undefined]), oneof([alpn(), undefined]), oneof([next_protocol_negotiation(), undefined]), - oneof([srp(), undefined])}, + oneof([srp(), undefined]) + %% oneof([renegotiation_info(), undefined]) + }, maps:filter(fun(_, undefined) -> false; (_,_) -> true end, - #{sni => SNI, + #{ + sni => SNI, ec_point_formats => ECPoitF, elliptic_curves => ECCurves, alpn => ALPN, next_protocol_negotiation => NextP, - srp => SRP})). - -extensions_1_3() -> - %% ?LET(Entry, key_share_entry(), - %% maps:filter(fun(_, undefined) -> - %% false; - %% (_,_) -> - %% true - %% end, #{key_share_entry => Entry})). - ?LET({HashSign, SigAlgCert}, {oneof([hash_sign_algos(?'TLS_v1.2')]), oneof([signature_scheme_list()])}, - #{signature_algs => HashSign, - signature_algs_cert => SigAlgCert}). - -empty_hello_extensions({3, 4}, server) -> - #{server_hello_selected_version => undefined, - key_share => undefined, - pre_shared_key => undefined, - sni => undefined - }; -empty_hello_extensions({3, 4}, client) -> - #{client_hello_versions => undefined, - signature_algs => undefined, - signature_algs_cert => undefined, - sni => undefined, - alpn => undefined, - key_share => undefined, - pre_shared_key => undefined - }; -empty_hello_extensions({3, 3}, client) -> - Ext = empty_hello_extensions({3,2}, client), - Ext#{client_hello_versions => undefined, - signature_algs => undefined, - signature_algs_cert => undefined}; -empty_hello_extensions(_, client) -> - #{renegotiation_info => undefined, - alpn => undefined, - next_protocol_negotiation => undefined, - srp => undefined, - ec_point_formats => undefined, - elliptic_curves => undefined, - sni => undefined}; -empty_hello_extensions(_, server) -> - #{renegotiation_info => undefined, - alpn => undefined, - next_protocol_negotiation => undefined, - ec_point_formats => undefined, - sni => undefined}. + srp => SRP + %% renegotiation_info => RenegotiationInfo + })); +extensions(?'TLS_v1.3' = Version, server_hello) -> + ?LET({ + KeyShare, + %% PreSharedKeys, + SupportedVersions + }, + { + oneof([key_share(server_hello), undefined]), + %% oneof([pre_shared_keys(), undefined]), + oneof([server_hello_selected_version(), undefined]) + }, + maps:filter(fun(_, undefined) -> + false; + (_,_) -> + true + end, + #{ + key_share => KeyShare, + %% pre_shared_keys => PreSharedKeys, + server_hello_selected_version => SupportedVersions + })); +extensions(Version, server_hello) -> + ?LET({ + ECPoitF, + ALPN, + NextP + %% RenegotiationInfo, + }, + { + oneof([ec_point_formats(), undefined]), + oneof([alpn(), undefined]), + oneof([next_protocol_negotiation(), undefined]) + %% oneof([renegotiation_info(), undefined]), + }, + maps:filter(fun(_, undefined) -> + false; + (_,_) -> + true + end, + #{ + ec_point_formats => ECPoitF, + alpn => ALPN, + next_protocol_negotiation => NextP + %% renegotiation_info => RenegotiationInfo + })); +extensions(?'TLS_v1.3' = Version, encrypted_extensions) -> + ?LET({ + ServerName, + %% MaxFragmentLength, + SupportedGroups, + %% UseSrtp, + %% Heartbeat, + ALPN + %% ClientCertiticateType, + %% ServerCertificateType, + %% EarlyData + }, + { + oneof([server_name(), undefined]), + %% oneof([max_fragment_length(), undefined]), + oneof([supported_groups(Version), undefined]), + %% oneof([use_srtp(), undefined]), + %% oneof([heartbeat(), undefined]), + oneof([alpn(), undefined]) + %% oneof([client_cert_type(), undefined]), + %% oneof([server_cert_type(), undefined]), + %% oneof([early_data(), undefined]) + }, + maps:filter(fun(_, undefined) -> + false; + (_,_) -> + true + end, + #{ + sni => ServerName, + %% max_fragment_length => MaxFragmentLength, + elliptic_curves => SupportedGroups, + %% use_srtp => UseSrtp, + %% heartbeat => Heartbeat, + alpn => ALPN + %% client_cert_type => ClientCertificateType, + %% server_cert_type => ServerCertificateType, + %% early_data => EarlyData + })). + +server_name() -> + ?LET(ServerName, sni(), + ServerName). + %% sni(). signature_algs_cert() -> - ?LET(Algs, signature_scheme_list(), - Algs). + ?LET(List, sig_scheme_list(), + #signature_algorithms_cert{signature_scheme_list = List}). -signature_scheme_list() -> +signature_algorithms() -> ?LET(List, sig_scheme_list(), - #signature_scheme_list{signature_scheme_list = List}). + #signature_algorithms{signature_scheme_list = List}). sig_scheme_list() -> oneof([[rsa_pkcs1_sha256], @@ -357,16 +511,23 @@ sig_scheme_list() -> ecdsa_sha1] ]). -supported_versions(?'TLS_v1.3') -> - oneof([[{3,4}], - [{3,3},{3,4}], - [{3,4},{3,3},{3,2},{3,1},{3,0}] - ]); -supported_versions(_) -> - oneof([[{3,3}], - [{3,3},{3,2}], - [{3,3},{3,2},{3,1},{3,0}] - ]). +client_hello_versions(?'TLS_v1.3') -> + ?LET(SupportedVersions, + oneof([[{3,4}], + [{3,3},{3,4}], + [{3,4},{3,3},{3,2},{3,1},{3,0}] + ]), + #client_hello_versions{versions = SupportedVersions}); +client_hello_versions(_) -> + ?LET(SupportedVersions, + oneof([[{3,3}], + [{3,3},{3,2}], + [{3,3},{3,2},{3,1},{3,0}] + ]), + #client_hello_versions{versions = SupportedVersions}). + +server_hello_selected_version() -> + #server_hello_selected_version{selected_version = {3,4}}. request_update() -> oneof([?UPDATE_NOT_REQUESTED, ?UPDATE_REQUESTED]). @@ -431,13 +592,25 @@ certificate_types(?'TLS_v1.2') -> certificate_types(_) -> iolist_to_binary([<<?BYTE(?ECDSA_SIGN)>>, <<?BYTE(?RSA_SIGN)>>, <<?BYTE(?DSS_SIGN)>>]). + + +signature_algs({3,4}) -> + ?LET(Algs, signature_algorithms(), + Algs); +signature_algs({3,3} = Version) -> + #hash_sign_algos{hash_sign_algos = hash_alg_list(Version)}; +signature_algs(Version) when Version < {3,3} -> + undefined. + + + hashsign_algorithms({_, N} = Version) when N >= 3 -> #hash_sign_algos{hash_sign_algos = hash_alg_list(Version)}; hashsign_algorithms(_) -> undefined. hash_alg_list(Version) -> - ?LET(NumOf, choose(0,15), + ?LET(NumOf, choose(1,15), ?LET(List, [hash_alg(Version) || _ <- lists:seq(1,NumOf)], lists:usort(List) )). @@ -481,27 +654,27 @@ key_share_entry() -> undefined. %%#key_share_entry{}. -client_hello_versions(Versions) -> - #client_hello_versions{versions = Versions}. - server_hello_selected_version(Version) -> #server_hello_selected_version{selected_version = Version}. sni() -> #sni{hostname = net_adm:localhost()}. -ec_poit_formats() -> +ec_point_formats() -> #ec_point_formats{ec_point_format_list = ec_point_format_list()}. ec_point_format_list() -> [?ECPOINT_UNCOMPRESSED]. -elliptic_curves({_, Minor}) -> +elliptic_curves({_, Minor}) when Minor < 4 -> Curves = tls_v1:ecc_curves(Minor), #elliptic_curves{elliptic_curve_list = Curves}. -hash_sign_algos(Version) -> - #hash_sign_algos{hash_sign_algos = hash_alg_list(Version)}. +%% RFC 8446 (TLS 1.3) renamed the "elliptic_curve" extension. +supported_groups({_, Minor}) when Minor >= 4 -> + SupportedGroups = tls_v1:groups(Minor), + #supported_groups{supported_groups = SupportedGroups}. + alpn() -> ?LET(ExtD, alpn_protocols(), #alpn{extension_data = ExtD}). @@ -520,7 +693,7 @@ renegotiation_info() -> #renegotiation_info{renegotiated_connection = 0}. gen_name() -> - ?LET(Size, choose(0,10), gen_string(Size)). + ?LET(Size, choose(1,10), gen_string(Size)). gen_char() -> choose($a,$z). @@ -532,3 +705,57 @@ gen_string(0, Acc) -> Acc; gen_string(N, Acc) -> ?LET(Char, gen_char(), gen_string(N-1, [Char | Acc])). + +key_share(client_hello) -> + ?LET(ClientShares, key_share_entry_list(), + #key_share_client_hello{ + client_shares = ClientShares}); +key_share(server_hello) -> + ?LET([ServerShare], key_share_entry_list(1), + #key_share_server_hello{ + server_share = ServerShare}). + +key_share_entry_list() -> + Max = length(ssl:groups()), + ?LET(Size, choose(1,Max), key_share_entry_list(Size)). +%% +key_share_entry_list(N) -> + key_share_entry_list(N, ssl:groups(), []). +%% +key_share_entry_list(0, _Pool, Acc) -> + Acc; +key_share_entry_list(N, Pool, Acc) -> + R = rand:uniform(length(Pool)), + G = lists:nth(R, Pool), + P = generate_public_key(G), + KeyShareEntry = + #key_share_entry{ + group = G, + key_exchange = P}, + key_share_entry_list(N - 1, Pool -- [G], [KeyShareEntry|Acc]). + +generate_public_key(Group) + when Group =:= secp256r1 orelse + Group =:= secp384r1 orelse + Group =:= secp521r1 -> + #'ECPrivateKey'{publicKey = PublicKey} = + public_key:generate_key({namedCurve, secp256r1}), + PublicKey; +generate_public_key(Group) -> + {PublicKey, _} = + public_key:generate_key(ssl_dh_groups:dh_params(Group)), + PublicKey. + +groups() -> + Max = length(ssl:groups()), + ?LET(Size, choose(1,Max), group_list(Size)). + +group_list(N) -> + group_list(N, ssl:groups(), []). +%% +group_list(0, _Pool, Acc) -> + Acc; +group_list(N, Pool, Acc) -> + R = rand:uniform(length(Pool)), + G = lists:nth(R, Pool), + group_list(N - 1, Pool -- [G], [G|Acc]). diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index c93f066825..a5309e866b 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -395,10 +395,25 @@ client_ecdhe_rsa_server_ecdhe_ecdsa_client_custom(Config) -> end. mix_sign(Config) -> - {COpts0, SOpts0} = ssl_test_lib:make_mix_cert(Config), + mix_sign_rsa_peer(Config), + mix_sign_ecdsa_peer(Config). + +mix_sign_ecdsa_peer(Config) -> + {COpts0, SOpts0} = ssl_test_lib:make_mix_cert([{mix, peer_ecc} |Config]), COpts = ssl_test_lib:ssl_options(COpts0, Config), SOpts = ssl_test_lib:ssl_options(SOpts0, Config), ECDHE_ECDSA = ssl:filter_cipher_suites(ssl:cipher_suites(default, 'tlsv1.2'), [{key_exchange, fun(ecdhe_ecdsa) -> true; (_) -> false end}]), ssl_test_lib:basic_test(COpts, [{ciphers, ECDHE_ECDSA} | SOpts], Config). + + +mix_sign_rsa_peer(Config) -> + {COpts0, SOpts0} = ssl_test_lib:make_mix_cert([{mix, peer_rsa} |Config]), + COpts = ssl_test_lib:ssl_options(COpts0, Config), + SOpts = ssl_test_lib:ssl_options(SOpts0, Config), + ECDHE_RSA = + ssl:filter_cipher_suites(ssl:cipher_suites(default, 'tlsv1.2'), + [{key_exchange, fun(ecdhe_rsa) -> true; (_) -> false end}]), + ssl_test_lib:basic_test(COpts, [{ciphers, ECDHE_RSA} | SOpts], Config). + diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 97b794c3e2..1cfff436d2 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -244,7 +244,9 @@ error_handling_tests()-> recv_active_once, recv_error_handling, call_in_error_state, - close_in_error_state + close_in_error_state, + abuse_transport_accept_socket, + controlling_process_transport_accept_socket ]. error_handling_tests_tls()-> @@ -4054,7 +4056,51 @@ close_in_error_state(Config) when is_list(Config) -> Other -> ct:fail(Other) end. +%%-------------------------------------------------------------------- +abuse_transport_accept_socket() -> + [{doc,"Only ssl:handshake and ssl:controlling_process is allowed for transport_accept:sockets"}]. +abuse_transport_accept_socket(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), + + Server = ssl_test_lib:start_server_transport_abuse_socket([{node, ServerNode}, + {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +controlling_process_transport_accept_socket() -> + [{doc,"Only ssl:handshake and ssl:controlling_process is allowed for transport_accept:sockets"}]. +controlling_process_transport_accept_socket(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), + + Server = ssl_test_lib:start_server_transport_control([{node, ServerNode}, + {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + _Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, ClientOpts}]), + ssl_test_lib:check_result(Server, ok), + ssl_test_lib:close(Server). + +%%-------------------------------------------------------------------- run_error_server_close([Pid | Opts]) -> {ok, Listen} = ssl:listen(0, Opts), {ok,{_, Port}} = ssl:sockname(Listen), diff --git a/lib/ssl/test/ssl_bench_SUITE.erl b/lib/ssl/test/ssl_bench_SUITE.erl index 3fe6338d69..13097b08b6 100644 --- a/lib/ssl/test/ssl_bench_SUITE.erl +++ b/lib/ssl/test/ssl_bench_SUITE.erl @@ -44,6 +44,7 @@ init_per_suite(Config) -> nonode@nohost -> {skipped, "Node not distributed"}; _ -> + ssl_test_lib:clean_start(), [{server_node, ssl_bench_test_lib:setup(perf_server)}|Config] end. diff --git a/lib/ssl/test/ssl_bench_test_lib.erl b/lib/ssl/test/ssl_bench_test_lib.erl index e5cbb911bd..47bcd41608 100644 --- a/lib/ssl/test/ssl_bench_test_lib.erl +++ b/lib/ssl/test/ssl_bench_test_lib.erl @@ -58,13 +58,13 @@ setup(Name) -> Path = code:get_path(), true = rpc:call(Node, code, set_path, [Path]), ok = rpc:call(Node, ?MODULE, setup_server, [node()]), - io:format("Client (~p) using ~s~n",[node(), code:which(ssl)]), + io:format("Client (~p) using ~ts~n",[node(), code:which(ssl)]), (Node =:= node()) andalso restrict_schedulers(client), Node. setup_server(ClientNode) -> (ClientNode =:= node()) andalso restrict_schedulers(server), - io:format("Server (~p) using ~s~n",[node(), code:which(ssl)]), + io:format("Server (~p) using ~ts~n",[node(), code:which(ssl)]), ok. restrict_schedulers(Type) -> diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl index 1423c99dc2..e6c82d3eb5 100644 --- a/lib/ssl/test/ssl_engine_SUITE.erl +++ b/lib/ssl/test/ssl_engine_SUITE.erl @@ -90,12 +90,14 @@ end_per_testcase(_TestCase, Config) -> private_key(Config) when is_list(Config) -> ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client_engine"]), ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server_engine"]), + Ext = x509_test:extensions([{key_usage, [digitalSignature, keyEncipherment]}]), #{server_config := ServerConf, client_config := ClientConf} = GenCertData = public_key:pkix_test_data(#{server_chain => #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}], intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]], - peer => [{key, ssl_test_lib:hardcode_rsa_key(3)} + peer => [{extensions, Ext}, + {key, ssl_test_lib:hardcode_rsa_key(3)} ]}, client_chain => #{root => [{key, ssl_test_lib:hardcode_rsa_key(4)}], @@ -131,6 +133,12 @@ private_key(Config) when is_list(Config) -> %% Test with engine test_tls_connection(EngineServerConf, EngineClientConf, Config), + %% Test with engine and rsa keyexchange + RSASuites = all_kex_rsa_suites([{tls_version, 'tlsv1.2'} | Config]), + + test_tls_connection([{ciphers, RSASuites}, {versions, ['tlsv1.2']} | EngineServerConf], + [{ciphers, RSASuites}, {versions, ['tlsv1.2']} | EngineClientConf], Config), + %% Test with engine and present file arugments test_tls_connection(EngineFileServerConf, EngineFileClientConf, Config), @@ -160,3 +168,8 @@ test_tls_connection(ServerConf, ClientConf, Config) -> ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), ssl_test_lib:close(Client). + +all_kex_rsa_suites(Config) -> + Version = proplists:get_value(tls_version, Config), + All = ssl:cipher_suites(all, Version), + ssl:filter_cipher_suites(All,[{key_exchange, fun(rsa) -> true;(_) -> false end}]). diff --git a/lib/ssl/test/ssl_handshake_SUITE.erl b/lib/ssl/test/ssl_handshake_SUITE.erl index 861fecc554..e39313e5cd 100644 --- a/lib/ssl/test/ssl_handshake_SUITE.erl +++ b/lib/ssl/test/ssl_handshake_SUITE.erl @@ -112,7 +112,7 @@ decode_hello_handshake(_Config) -> decode_single_hello_extension_correctly(_Config) -> Renegotiation = <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(1), 0>>, - Extensions = ssl_handshake:decode_extensions(Renegotiation), + Extensions = ssl_handshake:decode_extensions(Renegotiation, {3,3}, undefined), #{renegotiation_info := #renegotiation_info{renegotiated_connection = <<0>>}} = Extensions. decode_supported_elliptic_curves_hello_extension_correctly(_Config) -> @@ -200,7 +200,7 @@ signature_algorithms(Config) -> hash_sign_algos = [{sha512, rsa}, {sha, dsa}, {sha, rsa}]}, - Schemes0 = #signature_scheme_list{ + Schemes0 = #signature_algorithms_cert{ signature_scheme_list = [rsa_pkcs1_sha1, ecdsa_sha1]}, {sha512, rsa} = ssl_handshake:select_hashsign( @@ -216,7 +216,7 @@ signature_algorithms(Config) -> Cert, ecdhe_rsa, tls_v1:default_signature_algs({3,3}), {3,3}), - Schemes1 = #signature_scheme_list{ + Schemes1 = #signature_algorithms_cert{ signature_scheme_list = [rsa_pkcs1_sha256, ecdsa_sha1]}, %% Signature not supported diff --git a/lib/ssl/test/ssl_rfc_5869_SUITE.erl b/lib/ssl/test/ssl_rfc_5869_SUITE.erl new file mode 100644 index 0000000000..8b2d1c2082 --- /dev/null +++ b/lib/ssl/test/ssl_rfc_5869_SUITE.erl @@ -0,0 +1,316 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2018-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. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(ssl_rfc_5869_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [sha_256_basic, + sha_256_long, + sha_256_no_salt, + sha_basic, + sha_long, + sha_no_salt, + sha_default_salt + ]. + +%%-------------------------------------------------------------------- +init_per_suite(Config) -> + catch crypto:stop(), + try crypto:start() of + ok -> + Config + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%-------------------------------------------------------------------- +init_per_testcase(_TestCase, Config) -> + ct:timetrap({seconds, 5}), + Config. + +end_per_testcase(_TestCase, Config) -> + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- + +sha_256_basic() -> + [{doc, "Basic test case with SHA-256"}]. +sha_256_basic(Config) when is_list(Config) -> + %% Hash = SHA-256 + %% IKM = 0x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b (22 octets) + %% salt = 0x000102030405060708090a0b0c (13 octets) + %% info = 0xf0f1f2f3f4f5f6f7f8f9 (10 octets) + %% L = 42 + %% PRK = 0x077709362c2e32df0ddc3f0dc47bba63 + %% 90b6c73bb50f9c3122ec844ad7c2b3e5 (32 octets) + %% OKM = 0x3cb25f25faacd57a90434f64d0362f2a + %% 2d2d0a90cf1a5a4c5db02d56ecc4c5bf + %% 34007208d5b887185865 (42 octets) + IKM = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + Salt = hexstr2bin("000102030405060708090a0b0c"), + Info = hexstr2bin("f0f1f2f3f4f5f6f7f8f9"), + PRK = hexstr2bin("077709362c2e32df0ddc3f0dc47bba63" + "90b6c73bb50f9c3122ec844ad7c2b3e5"), + OKM = hexstr2bin("3cb25f25faacd57a90434f64d0362f2a" + "2d2d0a90cf1a5a4c5db02d56ecc4c5bf" + "34007208d5b887185865"), + hkdf_test(sha256, Salt, IKM, PRK, Info, 42, OKM). + +sha_256_long() -> + [{doc, "Test with SHA-256 and longer inputs/outputs"}]. +sha_256_long(Config) when is_list(Config) -> + %% Hash = SHA-256 + %% IKM = 0x000102030405060708090a0b0c0d0e0f + %% 101112131415161718191a1b1c1d1e1f + %% 202122232425262728292a2b2c2d2e2f + %% 303132333435363738393a3b3c3d3e3f + %% 404142434445464748494a4b4c4d4e4f (80 octets) + %% salt = 0x606162636465666768696a6b6c6d6e6f + %% 707172737475767778797a7b7c7d7e7f + %% 808182838485868788898a8b8c8d8e8f + %% 909192939495969798999a9b9c9d9e9f + %% a0a1a2a3a4a5a6a7a8a9aaabacadaeaf (80 octets) + %% info = 0xb0b1b2b3b4b5b6b7b8b9babbbcbdbebf + %% c0c1c2c3c4c5c6c7c8c9cacbcccdcecf + %% d0d1d2d3d4d5d6d7d8d9dadbdcdddedf + %% e0e1e2e3e4e5e6e7e8e9eaebecedeeef + %% f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff (80 octets) + %% L = 82 + + %% PRK = 0x06a6b88c5853361a06104c9ceb35b45c + %% ef760014904671014a193f40c15fc244 (32 octets) + %% OKM = 0xb11e398dc80327a1c8e7f78c596a4934 + %% 4f012eda2d4efad8a050cc4c19afa97c + %% 59045a99cac7827271cb41c65e590e09 + %% da3275600c2f09b8367793a9aca3db71 + %% cc30c58179ec3e87c14c01d5c1f3434f + %% 1d87 (82 octets) + IKM = hexstr2bin("000102030405060708090a0b0c0d0e0f" + "101112131415161718191a1b1c1d1e1f" + "202122232425262728292a2b2c2d2e2f" + "303132333435363738393a3b3c3d3e3f" + "404142434445464748494a4b4c4d4e4f" + ), + Salt = hexstr2bin("606162636465666768696a6b6c6d6e6f" + "707172737475767778797a7b7c7d7e7f" + "808182838485868788898a8b8c8d8e8f" + "909192939495969798999a9b9c9d9e9f" + "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" + ), + Info = hexstr2bin("b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" + "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" + "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" + "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" + "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + ), + PRK = hexstr2bin("06a6b88c5853361a06104c9ceb35b45c" + "ef760014904671014a193f40c15fc244"), + OKM = hexstr2bin("b11e398dc80327a1c8e7f78c596a4934" + "4f012eda2d4efad8a050cc4c19afa97c" + "59045a99cac7827271cb41c65e590e09" + "da3275600c2f09b8367793a9aca3db71" + "cc30c58179ec3e87c14c01d5c1f3434f" + "1d87" + ), + hkdf_test(sha256, Salt, IKM, PRK, Info, 82, OKM). +sha_256_no_salt() -> + [{doc, "Test with SHA-256 and zero-length salt/info"}]. +sha_256_no_salt(Config) when is_list(Config) -> + %% Hash = SHA-256 + %% IKM = 0x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b (22 octets) + %% salt = (0 octets) + %% info = (0 octets) + %% L = 42 + + %% PRK = 0x19ef24a32c717b167f33a91d6f648bdf + %% 96596776afdb6377ac434c1c293ccb04 (32 octets) + %% OKM = 0x8da4e775a563c18f715f802a063c5a31 + %% b8a11f5c5ee1879ec3454e5f3c738d2d + %% 9d201395faa4b61a96c8 (42 octets) + IKM = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + Salt = <<>>, + Info = <<>>, + PRK = hexstr2bin("19ef24a32c717b167f33a91d6f648bdf" + "96596776afdb6377ac434c1c293ccb04"), + OKM = hexstr2bin("8da4e775a563c18f715f802a063c5a31" + "b8a11f5c5ee1879ec3454e5f3c738d2d" + "9d201395faa4b61a96c8"), + hkdf_test(sha256, Salt, IKM, PRK, Info, 42, OKM). + +sha_basic() -> + [{doc, " Basic test case with SHA-1"}]. +sha_basic(Config) when is_list(Config) -> + %% Hash = SHA-1 + %% IKM = 0x0b0b0b0b0b0b0b0b0b0b0b (11 octets) + %% salt = 0x000102030405060708090a0b0c (13 octets) + %% info = 0xf0f1f2f3f4f5f6f7f8f9 (10 octets) + %% L = 42 + + %% PRK = 0x9b6c18c432a7bf8f0e71c8eb88f4b30baa2ba243 (20 octets) + %% OKM = 0x085a01ea1b10f36933068b56efa5ad81 + %% a4f14b822f5b091568a9cdd4f155fda2 + %% c22e422478d305f3f896 (42 octets) + IKM = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + Salt = hexstr2bin("000102030405060708090a0b0c"), + Info = hexstr2bin("f0f1f2f3f4f5f6f7f8f9"), + PRK = hexstr2bin("077709362c2e32df0ddc3f0dc47bba63" + "90b6c73bb50f9c3122ec844ad7c2b3e5"), + OKM = hexstr2bin("3cb25f25faacd57a90434f64d0362f2a" + "2d2d0a90cf1a5a4c5db02d56ecc4c5bf" + "34007208d5b887185865"), + hkdf_test(sha256, Salt, IKM, PRK, Info, 42, OKM). + +sha_long() -> + [{doc, "Test with SHA-1 and longer inputs/outputs"}]. +sha_long(Config) when is_list(Config) -> + %% Hash = SHA-1 + %% IKM = 0x000102030405060708090a0b0c0d0e0f + %% 101112131415161718191a1b1c1d1e1f + %% 202122232425262728292a2b2c2d2e2f + %% 303132333435363738393a3b3c3d3e3f + %% 404142434445464748494a4b4c4d4e4f (80 octets) + %% salt = 0x606162636465666768696a6b6c6d6e6f + %% 707172737475767778797a7b7c7d7e7f + %% 808182838485868788898a8b8c8d8e8f + %% 909192939495969798999a9b9c9d9e9f + %% a0a1a2a3a4a5a6a7a8a9aaabacadaeaf (80 octets) + %% info = 0xb0b1b2b3b4b5b6b7b8b9babbbcbdbebf + %% c0c1c2c3c4c5c6c7c8c9cacbcccdcecf + %% d0d1d2d3d4d5d6d7d8d9dadbdcdddedf + %% e0e1e2e3e4e5e6e7e8e9eaebecedeeef + %% f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff (80 octets) + %% L = 82 + + %% PRK = 0x8adae09a2a307059478d309b26c4115a224cfaf6 (20 octets) + %% OKM = 0x0bd770a74d1160f7c9f12cd5912a06eb + %% ff6adcae899d92191fe4305673ba2ffe + %% 8fa3f1a4e5ad79f3f334b3b202b2173c + %% 486ea37ce3d397ed034c7f9dfeb15c5e + %% 927336d0441f4c4300e2cff0d0900b52 + %% d3b4 (82 octets) + IKM = hexstr2bin("000102030405060708090a0b0c0d0e0f" + "101112131415161718191a1b1c1d1e1f" + "202122232425262728292a2b2c2d2e2f" + "303132333435363738393a3b3c3d3e3f" + "404142434445464748494a4b4c4d4e4f" + ), + Salt = hexstr2bin("606162636465666768696a6b6c6d6e6f" + "707172737475767778797a7b7c7d7e7f" + "808182838485868788898a8b8c8d8e8f" + "909192939495969798999a9b9c9d9e9f" + "a0a1a2a3a4a5a6a7a8a9aaabacadaeaf" + ), + Info = hexstr2bin("b0b1b2b3b4b5b6b7b8b9babbbcbdbebf" + "c0c1c2c3c4c5c6c7c8c9cacbcccdcecf" + "d0d1d2d3d4d5d6d7d8d9dadbdcdddedf" + "e0e1e2e3e4e5e6e7e8e9eaebecedeeef" + "f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff" + ), + PRK = hexstr2bin("8adae09a2a307059478d309b26c4115a224cfaf6"), + OKM = hexstr2bin("0bd770a74d1160f7c9f12cd5912a06eb" + "ff6adcae899d92191fe4305673ba2ffe" + "8fa3f1a4e5ad79f3f334b3b202b2173c" + "486ea37ce3d397ed034c7f9dfeb15c5e" + "927336d0441f4c4300e2cff0d0900b52" + "d3b4" + ), + hkdf_test(sha, Salt, IKM, PRK, Info, 82, OKM). + +sha_no_salt() -> + [{doc, "Test with SHA-1 and zero-length salt/info"}]. +sha_no_salt(Config) when is_list(Config) -> + %% Hash = SHA-1 + %% IKM = 0x0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b (22 octets) + %% salt = (0 octets) + %% info = (0 octets) + %% L = 42 + + %% PRK = 0xda8c8a73c7fa77288ec6f5e7c297786aa0d32d01 (20 octets) + %% OKM = 0x0ac1af7002b3d761d1e55298da9d0506 + %% b9ae52057220a306e07b6b87e8df21d0 + %% ea00033de03984d34918 (42 octets) + IKM = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), + Salt = <<>>, + Info = <<>>, + PRK = hexstr2bin("da8c8a73c7fa77288ec6f5e7c297786aa0d32d01"), + OKM = hexstr2bin("0ac1af7002b3d761d1e55298da9d0506" + "b9ae52057220a306e07b6b87e8df21d0" + "ea00033de03984d34918"), + hkdf_test(sha, Salt, IKM, PRK, Info, 42, OKM). + + +sha_default_salt() -> + [{doc, "Test with SHA-1, salt not provided (defaults to HashLen zero octets), + zero-length info"}]. +sha_default_salt(Config) when is_list(Config) -> + %% Hash = SHA-1 + %% IKM = 0x0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c (22 octets) + %% salt = not provided (defaults to HashLen zero octets) + %% info = (0 octets) + %% L = 42 + + %% PRK = 0x2adccada18779e7c2077ad2eb19d3f3e731385dd (20 octets) + %% OKM = 0x2c91117204d745f3500d636a62f64f0a + %% b3bae548aa53d423b0d1f27ebba6f5e5 + %% 673a081d70cce7acfc48 (42 octets) + IKM = hexstr2bin("0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c"), + Salt = binary:copy(<<0>>, 20), + Info = <<>>, + PRK = hexstr2bin("2adccada18779e7c2077ad2eb19d3f3e731385dd"), + OKM = hexstr2bin("2c91117204d745f3500d636a62f64f0a" + "b3bae548aa53d423b0d1f27ebba6f5e5" + "673a081d70cce7acfc48"), + hkdf_test(sha, Salt, IKM, PRK, Info, 42, OKM). + +hkdf_test(HashAlg, Salt, KeyingMaterial, PsedoRandKey, ContextInfo, Length, Key) -> + PsedoRandKey = tls_v1:hkdf_extract(HashAlg, Salt, KeyingMaterial), + Key = tls_v1:hkdf_expand(PsedoRandKey, ContextInfo, Length, HashAlg). + +hexstr2bin(S) when is_binary(S) -> + list_to_binary(hexstr2list(binary_to_list(S))); +hexstr2bin(S) -> + list_to_binary(hexstr2list(S)). + +hexstr2list([$ |T]) -> + hexstr2list(T); +hexstr2list([X,Y|T]) -> + [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; +hexstr2list([]) -> + []. +mkint(C) when $0 =< C, C =< $9 -> + C - $0; +mkint(C) when $A =< C, C =< $F -> + C - $A + 10; +mkint(C) when $a =< C, C =< $f -> + C - $a + 10. diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 39a5bcaad6..8a2f0824fb 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -196,6 +196,55 @@ connect(ListenSocket, Node, _, _, Timeout, Opts, _) -> rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Opts, Timeout]), AcceptSocket. + +start_server_transport_abuse_socket(Args) -> + Result = spawn_link(?MODULE, transport_accept_abuse, [Args]), + receive + {listen, up} -> + Result + end. + +start_server_transport_control(Args) -> + Result = spawn_link(?MODULE, transport_switch_control, [Args]), + receive + {listen, up} -> + Result + end. + + +transport_accept_abuse(Opts) -> + Node = proplists:get_value(node, Opts), + Port = proplists:get_value(port, Opts), + Options = proplists:get_value(options, Opts), + Pid = proplists:get_value(from, Opts), + Transport = proplists:get_value(transport, Opts, ssl), + ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), + {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), + {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, + [ListenSocket]), + {error, _} = rpc:call(Node, ssl, connection_information, [AcceptSocket]), + _ = rpc:call(Node, ssl, handshake, [AcceptSocket, infinity]), + Pid ! {self(), ok}. + + +transport_switch_control(Opts) -> + Node = proplists:get_value(node, Opts), + Port = proplists:get_value(port, Opts), + Options = proplists:get_value(options, Opts), + Pid = proplists:get_value(from, Opts), + Transport = proplists:get_value(transport, Opts, ssl), + ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]), + {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]), + Pid ! {listen, up}, + send_selected_port(Pid, Port, ListenSocket), + {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept, + [ListenSocket]), + ok = rpc:call(Node, ssl, controlling_process, [AcceptSocket, self()]), + Pid ! {self(), ok}. + + remove_close_msg(0) -> ok; remove_close_msg(ReconnectTimes) -> @@ -693,20 +742,12 @@ make_mix_cert(Config) -> Ext = x509_test:extensions([{key_usage, [digitalSignature]}]), Digest = {digest, appropriate_sha(crypto:supports())}, CurveOid = hd(tls_v1:ecc_curves(0)), - ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "mix"]), - ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "mix"]), - ClientChain = [[Digest, {key, {namedCurve, CurveOid}}], - [Digest, {key, hardcode_rsa_key(1)}], - [Digest, {key, {namedCurve, CurveOid}}, {extensions, Ext}] - ], - ServerChain = [[Digest, {key, {namedCurve, CurveOid}}], - [Digest, {key, hardcode_rsa_key(2)}], - [Digest, {key, {namedCurve, CurveOid}},{extensions, Ext}] - ], + Mix = proplists:get_value(mix, Config, peer_ecc), ClientChainType =ServerChainType = mix, + {ClientChain, ServerChain} = mix(Mix, Digest, CurveOid, Ext), CertChainConf = gen_conf(ClientChainType, ServerChainType, ClientChain, ServerChain), - ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ClientChainType)]), - ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), atom_to_list(ServerChainType)]), + ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "mix" ++ atom_to_list(Mix)]), + ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "mix" ++ atom_to_list(Mix)]), GenCertData = public_key:pkix_test_data(CertChainConf), [{server_config, ServerConf}, {client_config, ClientConf}] = @@ -715,6 +756,28 @@ make_mix_cert(Config) -> [{reuseaddr, true}, {verify, verify_peer} | ServerConf] }. +mix(peer_ecc, Digest, CurveOid, Ext) -> + ClientChain = [[Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, hardcode_rsa_key(1)}], + [Digest, {key, {namedCurve, CurveOid}}, {extensions, Ext}] + ], + ServerChain = [[Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, hardcode_rsa_key(2)}], + [Digest, {key, {namedCurve, CurveOid}},{extensions, Ext}] + ], + {ClientChain, ServerChain}; + +mix(peer_rsa, Digest, CurveOid, Ext) -> + ClientChain = [[Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, hardcode_rsa_key(1)}, {extensions, Ext}] + ], + ServerChain = [[Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, {namedCurve, CurveOid}}], + [Digest, {key, hardcode_rsa_key(2)},{extensions, Ext}] + ], + {ClientChain, ServerChain}. + make_ecdsa_cert(Config) -> CryptoSupport = crypto:supports(), case proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)) of diff --git a/lib/stdlib/doc/src/beam_lib.xml b/lib/stdlib/doc/src/beam_lib.xml index 26d0724aaf..213170df7f 100644 --- a/lib/stdlib/doc/src/beam_lib.xml +++ b/lib/stdlib/doc/src/beam_lib.xml @@ -180,8 +180,8 @@ io:fwrite("~s~n", [erl_prettypr:format(erl_syntax:form_list(AC))]).</code> <name name="beam"/> <desc> <p>Each of the functions described below accept either the - module name, the filename, or a binary containing the BEAM - module.</p> + filename (as a string) or a binary containing the BEAM + module.</p> </desc> </datatype> <datatype> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 57a19ef2ca..611b176613 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -611,9 +611,8 @@ Error: fun containing local Erlang function calls </item> <item> <p><c>Item=stats, Value=tuple()</c></p> - <p>Returns internal statistics about <c>set</c>, <c>bag</c>, and - <c>duplicate_bag</c> tables on an internal format used by OTP - test suites. Not for production use.</p></item> + <p>Returns internal statistics about tables on an internal format + used by OTP test suites. Not for production use.</p></item> </list> </desc> </func> @@ -1140,16 +1139,11 @@ ets:select(Table, MatchSpec),</code> <c>set</c>, <c>bag</c> and <c>duplicate_bag</c>. For <c>ordered_set</c> the memory overhead depends on the number of inserted objects and the amount of actual detected - concurrency. The memory overhead can be especially large when both - options are combined.</p> + concurrency in runtime. The memory overhead can be especially + large when both options are combined.</p> <note> <p>Prior to stdlib-3.7 (OTP-22.0) <c>write_concurrency</c> had no effect on <c>ordered_set</c>.</p> - <p>The current implementation of <c>write_concurrency</c> for - <c>ordered_set</c> does only improve explicit single key - operations. Mixing single key operations with operations - potentially accessing multiple keys may even yield worse - performance with <c>write_concurrency</c> on <c>ordered_set</c>.</p> </note> <marker id="new_2_read_concurrency"></marker> </item> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index f793ec7fdf..fc34e51216 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -775,7 +775,7 @@ gen_event:stop -----> Module:terminate/2 <p>This callback is optional, so callback modules need not export it. The <c>gen_event</c> module provides a default implementation of this function that logs about the unexpected - <c>Info</c> message, drops it and returns <c>{noreply, State}</c>.</p> + <c>Info</c> message, drops it and returns <c>{ok, State}</c>.</p> </note> <p>This function is called for each installed event handler when an event manager receives any other message than an event or diff --git a/lib/stdlib/doc/src/lists.xml b/lib/stdlib/doc/src/lists.xml index c3d5d7e07a..e4215a5336 100644 --- a/lib/stdlib/doc/src/lists.xml +++ b/lib/stdlib/doc/src/lists.xml @@ -850,14 +850,6 @@ splitwith(Pred, List) -> > <input>lists:subtract("123212", "212").</input> "312".</pre> <p><c>lists:subtract(A, B)</c> is equivalent to <c>A -- B</c>.</p> - <warning> - <p>The complexity of <c>lists:subtract(A, B)</c> is proportional to - <c>length(A)*length(B)</c>, meaning that it is very slow if both - <c>A</c> and <c>B</c> are long lists. (If both lists are long, it - is a much better choice to use ordered lists and - <seealso marker="ordsets#subtract/2"> - <c>ordsets:subtract/2</c></seealso>.</p> - </warning> </desc> </func> diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml index 318643aef8..64b97fad7f 100644 --- a/lib/stdlib/doc/src/notes.xml +++ b/lib/stdlib/doc/src/notes.xml @@ -504,6 +504,21 @@ </section> +<section><title>STDLIB 3.4.5.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>List subtraction (The <c>--</c> operator) will now + yield properly on large inputs.</p> + <p> + Own Id: OTP-15371</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 3.4.5</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -1658,6 +1673,21 @@ </section> +<section><title>STDLIB 2.8.0.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p>List subtraction (The <c>--</c> operator) will now + yield properly on large inputs.</p> + <p> + Own Id: OTP-15371</p> + </item> + </list> + </section> + +</section> + <section><title>STDLIB 2.8</title> <section><title>Fixed Bugs and Malfunctions</title> @@ -7827,4 +7857,3 @@ </section> </section> </chapter> - diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 01181b1097..3386cfcbe6 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -53,7 +53,7 @@ %%------------------------------------------------------------------------- --type beam() :: module() | file:filename() | binary(). +-type beam() :: file:filename() | binary(). -type debug_info() :: {DbgiVersion :: atom(), Backend :: module(), Data :: term()} | 'no_debug_info'. -type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()]. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index e9ac2fcdff..e0cd68617b 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2262,8 +2262,7 @@ expr({'fun',Line,Body}, Vt, St) -> {[],St}; {function,M,F,A} -> %% New in R15. - {Bvt, St1} = expr_list([M,F,A], Vt, St), - {vtupdate(Bvt, Vt),St1} + expr_list([M,F,A], Vt, St) end; expr({named_fun,_,'_',Cs}, Vt, St) -> fun_clauses(Cs, Vt, St); diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index aaed13ba3a..2cfc702b53 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -398,10 +398,8 @@ obsolete_1(megaco, format_versions, 1) -> %% *** OS-MON-MIB *** -obsolete_1(os_mon_mib, init, 1) -> - {deprecated, {os_mon_mib, load, 1}}; -obsolete_1(os_mon_mib, stop, 1) -> - {deprecated, {os_mon_mib, unload, 1}}; +obsolete_1(os_mon_mib, _, _) -> + {removed, "was removed in 22.0"}; obsolete_1(auth, is_auth, 1) -> {deprecated, {net_adm, ping, 1}}; diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index cd09872b87..9cd425db9a 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -108,7 +108,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-10.0","crypto-3.3", + {runtime_dependencies, ["sasl-3.0","kernel-6.0","erts-@OTP-15128@","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index bbe3cefa42..712b1b92fb 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -99,11 +99,9 @@ MODULES= \ maps_SUITE \ zzz_SUITE -ERL_FILES= $(MODULES:%=%.erl) +ERTS_MODULES= erts_test_utils -TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) - -INSTALL_PROGS= $(TARGET_FILES) +ERL_FILES= $(MODULES:%=%.erl) $(ERTS_MODULES:%=$(ERL_TOP)/erts/emulator/test/%.erl) # ---------------------------------------------------- # Release directory specification @@ -128,7 +126,7 @@ COVERFILE=stdlib.cover # ---------------------------------------------------- make_emakefile: - $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) $(ERTS_MODULES) \ > $(EMAKEFILE) tests debug opt: make_emakefile diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c1613a7273..e6ed55bf2d 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -67,7 +67,8 @@ record_errors/1, otp_11879_cont/1, non_latin1_module/1, otp_14323/1, stacktrace_syntax/1, - otp_14285/1, otp_14378/1]). + otp_14285/1, otp_14378/1, + external_funs/1]). suite() -> [{ct_hooks,[ts_install_cth]}, @@ -88,7 +89,7 @@ all() -> maps, maps_type, maps_parallel_match, otp_11851, otp_11879, otp_13230, record_errors, otp_11879_cont, non_latin1_module, otp_14323, - stacktrace_syntax, otp_14285, otp_14378]. + stacktrace_syntax, otp_14285, otp_14378, external_funs]. groups() -> [{unused_vars_warn, [], @@ -4134,6 +4135,21 @@ otp_14285(Config) -> run(Config, Ts), ok. +external_funs(Config) when is_list(Config) -> + Ts = [{external_funs_1, + %% ERL-762: Unused variable warning not being emitted. + <<"f() -> + BugVar = process_info(self()), + if true -> fun m:f/1 end. + f(M, F) -> + BugVar = process_info(self()), + if true -> fun M:F/1 end.">>, + [], + {warnings,[{2,erl_lint,{unused_var,'BugVar'}}, + {5,erl_lint,{unused_var,'BugVar'}}]}}], + run(Config, Ts), + ok. + format_error(E) -> lists:flatten(erl_lint:format_error(E)). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 2c0692855f..22c77aa172 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -66,6 +66,7 @@ meta_lookup_named_read/1, meta_lookup_named_write/1, meta_newdel_unnamed/1, meta_newdel_named/1]). -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, + smp_ordered_iteration/1, smp_select_replace/1, otp_8166/1, otp_8732/1, delete_unfix_race/1]). -export([throughput_benchmark/0, test_throughput_benchmark/1]). -export([exit_large_table_owner/1, @@ -133,7 +134,8 @@ all() -> otp_5340, otp_6338, otp_6842_select_1000, otp_7665, otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted, shrink_pseudo_deleted, {group, meta_smp}, smp_insert, - smp_fixed_delete, smp_unfix_fix, smp_select_replace, + smp_fixed_delete, smp_unfix_fix, smp_select_replace, + smp_ordered_iteration, smp_select_delete, otp_8166, exit_large_table_owner, exit_many_large_table_owner, exit_many_tables_owner, exit_many_many_tables_owner, write_concurrency, heir, @@ -796,15 +798,16 @@ t_delete_all_objects(Config) when is_list(Config) -> get_kept_objects(T) -> case ets:info(T,stats) of - false -> - 0; {_,_,_,_,_,_,KO} -> - KO + KO; + _ -> + 0 end. t_delete_all_objects_do(Opts) -> - T=ets_new(x,Opts), - filltabint(T,4000), + KeyRange = 4000, + T=ets_new(x, Opts, KeyRange), + filltabint(T,KeyRange), O=ets:first(T), ets:next(T,O), ets:safe_fixtable(T,true), @@ -813,13 +816,13 @@ t_delete_all_objects_do(Opts) -> 0 = ets:info(T,size), case ets:info(T,type) of ordered_set -> ok; - _ -> 4000 = get_kept_objects(T) + _ -> KeyRange = get_kept_objects(T) end, ets:safe_fixtable(T,false), 0 = ets:info(T,size), 0 = get_kept_objects(T), - filltabint(T,4000), - 4000 = ets:info(T,size), + filltabint(T, KeyRange), + KeyRange = ets:info(T,size), true = ets:delete_all_objects(T), 0 = ets:info(T,size), ets:delete(T), @@ -3104,18 +3107,18 @@ setbag(Config) when is_list(Config) -> %% Test case to check proper return values for illegal ets_new() calls. badnew(Config) when is_list(Config) -> EtsMem = etsmem(), - {'EXIT',{badarg,_}} = (catch ets_new(12,[])), - {'EXIT',{badarg,_}} = (catch ets_new({a,b},[])), - {'EXIT',{badarg,_}} = (catch ets_new(name,[foo])), - {'EXIT',{badarg,_}} = (catch ets_new(name,{bag})), - {'EXIT',{badarg,_}} = (catch ets_new(name,bag)), + {'EXIT',{badarg,_}} = (catch ets:new(12,[])), + {'EXIT',{badarg,_}} = (catch ets:new({a,b},[])), + {'EXIT',{badarg,_}} = (catch ets:new(name,[foo])), + {'EXIT',{badarg,_}} = (catch ets:new(name,{bag})), + {'EXIT',{badarg,_}} = (catch ets:new(name,bag)), verify_etsmem(EtsMem). %% OTP-2314. Test case to check that a non-proper list does not %% crash the emulator. verybadnew(Config) when is_list(Config) -> EtsMem = etsmem(), - {'EXIT',{badarg,_}} = (catch ets_new(verybad,[set|protected])), + {'EXIT',{badarg,_}} = (catch ets:new(verybad,[set|protected])), verify_etsmem(EtsMem). %% Small check to see if named tables work. @@ -3464,9 +3467,11 @@ delete_tab_do(Opts) -> %% Check that ets:delete/1 works and that other processes can run. delete_large_tab(Config) when is_list(Config) -> ct:timetrap({minutes,60}), %% valgrind needs a lot - Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 200000)], + KeyRange = 16#ffffff, + Data = [{erlang:phash2(I, KeyRange),I} || I <- lists:seq(1, 200000)], EtsMem = etsmem(), - repeat_for_opts(fun(Opts) -> delete_large_tab_do(Opts,Data) end), + repeat_for_opts(fun(Opts) -> delete_large_tab_do(key_range(Opts,KeyRange), + Data) end), verify_etsmem(EtsMem). delete_large_tab_do(Opts,Data) -> @@ -3542,9 +3547,13 @@ delete_large_tab_2(Name, Flags, Data, Fix) -> %% Delete a large name table and try to create a new table with %% the same name in another process. delete_large_named_table(Config) when is_list(Config) -> - Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 200000)], + KeyRange = 16#ffffff, + Data = [{erlang:phash2(I, KeyRange),I} || I <- lists:seq(1, 200000)], EtsMem = etsmem(), - repeat_for_opts(fun(Opts) -> delete_large_named_table_do(Opts,Data) end), + repeat_for_opts(fun(Opts) -> + delete_large_named_table_do(key_range(Opts,KeyRange), + Data) + end), verify_etsmem(EtsMem), ok. @@ -3585,8 +3594,12 @@ delete_large_named_table_2(Name, Flags, Data, Fix) -> %% Delete a large table, and kill the process during the delete. evil_delete(Config) when is_list(Config) -> - Data = [{I,I*I} || I <- lists:seq(1, 100000)], - repeat_for_opts(fun(Opts) -> evil_delete_do(Opts,Data) end). + KeyRange = 100000, + Data = [{I,I*I} || I <- lists:seq(1, KeyRange)], + repeat_for_opts(fun(Opts) -> + evil_delete_do(key_range(Opts,KeyRange), + Data) + end). evil_delete_do(Opts,Data) -> EtsMem = etsmem(), @@ -4154,19 +4167,12 @@ match_object2(Config) when is_list(Config) -> match_object2_do(Opts) -> EtsMem = etsmem(), - Tab = ets_new(foo, [bag, {keypos, 2} | Opts]), - fill_tab2(Tab, 0, 13005), % match_db_object does 1000 + KeyRange = 13005, + Tab = ets_new(foo, [{keypos, 2} | Opts], KeyRange), + fill_tab2(Tab, 0, KeyRange), % match_db_object does 1000 % elements per pass, might % change in the future. - case catch ets:match_object(Tab, {hej, '$1'}) of - {'EXIT', _} -> - ets:delete(Tab), - ct:fail("match_object EXIT:ed"); - [] -> - io:format("Nothing matched."); - List -> - io:format("Matched:~p~n",[List]) - end, + [] = ets:match_object(Tab, {hej, '$1'}), ets:delete(Tab), verify_etsmem(EtsMem). @@ -4411,10 +4417,11 @@ tab2file2(Config) when is_list(Config) -> tab2file2_do(Opts, Config) -> EtsMem = etsmem(), - Tab = ets_new(ets_SUITE_foo_tab, [named_table, private, - {keypos, 2} | Opts]), + KeyRange = 10000, + Tab = ets_new(ets_SUITE_foo_tab, [named_table, private, {keypos, 2} | Opts], + KeyRange), FName = filename:join([proplists:get_value(priv_dir, Config),"tab2file2_case"]), - ok = fill_tab2(Tab, 0, 10000), % Fill up the table (grucho mucho!) + ok = fill_tab2(Tab, 0, KeyRange), % Fill up the table (grucho mucho!) Len = length(ets:tab2list(Tab)), Mem = ets:info(Tab, memory), Type = ets:info(Tab, type), @@ -4473,8 +4480,9 @@ tabfile_ext1(Config) when is_list(Config) -> tabfile_ext1_do(Opts,Config) -> FName = filename:join([proplists:get_value(priv_dir, Config),"nisse.dat"]), FName2 = filename:join([proplists:get_value(priv_dir, Config),"countflip.dat"]), - L = lists:seq(1,10), - T = ets_new(x,Opts), + KeyRange = 10, + L = lists:seq(1,KeyRange), + T = ets_new(x,Opts,KeyRange), Name = make_ref(), [ets:insert(T,{X,integer_to_list(X)}) || X <- L], ok = ets:tab2file(T,FName,[{extended_info,[object_count]}]), @@ -4511,8 +4519,9 @@ tabfile_ext2(Config) when is_list(Config) -> tabfile_ext2_do(Opts,Config) -> FName = filename:join([proplists:get_value(priv_dir, Config),"olle.dat"]), FName2 = filename:join([proplists:get_value(priv_dir, Config),"bitflip.dat"]), - L = lists:seq(1,10), - T = ets_new(x,Opts), + KeyRange = 10, + L = lists:seq(1, KeyRange), + T = ets_new(x, Opts, KeyRange), Name = make_ref(), [ets:insert(T,{X,integer_to_list(X)}) || X <- L], ok = ets:tab2file(T,FName,[{extended_info,[md5sum]}]), @@ -4681,9 +4690,10 @@ heavy_lookup(Config) when is_list(Config) -> heavy_lookup_do(Opts) -> EtsMem = etsmem(), - Tab = ets_new(foobar_table, [{keypos, 2} | Opts]), - ok = fill_tab2(Tab, 0, 7000), - _ = [do_lookup(Tab, 6999) || _ <- lists:seq(1, 50)], + KeyRange = 7000, + Tab = ets_new(foobar_table, [{keypos, 2} | Opts], KeyRange), + ok = fill_tab2(Tab, 0, KeyRange), + _ = [do_lookup(Tab, KeyRange-1) || _ <- lists:seq(1, 50)], true = ets:delete(Tab), verify_etsmem(EtsMem). @@ -4704,11 +4714,12 @@ heavy_lookup_element(Config) when is_list(Config) -> heavy_lookup_element_do(Opts) -> EtsMem = etsmem(), - Tab = ets_new(foobar_table, [{keypos, 2} | Opts]), - ok = fill_tab2(Tab, 0, 7000), + KeyRange = 7000, + Tab = ets_new(foobar_table, [{keypos, 2} | Opts], KeyRange), + ok = fill_tab2(Tab, 0, KeyRange), %% lookup ALL elements 50 times Laps = 50 div syrup_factor(), - _ = [do_lookup_element(Tab, 6999, 1) || _ <- lists:seq(1, Laps)], + _ = [do_lookup_element(Tab, KeyRange-1, 1) || _ <- lists:seq(1, Laps)], true = ets:delete(Tab), verify_etsmem(EtsMem). @@ -4731,11 +4742,11 @@ heavy_concurrent(Config) when is_list(Config) -> repeat_for_opts_all_set_table_types(fun do_heavy_concurrent/1). do_heavy_concurrent(Opts) -> - Size = 10000, + KeyRange = 10000, Laps = 10000 div syrup_factor(), EtsMem = etsmem(), - Tab = ets_new(blupp, [public, {keypos, 2} | Opts]), - ok = fill_tab2(Tab, 0, Size), + Tab = ets_new(blupp, [public, {keypos, 2} | Opts], KeyRange), + ok = fill_tab2(Tab, 0, KeyRange), Procs = lists:map( fun (N) -> my_spawn_link( @@ -5014,6 +5025,7 @@ filltabint(Tab,0) -> filltabint(Tab,N) -> ets:insert(Tab,{N,integer_to_list(N)}), filltabint(Tab,N-1). + filltabint2(Tab,0) -> Tab; filltabint2(Tab,N) -> @@ -5230,8 +5242,9 @@ gen_dets_filename(Config,N) -> otp_6842_select_1000(Config) when is_list(Config) -> repeat_for_opts_all_ord_set_table_types( fun(Opts) -> - Tab = ets_new(xxx,Opts), - [ets:insert(Tab,{X,X}) || X <- lists:seq(1,10000)], + KeyRange = 10000, + Tab = ets_new(xxx, Opts, KeyRange), + [ets:insert(Tab,{X,X}) || X <- lists:seq(1,KeyRange)], AllTrue = lists:duplicate(10,true), AllTrue = [ length( @@ -5420,7 +5433,7 @@ grow_shrink(Config) when is_list(Config) -> fun(Opts) -> EtsMem = etsmem(), - Set = ets_new(a, Opts), + Set = ets_new(a, Opts, 5000), grow_shrink_0(0, 3071, 3000, 5000, Set), ets:delete(Set), @@ -5449,14 +5462,13 @@ grow_shrink_3(N, ShrinkTo, T) -> true = ets:delete(T, N), grow_shrink_3(N-1, ShrinkTo, T). -%% Grow a table that still contains pseudo-deleted objects. +%% Grow a hash table that still contains pseudo-deleted objects. grow_pseudo_deleted(Config) when is_list(Config) -> only_if_smp(fun() -> grow_pseudo_deleted_do() end). grow_pseudo_deleted_do() -> lists:foreach(fun(Type) -> grow_pseudo_deleted_do(Type) end, - [set,cat_ord_set,stim_cat_ord_set, - ordered_set,bag,duplicate_bag]). + [set,bag,duplicate_bag]). grow_pseudo_deleted_do(Type) -> process_flag(scheduler,1), @@ -5471,12 +5483,7 @@ grow_pseudo_deleted_do(Type) -> [true]}]), Left = Mult*(Mod-1), Left = ets:info(T,size), - case Type of - cat_ord_set -> ok; - stim_cat_ord_set -> ok; - ordered_set -> ok; - _ -> Mult = get_kept_objects(T) - end, + Mult = get_kept_objects(T), filltabstr(T,Mult), my_spawn_opt( fun() -> @@ -5508,14 +5515,13 @@ grow_pseudo_deleted_do(Type) -> ets:delete(T), process_flag(scheduler,0). -%% Shrink a table that still contains pseudo-deleted objects. +%% Shrink a hash table that still contains pseudo-deleted objects. shrink_pseudo_deleted(Config) when is_list(Config) -> only_if_smp(fun()->shrink_pseudo_deleted_do() end). shrink_pseudo_deleted_do() -> lists:foreach(fun(Type) -> shrink_pseudo_deleted_do(Type) end, - [set,cat_ord_set,stim_cat_ord_set, - ordered_set,bag,duplicate_bag]). + [set,bag,duplicate_bag]). shrink_pseudo_deleted_do(Type) -> process_flag(scheduler,1), @@ -5529,12 +5535,7 @@ shrink_pseudo_deleted_do(Type) -> [{'>', '$1', Half}], [true]}]), Half = ets:info(T,size), - case Type of - cat_ord_set -> ok; - stim_cat_ord_set -> ok; - ordered_set -> ok; - _ -> Half = get_kept_objects(T) - end, + Half = get_kept_objects(T), my_spawn_opt( fun()-> true = ets:info(T,fixed), Self ! start, @@ -5638,9 +5639,11 @@ smp_insert(Config) when is_list(Config) -> [[set,ordered_set,stim_cat_ord_set]]). smp_insert_do(Opts) -> - ets_new(smp_insert,[named_table,public,{write_concurrency,true}|Opts]), + KeyRange = 10000, + ets_new(smp_insert,[named_table,public,{write_concurrency,true}|Opts], + KeyRange), InitF = fun(_) -> ok end, - ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(10000)}) + ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(KeyRange)}) end, FiniF = fun(_) -> ok end, run_smp_workers(InitF,ExecF,FiniF,100000), @@ -5649,41 +5652,36 @@ smp_insert_do(Opts) -> %% Concurrent deletes on same fixated table. smp_fixed_delete(Config) when is_list(Config) -> - only_if_smp(fun()-> - repeat_for_opts(fun smp_fixed_delete_do/1, - [[set,ordered_set,stim_cat_ord_set]]) - end). - -smp_fixed_delete_do(Opts) -> - begin - T = ets_new(foo,[public,{write_concurrency,true}|Opts]), - %%Mem = ets:info(T,memory), - NumOfObjs = 100000, - filltabint(T,NumOfObjs), - ets:safe_fixtable(T,true), - Buckets = num_of_buckets(T), - InitF = fun([ProcN,NumOfProcs|_]) -> {ProcN,NumOfProcs} end, - ExecF = fun({Key,_}) when Key > NumOfObjs -> - [end_of_work]; - ({Key,Increment}) -> - true = ets:delete(T,Key), - {Key+Increment,Increment} - end, - FiniF = fun(_) -> ok end, - run_sched_workers(InitF,ExecF,FiniF,NumOfObjs), - 0 = ets:info(T,size), - true = ets:info(T,fixed), - Buckets = num_of_buckets(T), - case ets:info(T,type) of - set -> NumOfObjs = get_kept_objects(T); - _ -> ok - end, - ets:safe_fixtable(T,false), - %% Will fail as unfix does not shrink the table: - %%Mem = ets:info(T,memory), - %%verify_table_load(T), - ets:delete(T) - end. + only_if_smp(fun() -> smp_fixed_delete_do() end). + +smp_fixed_delete_do() -> + T = ets_new(foo,[public,{write_concurrency,true}]), + %%Mem = ets:info(T,memory), + NumOfObjs = 100000, + filltabint(T,NumOfObjs), + ets:safe_fixtable(T,true), + Buckets = num_of_buckets(T), + InitF = fun([ProcN,NumOfProcs|_]) -> {ProcN,NumOfProcs} end, + ExecF = fun({Key,_}) when Key > NumOfObjs -> + [end_of_work]; + ({Key,Increment}) -> + true = ets:delete(T,Key), + {Key+Increment,Increment} + end, + FiniF = fun(_) -> ok end, + run_sched_workers(InitF,ExecF,FiniF,NumOfObjs), + 0 = ets:info(T,size), + true = ets:info(T,fixed), + Buckets = num_of_buckets(T), + case ets:info(T,type) of + set -> NumOfObjs = get_kept_objects(T); + _ -> ok + end, + ets:safe_fixtable(T,false), + %% Will fail as unfix does not shrink the table: + %%Mem = ets:info(T,memory), + %%verify_table_load(T), + ets:delete(T). %% ERL-720 %% Provoke race between ets:delete and table unfix (by select_count) @@ -5928,8 +5926,10 @@ verify_table_load(T) -> otp_8732(Config) when is_list(Config) -> repeat_for_all_ord_set_table_types( fun(Opts) -> - Tab = ets_new(noname,Opts), - filltabstr(Tab,999), + KeyRange = 999, + KeyFun = fun(K) -> integer_to_list(K) end, + Tab = ets_new(noname,Opts, KeyRange, KeyFun), + filltabstr(Tab, KeyRange), ets:insert(Tab,{[],"nasty NIL object"}), [] = ets:match(Tab,{'_',nomatch}) %% Will hang if bug not fixed end), @@ -5939,11 +5939,14 @@ otp_8732(Config) when is_list(Config) -> %% Run concurrent select_delete (and inserts) on same table. smp_select_delete(Config) when is_list(Config) -> repeat_for_opts(fun smp_select_delete_do/1, - [[set,ordered_set,stim_cat_ord_set], read_concurrency, compressed]). + [[set,ordered_set,stim_cat_ord_set], + read_concurrency, compressed]). smp_select_delete_do(Opts) -> + KeyRange = 10000, begin % indentation - T = ets_new(smp_select_delete,[named_table,public,{write_concurrency,true}|Opts]), + T = ets_new(smp_select_delete,[named_table,public,{write_concurrency,true}|Opts], + KeyRange), Mod = 17, Zeros = erlang:make_tuple(Mod,0), InitF = fun(_) -> Zeros end, @@ -5960,7 +5963,7 @@ smp_select_delete_do(Opts) -> element(Eq+1,Diffs0) - Deleted), Diffs1; _ -> - Key = rand:uniform(10000), + Key = rand:uniform(KeyRange), Eq = Key rem Mod, case ets:insert_new(T,{Key,Key}) of true -> @@ -6004,12 +6007,13 @@ smp_select_replace(Config) when is_list(Config) -> [[set,ordered_set,stim_cat_ord_set,duplicate_bag]]). smp_select_replace_do(Opts) -> + KeyRange = 20, T = ets_new(smp_select_replace, - [public, {write_concurrency, true} | Opts]), - ObjCount = 20, + [public, {write_concurrency, true} | Opts], + KeyRange), InitF = fun (_) -> 0 end, ExecF = fun (Cnt0) -> - CounterId = rand:uniform(ObjCount), + CounterId = rand:uniform(KeyRange), Match = [{{'$1', '$2'}, [{'=:=', '$1', CounterId}], [{{'$1', {'+', '$2', 1}}}]}], @@ -6033,11 +6037,138 @@ smp_select_replace_do(Opts) -> FinalCounts = ets:select(T, [{{'_', '$1'}, [], ['$1']}]), Total = lists:sum(FinalCounts), Total = lists:sum(Results), - ObjCount = ets:select_delete(T, [{{'_', '_'}, [], [true]}]), + KeyRange = ets:select_delete(T, [{{'_', '_'}, [], [true]}]), 0 = ets:info(T, size), true = ets:delete(T), ok. +%% Iterate ordered_set with write_concurrency +%% and make sure we hit all "stable" long lived keys +%% while "volatile" objects are randomly inserted and deleted. +smp_ordered_iteration(Config) when is_list(Config) -> + repeat_for_opts(fun smp_ordered_iteration_do/1, + [[cat_ord_set,stim_cat_ord_set]]). + + +smp_ordered_iteration_do(Opts) -> + KeyRange = 1000, + OffHeap = erts_test_utils:mk_ext_pid({a@b,1}, 4711, 1), + KeyFun = fun(K, Type) -> + {K div 10, K rem 10, Type, OffHeap} + end, + StimKeyFun = fun(K) -> + KeyFun(K, element(rand:uniform(3), + {stable, other, volatile})) + end, + T = ets_new(smp_ordered_iteration, [public, {write_concurrency,true} | Opts], + KeyRange, StimKeyFun), + NStable = KeyRange div 4, + prefill_table(T, KeyRange, NStable, fun(K) -> {KeyFun(K, stable), 0} end), + NStable = ets:info(T, size), + NVolatile = KeyRange div 2, + prefill_table(T, KeyRange, NVolatile, fun(K) -> {KeyFun(K, volatile), 0} end), + + InitF = fun (_) -> #{insert => 0, delete => 0, + select_delete_bk => 0, select_delete_pbk => 0, + select_replace_bk => 0, select_replace_pbk => 0} + end, + ExecF = fun (Counters) -> + K = rand:uniform(KeyRange), + Key = KeyFun(K, volatile), + Acc = case rand:uniform(22) of + R when R =< 10 -> + ets:insert(T, {Key}), + incr_counter(insert, Counters); + R when R =< 15 -> + ets:delete(T, Key), + incr_counter(delete, Counters); + R when R =< 19 -> + %% Delete bound key + ets:select_delete(T, [{{Key, '_'}, [], [true]}]), + incr_counter(select_delete_bk, Counters); + R when R =< 20 -> + %% Delete partially bound key + ets:select_delete(T, [{{{K div 10, '_', volatile, '_'}, '_'}, [], [true]}]), + incr_counter(select_delete_pbk, Counters); + R when R =< 21 -> + %% Replace bound key + ets:select_replace(T, [{{Key, '$1'}, [], + [{{{const,Key}, {'+','$1',1}}}]}]), + incr_counter(select_replace_bk, Counters); + _ -> + %% Replace partially bound key + ets:select_replace(T, [{{{K div 10, '_', volatile, '_'}, '$1'}, [], + [{{{element,1,'$_'}, {'+','$1',1}}}]}]), + incr_counter(select_replace_pbk, Counters) + end, + receive stop -> + [end_of_work | Acc] + after 0 -> + Acc + end + end, + FiniF = fun (Acc) -> Acc end, + Pids = run_sched_workers(InitF, ExecF, FiniF, infinite), + timer:send_after(1000, stop), + + Log2ChunkMax = math:log2(NStable*2), + Rounds = fun Loop(N) -> + MS = [{{{'_', '_', stable, '_'}, '_'}, [], [true]}], + NStable = ets:select_count(T, MS), + NStable = count_stable(T, next, ets:first(T), 0), + NStable = count_stable(T, prev, ets:last(T), 0), + NStable = length(ets:select(T, MS)), + NStable = length(ets:select_reverse(T, MS)), + Chunk = round(math:pow(2, rand:uniform()*Log2ChunkMax)), + NStable = ets_select_chunks_count(T, MS, Chunk), + receive stop -> N + after 0 -> Loop(N+1) + end + end (1), + [P ! stop || P <- Pids], + Results = wait_pids(Pids), + io:format("Ops = ~p\n", [maps_sum(Results)]), + io:format("Diff = ~p\n", [ets:info(T,size) - NStable - NVolatile]), + io:format("Stats = ~p\n", [ets:info(T,stats)]), + io:format("Rounds = ~p\n", [Rounds]), + true = ets:delete(T), + + %% Verify no leakage of offheap key data + ok = erts_test_utils:check_node_dist(), + ok. + +incr_counter(Name, Counters) -> + Counters#{Name => maps:get(Name, Counters, 0) + 1}. + +count_stable(T, Next, {_, _, stable, _}=Key, N) -> + count_stable(T, Next, ets:Next(T, Key), N+1); +count_stable(T, Next, {_, _, volatile, _}=Key, N) -> + count_stable(T, Next, ets:Next(T, Key), N); +count_stable(_, _, '$end_of_table', N) -> + N. + +ets_select_chunks_count(T, MS, Chunk) -> + ets_select_chunks_count(ets:select(T, MS, Chunk), 0). + +ets_select_chunks_count('$end_of_table', N) -> + N; +ets_select_chunks_count({List, Continuation}, N) -> + ets_select_chunks_count(ets:select(Continuation), + length(List) + N). + +maps_sum([Ma | Tail]) when is_map(Ma) -> + maps_sum([lists:sort(maps:to_list(Ma)) | Tail]); +maps_sum([La, Mb | Tail]) -> + Lab = lists:zipwith(fun({K,Va}, {K,Vb}) -> {K,Va+Vb} end, + La, + lists:sort(maps:to_list(Mb))), + maps_sum([Lab | Tail]); +maps_sum([L]) -> + L. + + + + %% Test different types. types(Config) when is_list(Config) -> init_externals(), @@ -6307,19 +6438,18 @@ do_work(WorksDoneSoFar, Table, ProbHelpTab, Range, Operations) -> do_work(WorksDoneSoFar + 1, Table, ProbHelpTab, Range, Operations) end. -prefill_table(T, KeyRange, Num) -> +prefill_table(T, KeyRange, Num, ObjFun) -> Seed = rand:uniform(KeyRange), %%io:format("prefill_table: Seed = ~p\n", [Seed]), RState = unique_rand_start(KeyRange, Seed), - prefill_table_loop(T, RState, Num), - Num = ets:info(T, size). + prefill_table_loop(T, RState, Num, ObjFun). -prefill_table_loop(_, _, 0) -> +prefill_table_loop(_, _, 0, _) -> ok; -prefill_table_loop(T, RS0, N) -> +prefill_table_loop(T, RS0, N, ObjFun) -> {Key, RS1} = unique_rand_next(RS0), - ets:insert(T, {Key}), - prefill_table_loop(T, RS1, N-1). + ets:insert(T, ObjFun(Key)), + prefill_table_loop(T, RS1, N-1, ObjFun). throughput_benchmark() -> throughput_benchmark(false, not_set, not_set). @@ -6445,7 +6575,9 @@ throughput_benchmark(TestMode, BenchmarkRunMs, RecoverTimeMs) -> Range, Duration, RecoverTime) -> ProbHelpTab = CalculateOpsProbHelpTab(Scenario, 0), Table = ets:new(t, TableConfig), - prefill_table(Table, Range, Range div 2), + Nobj = Range div 2, + prefill_table(Table, Range, Nobj, fun(K) -> {K} end), + Nobj = ets:info(Table, size), SafeFixTableIfRequired(Table, Scenario, true), ParentPid = self(), ChildPids = @@ -7324,20 +7456,37 @@ is_redundant_opts_combo(Opts) -> lists:member(private, Opts) orelse lists:member(protected, Opts)). -ets_new(Name, Opts) -> - ReplaceStimOrdSetHelper = - fun (MOpts) -> - lists:map(fun (I) -> - case I of - stim_cat_ord_set -> ordered_set; - cat_ord_set -> ordered_set; - _ -> I - end - end, MOpts) - end, +%% Add fake table option with info about key range. +%% Will be consumed by ets_new and used for stim_cat_ord_set. +key_range(Opts, KeyRange) -> + [{key_range, KeyRange} | Opts]. + +ets_new(Name, Opts0) -> + {KeyRange, Opts1} = case lists:keytake(key_range, 1, Opts0) of + {value, {key_range, KR}, Rest1} -> + {KR, Rest1}; + false -> + {1000*1000, Opts0} + end, + ets_new(Name, Opts1, KeyRange). + +ets_new(Name, Opts, KeyRange) -> + ets_new(Name, Opts, KeyRange, fun id/1). + +ets_new(Name, Opts0, KeyRange, KeyFun) -> + {CATree, Stimulate, RevOpts} = + lists:foldl(fun(cat_ord_set, {false, false, Lacc}) -> + {true, false, [ordered_set | Lacc]}; + (stim_cat_ord_set, {false, false, Lacc}) -> + {true, true, [ordered_set | Lacc]}; + (Other, {CAT, STIM, Lacc}) -> + {CAT, STIM, [Other | Lacc]} + end, + {false, false, []}, + Opts0), + Opts = lists:reverse(RevOpts), EtsNewHelper = - fun (MOpts) -> - UseOpts = ReplaceStimOrdSetHelper(MOpts), + fun (UseOpts) -> case get(ets_new_opts) of UseOpts -> silence; %% suppress identical table opts spam @@ -7347,8 +7496,7 @@ ets_new(Name, Opts) -> end, ets:new(Name, UseOpts) end, - case (lists:member(stim_cat_ord_set, Opts) or - lists:member(cat_ord_set, Opts)) andalso + case CATree andalso (not lists:member({write_concurrency, false}, Opts)) andalso (not lists:member(private, Opts)) andalso (not lists:member(protected, Opts)) of @@ -7364,62 +7512,54 @@ ets_new(Name, Opts) -> false -> [public|NewOpts1] end, T = EtsNewHelper(NewOpts2), - case lists:member(stim_cat_ord_set, Opts) of - true -> stimulate_contention(T); - false -> ok + case Stimulate of + false -> ok; + true -> stimulate_contention(T, KeyRange, KeyFun) end, T; false -> EtsNewHelper(Opts) end. -% This function do the following to the input ETS table: -% 1. Perform a number of concurrent insert operations -% 2. Remove all inserted items -% % The purpose of this function is to stimulate fine grained locking in % tables of types ordered_set with the write_concurrency options -% turned on. Such tables are implemented as CA trees* and thus -% activates fine grained locking only when lock contention is -% detected. -% -% A Contention Adapting Approach to Concurrent Ordered Sets -% Journal of Parallel and Distributed Computing, 2018 -% Kjell Winblad and Konstantinos Sagonas -% https://doi.org/10.1016/j.jpdc.2017.11.007 -stimulate_contention(T) -> - NrOfSchedulers = erlang:system_info(schedulers), - ParentPid = self(), - KeyRange = 100000, - ChildPids = - lists:map(fun(_N) -> - spawn(fun() -> - receive start -> ok end, - stimulate_contention_do_inserts(T, KeyRange, 0), - ParentPid ! done - end) - end, lists:seq(1, NrOfSchedulers)), - lists:foreach(fun(Pid) -> Pid ! start end, ChildPids), - timer:sleep(100), - lists:foreach(fun(Pid) -> Pid ! stop end, ChildPids), - lists:foreach(fun(_P) -> receive done -> ok end end, ChildPids), - lists:foreach(fun(N) -> ets:delete(T, N) end, lists:seq(0, KeyRange)). - - - -stimulate_contention_do_inserts(T, KeyRange, 0) -> - OpsBetweenStopCheck = 10000, - receive - stop -> ok - after - 0 -> stimulate_contention_do_inserts(T, KeyRange, OpsBetweenStopCheck) - end; -stimulate_contention_do_inserts(T, KeyRange, OpsToNextStopCheck) -> - R = trunc(KeyRange * rand:uniform()), - ets:insert(T,{R,R,R}), - stimulate_contention_do_inserts(T, KeyRange, OpsToNextStopCheck - 1). - +% turned on. The erts_debug feature 'ets_force_split' is used to easier +% generate a routing tree with fine grained locking without having to +% provoke lots of actual lock contentions. +stimulate_contention(Tid, KeyRange, KeyFun) -> + T = case Tid of + A when is_atom(A) -> ets:whereis(A); + _ -> Tid + end, + erts_debug:set_internal_state(ets_force_split, {T, true}), + Num = case KeyRange > 50 of + true -> 50; + false -> KeyRange + end, + Seed = rand:uniform(KeyRange), + %%io:format("prefill_table: Seed = ~p\n", [Seed]), + RState = unique_rand_start(KeyRange, Seed), + stim_inserter_loop(T, RState, Num, KeyFun), + Num = ets:info(T, size), + ets:match_delete(T, {'$1','$1','$1'}), + 0 = ets:info(T, size), + erts_debug:set_internal_state(ets_force_split, {T, false}), + case ets:info(T,stats) of + {0, _, _} -> + io:format("No routing nodes in table?\n" + "Debug feature 'ets_force_split' does not seem to work.\n", []), + ct:fail("No ets_force_split?"); + Stats -> + io:format("stimulated ordered_set: ~p\n", [Stats]) + end. +stim_inserter_loop(_, _, 0, _) -> + ok; +stim_inserter_loop(T, RS0, N, KeyFun) -> + {K, RS1} = unique_rand_next(RS0), + Key = KeyFun(K), + ets:insert(T, {Key, Key, Key}), + stim_inserter_loop(T, RS1, N-1, KeyFun). do_tc(Do, Report) -> T1 = erlang:monotonic_time(), @@ -7478,4 +7618,5 @@ dquad(Prime, X, Seed) -> %% Primes where P rem 4 == 3. primes_3mod4() -> [103, 211, 503, 1019, 2003, 5003, 10007, 20011, 50023, - 100003, 200003, 500083, 1000003, 2000003]. + 100003, 200003, 500083, 1000003, 2000003, 5000011, + 10000019, 20000003, 50000047, 100000007]. diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl index af94fc79bc..5dab6f6697 100644 --- a/lib/stdlib/test/lists_SUITE.erl +++ b/lib/stdlib/test/lists_SUITE.erl @@ -158,6 +158,20 @@ append_2(Config) when is_list(Config) -> "abcdef"=lists:append("abc", "def"), [hej, du]=lists:append([hej], [du]), [10, [elem]]=lists:append([10], [[elem]]), + + %% Trapping, both crashing and otherwise. + [append_trapping_1(N) || N <- lists:seq(0, 20)], + + ok. + +append_trapping_1(N) -> + List = lists:duplicate(N + (1 bsl N), gurka), + ImproperList = List ++ crash, + + {'EXIT',_} = (catch (ImproperList ++ [])), + + [3, 2, 1 | List] = lists:reverse(List ++ [1, 2, 3]), + ok. %% Tests the lists:reverse() implementation. The function is @@ -2597,6 +2611,20 @@ subtract(Config) when is_list(Config) -> {'EXIT',_} = (catch sub([a|b], [])), {'EXIT',_} = (catch sub([a|b], [a])), + %% Trapping, both crashing and otherwise. + [sub_trapping(N) || N <- lists:seq(0, 18)], + + %% The current implementation chooses which algorithm to use based on + %% certain thresholds, and we need proper coverage for all corner cases. + [sub_thresholds(N) || N <- lists:seq(0, 32)], + + %% Trapping, both crashing and otherwise. + [sub_trapping(N) || N <- lists:seq(0, 18)], + + %% The current implementation chooses which algorithm to use based on + %% certain thresholds, and we need proper coverage for all corner cases. + [sub_thresholds(N) || N <- lists:seq(0, 32)], + ok. sub_non_matching(A, B) -> @@ -2606,6 +2634,41 @@ sub(A, B) -> Res = A -- B, Res = lists:subtract(A, B). +sub_trapping(N) -> + List = lists:duplicate(N + (1 bsl N), gurka), + ImproperList = List ++ crash, + + {'EXIT',_} = (catch sub_trapping_1(ImproperList, [])), + {'EXIT',_} = (catch sub_trapping_1(List, ImproperList)), + + List = List -- lists:duplicate(N + (1 bsl N), gaffel), + ok = sub_trapping_1(List, []). + +sub_trapping_1([], _) -> ok; +sub_trapping_1(L, R) -> sub_trapping_1(L -- R, [gurka | R]). + +sub_thresholds(N) -> + %% This needs to be long enough to cause trapping. + OtherLen = 1 bsl 18, + Other = lists:seq(0, OtherLen - 1), + + Disjoint = lists:seq(-N, -1), + Subset = lists:seq(1, N), + + %% LHS is disjoint from RHS, so all elements must be retained. + Disjoint = Disjoint -- Other, + + %% LHS is covered by RHS, so all elements must be removed. + [] = Subset -- Other, + + %% RHS is disjoint from LHS, so all elements must be retained. + Other = Other -- Disjoint, + + %% RHS is covered by LHS, so N elements must be removed. + N = OtherLen - length(Other -- Subset), + + ok. + %% Test lists:droplast/1 droplast(Config) when is_list(Config) -> [] = lists:droplast([x]), |