diff options
Diffstat (limited to 'lib')
62 files changed, 1850 insertions, 1071 deletions
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 32703b4dd1..9c6f835ab0 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -201,7 +201,6 @@ move_allocates_2(Alloc, [], Acc) -> alloc_may_pass({set,_,_,{alloc,_,_}}) -> false; alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false; alloc_may_pass({set,_,_,put_list}) -> false; -alloc_may_pass({set,_,_,{put_tuple,_}}) -> false; alloc_may_pass({set,_,_,put}) -> false; alloc_may_pass({set,_,_,_}) -> true. diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index dcc6ad4c7c..d9ea6f5a70 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose: Optimizes booleans in guards. @@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). live_regs(Regs) -> - foldl(fun ({I,_}, _) -> I; - ([], Max) -> Max end, - -1, Regs)+1. - + foldl(fun ({I,_}, _) -> + I + end, -1, Regs)+1. + %%% %%% Convert a block to Static Single Assignment (SSA) form. @@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) -> initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) -> InitRegs = free_vars_regs(Arity), add_init_regs(InitRegs, Regs); -initialized_regs([_|_], Regs) -> Regs; -initialized_regs([], Regs) -> Regs. +initialized_regs([_|_], Regs) -> Regs. add_init_regs([{x,_}=X|T], Regs) -> add_init_regs(T, ordsets:add_element(X, Regs)); diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 920ce07396..017ca129b0 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -621,8 +621,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) -> %% %% New make_fun2/4 instruction added in August 2001 (R8). -%% New put_literal/2 instruction added in Feb 2006 R11B-4. -%% We handle them specially here to avoid adding an argument to +%% We handle it specially here to avoid adding an argument to %% the clause for every instruction. %% @@ -631,8 +630,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) -> {OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} = lists:keyfind(OldIndex, 1, Lambdas), {make_fun2,{M,F,A},OldIndex,OldUniq,NumFree}; -resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) -> - {put_literal,{literal,gb_trees:get(Index, Literals)},Dst}; resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) -> %% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]), resolve_inst(Instr, Imports, Str, Lbls). @@ -1015,9 +1012,6 @@ resolve_inst({gc_bif3,Args},Imports,_,_) -> %% %% New instructions for creating non-byte aligned binaries. %% -resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) -> - [A2,A3] = resolve_args(Args), - {bs_bits_to_bytes2,A2,A3}; resolve_inst({bs_final2,[X,Y]},_,_,_) -> {bs_final2,X,Y}; diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3729ccb0da..f83f73b224 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -76,9 +76,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A end, Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> case tdb_find(TupleReg, Ts0) of {tuple,_,[Contents]} -> @@ -118,7 +115,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0 Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]) end; - simplify_basic_1([I|Is], Ts0, Acc) -> Ts = update(I, Ts0), simplify_basic_1(Is, Ts, [I|Acc]); diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index ac249e6672..761d4ffec0 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2007-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% %% Purpose : Common utilities used by several optimization passes. @@ -424,12 +424,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) -> false when R =:= D -> {killed,St}; false -> check_liveness(R, Is, St) end; -check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) -> - case R of - Src -> {used,St}; - Dst -> {killed,St}; - _ -> check_liveness(R, Is, St) - end; check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) -> case member(R, [Sz,Src]) of true -> {used,St}; diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 34065cfdce..dc5a1068db 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -757,9 +757,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, Vst); valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> assert_term(Src, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 3f250a6d5a..08de3059c9 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -294,15 +294,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) -> end; fold_comp([], _Run, St) -> {ok,St}. -os_process_size() -> - case os:type() of - {unix, sunos} -> - Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"), - list_to_integer(lib:nonl(Size)); - _ -> - 0 - end. - run_tc({Name,Fun}, St) -> Before0 = statistics(runtime), Val = (catch Fun(St)), @@ -311,9 +302,8 @@ run_tc({Name,Fun}, St) -> {After_c, _} = After0, Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize), Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])), - Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])), - io:format(" ~-30s: ~10.2f s ~12s ~10s\n", - [Name,(After_c-Before_c) / 1000,Mem,Sz]), + io:format(" ~-30s: ~10.2f s ~12s\n", + [Name,(After_c-Before_c) / 1000,Mem]), Val. comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) -> diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index d7e344b019..63527bda8f 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0 # New instructions in R10B. 109: bs_init2/6 -110: bs_bits_to_bytes/3 +110: -bs_bits_to_bytes/3 111: bs_add/5 112: apply/1 113: apply_last/2 diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index b2f0ac75c7..16c5b6b415 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -130,7 +130,6 @@ in_guard=false :: boolean(), %In guard or not. wanted=true :: boolean(), %Result wanted or not. opts :: [compile:option()], %Options. - es=[] :: [error()], %Errors. ws=[] :: [warning()], %Warnings. file=[{file,""}]}). %File @@ -145,42 +144,37 @@ module({Mod,Exp,Forms}, Opts) -> Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp), - {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) -> - form(F, Acc, Opts) - end, {[],[],[],[],[]}, Forms), + {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) -> + form(F, Acc, Opts) + end, {[],[],[],[]}, Forms), Kfs = reverse(Kfs0), As = reverse(As0), - case Es of - [] -> - {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}; - _ -> - {error,Es,Ws} - end. + {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}. -form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) -> - {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts), - {[F|Fs],As,Es,Ws,File}; -form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) -> - {Fs,As,Es,Ws,File}; -form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) -> - {Fs,[attribute(F)|As],Es,Ws,File}. +form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) -> + {F,Ws} = function(F0, Ws0, File, Opts), + {[F|Fs],As,Ws,File}; +form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) -> + {Fs,As,Ws,File}; +form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) -> + {Fs,[attribute(F)|As],Ws,File}. attribute({attribute,Line,Name,Val}) -> {#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}. -function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) -> +function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) -> %%ok = io:fwrite("~p - ", [{Name,Arity}]), - St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]}, + St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]}, {B0,St1} = body(Cs0, Name, Arity, St0), %%ok = io:fwrite("1", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B0]), {B1,St2} = ubody(B0, St1), %%ok = io:fwrite("2", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B1]), - {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2), + {B2,#core{ws=Ws}} = cbody(B1, St2), %%ok = io:fwrite("3~n", []), %%ok = io:fwrite("~w:~p~n", [?LINE,B2]), - {{#c_var{name={Name,Arity}},B2},Es,Ws}. + {{#c_var{name={Name,Arity}},B2},Ws}. body(Cs0, Name, Arity, St0) -> Anno = lineno_anno(element(2, hd(Cs0)), St0), @@ -2096,20 +2090,12 @@ is_simple(#c_literal{}) -> true; is_simple(#c_cons{hd=H,tl=T}) -> is_simple(H) andalso is_simple(T); is_simple(#c_tuple{es=Es}) -> is_simple_list(Es); -is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es); is_simple(_) -> false. -spec is_simple_list([cerl:cerl()]) -> boolean(). is_simple_list(Es) -> lists:all(fun is_simple/1, Es). --spec is_simp_bin([cerl:cerl()]) -> boolean(). - -is_simp_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_simple(E) andalso is_simple(S) - end, Es). - %%% %%% Handling of warnings. %%% diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index 9fda37530b..a7a4d4dc91 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -361,8 +361,6 @@ match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A); match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) -> match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A); -match_fail(#k_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) -> - match_fail(#k_atom{anno=Anno,val=Atom}, I, A); match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A}; match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index a460d54239..84cfd16e60 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(andor_SUITE). @@ -141,6 +141,10 @@ t_and_or(Config) when is_list(Config) -> ok. +-define(GUARD(E), if E -> true; + true -> false + end). + t_andalso(Config) when is_list(Config) -> Bs = [true,false], Ps = [{X,Y} || X <- Bs, Y <- Bs], @@ -151,6 +155,11 @@ t_andalso(Config) when is_list(Config) -> ?line false = false andalso true, ?line false = false andalso false, + ?line true = ?GUARD(true andalso true), + ?line false = ?GUARD(true andalso false), + ?line false = ?GUARD(false andalso true), + ?line false = ?GUARD(false andalso false), + ?line false = false andalso glurf, ?line false = false andalso exit(exit_now), @@ -176,6 +185,11 @@ t_orelse(Config) when is_list(Config) -> ?line true = false orelse true, ?line false = false orelse false, + ?line true = ?GUARD(true orelse true), + ?line true = ?GUARD(true orelse false), + ?line true = ?GUARD(false orelse true), + ?line false = ?GUARD(false orelse false), + ?line true = true orelse glurf, ?line true = true orelse exit(exit_now), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 75b6f801e7..caaa587006 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -30,7 +30,8 @@ multiple_uses/1,zero_label/1,followed_by_catch/1, matching_meets_construction/1,simon/1,matching_and_andalso/1, otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, - match_string/1,zero_width/1,bad_size/1,haystack/1]). + match_string/1,zero_width/1,bad_size/1,haystack/1, + cover_beam_bool/1]). -export([coverage_id/1]). @@ -45,7 +46,7 @@ all(suite) -> wfbm,degenerated_match,bs_sum,coverage,multiple_uses,zero_label, followed_by_catch,matching_meets_construction,simon,matching_and_andalso, otp_7188,otp_7233,otp_7240,otp_7498,match_string,zero_width,bad_size, - haystack]. + haystack,cover_beam_bool]. init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> Dog = test_server:timetrap(?t:minutes(1)), @@ -985,6 +986,25 @@ fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}}) when ?MODULE =:= bs_match_inline_SUITE -> Args = tuple_to_list(ActualArgs). +%% Cover the clause handling bs_context to binary in +%% beam_block:initialized_regs/2. +cover_beam_bool(Config) when is_list(Config) -> + ?line ok = do_cover_beam_bool(<<>>, 3), + ?line <<19>> = do_cover_beam_bool(<<19>>, 2), + ?line <<42>> = do_cover_beam_bool(<<42>>, 1), + ?line <<17>> = do_cover_beam_bool(<<13,17>>, 0), + ok. + +do_cover_beam_bool(Bin, X) when X > 0 -> + if + X =:= 1; X =:= 2 -> + Bin; + true -> + ok + end; +do_cover_beam_bool(<<_,Bin/binary>>, X) -> + do_cover_beam_bool(Bin, X+1). + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 5ec2408a35..69d284ea6c 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,3 +1,3 @@ %% -*- erlang -*- -{exclude,[sys_pre_attributes,core_parse]}. +{exclude,[sys_pre_attributes,core_scan,core_parse]}. diff --git a/lib/compiler/test/core_SUITE_data/.gitignore b/lib/compiler/test/core_SUITE_data/.gitignore new file mode 100644 index 0000000000..d11d93d37f --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/.gitignore @@ -0,0 +1 @@ +!*.core diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 07779ddd5a..b48b1daa32 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -82,6 +82,14 @@ bad_negate(X, Y) when is_float(X) -> Y1 = -Y, %BIF call. {X2, Y1}. +%% Some math functions are not implemented on all platforms. +-define(OPTIONAL(Expected, Expr), + try + Expected = Expr + catch + error:undef -> ok + end). + math_functions(Config) when is_list(Config) -> %% Mostly silly coverage. ?line 0.0 = math:tan(0), @@ -93,6 +101,14 @@ math_functions(Config) when is_list(Config) -> ?line -1.0 = math:cos(math:pi()), ?line 1.0 = math:exp(0), ?line 1.0 = math:pow(math:pi(), 0), + ?line 0.0 = math:log(1), + ?line 0.0 = math:asin(0), + ?line 0.0 = math:acos(1), + ?line ?OPTIONAL(0.0, math:asinh(0)), + ?line ?OPTIONAL(0.0, math:acosh(1)), + ?line ?OPTIONAL(0.0, math:atanh(0)), + ?line ?OPTIONAL(0.0, math:erf(0)), + ?line ?OPTIONAL(1.0, math:erfc(0)), ?line 0.0 = math:tan(id(0)), ?line 0.0 = math:atan2(id(0), 1), @@ -101,6 +117,14 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:tanh(id(0)), ?line 1.0 = math:log10(id(10)), ?line 1.0 = math:exp(id(0)), + ?line 0.0 = math:log(id(1)), + ?line 0.0 = math:asin(id(0)), + ?line 0.0 = math:acos(id(1)), + ?line ?OPTIONAL(0.0, math:asinh(id(0))), + ?line ?OPTIONAL(0.0, math:acosh(id(1))), + ?line ?OPTIONAL(0.0, math:atanh(id(0))), + ?line ?OPTIONAL(0.0, math:erf(id(0))), + ?line ?OPTIONAL(1.0, math:erfc(id(0))), %% Only for coverage (of beam_type.erl). ?line {'EXIT',{undef,_}} = (catch math:fnurfla(0)), diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 9c4687efa1..fd51b777ac 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -112,6 +112,12 @@ aliases(Config) when is_list(Config) -> ?line {42,42,42,42} = multiple_aliases_1(42), ?line {7,7,7} = multiple_aliases_2(7), ?line {{a,b},{a,b},{a,b}} = multiple_aliases_3({a,b}), + + %% Lists/literals. + ?line {a,b} = list_alias1([a,b]), + ?line {a,b} = list_alias2([a,b]), + ?line {a,b} = list_alias3([a,b]), + ok. str_alias(V) -> @@ -206,6 +212,15 @@ multiple_aliases_2((A=B)=(A=C)) -> multiple_aliases_3((A={_,_}=B)={_,_}=C) -> {A,B,C}. +list_alias1([a,b]=[X,Y]) -> + {X,Y}. + +list_alias2([X,Y]=[a,b]) -> + {X,Y}. + +list_alias3([X,b]=[a,Y]) -> + {X,Y}. + %% OTP-7018. match_in_call(Config) when is_list(Config) -> diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 793c53ac31..126a679724 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -104,7 +104,17 @@ silly_coverage(Config) when is_list(Config) -> ?line expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end), ?line expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), - %% v3_codgen + %% v3_life + BadKernel = {k_mdef,[],?MODULE, + [{foo,0}], + [], + [{k_fdef, + {k,[],[],[]}, + f,0,[], + seriously_bad_body}]}, + ?line expect_error(fun() -> v3_life:module(BadKernel, []) end), + + %% v3_codegen CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index b9679fbb12..1f8be4040e 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -895,11 +895,6 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| end, trans_bin_call({hipe_bs_primop,Name}, Lbl, Args, [Dst, Base, Offset], Base, Offset, Env, Instructions); -trans_fun([{bs_bits_to_bytes2, Bits, Bytes}|Instructions], Env) -> - Src = trans_arg(Bits), - Dst = mk_var(Bytes), - [hipe_icode:mk_primop([Dst], 'bsl', [Src, hipe_icode:mk_const(3)])| - trans_fun(Instructions,Env)]; trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), @@ -1129,13 +1124,6 @@ trans_fun([{gc_bif,Name,Fail,_Live,SrcRs,DstR}|Instructions], Env) -> trans_fun([{bif,Name,Fail,SrcRs,DstR}|Instructions], Env) end; %%-------------------------------------------------------------------- -%% Instruction for constant pool added in February 2007 for R11B-4. -%%-------------------------------------------------------------------- -trans_fun([{put_literal,{literal,Literal},DstR}|Instructions], Env) -> - DstV = mk_var(DstR), - Move = hipe_icode:mk_move(DstV, hipe_icode:mk_const(Literal)), - [Move | trans_fun(Instructions, Env)]; -%%-------------------------------------------------------------------- %% New test instruction added in July 2007 for R12. %%-------------------------------------------------------------------- %%--- is_bitstr --- diff --git a/lib/ic/doc/src/Makefile b/lib/ic/doc/src/Makefile index 26d0932a95..8eda436a24 100644 --- a/lib/ic/doc/src/Makefile +++ b/lib/ic/doc/src/Makefile @@ -1,19 +1,19 @@ # # %CopyrightBegin% -# -# Copyright Ericsson AB 1998-2009. All Rights Reserved. -# +# +# Copyright Ericsson AB 1998-2010. All Rights Reserved. +# # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in # compliance with the License. You should have received a copy of the # Erlang Public License along with this software. If not, it can be # retrieved online at http://www.erlang.org/. -# +# # Software distributed under the License is distributed on an "AS IS" # basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See # the License for the specific language governing rights and limitations # under the License. -# +# # %CopyrightEnd% # # @@ -211,7 +211,11 @@ $(HTMLDIR)/%.gif: %.gif ifdef DOCSUPPORT +ifneq (,$(JAVA)) docs: pdf html man $(JAVADOC_GENERATED_FILES) +else +docs: pdf html man +endif $(TOP_PDF_FILE): $(XML_FILES) @@ -301,6 +305,7 @@ release_docs_spec: docs $(INSTALL_DATA) $(GIF_FILES) $(EXTRA_FILES) $(HTML_FILES) \ $(RELSYSDIR)/doc/html $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) +ifneq (,$(JAVA)) $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DIR) $(RELSYSDIR)/doc/html/java/com @@ -313,6 +318,7 @@ release_docs_spec: docs $(RELSYSDIR)/doc/html/java/resources $(INSTALL_DATA) $(JAVADOC_PACK_HTML_FILES) \ $(RELSYSDIR)/doc/html/java/com/ericsson/otp/ic +endif $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 $(INSTALL_DATA) $(MAN3_FILES) $(RELEASE_PATH)/man/man3 diff --git a/lib/ic/doc/src/notes.xml b/lib/ic/doc/src/notes.xml index dbafde7b4b..6684547572 100644 --- a/lib/ic/doc/src/notes.xml +++ b/lib/ic/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1998</year><year>2009</year> + <year>1998</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>IDL Compiler Release Notes</title> @@ -31,6 +31,22 @@ </header> <section> + <title>IC 4.2.25</title> + + <section> + <title>Improvements and New Features</title> + <list type="bulleted"> + <item> + <p> + The documentation can now be built and installed without Java.</p> + <p> + Own Id: OTP-8639 Aux Id:</p> + </item> + </list> + </section> + </section> + + <section> <title>IC 4.2.24</title> <section> diff --git a/lib/ic/vsn.mk b/lib/ic/vsn.mk index e0fccf4889..4aa2a04b60 100644 --- a/lib/ic/vsn.mk +++ b/lib/ic/vsn.mk @@ -1,6 +1,8 @@ -IC_VSN = 4.2.24 +IC_VSN = 4.2.25 -TICKETS = OTP-8307 \ +TICKETS = OTP-8639 + +TICKETS_4.2.24 = OTP-8307 \ OTP-8353 \ OTP-8354 \ OTP-8355 diff --git a/lib/kernel/doc/src/file.xml b/lib/kernel/doc/src/file.xml index 50f9722a1c..382262d1ee 100644 --- a/lib/kernel/doc/src/file.xml +++ b/lib/kernel/doc/src/file.xml @@ -62,6 +62,25 @@ time() = {{Year, Month, Day}, {Hour, Minute, Second}} </section> <funcs> <func> + <name>advise(IoDevice, Offset, Length, Advise) -> ok | {error, Reason}</name> + <fsummary>Predeclare an access pattern for file data</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Offset = int()</v> + <v>Length = int()</v> + <v>Advise = posix_file_advise()</v> + <v>posix_file_advise() = normal | sequential | random | no_reuse + | will_need | dont_need</v> + <v>Reason = ext_posix()</v> + </type> + <desc> + <p><c>advise/4</c> can be used to announce an intention to access file + data in a specific pattern in the future, thus allowing the + operating system to perform appropriate optimizations.</p> + <p>On some platforms, this function might have no effect.</p> + </desc> + </func> + <func> <name>change_group(Filename, Gid) -> ok | {error, Reason}</name> <fsummary>Change group of a file</fsummary> <type> @@ -1641,6 +1660,33 @@ f.txt: {person, "kalle", 25}. </desc> </func> <func> + <name>datasync(IoDevice) -> ok | {error, Reason}</name> + <fsummary>Synchronizes the in-memory data of a file, ignoring most of its metadata, with that on the physical medium</fsummary> + <type> + <v>IoDevice = io_device()</v> + <v>Reason = ext_posix() | terminated</v> + </type> + <desc> + <p>Makes sure that any buffers kept by the operating system + (not by the Erlang runtime system) are written to disk. In + many ways it's resembles fsync but it not requires to update + some of file's metadata such as the access time. On + some platforms, this function might have no effect.</p> + <p>Applications that access databases or log files often write + a tiny data fragment (e.g., one line in a log file) and then + call fsync() immediately in order to ensure that the written + data is physically stored on the harddisk. Unfortunately, fsync() + will always initiate two write operations: one for the newly + written data and another one in order to update the modification + time stored in the inode. If the modification time is not a part + of the transaction concept fdatasync() can be used to avoid + unnecessary inode disk write operations.</p> + <p>Available only in some POSIX systems. This call results in a + call to fsync(), or has no effect, in systems not implementing + the fdatasync syscall.</p> + </desc> + </func> + <func> <name>truncate(IoDevice) -> ok | {error, Reason}</name> <fsummary>Truncate a file</fsummary> <type> diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 46ffa9d708..a694ed0708 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -36,11 +36,11 @@ %% Specialized -export([ipread_s32bu_p32bu/3]). %% Generic file contents. --export([open/2, close/1, +-export([open/2, close/1, advise/4, read/2, write/2, pread/2, pread/3, pwrite/2, pwrite/3, read_line/1, - position/2, truncate/1, sync/1, + position/2, truncate/1, datasync/1, sync/1, copy/2, copy/3]). %% High level operations -export([consult/1, path_consult/2]). @@ -89,6 +89,8 @@ -type date() :: {pos_integer(), pos_integer(), pos_integer()}. -type time() :: {non_neg_integer(), non_neg_integer(), non_neg_integer()}. -type date_time() :: {date(), time()}. +-type posix_file_advise() :: 'normal' | 'sequential' | 'random' | 'no_reuse' | + 'will_need' | 'dont_need'. %%%----------------------------------------------------------------- %%% General functions @@ -352,6 +354,18 @@ close(#file_descriptor{module = Module} = Handle) -> close(_) -> {error, badarg}. +-spec advise(File :: io_device(), Offset :: integer(), + Length :: integer(), Advise :: posix_file_advise()) -> + 'ok' | {'error', posix()}. + +advise(File, Offset, Length, Advise) when is_pid(File) -> + R = file_request(File, {advise, Offset, Length, Advise}), + wait_file_reply(File, R); +advise(#file_descriptor{module = Module} = Handle, Offset, Length, Advise) -> + Module:advise(Handle, Offset, Length, Advise); +advise(_, _, _, _) -> + {error, badarg}. + -spec read(File :: io_device(), Size :: non_neg_integer()) -> 'eof' | {'ok', [char()] | binary()} | {'error', posix()}. @@ -472,6 +486,16 @@ pwrite(#file_descriptor{module = Module} = Handle, Offs, Bytes) -> pwrite(_, _, _) -> {error, badarg}. +-spec datasync(File :: io_device()) -> 'ok' | {'error', posix()}. + +datasync(File) when is_pid(File) -> + R = file_request(File, datasync), + wait_file_reply(File, R); +datasync(#file_descriptor{module = Module} = Handle) -> + Module:datasync(Handle); +datasync(_) -> + {error, badarg}. + -spec sync(File :: io_device()) -> 'ok' | {'error', posix()}. sync(File) when is_pid(File) -> diff --git a/lib/kernel/src/file_io_server.erl b/lib/kernel/src/file_io_server.erl index 3ac35a209d..39dc32bb79 100644 --- a/lib/kernel/src/file_io_server.erl +++ b/lib/kernel/src/file_io_server.erl @@ -198,6 +198,14 @@ io_reply(From, ReplyAs, Reply) -> %%%----------------------------------------------------------------- %%% file requests +file_request({advise,Offset,Length,Advise}, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:advise(Handle, Offset, Length, Advise) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request({pread,At,Sz}, #state{handle=Handle,buf=Buf,read_mode=ReadMode}=State) -> case position(Handle, At, Buf) of @@ -219,6 +227,14 @@ file_request({pwrite,At,Data}, Reply -> std_reply(Reply, State) end; +file_request(datasync, + #state{handle=Handle}=State) -> + case ?PRIM_FILE:datasync(Handle) of + {error,_}=Reply -> + {stop,normal,Reply,State}; + Reply -> + {reply,Reply,State} + end; file_request(sync, #state{handle=Handle}=State) -> case ?PRIM_FILE:sync(Handle) of diff --git a/lib/kernel/src/ram_file.erl b/lib/kernel/src/ram_file.erl index d996650948..48ea871433 100644 --- a/lib/kernel/src/ram_file.erl +++ b/lib/kernel/src/ram_file.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(ram_file). @@ -24,11 +24,11 @@ -export([open/2, close/1]). -export([write/2, read/2, copy/3, pread/2, pread/3, pwrite/2, pwrite/3, - position/2, truncate/1, sync/1]). + position/2, truncate/1, datasync/1, sync/1]). %% Specialized file operations -export([get_size/1, get_file/1, set_file/2, get_file_close/1]). --export([compress/1, uncompress/1, uuencode/1, uudecode/1]). +-export([compress/1, uncompress/1, uuencode/1, uudecode/1, advise/4]). -export([open_mode/1]). %% used by ftp-file @@ -60,6 +60,7 @@ -define(RAM_FILE_TRUNCATE, 14). -define(RAM_FILE_PREAD, 17). -define(RAM_FILE_PWRITE, 18). +-define(RAM_FILE_FDATASYNC, 19). %% Other operations -define(RAM_FILE_GET, 30). @@ -70,6 +71,7 @@ -define(RAM_FILE_UUENCODE, 35). -define(RAM_FILE_UUDECODE, 36). -define(RAM_FILE_SIZE, 37). +-define(RAM_FILE_ADVISE, 38). %% Open modes for RAM_FILE_OPEN -define(RAM_FILE_MODE_READ, 1). @@ -90,6 +92,14 @@ -define(RAM_FILE_RESP_NUMBER, 3). -define(RAM_FILE_RESP_INFO, 4). +%% POSIX file advises +-define(POSIX_FADV_NORMAL, 0). +-define(POSIX_FADV_RANDOM, 1). +-define(POSIX_FADV_SEQUENTIAL, 2). +-define(POSIX_FADV_WILLNEED, 3). +-define(POSIX_FADV_DONTNEED, 4). +-define(POSIX_FADV_NOREUSE, 5). + %% -------------------------------------------------------------------------- %% Generic file contents operations. %% @@ -167,6 +177,8 @@ copy(#file_descriptor{module = ?MODULE} = Source, %% XXX Should be moved down to the driver for optimization. file:copy_opened(Source, Dest, Length). +datasync(#file_descriptor{module = ?MODULE, data = Port}) -> + call_port(Port, <<?RAM_FILE_FDATASYNC>>). sync(#file_descriptor{module = ?MODULE, data = Port}) -> call_port(Port, <<?RAM_FILE_FSYNC>>). @@ -349,6 +361,28 @@ uudecode(#file_descriptor{module = ?MODULE, data = Port}) -> uudecode(#file_descriptor{}) -> {error, enotsup}. +advise(#file_descriptor{module = ?MODULE, data = Port}, Offset, + Length, Advise) -> + Cmd0 = <<?RAM_FILE_ADVISE, Offset:64/signed, Length:64/signed>>, + case Advise of + normal -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NORMAL:32/signed>>); + random -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_RANDOM:32/signed>>); + sequential -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_SEQUENTIAL:32/signed>>); + will_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_WILLNEED:32/signed>>); + dont_need -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_DONTNEED:32/signed>>); + no_reuse -> + call_port(Port, <<Cmd0/binary, ?POSIX_FADV_NOREUSE:32/signed>>); + _ -> + {error, einval} + end; +advise(#file_descriptor{}, _Offset, _Length, _Advise) -> + {error, enotsup}. + %%%----------------------------------------------------------------- diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 1d170790a3..1d652679b0 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -52,7 +52,7 @@ old_modes/1, new_modes/1, path_open/1, open_errors/1]). -export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1, file_info_bad/1, file_info_times/1, file_write_file_info/1]). --export([rename/1, access/1, truncate/1, sync/1, +-export([rename/1, access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). -export([otp_5814/1]). @@ -82,6 +82,8 @@ -export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]). +-export([advise/1]). + %% Debug exports -export([create_file_slow/2, create_file/2, create_bin/2]). -export([verify_file/2, verify_bin/3]). @@ -377,7 +379,9 @@ win_cur_dir_1(_Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync]. +files(suite) -> + [open,pos,file_info,consult,eval,script,truncate, + sync,datasync,advise]. open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write, pread_write,append,open_errors]. @@ -1355,6 +1359,30 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?FILE_MODULE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]), + ?line ok = ?FILE_MODULE:datasync(Fd), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Ordinary open. + ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]), + ?line ok = ?FILE_MODULE:datasync(Fd2), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1378,6 +1406,77 @@ sync(Config) when is_list(Config) -> ?line test_server:timetrap_cancel(Dog), ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?FILE_MODULE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd, 0, 0, normal), + ?line ok = io:format(Fd, "~s", [Line1]), + ?line ok = io:format(Fd, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd), + + ?line {ok, Fd2} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd2, 0, 0, random), + ?line ok = io:format(Fd2, "~s", [Line1]), + ?line ok = io:format(Fd2, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line {ok, Fd3} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd3, 0, 0, sequential), + ?line ok = io:format(Fd3, "~s", [Line1]), + ?line ok = io:format(Fd3, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line {ok, Fd4} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd4, 0, 0, will_need), + ?line ok = io:format(Fd4, "~s", [Line1]), + ?line ok = io:format(Fd4, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd4), + + ?line {ok, Fd5} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd5, 0, 0, dont_need), + ?line ok = io:format(Fd5, "~s", [Line1]), + ?line ok = io:format(Fd5, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd5), + + ?line {ok, Fd6} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = ?FILE_MODULE:advise(Fd6, 0, 0, no_reuse), + ?line ok = io:format(Fd6, "~s", [Line1]), + ?line ok = io:format(Fd6, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd6), + + ?line {ok, Fd7} = ?FILE_MODULE:open(Advise, [write]), + ?line {error, einval} = ?FILE_MODULE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?FILE_MODULE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?FILE_MODULE:open(Advise, [write]), + ?line ok = io:format(Fd8, "~s", [Line1]), + ?line ok = io:format(Fd8, "~s", [Line2]), + ?line ok = ?FILE_MODULE:close(Fd8), + ?line {ok, Fd9} = ?FILE_MODULE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?FILE_MODULE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?FILE_MODULE:read_line(Fd9), + ?line {ok, Line2} = ?FILE_MODULE:read_line(Fd9), + ?line eof = ?FILE_MODULE:read_line(Fd9), + ?line ok = ?FILE_MODULE:close(Fd9), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl index 6badbb5090..21bdc06fdc 100644 --- a/lib/kernel/test/prim_file_SUITE.erl +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -34,7 +34,7 @@ file_info_times_a/1, file_info_times_b/1, file_write_file_info_a/1, file_write_file_info_b/1]). -export([rename_a/1, rename_b/1, - access/1, truncate/1, sync/1, + access/1, truncate/1, datasync/1, sync/1, read_write/1, pread_write/1, append/1]). -export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). @@ -48,6 +48,8 @@ symlinks_a/1, symlinks_b/1, list_dir_limit/1]). +-export([advise/1]). + -include("test_server.hrl"). -include_lib("kernel/include/file.hrl"). @@ -380,7 +382,7 @@ win_cur_dir_1(_Config, Handle) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -files(suite) -> [open,pos,file_info,truncate,sync]. +files(suite) -> [open,pos,file_info,truncate,sync,datasync,advise]. open(suite) -> [open1,modes,close,access,read_write, pread_write,append]. @@ -1064,6 +1066,24 @@ truncate(Config) when is_list(Config) -> ok. +datasync(suite) -> []; +datasync(doc) -> "Tests that ?PRIM_FILE:datasync/1 at least doesn't crash."; +datasync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]), + ?line ok = ?PRIM_FILE:datasync(Fd), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + + sync(suite) -> []; sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash."; sync(Config) when is_list(Config) -> @@ -1082,6 +1102,77 @@ sync(Config) when is_list(Config) -> ok. +advise(suite) -> []; +advise(doc) -> "Tests that ?PRIM_FILE:advise/4 at least doesn't crash."; +advise(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Advise = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_advise.fil"), + + Line1 = "Hello\n", + Line2 = "World!\n", + + ?line {ok, Fd} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd, 0, 0, normal), + ?line ok = ?PRIM_FILE:write(Fd, Line1), + ?line ok = ?PRIM_FILE:write(Fd, Line2), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line {ok, Fd2} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd2, 0, 0, random), + ?line ok = ?PRIM_FILE:write(Fd2, Line1), + ?line ok = ?PRIM_FILE:write(Fd2, Line2), + ?line ok = ?PRIM_FILE:close(Fd2), + + ?line {ok, Fd3} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd3, 0, 0, sequential), + ?line ok = ?PRIM_FILE:write(Fd3, Line1), + ?line ok = ?PRIM_FILE:write(Fd3, Line2), + ?line ok = ?PRIM_FILE:close(Fd3), + + ?line {ok, Fd4} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd4, 0, 0, will_need), + ?line ok = ?PRIM_FILE:write(Fd4, Line1), + ?line ok = ?PRIM_FILE:write(Fd4, Line2), + ?line ok = ?PRIM_FILE:close(Fd4), + + ?line {ok, Fd5} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd5, 0, 0, dont_need), + ?line ok = ?PRIM_FILE:write(Fd5, Line1), + ?line ok = ?PRIM_FILE:write(Fd5, Line2), + ?line ok = ?PRIM_FILE:close(Fd5), + + ?line {ok, Fd6} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:advise(Fd6, 0, 0, no_reuse), + ?line ok = ?PRIM_FILE:write(Fd6, Line1), + ?line ok = ?PRIM_FILE:write(Fd6, Line2), + ?line ok = ?PRIM_FILE:close(Fd6), + + ?line {ok, Fd7} = ?PRIM_FILE:open(Advise, [write]), + ?line {error, einval} = ?PRIM_FILE:advise(Fd7, 0, 0, bad_advise), + ?line ok = ?PRIM_FILE:close(Fd7), + + %% test write without advise, then a read after an advise + ?line {ok, Fd8} = ?PRIM_FILE:open(Advise, [write]), + ?line ok = ?PRIM_FILE:write(Fd8, Line1), + ?line ok = ?PRIM_FILE:write(Fd8, Line2), + ?line ok = ?PRIM_FILE:close(Fd8), + ?line {ok, Fd9} = ?PRIM_FILE:open(Advise, [read]), + Offset = 0, + %% same as a 0 length in some implementations + Length = length(Line1) + length(Line2), + ?line ok = ?PRIM_FILE:advise(Fd9, Offset, Length, sequential), + ?line {ok, Line1} = ?PRIM_FILE:read_line(Fd9), + ?line {ok, Line2} = ?PRIM_FILE:read_line(Fd9), + ?line eof = ?PRIM_FILE:read_line(Fd9), + ?line ok = ?PRIM_FILE:close(Fd9), + + ?line test_server:timetrap_cancel(Dog), + ok. + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% delete_a(suite) -> []; diff --git a/lib/snmp/doc/src/notes.xml b/lib/snmp/doc/src/notes.xml index eb7c9db6ba..45e1549de7 100644 --- a/lib/snmp/doc/src/notes.xml +++ b/lib/snmp/doc/src/notes.xml @@ -60,6 +60,12 @@ <p>Own Id: OTP-8594</p> </item> + <item> + <p>Auto [agent] Changed default value for the MIB server cache. + GC is now on by default. </p> + <p>Own Id: OTP-8648</p> + </item> + </list> </section> @@ -83,6 +89,15 @@ <p>Own Id: OTP-8595</p> </item> + <item> + <p>[manager] Raise condition causing the manager server process to + crash. Unregistering an agent while traffic (set/get-operations) + is ongoing could cause a crash in the manager server process + (raise condition). </p> + <p>Own Id: OTP-8646</p> + <p>Aux Id: Seq 11585</p> + </item> + </list> </section> diff --git a/lib/snmp/doc/src/snmp_app.xml b/lib/snmp/doc/src/snmp_app.xml index 57eb87a759..694e619da1 100644 --- a/lib/snmp/doc/src/snmp_app.xml +++ b/lib/snmp/doc/src/snmp_app.xml @@ -346,7 +346,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmp_config.xml b/lib/snmp/doc/src/snmp_config.xml index 5bd36305fc..769b908adc 100644 --- a/lib/snmp/doc/src/snmp_config.xml +++ b/lib/snmp/doc/src/snmp_config.xml @@ -343,7 +343,7 @@ <p>Defines if the mib server shall perform cache gc automatically or leave it to the user (see <seealso marker="snmpa#gc_mibs_cache">gc_mibs_cache/0,1,2,3</seealso>). </p> - <p>Default is <c>false</c>.</p> + <p>Default is <c>true</c>.</p> </item> <tag><c><![CDATA[mibs_cache_age() = integer() > 0 <optional>]]></c></tag> diff --git a/lib/snmp/doc/src/snmpa.xml b/lib/snmp/doc/src/snmpa.xml index b3661ae9b0..69fe6d62f4 100644 --- a/lib/snmp/doc/src/snmpa.xml +++ b/lib/snmp/doc/src/snmpa.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2004</year><year>2009</year> + <year>2004</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>snmpa</title> @@ -648,6 +648,20 @@ notification_delivery_info() = #snmpa_notification_delivery_info{} <desc> <p>Disable the mib server cache. </p> + <marker id="which_mibs_cache_size"></marker> + </desc> + </func> + + <func> + <name>which_mibs_cache_size() -> void()</name> + <name>which_mibs_cache_size(Agent) -> void()</name> + <fsummary>The size of the mib server cache</fsummary> + <type> + <v>Agent = pid() | atom()</v> + </type> + <desc> + <p>Retreive the size of the mib server cache. </p> + <marker id="gc_mibs_cache"></marker> </desc> </func> diff --git a/lib/snmp/src/agent/snmpa.erl b/lib/snmp/src/agent/snmpa.erl index a113bba3a7..1c37d76074 100644 --- a/lib/snmp/src/agent/snmpa.erl +++ b/lib/snmp/src/agent/snmpa.erl @@ -47,6 +47,7 @@ mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/0, invalidate_mibs_cache/1, + which_mibs_cache_size/0, which_mibs_cache_size/1, enable_mibs_cache/0, enable_mibs_cache/1, disable_mibs_cache/0, disable_mibs_cache/1, gc_mibs_cache/0, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, @@ -302,6 +303,13 @@ invalidate_mibs_cache(Agent) -> snmpa_agent:invalidate_mibs_cache(Agent). +which_mibs_cache_size() -> + which_mibs_cache_size(snmp_master_agent). + +which_mibs_cache_size(Agent) -> + snmpa_agent:which_mibs_cache_size(Agent). + + enable_mibs_cache() -> enable_mibs_cache(snmp_master_agent). diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index fb04fca632..648f5b53fa 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -48,6 +48,7 @@ get/2, get/3, get_next/2, get_next/3]). -export([mib_of/1, mib_of/2, me_of/1, me_of/2, invalidate_mibs_cache/1, + which_mibs_cache_size/1, enable_mibs_cache/1, disable_mibs_cache/1, gc_mibs_cache/1, gc_mibs_cache/2, gc_mibs_cache/3, enable_mibs_cache_autogc/1, disable_mibs_cache_autogc/1, @@ -245,6 +246,10 @@ disable_mibs_cache(Agent) -> call(Agent, {mibs_cache_request, disable_cache}). +which_mibs_cache_size(Agent) -> + call(Agent, {mibs_cache_request, cache_size}). + + enable_mibs_cache_autogc(Agent) -> call(Agent, {mibs_cache_request, enable_autogc}). @@ -1219,6 +1224,8 @@ handle_mibs_cache_request(MibServer, Req) -> snmpa_mib:gc_cache(MibServer, Age); {gc_cache, Age, GcLimit} -> snmpa_mib:gc_cache(MibServer, Age, GcLimit); + cache_size -> + snmpa_mib:which_cache_size(MibServer); enable_cache -> snmpa_mib:enable_cache(MibServer); disable_cache -> diff --git a/lib/snmp/src/agent/snmpa_mib.erl b/lib/snmp/src/agent/snmpa_mib.erl index 370989d0be..ce90db18b3 100644 --- a/lib/snmp/src/agent/snmpa_mib.erl +++ b/lib/snmp/src/agent/snmpa_mib.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(snmpa_mib). @@ -55,7 +55,7 @@ -define(NO_CACHE, no_mibs_cache). -define(DEFAULT_CACHE_USAGE, true). -define(CACHE_GC_TICKTIME, timer:minutes(1)). --define(DEFAULT_CACHE_AUTOGC, false). +-define(DEFAULT_CACHE_AUTOGC, true). -define(DEFAULT_CACHE_GCLIMIT, 100). -define(DEFAULT_CACHE_AGE, timer:minutes(10)). -define(CACHE_GC_TRIGGER, cache_gc_trigger). diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index aa3410fea3..2acff74b42 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -24,48 +24,59 @@ [ {"4.16.1", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []} + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpm_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, - soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, + {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, {advanced, upgrade_from_pre_4_16}, + soft_purge, soft_purge, [snmpm_config, snmp_log]}, + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -82,13 +93,14 @@ [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, upgrade_from_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -109,49 +121,60 @@ [ {"4.16.1", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, - {load_module, snmp_pdus, soft_purge, soft_purge, []} + {load_module, snmp_pdus, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.16", [ + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, soft, soft_purge, soft_purge, []} + {update, snmpm_net_if, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]} ] }, {"4.15", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpm_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpm_config, snmp_log]}, - {update, snmpm_config, soft, soft_purge, soft_purge, []} + {update, snmpm_config, soft, soft_purge, soft_purge, []}, + {update, snmpm_server, soft, soft_purge, soft_purge, []} ] }, {"4.14", [ {load_module, snmp_pdus, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_config, soft_purge, soft_purge, []}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, - {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, + {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, []}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, @@ -169,12 +192,13 @@ {load_module, snmp_pdus, soft_purge, soft_purge, []}, {load_module, snmpa_mib_data, soft_purge, soft_purge, []}, {load_module, snmp_config, soft_purge, soft_purge, []}, - {load_module, snmpa, soft_purge, soft_purge, [snmp_log]}, + {load_module, snmpa, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, {load_module, snmp_log, soft_purge, soft_purge, []}, {load_module, snmpa_general_db, soft_purge, soft_purge, []}, {update, snmpa_net_if, {advanced, downgrade_to_pre_4_16}, soft_purge, soft_purge, [snmpa_agent, snmp_log]}, - {update, snmpa_agent, soft, soft_purge, soft_purge, []}, + {update, snmpa_mib, soft, soft_purge, soft_purge, [snmpa_mib_data]}, + {update, snmpa_agent, soft, soft_purge, soft_purge, [snmpa_mib]}, {load_module, snmpa_usm, soft_purge, soft_purge, [snmp_usm]}, {load_module, snmp_usm, soft_purge, soft_purge, []}, diff --git a/lib/snmp/src/manager/snmpm_server.erl b/lib/snmp/src/manager/snmpm_server.erl index 30aacc0ec3..d64b5b1d53 100644 --- a/lib/snmp/src/manager/snmpm_server.erl +++ b/lib/snmp/src/manager/snmpm_server.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% @@ -2804,16 +2804,16 @@ agent_data(TargetName, CtxName) -> agent_data(TargetName, CtxName, Config) -> case snmpm_config:agent_info(TargetName, all) of {ok, Info} -> - {value, {_, Version}} = lists:keysearch(version, 1, Info), + Version = agent_data_item(version, Info), MsgData = case Version of v3 -> DefSecModel = agent_data_item(sec_model, Info), DefSecName = agent_data_item(sec_name, Info), DefSecLevel = agent_data_item(sec_level, Info), - + EngineId = agent_data_item(engine_id, Info), - + SecModel = agent_data_item(sec_model, Config, DefSecModel), @@ -2829,7 +2829,7 @@ agent_data(TargetName, CtxName, Config) -> _ -> DefComm = agent_data_item(community, Info), DefSecModel = agent_data_item(sec_model, Info), - + Comm = agent_data_item(community, Config, DefComm), @@ -2848,8 +2848,12 @@ agent_data(TargetName, CtxName, Config) -> end. agent_data_item(Item, Info) -> - {value, {_, Val}} = lists:keysearch(Item, 1, Info), - Val. + case lists:keysearch(Item, 1, Info) of + {value, {_, Val}} -> + Val; + false -> + throw({error, {not_found, Item, Info}}) + end. agent_data_item(Item, Info, Default) -> case lists:keysearch(Item, 1, Info) of diff --git a/lib/snmp/vsn.mk b/lib/snmp/vsn.mk index 2fccc733e6..c3704bf6c9 100644 --- a/lib/snmp/vsn.mk +++ b/lib/snmp/vsn.mk @@ -21,9 +21,11 @@ SNMP_VSN = 4.16.2 PRE_VSN = APP_VSN = "snmp-$(SNMP_VSN)$(PRE_VSN)" -TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 +TICKETS = OTP-8563 OTP-8574 OTP-8594 OTP-8595 OTP-8646 OTP-8648 -TICKETS_4_16_1 = OTP-8480 OTP-8481 +TICKETS_4_16_1 = \ + OTP-8480 \ + OTP-8481 TICKETS_4_16 = \ OTP-8395 \ diff --git a/lib/ssl/doc/src/new_ssl.xml b/lib/ssl/doc/src/new_ssl.xml index ab6e112a35..4ffaa9d96a 100644 --- a/lib/ssl/doc/src/new_ssl.xml +++ b/lib/ssl/doc/src/new_ssl.xml @@ -88,6 +88,10 @@ extensions are not supported yet. </item> <item>Supported SSL/TLS-versions are SSL-3.0 and TLS-1.0 </item> <item>For security reasons sslv2 is not supported.</item> + <item>Ephemeral Diffie-Hellman cipher suites are supported + but not Diffie Hellman Certificates cipher suites.</item> + <item>Export cipher suites are not supported as the + U.S. lifted its export restrictions in early 2000.</item> </list> </section> @@ -148,25 +152,20 @@ <p><c>protocol() = sslv3 | tlsv1 </c></p> - <p><c>ciphers() = [ciphersuite()] | sting() (according to old API)</c></p> + <p><c>ciphers() = [ciphersuite()] | string() (according to old API)</c></p> <p><c>ciphersuite() = - {key_exchange(), cipher(), hash(), exportable()}</c></p> + {key_exchange(), cipher(), hash()}</c></p> - <p><c>key_exchange() = rsa | dh_dss | dh_rsa | dh_anon | dhe_dss - | dhe_rsa | krb5 | KeyExchange_export + <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa </c></p> - <p><c>cipher() = rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' - des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | - rc2_cbc_40 | rc4_40 </c></p> + <p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc' + | aes_128_cbc | aes_256_cbc </c></p> <p> <c>hash() = md5 | sha </c></p> - <p> <c>exportable() = export | no_export | ignore - </c></p> - <p><c>ssl_imp() = new | old - default is old.</c></p> </section> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 95cd92ee60..185a1f755a 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -718,7 +718,10 @@ emulated_options([], Inet,Emulated) -> cipher_suites(Version, []) -> ssl_cipher:suites(Version); -cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> +cipher_suites(Version, [{_,_,_,_}| _] = Ciphers0) -> %% Backwards compatibility + Ciphers = [{KeyExchange, Cipher, Hash} || {KeyExchange, Cipher, Hash, _} <- Ciphers0], + cipher_suites(Version, Ciphers); +cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0], cipher_suites(Version, Ciphers); cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index ef4b450d68..daf4ef48b7 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -48,7 +48,7 @@ %% cipher values has been updated according to <CipherSuite> %%------------------------------------------------------------------- security_parameters(CipherSuite, SecParams) -> - { _, Cipher, Hash, Exportable} = suite_definition(CipherSuite), + { _, Cipher, Hash} = suite_definition(CipherSuite), SecParams#security_parameters{ cipher_suite = CipherSuite, bulk_cipher_algorithm = bulk_cipher_algorithm(Cipher), @@ -58,8 +58,7 @@ security_parameters(CipherSuite, SecParams) -> key_material_length = key_material(Cipher), iv_size = iv_size(Cipher), mac_algorithm = mac_algorithm(Hash), - hash_size = hash_size(Hash), - exportable = Exportable}. + hash_size = hash_size(Hash)}. %%-------------------------------------------------------------------- %% Function: cipher(Method, CipherState, Mac, Data) -> @@ -109,10 +108,6 @@ cipher(?AES, CipherState, Mac, Fragment) -> %% block_cipher(fun(Key, IV, T) -> %% crypto:idea_cbc_encrypt(Key, IV, T) %% end, block_size(idea_cbc), CipherState, Mac, Fragment); -%% cipher(?RC2, CipherState, Mac, Fragment) -> -%% block_cipher(fun(Key, IV, T) -> -%% crypto:rc2_40_cbc_encrypt(Key, IV, T) -%% end, block_size(rc2_cbc_40), CipherState, Mac, Fragment). block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, Mac, Fragment) -> @@ -175,10 +170,6 @@ decipher(?AES, HashSz, CipherState, Fragment) -> %% block_decipher(fun(Key, IV, T) -> %% crypto:idea_cbc_decrypt(Key, IV, T) %% end, CipherState, HashSz, Fragment); -%% decipher(?RC2, HashSz, CipherState, Fragment) -> -%% block_decipher(fun(Key, IV, T) -> -%% crypto:rc2_40_cbc_decrypt(Key, IV, T) -%% end, CipherState, HashSz, Fragment). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, HashSz, Fragment) -> @@ -209,289 +200,147 @@ suites({3, N}) when N == 1; N == 2 -> %%-------------------------------------------------------------------- %% Function: suite_definition(CipherSuite) -> -%% {KeyExchange, Cipher, Hash, Exportable} +%% {KeyExchange, Cipher, Hash} %% %% %% CipherSuite - as defined in ssl_cipher.hrl -%% KeyExchange - rsa | dh_dss | dh_rsa | dh_anon | dhe_dss | dhe_rsa -%% krb5 | *_export (old ssl) +%% KeyExchange - rsa | dh_anon | dhe_dss | dhe_rsa | kerb5 +%% %% Cipher - null | rc4_128 | idea_cbc | des_cbc | '3des_ede_cbc' -%% des40_cbc | dh_dss | aes_128_cbc | aes_256_cbc | -%% rc2_cbc_40 | rc4_40 +%% des40_cbc | aes_128_cbc | aes_256_cbc %% Hash - null | md5 | sha -%% Exportable - export | no_export | ignore(?) %% -%% Description: Returns a security parameters record where the +%% Description: Returns a security parameters tuple where the %% cipher values has been updated according to <CipherSuite> %% Note: Currently not supported suites are commented away. %% They should be supported or removed in the future. %%------------------------------------------------------------------- %% TLS v1.1 suites suite_definition(?TLS_NULL_WITH_NULL_NULL) -> - {null, null, null, ignore}; + {null, null, null}; %% suite_definition(?TLS_RSA_WITH_NULL_MD5) -> -%% {rsa, null, md5, ignore}; +%% {rsa, null, md5}; %% suite_definition(?TLS_RSA_WITH_NULL_SHA) -> -%% {rsa, null, sha, ignore}; +%% {rsa, null, sha}; suite_definition(?TLS_RSA_WITH_RC4_128_MD5) -> - {rsa, rc4_128, md5, no_export}; + {rsa, rc4_128, md5}; suite_definition(?TLS_RSA_WITH_RC4_128_SHA) -> - {rsa, rc4_128, sha, no_export}; + {rsa, rc4_128, sha}; %% suite_definition(?TLS_RSA_WITH_IDEA_CBC_SHA) -> -%% {rsa, idea_cbc, sha, no_export}; +%% {rsa, idea_cbc, sha}; suite_definition(?TLS_RSA_WITH_DES_CBC_SHA) -> - {rsa, des_cbc, sha, no_export}; + {rsa, des_cbc, sha}; suite_definition(?TLS_RSA_WITH_3DES_EDE_CBC_SHA) -> - {rsa, '3des_ede_cbc', sha, no_export}; -%% suite_definition(?TLS_DH_DSS_WITH_DES_CBC_SHA) -> -%% {dh_dss, des_cbc, sha, no_export}; -%% suite_definition(?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA) -> -%% {dh_dss, '3des_ede_cbc', sha, no_export}; -%% suite_definition(?TLS_DH_RSA_WITH_DES_CBC_SHA) -> -%% {dh_rsa, des_cbc, sha, no_export}; -%% suite_definition(?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA) -> -%% {dh_rsa, '3des_ede_cbc', sha, no_export}; + {rsa, '3des_ede_cbc', sha}; suite_definition(?TLS_DHE_DSS_WITH_DES_CBC_SHA) -> - {dhe_dss, des_cbc, sha, no_export}; + {dhe_dss, des_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA) -> - {dhe_dss, '3des_ede_cbc', sha, no_export}; + {dhe_dss, '3des_ede_cbc'}; suite_definition(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> - {dhe_rsa, des_cbc, sha, no_export}; + {dhe_rsa, des_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA) -> - {dhe_rsa, '3des_ede_cbc', sha, no_export}; -%% suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) -> -%% {dh_anon, rc4_128, md5, no_export}; -%% suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) -> -%% {dh_anon, des40_cbc, sha, no_export}; -%% suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) -> -%% {dh_anon, '3des_ede_cbc', sha, no_export}; + {dhe_rsa, '3des_ede_cbc', sha}; %%% TSL V1.1 AES suites suite_definition(?TLS_RSA_WITH_AES_128_CBC_SHA) -> - {rsa, aes_128_cbc, sha, ignore}; -%% suite_definition(?TLS_DH_DSS_WITH_AES_128_CBC_SHA) -> -%% {dh_dss, aes_128_cbc, sha, ignore}; -%% suite_definition(?TLS_DH_RSA_WITH_AES_128_CBC_SHA) -> -%% {dh_rsa, aes_128_cbc, sha, ignore}; + {rsa, aes_128_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_128_CBC_SHA) -> - {dhe_dss, aes_128_cbc, sha, ignore}; + {dhe_dss, aes_128_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_128_CBC_SHA) -> - {dhe_rsa, aes_128_cbc, sha, ignore}; -%% suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) -> -%% {dh_anon, aes_128_cbc, sha, ignore}; + {dhe_rsa, aes_128_cbc, sha}; suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) -> - {rsa, aes_256_cbc, sha, ignore}; -%% suite_definition(?TLS_DH_DSS_WITH_AES_256_CBC_SHA) -> -%% {dh_dss, aes_256_cbc, sha, ignore}; -%% suite_definition(?TLS_DH_RSA_WITH_AES_256_CBC_SHA) -> -%% {dh_rsa, aes_256_cbc, sha, ignore}; + {rsa, aes_256_cbc, sha}; suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) -> - {dhe_dss, aes_256_cbc, sha, ignore}; + {dhe_dss, aes_256_cbc, sha}; suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> - {dhe_rsa, aes_256_cbc, sha, ignore}. -%% suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) -> -%% {dh_anon, aes_256_cbc, sha, ignore}; + {dhe_rsa, aes_256_cbc, sha}. -%% TSL V1.1 KRB SUITES +%% TODO: support kerbos key exchange? +%% TSL V1.1 KRB SUITES %% suite_definition(?TLS_KRB5_WITH_DES_CBC_SHA) -> -%% {krb5, des_cbc, sha, ignore}; +%% {krb5, des_cbc, sha}; %% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_SHA) -> -%% {krb5, '3des_ede_cbc', sha, ignore}; +%% {krb5, '3des_ede_cbc', sha}; %% suite_definition(?TLS_KRB5_WITH_RC4_128_SHA) -> -%% {krb5, rc4_128, sha, ignore}; +%% {krb5, rc4_128, sha}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_SHA) -> -%% {krb5, idea_cbc, sha, ignore}; +%% {krb5, idea_cbc, sha}; %% suite_definition(?TLS_KRB5_WITH_DES_CBC_MD5) -> -%% {krb5, des_cbc, md5, ignore}; +%% {krb5, des_cbc, md5}; %% suite_definition(?TLS_KRB5_WITH_3DES_EDE_CBC_MD5) -> -%% {krb5, '3des_ede_cbc', md5, ignore}; +%% {krb5, '3des_ede_cbc', md5}; %% suite_definition(?TLS_KRB5_WITH_RC4_128_MD5) -> -%% {krb5, rc4_128, md5, ignore}; +%% {krb5, rc4_128, md5}; %% suite_definition(?TLS_KRB5_WITH_IDEA_CBC_MD5) -> -%% {krb5, idea_cbc, md5, ignore}; - -%% suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> -%% {rsa, rc4_56, md5, export}; -%% suite_definition(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> -%% {rsa, rc2_cbc_56, md5, export}; -%% suite_definition(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> -%% {rsa, des_cbc, sha, export}; -%% suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> -%% {dhe_dss, des_cbc, sha, export}; -%% suite_definition(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> -%% {rsa, rc4_56, sha, export}; -%% suite_definition(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> -%% {dhe_dss, rc4_56, sha, export}; -%% suite_definition(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> -%% {dhe_dss, rc4_128, sha, export}; - -%% Export suites TLS 1.0 OR SSLv3-only servers. -%% suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA) -> -%% {krb5_export, des40_cbc, sha, export}; -%% suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA) -> -%% {krb5_export, rc2_cbc_40, sha, export}; -%% suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_SHA) -> -%% {krb5_export, des40_cbc, sha, export}; -%% suite_definition(?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5) -> -%% {krb5_export, des40_cbc, md5, export}; -%% suite_definition(?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5) -> -%% {krb5_export, rc2_cbc_40, md5, export}; -%% suite_definition(?TLS_KRB5_EXPORT_WITH_RC4_40_MD5) -> -%% {krb5_export, rc2_cbc_40, md5, export}; -%% suite_definition(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> -%% {rsa, rc4_40, md5, export}; -%% suite_definition(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> -%% {rsa, rc2_cbc_40, md5, export}; -%% suite_definition(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> -%% {rsa, des40_cbc, sha, export}; -%% suite_definition(?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA) -> -%% {dh_dss, des40_cbc, sha, export}; -%% suite_definition(?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA) -> -%% {dh_rsa, des40_cbc, sha, export}; -%% suite_definition(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> -%% {dhe_dss, des40_cbc, sha, export}; -%% suite_definition(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> -%% {dhe_rsa, des40_cbc, sha, export}; -%% suite_definition(?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5) -> -%% {dh_anon, rc4_40, md5, export}; -%% suite_definition(?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA) -> -%% {dh_anon, des40_cbc, sha, export}. +%% {krb5, idea_cbc, md5}; %% TLS v1.1 suites -suite({rsa, null, md5, ignore}) -> - ?TLS_RSA_WITH_NULL_MD5; -suite({rsa, null, sha, ignore}) -> - ?TLS_RSA_WITH_NULL_SHA; -suite({rsa, rc4_128, md5, no_export}) -> +%%suite({rsa, null, md5}) -> +%% ?TLS_RSA_WITH_NULL_MD5; +%%suite({rsa, null, sha}) -> +%% ?TLS_RSA_WITH_NULL_SHA; +suite({rsa, rc4_128, md5}) -> ?TLS_RSA_WITH_RC4_128_MD5; -suite({rsa, rc4_128, sha, no_export}) -> +suite({rsa, rc4_128, sha}) -> ?TLS_RSA_WITH_RC4_128_SHA; -%% suite({rsa, idea_cbc, sha, no_export}) -> +%% suite({rsa, idea_cbc, sha}) -> %% ?TLS_RSA_WITH_IDEA_CBC_SHA; -suite({rsa, des_cbc, sha, no_export}) -> +suite({rsa, des_cbc, sha}) -> ?TLS_RSA_WITH_DES_CBC_SHA; -suite({rsa, '3des_ede_cbc', sha, no_export}) -> +suite({rsa, '3des_ede_cbc', sha}) -> ?TLS_RSA_WITH_3DES_EDE_CBC_SHA; -%% suite({dh_dss, des_cbc, sha, no_export}) -> -%% ?TLS_DH_DSS_WITH_DES_CBC_SHA; -%% suite({dh_dss, '3des_ede_cbc', sha, no_export}) -> -%% ?TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA; -%% suite({dh_rsa, des_cbc, sha, no_export}) -> -%% ?TLS_DH_RSA_WITH_DES_CBC_SHA; -%% suite({dh_rsa, '3des_ede_cbc', sha, no_export}) -> -%% ?TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA; -suite({dhe_dss, des_cbc, sha, no_export}) -> +suite({dhe_dss, des_cbc, sha}) -> ?TLS_DHE_DSS_WITH_DES_CBC_SHA; -suite({dhe_dss, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_dss, '3des_ede_cbc', sha}) -> ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA; -suite({dhe_rsa, des_cbc, sha, no_export}) -> +suite({dhe_rsa, des_cbc, sha}) -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; -suite({dhe_rsa, '3des_ede_cbc', sha, no_export}) -> +suite({dhe_rsa, '3des_ede_cbc', sha}) -> ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA; -%% suite({dh_anon, rc4_128, md5, no_export}) -> +%% suite({dh_anon, rc4_128, md5}) -> %% ?TLS_DH_anon_WITH_RC4_128_MD5; -%% suite({dh_anon, des40_cbc, sha, no_export}) -> +%% suite({dh_anon, des40_cbc, sha}) -> %% ?TLS_DH_anon_WITH_DES_CBC_SHA; -%% suite({dh_anon, '3des_ede_cbc', sha, no_export}) -> +%% suite({dh_anon, '3des_ede_cbc', sha}) -> %% ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA; %%% TSL V1.1 AES suites -suite({rsa, aes_128_cbc, sha, ignore}) -> +suite({rsa, aes_128_cbc, sha}) -> ?TLS_RSA_WITH_AES_128_CBC_SHA; -%% suite({dh_dss, aes_128_cbc, sha, ignore}) -> -%% ?TLS_DH_DSS_WITH_AES_128_CBC_SHA; -%% suite({dh_rsa, aes_128_cbc, sha, ignore}) -> -%% ?TLS_DH_RSA_WITH_AES_128_CBC_SHA; -%% suite({dhe_dss, aes_128_cbc, sha, ignore}) -> +%% suite({dhe_dss, aes_128_cbc, sha}) -> %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA; -suite({dhe_rsa, aes_128_cbc, sha, ignore}) -> +suite({dhe_rsa, aes_128_cbc, sha}) -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA; -%% suite({dh_anon, aes_128_cbc, sha, ignore}) -> +%% suite({dh_anon, aes_128_cbc, sha}) -> %% ?TLS_DH_anon_WITH_AES_128_CBC_SHA; -suite({rsa, aes_256_cbc, sha, ignore}) -> +suite({rsa, aes_256_cbc, sha}) -> ?TLS_RSA_WITH_AES_256_CBC_SHA; -%% suite({dh_dss, aes_256_cbc, sha, ignore}) -> -%% ?TLS_DH_DSS_WITH_AES_256_CBC_SHA; -%% suite({dh_rsa, aes_256_cbc, sha, ignore}) -> -%% ?TLS_DH_RSA_WITH_AES_256_CBC_SHA; -suite({dhe_dss, aes_256_cbc, sha, ignore}) -> +suite({dhe_dss, aes_256_cbc, sha}) -> ?TLS_DHE_DSS_WITH_AES_256_CBC_SHA; -suite({dhe_rsa, aes_256_cbc, sha, ignore}) -> +suite({dhe_rsa, aes_256_cbc, sha}) -> ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA. -%% suite({dh_anon, aes_256_cbc, sha, ignore}) -> +%% suite({dh_anon, aes_256_cbc, sha}) -> %% ?TLS_DH_anon_WITH_AES_256_CBC_SHA. +%% TODO: support kerbos key exchange? %% TSL V1.1 KRB SUITES -%% suite({krb5, des_cbc, sha, ignore}) -> +%% suite({krb5, des_cbc, sha}) -> %% ?TLS_KRB5_WITH_DES_CBC_SHA; -%% suite({krb5_cbc, '3des_ede_cbc', sha, ignore}) -> +%% suite({krb5_cbc, '3des_ede_cbc', sha}) -> %% ?TLS_KRB5_WITH_3DES_EDE_CBC_SHA; -%% suite({krb5, rc4_128, sha, ignore}) -> +%% suite({krb5, rc4_128, sha}) -> %% ?TLS_KRB5_WITH_RC4_128_SHA; -%% suite({krb5_cbc, idea_cbc, sha, ignore}) -> +%% suite({krb5_cbc, idea_cbc, sha}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_SHA; -%% suite({krb5_cbc, md5, ignore}) -> +%% suite({krb5_cbc, md5}) -> %% ?TLS_KRB5_WITH_DES_CBC_MD5; -%% suite({krb5_ede_cbc, des_cbc, md5, ignore}) -> +%% suite({krb5_ede_cbc, des_cbc, md5}) -> %% ?TLS_KRB5_WITH_3DES_EDE_CBC_MD5; -%% suite({krb5_128, rc4_128, md5, ignore}) -> +%% suite({krb5_128, rc4_128, md5}) -> %% ?TLS_KRB5_WITH_RC4_128_MD5; -%% suite({krb5, idea_cbc, md5, ignore}) -> +%% suite({krb5, idea_cbc, md5}) -> %% ?TLS_KRB5_WITH_IDEA_CBC_MD5; -%% Export suites TLS 1.0 OR SSLv3-only servers. -%% suite({rsa, rc4_40, md5, export}) -> -%% ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -%% suite({rsa, rc2_cbc_40, md5, export}) -> -%% ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -%% suite({rsa, des40_cbc, sha, export}) -> -%% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% suite({rsa, rc4_56, md5, export}) -> -%% ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -%% suite({rsa, rc2_cbc_56, md5, export}) -> -%% ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -%% suite({rsa, des_cbc, sha, export}) -> -%% ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -%% suite({dhe_dss, des_cbc, sha, export}) -> -%% ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -%% suite({rsa, rc4_56, sha, export}) -> -%% ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -%% suite({dhe_dss, rc4_56, sha, export}) -> -%% ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; -%% suite({dhe_dss, rc4_128, sha, export}) -> -%% ?TLS_DHE_DSS_WITH_RC4_128_SHA; -%% suite({krb5_export, des40_cbc, sha, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA; -%% suite({krb5_export, rc2_cbc_40, sha, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA; -%% suite({krb5_export, rc4_cbc_40, sha, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_RC4_40_SHA; -%% suite({krb5_export, des40_cbc, md5, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5; -%% suite({krb5_export, rc2_cbc_40, md5, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5; -%% suite({krb5_export, rc4_cbc_40, md5, export}) -> -%% ?TLS_KRB5_EXPORT_WITH_RC4_40_MD5; -%% suite({rsa_export, rc4_cbc_40, md5, export}) -> -%% ?TLS_RSA_EXPORT_WITH_RC4_40_MD5; -%% suite({rsa_export, rc2_cbc_40, md5, export}) -> -%% ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -%% suite({rsa_export, des40_cbc, sha, export}) -> -%% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% suite({dh_dss_export, des40_cbc, sha, export}) -> -%% ?TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA; -%% suite({dh_rsa_export, des40_cbc, sha, export}) -> -%% ?TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% suite({dhe_dss_export, des40_cbc, sha, export}) -> -%% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -%% suite({dhe_rsa_export, des40_cbc, sha, export}) -> -%% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% suite({dh_anon_export, rc4_40, md5, export}) -> -%% ?TLS_DH_anon_EXPORT_WITH_RC4_40_MD5; -%% suite({dh_anon_export, des40_cbc, sha, export}) -> -%% ?TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA. - - %% translate constants <-> openssl-strings %% TODO: Is there a pattern in the nameing %% that is useable to make a nicer function defention? @@ -523,36 +372,12 @@ openssl_suite("RC4-SHA") -> ?TLS_RSA_WITH_RC4_128_SHA; openssl_suite("RC4-MD5") -> ?TLS_RSA_WITH_RC4_128_MD5; -%% TODO: Do we want to support this? -%% openssl_suite("EXP1024-RC4-MD5") -> -%% ?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5; -%% openssl_suite("EXP1024-RC2-CBC-MD5") -> -%% ?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5; -%% openssl_suite("EXP1024-DES-CBC-SHA") -> -%% ?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA; -%% openssl_suite("EXP1024-DHE-DSS-DES-CBC-SHA") -> -%% ?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA; -%% openssl_suite("EXP1024-RC4-SHA") -> -%% ?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA; -%% openssl_suite("EXP1024-DHE-DSS-RC4-SHA") -> -%% ?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA; %% openssl_suite("DHE-DSS-RC4-SHA") -> %% ?TLS_DHE_DSS_WITH_RC4_128_SHA; - openssl_suite("EDH-RSA-DES-CBC-SHA") -> ?TLS_DHE_RSA_WITH_DES_CBC_SHA; openssl_suite("DES-CBC-SHA") -> ?TLS_RSA_WITH_DES_CBC_SHA. -%% openssl_suite("EXP-EDH-RSA-DES-CBC-SHA") -> -%% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% openssl_suite("EXP-EDH-DSS-DES-CBC-SHA") -> -%% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA; -%% openssl_suite("EXP-DES-CBC-SHA") -> -%% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA; -%% openssl_suite("EXP-RC2-CBC-MD5") -> -%% ?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5; -%% openssl_suite("EXP-RC4-MD5") -> -%% ?TLS_RSA_EXPORT_WITH_RC4_40_MD5. openssl_suite_name(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) -> "DHE-RSA-AES256-SHA"; @@ -582,29 +407,7 @@ openssl_suite_name(?TLS_DHE_RSA_WITH_DES_CBC_SHA) -> "EDH-RSA-DES-CBC-SHA"; openssl_suite_name(?TLS_RSA_WITH_DES_CBC_SHA) -> "DES-CBC-SHA"; -%% openssl_suite_name(?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA) -> -%% "EXP-EDH-RSA-DES-CBC-SHA"; -%% openssl_suite_name(?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA) -> -%% "EXP-EDH-DSS-DES-CBC-SHA"; -%% openssl_suite_name(?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA) -> -%% "EXP-DES-CBC-SHA"; -%% openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5) -> -%% "EXP-RC2-CBC-MD5"; -%% openssl_suite_name(?TLS_RSA_EXPORT_WITH_RC4_40_MD5) -> -%% "EXP-RC4-MD5"; - -%% openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5) -> -%% "EXP1024-RC4-MD5"; -%% openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5) -> -%% "EXP1024-RC2-CBC-MD5"; -%% openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA) -> -%% "EXP1024-DES-CBC-SHA"; -%% openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA) -> -%% "EXP1024-DHE-DSS-DES-CBC-SHA"; -%% openssl_suite_name(?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA) -> -%% "EXP1024-RC4-SHA"; -%% openssl_suite_name(?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA) -> -%% "EXP1024-DHE-DSS-RC4-SHA"; + %% openssl_suite_name(?TLS_DHE_DSS_WITH_RC4_128_SHA) -> %% "DHE-DSS-RC4-SHA"; @@ -621,12 +424,7 @@ bulk_cipher_algorithm(null) -> %% Not supported yet %% bulk_cipher_algorithm(idea_cbc) -> %% ?IDEA; -%% bulk_cipher_algorithm(Cipher) when Cipher == rc2_cbc_40; -%% Cipher == rc2_cbc_56 -> -%% ?RC2; -bulk_cipher_algorithm(Cipher) when Cipher == rc4_40; - Cipher == rc4_56; - Cipher == rc4_128 -> +bulk_cipher_algorithm(rc4_128) -> ?RC4; %% bulk_cipher_algorithm(des40_cbc) -> %% ?DES40; @@ -639,14 +437,10 @@ bulk_cipher_algorithm(Cipher) when Cipher == aes_128_cbc; ?AES. type(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> ?STREAM; type(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc'; @@ -659,13 +453,8 @@ key_material(null) -> key_material(Cipher) when Cipher == idea_cbc; Cipher == rc4_128 -> 16; -key_material(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56 -> - 7; -key_material(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 5; +%%key_material(des40_cbc) -> +%% 5; key_material(des_cbc) -> 8; key_material('3des_ede_cbc') -> @@ -678,10 +467,6 @@ key_material(aes_256_cbc) -> expanded_key_material(null) -> 0; expanded_key_material(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 16; expanded_key_material(Cipher) when Cipher == des_cbc; @@ -696,13 +481,9 @@ expanded_key_material(Cipher) when Cipher == aes_128_cbc; effective_key_bits(null) -> 0; -effective_key_bits(Cipher) when Cipher == rc2_cbc_40; - Cipher == rc4_40; - Cipher == des40_cbc -> - 40; -effective_key_bits(Cipher) when Cipher == rc2_cbc_56; - Cipher == rc4_56; - Cipher == des_cbc -> +%%effective_key_bits(des40_cbc) -> +%% 40; +effective_key_bits(des_cbc) -> 56; effective_key_bits(Cipher) when Cipher == idea_cbc; Cipher == rc4_128; @@ -714,16 +495,12 @@ effective_key_bits(aes_256_cbc) -> 256. iv_size(Cipher) when Cipher == null; - Cipher == rc4_40; - Cipher == rc4_56; Cipher == rc4_128 -> 0; iv_size(Cipher) -> block_size(Cipher). block_size(Cipher) when Cipher == idea_cbc; - Cipher == rc2_cbc_40; - Cipher == rc2_cbc_56; Cipher == des40_cbc; Cipher == des_cbc; Cipher == '3des_ede_cbc' -> diff --git a/lib/ssl/src/ssl_cipher.hrl b/lib/ssl/src/ssl_cipher.hrl index d282cbd780..80fe527f45 100644 --- a/lib/ssl/src/ssl_cipher.hrl +++ b/lib/ssl/src/ssl_cipher.hrl @@ -57,7 +57,7 @@ %% TLS_NULL_WITH_NULL_NULL = { 0x00,0x00 }; -define(TLS_NULL_WITH_NULL_NULL, <<?BYTE(16#00), ?BYTE(16#00)>>). -%%% The following CipherSuite definitions require that the server +%%% The following cipher suite definitions require that the server %%% provide an RSA certificate that can be used for key exchange. The %%% server may request either an RSA or a DSS signature-capable %%% certificate in the certificate request message. @@ -68,24 +68,15 @@ %% TLS_RSA_WITH_NULL_SHA = { 0x00,0x02 }; -define(TLS_RSA_WITH_NULL_SHA, <<?BYTE(16#00), ?BYTE(16#02)>>). -%% TLS_RSA_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x03 }; --define(TLS_RSA_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#03)>>). - %% TLS_RSA_WITH_RC4_128_MD5 = { 0x00,0x04 }; -define(TLS_RSA_WITH_RC4_128_MD5, <<?BYTE(16#00), ?BYTE(16#04)>>). %% TLS_RSA_WITH_RC4_128_SHA = { 0x00,0x05 }; -define(TLS_RSA_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#05)>>). -%% TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x06 }; --define(TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#06)>>). - %% TLS_RSA_WITH_IDEA_CBC_SHA = { 0x00,0x07 }; -define(TLS_RSA_WITH_IDEA_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#07)>>). -%% TLS_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x08 }; --define(TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#08)>>). - %% TLS_RSA_WITH_DES_CBC_SHA = { 0x00,0x09 }; -define(TLS_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#09)>>). @@ -106,51 +97,33 @@ %%% provided by the client must use the parameters (group and %%% generator) described by the server. -%% TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0B }; --define(TLS_DH_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0B)>>). - %% TLS_DH_DSS_WITH_DES_CBC_SHA = { 0x00,0x0C }; -define(TLS_DH_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0C)>>). %% TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x0D }; -define(TLS_DH_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0D)>>). -%% TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x0E }; --define(TLS_DH_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0E)>>). - %% TLS_DH_RSA_WITH_DES_CBC_SHA = { 0x00,0x0F }; -define(TLS_DH_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#0F)>>). %% TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x10 }; -define(TLS_DH_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#10)>>). -%% TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x11 }; --define(TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#11)>>). - %% TLS_DHE_DSS_WITH_DES_CBC_SHA = { 0x00,0x12 }; -define(TLS_DHE_DSS_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#12)>>). %% TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA = { 0x00,0x13 }; -define(TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#13)>>). -%% TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x14 }; --define(TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#14)>>). - %% TLS_DHE_RSA_WITH_DES_CBC_SHA = { 0x00,0x15 }; -define(TLS_DHE_RSA_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#15)>>). %% TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA = { 0x00,0x16 }; -define(TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#16)>>). -%% TLS_DH_anon_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x17 }; --define(TLS_DH_anon_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#17)>>). - %% TLS_DH_anon_WITH_RC4_128_MD5 = { 0x00,0x18 }; -define(TLS_DH_anon_WITH_RC4_128_MD5, <<?BYTE(16#00),?BYTE(16#18)>>). -%% TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA = { 0x00,0x19 }; --define(TLS_DH_anon_EXPORT_WITH_DES40_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#19)>>). - %% TLS_DH_anon_WITH_DES_CBC_SHA = { 0x00,0x1A }; -define(TLS_DH_anon_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#1A)>>). @@ -222,35 +195,7 @@ %% TLS_KRB5_WITH_IDEA_CBC_MD5 = { 0x00,0x25 }; -define(TLS_KRB5_WITH_IDEA_CBC_MD5, <<?BYTE(16#00), ?BYTE(16#25)>>). -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA = { 0x00,0x26 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#26)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA = { 0x00,0x27 }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_SHA, <<?BYTE(16#00), ?BYTE(16#27)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_SHA = { 0x00,0x28 }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_SHA, <<?BYTE(16#00), ?BYTE(16#28)>>). - -%% TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5 = { 0x00,0x29 }; --define(TLS_KRB5_EXPORT_WITH_DES_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#29)>>). - -%% TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5 = { 0x00,0x2A }; --define(TLS_KRB5_EXPORT_WITH_RC2_CBC_40_MD5, <<?BYTE(16#00), ?BYTE(16#2A)>>). - -%% TLS_KRB5_EXPORT_WITH_RC4_40_MD5 = { 0x00,0x2B }; --define(TLS_KRB5_EXPORT_WITH_RC4_40_MD5, <<?BYTE(16#00), ?BYTE(16#2B)>>). - -%% Additional TLS ciphersuites from draft-ietf-tls-56-bit-ciphersuites-00.txt - --define(TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, <<?BYTE(16#00), ?BYTE(16#60)>>). --define(TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, <<?BYTE(16#00), ?BYTE(16#61)>>). --define(TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#62)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, <<?BYTE(16#00), ?BYTE(16#63)>>). --define(TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#64)>>). --define(TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, <<?BYTE(16#00), ?BYTE(16#65)>>). --define(TLS_DHE_DSS_WITH_RC4_128_SHA, <<?BYTE(16#00), ?BYTE(16#66)>>). - -%% RFC 5746 - Not a real ciphersuite used to signal empty "renegotiation_info" extension +%% RFC 5746 - Not a real cipher suite used to signal empty "renegotiation_info" extension %% to avoid handshake failure from old servers that do not ignore %% hello extension data as they should. -define(TLS_EMPTY_RENEGOTIATION_INFO_SCSV, <<?BYTE(16#00), ?BYTE(16#FF)>>). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index a4eaf03086..6912ee8983 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -39,7 +39,7 @@ -include_lib("public_key/include/public_key.hrl"). %% Internal application API --export([send/2, send/3, recv/3, connect/7, ssl_accept/6, handshake/2, +-export([send/2, recv/3, connect/7, ssl_accept/6, handshake/2, socket_control/3, close/1, shutdown/2, new_user/2, get_opts/2, set_opts/2, info/1, session_info/1, peer_certificate/1, sockname/1, peername/1, renegotiation/1]). @@ -87,7 +87,6 @@ from, % term(), where to reply bytes_to_read, % integer(), # bytes to read in passive mode user_data_buffer, % binary() -%% tls_buffer, % Keeps a lookahead one packet if available log_alert, % boolean() renegotiation, % {boolean(), From | internal | peer} recv_during_renegotiation, %boolean() @@ -108,9 +107,9 @@ %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, infinity). -send(Pid, Data, Timeout) -> - sync_send_all_state_event(Pid, {application_data, erlang:iolist_to_binary(Data)}, Timeout). + sync_send_all_state_event(Pid, {application_data, + erlang:iolist_to_binary(Data)}, infinity). + %%-------------------------------------------------------------------- %% Function: recv(Socket, Length Timeout) -> {ok, Data} | {error, reason} %% @@ -211,8 +210,6 @@ peername(ConnectionPid) -> %% %% Description: Same as inet:getopts/2 %%-------------------------------------------------------------------- -get_opts({ListenSocket, {_SslOpts, SockOpts}, _}, OptTags) -> - get_socket_opts(ListenSocket, OptTags, SockOpts, []); get_opts(ConnectionPid, OptTags) -> sync_send_all_state_event(ConnectionPid, {get_opts, OptTags}). %%-------------------------------------------------------------------- @@ -361,7 +358,7 @@ hello(#server_hello{cipher_suite = CipherSuite, case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of {Version, NewId, ConnectionStates1} -> - {KeyAlgorithm, _, _, _} = + {KeyAlgorithm, _, _} = ssl_cipher:suite_definition(CipherSuite), PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm), @@ -425,7 +422,7 @@ abbreviated(#hello_request{}, State0) -> {Record, State} = next_record(State0), next_state(hello, Record, State); -abbreviated(Finished = #finished{verify_data = Data}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = server, negotiated_version = Version, tls_handshake_hashes = Hashes, @@ -443,7 +440,7 @@ abbreviated(Finished = #finished{verify_data = Data}, {stop, normal, State} end; -abbreviated(Finished = #finished{verify_data = Data}, +abbreviated(#finished{verify_data = Data} = Finished, #state{role = client, tls_handshake_hashes = Hashes0, session = #session{master_secret = MasterSecret}, negotiated_version = Version, @@ -507,7 +504,7 @@ certify(#certificate{} = Cert, certify(#server_key_exchange{} = KeyExchangeMsg, #state{role = client, negotiated_version = Version, key_algorithm = Alg} = State0) - when Alg == dhe_dss; Alg == dhe_rsa ->%%Not imp:Alg == dh_anon;Alg == krb5 -> + when Alg == dhe_dss; Alg == dhe_rsa -> case handle_server_key(KeyExchangeMsg, State0) of #state{} = State1 -> {Record, State} = next_record(State1), @@ -518,13 +515,9 @@ certify(#server_key_exchange{} = KeyExchangeMsg, {stop, normal, State0} end; -certify(#server_key_exchange{}, - State = #state{role = client, negotiated_version = Version, - key_algorithm = Alg}) - when Alg == rsa; Alg == dh_dss; Alg == dh_rsa -> - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, certify_server_key_exchange, State), - {stop, normal, State}; +certify(#server_key_exchange{} = Msg, + #state{role = client, key_algorithm = rsa} = State) -> + handle_unexpected_message(Msg, certify_server_keyexchange, State); certify(#certificate_request{}, State0) -> {Record, State} = next_record(State0#state{client_certificate_requested = true}), @@ -568,17 +561,12 @@ certify(#server_hello_done{}, {stop, normal, State0} end; -certify(#client_key_exchange{}, - State = #state{role = server, - client_certificate_requested = true, - ssl_options = #ssl_options{fail_if_no_peer_cert = true}, - negotiated_version = Version}) -> +certify(#client_key_exchange{} = Msg, + #state{role = server, + client_certificate_requested = true, + ssl_options = #ssl_options{fail_if_no_peer_cert = true}} = State) -> %% We expect a certificate here - Alert = ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, - certify_server_waiting_certificate, State), - {stop, normal, State}; - + handle_unexpected_message(Msg, certify_client_key_exchange, State); certify(#client_key_exchange{exchange_keys = #encrypted_premaster_secret{premaster_secret @@ -818,10 +806,22 @@ handle_sync_event(start, From, StateName, State) -> handle_sync_event(close, _, _StateName, State) -> {stop, normal, ok, State}; -handle_sync_event({shutdown, How}, _, StateName, - #state{transport_cb = CbModule, +handle_sync_event({shutdown, How0}, _, StateName, + #state{transport_cb = Transport, + negotiated_version = Version, + connection_states = ConnectionStates, socket = Socket} = State) -> - case CbModule:shutdown(Socket, How) of + case How0 of + How when How == write; How == both -> + Alert = ?ALERT_REC(?WARNING, ?CLOSE_NOTIFY), + {BinMsg, _} = + encode_alert(Alert, Version, ConnectionStates), + Transport:send(Socket, BinMsg); + _ -> + ok + end, + + case Transport:shutdown(Socket, How0) of ok -> {reply, ok, StateName, State}; Error -> @@ -1056,16 +1056,9 @@ init_certificates(#ssl_options{cacertfile = CACertFile, case ssl_manager:connection_init(CACertFile, Role) of {ok, CertDbRef, CacheRef} -> init_certificates(CertDbRef, CacheRef, CertFile, Role); - {error, {badmatch, _Error}} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile); - {error, _Error} -> - Report = io_lib:format("SSL: Error ~p Initializing: ~p ~n", - [_Error, CACertFile]), - error_logger:error_report(Report), - throw(ecacertfile) + {error, Reason} -> + handle_file_error(?LINE, error, Reason, CACertFile, ecacertfile, + erlang:get_stacktrace()) end. init_certificates(CertDbRef, CacheRef, CertFile, client) -> @@ -1081,59 +1074,56 @@ init_certificates(CertDbRef, CacheRef, CertFile, server) -> [OwnCert] = ssl_certificate:file_to_certificats(CertFile), {ok, CertDbRef, CacheRef, OwnCert} catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, CertFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ecertfile) + Error:Reason -> + handle_file_error(?LINE, Error, Reason, CertFile, ecertfile, + erlang:get_stacktrace()) end. init_private_key(undefined, "", _Password, client) -> undefined; init_private_key(undefined, KeyFile, Password, _) -> - try - {ok, List} = ssl_manager:cache_pem_file(KeyFile), - [Der] = [Der || Der = {PKey, _ , _} <- List, - PKey =:= rsa_private_key orelse - PKey =:= dsa_private_key], - {ok, Decoded} = public_key:decode_private_key(Der,Password), - Decoded - catch - _E:{badmatch, _R={error,_}} -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile); - _E:_R -> - Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", - [?LINE, _E,_R, KeyFile, - erlang:get_stacktrace()]), - error_logger:error_report(Report), - throw(ekeyfile) + case ssl_manager:cache_pem_file(KeyFile) of + {ok, List} -> + [Der] = [Der || Der = {PKey, _ , _} <- List, + PKey =:= rsa_private_key orelse + PKey =:= dsa_private_key], + {ok, Decoded} = public_key:decode_private_key(Der,Password), + Decoded; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, KeyFile, ekeyfile, + erlang:get_stacktrace()) end; + init_private_key(PrivateKey, _, _,_) -> PrivateKey. +handle_file_error(Line, Error, {badmatch, Reason}, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack); +handle_file_error(Line, Error, Reason, File, Throw, Stack) -> + file_error(Line, Error, Reason, File, Throw, Stack). + +file_error(Line, Error, Reason, File, Throw, Stack) -> + Report = io_lib:format("SSL: ~p: ~p:~p ~s~n ~p~n", + [Line, Error, Reason, File, Stack]), + error_logger:error_report(Report), + throw(Throw). + init_diffie_hellman(_, client) -> undefined; init_diffie_hellman(undefined, _) -> ?DEFAULT_DIFFIE_HELLMAN_PARAMS; init_diffie_hellman(DHParamFile, server) -> - {ok, List} = ssl_manager:cache_pem_file(DHParamFile), - case [Der || Der = {dh_params, _ , _} <- List] of - [Der] -> - {ok, Decoded} = public_key:decode_dhparams(Der), - Decoded; - [] -> - ?DEFAULT_DIFFIE_HELLMAN_PARAMS + case ssl_manager:cache_pem_file(DHParamFile) of + {ok, List} -> + case [Der || Der = {dh_params, _ , _} <- List] of + [Der] -> + {ok, Decoded} = public_key:decode_dhparams(Der), + Decoded; + [] -> + ?DEFAULT_DIFFIE_HELLMAN_PARAMS + end; + {error, Reason} -> + handle_file_error(?LINE, error, Reason, DHParamFile, edhfile, erlang:get_stacktrace()) end. sync_send_all_state_event(FsmPid, Event) -> @@ -1191,15 +1181,18 @@ verify_client_cert(#state{client_certificate_requested = true, role = client, case ssl_handshake:client_certificate_verify(OwnCert, MasterSecret, Version, KeyAlg, PrivateKey, Hashes0) of - ignore -> %% No key or cert or fixed_diffie_hellman - State; - Verified -> + #certificate_verify{} = Verified -> {BinVerified, ConnectionStates1, Hashes1} = encode_handshake(Verified, KeyAlg, Version, ConnectionStates0, Hashes0), Transport:send(Socket, BinVerified), State#state{connection_states = ConnectionStates1, - tls_handshake_hashes = Hashes1} + tls_handshake_hashes = Hashes1}; + ignore -> + State; + #alert{} = Alert -> + handle_own_alert(Alert, Version, certify, State) + end; verify_client_cert(#state{client_certificate_requested = false} = State) -> State. @@ -1290,7 +1283,7 @@ server_hello(ServerHello, #state{transport_cb = Transport, connection_states = ConnectionStates0, tls_handshake_hashes = Hashes0} = State) -> CipherSuite = ServerHello#server_hello.cipher_suite, - {KeyAlgorithm, _, _, _} = ssl_cipher:suite_definition(CipherSuite), + {KeyAlgorithm, _, _} = ssl_cipher:suite_definition(CipherSuite), %% Version = ServerHello#server_hello.server_version, TODO ska kontrolleras {BinMsg, ConnectionStates1, Hashes1} = encode_handshake(ServerHello, Version, ConnectionStates0, Hashes0), @@ -1333,19 +1326,8 @@ certify_server(#state{transport_cb = Transport, throw(Alert) end. -key_exchange(#state{role = server, key_algorithm = Algo} = State) - when Algo == rsa; - Algo == dh_dss; - Algo == dh_rsa -> +key_exchange(#state{role = server, key_algorithm = rsa} = State) -> State; - -%% Remove or uncomment when we decide if to support export cipher suites -%%key_exchange(#state{role = server, key_algorithm = rsa_export} = State) -> - %% TODO when the public key in the server certificate is - %% less than or equal to 512 bits in length dont send key_exchange - %% but do it otherwise -%% State; - key_exchange(#state{role = server, key_algorithm = Algo, diffie_hellman_params = Params, private_key = PrivateKey, @@ -1396,7 +1378,6 @@ key_exchange(#state{role = client, Transport:send(Socket, BinMsg), State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}; - key_exchange(#state{role = client, connection_states = ConnectionStates0, key_algorithm = Algorithm, @@ -1415,9 +1396,6 @@ key_exchange(#state{role = client, State#state{connection_states = ConnectionStates1, tls_handshake_hashes = Hashes1}. -%% key_algorithm = dh_rsa | dh_dss are not supported. If we want to -%% support it we need a key_exchange clause for it here. - rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) when Algorithm == ?rsaEncryption; Algorithm == ?md2WithRSAEncryption; @@ -1429,20 +1407,6 @@ rsa_key_exchange(PremasterSecret, PublicKeyInfo = {Algorithm, _, _}) rsa_key_exchange(_, _) -> throw (?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)). -%% Uncomment if we decide to support cipher suites with key_algorithm -%% dh_rsa and dh_dss. Could also be removed if we decide support for -%% this will not be needed. Not supported by openssl! -%% dh_key_exchange(OwnCert, DhKeys, true) -> -%% case public_key:pkix_is_fixed_dh_cert(OwnCert) of -%% true -> -%% ssl_handshake:key_exchange(client, fixed_diffie_hellman); -%% false -> -%% {DhPubKey, _} = DhKeys, -%% ssl_handshake:key_exchange(client, {dh, DhPubKey}) -%% end; -%% dh_key_exchange(_, {DhPubKey, _}, false) -> -%% ssl_handshake:key_exchange(client, {dh, DhPubKey}). - request_client_cert(#state{ssl_options = #ssl_options{verify = verify_peer}, connection_states = ConnectionStates0, cert_db_ref = CertDbRef, @@ -1749,13 +1713,7 @@ header(N, Binary) -> <<?BYTE(ByteN), NewBinary/binary>> = Binary, [ByteN | header(N-1, NewBinary)]. -%% tcp_closed -send_or_reply(false, _Pid, undefined, _Data) -> - Report = io_lib:format("SSL(debug): Unexpected Data ~p ~n",[_Data]), - error_logger:error_report(Report), - erlang:error({badarg, _Pid, undefined, _Data}), - ok; -send_or_reply(false, _Pid, From, Data) -> +send_or_reply(false, _Pid, From, Data) when From =/= undefined -> gen_fsm:reply(From, Data); send_or_reply(_, Pid, _From, Data) -> send_user(Pid, Data). @@ -2016,34 +1974,19 @@ handle_alerts(_, {stop, _, _} = Stop) -> handle_alerts([Alert | Alerts], {next_state, StateName, State}) -> handle_alerts(Alerts, handle_alert(Alert, StateName, State)). -handle_alert(#alert{level = ?FATAL} = Alert, connection, - #state{from = From, user_application = {_Mon, Pid}, - log_alert = Log, - host = Host, port = Port, session = Session, - role = Role, socket_options = Opts} = State) -> - invalidate_session(Role, Host, Port, Session), - log_alert(Log, connection, Alert), - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; - -handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - connection, #state{from = From, - role = Role, - user_application = {_Mon, Pid}, - socket_options = Opts} = State) -> - alert_user(Opts#socket_options.active, Pid, From, Alert, Role), - {stop, normal, State}; - handle_alert(#alert{level = ?FATAL} = Alert, StateName, #state{from = From, host = Host, port = Port, session = Session, - log_alert = Log, role = Role} = State) -> + user_application = {_Mon, Pid}, + log_alert = Log, role = Role, socket_options = Opts} = State) -> invalidate_session(Role, Host, Port, Session), log_alert(Log, StateName, Alert), - alert_user(From, Alert, Role), + alert_user(StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; + handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert, - _, #state{from = From, role = Role} = State) -> - alert_user(From, Alert, Role), + StateName, #state{from = From, role = Role, + user_application = {_Mon, Pid}, socket_options = Opts} = State) -> + alert_user(StateName, Opts, Pid, From, Alert, Role), {stop, normal, State}; handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName, @@ -2066,6 +2009,11 @@ handle_alert(#alert{level = ?WARNING, description = ?USER_CANCELED} = Alert, Sta {Record, State} = next_record(State0), next_state(StateName, Record, State). +alert_user(connection, Opts, Pid, From, Alert, Role) -> + alert_user(Opts#socket_options.active, Pid, From, Alert, Role); +alert_user(_, _, _, From, Alert, Role) -> + alert_user(From, Alert, Role). + alert_user(From, Alert, Role) -> alert_user(false, no_pid, From, Alert, Role). @@ -2085,13 +2033,13 @@ alert_user(Active, Pid, From, Alert, Role) -> {ssl_error, sslsocket(), ReasonCode}) end. -log_alert(true, StateName, Alert) -> +log_alert(true, Info, Alert) -> Txt = ssl_alert:alert_txt(Alert), - error_logger:format("SSL: ~p: ~s\n", [StateName, Txt]); + error_logger:format("SSL: ~p: ~s\n", [Info, Txt]); log_alert(false, _, _) -> ok. -handle_own_alert(Alert, Version, StateName, +handle_own_alert(Alert, Version, Info, #state{transport_cb = Transport, socket = Socket, from = User, @@ -2106,20 +2054,18 @@ handle_own_alert(Alert, Version, StateName, ignore end, try %% Try to tell the local user - log_alert(Log, StateName, Alert), + log_alert(Log, Info, Alert), alert_user(User, Alert, Role) catch _:_ -> ok end. -handle_unexpected_message(_Msg, StateName, #state{negotiated_version = Version} = State) -> +handle_unexpected_message(Msg, Info, #state{negotiated_version = Version} = State) -> Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), - handle_own_alert(Alert, Version, StateName, State), + handle_own_alert(Alert, Version, {Info, Msg}, State), {stop, normal, State}. -make_premaster_secret({MajVer, MinVer}, Alg) when Alg == rsa; - Alg == dh_dss; - Alg == dh_rsa -> +make_premaster_secret({MajVer, MinVer}, rsa) -> Rand = crypto:rand_bytes(?NUM_OF_PREMASTERSECRET_BYTES-2), <<?BYTE(MajVer), ?BYTE(MinVer), Rand/binary>>; make_premaster_secret(_, _) -> diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 3772e540b3..5f3dff8894 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -282,7 +282,7 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, PrivateKey, {Hashes0, _}) -> case public_key:pkix_is_fixed_dh_cert(OwnCert) of true -> - ignore; + ?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE); false -> Hashes = calc_certificate_verify(Version, MasterSecret, @@ -302,7 +302,6 @@ client_certificate_verify(OwnCert, MasterSecret, Version, Algorithm, certificate_verify(Signature, {_, PublicKey, _}, Version, MasterSecret, Algorithm, {_, Hashes0}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> Hashes = calc_certificate_verify(Version, MasterSecret, Algorithm, Hashes0), @@ -346,13 +345,6 @@ key_exchange(client, {premaster_secret, Secret, {_, PublicKey, _}}) -> encrypted_premaster_secret(Secret, PublicKey), #client_key_exchange{exchange_keys = EncPremasterSecret}; -%% Uncomment if dh_rsa and dh_dss cipher suites should -%% be supported. -%% key_exchange(client, fixed_diffie_hellman) -> -%% #client_key_exchange{exchange_keys = -%% #client_diffie_hellman_public{ -%% dh_public = <<>> -%% }}; key_exchange(client, {dh, <<?UINT32(Len), PublicKey:Len/binary>>}) -> #client_key_exchange{ exchange_keys = #client_diffie_hellman_public{ @@ -725,12 +717,11 @@ master_secret(Version, MasterSecret, #security_parameters{ hash_size = HashSize, key_material_length = KML, expanded_key_material_length = EKML, - iv_size = IVS, - exportable = Exportable}, + iv_size = IVS}, ConnectionStates, Role) -> {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV} = - setup_keys(Version, Exportable, MasterSecret, ServerRandom, + setup_keys(Version, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS), ?DBG_HEX(ClientWriteKey), ?DBG_HEX(ClientIV), @@ -812,14 +803,7 @@ dec_hs(?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary, renegotiation_info = RenegotiationInfo}; dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>, _, _) -> #certificate{asn1_certificates = certs_to_list(ASN1Certs)}; -%% Uncomment if support for export ciphers is added. -%% dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen), Mod:ModLen/binary, -%% ?UINT16(ExpLen), Exp:ExpLen/binary, -%% ?UINT16(_), Sig/binary>>, -%% ?KEY_EXCHANGE_RSA, _) -> -%% #server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, -%% rsa_exponent = Exp}, -%% signed_params = Sig}; + dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary, ?UINT16(GLen), G:GLen/binary, ?UINT16(YLen), Y:YLen/binary, @@ -846,8 +830,7 @@ dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(_), PKEPMS/binary>>, PreSecret = #encrypted_premaster_secret{premaster_secret = PKEPMS}, #client_key_exchange{exchange_keys = PreSecret}; dec_hs(?CLIENT_KEY_EXCHANGE, <<>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> - %% TODO: Should check whether the cert already contains a suitable DH-key (7.4.7.2) - throw(?ALERT_REC(?FATAL, implicit_public_value_encoding)); + throw(?ALERT_REC(?FATAL, ?UNSUPPORTED_CERTIFICATE)); dec_hs(?CLIENT_KEY_EXCHANGE, <<?UINT16(DH_YLen), DH_Y:DH_YLen/binary>>, ?KEY_EXCHANGE_DIFFIE_HELLMAN, _) -> #client_key_exchange{exchange_keys = @@ -953,17 +936,6 @@ enc_hs(#certificate{asn1_certificates = ASN1CertList}, _Version, _) -> ASN1Certs = certs_from_list(ASN1CertList), ACLen = erlang:iolist_size(ASN1Certs), {?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>}; -%% Uncomment if support for export ciphers is added. -%% enc_hs(#server_key_exchange{params = #server_rsa_params{rsa_modulus = Mod, -%% rsa_exponent = Exp}, -%% signed_params = SignedParams}, _Version, _) -> -%% ModLen = byte_size(Mod), -%% ExpLen = byte_size(Exp), -%% SignedLen = byte_size(SignedParams), -%% {?SERVER_KEY_EXCHANGE, <<?UINT16(ModLen),Mod/binary, -%% ?UINT16(ExpLen), Exp/binary, -%% ?UINT16(SignedLen), SignedParams/binary>> -%% }; enc_hs(#server_key_exchange{params = #server_dh_params{ dh_p = P, dh_g = G, dh_y = Y}, signed_params = SignedParams}, _Version, _) -> @@ -1073,16 +1045,11 @@ from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) -> certificate_types({KeyExchange, _, _, _}) when KeyExchange == rsa; - KeyExchange == dh_dss; - KeyExchange == dh_rsa; KeyExchange == dhe_dss; KeyExchange == dhe_rsa -> <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>; certificate_types(_) -> - %%TODO: Is this a good default, - %% is there a case where we like to request - %% a RSA_FIXED_DH or DSS_FIXED_DH <<?BYTE(?RSA_SIGN)>>. certificate_authorities(CertDbRef) -> @@ -1125,22 +1092,16 @@ calc_master_secret({3,N},PremasterSecret, ClientRandom, ServerRandom) when N == 1; N == 2 -> ssl_tls1:master_secret(PremasterSecret, ClientRandom, ServerRandom). -setup_keys({3,0}, Exportable, MasterSecret, +setup_keys({3,0}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS) -> - ssl_ssl3:setup_keys(Exportable, MasterSecret, ServerRandom, + ssl_ssl3:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KML, EKML, IVS); -setup_keys({3,1}, _Exportable, MasterSecret, +setup_keys({3,1}, MasterSecret, ServerRandom, ClientRandom, HashSize, KML, _EKML, IVS) -> ssl_tls1:setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KML, IVS). -%% Uncomment when supported -%% setup_keys({3,2}, _Exportable, MasterSecret, -%% ServerRandom, ClientRandom, HashSize, KML, _EKML, _IVS) -> -%% ssl_tls1:setup_keys(MasterSecret, ServerRandom, -%% ClientRandom, HashSize, KML). - calc_finished({3, 0}, Role, MasterSecret, Hashes) -> ssl_ssl3:finished(Role, MasterSecret, Hashes); calc_finished({3, N}, Role, MasterSecret, Hashes) @@ -1154,7 +1115,6 @@ calc_certificate_verify({3, N}, _, Algorithm, Hashes) ssl_tls1:certificate_verify(Algorithm, Hashes). server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5Context = crypto:md5_init(), NewMD5Context = crypto:md5_update(MD5Context, Value), @@ -1166,9 +1126,7 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa; <<MD5/binary, SHA/binary>>; -server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; - Algorithm == dhe_dss -> - +server_key_exchange_hash(dhe_dss, Value) -> SHAContext = crypto:sha_init(), NewSHAContext = crypto:sha_update(SHAContext, Value), crypto:sha_final(NewSHAContext). @@ -1176,9 +1134,9 @@ server_key_exchange_hash(Algorithm, Value) when Algorithm == dh_dss; sig_alg(dh_anon) -> ?SIGNATURE_ANONYMOUS; -sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa; Alg == dh_rsa -> +sig_alg(Alg) when Alg == dhe_rsa; Alg == rsa -> ?SIGNATURE_RSA; -sig_alg(Alg) when Alg == dh_dss; Alg == dhe_dss -> +sig_alg(dhe_dss) -> ?SIGNATURE_DSA; sig_alg(_) -> ?NULL. diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 539ddd936a..7a0192a80f 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -179,10 +179,8 @@ handle_call({{connection_init, TrustedcertsFile, _Role}, Pid}, _From, {ok, Ref} = ssl_certificate_db:add_trusted_certs(Pid, TrustedcertsFile, Db), {ok, Ref, Cache} catch - _:{badmatch, Error} -> - {error, Error}; - _E:_R -> - {error, {_R,erlang:get_stacktrace()}} + _:Reason -> + {error, Reason} end, {reply, Result, State}; @@ -204,14 +202,10 @@ handle_call({{cache_pem, File},Pid}, _, State = #state{certificate_db = Db}) -> try ssl_certificate_db:cache_pem_file(Pid,File,Db) of Result -> {reply, Result, State} - catch _:{badmatch, Reason} -> - {reply, Reason, State}; - _:Reason -> + catch + _:Reason -> {reply, {error, Reason}, State} - end; - -handle_call(_,_, State) -> - {reply, ok, State}. + end. %%-------------------------------------------------------------------- %% Function: handle_cast(Msg, State) -> {noreply, State} | %% {noreply, State, Timeout} | @@ -339,7 +333,7 @@ init_session_validator([Cache, CacheCb, LifeTime]) -> CacheCb:foldl(fun session_validation/2, LifeTime, Cache). -session_validation({{Host, Port, _}, Session}, LifeTime) -> +session_validation({{{Host, Port}, _}, Session}, LifeTime) -> validate_session(Host, Port, Session, LifeTime), LifeTime; session_validation({{Port, _}, Session}, LifeTime) -> diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index f9f915f13d..43f18d95a0 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -29,6 +29,7 @@ -include("ssl_internal.hrl"). -include("ssl_alert.hrl"). -include("ssl_handshake.hrl"). +-include("ssl_cipher.hrl"). -include("ssl_debug.hrl"). %% Connection state handling @@ -410,16 +411,14 @@ protocol_version(tlsv1) -> {3, 1}; protocol_version(sslv3) -> {3, 0}; -protocol_version(sslv2) -> +protocol_version(sslv2) -> %% Backwards compatibility {2, 0}; protocol_version({3, 2}) -> 'tlsv1.1'; protocol_version({3, 1}) -> tlsv1; protocol_version({3, 0}) -> - sslv3; -protocol_version({2, 0}) -> - sslv2. + sslv3. %%-------------------------------------------------------------------- %% Function: protocol_version(Version1, Version2) -> #protocol_version{} %% Version1 = Version2 = #protocol_version{} @@ -467,7 +466,7 @@ highest_protocol_version(_, [Version | Rest]) -> %%-------------------------------------------------------------------- supported_protocol_versions() -> Fun = fun(Version) -> - protocol_version(Version) + protocol_version(Version) end, case application:get_env(ssl, protocol_version) of undefined -> @@ -475,11 +474,18 @@ supported_protocol_versions() -> {ok, []} -> lists:map(Fun, ?DEFAULT_SUPPORTED_VERSIONS); {ok, Vsns} when is_list(Vsns) -> - lists:map(Fun, Vsns); + Versions = lists:filter(fun is_acceptable_version/1, lists:map(Fun, Vsns)), + supported_protocol_versions(Versions); {ok, Vsn} -> - [Fun(Vsn)] + Versions = lists:filter(fun is_acceptable_version/1, [Fun(Vsn)]), + supported_protocol_versions(Versions) end. +supported_protocol_versions([]) -> + ?DEFAULT_SUPPORTED_VERSIONS; +supported_protocol_versions([_|_] = Vsns) -> + Vsns. + %%-------------------------------------------------------------------- %% Function: is_acceptable_version(Version) -> true | false %% Version = #protocol_version{} @@ -532,12 +538,10 @@ initial_connection_state(ConnectionEnd) -> }. initial_security_params(ConnectionEnd) -> - #security_parameters{connection_end = ConnectionEnd, - bulk_cipher_algorithm = ?NULL, - mac_algorithm = ?NULL, - compression_algorithm = ?NULL, - cipher_type = ?NULL - }. + SecParams = #security_parameters{connection_end = ConnectionEnd, + compression_algorithm = ?NULL}, + ssl_cipher:security_parameters(?TLS_NULL_WITH_NULL_NULL, + SecParams). empty_connection_state(ConnectionEnd) -> SecParams = empty_security_params(ConnectionEnd), @@ -689,7 +693,7 @@ hash_and_bump_seqno(#connection_state{sequence_number = SeqNo, check_hash(_, _) -> ok. %% TODO check this -mac_hash(?NULL, {_,_}, _MacSecret, _SeqNo, _Type, +mac_hash({_,_}, ?NULL, _MacSecret, _SeqNo, _Type, _Length, _Fragment) -> <<>>; mac_hash({3, 0}, MacAlg, MacSecret, SeqNo, Type, Length, Fragment) -> diff --git a/lib/ssl/src/ssl_ssl3.erl b/lib/ssl/src/ssl_ssl3.erl index df809ce275..1bf8c2b458 100644 --- a/lib/ssl/src/ssl_ssl3.erl +++ b/lib/ssl/src/ssl_ssl3.erl @@ -30,7 +30,7 @@ -include("ssl_record.hrl"). % MD5 and SHA -export([master_secret/3, finished/3, certificate_verify/3, - mac_hash/6, setup_keys/8, + mac_hash/6, setup_keys/7, suites/0]). -compile(inline). @@ -76,7 +76,7 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> <<MD5/binary, SHA/binary>>. certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) - when Algorithm == rsa; Algorithm == dh_rsa; Algorithm == dhe_rsa -> + when Algorithm == rsa; Algorithm == dhe_rsa -> %% md5_hash %% MD5(master_secret + pad_2 + %% MD5(handshake_messages + master_secret + pad_1)); @@ -88,8 +88,7 @@ certificate_verify(Algorithm, MasterSecret, {MD5Hash, SHAHash}) SHA = handshake_hash(?SHA, MasterSecret, undefined, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, MasterSecret, {_, SHAHash}) - when Algorithm == dh_dss; Algorithm == dhe_dss -> +certificate_verify(dhe_dss, MasterSecret, {_, SHAHash}) -> %% sha_hash %% SHA(master_secret + pad_2 + %% SHA(handshake_messages + master_secret + pad_1)); @@ -114,9 +113,7 @@ mac_hash(Method, Mac_write_secret, Seq_num, Type, Length, Fragment) -> ?DBG_HEX(Mac), Mac. -setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, - HS, KML, _EKML, IVS) - when Exportable == no_export; Exportable == ignore -> +setup_keys(MasterSecret, ServerRandom, ClientRandom, HS, KML, _EKML, IVS) -> KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, 2*(HS+KML+IVS)), %% draft-ietf-tls-ssl-version3-00 - 6.2.2 @@ -137,47 +134,7 @@ setup_keys(Exportable, MasterSecret, ServerRandom, ClientRandom, ?DBG_HEX(ClientIV), ?DBG_HEX(ServerIV), {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, ClientIV, ServerIV}; - -setup_keys(export, MasterSecret, ServerRandom, ClientRandom, - HS, KML, EKML, IVS) -> - KeyBlock = generate_keyblock(MasterSecret, ServerRandom, ClientRandom, - 2*(HS+KML)), - %% draft-ietf-tls-ssl-version3-00 - 6.2.2 - %% Exportable encryption algorithms (for which - %% CipherSpec.is_exportable is true) require additional processing as - %% follows to derive their final write keys: - - %% final_client_write_key = MD5(client_write_key + - %% ClientHello.random + - %% ServerHello.random); - %% final_server_write_key = MD5(server_write_key + - %% ServerHello.random + - %% ClientHello.random); - - %% Exportable encryption algorithms derive their IVs from the random - %% messages: - %% client_write_IV = MD5(ClientHello.random + ServerHello.random); - %% server_write_IV = MD5(ServerHello.random + ClientHello.random); - - <<ClientWriteMacSecret:HS/binary, ServerWriteMacSecret:HS/binary, - ClientWriteKey:KML/binary, ServerWriteKey:KML/binary>> = KeyBlock, - <<ClientIV:IVS/binary, _/binary>> = - hash(?MD5, [ClientRandom, ServerRandom]), - <<ServerIV:IVS/binary, _/binary>> = - hash(?MD5, [ServerRandom, ClientRandom]), - <<FinalClientWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ClientWriteKey, ClientRandom, ServerRandom]), - <<FinalServerWriteKey:EKML/binary, _/binary>> = - hash(?MD5, [ServerWriteKey, ServerRandom, ClientRandom]), - ?DBG_HEX(ClientWriteMacSecret), - ?DBG_HEX(ServerWriteMacSecret), - ?DBG_HEX(FinalClientWriteKey), - ?DBG_HEX(FinalServerWriteKey), - ?DBG_HEX(ClientIV), - ?DBG_HEX(ServerIV), - {ClientWriteMacSecret, ServerWriteMacSecret, FinalClientWriteKey, - FinalServerWriteKey, ClientIV, ServerIV}. + ServerWriteKey, ClientIV, ServerIV}. suites() -> [ @@ -191,25 +148,12 @@ suites() -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, %% ?TLS_RSA_WITH_IDEA_CBC_SHA, Not supported: in later openssl version than OTP requires - ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -269,8 +213,7 @@ handshake_hash(Method, MasterSecret, Sender, HandshakeHash) -> hash(Method, [MasterSecret, pad_2(Method), InnerHash]). get_sender(client) -> "CLNT"; -get_sender(server) -> "SRVR"; -get_sender(none) -> "". +get_sender(server) -> "SRVR". generate_keyblock(MasterSecret, ServerRandom, ClientRandom, WantedLength) -> gen(MasterSecret, [MasterSecret, ServerRandom, ClientRandom], diff --git a/lib/ssl/src/ssl_tls1.erl b/lib/ssl/src/ssl_tls1.erl index ce9a135168..900b8e166d 100644 --- a/lib/ssl/src/ssl_tls1.erl +++ b/lib/ssl/src/ssl_tls1.erl @@ -30,7 +30,7 @@ -include("ssl_debug.hrl"). -export([master_secret/3, finished/3, certificate_verify/2, mac_hash/7, - setup_keys/5, setup_keys/6, suites/0]). + setup_keys/6, suites/0]). %%==================================================================== %% Internal application API @@ -58,14 +58,12 @@ finished(Role, MasterSecret, {MD5Hash, SHAHash}) -> certificate_verify(Algorithm, {MD5Hash, SHAHash}) when Algorithm == rsa; - Algorithm == dh_rsa; Algorithm == dhe_rsa -> MD5 = hash_final(?MD5, MD5Hash), SHA = hash_final(?SHA, SHAHash), <<MD5/binary, SHA/binary>>; -certificate_verify(Algorithm, {_, SHAHash}) when Algorithm == dh_dss; - Algorithm == dhe_dss -> +certificate_verify(dhe_dss, {_, SHAHash}) -> hash_final(?SHA, SHAHash). setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, @@ -92,26 +90,27 @@ setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, ServerWriteKey, ClientIV, ServerIV}. -setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> - %% RFC 4346 - 6.3. Key calculation - %% key_block = PRF(SecurityParameters.master_secret, - %% "key expansion", - %% SecurityParameters.server_random + - %% SecurityParameters.client_random); - %% Then the key_block is partitioned as follows: - %% client_write_MAC_secret[SecurityParameters.hash_size] - %% server_write_MAC_secret[SecurityParameters.hash_size] - %% client_write_key[SecurityParameters.key_material_length] - %% server_write_key[SecurityParameters.key_material_length] - WantedLength = 2 * (HashSize + KeyMatLen), - KeyBlock = prf(MasterSecret, "key expansion", - [ServerRandom, ClientRandom], WantedLength), - <<ClientWriteMacSecret:HashSize/binary, - ServerWriteMacSecret:HashSize/binary, - ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> - = KeyBlock, - {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, - ServerWriteKey, undefined, undefined}. +%% TLS v1.1 uncomment when supported. +%% setup_keys(MasterSecret, ServerRandom, ClientRandom, HashSize, KeyMatLen) -> +%% %% RFC 4346 - 6.3. Key calculation +%% %% key_block = PRF(SecurityParameters.master_secret, +%% %% "key expansion", +%% %% SecurityParameters.server_random + +%% %% SecurityParameters.client_random); +%% %% Then the key_block is partitioned as follows: +%% %% client_write_MAC_secret[SecurityParameters.hash_size] +%% %% server_write_MAC_secret[SecurityParameters.hash_size] +%% %% client_write_key[SecurityParameters.key_material_length] +%% %% server_write_key[SecurityParameters.key_material_length] +%% WantedLength = 2 * (HashSize + KeyMatLen), +%% KeyBlock = prf(MasterSecret, "key expansion", +%% [ServerRandom, ClientRandom], WantedLength), +%% <<ClientWriteMacSecret:HashSize/binary, +%% ServerWriteMacSecret:HashSize/binary, +%% ClientWriteKey:KeyMatLen/binary, ServerWriteKey:KeyMatLen/binary>> +%% = KeyBlock, +%% {ClientWriteMacSecret, ServerWriteMacSecret, ClientWriteKey, +%% ServerWriteKey, undefined, undefined}. mac_hash(Method, Mac_write_secret, Seq_num, Type, {Major, Minor}, Length, Fragment) -> @@ -140,30 +139,18 @@ suites() -> %%?TLS_DHE_DSS_WITH_AES_256_CBC_SHA, ?TLS_RSA_WITH_AES_256_CBC_SHA, ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + %%?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, ?TLS_RSA_WITH_3DES_EDE_CBC_SHA, ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, - %% ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, + %%?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, TODO: Support this? - %% ?TLS_RSA_WITH_IDEA_CBC_SHA, + %%?TLS_DHE_DSS_WITH_RC4_128_SHA, + %%?TLS_RSA_WITH_IDEA_CBC_SHA, ?TLS_RSA_WITH_RC4_128_SHA, ?TLS_RSA_WITH_RC4_128_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_RC2_CBC_56_MD5, - %%?TLS_RSA_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_DES_CBC_SHA, - %%?TLS_RSA_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_EXPORT1024_WITH_RC4_56_SHA, - %%?TLS_DHE_DSS_WITH_RC4_128_SHA, - %%?TLS_DHE_RSA_WITH_DES_CBC_SHA, - %% EDH-DSS-DES-CBC-SHA TODO: ?? + ?TLS_DHE_RSA_WITH_DES_CBC_SHA, + %%TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA ?TLS_RSA_WITH_DES_CBC_SHA - %% ?TLS_DHE_RSA_EXPORT_WITH_DES40_CBC_SHA, - %% ?TLS_DHE_DSS_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_DES40_CBC_SHA, - %%?TLS_RSA_EXPORT_WITH_RC2_CBC_40_MD5, - %%?TLS_RSA_EXPORT_WITH_RC4_40_MD5 ]. %%-------------------------------------------------------------------- @@ -245,7 +232,3 @@ hash_final(?MD5, Conntext) -> crypto:md5_final(Conntext); hash_final(?SHA, Conntext) -> crypto:sha_final(Conntext). - - - - diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 7ca906363f..ab0a394f93 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -27,13 +27,13 @@ -include("test_server.hrl"). -include("test_server_line.hrl"). -include_lib("public_key/include/public_key.hrl"). +-include("ssl_alert.hrl"). -define('24H_in_sec', 86400). -define(TIMEOUT, 60000). -define(EXPIRE, 10). -define(SLEEP, 500). - -behaviour(ssl_session_cache_api). %% For the session cache tests @@ -98,6 +98,37 @@ init_per_testcase(reuse_session_expired, Config0) -> ssl:start(), [{watchdog, Dog} | Config]; +init_per_testcase(no_authority_key_identifier, Config) -> + %% Clear cach so that root cert will not + %% be found. + ssl:stop(), + ssl:start(), + Config; + +init_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names -> + ssl:stop(), + application:load(ssl), + application:set_env(ssl, protocol_version, sslv3), + ssl:start(), + Config; + +init_per_testcase(protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, [sslv2, sslv3, tlsv1]), + ssl:start(), + Config; + +init_per_testcase(empty_protocol_versions, Config) -> + ssl:stop(), + application:load(ssl), + %% For backwards compatibility sslv2 should be filtered out. + application:set_env(ssl, protocol_version, []), + ssl:start(), + Config; + init_per_testcase(_TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = test_server:timetrap(?TIMEOUT), @@ -130,6 +161,12 @@ end_per_testcase(session_cache_process_mnesia, Config) -> end_per_testcase(reuse_session_expired, Config) -> application:unset_env(ssl, session_lifetime), end_per_testcase(default_action, Config); +end_per_testcase(TestCase, Config) when TestCase == ciphers_ssl3; + TestCase == ciphers_ssl3_openssl_names; + TestCase == protocol_versions; + TestCase == empty_protocol_versions-> + application:unset_env(ssl, protocol_version), + end_per_testcase(default_action, Config); end_per_testcase(_TestCase, Config) -> Dog = ?config(watchdog, Config), case Dog of @@ -151,30 +188,31 @@ all(doc) -> ["Test the basic ssl functionality"]; all(suite) -> - [app, connection_info, controlling_process, controller_dies, - client_closes_socket, - peercert, connect_dist, - peername, sockname, socket_options, misc_ssl_options, versions, cipher_suites, - upgrade, upgrade_with_timeout, tcp_connect, - ipv6, ekeyfile, ecertfile, ecacertfile, eoptions, shutdown, - shutdown_write, shutdown_both, shutdown_error, ciphers, - send_close, close_transport_accept, dh_params, - server_verify_peer_passive, - server_verify_peer_active, server_verify_peer_active_once, - server_verify_none_passive, server_verify_none_active, - server_verify_none_active_once, server_verify_no_cacerts, - server_require_peer_cert_ok, server_require_peer_cert_fail, - server_verify_client_once_passive, - server_verify_client_once_active, - server_verify_client_once_active_once, - client_verify_none_passive, - client_verify_none_active, client_verify_none_active_once - %%, session_cache_process_list, session_cache_process_mnesia - ,reuse_session, reuse_session_expired, server_does_not_want_to_reuse_session, - client_renegotiate, server_renegotiate, client_renegotiate_reused_session, - server_renegotiate_reused_session, - client_no_wrap_sequence_number, server_no_wrap_sequence_number, - extended_key_usage, validate_extensions_fun + [app, alerts, connection_info, protocol_versions, + empty_protocol_versions, controlling_process, controller_dies, + client_closes_socket, peercert, connect_dist, peername, sockname, + socket_options, misc_ssl_options, versions, cipher_suites, + upgrade, upgrade_with_timeout, tcp_connect, ipv6, ekeyfile, + ecertfile, ecacertfile, eoptions, shutdown, shutdown_write, + shutdown_both, shutdown_error, ciphers, ciphers_ssl3, + ciphers_openssl_names, ciphers_ssl3_openssl_names, send_close, + close_transport_accept, dh_params, server_verify_peer_passive, + server_verify_peer_active, server_verify_peer_active_once, + server_verify_none_passive, server_verify_none_active, + server_verify_none_active_once, server_verify_no_cacerts, + server_require_peer_cert_ok, server_require_peer_cert_fail, + server_verify_client_once_passive, + server_verify_client_once_active, + server_verify_client_once_active_once, client_verify_none_passive, + client_verify_none_active, client_verify_none_active_once, + %session_cache_process_list, session_cache_process_mnesia, + reuse_session, reuse_session_expired, + server_does_not_want_to_reuse_session, client_renegotiate, + server_renegotiate, client_renegotiate_reused_session, + server_renegotiate_reused_session, client_no_wrap_sequence_number, + server_no_wrap_sequence_number, extended_key_usage, + validate_extensions_fun, no_authority_key_identifier, + invalid_signature_client, invalid_signature_server, cert_expired ]. %% Test cases starts here. @@ -185,7 +223,31 @@ app(suite) -> []; app(Config) when is_list(Config) -> ok = test_server:app_test(ssl). - +%%-------------------------------------------------------------------- +alerts(doc) -> + "Test ssl_alert:alert_txt/1"; +alerts(suite) -> + []; +alerts(Config) when is_list(Config) -> + Descriptions = [?CLOSE_NOTIFY, ?UNEXPECTED_MESSAGE, ?BAD_RECORD_MAC, + ?DECRYPTION_FAILED, ?RECORD_OVERFLOW, ?DECOMPRESSION_FAILURE, + ?HANDSHAKE_FAILURE, ?BAD_CERTIFICATE, ?UNSUPPORTED_CERTIFICATE, + ?CERTIFICATE_REVOKED,?CERTIFICATE_EXPIRED, ?CERTIFICATE_UNKNOWN, + ?ILLEGAL_PARAMETER, ?UNKNOWN_CA, ?ACCESS_DENIED, ?DECODE_ERROR, + ?DECRYPT_ERROR, ?EXPORT_RESTRICTION, ?PROTOCOL_VERSION, + ?INSUFFICIENT_SECURITY, ?INTERNAL_ERROR, ?USER_CANCELED, + ?NO_RENEGOTIATION], + Alerts = [?ALERT_REC(?WARNING, ?CLOSE_NOTIFY) | + [?ALERT_REC(?FATAL, Desc) || Desc <- Descriptions]], + lists:foreach(fun(Alert) -> + case ssl_alert:alert_txt(Alert) of + Txt when is_list(Txt) -> + ok; + Other -> + test_server:fail({unexpected, Other}) + end + end, Alerts). +%%-------------------------------------------------------------------- connection_info(doc) -> ["Test the API function ssl:connection_info/1"]; connection_info(suite) -> @@ -214,7 +276,7 @@ connection_info(Config) when is_list(Config) -> Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha,no_export}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -226,6 +288,49 @@ connection_info_result(Socket) -> %%-------------------------------------------------------------------- +protocol_versions(doc) -> + ["Test to set a list of protocol versions in app environment."]; + +protocol_versions(suite) -> + []; + +protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + +empty_protocol_versions(doc) -> + ["Test to set an empty list of protocol versions in app environment."]; + +empty_protocol_versions(suite) -> + []; + +empty_protocol_versions(Config) when is_list(Config) -> + basic_test(Config). + + +basic_test(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, ClientOpts}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + controlling_process(doc) -> ["Test API function controlling_process/2"]; @@ -283,7 +388,7 @@ controlling_process_result(Socket, Pid, Msg) -> ssl:send(Socket, Msg), no_result_msg. - +%%-------------------------------------------------------------------- controller_dies(doc) -> ["Test that the socket is closed after controlling process dies"]; controller_dies(suite) -> []; @@ -598,9 +703,12 @@ cipher_suites(suite) -> []; cipher_suites(Config) when is_list(Config) -> - MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha,no_export}, + MandatoryCipherSuite = {rsa,'3des_ede_cbc',sha}, [_|_] = Suites = ssl:cipher_suites(), - true = lists:member(MandatoryCipherSuite, Suites). + true = lists:member(MandatoryCipherSuite, Suites), + Suites = ssl:cipher_suites(erlang), + [_|_] =ssl:cipher_suites(openssl). + %%-------------------------------------------------------------------- socket_options(doc) -> ["Test API function getopts/2 and setopts/2"]; @@ -635,9 +743,16 @@ socket_options(Config) when is_list(Config) -> {options, ClientOpts}]), ssl_test_lib:check_result(Server, ok, Client, ok), - + ssl_test_lib:close(Server), - ssl_test_lib:close(Client). + ssl_test_lib:close(Client), + + {ok, Listen} = ssl:listen(0, ServerOpts), + {ok,[{mode,list}]} = ssl:getopts(Listen, [mode]), + ok = ssl:setopts(Listen, [{mode, binary}]), + {ok,[{mode, binary}]} = ssl:getopts(Listen, [mode]), + {ok,[{recbuf, _}]} = ssl:getopts(Listen, [recbuf]), + ssl:close(Listen). socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> %% Test get/set emulated opts @@ -646,6 +761,8 @@ socket_options_result(Socket, Options, DefaultValues, NewOptions, NewValues) -> {ok, NewValues} = ssl:getopts(Socket, NewOptions), %% Test get/set inet opts {ok,[{nodelay,false}]} = ssl:getopts(Socket, [nodelay]), + ssl:setopts(Socket, [{nodelay, true}]), + {ok,[{nodelay, true}]} = ssl:getopts(Socket, [nodelay]), ok. %%-------------------------------------------------------------------- @@ -1272,9 +1389,9 @@ shutdown_error(Config) when is_list(Config) -> ok = ssl:close(Listen), {error, closed} = ssl:shutdown(Listen, read_write). -%%-------------------------------------------------------------------- +%%------------------------------------------------------------------- ciphers(doc) -> - [""]; + ["Test all ssl cipher suites in highest support ssl/tls version"]; ciphers(suite) -> []; @@ -1284,6 +1401,7 @@ ciphers(Config) when is_list(Config) -> ssl_record:protocol_version(ssl_record:highest_protocol_version([])), Ciphers = ssl:cipher_suites(), + test_server:format("tls1 erlang cipher suites ~p~n", [Ciphers]), Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config) end, Ciphers), @@ -1294,7 +1412,74 @@ ciphers(Config) when is_list(Config) -> test_server:format("Cipher suite errors: ~p~n", [Error]), test_server:fail(cipher_suite_failed_see_test_case_log) end. - + +ciphers_ssl3(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3(suite) -> + []; + +ciphers_ssl3(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version({3,0}), + + Ciphers = ssl:cipher_suites(), + test_server:format("ssl3 erlang cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + +ciphers_openssl_names(doc) -> + ["Test all ssl cipher suites in highest support ssl/tls version"]; + +ciphers_openssl_names(suite) -> + []; + +ciphers_openssl_names(Config) when is_list(Config) -> + Version = + ssl_record:protocol_version(ssl_record:highest_protocol_version([])), + + Ciphers = ssl:cipher_suites(openssl), + test_server:format("tls1 openssl cipher suites ~p~n", [Ciphers]), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + + +ciphers_ssl3_openssl_names(doc) -> + ["Test all ssl cipher suites in ssl3"]; + +ciphers_ssl3_openssl_names(suite) -> + []; + +ciphers_ssl3_openssl_names(Config) when is_list(Config) -> + Version = ssl_record:protocol_version({3,0}), + Ciphers = ssl:cipher_suites(openssl), + Result = lists:map(fun(Cipher) -> + cipher(Cipher, Version, Config) end, + Ciphers), + case lists:flatten(Result) of + [] -> + ok; + Error -> + test_server:format("Cipher suite errors: ~p~n", [Error]), + test_server:fail(cipher_suite_failed_see_test_case_log) + end. + cipher(CipherSuite, Version, Config) -> process_flag(trap_exit, true), test_server:format("Testing CipherSuite ~p~n", [CipherSuite]), @@ -1314,7 +1499,9 @@ cipher(CipherSuite, Version, Config) -> [{ciphers,[CipherSuite]} | ClientOpts]}]), - ServerMsg = ClientMsg = {ok, {Version, CipherSuite}}, + ErlangCipherSuite = erlang_cipher_suite(CipherSuite), + + ServerMsg = ClientMsg = {ok, {Version, ErlangCipherSuite}}, Result = ssl_test_lib:wait_for_result(Server, ServerMsg, Client, ClientMsg), @@ -1333,9 +1520,14 @@ cipher(CipherSuite, Version, Config) -> ok -> []; Error -> - [{CipherSuite, Error}] + [{ErlangCipherSuite, Error}] end. +erlang_cipher_suite(Suite) when is_list(Suite)-> + ssl_cipher:suite_definition(ssl_cipher:openssl_suite(Suite)); +erlang_cipher_suite(Suite) -> + Suite. + %%-------------------------------------------------------------------- reuse_session(doc) -> ["Test reuse of sessions (short handshake)"]; @@ -2273,7 +2465,7 @@ extended_key_usage(Config) when is_list(Config) -> ServerOpts = ?config(server_verification_opts, Config), PrivDir = ?config(priv_dir, Config), - KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), {ok, Key} = public_key:decode_private_key(KeyInfo), @@ -2316,7 +2508,7 @@ extended_key_usage(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {mfa, {?MODULE, send_recv_result_active, []}}, - {options, NewClientOpts}]), + {options, [{verify, verify_peer} | NewClientOpts]}]), ssl_test_lib:check_result(Server, ok, Client, ok), @@ -2359,6 +2551,217 @@ validate_extensions_fun(Config) when is_list(Config) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +no_authority_key_identifier(doc) -> + ["Test cert that does not have authorityKeyIdentifier extension"]; + +no_authority_key_identifier(suite) -> + []; +no_authority_key_identifier(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(CertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + Extensions = OTPTbsCert#'OTPTBSCertificate'.extensions, + NewExtensions = delete_authority_key_extension(Extensions, []), + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{extensions = NewExtensions}, + + test_server:format("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + NewDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewCertFile, [{cert, NewDerCert}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, ok, Client, ok), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +delete_authority_key_extension([], Acc) -> + lists:reverse(Acc); +delete_authority_key_extension([#'Extension'{extnID = ?'id-ce-authorityKeyIdentifier'} | Rest], + Acc) -> + delete_authority_key_extension(Rest, Acc); +delete_authority_key_extension([Head | Rest], Acc) -> + delete_authority_key_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + +invalid_signature_server(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_server(suite) -> + []; + +invalid_signature_server(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "server/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/invalid_cert.pem"), + {ok, [{cert, ServerDerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, ServerOTPCert} = public_key:pkix_decode_cert(ServerDerCert, otp), + ServerOTPTbsCert = ServerOTPCert#'OTPCertificate'.tbsCertificate, + NewServerDerCert = public_key:sign(ServerOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- + +invalid_signature_client(doc) -> + ["Test server with invalid signature"]; + +invalid_signature_client(suite) -> + []; + +invalid_signature_client(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "client/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ClientCertFile = proplists:get_value(certfile, ClientOpts), + NewClientCertFile = filename:join(PrivDir, "client/invalid_cert.pem"), + {ok, [{cert, ClientDerCert, _}]} = public_key:pem_to_der(ClientCertFile), + {ok, ClientOTPCert} = public_key:pkix_decode_cert(ClientDerCert, otp), + ClientOTPTbsCert = ClientOTPCert#'OTPCertificate'.tbsCertificate, + NewClientDerCert = public_key:sign(ClientOTPTbsCert, Key), + public_key:der_to_pem(NewClientCertFile, [{cert, NewClientDerCert}]), + NewClientOpts = [{certfile, NewClientCertFile} | proplists:delete(certfile, ClientOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, [{verify, verify_peer} | ServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, NewClientOpts}]), + + ssl_test_lib:check_result(Server, {error, "bad certificate"}, + Client, {error,"bad certificate"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +%%-------------------------------------------------------------------- +cert_expired(doc) -> + ["Test server with invalid signature"]; + +cert_expired(suite) -> + []; + +cert_expired(Config) when is_list(Config) -> + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + {ok, [KeyInfo]} = public_key:pem_to_der(KeyFile), + {ok, Key} = public_key:decode_private_key(KeyInfo), + + ServerCertFile = proplists:get_value(certfile, ServerOpts), + NewServerCertFile = filename:join(PrivDir, "server/expired_cert.pem"), + {ok, [{cert, DerCert, _}]} = public_key:pem_to_der(ServerCertFile), + {ok, OTPCert} = public_key:pkix_decode_cert(DerCert, otp), + OTPTbsCert = OTPCert#'OTPCertificate'.tbsCertificate, + + {Year, Month, Day} = date(), + {Hours, Min, Sec} = time(), + NotBeforeStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-2, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NotAfterStr = lists:flatten(io_lib:format("~p~s~s~s~s~sZ",[Year-1, + two_digits_str(Month), + two_digits_str(Day), + two_digits_str(Hours), + two_digits_str(Min), + two_digits_str(Sec)])), + NewValidity = {'Validity', {generalTime, NotBeforeStr}, {generalTime, NotAfterStr}}, + + test_server:format("Validity: ~p ~n NewValidity: ~p ~n", + [OTPTbsCert#'OTPTBSCertificate'.validity, NewValidity]), + + NewOTPTbsCert = OTPTbsCert#'OTPTBSCertificate'{validity = NewValidity}, + NewServerDerCert = public_key:sign(NewOTPTbsCert, Key), + public_key:der_to_pem(NewServerCertFile, [{cert, NewServerDerCert}]), + NewServerOpts = [{certfile, NewServerCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, NewServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, [{verify, verify_peer} | ClientOpts]}]), + + ssl_test_lib:check_result(Server, {error, "certificate expired"}, + Client, {error, "certificate expired"}), + + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + + +two_digits_str(N) when N < 10 -> + lists:flatten(io_lib:format("0~p", [N])); +two_digits_str(N) -> + lists:flatten(io_lib:format("~p", [N])). + +%%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- send_recv_result(Socket) -> diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 03466aec6f..82073c0735 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -33,6 +33,7 @@ -define(OPENSSL_RENEGOTIATE, "r\n"). -define(OPENSSL_QUIT, "Q\n"). -define(OPENSSL_GARBAGE, "P\n"). +-define(EXPIRE, 10). %% Test server callback functions %%-------------------------------------------------------------------- @@ -81,6 +82,15 @@ end_per_suite(_Config) -> %% variable, but should NOT alter/remove any existing entries. %% Description: Initialization before each test case %%-------------------------------------------------------------------- +init_per_testcase(expired_session, Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5), + ssl:stop(), + application:load(ssl), + application:set_env(ssl, session_lifetime, ?EXPIRE), + ssl:start(), + [{watchdog, Dog} | Config]; + init_per_testcase(TestCase, Config0) -> Config = lists:keydelete(watchdog, 1, Config0), Dog = ssl_test_lib:timetrap(?TIMEOUT), @@ -103,14 +113,20 @@ special_init(_, Config) -> %% A list of key/value pairs, holding the test case configuration. %% Description: Cleanup after each test case %%-------------------------------------------------------------------- -end_per_testcase(_TestCase, Config) -> +end_per_testcase(reuse_session_expired, Config) -> + application:unset_env(ssl, session_lifetime), + end_per_testcase(default_action, Config); + +end_per_testcase(default_action, Config) -> Dog = ?config(watchdog, Config), case Dog of undefined -> ok; _ -> test_server:timetrap_cancel(Dog) - end. + end; +end_per_testcase(_, Config) -> + end_per_testcase(default_action, Config). %%-------------------------------------------------------------------- %% Function: all(Clause) -> TestCases @@ -142,7 +158,9 @@ all(suite) -> tls1_erlang_server_openssl_client_client_cert, tls1_erlang_server_erlang_client_client_cert, ciphers, - erlang_client_bad_openssl_server + erlang_client_bad_openssl_server, + expired_session, + ssl2_erlang_server_openssl_client ]. %% Test cases starts here. @@ -991,6 +1009,100 @@ erlang_client_bad_openssl_server(Config) when is_list(Config) -> close_port(OpensslPort), process_flag(trap_exit, false), ok. + +%%-------------------------------------------------------------------- + +expired_session(doc) -> + ["Test our ssl client handling of expired sessions. Will make" + "better code coverage of the ssl_manager module"]; + +expired_session(suite) -> + []; + +expired_session(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + + Port = ssl_test_lib:inet_port(node()), + CertFile = proplists:get_value(certfile, ServerOpts), + KeyFile = proplists:get_value(keyfile, ServerOpts), + + Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++ + " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpensslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + + wait_for_openssl_server(), + + Client0 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client0), + + %% Make sure session is registered + test_server:sleep(?SLEEP), + + Client1 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + ssl_test_lib:close(Client1), + %% Make sure session is unregistered due to expiration + test_server:sleep((?EXPIRE+1) * 1000), + + Client2 = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + close_port(OpensslPort), + ssl_test_lib:close(Client2), + process_flag(trap_exit, false). + +%%-------------------------------------------------------------------- +ssl2_erlang_server_openssl_client(doc) -> + ["Test that ssl v2 clients are rejected"]; +ssl2_erlang_server_openssl_client(suite) -> + []; +ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ServerOpts = ?config(server_opts, Config), + + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + + Data = "From openssl to erlang", + + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + + Cmd = "openssl s_client -port " ++ integer_to_list(Port) ++ + " -host localhost -ssl2 -msg", + + test_server:format("openssl cmd: ~p~n", [Cmd]), + + OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]), + port_command(OpenSslPort, Data), + + ssl_test_lib:check_result(Server, {error,"protocol version"}), + + ssl_test_lib:close(Server), + + close_port(OpenSslPort), + process_flag(trap_exit, false), + ok. + %%-------------------------------------------------------------------- erlang_ssl_receive(Socket, Data) -> diff --git a/lib/stdlib/doc/src/binary.xml b/lib/stdlib/doc/src/binary.xml index 05ec4406c6..c5eb81a86a 100644 --- a/lib/stdlib/doc/src/binary.xml +++ b/lib/stdlib/doc/src/binary.xml @@ -387,7 +387,7 @@ <p>Even though <c><<"cd">></c> ends before <c><<"bcde">></c>, <c><<"bcde">></c> begins first and is therefore the first match. If two - overlapping matches begins at the same position, the longest is + overlapping matches begin at the same position, the longest is returned.</p> <p>Summary of the options:</p> @@ -634,7 +634,7 @@ store(Binary, GBSet) -> <p>If any position given in <c>InsPos</c> is greater than the size of the replacement binary, a <c>badarg</c> exception is raised.</p> - <p>The options <c>global</c> and <c>{scope, part()}</c> works as for <seealso marker="#split-3">split/3</seealso>. The return type is always a <c>binary()</c>.</p> + <p>The options <c>global</c> and <c>{scope, part()}</c> work as for <seealso marker="#split-3">split/3</seealso>. The return type is always a <c>binary()</c>.</p> <p>For a description of <c>Pattern</c>, see <seealso marker="#compile_pattern-1">compile_pattern/1</seealso>.</p> </desc> diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml index df09294de6..2234a62ac3 100644 --- a/lib/stdlib/doc/src/gen_event.xml +++ b/lib/stdlib/doc/src/gen_event.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>gen_event</title> @@ -630,12 +630,66 @@ gen_event:stop -----> Module:terminate/2 <p>The function should return the updated internal state.</p> </desc> </func> + <func> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> + <fsummary>Optional function for providing a term describing the + current event handler state.</fsummary> + <type> + <v>Opt = normal | terminate</v> + <v>PDict = [{Key, Value}]</v> + <v>State = term()</v> + <v>Status = term()</v> + </type> + <desc> + <note> + <p>This callback is optional, so event handler modules need + not export it. If a handler does not export this function, + the gen_event module uses the handler state directly for + the purposes described below.</p> + </note> + <p>This function is called by a gen_event process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_event status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The event handler terminates abnormally and gen_event + logs an error. <c>Opt</c> is set to the + atom <c>terminate</c> for this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the event handler state for these cases. An + event handler callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its state appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current state of the event handler.</p> + <p><c>PDict</c> is the current value of the gen_event's + process dictionary.</p> + <p><c>State</c> is the internal state of the event + handler.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state of the event + handler. Any term is allowed for <c>Status</c>. The + gen_event module uses <c>Status</c> as follows:</p> + <list typed="bulleted"> + <item>When <c>sys:get_status/1,2</c> is called, gen_event + ensures that its return value contains <c>Status</c> in + place of the event handler's actual state term.</item> + <item>When an event handler terminates abnormally, gen_event + logs <c>Status</c> in place of the event handler's actual + state term.</item> + </list> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> + </desc> + </func> </funcs> <section> <title>SEE ALSO</title> - <p><seealso marker="supervisor">supervisor(3)</seealso>, + <p><seealso marker="supervisor">supervisor(3)</seealso>, <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml index 739cd0bffd..d15383c621 100644 --- a/lib/stdlib/doc/src/gen_fsm.xml +++ b/lib/stdlib/doc/src/gen_fsm.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>gen_fsm</title> @@ -730,33 +730,58 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, StateData]) -> Status</name> + <name>Module:format_status(Opt, [PDict, StateData]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_fsm status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>StateData = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_fsm module provides a default - implementation of this function that returns the callback - module state data.</em></p> - <p>This function is called by a gen_fsm process when one - of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_fsm status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_fsm.</p> + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_fsm module provides a default + implementation of this function that returns the callback + module state data.</p> + </note> + <p>This function is called by a gen_fsm process when:</p> + <list typed="bulleted"> + <item>One + of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> + is invoked to get the gen_fsm status. <c>Opt</c> is set to + the atom <c>normal</c> for this case.</item> + <item>The gen_fsm terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for + this case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_fsm status for these cases. A callback + module wishing to customise the <c>sys:get_status/1,2</c> + return value as well as how its status appears in + termination error logs exports an instance + of <c>format_status/2</c> that returns a term describing the + current status of the gen_fsm.</p> <p><c>PDict</c> is the current value of the gen_fsm's process dictionary.</p> <p><c>StateData</c> is the internal state data of the gen_fsm.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_fsm.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_fsm. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"StateData", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_fsm state data. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state data representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> @@ -770,4 +795,3 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4 <seealso marker="sys">sys(3)</seealso></p> </section> </erlref> - diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml index 30c04d1d52..1045766e01 100644 --- a/lib/stdlib/doc/src/gen_server.xml +++ b/lib/stdlib/doc/src/gen_server.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -13,12 +13,12 @@ compliance with the License. You should have received a copy of the Erlang Public License along with this software. If not, it can be retrieved online at http://www.erlang.org/. - + Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for the specific language governing rights and limitations under the License. - + </legalnotice> <title>gen_server</title> @@ -599,32 +599,57 @@ gen_server:abcast -----> Module:handle_cast/2 </desc> </func> <func> - <name>Module:format_status(normal, [PDict, State]) -> Status</name> + <name>Module:format_status(Opt, [PDict, State]) -> Status</name> <fsummary>Optional function for providing a term describing the current gen_server status.</fsummary> <type> + <v>Opt = normal | terminate</v> <v>PDict = [{Key, Value}]</v> <v>State = term()</v> - <v>Status = [term()]</v> + <v>Status = term()</v> </type> <desc> - <p><em>This callback is optional, so callback modules need not - export it. The gen_server module provides a default - implementation of this function that returns the callback - module state.</em></p> - <p>This function is called by a gen_server process when one + <note> + <p>This callback is optional, so callback modules need not + export it. The gen_server module provides a default + implementation of this function that returns the callback + module state.</p> + </note> + <p>This function is called by a gen_server process when:</p> + <list typed="bulleted"> + <item>One of <seealso marker="sys#get_status/1">sys:get_status/1,2</seealso> - is invoked to get the gen_server status. A callback module - wishing to customise the <c>sys:get_status/1,2</c> return - value exports an instance of <c>format_status/2</c> that - returns a term describing the current status of the - gen_server.</p> + is invoked to get the gen_server status. <c>Opt</c> is set + to the atom <c>normal</c> for this case.</item> + <item>The gen_server terminates abnormally and logs an + error. <c>Opt</c> is set to the atom <c>terminate</c> for this + case.</item> + </list> + <p>This function is useful for customising the form and + appearance of the gen_server status for these cases. A + callback module wishing to customise + the <c>sys:get_status/1,2</c> return value as well as how + its status appears in termination error logs exports an + instance of <c>format_status/2</c> that returns a term + describing the current status of the gen_server.</p> <p><c>PDict</c> is the current value of the gen_server's process dictionary.</p> <p><c>State</c> is the internal state of the gen_server.</p> - <p>The function should return <c>Status</c>, a list of one or - more terms that customise the details of the current state - and status of the gen_server.</p> + <p>The function should return <c>Status</c>, a term that + customises the details of the current state and status of + the gen_server. There are no restrictions on the + form <c>Status</c> can take, but for + the <c>sys:get_status/1,2</c> case (when <c>Opt</c> + is <c>normal</c>), the recommended form for + the <c>Status</c> value is <c>[{data, [{"State", + Term}]}]</c> where <c>Term</c> provides relevant details of + the gen_server state. Following this recommendation isn't + required, but doing so will make the callback module status + consistent with the rest of the <c>sys:get_status/1,2</c> + return value.</p> + <p>One use for this function is to return compact alternative + state representations to avoid having large state terms + printed in logfiles.</p> </desc> </func> </funcs> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 27ff9441e6..b1e9e3a02f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -677,12 +677,23 @@ report_error(Handler, Reason, State, LastIn, SName) -> _ -> Reason end, + Mod = Handler#handler.module, + FmtState = case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, error_msg("** gen_event handler ~p crashed.~n" "** Was installed in ~p~n" "** Last event was: ~p~n" "** When handler state == ~p~n" "** Reason == ~p~n", - [handler(Handler),SName,LastIn,State,Reason1]). + [handler(Handler),SName,LastIn,FmtState,Reason1]). handler(Handler) when not Handler#handler.id -> Handler#handler.module; @@ -711,10 +722,20 @@ get_modules(MSL) -> %%----------------------------------------------------------------- %% Status information %%----------------------------------------------------------------- -format_status(_Opt, StatusData) -> - [_PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, +format_status(Opt, StatusData) -> + [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, Header = lists:concat(["Status for event handler ", ServerName]), + FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [PDict, State], + case catch Mod:format_status(Opt, Args) of + {'EXIT', _} -> MSL; + Else -> MS#handler{state = Else} + end; + _ -> + MS + end || #handler{module = Mod, state = State} = MS <- MSL], [{header, Header}, {data, [{"Status", SysState}, {"Parent", Parent}]}, - {items, {"Installed handlers", MSL}}]. + {items, {"Installed handlers", FmtMSL}}]. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 9961646418..8d1b46d6ab 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -542,7 +542,18 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, StateName, StateData, Debug), + FmtStateData = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), StateData], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> StateData; + Else -> Else + end; + _ -> + StateData + end, + error_info(Reason,Name,Msg,StateName,FmtStateData,Debug), exit(Reason) end end. @@ -610,15 +621,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for state machine ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"StateData", StateData}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt,[PDict,StateData]) of - {'EXIT', _} -> [{data, [{"StateData", StateData}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"StateData", StateData}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 1c9e5270b6..dc8e7ecd16 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -705,7 +705,18 @@ terminate(Reason, Name, Msg, Mod, State, Debug) -> {shutdown,_}=Shutdown -> exit(Shutdown); _ -> - error_info(Reason, Name, Msg, State, Debug), + FmtState = + case erlang:function_exported(Mod, format_status, 2) of + true -> + Args = [get(), State], + case catch Mod:format_status(terminate, Args) of + {'EXIT', _} -> State; + Else -> Else + end; + _ -> + State + end, + error_info(Reason, Name, Msg, FmtState, Debug), exit(Reason) end end. @@ -836,15 +847,17 @@ format_status(Opt, StatusData) -> end, Header = lists:concat(["Status for generic server ", NameTag]), Log = sys:get_debug(log, Debug, []), - Specfic = + DefaultStatus = [{data, [{"State", State}]}], + Specfic = case erlang:function_exported(Mod, format_status, 2) of true -> case catch Mod:format_status(Opt, [PDict, State]) of - {'EXIT', _} -> [{data, [{"State", State}]}]; - Else -> Else + {'EXIT', _} -> DefaultStatus; + StatusList when is_list(StatusList) -> StatusList; + Else -> [Else] end; _ -> - [{data, [{"State", State}]}] + DefaultStatus end, [{header, Header}, {data, [{"Status", SysState}, diff --git a/lib/stdlib/test/dummy1_h.erl b/lib/stdlib/test/dummy1_h.erl index 4377d774a3..5b503d5984 100644 --- a/lib/stdlib/test/dummy1_h.erl +++ b/lib/stdlib/test/dummy1_h.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(dummy1_h). @@ -21,7 +21,7 @@ %% Test event handler for gen_event_SUITE.erl -export([init/1, handle_event/2, handle_call/2, handle_info/2, - terminate/2]). + terminate/2, format_status/2]). init(make_error) -> {error, my_error}; @@ -67,4 +67,5 @@ terminate(remove_handler, Parent) -> terminate(_Reason, _State) -> ok. - +format_status(_Opt, [_PDict, _State]) -> + "dummy1_h handler state". diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 8cbffaca56..4f7de451e3 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -23,9 +23,11 @@ -export([all/1]). -export([start/1, test_all/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, - notify/1, sync_notify/1, call/1, info/1, hibernate/1]). + notify/1, sync_notify/1, call/1, info/1, hibernate/1, + call_format_status/1, error_format_status/1]). -all(suite) -> {req, [stdlib], [start, test_all, hibernate]}. +all(suite) -> {req, [stdlib], [start, test_all, hibernate, + call_format_status, error_format_status]}. %% -------------------------------------- %% Start an event manager. @@ -844,3 +846,56 @@ info(Config) when is_list(Config) -> ?line ok = gen_event:stop(my_dummy_handler), ok. + +call_format_status(suite) -> + []; +call_format_status(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2"]; +call_format_status(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + %% State here intentionally differs from what we expect from format_status + State = self(), + FmtState = "dummy1_h handler state", + ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [State]), + ?line Status1 = sys:get_status(Pid), + ?line Status2 = sys:get_status(Pid, 5000), + ?line ok = gen_event:stop(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line HandlerInfo1 = proplists:get_value(items, Data1), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo1, + ?line {status, Pid, _, [_, _, Pid, [], Data2]} = Status2, + ?line HandlerInfo2 = proplists:get_value(items, Data2), + ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, + ok. + +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that a handler error calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = self(), + ?line {ok, Pid} = gen_event:start({local, my_dummy_handler}), + ?line ok = gen_event:add_sup_handler(my_dummy_handler, dummy1_h, [State]), + ?line ok = gen_event:notify(my_dummy_handler, do_crash), + ?line receive + {gen_event_EXIT,dummy1_h,{'EXIT',_}} -> ok + after 5000 -> + ?t:fail(exit_gen_event) + end, + FmtState = "dummy1_h handler state", + receive + {error,_GroupLeader, {Pid, + "** gen_event handler"++_, + [dummy1_h,my_dummy_handler,do_crash, + FmtState, _]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + ?line ok = gen_event:stop(Pid), + process_flag(trap_exit, OldFl), + ok. diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 23c1d9a193..d61eeb403b 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %% -module(gen_fsm_SUITE). @@ -30,7 +30,7 @@ -export([shutdown/1]). --export([sys/1, sys1/1, call_format_status/1]). +-export([sys/1, sys1/1, call_format_status/1, error_format_status/1]). -export([hibernate/1,hiber_idle/3,hiber_wakeup/3,hiber_idle/2,hiber_wakeup/2]). @@ -305,7 +305,7 @@ shutdown(Config) when is_list(Config) -> ok. -sys(suite) -> [sys1, call_format_status]. +sys(suite) -> [sys1, call_format_status, error_format_status]. sys1(Config) when is_list(Config) -> ?line {ok, Pid} = @@ -324,6 +324,27 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data), ?line stop_it(Pid). +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + StateData = "called format_status", + ?line {ok, Pid} = gen_fsm:start(gen_fsm_SUITE, {state_data, StateData}, []), + %% bad return value in the gen_fsm loop + ?line {'EXIT',{{bad_return_value, badreturn},_}} = + (catch gen_fsm:sync_send_event(Pid, badreturn)), + receive + {error,_GroupLeader,{Pid, + "** State machine"++_, + [Pid,{_,_,badreturn},idle,StateData,_]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Hibernation hibernate(suite) -> []; @@ -704,6 +725,8 @@ init(hiber) -> {ok, hiber_idle, []}; init(hiber_now) -> {ok, hiber_idle, [], hibernate}; +init({state_data, StateData}) -> + {ok, idle, StateData}; init(_) -> {ok, idle, state_data}. @@ -844,5 +867,7 @@ handle_sync_event(stop_shutdown_reason, _From, _State, Data) -> handle_sync_event({get, _Pid}, _From, State, Data) -> {reply, {state, State, Data}, State, Data}. -format_status(_Opt, [_Pdict, _StateData]) -> +format_status(terminate, [_Pdict, StateData]) -> + StateData; +format_status(normal, [_Pdict, _StateData]) -> [format_status_called]. diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 0f60c2c4ee..0966734c89 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -31,7 +31,7 @@ spec_init_local_registered_parent/1, spec_init_global_registered_parent/1, otp_5854/1, hibernate/1, otp_7669/1, call_format_status/1, - call_with_huge_message_queue/1 + error_format_status/1, call_with_huge_message_queue/1 ]). % spawn export @@ -52,7 +52,8 @@ all(suite) -> call_remote_n2, call_remote_n3, spec_init, spec_init_local_registered_parent, spec_init_global_registered_parent, - otp_5854, hibernate, otp_7669, call_format_status, + otp_5854, hibernate, otp_7669, + call_format_status, error_format_status, call_with_huge_message_queue]. -define(default_timeout, ?t:minutes(1)). @@ -897,7 +898,7 @@ call_format_status(doc) -> ["Test that sys:get_status/1,2 calls format_status/2"]; call_format_status(Config) when is_list(Config) -> ?line {ok, Pid} = gen_server:start_link({local, call_format_status}, - gen_server_SUITE, [], []), + ?MODULE, [], []), ?line Status1 = sys:get_status(call_format_status), ?line {status, Pid, _Mod, [_PDict, running, _Parent, _, Data1]} = Status1, ?line [format_status_called | _] = lists:reverse(Data1), @@ -906,6 +907,35 @@ call_format_status(Config) when is_list(Config) -> ?line [format_status_called | _] = lists:reverse(Data2), ok. +%% Verify that error termination correctly calls our format_status/2 fun +%% +error_format_status(suite) -> + []; +error_format_status(doc) -> + ["Test that an error termination calls format_status/2"]; +error_format_status(Config) when is_list(Config) -> + ?line error_logger_forwarder:register(), + OldFl = process_flag(trap_exit, true), + State = "called format_status", + ?line {ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []), + ?line {'EXIT',{crashed,_}} = (catch gen_server:call(Pid, crash)), + receive + {'EXIT', Pid, crashed} -> + ok + end, + receive + {error,_GroupLeader,{Pid, + "** Generic server"++_, + [Pid,crash,State,crashed]}} -> + ok; + Other -> + ?line io:format("Unexpected: ~p", [Other]), + ?line ?t:fail() + end, + ?t:messages_get(), + process_flag(trap_exit, OldFl), + ok. + %% Test that the time for a huge message queue is not %% significantly slower than with an empty message queue. call_with_huge_message_queue(Config) when is_list(Config) -> @@ -1105,5 +1135,7 @@ terminate({From, stopped_info}, _State) -> terminate(_Reason, _State) -> ok. -format_status(_Opt, [_PDict, _State]) -> - [format_status_called]. +format_status(terminate, [_PDict, State]) -> + State; +format_status(normal, [_PDict, _State]) -> + format_status_called. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 8c3afd7f66..5d6b6c7529 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -885,15 +885,54 @@ files written in other languages than Erlang.") If nil, the inferior shell replaces the window. This is the traditional behaviour.") -(defvar erlang-mode-map nil +(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) + "Non-nil means use `compilation-minor-mode' in Erlang shell.") + +(defvar erlang-mode-map + (let ((map (make-sparse-keymap))) + (unless (boundp 'indent-line-function) + (define-key map "\t" 'erlang-indent-command)) + (define-key map ";" 'erlang-electric-semicolon) + (define-key map "," 'erlang-electric-comma) + (define-key map "<" 'erlang-electric-lt) + (define-key map ">" 'erlang-electric-gt) + (define-key map "\C-m" 'erlang-electric-newline) + (if (not (boundp 'delete-key-deletes-forward)) + (define-key map "\177" 'backward-delete-char-untabify) + (define-key map [(backspace)] 'backward-delete-char-untabify)) + ;;(unless (boundp 'fill-paragraph-function) + (define-key map "\M-q" 'erlang-fill-paragraph) + (unless (boundp 'beginning-of-defun-function) + (define-key map "\M-\C-a" 'erlang-beginning-of-function) + (define-key map "\M-\C-e" 'erlang-end-of-function) + (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\t" 'erlang-complete-tag) + (define-key map "\C-c\M-\t" 'tempo-complete-tag) + (define-key map "\M-+" 'erlang-find-next-tag) + (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) + (define-key map "\C-c\M-b" 'tempo-backward-mark) + (define-key map "\C-c\M-e" 'erlang-end-of-clause) + (define-key map "\C-c\M-f" 'tempo-forward-mark) + (define-key map "\C-c\M-h" 'erlang-mark-clause) + (define-key map "\C-c\C-c" 'comment-region) + (define-key map "\C-c\C-j" 'erlang-generate-new-clause) + (define-key map "\C-c\C-k" 'erlang-compile) + (define-key map "\C-c\C-l" 'erlang-compile-display) + (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) + (define-key map "\C-c\C-q" 'erlang-indent-function) + (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-y" 'erlang-clone-arguments) + (define-key map "\C-c\C-a" 'erlang-align-arrows) + (define-key map "\C-c\C-z" 'erlang-shell-display) + (unless inferior-erlang-use-cmm + (define-key map "\C-x`" 'erlang-next-error)) + map) "*Keymap used in Erlang mode.") (defvar erlang-mode-abbrev-table nil "Abbrev table in use in Erlang-mode buffers.") (defvar erlang-mode-syntax-table nil "Syntax table in use in Erlang-mode buffers.") -(defconst inferior-erlang-use-cmm (boundp 'minor-mode-overriding-map-alist) - "Non-nil means use `compilation-minor-mode' in Erlang shell.") (defvar erlang-skel-file "erlang-skels" @@ -1247,7 +1286,7 @@ Other commands: (setq major-mode 'erlang-mode) (setq mode-name "Erlang") (erlang-syntax-table-init) - (erlang-keymap-init) + (use-local-map erlang-mode-map) (erlang-electric-init) (erlang-menu-init) (erlang-mode-variables) @@ -1302,53 +1341,6 @@ Other commands: (set-syntax-table erlang-mode-syntax-table)) -(defun erlang-keymap-init () - (if erlang-mode-map - nil - (setq erlang-mode-map (make-sparse-keymap)) - (erlang-mode-commands erlang-mode-map)) - (use-local-map erlang-mode-map)) - - -(defun erlang-mode-commands (map) - (unless (boundp 'indent-line-function) - (define-key map "\t" 'erlang-indent-command)) - (define-key map ";" 'erlang-electric-semicolon) - (define-key map "," 'erlang-electric-comma) - (define-key map "<" 'erlang-electric-lt) - (define-key map ">" 'erlang-electric-gt) - (define-key map "\C-m" 'erlang-electric-newline) - (if (not (boundp 'delete-key-deletes-forward)) - (define-key map "\177" 'backward-delete-char-untabify) - (define-key map [(backspace)] 'backward-delete-char-untabify)) - ;;(unless (boundp 'fill-paragraph-function) - (define-key map "\M-q" 'erlang-fill-paragraph) - (unless (boundp 'beginning-of-defun-function) - (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function) - (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs - (define-key map "\M-\t" 'erlang-complete-tag) - (define-key map "\C-c\M-\t" 'tempo-complete-tag) - (define-key map "\M-+" 'erlang-find-next-tag) - (define-key map "\C-c\M-a" 'erlang-beginning-of-clause) - (define-key map "\C-c\M-b" 'tempo-backward-mark) - (define-key map "\C-c\M-e" 'erlang-end-of-clause) - (define-key map "\C-c\M-f" 'tempo-forward-mark) - (define-key map "\C-c\M-h" 'erlang-mark-clause) - (define-key map "\C-c\C-c" 'comment-region) - (define-key map "\C-c\C-j" 'erlang-generate-new-clause) - (define-key map "\C-c\C-k" 'erlang-compile) - (define-key map "\C-c\C-l" 'erlang-compile-display) - (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) - (define-key map "\C-c\C-q" 'erlang-indent-function) - (define-key map "\C-c\C-u" 'erlang-uncomment-region) - (define-key map "\C-c\C-y" 'erlang-clone-arguments) - (define-key map "\C-c\C-a" 'erlang-align-arrows) - (define-key map "\C-c\C-z" 'erlang-shell-display) - (unless inferior-erlang-use-cmm - (define-key map "\C-x`" 'erlang-next-error))) - - (defun erlang-electric-init () ;; Set up electric character functions to work with ;; delsel/pending-del mode. Also, set up text properties for bit diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index 1f0b7922a0..71041ff558 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -1,19 +1,19 @@ %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% compliance with the License. You should have received a copy of the %% Erlang Public License along with this software. If not, it can be %% retrieved online at http://www.erlang.org/. -%% +%% %% Software distributed under the License is distributed on an "AS IS" %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See %% the License for the specific language governing rights and limitations %% under the License. -%% +%% %% %CopyrightEnd% %%%------------------------------------------------------------------- %%% File : wx_object.erl @@ -321,7 +321,8 @@ loop(Parent, Name, State, Mod, Time, Debug) -> _Msg when Debug =:= [] -> handle_msg(Msg, Parent, Name, State, Mod); _Msg -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, {in, Msg}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {in, Msg}), handle_msg(Msg, Parent, Name, State, Mod, Debug1) end. @@ -410,12 +411,12 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) -> Debug1 = reply(Name, From, Reply, NState, Debug), loop(Parent, Name, NState, Mod, Time1, Debug1); {noreply, NState} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); {noreply, NState, Time1} -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); {stop, Reason, Reply, NState} -> {'EXIT', R} = @@ -437,12 +438,12 @@ handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, []) -> handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, []) -> loop(Parent, Name, NState, Mod, Time1, []); handle_no_reply({noreply, NState}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, infinity, Debug1); handle_no_reply({noreply, NState, Time1}, Parent, Name, _Msg, Mod, _State, Debug) -> - Debug1 = sys:handle_debug(Debug, {gen_server, print_event}, Name, - {noreply, NState}), + Debug1 = sys:handle_debug(Debug, fun print_event/3, + Name, {noreply, NState}), loop(Parent, Name, NState, Mod, Time1, Debug1); handle_no_reply(Reply, _Parent, Name, Msg, Mod, State, Debug) -> handle_common_reply(Reply, Name, Msg, Mod, State,Debug). @@ -462,8 +463,8 @@ handle_common_reply(Reply, Name, Msg, Mod, State, Debug) -> %% @hidden reply(Name, {To, Tag}, Reply, State, Debug) -> reply({To, Tag}, Reply), - sys:handle_debug(Debug, {gen_server, print_event}, Name, - {out, Reply, To, State} ). + sys:handle_debug(Debug, fun print_event/3, + Name, {out, Reply, To, State}). %%----------------------------------------------------------------- @@ -485,6 +486,29 @@ system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) -> Else -> Else end. +%%----------------------------------------------------------------- +%% Format debug messages. Print them as the call-back module sees +%% them, not as the real erlang messages. Use trace for that. +%%----------------------------------------------------------------- +print_event(Dev, {in, Msg}, Name) -> + case Msg of + {'$gen_call', {From, _Tag}, Call} -> + io:format(Dev, "*DBG* ~p got call ~p from ~w~n", + [Name, Call, From]); + {'$gen_cast', Cast} -> + io:format(Dev, "*DBG* ~p got cast ~p~n", + [Name, Cast]); + _ -> + io:format(Dev, "*DBG* ~p got ~p~n", [Name, Msg]) + end; +print_event(Dev, {out, Msg, To, State}, Name) -> + io:format(Dev, "*DBG* ~p sent ~p to ~w, new state ~w~n", + [Name, Msg, To, State]); +print_event(Dev, {noreply, State}, Name) -> + io:format(Dev, "*DBG* ~p new state ~w~n", [Name, State]); +print_event(Dev, Event, Name) -> + io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). + %%% --------------------------------------------------- %%% Terminate the server. %%% --------------------------------------------------- |