diff options
Diffstat (limited to 'lib')
85 files changed, 3008 insertions, 4098 deletions
diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 0f9e044f9e..9d751996ad 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -80,6 +80,7 @@ MODULES= \ ct_groups \ ct_property_test \ ct_release_test \ + ct_default_gl \ erl2html2 \ test_server_ctrl \ test_server_gl \ diff --git a/lib/common_test/src/ct_default_gl.erl b/lib/common_test/src/ct_default_gl.erl new file mode 100644 index 0000000000..d1b52e5f4f --- /dev/null +++ b/lib/common_test/src/ct_default_gl.erl @@ -0,0 +1,83 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(ct_default_gl). +-export([start_link/1, stop/0]). + +-export([init/1,handle_call/3,handle_cast/2,handle_info/2,terminate/2]). + +%% start_link() +%% Start a new group leader process. +start_link(ParentGL) -> + do_start(ParentGL, 3). + +do_start(_ParentGL, 0) -> + exit({?MODULE,startup}); +do_start(ParentGL, Retries) -> + case whereis(?MODULE) of + undefined -> + case gen_server:start_link(?MODULE, [ParentGL], []) of + {ok,Pid} -> + {ok,Pid}; + Other -> + Other + end; + Pid -> + exit(Pid, kill), + timer:sleep(1000), + do_start(ParentGL, Retries-1) + end. + +%% stop(Pid) +%% Stop a group leader process. +stop() -> + gen_server:cast(whereis(?MODULE), stop). + + +%%% Internal functions. + +init([ParentGL]) -> + register(?MODULE, self()), + {ok,#{parent_gl_pid => ParentGL, + parent_gl_monitor => erlang:monitor(process,ParentGL)}}. + +handle_cast(stop, St) -> + {stop,normal,St}. + +%% If the parent group leader dies, fall back on using the local user process +handle_info({'DOWN',Ref,process,_,_Reason}, #{parent_gl_monitor := Ref} = St) -> + User = whereis(user), + {noreply,St#{parent_gl_pid => User, + parent_gl_monitor => erlang:monitor(process,User)}}; + +handle_info({io_request,_From,_ReplyAs,_Req} = IoReq, + #{parent_gl_pid := ParentGL} = St) -> + ParentGL ! IoReq, + {noreply,St}; + +handle_info(Msg, St) -> + io:format(user, "Common Test Group Leader process got: ~tp~n", [Msg]), + {noreply,St}. + +handle_call(_Req, _From, St) -> + {reply,ok,St}. + +terminate(_, _) -> + ok. diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index 104515e57e..291a4d716c 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -307,7 +307,7 @@ add_defaults(Mod,Func, GroupPath) -> "~w:suite/0 failed: ~p~n", [Suite,Reason]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,{exited,Reason}}; SuiteInfo when is_list(SuiteInfo) -> case lists:all(fun(E) when is_tuple(E) -> true; @@ -330,7 +330,7 @@ add_defaults(Mod,Func, GroupPath) -> "~w:suite/0: ~p~n", [Suite,SuiteInfo]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,bad_return_value} end; SuiteInfo -> @@ -338,7 +338,7 @@ add_defaults(Mod,Func, GroupPath) -> "Invalid return value from " "~w:suite/0: ~p~n", [Suite,SuiteInfo]), io:format(ErrStr, []), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), {suite0_failed,bad_return_value} end. @@ -366,7 +366,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "~w:group(~w): ~p~n", [Mod,GrName,BadGr0Val]), io:format(Gr0ErrStr, []), - io:format(user, Gr0ErrStr, []), + io:format(?def_gl, Gr0ErrStr, []), {group0_failed,bad_return_value}; _ -> Args = if Func == init_per_group ; Func == end_per_group -> @@ -388,7 +388,7 @@ add_defaults1(Mod,Func, GroupPath, SuiteInfo) -> "~w:~w/0: ~p~n", [Mod,Func,BadTC0Val]), io:format(TC0ErrStr, []), - io:format(user, TC0ErrStr, []), + io:format(?def_gl, TC0ErrStr, []), {testcase0_failed,bad_return_value}; _ -> %% let test case info (also for all config funcs) override @@ -927,7 +927,7 @@ error_notification(Mod,Func,_Args,{Error,Loc}) -> Div = "~n- - - - - - - - - - - - - - - - - - - " "- - - - - - - - - - - - - - - - - - - - -~n", ErrorStr2 = io_lib:format(ErrorFormat, ErrorArgs), - io:format(user, lists:concat([Div,ErrorStr2,Div,"~n"]), + io:format(?def_gl, lists:concat([Div,ErrorStr2,Div,"~n"]), []), Link = "\n\n<a href=\"#end\">" @@ -1133,7 +1133,7 @@ get_all(Mod, ConfTests) -> ErrStr = io_lib:format("~n*** ERROR *** " "~w:all/0 failed: ~p~n", [Mod,ExitReason]), - io:format(user, ErrStr, []), + io:format(?def_gl, ErrStr, []), %% save the error info so it doesn't get printed twice ct_util:set_testdata_async({{error_in_suite,Mod}, ExitReason}); diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index 9282a9f81d..0daed60dba 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -531,8 +531,13 @@ tc_print(Category,Importance,Format,Args) -> Val end, if Importance >= (100-VLvl) -> - Head = get_heading(Category), - io:format(user, lists:concat([Head,Format,"\n\n"]), Args), + Str = lists:concat([get_heading(Category),Format,"\n\n"]), + try + io:format(?def_gl, Str, Args) + catch + %% default group leader probably not started, or has stopped + _:_ -> io:format(user, Str, Args) + end, ok; true -> ok @@ -679,7 +684,7 @@ logger(Parent, Mode, Verbosity) -> PrivFilesDestRun = [filename:join(AbsDir, F) || F <- PrivFiles], case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of {error,Src1,Dest1,Reason1} -> - io:format(user, "ERROR! "++ + io:format(?def_gl, "ERROR! "++ "Priv file ~p could not be copied to ~p. "++ "Reason: ~p~n", [Src1,Dest1,Reason1]), @@ -687,7 +692,7 @@ logger(Parent, Mode, Verbosity) -> ok -> case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of {error,Src2,Dest2,Reason2} -> - io:format(user, + io:format(?def_gl, "ERROR! "++ "Priv file ~p could not be copied to ~p. " ++"Reason: ~p~n", diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index fbb9c7ab60..a049ef5695 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -2155,8 +2155,8 @@ continue(_MakeErrors, true) -> false; continue(_MakeErrors, _AbortIfMissingSuites) -> io:nl(), - OldGl = group_leader(), - case set_group_leader_same_as_shell() of + OldGL = group_leader(), + case set_group_leader_same_as_shell(OldGL) of true -> S = self(), io:format("Failed to compile or locate one " @@ -2172,7 +2172,7 @@ continue(_MakeErrors, _AbortIfMissingSuites) -> S ! false end end), - group_leader(OldGl, self()), + group_leader(OldGL, self()), receive R when R==true; R==false -> R after 15000 -> @@ -2184,7 +2184,9 @@ continue(_MakeErrors, _AbortIfMissingSuites) -> true end. -set_group_leader_same_as_shell() -> +set_group_leader_same_as_shell(OldGL) -> + %% find the group leader process on the node in a dirty fashion + %% (check initial function call and look in the process dictionary) GS2or3 = fun(P) -> case process_info(P,initial_call) of {initial_call,{group,server,X}} when X == 2 ; X == 3 -> @@ -2197,7 +2199,10 @@ set_group_leader_same_as_shell() -> true == lists:keymember(shell,1, element(2,process_info(P,dictionary)))] of [GL|_] -> - group_leader(GL, self()); + %% check if started from remote node (skip interaction) + if node(OldGL) /= node(GL) -> false; + true -> group_leader(GL, self()) + end; [] -> false end. diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 82a8743cf0..4d3a2ae7e3 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -188,6 +188,8 @@ do_start(Parent, Mode, LogDir, Verbosity) -> ok end, + ct_default_gl:start_link(group_leader()), + {StartTime,TestLogDir} = ct_logs:init(Mode, Verbosity), ct_event:notify(#event{name=test_start, @@ -474,6 +476,7 @@ loop(Mode,TestData,StartDir) -> ct_logs:close(Info, StartDir), ct_event:stop(), ct_config:stop(), + ct_default_gl:stop(), ok = file:set_cwd(StartDir), return(From, Info); {Ref, _Msg} when is_reference(Ref) -> @@ -926,7 +929,8 @@ warn_duplicates(Suites) -> [] -> ok; _ -> - io:format(user,"~nWARNING! Deprecated function: ~w:sequences/0.~n" + io:format(?def_gl, + "~nWARNING! Deprecated function: ~w:sequences/0.~n" " Use group with sequence property instead.~n",[Mod]) end end, @@ -980,12 +984,12 @@ get_profile_data(Profile, Key, StartDir) -> end, case Result of {error,enoent} when Profile /= default -> - io:format(user, "~nERROR! Missing profile file ~p~n", [File]), + io:format(?def_gl, "~nERROR! Missing profile file ~p~n", [File]), undefined; {error,enoent} when Profile == default -> undefined; {error,Reason} -> - io:format(user,"~nERROR! Error in profile file ~p: ~p~n", + io:format(?def_gl,"~nERROR! Error in profile file ~p: ~p~n", [WhichFile,Reason]), undefined; {ok,Data} -> @@ -995,7 +999,7 @@ get_profile_data(Profile, Key, StartDir) -> _ when is_list(Data) -> Data; _ -> - io:format(user, + io:format(?def_gl, "~nERROR! Invalid profile data in ~p~n", [WhichFile]), [] @@ -1082,10 +1086,10 @@ open_url(iexplore, Args, URL) -> Path = proplists:get_value(default, Paths), [Cmd | _] = string:tokens(Path, "%"), Cmd1 = Cmd ++ " " ++ Args ++ " " ++ URL, - io:format(user, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]), + io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd1]), open_port({spawn,Cmd1}, []); _ -> - io:format("~nNo path to iexplore.exe~n",[]) + io:format(?def_gl, "~nNo path to iexplore.exe~n",[]) end, win32reg:close(R), ok; @@ -1095,6 +1099,6 @@ open_url(Prog, Args, URL) -> is_list(Prog) -> Prog end, Cmd = ProgStr ++ " " ++ Args ++ " " ++ URL, - io:format(user, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd]), + io:format(?def_gl, "~nOpening ~ts with command:~n ~ts~n", [URL,Cmd]), open_port({spawn,Cmd},[]), ok. diff --git a/lib/common_test/src/ct_util.hrl b/lib/common_test/src/ct_util.hrl index d7efa26863..039c8168ec 100644 --- a/lib/common_test/src/ct_util.hrl +++ b/lib/common_test/src/ct_util.hrl @@ -23,6 +23,7 @@ -define(board_table,ct_boards). -define(suite_table,ct_suite_data). -define(verbosity_table,ct_verbosity_table). +-define(def_gl, ct_default_gl). -record(conn, {handle, targetref, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 28a353d27b..2953a901b5 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -29,7 +29,7 @@ app_test/1,appup_test/1, file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1, binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1, - other_output/1, encrypted_abstr/1, + other_output/1, kernel_listing/1, encrypted_abstr/1, strict_record/1, cover/1, env/1, core/1, core_roundtrip/1, asm/1, @@ -47,7 +47,7 @@ all() -> test_lib:recompile(?MODULE), [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, - other_output, encrypted_abstr, + other_output, kernel_listing, encrypted_abstr, strict_record, cover, env, core, core_roundtrip, asm, sys_pre_attributes, dialyzer, warnings, pre_load_check, @@ -430,6 +430,32 @@ other_output(Config) when is_list(Config) -> ok. +%% Smoke test and cover of pretty-printing of Kernel code. +kernel_listing(_Config) -> + TestBeams = get_unique_beam_files(), + Abstr = [begin {ok,{Mod,[{abstract_code, + {raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + {Mod,Abstr} end || Beam <- TestBeams], + test_lib:p_run(fun(F) -> do_kernel_listing(F) end, Abstr). + +do_kernel_listing({M,A}) -> + try + {ok,M,Kern} = compile:forms(A, [to_kernel]), + IoList = v3_kernel_pp:format(Kern), + _ = iolist_size(IoList), + ok + catch + throw:{error,Error} -> + io:format("*** compilation failure '~p' for module ~s\n", + [Error,M]), + error; + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [M,Class,Error,erlang:get_stacktrace()]), + error + end. + encrypted_abstr(Config) when is_list(Config) -> {Simple,Target} = get_files(Config, simple, "encrypted_abstr"), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 429d6b79e0..11d4038b06 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -88,8 +88,31 @@ misc(Config) when is_list(Config) -> {ok,buf,<<>>} = get_data({o,false,0}, 0, buf), error = get_data({o,false,0}, 42, buf), + relief = misc_2(0), + error = misc_2(1), + error = misc_2(true), + + if + is_integer(Config) =/= true -> + ok + end, + + true = misc_3(1, 0), + true = misc_3(0, 0), + false = misc_3(0, 2), + + %% Abuse of boolean values. + + Zero = id(0), + One = id(1), + ok = if (Zero == 0) > false -> ok end, + ok = if (Zero == 0) =:= (One == 1) -> ok end, + ok = if (Zero == 0) =:= (One == 1) -> ok end, + ok = if is_atom(Zero > One) -> ok end, + error = if abs(Zero > One) -> ok; true -> error end, + ok = if is_integer(Zero) >= is_integer(One) -> ok end, + ok. - misc_1([{W},{X},{Y},{Z}]) -> if @@ -99,6 +122,17 @@ misc_1([{W},{X},{Y},{Z}]) -> none end. +misc_2(0) -> relief; +misc_2(Adapter = 1) when Adapter -> franklin; +misc_2(_) -> error. + +misc_3(LenUp, LenDw) -> + if + %% Cover handling of #k_alt{}. + LenUp >= 1 orelse ((LenDw >= 2) xor true) -> true; + true -> false + end. + get_data({o,Active,Raw}, BytesToRead, Buffer) when Raw =:= raw; Raw =:= 0 -> if @@ -164,6 +198,12 @@ basic_not(Config) when is_list(Config) -> check(fun() -> if not glurf -> ok; true -> error end end, error), check(fun() -> if not Glurf -> ok; true -> error end end, error), + check(fun() -> if not (not true) -> broken end end, broken), + + check(fun() -> if not (True xor True) -> ok end end, ok), + check(fun() -> if not (True xor False) -> ok; + true -> error end end, error), + ok. complex_not(Config) when is_list(Config) -> @@ -188,8 +228,60 @@ complex_not(Config) when is_list(Config) -> check(fun() -> if not(element(1, ATuple) orelse element(3, ATuple)) -> ok; true -> error end end, error), + %% complex_not_1/4 + ok = complex_not_1(1, 1, 1, a), + error = complex_not_1(1, 1, 1, []), + error = complex_not_1(1, 1, 3, a), + error = complex_not_1(1, 1, 3, []), + error = complex_not_1(1, 2, 1, a), + error = complex_not_1(1, 2, 1, []), + error = complex_not_1(1, 2, 3, a), + error = complex_not_1(1, 2, 3, []), + + %% complex_not_2/4 + ok = complex_not_2(1, 2, 0, x), + error = complex_not_2(1, 2, 0, []), + error = complex_not_2(1, 2, 3, x), + error = complex_not_2(1, 2, 3, []), + error = complex_not_2(1, 1, 0, x), + error = complex_not_2(1, 1, 0, []), + error = complex_not_2(1, 1, 3, x), + error = complex_not_2(1, 1, 3, []), + ok. +complex_not_1(A, B, C, D) -> + Res = complex_not_1a(A, B, C, D), + Res = complex_not_1b(A, B, C, D). + +complex_not_1a(A, B, C, D) + when (not (A < B)) andalso (not (B < C)) andalso (not is_list(D)) -> + ok; +complex_not_1a(_, _, _, _) -> + error. + +complex_not_1b(A, B, C, D) + when (not (A < B)) and (not (B < C)) and (not is_list(D)) -> + ok; +complex_not_1b(_, _, _, _) -> + error. + +complex_not_2(A, B, C, D) -> + Res = complex_not_2a(A, B, C, D), + Res = complex_not_2b(A, B, C, D). + +complex_not_2a(A, B, C, D) + when A < B andalso not (B < C) andalso not is_list(D) -> + ok; +complex_not_2a(_, _, _, _) -> + error. + +complex_not_2b(A, B, C, D) + when A < B, not (B < C), not is_list(D) -> + ok; +complex_not_2b(_, _, _, _) -> + error. + nested_nots(Config) when is_list(Config) -> true = nested_not_1(0, 0), true = nested_not_1(0, 1), @@ -210,19 +302,36 @@ nested_nots(Config) when is_list(Config) -> false = nested_not_2(true, true, atom), ok. -nested_not_1(X, Y) when not (((X>Y) or not(is_atom(X))) and +nested_not_1(X, Y) -> + Res = nested_not_1a(X, Y), + Res = nested_not_1b(X, Y). + +nested_not_1a(X, Y) when not (((X>Y) or not(is_atom(X))) and (is_atom(Y) or (X==3.4))) -> true; -nested_not_1(_, _) -> +nested_not_1a(_, _) -> + false. + +nested_not_1b(X, Y) when not (((X>Y) orelse not(is_atom(X))) andalso + (is_atom(Y) orelse (X==3.4))) -> + true; +nested_not_1b(_, _) -> false. nested_not_2(X, Y, Z) -> - nested_not_2(X, Y, Z, true). + Res = nested_not_2a(X, Y, Z, true), + Res = nested_not_2b(X, Y, Z, true). -nested_not_2(X, Y, Z, True) +nested_not_2a(X, Y, Z, True) when not(True and not((not(X) and not(Y)) or not(is_atom(Z)))) -> true; -nested_not_2(_, _, _, _) -> +nested_not_2a(_, _, _, _) -> + false. + +nested_not_2b(X, Y, Z, True) + when not(True andalso not((not(X) andalso not(Y)) orelse not(is_atom(Z)))) -> + true; +nested_not_2b(_, _, _, _) -> false. semicolon(Config) when is_list(Config) -> @@ -1094,6 +1203,13 @@ tricky(Config) when is_list(Config) -> false = rb(100000, [1], 42), true = rb(100000, [], 42), true = rb(555, [a,b,c], 19), + + error = tricky_3(42), + error = tricky_3(42.0), + error = tricky_3(<<>>), + error = tricky_3(#{}), + error = tricky_3({a,b}), + ok. tricky_1(X, Y) when abs((X == 1) or (Y == 2)) -> ok; @@ -1102,6 +1218,15 @@ tricky_1(_, _) -> not_ok. tricky_2(X) when float(X) or float(X) -> ok; tricky_2(_) -> error. +tricky_3(X) + when abs(X) or bit_size(X) or byte_size(X) or ceil(X) or + float(X) or floor(X) or length(X) or + map_size(X) or node() or node(X) or round(X) or + self() or size(X) or tl(X) or trunc(X) or tuple_size(X) -> + ok; +tricky_3(_) -> + error. + %% From dets_v9:read_buckets/11, simplified. rb(Size, ToRead, SoFar) when SoFar + Size < 81920; ToRead == [] -> true; diff --git a/lib/cosProperty/doc/src/notes.xml b/lib/cosProperty/doc/src/notes.xml index d5219fc110..e5d22982c5 100644 --- a/lib/cosProperty/doc/src/notes.xml +++ b/lib/cosProperty/doc/src/notes.xml @@ -32,6 +32,22 @@ <file>notes.xml</file> </header> + + <section><title>cosProperty 1.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix dialyzer warnings.</p> + <p> + Own Id: OTP-14006</p> + </item> + </list> + </section> + + </section> + <section><title>cosProperty 1.2.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl index bf046530d8..371e72cf72 100644 --- a/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl +++ b/lib/cosProperty/src/CosPropertyService_PropertySetDef_impl.erl @@ -913,8 +913,6 @@ mnesia_read(State) -> case mnesia:wread({oe_CosPropertyService, ?get_DBKey(State)}) of [#oe_CosPropertyService{properties = X}] -> X; - {atomic, []} -> - {'EXCEPTION', #'OBJECT_NOT_EXIST'{completion_status=?COMPLETED_NO}}; _Other -> {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}} end. diff --git a/lib/cosProperty/vsn.mk b/lib/cosProperty/vsn.mk index 1a8e42ffdb..78ba88445d 100644 --- a/lib/cosProperty/vsn.mk +++ b/lib/cosProperty/vsn.mk @@ -1,2 +1,2 @@ -COSPROPERTY_VSN = 1.2.1 +COSPROPERTY_VSN = 1.2.2 diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index c835f6dcf4..86b839eddb 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -241,18 +241,14 @@ static ERL_NIF_TERM cmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); -static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rc4_encrypt_with_state(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -314,21 +310,15 @@ static ErlNifFunc nif_funcs[] = { {"block_crypt_nif", 5, block_crypt_nif}, {"block_crypt_nif", 4, block_crypt_nif}, {"aes_ige_crypt_nif", 4, aes_ige_crypt_nif}, - - {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, - {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, {"aes_ctr_stream_init", 2, aes_ctr_stream_init}, {"aes_ctr_stream_encrypt", 2, aes_ctr_stream_encrypt}, {"aes_ctr_stream_decrypt", 2, aes_ctr_stream_encrypt}, - {"rand_bytes", 1, rand_bytes_1}, {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, - {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 4, mod_exp_nif}, {"dss_verify_nif", 4, dss_verify_nif}, {"rsa_verify_nif", 4, rsa_verify_nif}, {"do_exor", 2, do_exor}, - {"rc4_encrypt", 2, rc4_encrypt}, {"rc4_set_key", 1, rc4_set_key}, {"rc4_encrypt_with_state", 2, rc4_encrypt_with_state}, {"rsa_sign_nif", 3, rsa_sign_nif}, @@ -355,8 +345,6 @@ static ErlNifFunc nif_funcs[] = { {"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt}, {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt} - - }; ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload) @@ -1673,64 +1661,6 @@ static ERL_NIF_TERM aes_ige_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TE #endif } -/* Common for both encrypt and decrypt -*/ -static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, IVec, Data) */ - ErlNifBinary key, ivec, text; -#ifdef HAVE_EVP_AES_CTR - const EVP_CIPHER *cipher; - EVP_CIPHER_CTX ctx; - unsigned char *out; - int outl = 0; -#else - AES_KEY aes_key; - unsigned char ivec_clone[16]; /* writable copy */ - unsigned char ecount_buf[AES_BLOCK_SIZE]; - unsigned int num = 0; -#endif - ERL_NIF_TERM ret; - - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) -#ifndef HAVE_EVP_AES_CTR - || AES_set_encrypt_key(key.data, key.size*8, &aes_key) != 0 -#endif - || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 - || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { - return enif_make_badarg(env); - } -#ifdef HAVE_EVP_AES_CTR - switch (key.size) - { - case 16: cipher = EVP_aes_128_ctr(); break; - case 24: cipher = EVP_aes_192_ctr(); break; - case 32: cipher = EVP_aes_256_ctr(); break; - default: return enif_make_badarg(env); - } - - out = enif_make_new_binary(env,text.size,&ret); - EVP_CIPHER_CTX_init(&ctx); - EVP_CipherInit_ex(&ctx, cipher, NULL, - key.data, ivec.data, (argv[3] == atom_true)); - EVP_CIPHER_CTX_set_padding(&ctx, 0); - EVP_CipherUpdate(&ctx, out, &outl, text.data, text.size); - ASSERT(outl == text.size); - EVP_CipherFinal_ex(&ctx, out + outl, &outl); - ASSERT(outl == 0); - EVP_CIPHER_CTX_cleanup(&ctx); -#else - memcpy(ivec_clone, ivec.data, 16); - memset(ecount_buf, 0, sizeof(ecount_buf)); - AES_ctr128_encrypt((unsigned char *) text.data, - enif_make_new_binary(env, text.size, &ret), - text.size, &aes_key, ivec_clone, ecount_buf, &num); -#endif - CONSUME_REDS(env,text); - - /* To do an incremental {en|de}cryption, the state to to keep between calls - must include ivec_clone, ecount_buf and num. */ - return ret; -} /* Initializes state for ctr streaming (de)encryption */ @@ -2151,20 +2081,6 @@ static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ER #endif } -static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Bytes) */ - unsigned bytes; - unsigned char* data; - ERL_NIF_TERM ret; - - if (!enif_get_uint(env, argv[0], &bytes)) { - return enif_make_badarg(env); - } - data = enif_make_new_binary(env, bytes, &ret); - RAND_pseudo_bytes(data, bytes); - ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); - return ret; -} static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes) */ unsigned bytes; @@ -2183,49 +2099,6 @@ static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NI } -static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Bytes, TopMask, BottomMask) */ - unsigned bits; - BIGNUM *bn_rand; - int top, bottom; - unsigned char* data; - unsigned dlen; - ERL_NIF_TERM ret; - - if (!enif_get_uint(env, argv[0], &bits) - || !enif_get_int(env, argv[1], &top) - || !enif_get_int(env, argv[2], &bottom)) { - return enif_make_badarg(env); - } - if (! (top == -1 || top == 0 || top == 1) ) { - return enif_make_badarg(env); - } - if (! (bottom == 0 || bottom == 1) ) { - return enif_make_badarg(env); - } - - bn_rand = BN_new(); - if (! bn_rand ) { - return enif_make_badarg(env); - } - - /* Get a (bits) bit random number */ - if (!BN_rand(bn_rand, bits, top, bottom)) { - ret = atom_false; - } - else { - /* Copy the bignum into an erlang mpint binary. */ - dlen = BN_num_bytes(bn_rand); - data = enif_make_new_binary(env, dlen+4, &ret); - put_int32(data, dlen); - BN_bn2bin(bn_rand, data+4); - ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); - } - BN_free(bn_rand); - - return ret; -} - static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { ErlNifBinary bin; @@ -2492,29 +2365,6 @@ static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) return ret; } -static ERL_NIF_TERM rc4_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) -{/* (Key, Data) */ -#ifndef OPENSSL_NO_RC4 - ErlNifBinary key, data; - RC4_KEY rc4_key; - ERL_NIF_TERM ret; - - CHECK_NO_FIPS_MODE(); - - if (!enif_inspect_iolist_as_binary(env,argv[0], &key) - || !enif_inspect_iolist_as_binary(env,argv[1], &data)) { - return enif_make_badarg(env); - } - RC4_set_key(&rc4_key, key.size, key.data); - RC4(&rc4_key, data.size, data.data, - enif_make_new_binary(env, data.size, &ret)); - CONSUME_REDS(env,data); - return ret; -#else - return enif_raise_exception(env, atom_notsup); -#endif -} - static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Key) */ #ifndef OPENSSL_NO_RC4 diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index 43f9a0f9e7..0b62964efa 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -40,146 +40,10 @@ -export([ec_curve/1, ec_curves/0]). -export([rand_seed/1]). -%% DEPRECATED --export([rand_bytes/1]). --deprecated({rand_bytes, 1, next_major_release}). - -%% Replaced by hash_* --export([md4/1, md4_init/0, md4_update/2, md4_final/1]). --export([md5/1, md5_init/0, md5_update/2, md5_final/1]). --export([sha/1, sha_init/0, sha_update/2, sha_final/1]). --deprecated({md4, 1, next_major_release}). --deprecated({md5, 1, next_major_release}). --deprecated({sha, 1, next_major_release}). --deprecated({md4_init, 0, next_major_release}). --deprecated({md5_init, 0, next_major_release}). --deprecated({sha_init, 0, next_major_release}). --deprecated({md4_update, 2, next_major_release}). --deprecated({md5_update, 2, next_major_release}). --deprecated({sha_update, 2, next_major_release}). --deprecated({md4_final, 1, next_major_release}). --deprecated({md5_final, 1, next_major_release}). --deprecated({sha_final, 1, next_major_release}). - -%% Replaced by hmac_* --export([md5_mac/2, md5_mac_96/2, sha_mac/2, sha_mac/3, sha_mac_96/2]). --deprecated({md5_mac, 2, next_major_release}). --deprecated({md5_mac_96, 2, next_major_release}). --deprecated({sha_mac, 2, next_major_release}). --deprecated({sha_mac, 3, next_major_release}). --deprecated({sha_mac_96, 2, next_major_release}). - -%% Replaced by sign/verify --export([dss_verify/3, dss_verify/4, rsa_verify/3, rsa_verify/4]). --export([dss_sign/2, dss_sign/3, rsa_sign/2, rsa_sign/3]). --deprecated({dss_verify, 3, next_major_release}). --deprecated({dss_verify, 4, next_major_release}). --deprecated({rsa_verify, 3, next_major_release}). --deprecated({rsa_verify, 4, next_major_release}). --deprecated({dss_sign, 2, next_major_release}). --deprecated({dss_sign, 3, next_major_release}). --deprecated({rsa_sign, 2, next_major_release}). --deprecated({rsa_sign, 3, next_major_release}). - -%% Replaced by generate_key --export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). --deprecated({dh_generate_key, 1, next_major_release}). --deprecated({dh_generate_key, 2, next_major_release}). --deprecated({dh_compute_key, 3, next_major_release}). - -%% Replaced by mod_exp_prim and no longer needed --export([mod_exp/3, mpint/1, erlint/1, strong_rand_mpint/3]). --deprecated({mod_exp, 3, next_major_release}). --deprecated({mpint, 1, next_major_release}). --deprecated({erlint, 1, next_major_release}). --deprecated({strong_rand_mpint, 3, next_major_release}). - -%% Replaced by block_* --export([des_cbc_encrypt/3, des_cbc_decrypt/3, des_cbc_ivec/1]). --export([des3_cbc_encrypt/5, des3_cbc_decrypt/5]). --export([des_ecb_encrypt/2, des_ecb_decrypt/2]). --export([des_ede3_cbc_encrypt/5, des_ede3_cbc_decrypt/5]). --export([des_cfb_encrypt/3, des_cfb_decrypt/3, des_cfb_ivec/2]). --export([des3_cfb_encrypt/5, des3_cfb_decrypt/5]). --deprecated({des_cbc_encrypt, 3, next_major_release}). --deprecated({des_cbc_decrypt, 3, next_major_release}). --deprecated({des_cbc_ivec, 1, next_major_release}). --deprecated({des3_cbc_encrypt, 5, next_major_release}). --deprecated({des3_cbc_decrypt, 5, next_major_release}). --deprecated({des_ecb_encrypt, 2, next_major_release}). --deprecated({des_ecb_decrypt, 2, next_major_release}). --deprecated({des_ede3_cbc_encrypt, 5, next_major_release}). --deprecated({des_ede3_cbc_decrypt, 5, next_major_release}). --deprecated({des_cfb_encrypt, 3, next_major_release}). --deprecated({des_cfb_decrypt, 3, next_major_release}). --deprecated({des_cfb_ivec, 2, next_major_release}). --deprecated({des3_cfb_encrypt, 5, next_major_release}). --deprecated({des3_cfb_decrypt, 5, next_major_release}). --export([blowfish_ecb_encrypt/2, blowfish_ecb_decrypt/2]). --export([blowfish_cbc_encrypt/3, blowfish_cbc_decrypt/3]). --export([blowfish_cfb64_encrypt/3, blowfish_cfb64_decrypt/3]). --export([blowfish_ofb64_encrypt/3]). --deprecated({blowfish_ecb_encrypt, 2, next_major_release}). --deprecated({blowfish_ecb_decrypt, 2, next_major_release}). --deprecated({blowfish_cbc_encrypt, 3, next_major_release}). --deprecated({blowfish_cbc_decrypt, 3, next_major_release}). --deprecated({blowfish_cfb64_encrypt, 3, next_major_release}). --deprecated({blowfish_cfb64_decrypt, 3, next_major_release}). --deprecated({blowfish_ofb64_encrypt, 3, next_major_release}). --export([aes_cfb_128_encrypt/3, aes_cfb_128_decrypt/3]). --export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). --export([aes_cbc_256_encrypt/3, aes_cbc_256_decrypt/3]). --export([aes_cbc_ivec/1]). --deprecated({aes_cfb_128_encrypt, 3, next_major_release}). --deprecated({aes_cfb_128_decrypt, 3, next_major_release}). --deprecated({aes_cbc_128_encrypt, 3, next_major_release}). --deprecated({aes_cbc_128_decrypt, 3, next_major_release}). --deprecated({aes_cbc_256_encrypt, 3, next_major_release}). --deprecated({aes_cbc_256_decrypt, 3, next_major_release}). --deprecated({aes_cbc_ivec, 1, next_major_release}). --export([rc2_cbc_encrypt/3, rc2_cbc_decrypt/3]). --export([rc2_40_cbc_encrypt/3, rc2_40_cbc_decrypt/3]). --deprecated({rc2_cbc_encrypt, 3, next_major_release}). --deprecated({rc2_cbc_decrypt, 3, next_major_release}). -%% allready replaced by above! --deprecated({rc2_40_cbc_encrypt, 3, next_major_release}). --deprecated({rc2_40_cbc_decrypt, 3, next_major_release}). - -%% Replaced by stream_* --export([aes_ctr_stream_init/2, aes_ctr_stream_encrypt/2, aes_ctr_stream_decrypt/2]). --export([rc4_set_key/1, rc4_encrypt_with_state/2]). --deprecated({aes_ctr_stream_init, 2, next_major_release}). --deprecated({aes_ctr_stream_encrypt, 2, next_major_release}). --deprecated({aes_ctr_stream_decrypt, 2, next_major_release}). --deprecated({rc4_set_key, 1, next_major_release}). --deprecated({rc4_encrypt_with_state, 2, next_major_release}). - -%% Not needed special case of stream_* --export([aes_ctr_encrypt/3, aes_ctr_decrypt/3, rc4_encrypt/2]). --deprecated({aes_ctr_encrypt, 3, next_major_release}). --deprecated({aes_ctr_decrypt, 3, next_major_release}). --deprecated({rc4_encrypt, 2, next_major_release}). - -%% Replace by public/private_encrypt/decrypt --export([rsa_public_encrypt/3, rsa_private_decrypt/3]). --export([rsa_private_encrypt/3, rsa_public_decrypt/3]). --deprecated({rsa_public_encrypt, 3, next_major_release}). --deprecated({rsa_private_decrypt, 3, next_major_release}). --deprecated({rsa_public_decrypt, 3, next_major_release}). --deprecated({rsa_private_encrypt, 3, next_major_release}). - -%% Replaced by crypto:module_info() --export([info/0]). --deprecated({info, 0, next_major_release}). - %% This should correspond to the similar macro in crypto.c -define(MAX_BYTES_TO_NIF, 20000). %% Current value is: erlang:system_info(context_reductions) * 10 --type mpint() :: binary(). --type rsa_digest_type() :: 'md5' | 'sha' | 'sha224' | 'sha256' | 'sha384' | 'sha512'. --type dss_digest_type() :: 'none' | 'sha'. %%-type ecdsa_digest_type() :: 'md5' | 'sha' | 'sha256' | 'sha384' | 'sha512'. --type data_or_digest() :: binary() | {digest, binary()}. -type crypto_integer() :: binary() | integer(). %%-type ec_named_curve() :: atom(). %%-type ec_point() :: crypto_integer(). @@ -420,13 +284,10 @@ stream_decrypt(State, Data0) -> %% %% RAND - pseudo random numbers using RN_ functions in crypto lib %% --spec rand_bytes(non_neg_integer()) -> binary(). -spec strong_rand_bytes(non_neg_integer()) -> binary(). -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). -rand_bytes(_Bytes) -> ?nif_stub. - strong_rand_bytes(Bytes) -> case strong_rand_bytes_nif(Bytes) of false -> erlang:error(low_entropy); @@ -694,7 +555,7 @@ path2bin(Path) when is_list(Path) -> end. %%-------------------------------------------------------------------- -%%% Internal functions (some internal API functions are part of the deprecated API) +%%% Internal functions %%-------------------------------------------------------------------- max_bytes() -> ?MAX_BYTES_TO_NIF. @@ -724,59 +585,6 @@ hash_init_nif(_Hash) -> ?nif_stub. hash_update_nif(_State, _Data) -> ?nif_stub. hash_final_nif(_State) -> ?nif_stub. - -%% -%% MD5 -%% - --spec md5(iodata()) -> binary(). --spec md5_init() -> binary(). --spec md5_update(binary(), iodata()) -> binary(). --spec md5_final(binary()) -> binary(). - -md5(Data) -> - hash(md5, Data). -md5_init() -> - hash_init(md5). -md5_update(Context, Data) -> - hash_update(Context, Data). -md5_final(Context) -> - hash_final(Context). - -%% -%% MD4 -%% --spec md4(iodata()) -> binary(). --spec md4_init() -> binary(). --spec md4_update(binary(), iodata()) -> binary(). --spec md4_final(binary()) -> binary(). - -md4(Data) -> - hash(md4, Data). -md4_init() -> - hash_init(md4). -md4_update(Context, Data) -> - hash_update(Context, Data). -md4_final(Context) -> - hash_final(Context). - -%% -%% SHA -%% --spec sha(iodata()) -> binary(). --spec sha_init() -> binary(). --spec sha_update(binary(), iodata()) -> binary(). --spec sha_final(binary()) -> binary(). - -sha(Data) -> - hash(sha, Data). -sha_init() -> - hash_init(sha). -sha_update(Context, Data) -> - hash_update(Context, Data). -sha_final(Context) -> - hash_final(Context). - %% HMAC -------------------------------------------------------------------- hmac(Type, Key, Data, MacSize, Size, MaxBytes) when Size =< MaxBytes -> @@ -811,28 +619,6 @@ hmac_final_nif(_Context, _MacSize) -> ?nif_stub. cmac_nif(_Type, _Key, _Data) -> ?nif_stub. -%% -%% MD5_MAC -%% --spec md5_mac(iodata(), iodata()) -> binary(). --spec md5_mac_96(iodata(), iodata()) -> binary(). - -md5_mac(Key, Data) -> hmac(md5, Key, Data). - -md5_mac_96(Key, Data) -> hmac(md5, Key, Data, 12). - -%% -%% SHA_MAC -%% --spec sha_mac(iodata(), iodata()) -> binary(). --spec sha_mac_96(iodata(), iodata()) -> binary(). - -sha_mac(Key, Data) -> hmac(sha, Key, Data). - -sha_mac(Key, Data, Size) -> hmac(sha, Key, Data, Size). - -sha_mac_96(Key, Data) -> hmac(sha, Key, Data, 12). - %% CIPHERS -------------------------------------------------------------------- block_crypt_nif(_Type, _Key, _Ivec, _Text, _IsEncrypt) -> ?nif_stub. @@ -849,94 +635,6 @@ check_des3_key(Key) -> end. %% -%% DES - in electronic codebook mode (ECB) -%% --spec des_ecb_encrypt(iodata(), iodata()) -> binary(). --spec des_ecb_decrypt(iodata(), iodata()) -> binary(). - -des_ecb_encrypt(Key, Data) -> - block_encrypt(des_ecb, Key, Data). -des_ecb_decrypt(Key, Data) -> - block_decrypt(des_ecb, Key, Data). - -%% -%% DES3 - in cipher block chaining mode (CBC) -%% --spec des3_cbc_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> - binary(). --spec des3_cbc_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> - binary(). - -des3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - block_encrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). -des_ede3_cbc_encrypt(Key1, Key2, Key3, IVec, Data) -> - block_encrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). - -des3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - block_decrypt(des3_cbc, [Key1, Key2, Key3], IVec, Data). -des_ede3_cbc_decrypt(Key1, Key2, Key3, IVec, Data) -> - block_decrypt(des_ede3, [Key1, Key2, Key3], IVec, Data). - -%% -%% DES3 - in 8-bits cipher feedback mode (CFB) -%% --spec des3_cfb_encrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> - binary(). --spec des3_cfb_decrypt(iodata(), iodata(), iodata(), binary(), iodata()) -> - binary(). - -des3_cfb_encrypt(Key1, Key2, Key3, IVec, Data) -> - block_encrypt(des3_cfb, [Key1, Key2, Key3], IVec, Data). - -des3_cfb_decrypt(Key1, Key2, Key3, IVec, Data) -> - block_decrypt(des3_cfb, [Key1, Key2, Key3], IVec, Data). - -%% -%% Blowfish -%% --spec blowfish_ecb_encrypt(iodata(), iodata()) -> binary(). --spec blowfish_ecb_decrypt(iodata(), iodata()) -> binary(). --spec blowfish_cbc_encrypt(iodata(), binary(), iodata()) -> binary(). --spec blowfish_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). --spec blowfish_cfb64_encrypt(iodata(), binary(), iodata()) -> binary(). --spec blowfish_cfb64_decrypt(iodata(), binary(), iodata()) -> binary(). --spec blowfish_ofb64_encrypt(iodata(), binary(), iodata()) -> binary(). - -blowfish_ecb_encrypt(Key, Data) -> - block_encrypt(blowfish_ecb, Key, Data). - -blowfish_ecb_decrypt(Key, Data) -> - block_decrypt(blowfish_ecb, Key, Data). - -blowfish_cbc_encrypt(Key, IVec, Data) -> - block_encrypt(blowfish_cbc, Key, IVec, Data). - -blowfish_cbc_decrypt(Key, IVec, Data) -> - block_decrypt(blowfish_cbc, Key, IVec, Data). - -blowfish_cfb64_encrypt(Key, IVec, Data) -> - block_encrypt(blowfish_cfb64, Key, IVec, Data). - -blowfish_cfb64_decrypt(Key, IVec, Data) -> - block_decrypt(blowfish_cfb64, Key, IVec, Data). - -blowfish_ofb64_encrypt(Key, IVec, Data) -> - block_encrypt(blowfish_ofb64, Key, IVec, Data). - - -%% -%% AES in cipher feedback mode (CFB) - 128 bit shift -%% --spec aes_cfb_128_encrypt(iodata(), binary(), iodata()) -> binary(). --spec aes_cfb_128_decrypt(iodata(), binary(), iodata()) -> binary(). - -aes_cfb_128_encrypt(Key, IVec, Data) -> - block_encrypt(aes_cfb128, Key, IVec, Data). - -aes_cfb_128_decrypt(Key, IVec, Data) -> - block_decrypt(aes_cfb128, Key, IVec, Data). - -%% %% AES - in Galois/Counter Mode (GCM) %% %% The default tag length is EVP_GCM_TLS_TAG_LEN(16), @@ -952,88 +650,6 @@ chacha20_poly1305_encrypt(_Key, _Ivec, _AAD, _In) -> ?nif_stub. chacha20_poly1305_decrypt(_Key, _Ivec, _AAD, _In, _Tag) -> ?nif_stub. %% -%% DES - in cipher block chaining mode (CBC) -%% --spec des_cbc_encrypt(iodata(), binary(), iodata()) -> binary(). --spec des_cbc_decrypt(iodata(), binary(), iodata()) -> binary(). - -des_cbc_encrypt(Key, IVec, Data) -> - block_encrypt(des_cbc, Key, IVec, Data). - -des_cbc_decrypt(Key, IVec, Data) -> - block_decrypt(des_cbc, Key, IVec, Data). - -%% -%% dec_cbc_ivec(Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% des_cbc_[encrypt|decrypt]. -%% --spec des_cbc_ivec(iodata()) -> binary(). - -des_cbc_ivec(Data) -> - next_iv(des_cbc, Data). - -%% -%% DES - in 8-bits cipher feedback mode (CFB) -%% --spec des_cfb_encrypt(iodata(), binary(), iodata()) -> binary(). --spec des_cfb_decrypt(iodata(), binary(), iodata()) -> binary(). - -des_cfb_encrypt(Key, IVec, Data) -> - block_encrypt(des_cfb, Key, IVec, Data). - -des_cfb_decrypt(Key, IVec, Data) -> - block_decrypt(des_cfb, Key, IVec, Data). - -%% -%% dec_cfb_ivec(IVec, Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% des_cfb_[encrypt|decrypt]. -%% - --spec des_cfb_ivec(iodata(), iodata()) -> binary(). - -des_cfb_ivec(IVec, Data) -> - next_iv(des_cfb, Data, IVec). - - -%% -%% AES - with 128 or 256 bit key in cipher block chaining mode (CBC) -%% --spec aes_cbc_128_encrypt(iodata(), binary(), iodata()) -> - binary(). --spec aes_cbc_128_decrypt(iodata(), binary(), iodata()) -> - binary(). --spec aes_cbc_256_encrypt(iodata(), binary(), iodata()) -> - binary(). --spec aes_cbc_256_decrypt(iodata(), binary(), iodata()) -> - binary(). - -aes_cbc_128_encrypt(Key, IVec, Data) -> - block_encrypt(aes_cbc128, Key, IVec, Data). - -aes_cbc_128_decrypt(Key, IVec, Data) -> - block_decrypt(aes_cbc128, Key, IVec, Data). - -aes_cbc_256_encrypt(Key, IVec, Data) -> - block_encrypt(aes_cbc256, Key, IVec, Data). - -aes_cbc_256_decrypt(Key, IVec, Data) -> - block_decrypt(aes_cbc256, Key, IVec, Data). - -%% -%% aes_cbc_ivec(Data) -> binary() -%% -%% Returns the IVec to be used in the next iteration of -%% aes_cbc_*_[encrypt|decrypt]. -%% IVec size: 16 bytes -%% -aes_cbc_ivec(Data) -> - next_iv(aes_cbc, Data). - -%% %% AES - with 256 bit key in infinite garble extension mode (IGE) %% @@ -1066,17 +682,6 @@ do_stream_decrypt({rc4, State0}, Data) -> {State, Text} = rc4_encrypt_with_state(State0, Data), {{rc4, State}, Text}. -%% -%% AES - in counter mode (CTR) -%% --spec aes_ctr_encrypt(iodata(), binary(), iodata()) -> - binary(). --spec aes_ctr_decrypt(iodata(), binary(), iodata()) -> - binary(). - -aes_ctr_encrypt(_Key, _IVec, _Data) -> ?nif_stub. -aes_ctr_decrypt(_Key, _IVec, _Cipher) -> ?nif_stub. - %% %% AES - in counter mode (CTR) with state maintained for multi-call streaming @@ -1096,31 +701,9 @@ aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub. %% %% RC4 - symmetric stream cipher %% --spec rc4_encrypt(iodata(), iodata()) -> binary(). - -rc4_encrypt(_Key, _Data) -> ?nif_stub. rc4_set_key(_Key) -> ?nif_stub. rc4_encrypt_with_state(_State, _Data) -> ?nif_stub. - -%% RC2 block cipher - -rc2_cbc_encrypt(Key, IVec, Data) -> - notsup_to_error(block_encrypt(rc2_cbc, Key, IVec, Data)). - -rc2_cbc_decrypt(Key, IVec, Data) -> - notsup_to_error(block_decrypt(rc2_cbc, Key, IVec, Data)). - -%% -%% RC2 - 40 bits block cipher - Backwards compatibility not documented. -%% -rc2_40_cbc_encrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - notsup_to_error(block_encrypt(rc2_cbc, Key, IVec, Data)). - -rc2_40_cbc_decrypt(Key, IVec, Data) when erlang:byte_size(Key) == 5 -> - notsup_to_error(block_decrypt(rc2_cbc, Key, IVec, Data)). - - %% Secure remote password ------------------------------------------------------------------- user_srp_gen_key(Private, Generator, Prime) -> @@ -1168,7 +751,7 @@ srp_scrambler(Version, UserPublic, HostPublic, Prime) when Version == '6'; Versi srp_scrambler('3', _, HostPublic, _Prime) -> %% The parameter u is a 32-bit unsigned integer which takes its value %% from the first 32 bits of the SHA1 hash of B, MSB first. - <<U:32/bits, _/binary>> = sha(HostPublic), + <<U:32/bits, _/binary>> = hash(sha, HostPublic), U. srp_pad_length(Width, Length) -> @@ -1223,26 +806,10 @@ dh_check([_Prime,_Gen]) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% PrivKey = mpint() --spec dh_generate_key([binary()]) -> {binary(),binary()}. --spec dh_generate_key(binary()|undefined, [binary()]) -> - {binary(),binary()}. - -dh_generate_key(DHParameters) -> - dh_generate_key_nif(undefined, map_mpint_to_bin(DHParameters), 4). -dh_generate_key(PrivateKey, DHParameters) -> - dh_generate_key_nif(mpint_to_bin(PrivateKey), map_mpint_to_bin(DHParameters), 4). - dh_generate_key_nif(_PrivateKey, _DHParameters, _Mpint) -> ?nif_stub. %% DHParameters = [P (Prime)= mpint(), G(Generator) = mpint()] %% MyPrivKey, OthersPublicKey = mpint() --spec dh_compute_key(binary(), binary(), [binary()]) -> binary(). - -dh_compute_key(OthersPublicKey, MyPrivateKey, DHParameters) -> - compute_key(dh, mpint_to_bin(OthersPublicKey), mpint_to_bin(MyPrivateKey), - map_mpint_to_bin(DHParameters)). - - dh_compute_key_nif(_OthersPublicKey, _MyPrivateKey, _DHParameters) -> ?nif_stub. ec_key_generate(_Curve, _Key) -> ?nif_stub. @@ -1322,137 +889,19 @@ ensure_int_as_bin(Int) when is_integer(Int) -> ensure_int_as_bin(Bin) -> Bin. -map_to_norm_bin([H|_]=List) when is_integer(H) -> - lists:map(fun(E) -> int_to_bin(E) end, List); -map_to_norm_bin(List) -> - lists:map(fun(E) -> mpint_to_bin(E) end, List). - -%%-------------------------------------------------------------------- -%%% Deprecated %%-------------------------------------------------------------------- %% -%% rsa_public_encrypt -%% rsa_private_decrypt -type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'. --spec rsa_public_encrypt(binary(), [binary()], rsa_padding()) -> - binary(). --spec rsa_public_decrypt(binary(), [integer() | mpint()], rsa_padding()) -> - binary(). --spec rsa_private_encrypt(binary(), [integer() | mpint()], rsa_padding()) -> - binary(). --spec rsa_private_decrypt(binary(), [integer() | mpint()], rsa_padding()) -> - binary(). - -%% Binary, Key = [E,N] -rsa_public_encrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, map_to_norm_bin(Key), Padding, true) of - error -> - erlang:error(encrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - rsa_public_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. -%% Binary, Key = [E,N,D] -rsa_private_decrypt(BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of - error -> - erlang:error(decrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - rsa_private_crypt(_BinMsg, _Key, _Padding, _IsEncrypt) -> ?nif_stub. - -%% Binary, Key = [E,N,D] -rsa_private_encrypt(BinMesg, Key, Padding) -> - case rsa_private_crypt(BinMesg, map_to_norm_bin(Key), Padding, true) of - error -> - erlang:error(encrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - -%% Binary, Key = [E,N] -rsa_public_decrypt(BinMesg, Key, Padding) -> - case rsa_public_crypt(BinMesg, map_to_norm_bin(Key), Padding, false) of - error -> - erlang:error(decrypt_failed, [BinMesg,Key, Padding]); - Sign -> Sign - end. - -map_mpint_to_bin(List) -> - lists:map(fun(E) -> mpint_to_bin(E) end, List ). - -%% -%% DSS, RSA - sign -%% -%% Key = [P,Q,G,X] P,Q,G=DSSParams X=PrivateKey --spec dss_sign(data_or_digest(), [binary()]) -> binary(). --spec dss_sign(dss_digest_type(), data_or_digest(), [binary()]) -> binary(). --spec rsa_sign(data_or_digest(), [binary()]) -> binary(). --spec rsa_sign(rsa_digest_type(), data_or_digest(), [binary()]) -> binary(). - -dss_sign(DataOrDigest,Key) -> - dss_sign(sha,DataOrDigest,Key). -dss_sign(Type, Data, Key) when is_binary(Data), Type=/=none -> - sign(dss, Type, mpint_to_bin(Data), map_mpint_to_bin(Key)); -dss_sign(Type, Digest, Key) -> - sign(dss, Type, Digest, map_mpint_to_bin(Key)). - - -%% Key = [E,N,D] E=PublicExponent N=PublicModulus D=PrivateExponent -rsa_sign(DataOrDigest,Key) -> - rsa_sign(sha, DataOrDigest, Key). - -rsa_sign(Type, Data, Key) when is_binary(Data) -> - sign(rsa, Type, mpint_to_bin(Data), map_mpint_to_bin(Key)); -rsa_sign(Type, Digest, Key) -> - sign(rsa, Type, Digest, map_mpint_to_bin(Key)). - -%% -%% DSS, RSA - verify -%% --spec dss_verify(data_or_digest(), binary(), [binary()]) -> boolean(). --spec dss_verify(dss_digest_type(), data_or_digest(), binary(), [binary()]) -> boolean(). --spec rsa_verify(data_or_digest(), binary(), [binary()]) -> boolean(). --spec rsa_verify(rsa_digest_type(), data_or_digest(), binary(), [binary()]) -> - boolean(). - -%% Key = [P,Q,G,Y] P,Q,G=DSSParams Y=PublicKey -dss_verify(Data,Signature,Key) -> - dss_verify(sha, Data, Signature, Key). - -dss_verify(Type,Data,Signature,Key) when is_binary(Data), Type=/=none -> - verify(dss,Type,mpint_to_bin(Data),mpint_to_bin(Signature),map_mpint_to_bin(Key)); -dss_verify(Type,Digest,Signature,Key) -> - verify(dss,Type,Digest,mpint_to_bin(Signature),map_mpint_to_bin(Key)). - -% Key = [E,N] E=PublicExponent N=PublicModulus -rsa_verify(Data,Signature,Key) -> - rsa_verify(sha, Data,Signature,Key). -rsa_verify(Type, Data, Signature, Key) when is_binary(Data) -> - verify(rsa, Type, mpint_to_bin(Data), mpint_to_bin(Signature), map_mpint_to_bin(Key)); -rsa_verify(Type, Digest, Signature, Key) -> - verify(rsa, Type, Digest, mpint_to_bin(Signature), map_mpint_to_bin(Key)). - --spec strong_rand_mpint(Bits::non_neg_integer(), - Top::-1..1, - Bottom::0..1) -> binary(). - -strong_rand_mpint(Bits, Top, Bottom) -> - case strong_rand_mpint_nif(Bits,Top,Bottom) of - false -> erlang:error(low_entropy); - Bin -> Bin - end. -strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. - - %% large integer in a binary with 32bit length %% MP representaion (SSH2) mpint(X) when X < 0 -> mpint_neg(X); mpint(X) -> mpint_pos(X). - + -define(UINT32(X), X:32/unsigned-big-integer). @@ -1477,76 +926,8 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) -> <<Integer:Bits/integer>> = MPIntValue, Integer. -mpint_to_bin(<<Len:32, Bin:Len/binary>>) -> - Bin. - %% %% mod_exp - utility for rsa generation and SRP %% -mod_exp(Base, Exponent, Modulo) - when is_integer(Base), is_integer(Exponent), is_integer(Modulo) -> - bin_to_int(mod_exp_nif(int_to_bin(Base), int_to_bin(Exponent), int_to_bin(Modulo), 0)); - -mod_exp(Base, Exponent, Modulo) -> - mod_exp_nif(mpint_to_bin(Base),mpint_to_bin(Exponent),mpint_to_bin(Modulo), 4). - mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub. --define(FUNC_LIST, [hash, hash_init, hash_update, hash_final, - hmac, hmac_init, hmac_update, hmac_final, hmac_final_n, - cmac, - %% deprecated - md4, md4_init, md4_update, md4_final, - md5, md5_init, md5_update, md5_final, - sha, sha_init, sha_update, sha_final, - md5_mac, md5_mac_96, - sha_mac, sha_mac_96, - %% - block_encrypt, block_decrypt, - %% deprecated - des_cbc_encrypt, des_cbc_decrypt, - des_cfb_encrypt, des_cfb_decrypt, - des_ecb_encrypt, des_ecb_decrypt, - des3_cbc_encrypt, des3_cbc_decrypt, - des3_cfb_encrypt, des3_cfb_decrypt, - aes_cfb_128_encrypt, aes_cfb_128_decrypt, - rc2_cbc_encrypt, rc2_cbc_decrypt, - rc2_40_cbc_encrypt, rc2_40_cbc_decrypt, - aes_cbc_128_encrypt, aes_cbc_128_decrypt, - aes_cbc_256_encrypt, aes_cbc_256_decrypt, - blowfish_cbc_encrypt, blowfish_cbc_decrypt, - blowfish_cfb64_encrypt, blowfish_cfb64_decrypt, - blowfish_ecb_encrypt, blowfish_ecb_decrypt, blowfish_ofb64_encrypt, - %% - rand_bytes, - strong_rand_bytes, - rand_uniform, - rand_seed, - mod_pow, - exor, - %% deprecated - mod_exp,strong_rand_mpint,erlint, mpint, - %% - sign, verify, generate_key, compute_key, - %% deprecated - dss_verify,dss_sign, - rsa_verify,rsa_sign, - rsa_public_encrypt,rsa_private_decrypt, - rsa_private_encrypt,rsa_public_decrypt, - dh_generate_key, dh_compute_key, - %% - stream_init, stream_encrypt, stream_decrypt, - %% deprecated - rc4_encrypt, rc4_set_key, rc4_encrypt_with_state, - aes_ctr_encrypt, aes_ctr_decrypt, - aes_ctr_stream_init, aes_ctr_stream_encrypt, aes_ctr_stream_decrypt, - %% - next_iv, - %% deprecated - aes_cbc_ivec, - des_cbc_ivec, des_cfb_ivec, - info, - %% - info_lib, info_fips, supports]). -info() -> - ?FUNC_LIST. diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index 928a1b1d73..5a81c84558 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -7,8 +7,7 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk MODULES = \ blowfish_SUITE \ - crypto_SUITE \ - old_crypto_SUITE + crypto_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/crypto/test/blowfish_SUITE.erl b/lib/crypto/test/blowfish_SUITE.erl index a78f8fe39a..c2d0d2621b 100644 --- a/lib/crypto/test/blowfish_SUITE.erl +++ b/lib/crypto/test/blowfish_SUITE.erl @@ -151,7 +151,7 @@ end_per_group(_GroupName, Config) -> ecb_test(KeyBytes, ClearBytes, CipherBytes) -> {Key, Clear, Cipher} = {to_bin(KeyBytes), to_bin(ClearBytes), to_bin(CipherBytes)}, - ?line m(crypto:blowfish_ecb_encrypt(Key, Clear), Cipher), + ?line m(crypto:block_encrypt(blowfish_ecb, Key, Clear), Cipher), true. ecb(doc) -> @@ -200,7 +200,7 @@ cbc(doc) -> cbc(suite) -> []; cbc(Config) when is_list(Config) -> - true = crypto:blowfish_cbc_encrypt(?KEY, ?IVEC, ?DATA_PADDED) =:= + true = crypto:block_encrypt(blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED) =:= to_bin("6B77B4D63006DEE605B156E27403979358DEB9E7154616D959F1652BD5FF92CC"), ok. @@ -209,7 +209,7 @@ cfb64(doc) -> cfb64(suite) -> []; cfb64(Config) when is_list(Config) -> - true = crypto:blowfish_cfb64_encrypt(?KEY, ?IVEC, ?DATA) =:= + true = crypto:block_encrypt(blowfish_cfb64, ?KEY, ?IVEC, ?DATA) =:= to_bin("E73214A2822139CAF26ECF6D2EB9E76E3DA3DE04D1517200519D57A6C3"), ok. @@ -218,7 +218,7 @@ ofb64(doc) -> ofb64(suite) -> []; ofb64(Config) when is_list(Config) -> - true = crypto:blowfish_ofb64_encrypt(?KEY, ?IVEC, ?DATA) =:= + true = crypto:block_encrypt(blowfish_ofb64, ?KEY, ?IVEC, ?DATA) =:= to_bin("E73214A2822139CA62B343CC5B65587310DD908D0C241B2263C2CF80DA"), ok. @@ -227,8 +227,9 @@ no_ecb(doc) -> no_ecb(suite) -> []; no_ecb(Config) when is_list(Config) -> - notsup(fun crypto:blowfish_ecb_encrypt/2, - [to_bin("0000000000000000"), + notsup(fun crypto:block_encrypt/3, + [blowfish_ecb, + to_bin("0000000000000000"), to_bin("FFFFFFFFFFFFFFFF")]). no_cbc(doc) -> @@ -236,16 +237,16 @@ no_cbc(doc) -> no_cbc(suite) -> []; no_cbc(Config) when is_list(Config) -> - notsup(fun crypto:blowfish_cbc_encrypt/3, - [?KEY, ?IVEC, ?DATA_PADDED]). + notsup(fun crypto:block_encrypt/4, + [blowfish_cbc, ?KEY, ?IVEC, ?DATA_PADDED]). no_cfb64(doc) -> "Test that CFB64 mode is disabled"; no_cfb64(suite) -> []; no_cfb64(Config) when is_list(Config) -> - notsup(fun crypto:blowfish_cfb64_encrypt/3, - [?KEY, ?IVEC, ?DATA]), + notsup(fun crypto:block_encrypt/4, + [blowfish_cfb64, ?KEY, ?IVEC, ?DATA]), ok. no_ofb64(doc) -> @@ -253,8 +254,8 @@ no_ofb64(doc) -> no_ofb64(suite) -> []; no_ofb64(Config) when is_list(Config) -> - notsup(fun crypto:blowfish_ofb64_encrypt/3, - [?KEY, ?IVEC, ?DATA]). + notsup(fun crypto:block_encrypt/4, + [blowfish_ofb64, ?KEY, ?IVEC, ?DATA]). %% Helper functions diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl deleted file mode 100644 index 324ed39c6d..0000000000 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ /dev/null @@ -1,2350 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(old_crypto_SUITE). - --include_lib("common_test/include/ct.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - init_per_testcase/2, - end_per_testcase/2, - info/1, - link_test/1, - md5/1, - md5_update/1, - md4/1, - md4_update/1, - sha/1, - sha_update/1, - hmac_update_sha/1, - hmac_update_sha_n/1, - hmac_update_sha256/1, - hmac_update_sha512/1, - hmac_update_md5/1, - hmac_update_md5_io/1, - hmac_update_md5_n/1, - hmac_rfc2202/1, - hmac_rfc4231_sha224/1, - hmac_rfc4231_sha256/1, - hmac_rfc4231_sha384/1, - hmac_rfc4231_sha512/1, - ripemd160/1, - ripemd160_update/1, - sha256/1, - sha256_update/1, - sha512/1, - sha512_update/1, - md5_mac/1, - md5_mac_io/1, - des_cbc/1, - des_cbc_iter/1, - des_cfb/1, - des_cfb_iter/1, - des_ecb/1, - des3_cbc/1, - des3_cbf/1, - des3_cfb/1, - rc2_cbc/1, - aes_cfb/1, - aes_cbc/1, - aes_cbc_iter/1, - aes_ctr/1, - aes_ctr_stream/1, - mod_exp_test/1, - rand_uniform_test/1, - strong_rand_test/1, - rsa_verify_test/1, - dsa_verify_test/1, - rsa_sign_test/1, - rsa_sign_hash_test/1, - dsa_sign_test/1, - dsa_sign_hash_test/1, - rsa_encrypt_decrypt/1, - dh/1, - srp3/1, srp6/1, srp6a/1, - ec/1, - exor_test/1, - rc4_test/1, - rc4_stream_test/1, - blowfish_cfb64/1, - smp/1]). - --export([hexstr2bin/1]). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [link_test, {group, info}]. - -groups() -> - [{info, [sequence],[info, {group, rest}]}, - {rest, [], - [md5, md5_update, md4, md4_update, md5_mac, - md5_mac_io, ripemd160, ripemd160_update, sha, sha_update, - sha256, sha256_update, sha512, sha512_update, - hmac_update_sha, hmac_update_sha_n, hmac_update_sha256, hmac_update_sha512, - hmac_update_md5_n, hmac_update_md5_io, hmac_update_md5, - hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, - hmac_rfc4231_sha384, hmac_rfc4231_sha512, - des_cbc, aes_cfb, aes_cbc, - des_cfb, des_cfb_iter, des3_cbc, des3_cbf, des3_cfb, rc2_cbc, - aes_cbc_iter, aes_ctr, aes_ctr_stream, des_cbc_iter, des_ecb, - rand_uniform_test, strong_rand_test, - rsa_verify_test, dsa_verify_test, rsa_sign_test, - rsa_sign_hash_test, dsa_sign_test, dsa_sign_hash_test, - rsa_encrypt_decrypt, dh, srp3, srp6, srp6a, ec, exor_test, - rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, - smp]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - -init_per_testcase(info, Config) -> - Config; -init_per_testcase(_Name,Config) -> - io:format("init_per_testcase\n"), - ?line crypto:start(), - Config. - -end_per_testcase(info, Config) -> - Config; -end_per_testcase(_Name,Config) -> - io:format("end_per_testcase\n"), - ?line crypto:stop(), - Config. - -%% -%% -link_test(doc) -> - ["Test that the library is statically linked to libcrypto.a."]; -link_test(suite) -> - []; -link_test(Config) when is_list(Config) -> - ?line case os:type() of - {unix,darwin} -> {skipped,"Darwin cannot link statically"}; - {unix,_} -> link_test_1(); - _ -> {skip,"Only runs on Unix"} - end. - -link_test_1() -> - ?line CryptoPriv = code:priv_dir(crypto), - ?line Wc = filename:join([CryptoPriv,"lib","crypto.*"]), - ?line case filelib:wildcard(Wc) of - [] -> {skip,"Didn't find the crypto driver"}; - [Drv] -> link_test_2(Drv) - end. - -link_test_2(Drv) -> - case ldd_program() of - none -> - {skip,"No ldd-like program found"}; - Ldd -> - Cmd = Ldd ++ " " ++ Drv, - Libs = os:cmd(Cmd), - io:format("~p\n", [Libs]), - case string:str(Libs, "libcrypto") of - 0 -> - case ?t:is_commercial() of - true -> - ?t:fail({libcrypto,statically_linked}); - false -> - {comment,"Statically linked (OK for open-source platform)"} - end; - _ -> - ok - end - end. - -ldd_program() -> - case os:find_executable("ldd") of - false -> - case os:type() of - {unix,darwin} -> - case os:find_executable("otool") of - false -> none; - Otool -> Otool ++ " -L" - end; - _ -> - none - end; - Ldd when is_list(Ldd) -> Ldd - end. - - - -info(doc) -> - ["Call the info function."]; -info(suite) -> - []; -info(Config) when is_list(Config) -> - case {code:lib_dir(crypto),?t:is_commercial()} of - {{error,bad_name},false} -> - {skip,"Missing crypto application"}; - {_,_} -> - ?line crypto:start(), - ?line Info = crypto:info(), - ?line Exports = lists:usort([F || {F,_} <- crypto:module_info(exports)]), - ?line [] = Info -- Exports, - ?line NotInInfo = Exports -- Info, - io:format("NotInInfo = ~p\n", [NotInInfo]), - %% BlackList = lists:sort([des_ede3_cbc_decrypt, des_ede3_cbc_encrypt, - %% dh_check, dh_generate_parameters, - %% module_info, start, stop, version]), - %% ?line BlackList = NotInInfo, - - ?line InfoLib = crypto:info_lib(), - ?line [_|_] = InfoLib, - F = fun([{Name,VerN,VerS}|T],Me) -> - ?line true = is_binary(Name), - ?line true = is_integer(VerN), - ?line true = is_binary(VerS), - Me(T,Me); - ([],_) -> - ok - end, - ?line F(InfoLib,F), - ?line crypto:stop() - end. - -%% -%% -md5(doc) -> - ["Generate MD5 message digests and check the result. Examples are " - "from RFC-1321."]; -md5(suite) -> - []; -md5(Config) when is_list(Config) -> - ?line m(crypto:md5(""), - hexstr2bin("d41d8cd98f00b204e9800998ecf8427e")), - ?line m(crypto:md5("a"), - hexstr2bin("0cc175b9c0f1b6a831c399e269772661")), - ?line m(crypto:md5("abc"), - hexstr2bin("900150983cd24fb0d6963f7d28e17f72")), - ?line m(crypto:md5("message digest"), - hexstr2bin("f96b697d7cb7938d525a2f31aaf161d0")), - ?line m(crypto:md5("abcdefghijklmnopqrstuvwxyz"), - hexstr2bin("c3fcd3d76192e4007dfb496cca67e13b")), - ?line m(crypto:md5("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789"), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")), - ?line m(crypto:md5("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890"), - hexstr2bin("57edf4a22be3c955ac49da2e2107b67a")). - -%% -%% -md5_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; -md5_update(suite) -> - []; -md5_update(Config) when is_list(Config) -> - ?line Ctx = crypto:md5_init(), - ?line Ctx1 = crypto:md5_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx2 = crypto:md5_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" - "0123456789"), - ?line m(crypto:md5_final(Ctx2), - hexstr2bin("d174ab98d277d9f5a5611c2c9f419d9f")). - -%% -%% -md4(doc) -> - ["Generate MD4 message digests and check the result. Examples are " - "from RFC-1321."]; -md4(suite) -> - []; -md4(Config) when is_list(Config) -> - ?line m(crypto:md4(""), - hexstr2bin("31d6cfe0d16ae931b73c59d7e0c089c0")), - ?line m(crypto:md4("a"), - hexstr2bin("bde52cb31de33e46245e05fbdbd6fb24")), - ?line m(crypto:md4("abc"), - hexstr2bin("a448017aaf21d8525fc10ae87aa6729d")), - ?line m(crypto:md4("message digest"), - hexstr2bin("d9130a8164549fe818874806e1c7014b")), - ?line m(crypto:md4("abcdefghijklmnopqrstuvwxyz"), - hexstr2bin("d79e1c308aa5bbcdeea8ed63df412da9")), - ?line m(crypto:md4("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" - "0123456789"), - hexstr2bin("043f8582f241db351ce627e153e7f0e4")), - ?line m(crypto:md4("12345678901234567890123456789012345678901234567890" - "123456789012345678901234567890"), - hexstr2bin("e33b4ddc9c38f2199c3e7b164fcc0536")). - -%% -%% -md4_update(doc) -> - ["Generate MD5 message using md5_init, md5_update, and md5_final, and" - "check the result. Examples are from RFC-1321."]; -md4_update(suite) -> - []; -md4_update(Config) when is_list(Config) -> - ?line Ctx = crypto:md4_init(), - ?line Ctx1 = crypto:md4_update(Ctx, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), - ?line Ctx2 = crypto:md4_update(Ctx1, "abcdefghijklmnopqrstuvwxyz" - "0123456789"), - ?line m(crypto:md4_final(Ctx2), - hexstr2bin("043f8582f241db351ce627e153e7f0e4")). - -%% -%% -sha(doc) -> - ["Generate SHA message digests and check the result. Examples are " - "from FIPS-180-1."]; -sha(suite) -> - []; -sha(Config) when is_list(Config) -> - ?line m(crypto:sha("abc"), - hexstr2bin("A9993E364706816ABA3E25717850C26C9CD0D89D")), - ?line m(crypto:sha("abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). - - -%% -hmac_update_sha_n(doc) -> - ["Request a larger-than-allowed SHA1 HMAC using hmac_init, hmac_update, and hmac_final_n. " - "Expected values for examples are generated using crypto:sha_mac." ]; -hmac_update_sha_n(suite) -> - []; -hmac_update_sha_n(Config) when is_list(Config) -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final_n(Ctx3, 1024), - ?line Exp = crypto:sha_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac), - ?line m(size(Exp), size(Mac)). - - -hmac_update_sha(doc) -> - ["Generate an SHA1 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha_mac." ]; -hmac_update_sha(suite) -> - []; -hmac_update_sha(Config) when is_list(Config) -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:hmac(sha, Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_sha256(doc) -> - ["Generate an SHA256 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha256_mac." ]; -hmac_update_sha256(suite) -> - []; -hmac_update_sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> hmac_update_sha256_do() end). - -hmac_update_sha256_do() -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha256, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:hmac(sha256, Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_sha512(doc) -> - ["Generate an SHA512 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:sha512_mac." ]; -hmac_update_sha512(suite) -> - []; -hmac_update_sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> hmac_update_sha512_do() end). - -hmac_update_sha512_do() -> - ?line Key = hexstr2bin("00010203101112132021222330313233" - "04050607141516172425262734353637" - "08090a0b18191a1b28292a2b38393a3b" - "0c0d0e0f1c1d1e1f2c2d2e2f3c3d3e3f"), - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(sha512, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:hmac(sha512, Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - -hmac_update_md5(doc) -> - ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5(suite) -> - []; -hmac_update_md5(Config) when is_list(Config) -> - % ?line Key2 = ["A fine speach", "by a fine man!"], - Key2 = "A fine speach by a fine man!", - ?line Long1 = "Four score and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty, and dedicated to the proposition that all men are created equal.", - ?line Long2 = "Now we are engaged in a great civil war, testing whether that nation, or any nation, so conceived and so dedicated, can long endure. We are met on a great battle-field of that war. We have come to dedicate a portion of that field, as a final resting place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this.", - ?line Long3 = "But, in a larger sense, we can not dedicate, we can not consecrate, we can not hallow this ground. The brave men, living and dead, who struggled here, have consecrated it, far above our poor power to add or detract. The world will little note, nor long remember what we say here, but it can never forget what they did here. It is for us the living, rather, to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us-that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion that we here highly resolve that these dead shall not have died in vain-that this nation, under God, shall have a new birth of freedom-and that government of the people, by the people, for the people, shall not perish from the earth.", - ?line CtxA = crypto:hmac_init(md5, Key2), - ?line CtxB = crypto:hmac_update(CtxA, Long1), - ?line CtxC = crypto:hmac_update(CtxB, Long2), - ?line CtxD = crypto:hmac_update(CtxC, Long3), - ?line Mac2 = crypto:hmac_final(CtxD), - ?line Exp2 = crypto:md5_mac(Key2, lists:flatten([Long1, Long2, Long3])), - ?line m(Exp2, Mac2). - -hmac_rfc2202(doc) -> - ["Generate an HMAC using hmac, md5_mac, and sha_mac." - "Test vectors are taken from RFC-2202."]; -hmac_rfc2202(suite) -> - []; -hmac_rfc2202(Config) when is_list(Config) -> - hmac_rfc2202_md5(), - hmac_rfc2202_sha(). - -hmac_rfc2202_md5() -> - %% Test case 1 - Case1Key = binary:copy(<<16#0b>>, 16), - Case1Data = <<"Hi There">>, - Case1Exp = hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d"), - - ?line Case1Mac_1 = crypto:md5_mac(Case1Key, Case1Data), - ?line Case1Mac_2 = crypto:hmac(md5, Case1Key, Case1Data), - ?line m(Case1Exp, Case1Mac_1), - ?line m(Case1Exp, Case1Mac_2), - - %% Test case 2 - Case2Key = <<"Jefe">>, - Case2Data = <<"what do ya want for nothing?">>, - Case2Exp = hexstr2bin("750c783e6ab0b503eaa86e310a5db738"), - - ?line Case2Mac_1 = crypto:md5_mac(Case2Key, Case2Data), - ?line Case2Mac_2 = crypto:hmac(md5, Case2Key, Case2Data), - ?line m(Case2Exp, Case2Mac_1), - ?line m(Case2Exp, Case2Mac_2), - - %% Test case 3 - Case3Key = binary:copy(<<16#aa>>, 16), - Case3Data = binary:copy(<<16#dd>>, 50), - Case3Exp = hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6"), - - ?line Case3Mac_1 = crypto:md5_mac(Case3Key, Case3Data), - ?line Case3Mac_2 = crypto:hmac(md5, Case3Key, Case3Data), - ?line m(Case3Exp, Case3Mac_1), - ?line m(Case3Exp, Case3Mac_2), - - %% Test case 4 - Case4Key = list_to_binary(lists:seq(1, 16#19)), - Case4Data = binary:copy(<<16#cd>>, 50), - Case4Exp = hexstr2bin("697eaf0aca3a3aea3a75164746ffaa79"), - - ?line Case4Mac_1 = crypto:md5_mac(Case4Key, Case4Data), - ?line Case4Mac_2 = crypto:hmac(md5, Case4Key, Case4Data), - ?line m(Case4Exp, Case4Mac_1), - ?line m(Case4Exp, Case4Mac_2), - - %% Test case 5 - Case5Key = binary:copy(<<16#0c>>, 16), - Case5Data = "Test With Truncation", - Case5Exp = hexstr2bin("56461ef2342edc00f9bab995690efd4c"), - Case5Exp96 = hexstr2bin("56461ef2342edc00f9bab995"), - - ?line Case5Mac_1 = crypto:md5_mac(Case5Key, Case5Data), - ?line Case5Mac_2 = crypto:hmac(md5, Case5Key, Case5Data), - ?line Case5Mac96_1 = crypto:md5_mac_96(Case5Key, Case5Data), - ?line Case5Mac96_2 = crypto:hmac(md5, Case5Key, Case5Data, 12), - ?line m(Case5Exp, Case5Mac_1), - ?line m(Case5Exp, Case5Mac_2), - ?line m(Case5Exp96, Case5Mac96_1), - ?line m(Case5Exp96, Case5Mac96_2), - - %% Test case 6 - Case6Key = binary:copy(<<16#aa>>, 80), - Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - Case6Exp = hexstr2bin("6b1ab7fe4bd7bf8f0b62e6ce61b9d0cd"), - - ?line Case6Mac_1 = crypto:md5_mac(Case6Key, Case6Data), - ?line Case6Mac_2 = crypto:hmac(md5, Case6Key, Case6Data), - ?line m(Case6Exp, Case6Mac_1), - ?line m(Case6Exp, Case6Mac_2), - - %% Test case 7 - Case7Key = binary:copy(<<16#aa>>, 80), - Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, - Case7Exp = hexstr2bin("6f630fad67cda0ee1fb1f562db3aa53e"), - - ?line Case7Mac_1 = crypto:md5_mac(Case7Key, Case7Data), - ?line Case7Mac_2 = crypto:hmac(md5, Case7Key, Case7Data), - ?line m(Case7Exp, Case7Mac_1), - ?line m(Case7Exp, Case7Mac_2). - -hmac_rfc2202_sha() -> - %% Test case 1 - Case1Key = binary:copy(<<16#0b>>, 20), - Case1Data = <<"Hi There">>, - Case1Exp = hexstr2bin("b617318655057264e28bc0b6fb378c8ef146be00"), - - ?line Case1Mac_1 = crypto:sha_mac(Case1Key, Case1Data), - ?line Case1Mac_2 = crypto:hmac(sha, Case1Key, Case1Data), - ?line m(Case1Exp, Case1Mac_1), - ?line m(Case1Exp, Case1Mac_2), - - %% Test case 2 - Case2Key = <<"Jefe">>, - Case2Data = <<"what do ya want for nothing?">>, - Case2Exp = hexstr2bin("effcdf6ae5eb2fa2d27416d5f184df9c259a7c79"), - - ?line Case2Mac_1 = crypto:sha_mac(Case2Key, Case2Data), - ?line Case2Mac_2 = crypto:hmac(sha, Case2Key, Case2Data), - ?line m(Case2Exp, Case2Mac_1), - ?line m(Case2Exp, Case2Mac_2), - - %% Test case 3 - Case3Key = binary:copy(<<16#aa>>, 20), - Case3Data = binary:copy(<<16#dd>>, 50), - Case3Exp = hexstr2bin("125d7342b9ac11cd91a39af48aa17b4f63f175d3"), - - ?line Case3Mac_1 = crypto:sha_mac(Case3Key, Case3Data), - ?line Case3Mac_2 = crypto:hmac(sha, Case3Key, Case3Data), - ?line m(Case3Exp, Case3Mac_1), - ?line m(Case3Exp, Case3Mac_2), - - %% Test case 4 - Case4Key = list_to_binary(lists:seq(1, 16#19)), - Case4Data = binary:copy(<<16#cd>>, 50), - Case4Exp = hexstr2bin("4c9007f4026250c6bc8414f9bf50c86c2d7235da"), - - ?line Case4Mac_1 = crypto:sha_mac(Case4Key, Case4Data), - ?line Case4Mac_2 = crypto:hmac(sha, Case4Key, Case4Data), - ?line m(Case4Exp, Case4Mac_1), - ?line m(Case4Exp, Case4Mac_2), - - %% Test case 5 - Case5Key = binary:copy(<<16#0c>>, 20), - Case5Data = "Test With Truncation", - Case5Exp = hexstr2bin("4c1a03424b55e07fe7f27be1d58bb9324a9a5a04"), - Case5Exp96 = hexstr2bin("4c1a03424b55e07fe7f27be1"), - - ?line Case5Mac_1 = crypto:sha_mac(Case5Key, Case5Data), - ?line Case5Mac_2 = crypto:hmac(sha, Case5Key, Case5Data), - ?line Case5Mac96_1 = crypto:sha_mac_96(Case5Key, Case5Data), - ?line Case5Mac96_2 = crypto:hmac(sha, Case5Key, Case5Data, 12), - ?line m(Case5Exp, Case5Mac_1), - ?line m(Case5Exp, Case5Mac_2), - ?line m(Case5Exp96, Case5Mac96_1), - ?line m(Case5Exp96, Case5Mac96_2), - - %% Test case 6 - Case6Key = binary:copy(<<16#aa>>, 80), - Case6Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - Case6Exp = hexstr2bin("aa4ae5e15272d00e95705637ce8a3b55ed402112"), - - ?line Case6Mac_1 = crypto:sha_mac(Case6Key, Case6Data), - ?line Case6Mac_2 = crypto:hmac(sha, Case6Key, Case6Data), - ?line m(Case6Exp, Case6Mac_1), - ?line m(Case6Exp, Case6Mac_2), - - %% Test case 7 - Case7Key = binary:copy(<<16#aa>>, 80), - Case7Data = <<"Test Using Larger Than Block-Size Key and Larger Than One Block-Size Data">>, - Case7Exp = hexstr2bin("e8e99d0f45237d786d6bbaa7965c7808bbff1a91"), - - ?line Case7Mac_1 = crypto:sha_mac(Case7Key, Case7Data), - ?line Case7Mac_2 = crypto:hmac(sha, Case7Key, Case7Data), - ?line m(Case7Exp, Case7Mac_1), - ?line m(Case7Exp, Case7Mac_2). - -hmac_rfc4231_sha224(doc) -> - ["Generate an HMAC using crypto:sha224_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha224(suite) -> - []; -hmac_rfc4231_sha224(Config) when is_list(Config) -> - if_supported(sha224, fun() -> hmac_rfc4231_sha224_do() end). - -hmac_rfc4231_sha256(doc) -> - ["Generate an HMAC using crypto:sha256_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha256(suite) -> - []; -hmac_rfc4231_sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> hmac_rfc4231_sha256_do() end). - -hmac_rfc4231_sha384(doc) -> - ["Generate an HMAC using crypto:sha384_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha384(suite) -> - []; -hmac_rfc4231_sha384(Config) when is_list(Config) -> - if_supported(sha384, fun() -> hmac_rfc4231_sha384_do() end). - -hmac_rfc4231_sha512(doc) -> - ["Generate an HMAC using crypto:sha512_mac, hmac, and hmac_init, hmac_update, and hmac_final. " - "Testvectors are take from RFC4231." ]; -hmac_rfc4231_sha512(suite) -> - []; -hmac_rfc4231_sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> hmac_rfc4231_sha512_do() end). - -hmac_rfc4231_case(Hash, case1, Exp) -> - %% Test 1 - Key = binary:copy(<<16#0b>>, 20), - Data = <<"Hi There">>, - hmac_rfc4231_case(Hash, Key, Data, Exp); - -hmac_rfc4231_case(Hash, case2, Exp) -> - %% Test 2 - Key = <<"Jefe">>, - Data = <<"what do ya want for nothing?">>, - hmac_rfc4231_case(Hash, Key, Data, Exp); - -hmac_rfc4231_case(Hash, case3, Exp) -> - %% Test 3 - Key = binary:copy(<<16#aa>>, 20), - Data = binary:copy(<<16#dd>>, 50), - hmac_rfc4231_case(Hash, Key, Data, Exp); - -hmac_rfc4231_case(Hash, case4, Exp) -> - %% Test 4 - Key = list_to_binary(lists:seq(1, 16#19)), - Data = binary:copy(<<16#cd>>, 50), - hmac_rfc4231_case(Hash, Key, Data, Exp); - -hmac_rfc4231_case(Hash, case5, Exp) -> - %% Test 5 - Key = binary:copy(<<16#0c>>, 20), - Data = <<"Test With Truncation">>, - hmac_rfc4231_case(Hash, Key, Data, 16, Exp); - -hmac_rfc4231_case(Hash, case6, Exp) -> - %% Test 6 - Key = binary:copy(<<16#aa>>, 131), - Data = <<"Test Using Larger Than Block-Size Key - Hash Key First">>, - hmac_rfc4231_case(Hash, Key, Data, Exp); - -hmac_rfc4231_case(Hash, case7, Exp) -> - %% Test Case 7 - Key = binary:copy(<<16#aa>>, 131), - Data = <<"This is a test using a larger than block-size key and a larger t", - "han block-size data. The key needs to be hashed before being use", - "d by the HMAC algorithm.">>, - hmac_rfc4231_case(Hash, Key, Data, Exp). - -hmac_rfc4231_case(Hash, Key, Data, Exp) -> - ?line Ctx = crypto:hmac_init(Hash, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Mac1 = crypto:hmac_final(Ctx2), - ?line Mac3 = crypto:hmac(Hash, Key, Data), - ?line m(Exp, Mac1), - ?line m(Exp, Mac3). - -hmac_rfc4231_case(Hash, Key, Data, Trunc, Exp) -> - ?line Ctx = crypto:hmac_init(Hash, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Mac1 = crypto:hmac_final_n(Ctx2, Trunc), - ?line Mac3 = crypto:hmac(Hash, Key, Data, Trunc), - ?line m(Exp, Mac1), - ?line m(Exp, Mac3). - -hmac_rfc4231_sha224_do() -> - Case1 = hexstr2bin("896fb1128abbdf196832107cd49df33f" - "47b4b1169912ba4f53684b22"), - Case2 = hexstr2bin("a30e01098bc6dbbf45690f3a7e9e6d0f" - "8bbea2a39e6148008fd05e44"), - Case3 = hexstr2bin("7fb3cb3588c6c1f6ffa9694d7d6ad264" - "9365b0c1f65d69d1ec8333ea"), - Case4 = hexstr2bin("6c11506874013cac6a2abc1bb382627c" - "ec6a90d86efc012de7afec5a"), - Case5 = hexstr2bin("0e2aea68a90c8d37c988bcdb9fca6fa8"), - Case6 = hexstr2bin("95e9a0db962095adaebe9b2d6f0dbce2" - "d499f112f2d2b7273fa6870e"), - Case7 = hexstr2bin("3a854166ac5d9f023f54d517d0b39dbd" - "946770db9c2b95c9f6f565d1"), - hmac_rfc4231_cases_do(sha224, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha256_do() -> - Case1 = hexstr2bin("b0344c61d8db38535ca8afceaf0bf12b" - "881dc200c9833da726e9376c2e32cff7"), - Case2 = hexstr2bin("5bdcc146bf60754e6a042426089575c7" - "5a003f089d2739839dec58b964ec3843"), - Case3 = hexstr2bin("773ea91e36800e46854db8ebd09181a7" - "2959098b3ef8c122d9635514ced565fe"), - Case4 = hexstr2bin("82558a389a443c0ea4cc819899f2083a" - "85f0faa3e578f8077a2e3ff46729665b"), - Case5 = hexstr2bin("a3b6167473100ee06e0c796c2955552b"), - Case6 = hexstr2bin("60e431591ee0b67f0d8a26aacbf5b77f" - "8e0bc6213728c5140546040f0ee37f54"), - Case7 = hexstr2bin("9b09ffa71b942fcb27635fbcd5b0e944" - "bfdc63644f0713938a7f51535c3a35e2"), - hmac_rfc4231_cases_do(sha256, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha384_do() -> - Case1 = hexstr2bin("afd03944d84895626b0825f4ab46907f" - "15f9dadbe4101ec682aa034c7cebc59c" - "faea9ea9076ede7f4af152e8b2fa9cb6"), - Case2 = hexstr2bin("af45d2e376484031617f78d2b58a6b1b" - "9c7ef464f5a01b47e42ec3736322445e" - "8e2240ca5e69e2c78b3239ecfab21649"), - Case3 = hexstr2bin("88062608d3e6ad8a0aa2ace014c8a86f" - "0aa635d947ac9febe83ef4e55966144b" - "2a5ab39dc13814b94e3ab6e101a34f27"), - Case4 = hexstr2bin("3e8a69b7783c25851933ab6290af6ca7" - "7a9981480850009cc5577c6e1f573b4e" - "6801dd23c4a7d679ccf8a386c674cffb"), - Case5 = hexstr2bin("3abf34c3503b2a23a46efc619baef897"), - Case6 = hexstr2bin("4ece084485813e9088d2c63a041bc5b4" - "4f9ef1012a2b588f3cd11f05033ac4c6" - "0c2ef6ab4030fe8296248df163f44952"), - Case7 = hexstr2bin("6617178e941f020d351e2f254e8fd32c" - "602420feb0b8fb9adccebb82461e99c5" - "a678cc31e799176d3860e6110c46523e"), - hmac_rfc4231_cases_do(sha384, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_sha512_do() -> - Case1 = hexstr2bin("87aa7cdea5ef619d4ff0b4241a1d6cb0" - "2379f4e2ce4ec2787ad0b30545e17cde" - "daa833b7d6b8a702038b274eaea3f4e4" - "be9d914eeb61f1702e696c203a126854"), - Case2 = hexstr2bin("164b7a7bfcf819e2e395fbe73b56e0a3" - "87bd64222e831fd610270cd7ea250554" - "9758bf75c05a994a6d034f65f8f0e6fd" - "caeab1a34d4a6b4b636e070a38bce737"), - Case3 = hexstr2bin("fa73b0089d56a284efb0f0756c890be9" - "b1b5dbdd8ee81a3655f83e33b2279d39" - "bf3e848279a722c806b485a47e67c807" - "b946a337bee8942674278859e13292fb"), - Case4 = hexstr2bin("b0ba465637458c6990e5a8c5f61d4af7" - "e576d97ff94b872de76f8050361ee3db" - "a91ca5c11aa25eb4d679275cc5788063" - "a5f19741120c4f2de2adebeb10a298dd"), - Case5 = hexstr2bin("415fad6271580a531d4179bc891d87a6"), - Case6 = hexstr2bin("80b24263c7c1a3ebb71493c1dd7be8b4" - "9b46d1f41b4aeec1121b013783f8f352" - "6b56d037e05f2598bd0fd2215d6a1e52" - "95e64f73f63f0aec8b915a985d786598"), - Case7 = hexstr2bin("e37b6a775dc87dbaa4dfa9f96e5e3ffd" - "debd71f8867289865df5a32d20cdc944" - "b6022cac3c4982b10d5eeb55c3e4de15" - "134676fb6de0446065c97440fa8c6a58"), - hmac_rfc4231_cases_do(sha512, [Case1, Case2, Case3, Case4, Case5, Case6, Case7]). - -hmac_rfc4231_cases_do(Hash, CasesData) -> - hmac_rfc4231_cases_do(Hash, [case1, case2, case3, case4, case5, case6, case7], CasesData). - -hmac_rfc4231_cases_do(_Hash, _, []) -> - ok; -hmac_rfc4231_cases_do(Hash, [C|Cases], [D|CasesData]) -> - hmac_rfc4231_case(Hash, C, D), - hmac_rfc4231_cases_do(Hash, Cases, CasesData). - -hmac_update_md5_io(doc) -> - ["Generate an MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5_io(suite) -> - []; -hmac_update_md5_io(Config) when is_list(Config) -> - ?line Key = ["A fine speach", "by a fine man!"], - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(md5, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final(Ctx3), - ?line Exp = crypto:md5_mac(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). - - -hmac_update_md5_n(doc) -> - ["Generate a shortened MD5 HMAC using hmac_init, hmac_update, and hmac_final. " - "Expected values for examples are generated using crypto:md5_mac." ]; -hmac_update_md5_n(suite) -> - []; -hmac_update_md5_n(Config) when is_list(Config) -> - ?line Key = ["A fine speach", "by a fine man!"], - ?line Data = "Sampl", - ?line Data2 = "e #1", - ?line Ctx = crypto:hmac_init(md5, Key), - ?line Ctx2 = crypto:hmac_update(Ctx, Data), - ?line Ctx3 = crypto:hmac_update(Ctx2, Data2), - ?line Mac = crypto:hmac_final_n(Ctx3, 12), - ?line Exp = crypto:md5_mac_96(Key, lists:flatten([Data, Data2])), - ?line m(Exp, Mac). -%% -%% -ripemd160(doc) -> - ["Generate RIPEMD160 message digests and check the result."]; -ripemd160(suite) -> - []; -ripemd160(Config) when is_list(Config) -> - ?line m(crypto:hash(ripemd160,"abc"), - hexstr2bin("8EB208F7E05D987A9B044A8E98C6B087F15A0BFC")), - ?line m(crypto:hash(ripemd160,"abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). - - -%% -%% -ripemd160_update(doc) -> - ["Generate RIPEMD160 message digests by using ripemd160_init," - "ripemd160_update, and ripemd160_final and check the result."]; -ripemd160_update(suite) -> - []; -ripemd160_update(Config) when is_list(Config) -> - ?line Ctx = crypto:hash_init(ripemd160), - ?line Ctx1 = crypto:hash_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:hash_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:hash_final(Ctx2), - hexstr2bin("12A053384A9C0C88E405A06C27DCF49ADA62EB2B")). - -%% -%% -sha_update(doc) -> - ["Generate SHA message digests by using sha_init, sha_update, and" - "sha_final, and check the result. Examples are from FIPS-180-1."]; -sha_update(suite) -> - []; -sha_update(Config) when is_list(Config) -> - ?line Ctx = crypto:sha_init(), - ?line Ctx1 = crypto:sha_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:sha_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:sha_final(Ctx2), - hexstr2bin("84983E441C3BD26EBAAE4AA1F95129E5E54670F1")). - -%% -%% -sha256(doc) -> - ["Generate SHA-256 message digests and check the result. Examples are " - "from rfc-4634."]; -sha256(suite) -> - []; -sha256(Config) when is_list(Config) -> - if_supported(sha256, fun() -> sha256_do() end). - -sha256_do() -> - ?line m(crypto:hash(sha256, "abc"), - hexstr2bin("BA7816BF8F01CFEA4141" - "40DE5DAE2223B00361A396177A9CB410FF61F20015AD")), - ?line m(crypto:hash(sha256, "abcdbcdecdefdefgefghfghighijhijkijkljklmklm" - "nlmnomnopnopq"), - hexstr2bin("248D6A61D20638B8" - "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). - -%% -%% -sha256_update(doc) -> - ["Generate SHA256 message digests by using sha256_init, sha256_update, and" - "sha256_final, and check the result. Examples are from rfc-4634."]; -sha256_update(suite) -> - []; -sha256_update(Config) when is_list(Config) -> - if_supported(sha256, fun() -> sha256_update_do() end). - -sha256_update_do() -> - ?line Ctx = crypto:hash_init(sha256), - ?line Ctx1 = crypto:hash_update(Ctx, "abcdbcdecdefdefgefghfghighi"), - ?line Ctx2 = crypto:hash_update(Ctx1, "jhijkijkljklmklmnlmnomnopnopq"), - ?line m(crypto:hash_final(Ctx2), - hexstr2bin("248D6A61D20638B8" - "E5C026930C3E6039A33CE45964FF2167F6ECEDD419DB06C1")). - - -%% -%% -sha512(doc) -> - ["Generate SHA-512 message digests and check the result. Examples are " - "from rfc-4634."]; -sha512(suite) -> - []; -sha512(Config) when is_list(Config) -> - if_supported(sha512, fun() -> sha512_do() end). - -sha512_do() -> - ?line m(crypto:hash(sha512, "abc"), - hexstr2bin("DDAF35A193617ABACC417349AE20413112E6FA4E89A97EA2" - "0A9EEEE64B55D39A2192992A274FC1A836BA3C23A3FEEBBD" - "454D4423643CE80E2A9AC94FA54CA49F")), - ?line m(crypto:hash(sha512, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn" - "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), - hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" - "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" - "C7D329EEB6DD26545E96E55B874BE909")). - -%% -%% -sha512_update(doc) -> - ["Generate SHA512 message digests by using sha512_init, sha512_update, and" - "sha512_final, and check the result. Examples are from rfc=4634."]; -sha512_update(suite) -> - []; -sha512_update(Config) when is_list(Config) -> - if_supported(sha512, fun() -> sha512_update_do() end). - -sha512_update_do() -> - ?line Ctx = crypto:hash_init(sha512), - ?line Ctx1 = crypto:hash_update(Ctx, "abcdefghbcdefghicdefghijdefghijkefghijklfghijklmghijklmn"), - ?line Ctx2 = crypto:hash_update(Ctx1, "hijklmnoijklmnopjklmnopqklmnopqrlmnopqrsmnopqrstnopqrstu"), - ?line m(crypto:hash_final(Ctx2), - hexstr2bin("8E959B75DAE313DA8CF4F72814FC143F8F7779C6EB9F7FA1" - "7299AEADB6889018501D289E4900F7E4331B99DEC4B5433A" - "C7D329EEB6DD26545E96E55B874BE909")). - -%% -%% -md5_mac(doc) -> - ["Generate some HMACs, using MD5, and check the result. Examples are " - "from RFC-2104."]; -md5_mac(suite) -> - []; -md5_mac(Config) when is_list(Config) -> - ?line m(crypto:md5_mac(hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), - "Hi There"), - hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")), - ?line m(crypto:md5_mac(list_to_binary("Jefe"), - "what do ya want for nothing?"), - hexstr2bin("750c783e6ab0b503eaa86e310a5db738")), - ?line m(crypto:md5_mac(hexstr2bin("AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA"), - hexstr2bin("DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD" - "DDDDDDDDDDDDDDDDDDDD")), - hexstr2bin("56be34521d144c88dbb8c733f0e8b3f6")). - -%% -%% -md5_mac_io(doc) -> - ["Generate some HMACs, using MD5, with Key an IO-list, and check the " - "result. Examples are from RFC-2104."]; -md5_mac_io(suite) -> - []; -md5_mac_io(Config) when is_list(Config) -> - ?line Key1 = hexstr2bin("0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b"), - ?line {B11, B12} = split_binary(Key1, 4), - ?line Key11 = [B11,binary_to_list(B12)], - ?line m(crypto:md5_mac(Key11, "Hi There"), - hexstr2bin("9294727a3638bb1c13f48ef8158bfc9d")). - -%% -%% -des_cbc(doc) -> - "Encrypt and decrypt according to CBC DES. and check the result. " - "Example are from FIPS-81."; -des_cbc(suite) -> - []; -des_cbc(Config) when is_list(Config) -> - if_supported(des_cbc, fun des_cbc_do/0). - -des_cbc_do() -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des_cbc_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")), - ?line m(list_to_binary(Plain), - crypto:des_cbc_decrypt(Key, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" - "9484521388fa59ae67d58d2e77e86062733")), - ?line m(list_to_binary(Plain2), - crypto:des_cbc_decrypt(Key, IVec, Cipher2)). - -%% -%% -des_cbc_iter(doc) -> - "Encrypt and decrypt according to CBC DES in two steps, and " - "check the result. Example are from FIPS-81."; -des_cbc_iter(suite) -> - []; -des_cbc_iter(Config) when is_list(Config) -> - if_supported(des_cbc, fun des_cbc_iter_do/0). - -des_cbc_iter_do() -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain1 = "Now is the time ", - ?line Plain2 = "for all ", - ?line Cipher1 = crypto:des_cbc_encrypt(Key, IVec, Plain1), - ?line IVec2 = crypto:des_cbc_ivec(Cipher1), - ?line Cipher2 = crypto:des_cbc_encrypt(Key, IVec2, Plain2), - ?line Cipher = list_to_binary([Cipher1, Cipher2]), - ?line m(Cipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")). - -%% -%% -des_cfb(doc) -> - "Encrypt and decrypt according to CFB DES. and check the result. " - "Example is from FIPS-81."; -des_cfb(suite) -> - []; -des_cfb(Config) when is_list(Config) -> - if_supported(des_cfb, fun des_cfb_do/0). - -des_cfb_do() -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the", - ?line Cipher = crypto:des_cfb_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")), - ?line m(list_to_binary(Plain), - crypto:des_cfb_decrypt(Key, IVec, Cipher)). - -%% -%% -des_cfb_iter(doc) -> - "Encrypt and decrypt according to CFB DES in two steps, and " - "check the result. Example is from FIPS-81."; -des_cfb_iter(suite) -> - []; -des_cfb_iter(Config) when is_list(Config) -> - if_supported(des_cfb, fun des_cfb_iter_do/0). - -des_cfb_iter_do() -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain1 = "Now i", - ?line Plain2 = "s the", - ?line Cipher1 = crypto:des_cfb_encrypt(Key, IVec, Plain1), - ?line IVec2 = crypto:des_cfb_ivec(IVec, Cipher1), - ?line Cipher2 = crypto:des_cfb_encrypt(Key, IVec2, Plain2), - ?line Cipher = list_to_binary([Cipher1, Cipher2]), - ?line m(Cipher, hexstr2bin("f31fda07011462ee187f")). - -%% -%% -des_ecb(doc) -> - "Encrypt and decrypt according to ECB DES and check the result. " - "Example are from FIPS-81."; -des_ecb(suite) -> - []; -des_ecb(Config) when is_list(Config) -> - if_supported(des_ecb, fun des_ecb_do/0). - -des_ecb_do() -> - ?line Key = hexstr2bin("0123456789abcdef"), - ?line Cipher1 = crypto:des_ecb_encrypt(Key, "Now is t"), - ?line m(Cipher1, hexstr2bin("3fa40e8a984d4815")), - ?line Cipher2 = crypto:des_ecb_encrypt(Key, "he time "), - ?line m(Cipher2, hexstr2bin("6a271787ab8883f9")), - ?line Cipher3 = crypto:des_ecb_encrypt(Key, "for all "), - ?line m(Cipher3, hexstr2bin("893d51ec4b563b53")), - ?line Cipher4 = crypto:des_ecb_decrypt(Key, hexstr2bin("3fa40e8a984d4815")), - ?line m(Cipher4, <<"Now is t">>), - ?line Cipher5 = crypto:des_ecb_decrypt(Key, hexstr2bin("6a271787ab8883f9")), - ?line m(Cipher5, <<"he time ">>), - ?line Cipher6 = crypto:des_ecb_decrypt(Key, hexstr2bin("893d51ec4b563b53")), - ?line m(Cipher6, <<"for all ">>). -%% -%% -rc2_cbc(doc) -> - "Encrypt and decrypt according to RC2 CBC and check the result. " - "Example stripped out from public_key application test"; -rc2_cbc(Config) when is_list(Config) -> - if_supported(rc2_cbc, fun rc2_cbc_do/0). - -rc2_cbc_do() -> - Key = <<146,210,160,124,215,227,153,239,227,17,222,140,3,93,27,191>>, - IV = <<72,91,135,182,25,42,35,210>>, - - Cipher = <<36,245,206,158,168,230,58,69,148,137,32,192,250,41,237,181,181,251, 192,2,175,135,177,171,57,30,111,117,159,149,15,28,88,158,28,81,28,115, 85,219,241,82,117,222,91,85,73,117,164,25,182,52,191,64,123,57,26,19, 211,27,253,31,194,219,231,104,247,240,172,130,119,21,225,154,101,247, 32,216,42,216,133,169,78,22,97,27,227,26,196,224,172,168,17,9,148,55, 203,91,252,40,61,226,236,221,215,160,78,63,13,181,68,57,196,241,185, 207, 116,129,152,237,60,139,247,153,27,146,161,246,222,98,185,222,152, 187,135, 236,86,34,7,110,91,230,173,34,160,242,202,222,121,127,181,140, 101,203,195, 190,88,250,86,147,127,87,72,126,171,16,71,47,110,248,88, 14,29,143,161,152, 129,236,148,22,152,186,208,119,70,8,174,193,203,100, 193,203,200,117,102,242, 134,142,96,125,135,200,217,190,76,117,50,70, 209,186,101,241,200,91,40,193,54, 90,195,38,47,59,197,38,234,86,223,16, 51,253,204,129,20,171,66,21,241,26,135,216, 196,114,110,91,15,53,40, 164,201,136,113,95,247,51,181,208,241,68,168,98,151,36, 155,72,24,57, 42,191,14,125,204,10,167,214,233,138,115,125,234,121,134,227,26,247, 77,200,117,110,117,111,168,156,206,67,159,149,189,173,150,193,91,199, 216,153,22, 189,137,185,89,160,13,131,132,58,109,28,110,246,252,251,14, 232,91,38,52,29,101,188,69,123,50,0,130,178,93,73,239,118,7,77,35,59, 253,10,159,45,86,142,37,78,232,48>>, - Text = <<48,130,1,85,2,1,0,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,4,130,1,63,48,130, 1,59,2,1,0,2,65,0,222,187,252,44,9,214,27,173,162,169,70,47,36,34,78,84,204, 107,60,192,117,95,21,206,49,142,245,126,121,223,23,2,107,106,133,204,161,36, 40,2,114,69,4,93,242,5,42,50,154,47,154,211,209,123,120,161,5,114,173,155,34, 191,52,59,2,3,1,0,1,2,64,45,144,169,106,220,236,71,39,67,82,123,192,35,21,61, 143,13,110,150,180,12,142,210,40,39,109,70,125,132,51,6,66,159,134,112,85, 155,243,118,221,65,133,127,99,151,194,252,141,149,224,229,62,214,45,228,32, 184,85,67,14,228,161,184,161,2,33,0,255,202,240,131,130,57,49,224,115,255,83, 79,6,165,212,21,179,212,20,188,97,74,69,68,163,223,247,237,39,24,23,235,2,33, 0,222,234,48,36,33,23,219,45,59,136,55,245,143,29,165,48,255,131,207,146,131, 104,13,163,54,131,236,78,88,54,16,241,2,33,0,230,2,99,129,173,176,166,131, 241,106,143,76,9,107,70,41,121,185,228,39,124,200,159,62,216,169,5,180,111, 169,255,159,2,33,0,151,193,70,212,209,210,179,219,175,83,165,4,255,81,103,76, 92,39,24,0,222,132,208,3,244,241,10,198,171,54,227,129,2,32,43,250,20,31,16, 189,168,116,225,1,125,132,94,130,118,124,28,56,232,39,69,218,244,33,240,200, 205,9,215,101,35,135,7,7,7,7,7,7,7>>, - - Text = crypto:rc2_cbc_decrypt(Key, IV, Cipher), - Cipher = crypto:rc2_cbc_encrypt(Key, IV, Text). - -%% -%% -des3_cbc(doc) -> - "Encrypt and decrypt according to CBC 3DES, and check the result."; -des3_cbc(suite) -> - []; -des3_cbc(Config) when is_list(Config) -> - if_supported(des3_cbc, fun des3_cbc_do/0). - -des3_cbc_do() -> - ?line Key1 = hexstr2bin("0123456789abcdef"), - ?line Key2 = hexstr2bin("fedcba9876543210"), - ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain), - ?line m(Cipher, hexstr2bin("8a2667ee5577267cd9b1af2c5a0480" - "0bac1ae66970fb2b89")), - ?line m(list_to_binary(Plain), - crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des3_cbc_encrypt(Key1, Key2, Key3, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("eb33ec6ede2c8e90f6877e77b95d5" - "4c83cee22907f7f0041ca1b7abe202bfafe")), - ?line m(list_to_binary(Plain2), - crypto:des3_cbc_decrypt(Key1, Key2, Key3, IVec, Cipher2)), - - ?line Key = hexstr2bin("0123456789abcdef"), - ?line DESCipher = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain), - ?line m(DESCipher, hexstr2bin("e5c7cdde872bf27c43e934008c389c" - "0f683788499a7c05f6")), - ?line m(list_to_binary(Plain), - crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher)), - ?line DESCipher2 = crypto:des3_cbc_encrypt(Key, Key, Key, IVec, Plain2), - ?line m(DESCipher2, hexstr2bin("b9916b8ee4c3da64b4f44e3cbefb9" - "9484521388fa59ae67d58d2e77e86062733")), - ?line m(list_to_binary(Plain2), - crypto:des3_cbc_decrypt(Key, Key, Key, IVec, DESCipher2)). - -%% -%% -des3_cbf(doc) -> - "Encrypt and decrypt according to CFB 3DES, and check the result."; -des3_cbf(suite) -> - []; -des3_cbf(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#90705F -> {skipped,"OpenSSL version too old"}; - _ -> - if_supported(des3_cbf, fun des3_cfb_do/0) - end. - -%% -%% -des3_cfb(doc) -> - "Encrypt and decrypt according to CFB 3DES, and check the result."; -des3_cfb(suite) -> - []; -des3_cfb(Config) when is_list(Config) -> - case openssl_version() of - V when V < 16#90705F -> {skipped,"OpenSSL version too old"}; - _ -> - if_supported(des3_cfb, fun des3_cfb_do/0) - end. - -des3_cfb_do() -> - ?line Key1 = hexstr2bin("0123456789abcdef"), - ?line Key2 = hexstr2bin("fedcba9876543210"), - ?line Key3 = hexstr2bin("0f2d4b6987a5c3e1"), - ?line IVec = hexstr2bin("1234567890abcdef"), - ?line Plain = "Now is the time for all ", - ?line Cipher = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain), - ?line m(Cipher, hexstr2bin("fc0ba7a20646ba53cc8bff263f0937" - "1deab42a00666db02c")), - ?line m(list_to_binary(Plain), - crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher)), - ?line Plain2 = "7654321 Now is the time for " ++ [0, 0, 0, 0], - ?line Cipher2 = crypto:des3_cfb_encrypt(Key1, Key2, Key3, IVec, Plain2), - ?line m(Cipher2, hexstr2bin("8582c59ac01897422632c0accb66c" - "e413f5efab838fce7e41e2ba67705bad5bc")), - ?line m(list_to_binary(Plain2), - crypto:des3_cfb_decrypt(Key1, Key2, Key3, IVec, Cipher2)). - -%% -%% -aes_cfb(doc) -> - "Encrypt and decrypt according to AES CFB 128 bit and check " - "the result. Example are from NIST SP 800-38A."; - -aes_cfb(suite) -> - []; -aes_cfb(Config) when is_list(Config) -> - -%% Sample data from NIST Spec.Publ. 800-38A -%% F.3.13 CFB128-AES128.Encrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f -%% Segment #1 -%% Input Block 000102030405060708090a0b0c0d0e0f -%% Output Block 50fe67cc996d32b6da0937e99bafec60 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Ciphertext 3b3fd92eb72dad20333449f8e83cfb4a -%% Segment #2 -%% Input Block 3b3fd92eb72dad20333449f8e83cfb4a -%% Output Block 668bcf60beb005a35354a201dab36bda -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Ciphertext c8a64537a0b3a93fcde3cdad9f1ce58b -%% Segment #3 -%% Input Block c8a64537a0b3a93fcde3cdad9f1ce58b -%% Output Block 16bd032100975551547b4de89daea630 -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Ciphertext 26751f67a3cbb140b1808cf187a4f4df -%% Segment #4 -%% Input Block 26751f67a3cbb140b1808cf187a4f4df -%% Output Block 36d42170a312871947ef8714799bc5f6 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 -%% Ciphertext c04b05357c5d1c0eeac4c66f9ff7f2e6 - - ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), - ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), - ?line Cipher = hexstr2bin("3b3fd92eb72dad20333449f8e83cfb4a"), - - %% Try all prefixes of plain and cipher. - aes_cfb_do(byte_size(Plain), Plain, Cipher, Key, IVec). - -aes_cfb_do(N, Plain, Cipher, Key, IVec) when N >= 0 -> - <<P:N/binary, _/binary>> = Plain, - <<C:N/binary, _/binary>> = Cipher, - ?line C = crypto:aes_cfb_128_encrypt(Key, IVec, P), - ?line P = crypto:aes_cfb_128_decrypt(Key, IVec, C), - aes_cfb_do(N-1, Plain, Cipher, Key, IVec); -aes_cfb_do(_, _, _, _, _) -> ok. - - -%% -%% -aes_cbc(doc) -> - "Encrypt and decrypt according to AES CBC 128 bit. and check the result. " - "Example are from NIST SP 800-38A."; - -aes_cbc(suite) -> - []; -aes_cbc(Config) when is_list(Config) -> - -%% Sample data from NIST Spec.Publ. 800-38A -%% F.2.1 CBC-AES128.Encrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f -%% Block #1 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Input Block 6bc0bce12a459991e134741a7f9e1925 -%% Output Block 7649abac8119b246cee98e9b12e9197d -%% Ciphertext 7649abac8119b246cee98e9b12e9197d -%% Block #2 -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Input Block d86421fb9f1a1eda505ee1375746972c -%% Output Block 5086cb9b507219ee95db113a917678b2 -%% Ciphertext 5086cb9b507219ee95db113a917678b2 -%% Block #3 -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Input Block 604ed7ddf32efdff7020d0238b7c2a5d -%% Output Block 73bed6b8e3c1743b7116e69e22229516 -%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 -%% Block #4 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 -%% Input Block 8521f2fd3c8eef2cdc3da7e5c44ea206 -%% Output Block 3ff1caa1681fac09120eca307586e1a7 -%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 -%% -%% F.2.2 CBC-AES128.Decrypt -%% Key 2b7e151628aed2a6abf7158809cf4f3c -%% IV 000102030405060708090a0b0c0d0e0f - %% Block #1 -%% Ciphertext 7649abac8119b246cee98e9b12e9197d -%% Input Block 7649abac8119b246cee98e9b12e9197d -%% Output Block 6bc0bce12a459991e134741a7f9e1925 -%% Plaintext 6bc1bee22e409f96e93d7e117393172a -%% Block #2 -%% Ciphertext 5086cb9b507219ee95db113a917678b2 -%% Input Block 5086cb9b507219ee95db113a917678b2 -%% Output Block d86421fb9f1a1eda505ee1375746972c -%% Plaintext ae2d8a571e03ac9c9eb76fac45af8e51 -%% Block #3 -%% Ciphertext 73bed6b8e3c1743b7116e69e22229516 -%% Input Block 73bed6b8e3c1743b7116e69e22229516 -%% Output Block 604ed7ddf32efdff7020d0238b7c2a5d -%% Plaintext 30c81c46a35ce411e5fbc1191a0a52ef -%% Block #4 -%% Ciphertext 3ff1caa1681fac09120eca307586e1a7 -%% Input Block 3ff1caa1681fac09120eca307586e1a7 -%% Output Block 8521f2fd3c8eef2cdc3da7e5c44ea206 -%% Plaintext f69f2445df4f9b17ad2b417be66c3710 - - ?line Key = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - ?line IVec = hexstr2bin("000102030405060708090a0b0c0d0e0f"), - ?line Plain = hexstr2bin("6bc1bee22e409f96e93d7e117393172a"), - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), - ?line m(Cipher, hexstr2bin("7649abac8119b246cee98e9b12e9197d")), - ?line m(Plain, - crypto:aes_cbc_128_decrypt(Key, IVec, Cipher)). - -aes_cbc_iter(doc) -> - "Encrypt and decrypt according to CBC AES in steps"; -aes_cbc_iter(suite) -> []; -aes_cbc_iter(Config) when is_list(Config) -> - Key = list_to_binary(lists:seq(255,256-16*17,-17)), - IVec = list_to_binary(lists:seq(1,16*7,7)), - Plain = <<"One, two, three o'clock, four o'clock, rock" - "Five, six, seven o'clock, eight o'clock, rock" - "Nine, ten, eleven o'clock, twelve o'clock, rock" - "We're gonna rock around the clock tonight">>, - ?line 0 = size(Plain) rem 16, - - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Plain), - ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Cipher), - - ?line Cipher = aes_cbc_encrypt_iter(Key,IVec,Plain,<<>>), - ?line Plain = aes_cbc_decrypt_iter(Key,IVec,Cipher,<<>>), - ok. - -aes_cbc_encrypt_iter(_,_,<<>>, Acc) -> - Acc; -aes_cbc_encrypt_iter(Key,IVec,Data, Acc) -> - Bytes = 16 * (1 + size(Data) div (16*3)), - <<Chunk:Bytes/binary, Rest/binary>> = Data, - %%io:format("encrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), - ?line Cipher = crypto:aes_cbc_128_encrypt(Key, IVec, Chunk), - ?line IVec2 = crypto:aes_cbc_ivec(Cipher), - aes_cbc_encrypt_iter(Key,IVec2,Rest, <<Acc/binary, Cipher/binary>>). - -aes_cbc_decrypt_iter(_,_,<<>>, Acc) -> - Acc; -aes_cbc_decrypt_iter(Key,IVec,Data, Acc) -> - Bytes = 16 * (1 + size(Data) div (16*5)), - <<Chunk:Bytes/binary, Rest/binary>> = Data, - %%io:format("decrypt iter Chunk=~p Rest=~p\n",[Chunk,Rest]), - ?line Plain = crypto:aes_cbc_128_decrypt(Key, IVec, Chunk), - ?line IVec2 = crypto:aes_cbc_ivec(Chunk), - aes_cbc_decrypt_iter(Key,IVec2,Rest, <<Acc/binary, Plain/binary>>). - - -aes_ctr(doc) -> "CTR"; -aes_ctr(Config) when is_list(Config) -> - %% Sample data from NIST Spec.Publ. 800-38A - %% F.5.1 CTR-AES128.Encrypt - Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "874d6191b620e3261bef6864990db6ce"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "9806f66b7970fdff8617187bb9fffdff"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "5ae4df3edbd5d35e5b4f09020db03eab"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "1e031dda2fbe03d1792170a0f3009cee"}], - lists:foreach(fun(S) -> aes_ctr_do(Key128,S) end, Samples128), - - %% F.5.3 CTR-AES192.Encrypt - Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), - Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "1abc932417521ca24f2b0459fe7e6e0b"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "090339ec0aa6faefd5ccc2c6f4ce8e94"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "1e36b26bd1ebc670d1bd1d665620abf7"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "4f78a7f6d29809585a97daec58c6b050"}], - lists:foreach(fun(S) -> aes_ctr_do(Key192,S) end, Samples192), - - %% F.5.5 CTR-AES256.Encrypt - Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), - Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - "6bc1bee22e409f96e93d7e117393172a", % Plaintext - "601ec313775789a5b7a7f504bbf3d228"},% Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - "ae2d8a571e03ac9c9eb76fac45af8e51", - "f443e3ca4d62b59aca84e990cacaf5c5"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - "30c81c46a35ce411e5fbc1191a0a52ef", - "2b0930daa23de94ce87017ba2d84988d"}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - "f69f2445df4f9b17ad2b417be66c3710", - "dfc9c58db67aada613c2dd08457941a6"}], - lists:foreach(fun(S) -> aes_ctr_do(Key256,S) end, Samples256). - - -aes_ctr_do(Key,{IVec, Plain, Cipher}) -> - ?line I = hexstr2bin(IVec), - ?line P = hexstr2bin(Plain), - ?line C = crypto:aes_ctr_encrypt(Key, I, P), - ?line m(C, hexstr2bin(Cipher)), - ?line m(P, crypto:aes_ctr_decrypt(Key, I, C)). - -aes_ctr_stream(doc) -> "CTR Streaming"; -aes_ctr_stream(Config) when is_list(Config) -> - %% Sample data from NIST Spec.Publ. 800-38A - %% F.5.1 CTR-AES128.Encrypt - Key128 = hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), - Samples128 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f", "96e93d7e117393172a"], % Plaintext - ["874d6191b620e3261bef6864990db6ce"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a57", "1e03ac9c", "9eb76fac", "45af8e51"], - ["9806f66b7970fdff","8617187bb9fffdff"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46a35c", "e411e5fbc119", "1a0a52ef"], - ["5ae4df3e","dbd5d3","5e5b4f0902","0db03eab"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445df4f9b17ad2b417be66c3710"], - ["1e031dda2fbe","03d1792170a0","f3009cee"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key128,S) end, Samples128), - - %% F.5.3 CTR-AES192.Encrypt - Key192 = hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), - Samples192 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f96e93d7e117393172a"], % Plaintext - ["1abc9324","17521c","a24f2b04","59fe7e6e0b"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a57", "1e03ac9c9eb76fac", "45af8e51"], - ["090339ec0aa6faefd5ccc2c6f4ce8e94"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46a35ce411", "e5fbc1191a0a52ef"], - ["1e36b26bd1","ebc670d1bd1d","665620abf7"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445", "df4f9b17ad", "2b417be6", "6c3710"], - ["4f78a7f6d2980958","5a97daec58c6b050"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key192,S) end, Samples192), - - %% F.5.5 CTR-AES256.Encrypt - Key256 = hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), - Samples256 = [{"f0f1f2f3f4f5f6f7f8f9fafbfcfdfeff", % Input Block - ["6bc1bee22e409f96", "e93d7e117393172a"], % Plaintext - ["601ec313775789", "a5b7a7f504bbf3d228"]}, % Ciphertext - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff00", - ["ae2d8a571e03ac9c9eb76fac45af8e51"], - ["f443e3ca","4d62b59aca84","e990cacaf5c5"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff01", - ["30c81c46","a35ce411","e5fbc119","1a0a52ef"], - ["2b0930daa23de94ce87017ba2d84988d"]}, - {"f0f1f2f3f4f5f6f7f8f9fafbfcfdff02", - ["f69f2445df4f","9b17ad2b41","7be66c3710"], - ["dfc9c5","8db67aada6","13c2dd08","457941a6"]}], - lists:foreach(fun(S) -> aes_ctr_stream_do(Key256,S) end, Samples256). - - -aes_ctr_stream_do(Key,{IVec, PlainList, CipherList}) -> - ?line I = hexstr2bin(IVec), - ?line S = crypto:aes_ctr_stream_init(Key, I), - ?line C = aes_ctr_stream_do_iter( - S, PlainList, [], - fun(S2,P) -> crypto:aes_ctr_stream_encrypt(S2, P) end), - ?line m(C, hexstr2bin(lists:flatten(CipherList))), - ?line P = aes_ctr_stream_do_iter( - S, CipherList, [], - fun(S2,C2) -> crypto:aes_ctr_stream_decrypt(S2, C2) end), - ?line m(P, hexstr2bin(lists:flatten(PlainList))). - -aes_ctr_stream_do_iter(_State, [], Acc, _CipherFun) -> - iolist_to_binary(lists:reverse(Acc)); -aes_ctr_stream_do_iter(State, [Plain|Rest], Acc, CipherFun) -> - ?line P = hexstr2bin(Plain), - ?line {S2, C} = CipherFun(State, P), - aes_ctr_stream_do_iter(S2, Rest, [C | Acc], CipherFun). - -%% -%% -mod_exp_test(doc) -> - "mod_exp testing (A ^ M % P with bignums)"; -mod_exp_test(suite) -> - []; -mod_exp_test(Config) when is_list(Config) -> - mod_exp_aux_test(2, 5, 10, 8). - -mod_exp_aux_test(_, _, _, 0) -> - ok; -mod_exp_aux_test(B, E, M, N) -> - ?line R1 = crypto:mod_exp(B, E, M), - ?line R2 = ipow(B, E, M), - ?line m(R1, R2), - ?line mod_exp_aux_test(B, E*E+1, M*M+1, N-1). - -%% -%% -rand_uniform_test(doc) -> - "rand_uniform and random_bytes testing"; -rand_uniform_test(suite) -> - []; -rand_uniform_test(Config) when is_list(Config) -> - rand_uniform_aux_test(10), - ?line 10 = size(crypto:rand_bytes(10)). - -rand_uniform_aux_test(0) -> - ok; -rand_uniform_aux_test(N) -> - ?line L = N*1000, - ?line H = N*100000+1, - ?line crypto_rand_uniform(L, H), - ?line crypto_rand_uniform(-L, L), - ?line crypto_rand_uniform(-H, -L), - ?line crypto_rand_uniform(-H, L), - ?line rand_uniform_aux_test(N-1). - -crypto_rand_uniform(L,H) -> - ?line R1 = crypto:rand_uniform(L, H), - ?line t(R1 >= L), - ?line t(R1 < H). - - -%% -%% -strong_rand_test(doc) -> - "strong_rand_mpint and strong_random_bytes testing"; -strong_rand_test(suite) -> - []; -strong_rand_test(Config) when is_list(Config) -> - strong_rand_aux_test(180), - ?line 10 = byte_size(crypto:strong_rand_bytes(10)). - -strong_rand_aux_test(0) -> - ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), - ok; -strong_rand_aux_test(1) -> - ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), - ?line strong_rand_aux_test(0); -strong_rand_aux_test(N) -> - ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), - ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), - ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), - ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), - ?line strong_rand_aux_test(N-1). - -sru_length(Mpint) -> - I = crypto:erlint(Mpint), - length(erlang:integer_to_list(I, 2)). - -%% -%% -%% -%% -rsa_verify_test(doc) -> - "rsa_verify testing (A ^ M % P with bignums)"; -rsa_verify_test(suite) -> - []; -rsa_verify_test(Config) when is_list(Config) -> - ?line H = <<178,28,54,104,36,80,144,66,140,201,135,17,36,97,114,124, - 194,164,172,147>>, - ?line SigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, - 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, - 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, - 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, - 115,34,107,227,151,47,80,185,143,85,202,55,245,163,226,26, - 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, - 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, - 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, - ?line BadSigBlob = <<153,44,121,71,132,1,192,159,78,33,29,62,153,64,191,70, - 208,239,166,208,220,167,49,111,128,67,91,253,24,63,194,241, - 97,157,135,226,121,162,150,156,60,49,236,90,151,67,239,23, - 92,103,89,254,17,165,78,181,64,128,13,210,86,111,209,76, - 115,107,34,227,151,47,80,185,143,85,202,55,245,163,226,26, - 139,104,196,6,96,82,108,197,13,0,12,70,153,109,107,180, - 130,246,156,182,56,96,31,220,227,218,136,211,252,43,8,14, - 145,155,191,206,72,194,80,52,54,206,53,27,6,188,195,29>>, - ?line E = <<35>>, - ?line N = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, - 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, - 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, - 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, - 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, - 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, - 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, - 76,89,40,33,147,208,189,76,98,24,61,8,10,110,165,119,165>>, - ?line Nbad = <<0,199,209,142,191,86,92,148,103,37,250,217,175,169,109,10, - 130,139,34,237,174,90,97,118,7,185,57,137,252,236,177,193, - 228,16,62,29,153,144,64,207,152,240,152,206,136,89,64,6, - 3,187,89,57,241,219,88,215,75,70,120,20,145,229,37,1, - 67,138,204,17,39,231,249,239,116,142,169,99,149,41,65,123, - 26,225,133,0,41,85,77,181,35,100,162,223,92,220,207,50, - 63,168,193,171,174,199,23,214,201,63,157,76,125,6,54,73, - 76,89,40,33,147,189,208,76,98,24,61,8,10,110,165,119,165>>, - ?line Ebad = <<77>>, - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(E), sized_binary(N)]), true), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(Ebad), sized_binary(N)]), false), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(SigBlob), - [sized_binary(E), sized_binary(Nbad)]), false), - ?line m(crypto:rsa_verify(sized_binary(H), sized_binary(BadSigBlob), - [sized_binary(E), sized_binary(N)]), false). - -%% -%% -dsa_verify_test(doc) -> - "dsa_verify testing (A ^ M % P with bignums)"; -dsa_verify_test(suite) -> - []; -dsa_verify_test(Config) when is_list(Config) -> - ?line Msg = <<48,130,2,245,160,3,2,1,2,2,1,1,48,9,6,7,42,134,72,206,56,4,3,48, - 58,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3,85,4,10,19,17, - 84,101,115,116,32,67,101,114,116,105,102,105,99,97,116,101,115,49, - 15,48,13,6,3,85,4,3,19,6,68,83,65,32,67,65,48,30,23,13,48,49,48, - 52,49,57,49,52,53,55,50,48,90,23,13,49,49,48,52,49,57,49,52,53,55, - 50,48,90,48,93,49,11,48,9,6,3,85,4,6,19,2,85,83,49,26,48,24,6,3, - 85,4,10,19,17,84,101,115,116,32,67,101,114,116,105,102,105,99,97, - 116,101,115,49,50,48,48,6,3,85,4,3,19,41,86,97,108,105,100,32,68, - 83,65,32,83,105,103,110,97,116,117,114,101,115,32,69,69,32,67,101, - 114,116,105,102,105,99,97,116,101,32,84,101,115,116,52,48,130,1, - 182,48,130,1,43,6,7,42,134,72,206,56,4,1,48,130,1,30,2,129,129,0, - 228,139,175,64,140,21,215,61,124,238,3,150,18,104,193,32,5,232,23, - 202,158,116,101,75,154,84,151,42,120,51,218,165,197,114,234,52, - 179,148,104,66,213,27,253,119,240,168,66,158,100,147,144,182,194, - 2,49,70,19,122,3,105,204,152,45,86,157,94,35,95,40,191,173,127,15, - 208,105,149,98,92,26,7,42,94,140,115,73,126,253,18,34,142,85,229, - 86,233,174,114,41,150,135,8,39,215,119,67,240,134,184,9,10,27,20, - 165,230,3,230,69,121,77,233,250,83,95,193,9,189,126,197,195,2,21, - 0,128,63,228,252,243,76,229,62,203,15,23,10,42,84,108,208,103,108, - 13,59,2,129,128,102,212,22,138,32,173,254,209,50,159,165,127,167, - 179,208,234,119,63,235,108,162,228,41,216,216,188,33,221,154,247, - 204,229,180,119,77,223,236,218,162,140,156,117,18,90,31,254,102, - 211,17,194,239,132,67,236,169,136,110,76,186,76,63,53,150,199,103, - 252,153,189,15,153,41,19,145,78,216,2,174,254,107,175,80,86,170, - 47,30,181,42,200,238,34,71,37,120,107,33,221,20,63,206,240,16,129, - 247,150,29,156,65,187,94,68,146,93,46,198,30,184,205,105,200,143, - 63,59,62,208,79,162,206,217,3,129,132,0,2,129,128,15,83,40,172,56, - 47,61,243,17,97,65,195,61,167,214,122,247,246,1,50,211,33,113,16, - 20,213,195,62,77,235,25,162,140,175,158,8,61,65,10,255,204,162,71, - 130,122,86,161,163,253,236,178,139,183,57,181,202,160,25,133,130, - 155,150,104,168,187,107,186,144,164,225,173,101,182,68,49,210,30, - 34,47,83,65,79,250,156,248,47,232,44,67,36,22,126,43,216,100,247, - 100,250,240,121,72,29,185,2,109,144,54,204,235,54,15,242,57,171, - 125,39,236,247,71,111,221,51,196,126,77,238,36,87,163,107,48,105, - 48,29,6,3,85,29,14,4,22,4,20,179,51,215,81,162,4,13,68,251,157,64, - 241,18,98,113,176,83,246,105,13,48,31,6,3,85,29,35,4,24,48,22,128, - 20,116,21,213,36,28,189,94,101,136,31,225,139,9,126,127,234,25,72, - 78,97,48,23,6,3,85,29,32,4,16,48,14,48,12,6,10,96,134,72,1,101,3, - 2,1,48,1,48,14,6,3,85,29,15,1,1,255,4,4,3,2,6,192>>, - - ?line SigBlob = <<48,45,2,21,0,140,167,200,210,153,212,64,155,249,33,146,104,243, - 39,38,9,115,162,89,24,2,20,76,254,31,128,187,48,128,215,216, - 112,198,78,118,160,217,157,180,246,64,234>>, - ?line P_p = 157224271412839155721795253728878055347359513988016145491388196653004661857517720927482198111104095793441029858267073789634147217022008635826863307553453131345099940951090826856271796188522037524757740796268675508118348391218066949174594918958269259937813776150149068811425194955973128428675945283593831134219, - ?line Q_p = 1181895316321540581845959276009400765315408342791, - ?line G_p = 143872196713149000950547166575757355261637863805587906227228163275557375159769599033632918292482002186641475268486598023281100659643528846513898847919251032731261718358900479488287933293278745715922865499005559197328388506945134386346185262919258658109015074718441639029135304654725637911172671711310801418648, - - ?line Key = 12603618348903387232593303690286336220738319446775939686476278478034365380027994899970214309288018488811754534229198764622077544117034174589418477472887827980332636062691833965078594576024299807057520016043084384987871640003684704483975314128362610573625803532737054022545217931847268776098203204571431581966, - - ValidKey = [crypto:mpint(P_p), - crypto:mpint(Q_p), - crypto:mpint(G_p), - crypto:mpint(Key) - ], - - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), - ValidKey), true), - - BadMsg = one_bit_wrong(Msg), - ?line m(my_dss_verify(sized_binary(BadMsg), sized_binary(SigBlob), - ValidKey), false), - BadSig = one_bit_wrong(SigBlob), - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(BadSig), - ValidKey), false), - SizeErr = size(SigBlob) - 13, - - BadArg = (catch my_dss_verify(sized_binary(Msg), <<SizeErr:32, SigBlob/binary>>, - ValidKey)), - badarg = case element(1,element(2,BadArg)) of - badarg -> badarg; - function_clause -> badarg; - X -> X - end, - InValidKey = [crypto:mpint(P_p), - crypto:mpint(Q_p), - crypto:mpint(G_p), - crypto:mpint(Key+17) - ], - - ?line m(my_dss_verify(sized_binary(Msg), sized_binary(SigBlob), - InValidKey), false). - - -one_bit_wrong(List) when is_list(List) -> - lists:map(fun(Bin) -> one_bit_wrong(Bin) end, List); -one_bit_wrong(Bin) -> - Half = size(Bin) div 2, - <<First:Half/binary, Byte:8, Last/binary>> = Bin, - <<First/binary, (Byte+1):8, Last/binary>>. - - -%% -%% Sign tests - -rsa_sign_test(doc) -> - "rsa_sign testing"; -rsa_sign_test(suite) -> - []; -rsa_sign_test(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PrivKey = [PubEx, Mod, PrivEx], - PubKey = [PubEx, Mod], - PubKeyMpint = map_int_to_mpint(PubKey), - Sig1 = crypto:rsa_sign(sized_binary(Msg), map_int_to_mpint(PrivKey)), - Sig1 = crypto:sign(rsa, sha, Msg, PrivKey), - true = crypto:rsa_verify(sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), - true = crypto:verify(rsa, sha, Msg, Sig1, PubKey), - - Sig2 = crypto:rsa_sign(md5, sized_binary(Msg), map_int_to_mpint(PrivKey)), - Sig2 = crypto:sign(rsa, md5, Msg, PrivKey), - true = crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig2), PubKeyMpint), - true = crypto:verify(rsa, md5, Msg, Sig2, PubKey), - - false = (Sig1 =:= Sig2), - false = crypto:rsa_verify(md5, sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), - false = crypto:verify(rsa, md5, Msg, Sig1, PubKey), - true = crypto:rsa_verify(sha, sized_binary(Msg), sized_binary(Sig1), PubKeyMpint), - true = crypto:verify(rsa, sha, Msg, Sig1, PubKey), - - ok. -map_int_to_mpint(List) -> - lists:map(fun(E) -> crypto:mpint(E) end, List). - -rsa_sign_hash_test(doc) -> - "rsa_sign_hash testing"; -rsa_sign_hash_test(suite) -> - []; -rsa_sign_hash_test(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PrivKey = [crypto:mpint(PubEx), crypto:mpint(Mod), crypto:mpint(PrivEx)], - PubKey = [crypto:mpint(PubEx), crypto:mpint(Mod)], - MD5 = crypto:md5(sized_binary(Msg)), - SHA = crypto:sha(sized_binary(Msg)), - ?line Sig1 = crypto:rsa_sign(sha, {digest,SHA}, PrivKey), - ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig1),PubKey), true), - - ?line Sig2 = crypto:rsa_sign(md5, {digest,MD5}, PrivKey), - ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig2),PubKey), true), - - ?line m(Sig1 =:= Sig2, false), - ?line m(crypto:rsa_verify(md5, {digest,MD5}, sized_binary(Sig1),PubKey), false), - ?line m(crypto:rsa_verify(sha, {digest,SHA}, sized_binary(Sig2),PubKey), false), - - ok. - -dsa_sign_test(doc) -> - "dsa_sign testing"; -dsa_sign_test(suite) -> - []; -dsa_sign_test(Config) when is_list(Config) -> - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - - PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, - PrivKey = _X = 441502407453038284293378221372000880210588566361, - ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, - ParamQ = 1349199015905534965792122312016505075413456283393, - ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, - - Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], - ?line Sig1 = my_dss_sign(sized_binary(Msg), Params ++ [crypto:mpint(PrivKey)]), - - ?line m(my_dss_verify(sized_binary(Msg), Sig1, - Params ++ [crypto:mpint(PubKey)]), true), - - ?line m(my_dss_verify(sized_binary(one_bit_wrong(Msg)), Sig1, - Params ++ [crypto:mpint(PubKey)]), false), - - ?line m(my_dss_verify(sized_binary(Msg), one_bit_wrong(Sig1), - Params ++ [crypto:mpint(PubKey)]), false), - - %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), - - ok. - -dsa_sign_hash_test(doc) -> - "dsa_sign_hash testing"; -dsa_sign_hash_test(suite) -> - []; -dsa_sign_hash_test(Config) when is_list(Config) -> - Msg = <<"7896345786348756234 Hejsan Svejsan, erlang crypto debugger" - "09812312908312378623487263487623412039812 huagasd">>, - SHA = crypto:sha(sized_binary(Msg)), - - PubKey = _Y = 25854665488880835237281628794585130313500176551981812527054397586638455298000483144002221850980183404910190346416063318160497344811383498859129095184158800144312512447497510551471331451396405348497845813002058423110442376886564659959543650802132345311573634832461635601376738282831340827591903548964194832978, - PrivKey = _X = 441502407453038284293378221372000880210588566361, - ParamP = 109799869232806890760655301608454668257695818999841877165019612946154359052535682480084145133201304812979481136659521529774182959764860329095546511521488413513097576425638476458000255392402120367876345280670101492199681798674053929238558140260669578407351853803102625390950534052428162468100618240968893110797, - ParamQ = 1349199015905534965792122312016505075413456283393, - ParamG = 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669, - - Params = [crypto:mpint(ParamP), crypto:mpint(ParamQ), crypto:mpint(ParamG)], - ?line Sig1 = crypto:dss_sign(sha, {digest,SHA}, Params ++ [crypto:mpint(PrivKey)]), - - ?line m(crypto:dss_verify(none, SHA, sized_binary(Sig1), - Params ++ [crypto:mpint(PubKey)]), true), - - ?line m(crypto:dss_verify(sized_binary(one_bit_wrong(Msg)), sized_binary(Sig1), - Params ++ [crypto:mpint(PubKey)]), false), - - ?line m(crypto:dss_verify(sized_binary(Msg), sized_binary(one_bit_wrong(Sig1)), - Params ++ [crypto:mpint(PubKey)]), false), - - %%?line Bad = crypto:dss_sign(sized_binary(Msg), [Params, crypto:mpint(PubKey)]), - - ok. - - -rsa_encrypt_decrypt(doc) -> - ["Test rsa_public_encrypt and rsa_private_decrypt functions."]; -rsa_encrypt_decrypt(suite) -> []; -rsa_encrypt_decrypt(Config) when is_list(Config) -> - PubEx = 65537, - PrivEx = 7531712708607620783801185371644749935066152052780368689827275932079815492940396744378735701395659435842364793962992309884847527234216715366607660219930945, - Mod = 7919488123861148172698919999061127847747888703039837999377650217570191053151807772962118671509138346758471459464133273114654252861270845708312601272799123, - - PrivKey = [PubEx, Mod, PrivEx], - PubKey = [PubEx, Mod], - - Msg = <<"7896345786348 Asldi">>, - - ?line PKCS1 = rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_padding), - ?line PKCS1Dec = rsa_private_decrypt(PKCS1, PrivKey, rsa_pkcs1_padding), - io:format("PKCS1Dec ~p~n",[PKCS1Dec]), - ?line Msg = PKCS1Dec, - - ?line OAEP = rsa_public_encrypt(Msg, PubKey, rsa_pkcs1_oaep_padding), - ?line Msg = rsa_private_decrypt(OAEP, PrivKey, rsa_pkcs1_oaep_padding), - - <<Msg2Len:32,_/binary>> = crypto:mpint(Mod), - Msg2 = list_to_binary(lists:duplicate(Msg2Len-1, $X)), - ?line NoPad = rsa_public_encrypt(Msg2, PubKey, rsa_no_padding), - ?line NoPadDec = rsa_private_decrypt(NoPad, PrivKey, rsa_no_padding), - ?line NoPadDec = Msg2, - - ShouldBeError = (catch rsa_public_encrypt(Msg, PubKey, rsa_no_padding)), - ?line {'EXIT', {encrypt_failed,_}} = ShouldBeError, - -%% ?line SSL = rsa_public_encrypt(Msg, PubKey, rsa_sslv23_padding), -%% ?line Msg = rsa_private_decrypt(SSL, PrivKey, rsa_sslv23_padding), - - ?line PKCS1_2 = rsa_private_encrypt(Msg, PrivKey, rsa_pkcs1_padding), - ?line PKCS1_2Dec = rsa_public_decrypt(PKCS1_2, PubKey, rsa_pkcs1_padding), - io:format("PKCS2Dec ~p~n",[PKCS1_2Dec]), - ?line Msg = PKCS1_2Dec, - - ?line PKCS1_3 = rsa_private_encrypt(Msg2, PrivKey, rsa_no_padding), - ?line PKCS1_3Dec = rsa_public_decrypt(PKCS1_3, PubKey, rsa_no_padding), - io:format("PKCS2Dec ~p~n",[PKCS1_3Dec]), - ?line Msg2 = PKCS1_3Dec, - - ?line {'EXIT', {encrypt_failed,_}} = - (catch rsa_private_encrypt(Msg, PrivKey, rsa_no_padding)), - - ok. - -rsa_public_encrypt(Msg, Key, Pad) -> - C1 = crypto:rsa_public_encrypt(Msg, Key, Pad), - C2 = crypto:rsa_public_encrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad), - {C1,C2}. - -rsa_public_decrypt(Msg, Key, Pad) -> - R = crypto:rsa_public_decrypt(Msg, Key, Pad), - R = crypto:rsa_public_decrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). - -rsa_private_encrypt(Msg, Key, Pad) -> - R = crypto:rsa_private_encrypt(Msg, Key, Pad), - R = crypto:rsa_private_encrypt(Msg, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). - -rsa_private_decrypt({C1,C2}, Key, Pad) -> - R = crypto:rsa_private_decrypt(C1, Key, Pad), - R = crypto:rsa_private_decrypt(C2, Key, Pad), - R = crypto:rsa_private_decrypt(C1, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad), - R = crypto:rsa_private_decrypt(C2, lists:map(fun(E) -> crypto:mpint(E) end, Key), Pad). - - -dh(doc) -> - ["Test dh (Diffie-Hellman) functions."]; -dh(suite) -> []; -dh(Config) when is_list(Config) -> - Self = self(), - GenP = fun() -> - %% Gen Param may take arbitrary long time to finish - %% That's not a bug in erlang crypto application. - ?line DHPs = crypto:dh_generate_parameters(512,2), - ?line ok = crypto:dh_check(DHPs), - Self ! {param, DHPs} - end, - Pid = spawn(GenP), - receive - {param, DHPs} -> - timer:sleep(100), - io:format("DHP ~p~n", [DHPs]), - DHPs_mpint = lists:map(fun(E) -> sized_binary(E) end, DHPs), - ?line {Pub1,Priv1} = crypto:generate_key(dh, DHPs), - io:format("Key1:~n~p~n~p~n~n", [Pub1,Priv1]), - ?line {Pub2,Priv2} = crypto:dh_generate_key(DHPs_mpint), - io:format("Key2:~n~p~n~p~n~n", [Pub2,Priv2]), - ?line A = crypto:compute_key(dh, Pub1, unsized_binary(Priv2), DHPs), - ?line A = crypto:dh_compute_key(sized_binary(Pub1), Priv2, DHPs_mpint), - timer:sleep(100), %% Get another thread see if that triggers problem - ?line B = crypto:compute_key(dh, unsized_binary(Pub2), Priv1, DHPs), - ?line B = crypto:dh_compute_key(Pub2, sized_binary(Priv1), DHPs_mpint), - io:format("A ~p~n",[A]), - io:format("B ~p~n",[B]), - ?line A = B - after 50000 -> - io:format("Killing Param generation which took to long ~p~n",[Pid]), - exit(Pid, kill) - end. - - -ec(doc) -> - ["Test ec (Ecliptic Curve) functions."]; -ec(suite) -> []; -ec(Config) when is_list(Config) -> - if_supported(ecdh, fun() -> ec_do() end). - -ec_do() -> - %% test for a name curve - NamedCurve = hd(crypto:ec_curves()), - {D2_pub, D2_priv} = crypto:generate_key(ecdh, NamedCurve), - PrivECDH = [D2_priv, NamedCurve], - PubECDH = [D2_pub, NamedCurve], - %%TODO: find a published test case for a EC key - - Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>, - Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH), - ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH), - ?line false = crypto:verify(ecdsa, sha, Msg, <<10,20>>, PubECDH), - - ok. - -srp3(doc) -> - ["SRP-3 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; -srp3(suite) -> []; -srp3(Config) when is_list(Config) -> - Username = <<"alice">>, - Password = <<"password123">>, - Salt = hexstr2bin("2857827A19266A1F2BC6"), - Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" - "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" - "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" - "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" - "FD5138FE8376435B9FC61D2FC0EB06E3"), - Generator = <<2>>, - Version = '3', - Scrambler = hexstr2bin("02E2476A"), - - %% X = hexstr2bin("96E54AB0CD4C5123EDCFA4A1502918AAD3C9E2A8"), - Verifier = hexstr2bin("96EB5F13621D911AA1CA405DE9C64217D4108EEEECAFFE500034FE0E" - "C031E42C8714667C161BCE0E7996F7DDE1B63824C130D2D7286C08C0" - "49758420735961347112AE102A3F23B3F687F8FEE0DF2BFAF933C608" - "D6FE5B5EEE3116FE54016E065BF8E8C9FDBBC08719231AC215149140" - "519E8FDD9AA4F410C28A58AF42974D2D"), - ClientPrivate = hexstr2bin("6411DE75538BED8170677D577D0608F39112BC95B503C447EB6AC945" - "49C75C7B"), - ServerPrivate = hexstr2bin("85E44A6F694DBE676145DB245A045CD37C99F05C562C7840A31F270D" - "9AADCF8B"), - ClientPublic = hexstr2bin("B22B1FFA2244B8CB94F3A9080F419CAEAB0DBA93EA1965B5E84587EE" - "55C79E7A118865DC59B9D0353362C2A8261E7C1B0D221A0E233C2AD1" - "640DACBB8664CBC9733EAC392DA7800142860380C3FC573C3C064329" - "CF54063FD114C7210E9CB3A611EA8002B1844B698F930D95D143899B" - "948A090E0C25938E5F84067D1883DC63"), - ServerPublic = hexstr2bin("93A8C4D8B7F7395ADCFD4ABA37B015124513D3F37B3E85EB23064BE5" - "F53C0AE32FFB9D8C0AA0DCFFA74D632DD67DEBB5C35AAE9812286CC8" - "C43CC176ECBC6D3F447594D9554E995B2509127BF88FADDDA4982D03" - "8EC3001320712D3B1269308CE70F319B2295FA57674F03A2D993CFB1" - "F84C35B7D0C012FA73CD4C8F7D5A71C7"), - - SessionKey = hexstr2bin("C29A986C4D521BBC66428ED11D994CD7431574A6184B83CDCC345092" - "791E75748A1D38CAC4BD14760F0D2694B711236419240FF2F172454C" - "46ABF4FF39498DAFDD2C82924F7D7BD76CDFCE688C77D93F18A65409" - "9176A9192615DC0277AE7C12F1F6A7F6563FCA11675D809AF578BDE5" - "2B51E05D440B63099A017A0B45044801"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), - ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), - - {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), - SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, - {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), - SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, - {host, [Verifier, Prime, Version, Scrambler]}). - -srp6(doc) -> - ["SRP-6 test vectors generated by http://srp.stanford.edu/demo/demo.html"]; -srp6(suite) -> []; -srp6(Config) when is_list(Config) -> - Username = <<"alice">>, - Password = <<"password123">>, - Salt = hexstr2bin("2857827A19266A1F2BC6"), - Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" - "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" - "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" - "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" - "FD5138FE8376435B9FC61D2FC0EB06E3"), - Generator = <<2>>, - Version = '6', - Scrambler = hexstr2bin("0A2534C0BF52A0DA9001EEC62CF2A546AB0908A7"), - Verifier = hexstr2bin("96EB5F13621D911AA1CA405DE9C64217D4108EEEECAFFE500034FE0E" - "C031E42C8714667C161BCE0E7996F7DDE1B63824C130D2D7286C08C0" - "49758420735961347112AE102A3F23B3F687F8FEE0DF2BFAF933C608" - "D6FE5B5EEE3116FE54016E065BF8E8C9FDBBC08719231AC215149140" - "519E8FDD9AA4F410C28A58AF42974D2D"), - ClientPrivate = hexstr2bin("6411DE75538BED8170677D577D0608F39112BC95B503C447EB6AC945" - "49C75C7B"), - ServerPrivate = hexstr2bin("85E44A6F694DBE676145DB245A045CD37C99F05C562C7840A31F270D" - "9AADCF8B"), - ClientPublic = hexstr2bin("B22B1FFA2244B8CB94F3A9080F419CAEAB0DBA93EA1965B5E84587EE" - "55C79E7A118865DC59B9D0353362C2A8261E7C1B0D221A0E233C2AD1" - "640DACBB8664CBC9733EAC392DA7800142860380C3FC573C3C064329" - "CF54063FD114C7210E9CB3A611EA8002B1844B698F930D95D143899B" - "948A090E0C25938E5F84067D1883DC63"), - ServerPublic = hexstr2bin("D2D07845CE7ECDB9845DD36B10ACD3598CC29049DE9F467F84CE16B6" - "D97A6DC567AF8B0F9FEDF74962400AD5C357951E64E67B641246F264" - "C8DE6D9A72E554D6C8D3194548780A0C438A0FCC509CA88A14AA1DEB" - "C0F09E4B37A965D1545DB4AD361346F3189B0EA569C06D326C4E4797" - "9E381C748293B7C0591BE0BE419E053E"), - - SessionKey = hexstr2bin("19D22C19612874EBF1F2581F8EFCFDC44C6FDA3B87B0A73823D7E962" - "554295D4E48D3A336523ADBDDD0EC8FB0F02687109E97E01C17C93CC" - "7216F9CD8A4AC39F0429857D8D1023066614BDFCBCB89F59A0FEB81C" - "72E992AAD89095A84B6A5FADA152369AB1E350A03693BEF044DF3EDF" - "0C34741F4696C30E9F675D09F58ACBEB"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), - ClientPublic = crypto:mod_pow(Generator, ClientPrivate, Prime), - - {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), - SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, - {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), - SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, - {host, [Verifier, Prime, Version, Scrambler]}). - -srp6a(doc) -> - ["SRP-6a test vectors from RFC5054."]; -srp6a(suite) -> []; -srp6a(Config) when is_list(Config) -> - Username = <<"alice">>, - Password = <<"password123">>, - Salt = hexstr2bin("BEB25379D1A8581EB5A727673A2441EE"), - Prime = hexstr2bin("EEAF0AB9ADB38DD69C33F80AFA8FC5E86072618775FF3C0B9EA2314C" - "9C256576D674DF7496EA81D3383B4813D692C6E0E0D5D8E250B98BE4" - "8E495C1D6089DAD15DC7D7B46154D6B6CE8EF4AD69B15D4982559B29" - "7BCF1885C529F566660E57EC68EDBC3C05726CC02FD4CBF4976EAA9A" - "FD5138FE8376435B9FC61D2FC0EB06E3"), - Generator = <<2>>, - Version = '6a', - Scrambler = hexstr2bin("CE38B9593487DA98554ED47D70A7AE5F462EF019"), - Verifier = hexstr2bin("7E273DE8696FFC4F4E337D05B4B375BEB0DDE1569E8FA00A9886D812" - "9BADA1F1822223CA1A605B530E379BA4729FDC59F105B4787E5186F5" - "C671085A1447B52A48CF1970B4FB6F8400BBF4CEBFBB168152E08AB5" - "EA53D15C1AFF87B2B9DA6E04E058AD51CC72BFC9033B564E26480D78" - "E955A5E29E7AB245DB2BE315E2099AFB"), - ClientPrivate = hexstr2bin("60975527035CF2AD1989806F0407210BC81EDC04E2762A56AFD529DD" - "DA2D4393"), - ServerPrivate = hexstr2bin("E487CB59D31AC550471E81F00F6928E01DDA08E974A004F49E61F5D1" - "05284D20"), - ClientPublic = hexstr2bin("61D5E490F6F1B79547B0704C436F523DD0E560F0C64115BB72557EC4" - "4352E8903211C04692272D8B2D1A5358A2CF1B6E0BFCF99F921530EC" - "8E39356179EAE45E42BA92AEACED825171E1E8B9AF6D9C03E1327F44" - "BE087EF06530E69F66615261EEF54073CA11CF5858F0EDFDFE15EFEA" - "B349EF5D76988A3672FAC47B0769447B"), - ServerPublic = hexstr2bin("BD0C61512C692C0CB6D041FA01BB152D4916A1E77AF46AE105393011" - "BAF38964DC46A0670DD125B95A981652236F99D9B681CBF87837EC99" - "6C6DA04453728610D0C6DDB58B318885D7D82C7F8DEB75CE7BD4FBAA" - "37089E6F9C6059F388838E7A00030B331EB76840910440B1B27AAEAE" - "EB4012B7D7665238A8E3FB004B117B58"), - - SessionKey = hexstr2bin("B0DC82BABCF30674AE450C0287745E7990A3381F63B387AAF271A10D" - "233861E359B48220F7C4693C9AE12B0A6F67809F0876E2D013800D6C" - "41BB59B6D5979B5C00A172B4A2A5903A0BDCAF8A709585EB2AFAFA8F" - "3499B200210DCC1F10EB33943CD67FC88A2F39A4BE5BEC4EC0A3212D" - "C346D7E474B29EDE8A469FFECA686E5A"), - UserPassHash = crypto:sha([Salt, crypto:sha([Username, <<$:>>, Password])]), - Verifier = crypto:mod_pow(Generator, UserPassHash, Prime), - - {ClientPublic, ClientPrivate} = crypto:generate_key(srp, {user, [Generator, Prime, Version]}, ClientPrivate), - {ServerPublic, ServerPrivate} = crypto:generate_key(srp, {host, [Verifier, Generator, Prime, Version]}, ServerPrivate), - - SessionKey = crypto:compute_key(srp, ServerPublic, {ClientPublic, ClientPrivate}, - {user, [UserPassHash, Prime, Generator, Version, Scrambler]}), - SessionKey = crypto:compute_key(srp, ClientPublic, {ServerPublic, ServerPrivate}, - {host, [Verifier, Prime, Version, Scrambler]}). - -%% -%% -exor_test(doc) -> - ["Test the exor function."]; -exor_test(suite) -> - []; -exor_test(Config) when is_list(Config) -> - B = <<1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>, - Z1 = zero_bin(B), - Z1 = crypto:exor(B, B), - B1 = crypto:strong_rand_bytes(100), - B2 = crypto:strong_rand_bytes(100), - Z2 = zero_bin(B1), - Z2 = crypto:exor(B1, B1), - Z2 = crypto:exor(B2, B2), - R = xor_bytes(B1, B2), - R = crypto:exor(B1, B2), - ok. - -%% -%% -rc4_test(doc) -> - ["Test rc4 encryption ."]; -rc4_test(suite) -> - []; -rc4_test(Config) when is_list(Config) -> - if_supported(rc4, fun rc4_test_do/0). - -rc4_test_do() -> - CT1 = <<"Yo baby yo">>, - R1 = <<118,122,68,110,157,166,141,212,139,39>>, - K = "apaapa", - R1 = crypto:rc4_encrypt(K, CT1), - CT1 = crypto:rc4_encrypt(K, R1), - CT2 = lists:seq(0, 255), - R2 = crypto:rc4_encrypt(K, CT2), - CT2 = binary_to_list(crypto:rc4_encrypt(K, R2)), - ok. - -rc4_stream_test(doc) -> - ["Test rc4 stream encryption ."]; -rc4_stream_test(suite) -> - []; -rc4_stream_test(Config) when is_list(Config) -> - if_supported(rc4, fun rc4_stream_test_do/0). - -rc4_stream_test_do() -> - CT1 = <<"Yo ">>, - CT2 = <<"baby yo">>, - K = "apaapa", - State0 = crypto:rc4_set_key(K), - {State1, R1} = crypto:rc4_encrypt_with_state(State0, CT1), - {_State2, R2} = crypto:rc4_encrypt_with_state(State1, CT2), - R = list_to_binary([R1, R2]), - <<118,122,68,110,157,166,141,212,139,39>> = R, - ok. - -blowfish_cfb64(doc) -> ["Test Blowfish encrypt/decrypt."]; -blowfish_cfb64(suite) -> []; -blowfish_cfb64(Config) when is_list(Config) -> - Key = <<1,35,69,103,137,171,205,239,240,225,210,195,180,165,150,135>>, - - IVec = <<254,220,186,152,118,84,50,16>>, - Plain = <<"7654321 Now is the time for ">>, - Enc = <<231,50,20,162,130,33,57,202,242,110,207,109,46,185,231,110,61,163,222,4,209,81,114,0,81,157,87,166>>, - - Enc = crypto:blowfish_cfb64_encrypt(Key, IVec, Plain), - Plain = crypto:blowfish_cfb64_decrypt(Key, IVec, Enc), - - Key2 = <<"A2B4C">>, - IVec2 = <<"12345678">>, - Plain2 = <<"badger at my table....!">>, - Enc2 = <<173,76,128,155,70,81,79,228,4,162,188,92,119,53,144,89,93,236,28,164,176,16,138>>, - - Enc2 = crypto:blowfish_cfb64_encrypt(Key2, IVec2, Plain2), - Plain2 = crypto:blowfish_cfb64_decrypt(Key2, IVec2, Enc2). - - -smp(doc) -> "Check concurrent access to crypto driver"; -smp(suite) -> []; -smp(Config) -> - case erlang:system_info(smp_support) of - true -> - NumOfProcs = erlang:system_info(schedulers), - io:format("smp starting ~p workers\n",[NumOfProcs]), - Seeds = [random:uniform(9999) || _ <- lists:seq(1,NumOfProcs)], - Parent = self(), - Pids = [spawn_link(fun()-> worker(Seed,Config,Parent) end) - || Seed <- Seeds], - wait_pids(Pids); - - false -> - {skipped,"No smp support"} - end. - -worker(Seed, Config, Parent) -> - io:format("smp worker ~p, seed=~p~n",[self(),Seed]), - random:seed(Seed,Seed,Seed), - worker_loop(100, Config), - %%io:format("worker ~p done\n",[self()]), - Parent ! self(). - -worker_loop(0, _) -> - ok; -worker_loop(N, Config) -> - Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, - aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, - rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test, - hmac_update_md5, hmac_update_sha, hmac_update_sha256, hmac_update_sha512, - hmac_rfc2202, hmac_rfc4231_sha224, hmac_rfc4231_sha256, hmac_rfc4231_sha384, - hmac_rfc4231_sha512, aes_ctr_stream }, - - F = element(random:uniform(size(Funcs)),Funcs), - %%io:format("worker ~p calling ~p\n",[self(),F]), - ?MODULE:F(Config), - worker_loop(N-1,Config). - -wait_pids([]) -> - ok; -wait_pids(Pids) -> - receive - Pid -> - ?line true = lists:member(Pid,Pids), - Others = lists:delete(Pid,Pids), - io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), - wait_pids(Others) - end. - -%% -%% Help functions -%% - -% match -m(X, X) -> - ?line true. -t(true) -> - true. - -% hexstr2bin -hexstr2bin(S) -> - list_to_binary(hexstr2list(S)). - -hexstr2list([X,Y|T]) -> - [mkint(X)*16 + mkint(Y) | hexstr2list(T)]; -hexstr2list([]) -> - []. - -mkint(C) when $0 =< C, C =< $9 -> - C - $0; -mkint(C) when $A =< C, C =< $F -> - C - $A + 10; -mkint(C) when $a =< C, C =< $f -> - C - $a + 10. - -%% mod_exp in erlang (copied from jungerl's ssh_math.erl) -ipow(A, B, M) when M > 0, B >= 0 -> - if A == 1 -> - 1; - true -> - ipow(A, B, M, 1) - end. - -ipow(A, 1, M, Prod) -> - (A*Prod) rem M; -ipow(_A, 0, _M, Prod) -> - Prod; -ipow(A, B, M, Prod) -> - B1 = B bsr 1, - A1 = (A*A) rem M, - if B - B1 == B1 -> - ipow(A1, B1, M, Prod); - true -> - ipow(A1, B1, M, (A*Prod) rem M) - end. - -%% -%% Invert an element X mod P -%% Calculated as {1, {A,B}} = egcd(X,P), -%% 1 == P*A + X*B == X*B (mod P) i.e B is the inverse element -%% -%% X > 0, P > 0, X < P (P should be prime) -%% -%% invert(X,P) when X > 0, P > 0, X < P -> -%% I = inv(X,P,1,0), -%% if -%% I < 0 -> P + I; -%% true -> I -%% end. - -%% inv(0,_,_,Q) -> Q; -%% inv(X,P,R1,Q1) -> -%% D = P div X, -%% inv(P rem X, X, Q1 - D*R1, R1). - -sized_binary(Binary) when is_binary(Binary) -> - <<(size(Binary)):32/integer, Binary/binary>>; -sized_binary(List) -> - sized_binary(list_to_binary(List)). - -unsized_binary(<<Sz:32/integer, Binary:Sz/binary>>) -> - Binary. - -xor_bytes(Bin1, Bin2) when is_binary(Bin1), is_binary(Bin2) -> - L1 = binary_to_list(Bin1), - L2 = binary_to_list(Bin2), - list_to_binary(xor_bytes(L1, L2)); -xor_bytes(L1, L2) -> - xor_bytes(L1, L2, []). - -xor_bytes([], [], Acc) -> - lists:reverse(Acc); -xor_bytes([N1 | Tl1], [N2 | Tl2], Acc) -> - xor_bytes(Tl1, Tl2, [N1 bxor N2 | Acc]). - -zero_bin(N) when is_integer(N) -> - N8 = N * 8, - <<0:N8/integer>>; -zero_bin(B) when is_binary(B) -> - zero_bin(size(B)). - -my_dss_verify(Data,[Sign|Tail],Key) -> - Res = my_dss_verify(Data,sized_binary(Sign),Key), - case Tail of - [] -> Res; - _ -> ?line Res = my_dss_verify(Data,Tail,Key) - end; -my_dss_verify(Data,Sign,Key) -> - ?line Res = crypto:dss_verify(Data, Sign, Key), - ?line Res = crypto:dss_verify(sha, Data, Sign, Key), - ?line <<_:32,Raw/binary>> = Data, - ?line Res = crypto:dss_verify(none, crypto:sha(Raw), Sign, Key), - Res. - -my_dss_sign(Data,Key) -> - ?line S1 = crypto:dss_sign(Data, Key), - ?line S2 = crypto:dss_sign(sha, Data, Key), - ?line <<_:32,Raw/binary>> = Data, - ?line S3 = crypto:dss_sign(none, crypto:sha(Raw), Key), - [S1,S2,S3]. - -openssl_version() -> - case crypto:info_lib() of - [{<<"OpenSSL">>,LibVer,_}] when is_integer(LibVer) -> - LibVer; - _ -> - undefined - end. - -if_supported(Algorithm, Fun) -> - case lists:member(Algorithm, lists:append([Algo || {_, Algo} <- crypto:supports()])) of - true -> - Fun(); - _ -> - {skipped, io:format("~s not spupported", [Algorithm])} - end. diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 224aacd8d7..3386523206 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -763,32 +763,10 @@ trans_fun([{test,bs_test_unit,{f,Lbl},[Ms,Unit]}| [MsVar], [], Env, Instructions); trans_fun([{test,bs_match_string,{f,Lbl},[Ms,BitSize,Bin]}| Instructions], Env) -> - True = mk_label(new), - FalseLabName = map_label(Lbl), - TrueLabName = hipe_icode:label_name(True), + %% the current match buffer MsVar = mk_var(Ms), - TmpVar = mk_var(new), - ByteSize = BitSize div 8, - ExtraBits = BitSize rem 8, - WordSize = hipe_rtl_arch:word_size(), - if ExtraBits =:= 0 -> - trans_op_call({hipe_bs_primop,{bs_match_string,Bin,ByteSize}}, Lbl, - [MsVar], [MsVar], Env, Instructions); - BitSize =< ((WordSize * 8) - 5) -> - <<Int:BitSize, _/bits>> = Bin, - {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,BitSize,0}}, Lbl, - [MsVar], [TmpVar, MsVar], Env), - I2 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), - I1 ++ [I2,True] ++ trans_fun(Instructions, Env1); - true -> - <<RealBin:ByteSize/binary, Int:ExtraBits, _/bits>> = Bin, - {I1,Env1} = trans_one_op_call({hipe_bs_primop,{bs_match_string,RealBin,ByteSize}}, Lbl, - [MsVar], [MsVar], Env), - {I2,Env2} = trans_one_op_call({hipe_bs_primop,{bs_get_integer,ExtraBits,0}}, Lbl, - [MsVar], [TmpVar, MsVar], Env1), - I3 = hipe_icode:mk_type([TmpVar], {integer,Int}, TrueLabName, FalseLabName), - I1 ++ I2 ++ [I3,True] ++ trans_fun(Instructions, Env2) - end; + Primop = {hipe_bs_primop, {bs_match_string, Bin, BitSize}}, + trans_op_call(Primop, Lbl, [MsVar], [MsVar], Env, Instructions); trans_fun([{bs_context_to_binary,Var}|Instructions], Env) -> %% the current match buffer IVars = [trans_arg(Var)], diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index cee37b6a57..2a141c514e 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -287,8 +287,8 @@ pp(Dev, Op) -> io:format(Dev, "bs_start_match<~w>", [Max]); {{bs_start_match, Type}, Max} -> io:format(Dev, "bs_start_match<~w,~w>", [Type,Max]); - {bs_match_string, String, SizeInBytes} -> - io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBytes]); + {bs_match_string, String, SizeInBits} -> + io:format(Dev, "bs_match_string<~w, ~w>", [String, SizeInBits]); {bs_get_integer, Size, Flags} -> io:format(Dev, "bs_get_integer<~w, ~w>", [Size, Flags]); {bs_get_float, Size, Flags} -> @@ -596,10 +596,10 @@ type(Primop, Args) -> erl_types:t_subtract(Type, erl_types:t_matchstate()), erl_types:t_matchstate_slot( erl_types:t_inf(Type, erl_types:t_matchstate()), 0)); - {hipe_bs_primop, {bs_match_string,_,Bytes}} -> + {hipe_bs_primop, {bs_match_string,_,Bits}} -> [MatchState] = Args, BinType = erl_types:t_matchstate_present(MatchState), - NewBinType = match_bin(erl_types:t_bitstr(0, Bytes*8), BinType), + NewBinType = match_bin(erl_types:t_bitstr(0, Bits), BinType), erl_types:t_matchstate_update_present(NewBinType, MatchState); {hipe_bs_primop, {bs_test_unit,Unit}} -> [MatchState] = Args, diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl index c8fc9cc856..0957dd4df2 100644 --- a/lib/hipe/llvm/hipe_llvm_main.erl +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -84,7 +84,7 @@ compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> __ = file:close(File_llvm), %% Invoke LLVM compiler tools to produce an object file llvm_opt(Dir, Filename, Options), - llvm_llc(Dir, Filename, Options), + llvm_llc(Dir, Filename, Ver, Options), compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! {ok, Dir, Dir ++ Filename ++ ".o"}. @@ -103,12 +103,14 @@ llvm_opt(Dir, Filename, Options) -> %% @doc Invoke llc tool to compile the bitcode to object file %% (_name.bc -> _name.o). -llvm_llc(Dir, Filename, Options) -> +llvm_llc(Dir, Filename, Ver, Options) -> Source = Dir ++ Filename ++ ".bc", OptLevel = trans_optlev_flag(llc, Options), + VerFlags = llc_ver_flags(Ver), Align = find_stack_alignment(), LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align - , "-tailcallopt", "-filetype=asm"], %%FIXME + , "-tailcallopt", "-filetype=asm" %FIXME + | VerFlags], Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, %% io:format("LLC: ~s~n", [Command]), case os:cmd(Command) of @@ -153,6 +155,12 @@ trans_optlev_flag(Tool, Options) -> undefined -> "-O2" end. +llc_ver_flags(Ver = {_, _}) when Ver >= {3,9} -> + %% Works around a bug in the x86-call-frame-opt pass (as of LLVM 3.9) that + %% break the garbage collection stack descriptors. + ["-no-x86-call-frame-opt"]; +llc_ver_flags({_, _}) -> []. + %%------------------------------------------------------------------------------ %% Functions to manage Relocations %%------------------------------------------------------------------------------ diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl index 53aa8c57b2..20813f8bd7 100644 --- a/lib/hipe/llvm/hipe_rtl_to_llvm.erl +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -10,7 +10,8 @@ -include("../rtl/hipe_literals.hrl"). -include("hipe_llvm_arch.hrl"). --define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BITS_IN_WORD, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BITS_IN_BYTE, (?bytes_to_bits(1))). -define(BRANCH_META_TAKEN, "0"). -define(BRANCH_META_NOT_TAKEN, "1"). -define(FIRST_FREE_META_NO, 2). @@ -95,9 +96,9 @@ do_alloca_stack([], _, _, Acc) -> Acc; do_alloca_stack([D|Ds], Params, Roots, Acc) -> {Name, _I} = trans_dst(D), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), case hipe_rtl:is_var(D) of true -> Num = hipe_rtl:var_index(D), @@ -233,7 +234,7 @@ trans_alu(I, Relocs) -> {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), Op = trans_op(hipe_rtl:alu_op(I)), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), I4 = store_stack_dst(TmpDst, RtlDst), {[I4, I3, I2, I1], Relocs}. @@ -258,7 +259,7 @@ trans_alub_overflow(I, Sign, Relocs) -> TmpDst = mk_temp(), Name = trans_alub_op(I, Sign), NewRelocs = relocs_store(Name, {call, remote, {llvm, Name, 2}}, Relocs), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), T1 = mk_temp(), I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, @@ -320,7 +321,7 @@ trans_alub_no_overflow(I, Relocs) -> {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), Cond = trans_rel_op(hipe_rtl:alub_cond(I)), T3 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), %% br Metadata = branch_metadata(hipe_rtl:alub_pred(I)), @@ -338,7 +339,7 @@ trans_branch(I, Relocs) -> Cond = trans_rel_op(hipe_rtl:branch_cond(I)), %% icmp T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), %% br True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), @@ -366,7 +367,7 @@ trans_call(I, Relocs) -> {Name, I3, Relocs2} = trans_call_name(RtlCallName, hipe_rtl:call_type(I), Relocs1, CallArgs, FinalArgs), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), I4 = case hipe_rtl:call_fail(I) of @@ -450,7 +451,7 @@ trans_call_name(RtlCallName, RtlCallType, Relocs, CallArgs, FinalArgs) -> %% order to make the call TT1 = mk_temp(), {RegName, II1} = trans_src(Reg), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), II2 = hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), @@ -503,7 +504,7 @@ trans_enter(I, Relocs) -> {Name, I2, NewRelocs} = trans_call_name(hipe_rtl:enter_fun(I), hipe_rtl:enter_type(I), Relocs, CallArgs, FinalArgs), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), @@ -518,7 +519,7 @@ trans_fconv(I, Relocs) -> TmpDst = mk_temp(), {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), FloatTy = hipe_llvm:mk_double(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), I3 = store_float_stack(TmpDst, RtlDst), {[I3, I2, I1], Relocs}. @@ -538,7 +539,7 @@ trans_fload(I, Relocs) -> {Src, I1} = trans_float_src(RtlSrc), {Offset, I2} = trans_float_src(_Offset), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), T2 = mk_temp(), @@ -619,7 +620,7 @@ trans_fstore(I, Relocs) -> trans_fstore_reg(I, Relocs) -> {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), FloatTy = hipe_llvm:mk_double(), FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), @@ -659,7 +660,7 @@ trans_load(I, Relocs) -> {Src, I1} = trans_src(hipe_rtl:load_src(I)), {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), %%---------------------------------------------------------------- @@ -737,7 +738,7 @@ trans_move(I, Relocs) -> %% return %% trans_return(I, Relocs) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), {VarRet, I1} = case hipe_rtl:return_varlist(I) of [] -> @@ -777,7 +778,7 @@ trans_store(I, Relocs) -> {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), {Value, I3} = trans_src(hipe_rtl:store_src(I)), T1 = mk_temp(), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), I5 = @@ -811,14 +812,14 @@ trans_switch(I, Relocs, Data) -> JumpLabels = [mk_jump_label(L) || L <- Labels], SortOrder = hipe_rtl:switch_sort_order(I), NrLabels = length(Labels), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), TableTypeP = hipe_llvm:mk_pointer(TableType), TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], T1 = mk_temp(), {Src2, []} = trans_dst(RtlSrc), TableName = "table_" ++ tl(Src2), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, [{WordTy, "0"}, {WordTy, Src}], false), T2 = mk_temp(), @@ -933,7 +934,7 @@ create_fail_blocks(Label, FailLabels, Acc) -> false -> Acc; {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), I1 = hipe_llvm:mk_label(FailLabel), LP = hipe_llvm:mk_landingpad(), I2 = @@ -962,7 +963,7 @@ create_fail_blocks(Label, FailLabels, Acc) -> %% @doc Convert RTL argument list to LLVM argument list. trans_args(ArgList) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), MakeArg = fun(A) -> {Name, I1} = trans_src(A), @@ -972,13 +973,13 @@ trans_args(ArgList) -> %% @doc Convert a list of Precoloured registers to LLVM argument list. fix_reg_args(ArgList) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, A} || A <- ArgList]. %% @doc Load Precoloured registers. load_fixed_regs(RegList) -> Names = [mk_temp_reg(R) || R <- RegList], - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), Fun1 = fun (X, Y) -> @@ -991,7 +992,7 @@ load_fixed_regs(RegList) -> store_fixed_regs(RegList, Name) -> Names = [mk_temp_reg(R) || R <- RegList], Indexes = lists:seq(0, erlang:length(RegList) - 1), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), Fun1 = @@ -1064,7 +1065,7 @@ mk_temp_reg(Name) -> store_stack_dst(TempDst, Dst) -> {Dst2, II1} = trans_dst(Dst), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), [II2, II1]. @@ -1082,7 +1083,7 @@ trans_float_src(Src) -> Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), T1 = mk_temp(), %% XXX: Hardcoded offset - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), @@ -1098,7 +1099,7 @@ trans_float_src(Src) -> end. trans_src(A) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), case hipe_rtl:is_imm(A) of true -> @@ -1201,7 +1202,7 @@ map_precoloured_reg(Index) -> fix_reg_dst(Register) -> case Register of {Name, Offset} -> %% Case of %fcalls, %hplim - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), pointer_from_reg(Name, WordTy, Offset); Name -> %% Case of %p and %hp {Name, []} @@ -1209,7 +1210,7 @@ fix_reg_dst(Register) -> %% @doc Load precoloured src register. fix_reg_src(Register) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), case Register of {Name, Offset} -> %% Case of %fcalls, %hplim @@ -1331,10 +1332,10 @@ insn_dst(I) -> llvm_type_from_size(Size) -> case Size of - byte -> hipe_llvm:mk_int(8); + byte -> hipe_llvm:mk_int(?BITS_IN_BYTE); int16 -> hipe_llvm:mk_int(16); int32 -> hipe_llvm:mk_int(32); - word -> hipe_llvm:mk_int(64) + word -> hipe_llvm:mk_int(?BITS_IN_WORD) end. %% @doc Create definition for the compiled function. The parameters that are @@ -1364,13 +1365,13 @@ create_function_definition(Fun, Params, Code, LocalVars) -> lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), Final_Code = EntryBlock ++ Code, FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, FunctionOptions, [], Final_Code). header_params(Params) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. store_params(Params) -> @@ -1379,7 +1380,7 @@ store_params(Params) -> Index = hipe_rtl:var_index(X), {Name, _} = trans_dst(X), ParamName = "%v" ++ integer_to_list(Index), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) end, @@ -1396,11 +1397,11 @@ fixed_registers() -> end. header_regs(Registers) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. load_regs(Registers) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), WordTyPtr = hipe_llvm:mk_pointer(WordTy), Fun1 = fun(X) -> @@ -1501,28 +1502,30 @@ seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> %% @doc External declaration of an atom. declare_atom({AtomName, _}) -> - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + %% The type has to be byte, or a backend might assume the constant is aligned + %% and incorrectly optimise away type tests + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", ByteTy, ""). %% @doc Creation of local variable for an atom. load_atom({AtomName, _}) -> Dst = "%" ++ AtomName ++ "_var", Name = "@" ++ AtomName, - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - WordTyPtr = hipe_llvm:mk_pointer(WordTy), - hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc External declaration of a closure. declare_closure({ClosureName, _})-> - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). %% @doc Creation of local variable for a closure. load_closure({ClosureName, _})-> Dst = "%" ++ ClosureName ++ "_var", Name = "@" ++ ClosureName, - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc Declaration of a local variable for a switch jump table. @@ -1553,7 +1556,7 @@ declare_closure_labels(ClosureLabels, Relocs, Fun) -> List3 = string:join(List2, ",\n"), List4 = "[\n" ++ List3 ++ "\n]\n", NrLabels = length(LabelList), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), ConstDecl = hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), @@ -1568,7 +1571,7 @@ is_external_call(_, _) -> true. call_to_decl({Name, {call, _, MFA}}) -> {M, _F, A} = MFA, CConv = "cc 11", - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), {Type, Args} = case M of @@ -1583,14 +1586,14 @@ call_to_decl({Name, {call, _, MFA}}) -> %% @doc These functions are always declared, even if not used. fixed_fun_decl() -> - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), ByteTyPtr, ByteTyPtr], []), GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), @@ -1604,7 +1607,7 @@ fixed_fun_decl() -> %% values, add the offset and convert them again to pointers. declare_constant(Label) -> Name = "@DL" ++ integer_to_list(Label), - ByteTy = hipe_llvm:mk_int(8), + ByteTy = hipe_llvm:mk_int(?BITS_IN_BYTE), hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). %% @doc Load a constant is achieved by converting a pointer to an integer of @@ -1612,8 +1615,8 @@ declare_constant(Label) -> load_constant(Label) -> Dst = "%DL" ++ integer_to_list(Label) ++ "_var", Name = "@DL" ++ integer_to_list(Label), - WordTy = hipe_llvm:mk_int(?WORD_WIDTH), - ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + WordTy = hipe_llvm:mk_int(?BITS_IN_WORD), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(?BITS_IN_BYTE)), hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). %% @doc Store external constants and calls to dictionary. diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index ad23df80d2..291f920fcf 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -19,7 +19,7 @@ %%% %CopyrightEnd% %%% %%%------------------------------------------------------------------- -%%% File : hipe_rtl_binary_2.erl +%%% File : hipe_rtl_binary.erl %%% Author : Per Gustafsson <[email protected]> %%% Description : %%% diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 528672b893..d999cd2743 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -270,24 +270,23 @@ gen_rtl({bs_save, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) -> set_field_from_term({matchstate, {saveoffset, Slot}}, Ms, Offset), hipe_rtl:mk_goto(TrueLblName)]; %% ----- bs_match_string ----- -gen_rtl({bs_match_string, String, ByteSize}, Dst, [Ms], +gen_rtl({bs_match_string, String, BitSize}, Dst, [Ms], TrueLblName, FalseLblName) -> {[Offset, BinSize, Base], Instrs} = extract_matchstate_vars([offset, binsize, base], Ms), [SuccessLbl, ALbl, ULbl] = create_lbls(3), [NewOffset, BitOffset] = create_gcsafe_regs(2), - Unit = hipe_rtl_arch:word_size() - 1, - Loops = ByteSize div Unit, - Init = + Unit = (hipe_rtl_arch:word_size() - 1) * ?BYTE_SIZE, + Init = [Instrs, opt_update_ms(Dst, Ms), - check_size(Offset, hipe_rtl:mk_imm(ByteSize*?BYTE_SIZE), BinSize, + check_size(Offset, hipe_rtl:mk_imm(BitSize), BinSize, NewOffset, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl], SplitCode = [hipe_rtl:mk_alub(BitOffset, Offset, 'and', hipe_rtl:mk_imm(?LOW_BITS), eq, hipe_rtl:label_name(ALbl), hipe_rtl:label_name(ULbl))], - Loops = ByteSize div Unit, + Loops = BitSize div Unit, SkipSize = Loops * Unit, {ACode1, UCode1} = case Loops of @@ -297,9 +296,9 @@ gen_rtl({bs_match_string, String, ByteSize}, Dst, [Ms], create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) end, - <<_:SkipSize/binary, RestString/binary>> = String, + <<_:SkipSize/bits, RestString/bits>> = String, {ACode2, UCode2} = - case ByteSize rem Unit of + case BitSize rem Unit of 0 -> {[], []}; Rem -> @@ -393,12 +392,12 @@ validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) -> create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) -> [Reg] = create_gcsafe_regs(1), AlignedFun = fun(Value) -> - [get_int_to_reg(Reg, Unit*?BYTE_SIZE, Base, Offset, 'srl', + [get_int_to_reg(Reg, Unit, Base, Offset, 'srl', {unsigned, big}), update_and_test(Reg, Unit, Offset, Value, FalseLblName)] end, UnAlignedFun = fun(Value) -> - [get_unaligned_int_to_reg(Reg, Unit*?BYTE_SIZE, + [get_unaligned_int_to_reg(Reg, Unit, Base, Offset, BitOffset, 'srl', {unsigned, big})| update_and_test(Reg, Unit, Offset, Value, FalseLblName)] @@ -406,31 +405,31 @@ create_loops(Loops, Unit, String, Base, Offset, BitOffset, FalseLblName) -> {create_loops(Loops, Unit, String, AlignedFun), create_loops(Loops, Unit, String, UnAlignedFun)}. -create_rests(Rem, String, Base, Offset, BitOffset, FalseLblName) -> +create_rests(RemBits, String, Base, Offset, BitOffset, FalseLblName) -> [Reg] = create_gcsafe_regs(1), AlignedFun = fun(Value) -> - [get_int_to_reg(Reg, Rem*?BYTE_SIZE, Base, Offset, 'srl', + [get_int_to_reg(Reg, RemBits, Base, Offset, 'srl', {unsigned, big})| just_test(Reg, Value, FalseLblName)] end, UnAlignedFun = fun(Value) -> - [get_unaligned_int_to_reg(Reg, Rem*?BYTE_SIZE, + [get_unaligned_int_to_reg(Reg, RemBits, Base, Offset, BitOffset, 'srl', {unsigned, big})| just_test(Reg, Value, FalseLblName)] end, - {create_loops(1, Rem, String, AlignedFun), - create_loops(1, Rem, String, UnAlignedFun)}. + {create_loops(1, RemBits, String, AlignedFun), + create_loops(1, RemBits, String, UnAlignedFun)}. create_loops(0, _Unit, _String, _IntFun) -> []; create_loops(N, Unit, String, IntFun) -> - {Value, RestString} = get_value(Unit,String), + {Value, RestString} = get_value(Unit, String), [IntFun(Value), create_loops(N-1, Unit, RestString, IntFun)]. update_and_test(Reg, Unit, Offset, Value, FalseLblName) -> - [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(Unit*?BYTE_SIZE), FalseLblName), + [add_to_offset(Offset, Offset, hipe_rtl:mk_imm(Unit), FalseLblName), just_test(Reg, Value, FalseLblName)]. just_test(Reg, Value, FalseLblName) -> @@ -439,8 +438,8 @@ just_test(Reg, Value, FalseLblName) -> hipe_rtl:label_name(ContLbl), FalseLblName), ContLbl]. -get_value(N,String) -> - <<I:N/integer-unit:8, Rest/binary>> = String, +get_value(N, String) -> + <<I:N, Rest/bits>> = String, {I, Rest}. make_int_gc_code(I) when is_integer(I) -> diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl index b280705a47..d9f3278b45 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl @@ -9,6 +9,7 @@ test() -> <<49,50,51>> = lex_digits1(Bin, 1, []), <<49,50,51>> = lex_digits2(Bin, 1, []), ok = var_bind_bug(<<1, 2, 3, 4, 5, 6, 7, 8>>), + ok = bs_match_string_bug(), ok. %%-------------------------------------------------------------------- @@ -65,3 +66,50 @@ var_bind_bug(<<A:1/binary, B:8/integer, _C:B/binary, _Rest/binary>>) -> B -> wrong; _ -> ok end. + +%%-------------------------------------------------------------------- +%% From: Andreas Schultz +%% Date: 2/11/2016 +%% +%% Either HiPE is messing up binary matches in some cases or I'm not +%% seeing the problem. ... <SNIP PROGRAM - CLEANED UP VERSION BELOW> +%% With Erlang 19.1.3 the HiPE compiled version behaves differently +%% than the non-HiPE version: ... <SNIP TEST RUNS> +%% So, do I do something wrong here or is this a legitimate HiPE bug? +%% +%% Yes, this was a legitimate HiPE bug: The BEAM to ICode tranaslation +%% of the bs_match_string instruction, written long ago for binaries +%% (i.e., with byte-sized strings), tried to do a `clever' translation +%% of even bit-sized strings using a HiPE primop that took a `Size' +%% argument expressed in *bytes*. ICode is not really the place to do +%% such a thing, and moreover there is really no reason for the HiPE +%% primop not to take a Size argument expressed in *bits* instead. +%% The bug was fixed by changing the `Size' argument to be in bits, +%% postponing the translation of the bs_match_string primop until RTL +%% and doing a proper translation using bit-sized quantities there. +%%-------------------------------------------------------------------- + +bs_match_string_bug() -> + ok = test0(<<50>>), + Bin = data(), + ok = test1(Bin), + ok = test2(Bin), + ok. + +%% Minimal test case showing the problem matching with strings +test0(<<6:5, 0:1, 0:2>>) -> weird; +test0(<<6:5, _:1, _:2>>) -> ok; +test0(_) -> default. + +data() -> <<50,16,0>>. + +%% This was the problematic test case in HiPE: 'default' was returned +test1(<<1:3, 1:1, _:1, 0:1, 0:1, 0:1, _/binary>>) -> weird; +test1(<<1:3, 1:1, _:1, _:1, _:1, _:1, _/binary>>) -> ok; +test1(_) -> default. + +%% This variation of test1/1 above worked OK, even in HiPE +test2(<<1:3, 1:1, _:1, A:1, B:1, C:1, _/binary>>) + when A =:= 1; B =:= 1; C =:= 1 -> ok; +test2(<<1:3, 1:1, _:1, 0:1, 0:1, 0:1, _/binary>>) -> weird; +test2(_) -> default. diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml index 08454b9832..e97db20062 100644 --- a/lib/kernel/doc/src/gen_tcp.xml +++ b/lib/kernel/doc/src/gen_tcp.xml @@ -231,7 +231,11 @@ do_recv(Sock, Bs) -> <c><anno>Socket</anno></c>. The controlling process is the process that receives messages from the socket. If called by any other process than the current controlling process, - <c>{error, not_owner}</c> is returned.</p> + <c>{error, not_owner}</c> is returned. If the process identified + by <c><anno>Pid</anno></c> is not an existing local pid, + <c>{error, badarg}</c> is returned. <c>{error, badarg}</c> may also + be returned in some cases when <c><anno>Socket</anno></c> is closed + during the execution of this function.</p> <p>If the socket is set in active mode, this function will transfer any messages in the mailbox of the caller to the new controlling process. diff --git a/lib/kernel/doc/src/gen_udp.xml b/lib/kernel/doc/src/gen_udp.xml index 3f88a0272d..f79566ef71 100644 --- a/lib/kernel/doc/src/gen_udp.xml +++ b/lib/kernel/doc/src/gen_udp.xml @@ -68,7 +68,11 @@ <c><anno>Socket</anno></c>. The controlling process is the process that receives messages from the socket. If called by any other process than the current controlling process, - <c>{error, not_owner}</c> is returned.</p> + <c>{error, not_owner}</c> is returned. If the process identified + by <c><anno>Pid</anno></c> is not an existing local pid, + <c>{error, badarg}</c> is returned. <c>{error, badarg}</c> may also + be returned in some cases when <c><anno>Socket</anno></c> is closed + during the execution of this function.</p> </desc> </func> diff --git a/lib/kernel/include/dist_util.hrl b/lib/kernel/include/dist_util.hrl index 320e916c04..e3d2fe0eb6 100644 --- a/lib/kernel/include/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl @@ -29,7 +29,7 @@ -endif. -ifdef(dist_trace). --define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). +-define(trace(Fmt,Args), io:format("~p ~p:~s",[erlang:timestamp(),node(),lists:flatten(io_lib:format(Fmt, Args))])). % Use the one below for config-file (early boot) connection tracing %-define(trace(Fmt,Args), erlang:display([erlang:now(),node(),lists:flatten(io_lib:format(Fmt, Args))])). -define(trace_factor,8). diff --git a/lib/kernel/src/gen_sctp.erl b/lib/kernel/src/gen_sctp.erl index b133e6fed4..a6aa0edd15 100644 --- a/lib/kernel/src/gen_sctp.erl +++ b/lib/kernel/src/gen_sctp.erl @@ -439,7 +439,7 @@ error_string(X) -> -spec controlling_process(Socket, Pid) -> ok | {error, Reason} when Socket :: sctp_socket(), Pid :: pid(), - Reason :: closed | not_owner | inet:posix(). + Reason :: closed | not_owner | badarg | inet:posix(). controlling_process(S, Pid) when is_port(S), is_pid(Pid) -> inet:udp_controlling_process(S, Pid); diff --git a/lib/kernel/src/gen_tcp.erl b/lib/kernel/src/gen_tcp.erl index 1a21541b7c..ac61dbc792 100644 --- a/lib/kernel/src/gen_tcp.erl +++ b/lib/kernel/src/gen_tcp.erl @@ -320,7 +320,7 @@ unrecv(S, Data) when is_port(S) -> -spec controlling_process(Socket, Pid) -> ok | {error, Reason} when Socket :: socket(), Pid :: pid(), - Reason :: closed | not_owner | inet:posix(). + Reason :: closed | not_owner | badarg | inet:posix(). controlling_process(S, NewOwner) -> case inet_db:lookup_socket(S) of diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 98d2f0bcfb..3121544719 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -195,7 +195,7 @@ connect(S, Address, Port) when is_port(S) -> -spec controlling_process(Socket, Pid) -> ok | {error, Reason} when Socket :: socket(), Pid :: pid(), - Reason :: closed | not_owner | inet:posix(). + Reason :: closed | not_owner | badarg | inet:posix(). controlling_process(S, NewOwner) -> inet:udp_controlling_process(S, NewOwner). diff --git a/lib/kernel/src/global.erl b/lib/kernel/src/global.erl index 0c73ead7c5..5e8bc2ba5d 100644 --- a/lib/kernel/src/global.erl +++ b/lib/kernel/src/global.erl @@ -58,14 +58,18 @@ %%% In certain places in the server, calling io:format hangs everything, %%% so we'd better use erlang:display/1. %%% my_tracer is used in testsuites --define(trace(_), ok). +%% uncomment this if tracing is wanted +%%-define(DEBUG, true). +-ifdef(DEBUG). +-define(trace(T), erlang:display({format, node(), cs(), T})). + cs() -> + {_Big, Small, Tiny} = erlang:timestamp(), + (Small rem 100) * 100 + (Tiny div 10000). %-define(trace(T), (catch my_tracer ! {node(), {line,?LINE}, T})). - -%-define(trace(T), erlang:display({format, node(), cs(), T})). -%cs() -> -% {_Big, Small, Tiny} = now(), -% (Small rem 100) * 100 + (Tiny div 10000). +-else. +-define(trace(_), ok). +-endif. %% These are the protocol versions: %% Vsn 1 is the original protocol. diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index 82cf73cbda..b505524471 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"4\\.[0-2](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"5\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 0c679e7349..0a9f9316b0 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -26,15 +26,13 @@ %%-define(dist_debug, true). -%-define(DBG,erlang:display([?MODULE,?LINE])). - -ifdef(dist_debug). -define(debug(Term), erlang:display(Term)). -else. -define(debug(Term), ok). -endif. --ifdef(DEBUG). +-ifdef(dist_debug). -define(connect_failure(Node,Term), io:format("Net Kernel 2: Failed connection to node ~p, reason ~p~n", [Node,Term])). diff --git a/lib/mnesia/doc/src/Mnesia_chap3.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap3.xmlsrc index 8f1a4366ee..ffda739dfa 100644 --- a/lib/mnesia/doc/src/Mnesia_chap3.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap3.xmlsrc @@ -348,7 +348,7 @@ skeppet %<input>erl -sname b -mnesia dir '"/ldisc/scratch/Mnesia.company"'</inpu <p>If the startup procedure fails, the function <seealso marker="mnesia#start/0">mnesia:start()</seealso> returns the cryptic tuple - <c>{error,{shutdown, {mnesia_sup,start,[normal,[]]}}}</c>. + <c>{error,{shutdown, {mnesia_sup,start_link,[normal,[]]}}}</c>. To get more information about the start failure, use command-line arguments <c>-boot start_sasl</c> as argument to the <c>erl</c> script.</p> diff --git a/lib/mnesia/src/Makefile b/lib/mnesia/src/Makefile index 08a00e6aba..5206e469a5 100644 --- a/lib/mnesia/src/Makefile +++ b/lib/mnesia/src/Makefile @@ -43,6 +43,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/mnesia-$(VSN) # ---------------------------------------------------- MODULES= \ mnesia \ + mnesia_app \ mnesia_backend_type \ mnesia_backup \ mnesia_bup \ diff --git a/lib/mnesia/src/mnesia.app.src b/lib/mnesia/src/mnesia.app.src index 006ad4bac1..af14826c90 100644 --- a/lib/mnesia/src/mnesia.app.src +++ b/lib/mnesia/src/mnesia.app.src @@ -3,6 +3,7 @@ {vsn, "%VSN%"}, {modules, [ mnesia, + mnesia_app, mnesia_backend_type, mnesia_backup, mnesia_bup, @@ -49,7 +50,5 @@ mnesia_tm ]}, {applications, [kernel, stdlib]}, - {mod, {mnesia_sup, []}}, + {mod, {mnesia_app, []}}, {runtime_dependencies, ["stdlib-2.0","kernel-3.0","erts-7.0"]}]}. - - diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl index 5bf2fc2dc3..7b0e4976a0 100644 --- a/lib/mnesia/src/mnesia.erl +++ b/lib/mnesia/src/mnesia.erl @@ -138,6 +138,36 @@ -include("mnesia.hrl"). -import(mnesia_lib, [verbose/2]). +-type create_option() :: + {'access_mode', 'read_write' | 'read_only'} | + {'attributes', [atom()]} | + {'disc_copies', [node()]} | + {'disc_only_copies', [node]} | + {'index', [index_attr()]} | + {'load_order', non_neg_integer()} | + {'majority', boolean()} | + {'ram_copies', [node()]} | + {'record_name', atom()} | + {'snmp', SnmpStruct::term()} | + {'storage_properties', [{Backend::module(), [BackendProp::_]}]} | + {'type', 'set' | 'ordered_set' | 'bag'} | + {'local_content', boolean()}. + +-type t_result(Res) :: {'atomic', Res} | {'aborted', Reason::term()}. +-type activity() :: 'ets' | 'async_dirty' | 'sync_dirty' | 'transaction' | 'sync_transaction' | + {'transaction', Retries::non_neg_integer()} | + {'sync_transaction', Retries::non_neg_integer()}. +-type table() :: atom(). +-type storage_type() :: 'ram_copies' | 'disc_copies' | 'disc_only_copies'. +-type index_attr() :: atom() | non_neg_integer(). +-type write_locks() :: 'write' | 'sticky_write'. +-type read_locks() :: 'read'. +-type lock_kind() :: write_locks() | read_locks(). +-type select_continuation() :: term(). +-type snmp_struct() :: [{atom(), snmp_type() | tuple_of(snmp_type())}]. +-type snmp_type() :: 'fix_string' | 'string' | 'integer'. +-type tuple_of(_) :: tuple(). + -define(DEFAULT_ACCESS, ?MODULE). %% Select @@ -196,7 +226,7 @@ e_has_var(X, Pos) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Start and stop - +-spec start() -> 'ok' | {'error', term()}. start() -> start([]). @@ -216,6 +246,7 @@ start_() -> {error, R} end. +-spec start([{Option::atom(), Value::_}]) -> 'ok' | {'error', term()}. start(ExtraEnv) when is_list(ExtraEnv) -> case mnesia_lib:ensure_loaded(?APPLICATION) of ok -> @@ -238,6 +269,7 @@ patched_start([Head | _]) -> patched_start([]) -> start_(). +-spec stop() -> 'stopped' | {'error', term()}. stop() -> case application:stop(?APPLICATION) of ok -> stopped; @@ -245,6 +277,7 @@ stop() -> Other -> Other end. +-spec change_config(Config::atom(), Value::_) -> ok | {error, term()}. change_config(extra_db_nodes, Ns) when is_list(Ns) -> mnesia_controller:connect_nodes(Ns); change_config(dc_dump_limit, N) when is_number(N), N > 0 -> @@ -273,6 +306,7 @@ kill() -> ms() -> [ mnesia, + mnesia_app, mnesia_backup, mnesia_bup, mnesia_checkpoint, @@ -311,12 +345,12 @@ ms() -> %% Activity mgt -spec abort(_) -> no_return(). - abort(Reason = {aborted, _}) -> exit(Reason); abort(Reason) -> exit({aborted, Reason}). +-spec is_transaction() -> boolean(). is_transaction() -> case get(mnesia_activity_state) of {_, Tid, _Ts} when element(1,Tid) == tid -> @@ -325,29 +359,52 @@ is_transaction() -> false end. +-spec transaction(Fun) -> t_result(Res) when + Fun :: fun(() -> Res). transaction(Fun) -> transaction(get(mnesia_activity_state), Fun, [], infinity, ?DEFAULT_ACCESS, async). + +-spec transaction(Fun, Retries) -> t_result(Res) when + Fun :: fun(() -> Res), + Retries :: non_neg_integer() | 'infinity'; + (Fun, [Arg::_]) -> t_result(Res) when + Fun :: fun((...) -> Res). transaction(Fun, Retries) when is_integer(Retries), Retries >= 0 -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, async); transaction(Fun, Retries) when Retries == infinity -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, async); transaction(Fun, Args) -> transaction(get(mnesia_activity_state), Fun, Args, infinity, ?DEFAULT_ACCESS, async). + +-spec transaction(Fun, [Arg::_], Retries) -> t_result(Res) when + Fun :: fun((...) -> Res), + Retries :: non_neg_integer() | 'infinity'. transaction(Fun, Args, Retries) -> transaction(get(mnesia_activity_state), Fun, Args, Retries, ?DEFAULT_ACCESS, async). +-spec sync_transaction(Fun) -> t_result(Res) when + Fun :: fun(() -> Res). sync_transaction(Fun) -> transaction(get(mnesia_activity_state), Fun, [], infinity, ?DEFAULT_ACCESS, sync). + +-spec sync_transaction(Fun, Retries) -> t_result(Res) when + Fun :: fun(() -> Res), + Retries :: non_neg_integer() | 'infinity'; + (Fun, [Arg::_]) -> t_result(Res) when + Fun :: fun((...) -> Res). sync_transaction(Fun, Retries) when is_integer(Retries), Retries >= 0 -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, sync); sync_transaction(Fun, Retries) when Retries == infinity -> transaction(get(mnesia_activity_state), Fun, [], Retries, ?DEFAULT_ACCESS, sync); sync_transaction(Fun, Args) -> transaction(get(mnesia_activity_state), Fun, Args, infinity, ?DEFAULT_ACCESS, sync). + +-spec sync_transaction(Fun, [Arg::_], Retries) -> t_result(Res) when + Fun :: fun((...) -> Res), + Retries :: non_neg_integer() | 'infinity'. sync_transaction(Fun, Args, Retries) -> transaction(get(mnesia_activity_state), Fun, Args, Retries, ?DEFAULT_ACCESS, sync). - transaction(State, Fun, Args, Retries, Mod, Kind) when is_function(Fun), is_list(Args), Retries == infinity, is_atom(Mod) -> mnesia_tm:transaction(State, Fun, Args, Retries, Mod, Kind); @@ -363,28 +420,60 @@ non_transaction(State, Fun, Args, ActivityKind, Mod) non_transaction(_State, Fun, Args, _ActivityKind, _Mod) -> {aborted, {badarg, Fun, Args}}. +-spec async_dirty(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). async_dirty(Fun) -> async_dirty(Fun, []). + +-spec async_dirty(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). async_dirty(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, async_dirty, ?DEFAULT_ACCESS). +-spec sync_dirty(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). sync_dirty(Fun) -> sync_dirty(Fun, []). + +-spec sync_dirty(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). sync_dirty(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, sync_dirty, ?DEFAULT_ACCESS). +-spec ets(Fun) -> Res | no_return() when + Fun :: fun(() -> Res). ets(Fun) -> ets(Fun, []). + +-spec ets(Fun, [Arg::_]) -> Res | no_return() when + Fun :: fun((...) -> Res). ets(Fun, Args) -> non_transaction(get(mnesia_activity_state), Fun, Args, ets, ?DEFAULT_ACCESS). +-spec activity(Kind, Fun) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun(() -> Res). activity(Kind, Fun) -> activity(Kind, Fun, []). + +-spec activity(Kind, Fun, [Arg::_]) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun((...) -> Res); + (Kind, Fun, Mod) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun(() -> Res), + Mod :: atom(). + activity(Kind, Fun, Args) when is_list(Args) -> activity(Kind, Fun, Args, mnesia_monitor:get_env(access_module)); activity(Kind, Fun, Mod) -> activity(Kind, Fun, [], Mod). +-spec activity(Kind, Fun, [Arg::_], Mod) -> t_result(Res) | Res when + Kind :: activity(), + Fun :: fun((...) -> Res), + Mod :: atom(). + activity(Kind, Fun, Args, Mod) -> State = get(mnesia_activity_state), case Kind of @@ -414,7 +503,11 @@ wrap_trans(State, Fun, Args, Retries, Mod, Kind) -> %% Nodes may either be a list of nodes or one node as an atom %% Mnesia on all Nodes must be connected to each other, but %% it is not neccessary that they are up and running. - +-spec lock(LockItem, LockKind) -> list() | tuple() | no_return() when + LockItem :: {'record', table(), Key::term()} | + {'table', table()} | + {'global', Key::term(), MnesiaNodes::[node()]}, + LockKind :: lock_kind() | 'load'. lock(LockItem, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -425,6 +518,9 @@ lock(LockItem, LockKind) -> abort(no_transaction) end. +-spec lock_table(Tab::table(), LockKind) -> [MnesiaNode] | no_return() when + MnesiaNode :: node(), + LockKind :: lock_kind() | load. lock_table(Tab, LockKind) -> lock({table, Tab}, LockKind). @@ -446,11 +542,13 @@ lock(Tid, Ts, LockItem, LockKind) -> end. %% Grab a read lock on a whole table +-spec read_lock_table(Tab::table()) -> ok. read_lock_table(Tab) -> lock({table, Tab}, read), ok. %% Grab a write lock on a whole table +-spec write_lock_table(Tab::table()) -> ok. write_lock_table(Tab) -> lock({table, Tab}, write), ok. @@ -515,17 +613,19 @@ good_global_nodes(Nodes) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Access within an activity - updates - +-spec write(Record::tuple()) -> 'ok'. write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), write(Tab, Val, write); write(Val) -> abort({bad_type, Val}). +-spec s_write(Record::tuple()) -> 'ok'. s_write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), write(Tab, Val, sticky_write). +-spec write(Tab::table(), Record::tuple(), LockKind::write_locks()) -> 'ok'. write(Tab, Val, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -572,16 +672,19 @@ write_to_store(Tab, Store, Oid, Val) -> end, ok. +-spec delete({Tab::table(), Key::_}) -> 'ok'. delete({Tab, Key}) -> delete(Tab, Key, write); delete(Oid) -> abort({bad_type, Oid}). +-spec s_delete({Tab::table(), Key::_}) -> 'ok'. s_delete({Tab, Key}) -> delete(Tab, Key, sticky_write); s_delete(Oid) -> abort({bad_type, Oid}). +-spec delete(Tab::table(), Key::_, LockKind::write_locks()) -> 'ok'. delete(Tab, Key, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -618,18 +721,21 @@ delete(Tid, Ts, Tab, Key, LockKind) delete(_Tid, _Ts, Tab, _Key, _LockKind) -> abort({bad_type, Tab}). +-spec delete_object(Rec::tuple()) -> 'ok'. delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), delete_object(Tab, Val, write); delete_object(Val) -> abort({bad_type, Val}). +-spec s_delete_object(Rec::tuple()) -> 'ok'. s_delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), delete_object(Tab, Val, sticky_write); s_delete_object(Val) -> abort({bad_type, Val}). +-spec delete_object(Tab::table(), Rec::tuple(), LockKind::write_locks()) -> 'ok'. delete_object(Tab, Val, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -689,19 +795,23 @@ do_delete_object(Tid, Ts, Tab, Val, LockKind) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Access within an activity - read +-spec read(Tab::table(), Key::_) -> [tuple()]. read(Tab, Key) -> read(Tab, Key, read). +-spec read({Tab::table(), Key::_}) -> [tuple()]. read({Tab, Key}) -> read(Tab, Key, read); read(Oid) -> abort({bad_type, Oid}). +-spec wread({Tab::table(), Key::_}) -> [tuple()]. wread({Tab, Key}) -> read(Tab, Key, write); wread(Oid) -> abort({bad_type, Oid}). +-spec read(Tab::table(), Key::_, LockKind::lock_kind()) -> [tuple()]. read(Tab, Key, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -738,6 +848,7 @@ read(Tid, Ts, Tab, Key, LockKind) read(_Tid, _Ts, Tab, _Key, _LockKind) -> abort({bad_type, Tab}). +-spec first(Tab::table()) -> Key::term(). first(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -765,6 +876,7 @@ first(Tid, Ts, Tab) first(_Tid, _Ts,Tab) -> abort({bad_type, Tab}). +-spec last(Tab::table()) -> Key::term(). last(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -792,6 +904,7 @@ last(Tid, Ts, Tab) last(_Tid, _Ts,Tab) -> abort({bad_type, Tab}). +-spec next(Tab::table(), Key::term()) -> NextKey::term(). next(Tab,Key) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS,Tid,Ts} -> @@ -818,6 +931,7 @@ next(Tid,Ts,Tab,Key) next(_Tid, _Ts,Tab,_) -> abort({bad_type, Tab}). +-spec prev(Tab::table(), Key::term()) -> PrevKey::term(). prev(Tab,Key) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS,Tid,Ts} -> @@ -952,6 +1066,8 @@ ts_keys_1([], Acc) -> %%%%%%%%%%%%%%%%%%%%% %% Iterators +-spec foldl(Fun, Acc0, Tab::table()) -> Acc when + Fun::fun((Record::tuple(), Acc0) -> Acc). foldl(Fun, Acc, Tab) -> foldl(Fun, Acc, Tab, read). @@ -992,6 +1108,8 @@ do_foldl(A, O, Tab, Key, Fun, Acc, Type, Stored) -> %% Type is set or bag {_, Tid, Ts} = get(mnesia_activity_state), do_foldl(Tid, Ts, Tab, dirty_next(Tab, Key), Fun, NewAcc, Type, NewStored). +-spec foldr(Fun, Acc0, Tab::table()) -> Acc when + Fun::fun((Record::tuple(), Acc0) -> Acc). foldr(Fun, Acc, Tab) -> foldr(Fun, Acc, Tab, read). foldr(Fun, Acc, Tab, LockKind) when is_function(Fun) -> @@ -1105,12 +1223,15 @@ add_written_to_bag([{_, _ , delete} | Tail], _Objs, _Ack) -> add_written_to_bag([{_, Val, delete_object} | Tail], Objs, Ack) -> add_written_to_bag(Tail, lists:delete(Val, Objs), lists:delete(Val, Ack)). +-spec match_object(Pattern::tuple()) -> [Record::tuple()]. match_object(Pat) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), match_object(Tab, Pat, read); match_object(Pat) -> abort({bad_type, Pat}). +-spec match_object(Tab,Pattern,LockKind) -> [Record] when + Tab::table(),Pattern::tuple(),LockKind::lock_kind(),Record::tuple(). match_object(Tab, Pat, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1270,9 +1391,13 @@ deloid(Oid, [H | T]) -> %%%%%%%%%%%%%%%%%% % select - +-spec select(Tab, Spec) -> [Match] when + Tab::table(), Spec::ets:match_spec(), Match::term(). select(Tab, Pat) -> select(Tab, Pat, read). +-spec select(Tab, Spec, LockKind) -> [Match] when + Tab::table(), Spec::ets:match_spec(), + Match::term(),LockKind::lock_kind(). select(Tab, Pat, LockKind) when is_atom(Tab), Tab /= schema, is_list(Pat) -> case get(mnesia_activity_state) of @@ -1331,6 +1456,11 @@ select_lock(Tid,Ts,LockKind,Spec,Tab) -> end. %% Breakable Select +-spec select(Tab, Spec, N, LockKind) -> {[Match], Cont} | '$end_of_table' when + Tab::table(), Spec::ets:match_spec(), + Match::term(), N::non_neg_integer(), + LockKind::lock_kind(), + Cont::select_continuation(). select(Tab, Pat, NObjects, LockKind) when is_atom(Tab), Tab /= schema, is_list(Pat), is_integer(NObjects) -> case get(mnesia_activity_state) of @@ -1387,6 +1517,9 @@ fun_select(Tid, Ts, Tab, Spec, LockKind, TabPat, Init, NObjects, Node, Storage) select_state(Init(Spec),Def) end. +-spec select(Cont) -> {[Match], Cont} | '$end_of_table' when + Match::term(), + Cont::select_continuation(). select(Cont) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1436,6 +1569,7 @@ get_record_pattern([]) -> []; get_record_pattern([{M,C,_B}|R]) -> [{M,C,['$_']} | get_record_pattern(R)]. +-spec all_keys(Tab::table()) -> [Key::term()]. all_keys(Tab) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1460,12 +1594,20 @@ all_keys(Tid, Ts, Tab, LockKind) all_keys(_Tid, _Ts, Tab, _LockKind) -> abort({bad_type, Tab}). +-spec index_match_object(Pattern, Attr) -> [Record] when + Pattern::tuple(), Attr::index_attr(), Record::tuple(). index_match_object(Pat, Attr) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), index_match_object(Tab, Pat, Attr, read); index_match_object(Pat, _Attr) -> abort({bad_type, Pat}). +-spec index_match_object(Tab, Pattern, Attr, LockKind) -> [Record] when + Tab::table(), + Pattern::tuple(), + Attr::index_attr(), + LockKind::lock_kind(), + Record::tuple(). index_match_object(Tab, Pat, Attr, LockKind) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1502,6 +1644,11 @@ index_match_object(Tid, Ts, Tab, Pat, Attr, LockKind) index_match_object(_Tid, _Ts, Tab, Pat, _Attr, _LockKind) -> abort({bad_type, Tab, Pat}). +-spec index_read(Tab, Key, Attr) -> [Record] when + Tab::table(), + Key::term(), + Attr::index_attr(), + Record::tuple(). index_read(Tab, Key, Attr) -> case get(mnesia_activity_state) of {?DEFAULT_ACCESS, Tid, Ts} -> @@ -1541,13 +1688,14 @@ index_read(_Tid, _Ts, Tab, _Key, _Attr, _LockKind) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Dirty access regardless of activities - updates - +-spec dirty_write(Record::tuple()) -> 'ok'. dirty_write(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), dirty_write(Tab, Val); dirty_write(Val) -> abort({bad_type, Val}). +-spec dirty_write(Tab::table(), Record::tuple()) -> 'ok'. dirty_write(Tab, Val) -> do_dirty_write(async_dirty, Tab, Val). @@ -1559,11 +1707,13 @@ do_dirty_write(SyncMode, Tab, Val) do_dirty_write(_SyncMode, Tab, Val) -> abort({bad_type, Tab, Val}). +-spec dirty_delete({Tab::table(), Key::_}) -> 'ok'. dirty_delete({Tab, Key}) -> dirty_delete(Tab, Key); dirty_delete(Oid) -> abort({bad_type, Oid}). +-spec dirty_delete(Tab::table(), Key::_) -> 'ok'. dirty_delete(Tab, Key) -> do_dirty_delete(async_dirty, Tab, Key). @@ -1573,12 +1723,14 @@ do_dirty_delete(SyncMode, Tab, Key) when is_atom(Tab), Tab /= schema -> do_dirty_delete(_SyncMode, Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_delete_object(Record::tuple()) -> 'ok'. dirty_delete_object(Val) when is_tuple(Val), tuple_size(Val) > 2 -> Tab = element(1, Val), dirty_delete_object(Tab, Val); dirty_delete_object(Val) -> abort({bad_type, Val}). +-spec dirty_delete_object(Tab::table(), Record::tuple()) -> 'ok'. dirty_delete_object(Tab, Val) -> do_dirty_delete_object(async_dirty, Tab, Val). @@ -1596,12 +1748,15 @@ do_dirty_delete_object(_SyncMode, Tab, Val) -> abort({bad_type, Tab, Val}). %% A Counter is an Oid being {CounterTab, CounterName} - +-spec dirty_update_counter({Tab::table(), Key::_}, Incr::integer()) -> + NewVal::integer(). dirty_update_counter({Tab, Key}, Incr) -> dirty_update_counter(Tab, Key, Incr); dirty_update_counter(Counter, _Incr) -> abort({bad_type, Counter}). +-spec dirty_update_counter(Tab::table(), Key::_, Incr::integer()) -> + NewVal::integer(). dirty_update_counter(Tab, Key, Incr) -> do_dirty_update_counter(async_dirty, Tab, Key, Incr). @@ -1620,23 +1775,28 @@ do_dirty_update_counter(_SyncMode, Tab, _Key, Incr) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Dirty access regardless of activities - read +-spec dirty_read({Tab::table(), Key::_}) -> [tuple()]. dirty_read({Tab, Key}) -> dirty_read(Tab, Key); dirty_read(Oid) -> abort({bad_type, Oid}). +-spec dirty_read(Tab::table(), Key::_) -> [tuple()]. dirty_read(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_get, [Tab, Key]); dirty_read(Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_match_object(Pattern::tuple()) -> [Record::tuple()]. dirty_match_object(Pat) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), dirty_match_object(Tab, Pat); dirty_match_object(Pat) -> abort({bad_type, Pat}). +-spec dirty_match_object(Tab,Pattern) -> [Record] when + Tab::table(), Pattern::tuple(), Record::tuple(). dirty_match_object(Tab, Pat) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> dirty_rpc(Tab, ?MODULE, remote_dirty_match_object, [Tab, Pat]); @@ -1666,6 +1826,8 @@ remote_dirty_match_object(Tab, Pat, []) -> remote_dirty_match_object(Tab, Pat, _PosList) -> abort({bad_type, Tab, Pat}). +-spec dirty_select(Tab, Spec) -> [Match] when + Tab::table(), Spec::ets:match_spec(), Match::term(). dirty_select(Tab, Spec) when is_atom(Tab), Tab /= schema, is_list(Spec) -> dirty_rpc(Tab, ?MODULE, remote_dirty_select, [Tab, Spec]); dirty_select(Tab, Spec) -> @@ -1714,6 +1876,7 @@ dirty_sel_cont(#mnesia_select{cont='$end_of_table'}) -> '$end_of_table'; dirty_sel_cont(#mnesia_select{node=Node,tab=Tab,storage=Type,cont=Cont,orig=Ms}) -> do_dirty_rpc(Tab,Node,mnesia_lib,db_select_cont,[Type,Cont,Ms]). +-spec dirty_all_keys(Tab::table()) -> [Key::term()]. dirty_all_keys(Tab) when is_atom(Tab), Tab /= schema -> case ?catch_val({Tab, wild_pattern}) of {'EXIT', _} -> @@ -1729,12 +1892,19 @@ dirty_all_keys(Tab) when is_atom(Tab), Tab /= schema -> dirty_all_keys(Tab) -> abort({bad_type, Tab}). +-spec dirty_index_match_object(Pattern, Attr) -> [Record] when + Pattern::tuple(), Attr::index_attr(), Record::tuple(). dirty_index_match_object(Pat, Attr) when is_tuple(Pat), tuple_size(Pat) > 2 -> Tab = element(1, Pat), dirty_index_match_object(Tab, Pat, Attr); dirty_index_match_object(Pat, _Attr) -> abort({bad_type, Pat}). +-spec dirty_index_match_object(Tab, Pattern, Attr) -> [Record] when + Tab::table(), + Pattern::tuple(), + Attr::index_attr(), + Record::tuple(). dirty_index_match_object(Tab, Pat, Attr) when is_atom(Tab), Tab /= schema, is_tuple(Pat), tuple_size(Pat) > 2 -> case mnesia_schema:attr_tab_to_pos(Tab, Attr) of @@ -1758,6 +1928,11 @@ dirty_index_match_object(Tab, Pat, Attr) dirty_index_match_object(Tab, Pat, _Attr) -> abort({bad_type, Tab, Pat}). +-spec dirty_index_read(Tab, Key, Attr) -> [Record] when + Tab::table(), + Key::term(), + Attr::index_attr(), + Record::tuple(). dirty_index_read(Tab, Key, Attr) when is_atom(Tab), Tab /= schema -> Pos = mnesia_schema:attr_tab_to_pos(Tab, Attr), case has_var(Key) of @@ -1769,26 +1944,31 @@ dirty_index_read(Tab, Key, Attr) when is_atom(Tab), Tab /= schema -> dirty_index_read(Tab, _Key, _Attr) -> abort({bad_type, Tab}). +%% do not use only for backwards compatibility dirty_slot(Tab, Slot) when is_atom(Tab), Tab /= schema, is_integer(Slot) -> dirty_rpc(Tab, mnesia_lib, db_slot, [Tab, Slot]); dirty_slot(Tab, Slot) -> abort({bad_type, Tab, Slot}). +-spec dirty_first(Tab::table()) -> Key::term(). dirty_first(Tab) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_first, [Tab]); dirty_first(Tab) -> abort({bad_type, Tab}). +-spec dirty_last(Tab::table()) -> Key::term(). dirty_last(Tab) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_last, [Tab]); dirty_last(Tab) -> abort({bad_type, Tab}). +-spec dirty_next(Tab::table(), Key::_) -> NextKey::term(). dirty_next(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_next_key, [Tab, Key]); dirty_next(Tab, _Key) -> abort({bad_type, Tab}). +-spec dirty_prev(Tab::table(), Key::_) -> PrevKey::term(). dirty_prev(Tab, Key) when is_atom(Tab), Tab /= schema -> dirty_rpc(Tab, mnesia_lib, db_prev_key, [Tab, Key]); dirty_prev(Tab, _Key) -> @@ -1839,7 +2019,7 @@ do_dirty_rpc(Tab, Node, M, F, Args) -> %% Info %% Info about one table --spec table_info(atom(), any()) -> any(). +-spec table_info(Tab::table(), Item::term()) -> Info::term(). table_info(Tab, Item) -> case get(mnesia_activity_state) of undefined -> @@ -1927,16 +2107,20 @@ bad_info_reply(_Tab, memory) -> 0; bad_info_reply(Tab, Item) -> abort({no_exists, Tab, Item}). %% Raw info about all tables +-spec schema() -> ok. schema() -> mnesia_schema:info(). %% Raw info about one tables +-spec schema(Tab::table()) -> ok. schema(Tab) -> mnesia_schema:info(Tab). +-spec error_description(Error::term()) -> string(). error_description(Err) -> mnesia_lib:error_desc(Err). +-spec info() -> ok. info() -> case mnesia_lib:is_running() of yes -> @@ -2062,6 +2246,7 @@ display_tab_info() -> Rdisp = fun({Rpat, Rtabs}) -> io:format("~p = ~p~n", [Rpat, Rtabs]) end, lists:foreach(Rdisp, lists:sort(Repl)). +-spec get_backend_types() -> [BackendType::term()]. get_backend_types() -> case ?catch_val({schema, user_property, mnesia_backend_types}) of {'EXIT', _} -> @@ -2070,6 +2255,7 @@ get_backend_types() -> lists:sort(Ts) end. +-spec get_index_plugins() -> [IndexPlugins::term()]. get_index_plugins() -> case ?catch_val({schema, user_property, mnesia_index_plugins}) of {'EXIT', _} -> @@ -2118,6 +2304,7 @@ storage_count(T, {U, R, D, DO, Ext}) -> {ext, A, _} -> {U, R, D, DO, orddict:append(A, T, Ext)} end. +-spec system_info(Iterm::term()) -> Info::term(). system_info(Item) -> try system_info2(Item) catch _:Error -> abort(Error) @@ -2367,83 +2554,134 @@ load_mnesia_or_abort() -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Database mgt +-spec create_schema(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. create_schema(Ns) -> create_schema(Ns, []). +-spec create_schema(Ns::[node()], [Prop]) -> 'ok' | {'error', Reason::term()} when + Prop :: BackendType | IndexPlugin, + BackendType :: {backend_types, [{Name::atom(), Module::module()}]}, + IndexPlugin :: {index_plugins, [{{Name::atom()}, Module::module(), Function::atom()}]}. create_schema(Ns, Properties) -> mnesia_bup:create_schema(Ns, Properties). +-spec delete_schema(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. delete_schema(Ns) -> mnesia_schema:delete_schema(Ns). +-spec add_backend_type(Name::atom(), Module::module()) -> t_result('ok'). add_backend_type(Alias, Module) -> mnesia_schema:add_backend_type(Alias, Module). +-spec backup(Dest::term()) -> 'ok' | {'error', Reason::term()}. backup(Opaque) -> mnesia_log:backup(Opaque). +-spec backup(Dest::term(), Mod::module()) -> + 'ok' | {'error', Reason::term()}. backup(Opaque, Mod) -> mnesia_log:backup(Opaque, Mod). +-spec traverse_backup(Src::term(), Dest::term(), Fun, Acc) -> + {'ok', Acc} | {'error', Reason::term()} when + Fun :: fun((Items, Acc) -> {Items,Acc}). traverse_backup(S, T, Fun, Acc) -> mnesia_bup:traverse_backup(S, T, Fun, Acc). +-spec traverse_backup(Src::term(), SrcMod::module(), + Dest::term(), DestMod::module(), + Fun, Acc) -> + {'ok', Acc} | {'error', Reason::term()} when + Fun :: fun((Items, Acc) -> {Items,Acc}). traverse_backup(S, SM, T, TM, F, A) -> mnesia_bup:traverse_backup(S, SM, T, TM, F, A). +-spec install_fallback(Src::term()) -> 'ok' | {'error', Reason::term()}. install_fallback(Opaque) -> mnesia_bup:install_fallback(Opaque). +-spec install_fallback(Src::term(), Mod::module()|[Opt]) -> + 'ok' | {'error', Reason::term()} when + Opt :: Module | Scope | Dir, + Module :: {'module', Mod::module()}, + Scope :: {'scope', 'global' | 'local'}, + Dir :: {'mnesia_dir', Dir::string()}. install_fallback(Opaque, Mod) -> mnesia_bup:install_fallback(Opaque, Mod). +-spec uninstall_fallback() -> 'ok' | {'error', Reason::term()}. uninstall_fallback() -> mnesia_bup:uninstall_fallback(). +-spec uninstall_fallback(Args) -> 'ok' | {'error', Reason::term()} when + Args :: [{'mnesia_dir', Dir::string()}]. uninstall_fallback(Args) -> mnesia_bup:uninstall_fallback(Args). +-spec activate_checkpoint([Arg]) -> {'ok', Name, [node()]} | {'error', Reason::term()} when + Arg :: {'name', Name} | {'max', [table()]} | {'min', [table()]} | + {'allow_remote', boolean()} | {'ram_overrides_dump', boolean()}. activate_checkpoint(Args) -> mnesia_checkpoint:activate(Args). +-spec deactivate_checkpoint(Name::_) -> 'ok' | {'error', Reason::term()}. deactivate_checkpoint(Name) -> mnesia_checkpoint:deactivate(Name). +-spec backup_checkpoint(Name::_, Dest::_) -> 'ok' | {'error', Reason::term()}. backup_checkpoint(Name, Opaque) -> mnesia_log:backup_checkpoint(Name, Opaque). +-spec backup_checkpoint(Name::_, Dest::_, Mod::module()) -> + 'ok' | {'error', Reason::term()}. backup_checkpoint(Name, Opaque, Mod) -> mnesia_log:backup_checkpoint(Name, Opaque, Mod). +-spec restore(Src::_, [Arg]) -> t_result([table()]) when + Op :: 'skip_tables' | 'clear_tables' | 'keep_tables' | 'restore_tables', + Arg :: {'module', module()} | {Op, [table()]} | {'default_op', Op}. restore(Opaque, Args) -> mnesia_schema:restore(Opaque, Args). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - +-spec create_table([Arg]) -> t_result('ok') when + Arg :: {'name', table()} | create_option(). create_table(Arg) -> mnesia_schema:create_table(Arg). + +-spec create_table(Name::table(), [create_option()]) -> t_result('ok'). create_table(Name, Arg) when is_list(Arg) -> mnesia_schema:create_table([{name, Name}| Arg]); create_table(Name, Arg) -> {aborted, badarg, Name, Arg}. +-spec delete_table(Tab::table()) -> t_result('ok'). delete_table(Tab) -> mnesia_schema:delete_table(Tab). +-spec add_table_copy(Tab::table(), N::node(), ST::storage_type()) -> t_result(ok). add_table_copy(Tab, N, S) -> mnesia_schema:add_table_copy(Tab, N, S). + +-spec del_table_copy(Tab::table(), N::node()) -> t_result(ok). del_table_copy(Tab, N) -> mnesia_schema:del_table_copy(Tab, N). +-spec move_table_copy(Tab::table(), From::node(), To::node()) -> t_result(ok). move_table_copy(Tab, From, To) -> mnesia_schema:move_table(Tab, From, To). +-spec add_table_index(Tab::table(), I::index_attr()) -> t_result(ok). add_table_index(Tab, Ix) -> mnesia_schema:add_table_index(Tab, Ix). +-spec del_table_index(Tab::table(), I::index_attr()) -> t_result(ok). del_table_index(Tab, Ix) -> mnesia_schema:del_table_index(Tab, Ix). +-spec transform_table(Tab::table(), Fun, [Attr]) -> t_result(ok) when + Attr :: atom(), + Fun:: fun((Record::tuple()) -> Transformed::tuple()). transform_table(Tab, Fun, NewA) -> try val({Tab, record_name}) of OldRN -> mnesia_schema:transform_table(Tab, Fun, NewA, OldRN) @@ -2451,12 +2689,18 @@ transform_table(Tab, Fun, NewA) -> mnesia:abort(Reason) end. +-spec transform_table(Tab::table(), Fun, [Attr], RecName) -> t_result(ok) when + RecName :: atom(), + Attr :: atom(), + Fun:: fun((Record::tuple()) -> Transformed::tuple()). transform_table(Tab, Fun, NewA, NewRN) -> mnesia_schema:transform_table(Tab, Fun, NewA, NewRN). +-spec change_table_copy_type(Tab::table(), Node::node(), To::storage_type()) -> t_result(ok). change_table_copy_type(T, N, S) -> mnesia_schema:change_table_copy_type(T, N, S). +-spec clear_table(Tab::table()) -> t_result(ok). clear_table(Tab) -> case get(mnesia_activity_state) of State = {Mod, Tid, _Ts} when element(1, Tid) =/= tid -> @@ -2486,19 +2730,22 @@ clear_table(Tid, Ts, Tab, Obj) when element(1, Tid) =:= tid -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - user properties - +-spec read_table_property(Tab::table(), PropKey::term()) -> Res::tuple(). read_table_property(Tab, PropKey) -> val({Tab, user_property, PropKey}). +-spec write_table_property(Tab::table(), Prop::tuple()) -> t_result(ok). write_table_property(Tab, Prop) -> mnesia_schema:write_table_property(Tab, Prop). +-spec delete_table_property(Tab::table(), PropKey::term()) -> t_result(ok). delete_table_property(Tab, PropKey) -> mnesia_schema:delete_table_property(Tab, PropKey). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Table mgt - user properties +-spec change_table_frag(Tab::table(), FP::term()) -> t_result(ok). change_table_frag(Tab, FragProp) -> mnesia_schema:change_table_frag(Tab, FragProp). @@ -2506,28 +2753,38 @@ change_table_frag(Tab, FragProp) -> %% Table mgt - table load %% Dump a ram table to disc +-spec dump_tables([Tab::table()]) -> t_result(ok). dump_tables(Tabs) -> mnesia_schema:dump_tables(Tabs). %% allow the user to wait for some tables to be loaded +-spec wait_for_tables([Tab::table()], TMO::timeout()) -> + 'ok' | {'timeout', [table()]} | {'error', Reason::term()}. wait_for_tables(Tabs, Timeout) -> mnesia_controller:wait_for_tables(Tabs, Timeout). +-spec force_load_table(Tab::table()) -> 'yes' | {'error', Reason::term()}. force_load_table(Tab) -> case mnesia_controller:force_load_table(Tab) of ok -> yes; % Backwards compatibility Other -> Other end. +-spec change_table_access_mode(Tab::table(), Mode) -> t_result(ok) when + Mode :: 'read_only'|'read_write'. change_table_access_mode(T, Access) -> mnesia_schema:change_table_access_mode(T, Access). +-spec change_table_load_order(Tab::table(), Order) -> t_result(ok) when + Order :: non_neg_integer(). change_table_load_order(T, O) -> mnesia_schema:change_table_load_order(T, O). +-spec change_table_majority(Tab::table(), M::boolean()) -> t_result(ok). change_table_majority(T, M) -> mnesia_schema:change_table_majority(T, M). +-spec set_master_nodes(Ns::[node()]) -> 'ok' | {'error', Reason::term()}. set_master_nodes(Nodes) when is_list(Nodes) -> UseDir = system_info(use_dir), IsRunning = system_info(is_running), @@ -2566,6 +2823,8 @@ log_valid_master_nodes(Cstructs, Nodes, UseDir, IsRunning) -> Args = lists:map(Fun, Cstructs), mnesia_recover:log_master_nodes(Args, UseDir, IsRunning). +-spec set_master_nodes(Tab::table(), Ns::[node()]) -> + 'ok' | {'error', Reason::term()}. set_master_nodes(Tab, Nodes) when is_list(Nodes) -> UseDir = system_info(use_dir), IsRunning = system_info(is_running), @@ -2616,31 +2875,39 @@ set_master_nodes(Tab, Nodes) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Misc admin - +-spec dump_log() -> 'dumped'. dump_log() -> mnesia_controller:sync_dump_log(user). +-spec sync_log() -> 'ok' | {'error', Reason::term()}. sync_log() -> mnesia_monitor:sync_log(latest_log). +-spec subscribe(What) -> {'ok', node()} | {'error', Reason::term()} when + What :: 'system' | 'activity' | {'table', table(), 'simple' | 'detailed'}. subscribe(What) -> mnesia_subscr:subscribe(self(), What). +-spec unsubscribe(What) -> {'ok', node()} | {'error', Reason::term()} when + What :: 'system' | 'activity' | {'table', table(), 'simple' | 'detailed'}. unsubscribe(What) -> mnesia_subscr:unsubscribe(self(), What). +-spec report_event(Event::_) -> 'ok'. report_event(Event) -> mnesia_lib:report_system_event({mnesia_user, Event}). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Snmp - +-spec snmp_open_table(Tab::table(), Snmp::snmp_struct()) -> ok. snmp_open_table(Tab, Us) -> mnesia_schema:add_snmp(Tab, Us). +-spec snmp_close_table(Tab::table()) -> ok. snmp_close_table(Tab) -> mnesia_schema:del_snmp(Tab). +-spec snmp_get_row(Tab::table(), [integer()]) -> {'ok', Row::tuple()} | 'undefined'. snmp_get_row(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> case get(mnesia_activity_state) of {Mod, Tid, Ts=#tidstore{store=Store}} when element(1, Tid) =:= tid -> @@ -2676,7 +2943,7 @@ snmp_get_row(Tab, _RowIndex) -> abort({bad_type, Tab}). %%%%%%%%%%%%% - +-spec snmp_get_next_index(Tab::table(), [integer()]) -> {'ok', [integer()]} | 'endOfTable'. snmp_get_next_index(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> {Next,OrigKey} = dirty_rpc(Tab, mnesia_snmp_hook, get_next_index, [Tab, RowIndex]), case get(mnesia_activity_state) of @@ -2718,7 +2985,7 @@ get_ordered_snmp_key(_, []) -> endOfTable. %%%%%%%%%% - +-spec snmp_get_mnesia_key(Tab::table(), [integer()]) -> {'ok', Key::term()} | 'undefined'. snmp_get_mnesia_key(Tab, RowIndex) when is_atom(Tab), Tab /= schema, is_list(RowIndex) -> case get(mnesia_activity_state) of {_Mod, Tid, Ts} when element(1, Tid) =:= tid -> @@ -2782,17 +3049,27 @@ snmp_filter_key(undefined, RowIndex, Tab, Store) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Textfile access - +-spec load_textfile(File::file:filename()) -> t_result(ok) | {'error', term()}. load_textfile(F) -> mnesia_text:load_textfile(F). + +-spec dump_to_textfile(File :: file:filename()) -> 'ok' | 'error' | {'error', term()}. dump_to_textfile(F) -> mnesia_text:dump_to_textfile(F). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% QLC Handles %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +-spec table(Tab::table()) -> qlc:query_handle(). table(Tab) -> table(Tab, []). + +-spec table(Tab::table(), Options) -> qlc:query_handle() when + Options :: Option | [Option], + Option :: MnesiaOpt | QlcOption, + MnesiaOpt :: {'traverse', SelectOp} | {lock, lock_kind()} | {n_objects, non_neg_integer()}, + SelectOp :: 'select' | {'select', ets:match_spec()}, + QlcOption :: {'key_equality', '==' | '=:='}. table(Tab,Opts) -> {[Trav,Lock,NObjects],QlcOptions0} = qlc_opts(Opts,[{traverse,select},{lock,read},{n_objects,100}]), diff --git a/lib/mnesia/src/mnesia_app.erl b/lib/mnesia/src/mnesia_app.erl new file mode 100644 index 0000000000..4d89011db2 --- /dev/null +++ b/lib/mnesia/src/mnesia_app.erl @@ -0,0 +1,41 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-module(mnesia_app). + +-behaviour(application). + +-export([start/2, stop/1]). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% application callback functions + +start(normal, Args) -> + case mnesia_sup:start_link(Args) of + {ok, Pid} -> + {ok, Pid, {normal, Args}}; + Error -> + Error + end; +start(_, _) -> + {error, badarg}. + +stop(_StartArgs) -> + ok. diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index 10e232c800..1fdc656600 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -1192,25 +1192,15 @@ db_select(Storage, Tab, Pat) -> end. db_select_init({ext, Alias, Mod}, Tab, Pat, Limit) -> - case Mod:select(Alias, Tab, Pat, Limit) of - {Matches, Continuation} when is_list(Matches) -> - {Matches, {Alias, Continuation}}; - R -> - R - end; + Mod:select(Alias, Tab, Pat, Limit); db_select_init(disc_only_copies, Tab, Pat, Limit) -> dets:select(Tab, Pat, Limit); db_select_init(_, Tab, Pat, Limit) -> ets:select(Tab, Pat, Limit). -db_select_cont({ext, Alias, Mod}, Cont0, Ms) -> +db_select_cont({ext, _Alias, Mod}, Cont0, Ms) -> Cont = Mod:repair_continuation(Cont0, Ms), - case Mod:select(Cont) of - {Matches, Continuation} when is_list(Matches) -> - {Matches, {Alias, Continuation}}; - R -> - R - end; + Mod:select(Cont); db_select_cont(disc_only_copies, Cont0, Ms) -> Cont = dets:repair_continuation(Cont0, Ms), dets:select(Cont); diff --git a/lib/mnesia/src/mnesia_sup.erl b/lib/mnesia/src/mnesia_sup.erl index 4aece81308..3e5792900b 100644 --- a/lib/mnesia/src/mnesia_sup.erl +++ b/lib/mnesia/src/mnesia_sup.erl @@ -23,39 +23,21 @@ -module(mnesia_sup). --behaviour(application). -behaviour(supervisor). --export([start/0, start/2, init/1, stop/1, start_event/0, kill/0]). +-export([start_link/1, init/1, start_event/0, kill/0]). -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% application and suprvisor callback functions - -start(normal, Args) -> - SupName = {local,?MODULE}, - case supervisor:start_link(SupName, ?MODULE, [Args]) of - {ok, Pid} -> - {ok, Pid, {normal, Args}}; - Error -> - Error - end; -start(_, _) -> - {error, badarg}. - -start() -> - SupName = {local,?MODULE}, - supervisor:start_link(SupName, ?MODULE, []). +start_link(Args) -> + supervisor:start_link({local,?MODULE}, ?MODULE, [Args]). -stop(_StartArgs) -> - ok. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% supervisor callback functions -init([]) -> % Supervisor - init(); -init([[]]) -> % Application +init([[]]) -> init(); init(BadArg) -> {error, {badarg, BadArg}}. - + init() -> Flags = {one_for_all, 0, 3600}, % Should be rest_for_one policy @@ -124,4 +106,3 @@ ensure_dead(Name) -> timer:sleep(10), ensure_dead(Name) end. - diff --git a/lib/mnesia/test/ext_test.erl b/lib/mnesia/test/ext_test.erl index 45ddb148bc..b7904c95ac 100644 --- a/lib/mnesia/test/ext_test.erl +++ b/lib/mnesia/test/ext_test.erl @@ -233,5 +233,5 @@ select_1({Acc, C}) -> select(ext_ets, Tab, Ms, Limit) when is_integer(Limit); Limit =:= infinity -> ets:select(mnesia_lib:val({?MODULE,Tab}), Ms, Limit). -repair_continuation({Alias, Cont}, Ms) -> - {Alias, ets:repair_continuation(Cont, Ms)}. +repair_continuation(Cont, Ms) -> + ets:repair_continuation(Cont, Ms). diff --git a/lib/odbc/configure.in b/lib/odbc/configure.in index d26daa5eda..4deda13c8b 100644 --- a/lib/odbc/configure.in +++ b/lib/odbc/configure.in @@ -65,7 +65,7 @@ dnl --------------------------------------------------------------------- dnl Special windows stuff regarding CFLAGS and details in the environment... dnl --------------------------------------------------------------------- LM_WINDOWS_ENVIRONMENT - + AC_PROG_MAKE_SET AC_CHECK_PROGS(LD, ld.sh) @@ -136,8 +136,8 @@ AC_CHECK_MEMBERS([struct sockaddr_in6.sin6_addr], [], [], dnl Checks for library functions. AC_CHECK_FUNCS([memset socket]) - -# ODBC + +# ODBC $RM -f "$ERL_TOP/lib/odbc/SKIP" LM_CHECK_THR_LIB @@ -147,23 +147,23 @@ AC_SUBST(THR_LIBS) odbc_lib_link_success=no AC_SUBST(TARGET_FLAGS) case $host_os in - darwin1[[0-5]].*|darwin[[0-9]].*) + darwin*) TARGET_FLAGS="-DUNIX" if test ! -d "$with_odbc" || test "$with_odbc" = "yes"; then - ODBC_LIB= -L"/usr/lib" - ODBC_INCLUDE="-I/usr/lib/include" + ODBC_LIB= -L"/usr/local/lib" + ODBC_INCLUDE="-I/usr/local/include" else ODBC_LIB=-L"$with_odbc/lib" ODBC_INCLUDE="-I$with_odbc/include" fi - - AC_CHECK_LIB(iodbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -liodbc"; odbc_lib_link_success=yes]) + + AC_CHECK_LIB(iodbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) ;; win32|cygwin) TARGET_FLAGS="-DWIN32" AC_CHECK_LIB(ws2_32, main) if test ! -d "$with_odbc" || test "$with_odbc" = "yes"; then - ODBC_LIB="" + ODBC_LIB="" ODBC_INCLUDE="" else ODBC_LIB=-L"$with_odbc/lib" @@ -196,7 +196,7 @@ AC_SUBST(TARGET_FLAGS) elif test -d "${libdir}/64/."; then libdir="${libdir}/64" fi - fi + fi ODBC_LIB="-L$libdir" ODBC_INCLUDE="-I$erl_xcomp_isysroot$rdir/include" break @@ -207,7 +207,7 @@ AC_SUBST(TARGET_FLAGS) echo "No odbc library found" > "$ERL_TOP/lib/odbc/SKIP" else AC_MSG_RESULT($ODBC_LIB) - AC_CHECK_LIB(odbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) + AC_CHECK_LIB(odbc, SQLAllocHandle,[ODBC_LIB="$ODBC_LIB -lodbc"; odbc_lib_link_success=yes]) fi ;; diff --git a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl index 545be62852..8f7da2425b 100644 --- a/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl +++ b/lib/orber/COSS/CosNaming/CosNaming_NamingContextExt_impl.erl @@ -624,12 +624,7 @@ destroy(OE_THIS, OE_State) -> orber:dbg("[~p] ~p:destroy(~p);~n" "DB access returned ~p", [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL), - {'EXCEPTION', #'CosNaming_NamingContext_NotEmpty'{}}; - Other -> - orber:dbg("[~p] ~p:destroy(~p);~n" - "DB access returned ~p", - [?LINE, ?MODULE, SubobjKey, Other], ?DEBUG_LEVEL), - {'EXCEPTION', #'INTERNAL'{completion_status=?COMPLETED_NO}} + {'EXCEPTION', #'CosNaming_NamingContext_NotEmpty'{}} end end, case mnesia:transaction(_DF) of diff --git a/lib/orber/doc/src/notes.xml b/lib/orber/doc/src/notes.xml index 89f258e5e9..5a82270b28 100644 --- a/lib/orber/doc/src/notes.xml +++ b/lib/orber/doc/src/notes.xml @@ -33,6 +33,20 @@ <file>notes.xml</file> </header> + <section><title>Orber 3.8.3</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix some dialyzer warnings</p> + <p> + Own Id: OTP-14006</p> + </item> + </list> + </section> + + </section> <section><title>Orber 3.8.2</title> diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index faebbc4059..1be84f5a83 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -2115,7 +2115,7 @@ call_RQprotected(Module, Obj, Func, Args, GroupID, RQCtx) -> sticky_write), Reply; % retransmitted request - #ft_reply_retention{reply = Reply} -> + [#ft_reply_retention{reply = Reply}] -> Reply end. diff --git a/lib/orber/src/orber_ifr_contained.erl b/lib/orber/src/orber_ifr_contained.erl index d5f41fbe72..2a67fa98fd 100644 --- a/lib/orber/src/orber_ifr_contained.erl +++ b/lib/orber/src/orber_ifr_contained.erl @@ -232,7 +232,7 @@ move(true, Contained_objref, New_container, New_name, New_version) -> lists:filter(fun(X) -> X /= Contained_objref end, select(Old_container_obj, contents))), - New_container_obj = mnesia:read(New_container), + [New_container_obj] = mnesia:read(New_container), Contents = orber_ifr_container:contents(New_container, dk_All, true), New_new_container_obj = diff --git a/lib/orber/vsn.mk b/lib/orber/vsn.mk index dcb2c985a3..595e686cb7 100644 --- a/lib/orber/vsn.mk +++ b/lib/orber/vsn.mk @@ -1 +1 @@ -ORBER_VSN = 3.8.2 +ORBER_VSN = 3.8.3 diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index ecd320c1ea..7f866507a0 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-7](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index efe6cc9eb4..6a16c8689e 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -643,6 +643,8 @@ get_items([], _Dict) -> check_item({_,{mod,{M,A}}},_) when is_atom(M) -> {M,A}; +check_item({_,{mod,[]}},_) -> % default mod is [], so accept as entry + []; check_item({_,{vsn,Vsn}},I) -> case string_p(Vsn) of true -> Vsn; @@ -678,6 +680,8 @@ check_item({_,{modules,Mods}},I) -> true -> Mods; _ -> throw({bad_param, I}) end; +check_item({_,{start_phases,undefined}},_) -> % default start_phase is undefined, + undefined; % so accept as entry check_item({_,{start_phases,Phase}},I) -> case t_list_p(Phase) of true -> Phase; diff --git a/lib/sasl/test/systools_SUITE.erl b/lib/sasl/test/systools_SUITE.erl index bf95ceb70c..dd5f277a77 100644 --- a/lib/sasl/test/systools_SUITE.erl +++ b/lib/sasl/test/systools_SUITE.erl @@ -59,7 +59,7 @@ no_appup_relup/1, bad_appup_relup/1, app_start_type_relup/1, regexp_relup/1]). -export([normal_hybrid/1,hybrid_no_old_sasl/1,hybrid_no_new_sasl/1]). --export([otp_6226_outdir/1]). +-export([otp_6226_outdir/1, app_file_defaults/1]). -export([init_per_suite/1, end_per_suite/1, init_per_testcase/2, end_per_testcase/2]). -export([delete_tree/1]). @@ -97,7 +97,7 @@ groups() -> no_appup_relup, bad_appup_relup, app_start_type_relup, regexp_relup ]}, {hybrid, [], [normal_hybrid,hybrid_no_old_sasl,hybrid_no_new_sasl]}, - {options, [], [otp_6226_outdir]}]. + {options, [], [otp_6226_outdir,app_file_defaults]}]. init_per_group(_GroupName, Config) -> Config. @@ -2014,6 +2014,37 @@ otp_6226_outdir(Config) when is_list(Config) -> ok. +%% Test that all default values can be used as values in the .app file +app_file_defaults(Config) -> + PrivDir = ?config(priv_dir,Config), + Name = app1, + NameStr = atom_to_list(Name), + Vsn = "1.0", + AppSpec = app_spec(Name,#{vsn=>"1.0"}), + ok = file:write_file(filename:join(PrivDir,NameStr ++ ".app"), + io_lib:format("~p.~n",[AppSpec])), + {ok,_} = systools_make:read_application(NameStr,Vsn,[PrivDir],[]), + ok. + +app_spec(Name,New) -> + {application,Name,app_spec(New)}. + +app_spec(New) -> + Default = #{description => "", + id => "", + vsn => "", + modules => [], + maxP => infinity, + maxT => infinity, + registered => [], + included_applications => [], + applications => [], + env => [], + mod => [], + start_phases => undefined, + runtime_dependencies => []}, + maps:to_list(maps:merge(Default,New)). + %%%%%% %%%%%% Utilities %%%%%% diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index 2d897e9903..9a54937f96 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"4.0"). --define(stdlibvsn,"2.5"). +-define(kernelvsn,"5.0"). +-define(stdlibvsn,"3.0"). diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 69d5a47f83..7ab6f22424 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -96,7 +96,7 @@ APP_TARGET= $(EBIN)/$(APP_FILE) APPUP_SRC= $(APPUP_FILE).src APPUP_TARGET= $(EBIN)/$(APPUP_FILE) -INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl +INTERNAL_HRL_FILES = ssh_auth.hrl ssh_connect.hrl ssh_transport.hrl ssh.hrl ssh_userauth.hrl ssh_xfer.hrl ssh_dbg.hrl # ---------------------------------------------------- # FLAGS diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index dd414894d4..7451c9e6d0 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -928,6 +928,7 @@ handle_event(internal, Msg=#ssh_msg_channel_request{}, StateName, D) - handle_connection_msg(Msg, StateName, D); handle_event(internal, Msg=#ssh_msg_channel_success{}, StateName, D) -> + update_inet_buffers(D#data.socket), handle_connection_msg(Msg, StateName, D); handle_event(internal, Msg=#ssh_msg_channel_failure{}, StateName, D) -> @@ -1007,6 +1008,7 @@ handle_event(cast, {reply_request,success,ChannelId}, {connected,_}, D) -> case ssh_channel:cache_lookup(cache(D), ChannelId) of #channel{remote_id = RemoteId} -> Msg = ssh_connection:channel_success_msg(RemoteId), + update_inet_buffers(D#data.socket), {keep_state, send_msg(Msg,D)}; undefined -> @@ -1194,12 +1196,12 @@ handle_event(info, {Proto, Sock, NewData}, StateName, D0 = #data{socket = Sock, ssh_message:decode(set_kex_overload_prefix(DecryptedBytes,D)) of Msg = #ssh_msg_kexinit{} -> - {keep_state, D, [{next_event, internal, {Msg,DecryptedBytes}}, - {next_event, internal, prepare_next_packet} + {keep_state, D, [{next_event, internal, prepare_next_packet}, + {next_event, internal, {Msg,DecryptedBytes}} ]}; Msg -> - {keep_state, D, [{next_event, internal, Msg}, - {next_event, internal, prepare_next_packet} + {keep_state, D, [{next_event, internal, prepare_next_packet}, + {next_event, internal, Msg} ]} catch _C:_E -> @@ -1738,6 +1740,11 @@ send_replies(Repls, State) -> Repls). get_repl({connection_reply,Msg}, {CallRepls,S}) -> + if is_record(Msg, ssh_msg_channel_success) -> + update_inet_buffers(S#data.socket); + true -> + ok + end, {CallRepls, send_msg(Msg,S)}; get_repl({channel_data,undefined,_Data}, Acc) -> Acc; @@ -1926,3 +1933,13 @@ handshake(Pid, Ref, Timeout) -> {error, timeout} end. +update_inet_buffers(Socket) -> + {ok, BufSzs0} = inet:getopts(Socket, [sndbuf,recbuf]), + MinVal = 655360, + case + [{Tag,MinVal} || {Tag,Val} <- BufSzs0, + Val < MinVal] + of + [] -> ok; + NewOpts -> inet:setopts(Socket, NewOpts) + end. diff --git a/lib/ssh/src/ssh_dbg.erl b/lib/ssh/src/ssh_dbg.erl index ce5596e0f9..dff2bae9f2 100644 --- a/lib/ssh/src/ssh_dbg.erl +++ b/lib/ssh/src/ssh_dbg.erl @@ -28,6 +28,9 @@ stop/0 ]). +-export([shrink_bin/1, + wr_record/3]). + -include("ssh.hrl"). -include("ssh_transport.hrl"). -include("ssh_connect.hrl"). diff --git a/lib/ssh/src/ssh_dbg.hrl b/lib/ssh/src/ssh_dbg.hrl new file mode 100644 index 0000000000..e94664737b --- /dev/null +++ b/lib/ssh/src/ssh_dbg.hrl @@ -0,0 +1,27 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% + +-ifndef(SSH_DBG_HRL). +-define(SSH_DBG_HRL, 1). + +-define(formatrec(RecName,R), + ssh_dbg:wr_record(R, record_info(fields,RecName), [])). + +-endif. % SSH_DBG_HRL defined diff --git a/lib/ssh/test/ssh_connection_SUITE.erl b/lib/ssh/test/ssh_connection_SUITE.erl index bcf3b01824..e898d55b6f 100644 --- a/lib/ssh/test/ssh_connection_SUITE.erl +++ b/lib/ssh/test/ssh_connection_SUITE.erl @@ -381,13 +381,13 @@ do_interrupted_send(Config, SendSize, EchoSize) -> {password, "morot"}, {subsystems, [{"echo_n",EchoSS_spec}]}]), - ct:log("connect", []), + ct:log("~p:~p connect", [?MODULE,?LINE]), ConnectionRef = ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true}, {user, "foo"}, {password, "morot"}, {user_interaction, false}, {user_dir, UserDir}]), - ct:log("connected", []), + ct:log("~p:~p connected", [?MODULE,?LINE]), %% build big binary Data = << <<X:32>> || X <- lists:seq(1,SendSize div 4)>>, @@ -399,9 +399,9 @@ do_interrupted_send(Config, SendSize, EchoSize) -> Parent = self(), ResultPid = spawn( fun() -> - ct:log("open channel",[]), + ct:log("~p:~p open channel",[?MODULE,?LINE]), {ok, ChannelId} = ssh_connection:session_channel(ConnectionRef, infinity), - ct:log("start subsystem", []), + ct:log("~p:~p start subsystem", [?MODULE,?LINE]), case ssh_connection:subsystem(ConnectionRef, ChannelId, "echo_n", infinity) of success -> Parent ! {self(), channelId, ChannelId}, @@ -410,47 +410,69 @@ do_interrupted_send(Config, SendSize, EchoSize) -> try collect_data(ConnectionRef, ChannelId) of ExpectedData -> + ct:log("~p:~p got expected data",[?MODULE,?LINE]), ok; - _ -> - {fail,"unexpected result"} + Other -> + ct:log("~p:~p unexpect: ~p", [?MODULE,?LINE,Other]), + {fail,"unexpected result in listener"} catch Class:Exception -> - {fail, io_lib:format("Exception ~p:~p",[Class,Exception])} + {fail, io_lib:format("Listener exception ~p:~p",[Class,Exception])} end, - Parent ! {self(), Result}; + Parent ! {self(), result, Result}; Other -> Parent ! {self(), channelId, error, Other} end end), receive + {ResultPid, channelId, error, Other} -> + ct:log("~p:~p channelId error ~p", [?MODULE,?LINE,Other]), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid), + {fail, "ssh_connection:subsystem"}; + {ResultPid, channelId, ChannelId} -> - %% pre-adjust receive window so the other end doesn't block - ct:log("adjust window", []), - ssh_connection:adjust_window(ConnectionRef, ChannelId, size(ExpectedData) + 1), - - ct:log("going to send ~p bytes", [size(Data)]), - case ssh_connection:send(ConnectionRef, ChannelId, Data, 30000) of - {error, closed} -> - ct:log("{error,closed} - That's what we expect :)", []), - ok; - Msg -> - ct:log("Got ~p - that's bad, very bad indeed",[Msg]), - ct:fail({expected,{error,closed}, got, Msg}) - end, - ct:log("going to check the result (if it is available)", []), + ct:log("~p:~p ~p going to send ~p bytes", [?MODULE,?LINE,self(),size(Data)]), + SenderPid = spawn(fun() -> + Parent ! {self(), ssh_connection:send(ConnectionRef, ChannelId, Data, 30000)} + end), receive - {ResultPid, Result} -> - ct:log("Got result: ~p", [Result]), + {ResultPid, result, {fail, Fail}} -> + ct:log("~p:~p Listener failed: ~p", [?MODULE,?LINE,Fail]), + {fail, Fail}; + + {ResultPid, result, Result} -> + ct:log("~p:~p Got result: ~p", [?MODULE,?LINE,Result]), ssh:close(ConnectionRef), ssh:stop_daemon(Pid), - Result - end; + ct:log("~p:~p Check sender", [?MODULE,?LINE]), + receive + {SenderPid, {error, closed}} -> + ct:log("~p:~p {error,closed} - That's what we expect :)",[?MODULE,?LINE]), + ok; + Msg -> + ct:log("~p:~p Not expected send result: ~p",[?MODULE,?LINE,Msg]), + {fail, "Not expected msg"} + end; + + {SenderPid, {error, closed}} -> + ct:log("~p:~p {error,closed} - That's what we expect, but client channel handler has not reported yet",[?MODULE,?LINE]), + receive + {ResultPid, result, Result} -> + ct:log("~p:~p Now got the result: ~p", [?MODULE,?LINE,Result]), + ssh:close(ConnectionRef), + ssh:stop_daemon(Pid), + ok; + Msg -> + ct:log("~p:~p Got an unexpected msg ~p",[?MODULE,?LINE,Msg]), + {fail, "Un-expected msg"} + end; - {ResultPid, channelId, error, Other} -> - ssh:close(ConnectionRef), - ssh:stop_daemon(Pid), - {fail, io_lib:format("ssh_connection:subsystem: ~p",[Other])} + Msg -> + ct:log("~p:~p Got unexpected ~p",[?MODULE,?LINE,Msg]), + {fail, "Unexpected msg"} + end end. %%-------------------------------------------------------------------- @@ -910,34 +932,35 @@ big_cat_rx(ConnectionRef, ChannelId, Acc) -> end. collect_data(ConnectionRef, ChannelId) -> - ct:log("Listener ~p running! ConnectionRef=~p, ChannelId=~p",[self(),ConnectionRef,ChannelId]), + ct:log("~p:~p Listener ~p running! ConnectionRef=~p, ChannelId=~p",[?MODULE,?LINE,self(),ConnectionRef,ChannelId]), collect_data(ConnectionRef, ChannelId, [], 0). collect_data(ConnectionRef, ChannelId, Acc, Sum) -> TO = 5000, receive {ssh_cm, ConnectionRef, {data, ChannelId, 0, Data}} when is_binary(Data) -> - ct:log("collect_data: received ~p bytes. total ~p bytes",[size(Data),Sum+size(Data)]), + ct:log("~p:~p collect_data: received ~p bytes. total ~p bytes",[?MODULE,?LINE,size(Data),Sum+size(Data)]), + ssh_connection:adjust_window(ConnectionRef, ChannelId, size(Data)), collect_data(ConnectionRef, ChannelId, [Data | Acc], Sum+size(Data)); {ssh_cm, ConnectionRef, {eof, ChannelId}} -> try iolist_to_binary(lists:reverse(Acc)) of Bin -> - ct:log("collect_data: received eof.~nGot in total ~p bytes",[size(Bin)]), + ct:log("~p:~p collect_data: received eof.~nGot in total ~p bytes",[?MODULE,?LINE,size(Bin)]), Bin catch C:E -> - ct:log("collect_data: received eof.~nAcc is strange...~nException=~p:~p~nAcc=~p", - [C,E,Acc]), + ct:log("~p:~p collect_data: received eof.~nAcc is strange...~nException=~p:~p~nAcc=~p", + [?MODULE,?LINE,C,E,Acc]), {error,{C,E}} end; Msg -> - ct:log("collect_data: ***** unexpected message *****~n~p",[Msg]), + ct:log("~p:~p collect_data: ***** unexpected message *****~n~p",[?MODULE,?LINE,Msg]), collect_data(ConnectionRef, ChannelId, Acc, Sum) after TO -> - ct:log("collect_data: ----- Nothing received for ~p seconds -----~n",[]), + ct:log("~p:~p collect_data: ----- Nothing received for ~p seconds -----~n",[?MODULE,?LINE,TO]), collect_data(ConnectionRef, ChannelId, Acc, Sum) end. diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 2c7fe7898f..86c3d5de26 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -404,8 +404,6 @@ erlang_server_openssh_client_renegotiate(Config) -> {Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir}, {public_key_alg, PubKeyAlg}, {failfun, fun ssh_test_lib:failfun/2}]), - -%% catch ssh_dbg:messages(fun(String,_D) -> ct:log(String) end), ct:sleep(500), RenegLimitK = 3, @@ -431,13 +429,24 @@ erlang_server_openssh_client_renegotiate(Config) -> catch _:_ -> false end; + + ({exit_status,E}) when E=/=0 -> + ct:log("exit_status ~p",[E]), + throw({skip,"exit status"}); + (_) -> false end, - - ssh_test_lib:rcv_expected(Expect, OpenSsh, ?TIMEOUT), - %% Unfortunatly we can't check that there has been a renegotiation, just trust OpenSSH. - ssh:stop_daemon(Pid). + + try + ssh_test_lib:rcv_expected(Expect, OpenSsh, ?TIMEOUT) + of + _ -> + %% Unfortunatly we can't check that there has been a renegotiation, just trust OpenSSH. + ssh:stop_daemon(Pid) + catch + throw:{skip,R} -> {skip,R} + end. %%-------------------------------------------------------------------- erlang_client_openssh_server_renegotiate(_Config) -> @@ -447,7 +456,6 @@ erlang_client_openssh_server_renegotiate(_Config) -> Ref = make_ref(), Parent = self(), - catch ssh_dbg:messages(fun(X,_) -> ct:log(X) end), Shell = spawn_link( fun() -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 68f2f97b6e..edc7e0d8b2 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -170,6 +170,14 @@ <tag><c>SNIfun::fun()</c></tag> <item><p><c>= fun(ServerName :: string()) -> [ssl_option()]</c></p></item> + <tag><c>named_curve() =</c></tag> + <item><p><c>sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 + | sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 + | sect283k1 | sect283r1 | brainpoolP256r1 | secp256k1 | secp256r1 + | sect239k1 | sect233k1 | sect233r1 | secp224k1 | secp224r1 + | sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1 + | sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2</c></p></item> + </taglist> </section> @@ -217,6 +225,11 @@ Anonymous cipher suites are supported for testing purposes only and are not be used when security matters.</p></item> + <tag><c>{eccs, [named_curve()]}</c></tag> + <item><p> Allows to specify the order of preference for named curves + and to restrict their usage when using a cipher suite supporting them. + </p></item> + <tag><c>{secure_renegotiate, boolean()}</c></tag> <item><p>Specifies if to reject renegotiation attempt that does not live up to @@ -751,6 +764,11 @@ fun(srp, Username :: string(), UserState :: term()) -> (the default), use the client's preference. </item> + <tag><c>{honor_ecc_order, boolean()}</c></tag> + <item>If true, use the server's preference for ECC curve selection. If false + (the default), use the client's preference. + </item> + <tag><c>{signature_algs, [{hash(), ecdsa | rsa | dsa}]}</c></tag> <item><p> The algorithms specified by this option will be the ones accepted by the server in a signature algorithm @@ -804,6 +822,17 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> + <name>eccs() -></name> + <name>eccs(protocol()) -> [named_curve()]</name> + <fsummary>Returns a list of supported ECCs.</fsummary> + + <desc><p>Returns a list of supported ECCs. <c>eccs()</c> + is equivalent to calling <c>eccs(Protocol)</c> with all + supported protocols and then deduplicating the output.</p> + </desc> + </func> + + <func> <name>clear_pem_cache() -> ok </name> <fsummary> Clears the pem cache</fsummary> @@ -898,7 +927,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Returns all the connection information. </fsummary> <type> - <v>Item = protocol | cipher_suite | sni_hostname | atom()</v> + <v>Item = protocol | cipher_suite | sni_hostname | ecc | atom()</v> <d>Meaningful atoms, not specified above, are the ssl option names.</d> <v>Result = [{Item::atom(), Value::term()}]</v> <v>Reason = term()</v> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 27b753af2e..aa62ab8865 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -38,7 +38,7 @@ getopts/2, setopts/2, getstat/1, getstat/2 ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, +-export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1, connection_info/1, versions/0, session_info/1, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, negotiated_next_protocol/1, connection_information/1, connection_information/2]). @@ -420,6 +420,33 @@ cipher_suites(all) -> [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)]. %%-------------------------------------------------------------------- +-spec eccs() -> tls_v1:curves(). +%% Description: returns all supported curves across all versions +%%-------------------------------------------------------------------- +eccs() -> + Curves = tls_v1:ecc_curves(all), % only tls_v1 has named curves right now + eccs_filter_supported(Curves). + +%%-------------------------------------------------------------------- +-spec eccs(tls_record:tls_version() | tls_record:tls_atom_version()) -> + tls_v1:curves(). +%% Description: returns the curves supported for a given version of +%% ssl/tls. +%%-------------------------------------------------------------------- +eccs({3,0}) -> + []; +eccs({3,_}) -> + Curves = tls_v1:ecc_curves(all), + eccs_filter_supported(Curves); +eccs(AtomVersion) when is_atom(AtomVersion) -> + eccs(tls_record:protocol_version(AtomVersion)). + +eccs_filter_supported(Curves) -> + CryptoCurves = crypto:ec_curves(), + lists:filter(fun(Curve) -> proplists:get_bool(Curve, CryptoCurves) end, + Curves). + +%%-------------------------------------------------------------------- -spec getopts(#sslsocket{}, [gen_tcp:option_name()]) -> {ok, [gen_tcp:option()]} | {error, reason()}. %% @@ -647,6 +674,8 @@ do_connect(Address, Port, end. %% Handle extra ssl options given to ssl_accept +-spec handle_options([any()], #ssl_options{}) -> #ssl_options{} + ; ([any()], client | server) -> {ok, #config{}}. handle_options(Opts0, #ssl_options{protocol = Protocol, cacerts = CaCerts0, cacertfile = CaCertFile0} = InheritedSslOpts) -> RecordCB = record_cb(Protocol), @@ -725,6 +754,8 @@ handle_options(Opts0, Role) -> srp_identity = handle_option(srp_identity, Opts, undefined), ciphers = handle_cipher_option(proplists:get_value(ciphers, Opts, []), RecordCb:highest_protocol_version(Versions)), + eccs = handle_eccs_option(proplists:get_value(eccs, Opts, eccs()), + RecordCb:highest_protocol_version(Versions)), signature_algs = handle_hashsigns_option(proplists:get_value(signature_algs, Opts, default_option_role(server, tls_v1:default_signature_algs(Versions), Role)), @@ -755,6 +786,9 @@ handle_options(Opts0, Role) -> honor_cipher_order = handle_option(honor_cipher_order, Opts, default_option_role(server, false, Role), server, Role), + honor_ecc_order = handle_option(honor_ecc_order, Opts, + default_option_role(server, false, Role), + server, Role), protocol = proplists:get_value(protocol, Opts, tls), padding_check = proplists:get_value(padding_check, Opts, true), beast_mitigation = handle_option(beast_mitigation, Opts, one_n_minus_one), @@ -780,7 +814,7 @@ handle_options(Opts0, Role) -> alpn_preferred_protocols, next_protocols_advertised, client_preferred_next_protocols, log_alert, server_name_indication, honor_cipher_order, padding_check, crl_check, crl_cache, - fallback, signature_algs, beast_mitigation, v2_hello_compatible], + fallback, signature_algs, eccs, honor_ecc_order, beast_mitigation, v2_hello_compatible], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -1010,6 +1044,8 @@ validate_option(sni_fun, Fun) when is_function(Fun) -> Fun; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; +validate_option(honor_ecc_order, Value) when is_boolean(Value) -> + Value; validate_option(padding_check, Value) when is_boolean(Value) -> Value; validate_option(fallback, Value) when is_boolean(Value) -> @@ -1164,6 +1200,14 @@ binary_cipher_suites(Version, Ciphers0) -> Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")], binary_cipher_suites(Version, Ciphers). +handle_eccs_option(Value, {_Major, Minor}) when is_list(Value) -> + try tls_v1:ecc_curves(Minor, Value) of + Curves -> #elliptic_curves{elliptic_curve_list = Curves} + catch + exit:_ -> throw({error, {options, {eccs, Value}}}); + error:_ -> throw({error, {options, {eccs, Value}}}) + end. + unexpected_format(Error) -> lists:flatten(io_lib:format("Unexpected error: ~p", [Error])). @@ -1334,6 +1378,14 @@ new_ssl_options([{server_name_indication, Value} | Rest], #ssl_options{} = Opts, new_ssl_options(Rest, Opts#ssl_options{server_name_indication = validate_option(server_name_indication, Value)}, RecordCB); new_ssl_options([{honor_cipher_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{honor_cipher_order = validate_option(honor_cipher_order, Value)}, RecordCB); +new_ssl_options([{honor_ecc_order, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, Opts#ssl_options{honor_ecc_order = validate_option(honor_ecc_order, Value)}, RecordCB); +new_ssl_options([{eccs, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> + new_ssl_options(Rest, + Opts#ssl_options{eccs = + handle_eccs_option(Value, RecordCB:highest_protocol_version()) + }, + RecordCB); new_ssl_options([{signature_algs, Value} | Rest], #ssl_options{} = Opts, RecordCB) -> new_ssl_options(Rest, Opts#ssl_options{signature_algs = diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 08fca76123..b6e4d5b433 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1172,14 +1172,23 @@ handle_alert(#alert{level = ?WARNING} = Alert, StateName, %%% Internal functions %%-------------------------------------------------------------------- connection_info(#state{sni_hostname = SNIHostname, - session = #session{cipher_suite = CipherSuite}, + session = #session{cipher_suite = CipherSuite, ecc = ECCCurve}, protocol_cb = Connection, negotiated_version = {_,_} = Version, ssl_options = Opts}) -> RecordCB = record_cb(Connection), + CipherSuiteDef = ssl_cipher:erl_suite_definition(CipherSuite), + IsNamedCurveSuite = lists:member(element(1,CipherSuiteDef), + [ecdh_ecdsa, ecdhe_ecdsa, ecdh_anon]), + CurveInfo = case ECCCurve of + {namedCurve, Curve} when IsNamedCurveSuite -> + [{ecc, {named_curve, pubkey_cert_records:namedCurves(Curve)}}]; + _ -> + [] + end, [{protocol, RecordCB:protocol_version(Version)}, - {cipher_suite, ssl_cipher:erl_suite_definition(CipherSuite)}, - {sni_hostname, SNIHostname}] ++ ssl_options_list(Opts). + {cipher_suite, CipherSuiteDef}, + {sni_hostname, SNIHostname} | CurveInfo] ++ ssl_options_list(Opts). do_server_hello(Type, #hello_extensions{next_protocol_negotiation = NextProtocols} = ServerHelloExt, @@ -1741,12 +1750,13 @@ calculate_secret(#server_dh_params{dh_p = Prime, dh_g = Base, Connection, certify, certify); calculate_secret(#server_ecdh_params{curve = ECCurve, public = ECServerPubKey}, - State, Connection) -> + State=#state{session=Session}, Connection) -> ECDHKeys = public_key:generate_key(ECCurve), PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ECServerPubKey}, ECDHKeys), calculate_master_secret(PremasterSecret, - State#state{diffie_hellman_keys = ECDHKeys}, + State#state{diffie_hellman_keys = ECDHKeys, + session = Session#session{ecc = ECCurve}}, Connection, certify, certify); calculate_secret(#server_psk_params{ diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl index 5b51ac0916..4acc745c5f 100644 --- a/lib/ssl/src/ssl_handshake.erl +++ b/lib/ssl/src/ssl_handshake.erl @@ -70,7 +70,7 @@ %% Extensions handling -export([client_hello_extensions/6, handle_client_hello_extensions/9, %% Returns server hello extensions - handle_server_hello_extensions/9, select_curve/2 + handle_server_hello_extensions/9, select_curve/2, select_curve/3 ]). %% MISC @@ -120,11 +120,13 @@ server_hello_done() -> #server_hello_done{}. client_hello_extensions(Host, Version, CipherSuites, - #ssl_options{signature_algs = SupportedHashSigns, versions = AllVersions} = SslOpts, ConnectionStates, Renegotiation) -> + #ssl_options{signature_algs = SupportedHashSigns, + eccs = SupportedECCs, + versions = AllVersions} = SslOpts, ConnectionStates, Renegotiation) -> {EcPointFormats, EllipticCurves} = case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of true -> - client_ecc_extensions(tls_v1, Version); + client_ecc_extensions(SupportedECCs); false -> {undefined, undefined} end, @@ -1169,8 +1171,9 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, {resumed, Resumed} end. -supported_ecc({Major, Minor} = Version) when ((Major == 3) and (Minor >= 1)) orelse (Major > 3) -> - Curves = tls_v1:ecc_curves(Version), +%% Deprecated? +supported_ecc({Major, Minor}) when ((Major == 3) and (Minor >= 1)) orelse (Major > 3) -> + Curves = tls_v1:ecc_curves(Minor), #elliptic_curves{elliptic_curve_list = Curves}; supported_ecc(_) -> #elliptic_curves{elliptic_curve_list = []}. @@ -1454,12 +1457,12 @@ srp_user(#ssl_options{srp_identity = {UserName, _}}) -> srp_user(_) -> undefined. -client_ecc_extensions(Module, Version) -> +client_ecc_extensions(SupportedECCs) -> CryptoSupport = proplists:get_value(public_keys, crypto:supports()), case proplists:get_bool(ecdh, CryptoSupport) of true -> EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}, - EllipticCurves = #elliptic_curves{elliptic_curve_list = Module:ecc_curves(Version)}, + EllipticCurves = SupportedECCs, {EcPointFormats, EllipticCurves}; _ -> {undefined, undefined} @@ -1493,22 +1496,34 @@ advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) -> true; advertises_ec_ciphers([_| Rest]) -> advertises_ec_ciphers(Rest). -select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, - #elliptic_curves{elliptic_curve_list = ServerCurves}) -> - select_curve(ClientCurves, ServerCurves); -select_curve(undefined, _) -> + +select_curve(Client, Server) -> + select_curve(Client, Server, false). + +select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves}, + #elliptic_curves{elliptic_curve_list = ServerCurves}, + ServerOrder) -> + case ServerOrder of + false -> + select_shared_curve(ClientCurves, ServerCurves); + true -> + select_shared_curve(ServerCurves, ClientCurves) + end; +select_curve(undefined, _, _) -> %% Client did not send ECC extension use default curve if %% ECC cipher is negotiated - {namedCurve, ?secp256r1}; -select_curve(_, []) -> + {namedCurve, ?secp256r1}. + +select_shared_curve([], _) -> no_curve; -select_curve(Curves, [Curve| Rest]) -> +select_shared_curve([Curve | Rest], Curves) -> case lists:member(Curve, Curves) of true -> {namedCurve, Curve}; false -> - select_curve(Curves, Rest) + select_shared_curve(Rest, Curves) end. + %% RFC 6066, Section 3: Currently, the only server names supported are %% DNS hostnames sni(_, disable) -> diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index c19c1787ff..487d1fa096 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -140,6 +140,8 @@ crl_check :: boolean() | peer | best_effort, crl_cache, signature_algs, + eccs, + honor_ecc_order :: boolean(), v2_hello_compatible :: boolean() }). diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl index a2486bf752..2bd103c18a 100644 --- a/lib/ssl/src/tls_handshake.erl +++ b/lib/ssl/src/tls_handshake.erl @@ -160,13 +160,15 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId, extensions = #hello_extensions{elliptic_curves = Curves, signature_algs = ClientHashSigns} = HelloExt}, #ssl_options{versions = Versions, - signature_algs = SupportedHashSigns} = SslOpts, + signature_algs = SupportedHashSigns, + eccs = SupportedECCs, + honor_ecc_order = ECCOrder} = SslOpts, {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) -> case tls_record:is_acceptable_version(Version, Versions) of true -> AvailableHashSigns = ssl_handshake:available_signature_algs( ClientHashSigns, SupportedHashSigns, Cert, Version), - ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(Version)), + ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder), {Type, #session{cipher_suite = CipherSuite} = Session1} = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions, Port, Session0#session{ecc = ECCCurve}, Version, diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index 711db77708..7f24ce5192 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -31,9 +31,18 @@ -export([master_secret/4, finished/5, certificate_verify/3, mac_hash/7, setup_keys/8, suites/1, prf/5, - ecc_curves/1, oid_to_enum/1, enum_to_oid/1, + ecc_curves/1, ecc_curves/2, oid_to_enum/1, enum_to_oid/1, default_signature_algs/1, signature_algs/2]). +-type named_curve() :: sect571r1 | sect571k1 | secp521r1 | brainpoolP512r1 | + sect409k1 | sect409r1 | brainpoolP384r1 | secp384r1 | + sect283k1 | sect283r1 | brainpoolP256r1 | secp256k1 | secp256r1 | + sect239k1 | sect233k1 | sect233r1 | secp224k1 | secp224r1 | + sect193r1 | sect193r2 | secp192k1 | secp192r1 | sect163k1 | + sect163r1 | sect163r2 | secp160k1 | secp160r1 | secp160r2. +-type curves() :: [named_curve()]. +-export_type([curves/0, named_curve/0]). + %%==================================================================== %% Internal application API %%==================================================================== @@ -399,13 +408,20 @@ is_pair(Hash, rsa, Hashs) -> lists:member(Hash, AtLeastMd5). %% list ECC curves in prefered order -ecc_curves(_Minor) -> - TLSCurves = [sect571r1,sect571k1,secp521r1,brainpoolP512r1, - sect409k1,sect409r1,brainpoolP384r1,secp384r1, - sect283k1,sect283r1,brainpoolP256r1,secp256k1,secp256r1, - sect239k1,sect233k1,sect233r1,secp224k1,secp224r1, - sect193r1,sect193r2,secp192k1,secp192r1,sect163k1, - sect163r1,sect163r2,secp160k1,secp160r1,secp160r2], +-spec ecc_curves(1..3 | all) -> [named_curve()]. +ecc_curves(all) -> + [sect571r1,sect571k1,secp521r1,brainpoolP512r1, + sect409k1,sect409r1,brainpoolP384r1,secp384r1, + sect283k1,sect283r1,brainpoolP256r1,secp256k1,secp256r1, + sect239k1,sect233k1,sect233r1,secp224k1,secp224r1, + sect193r1,sect193r2,secp192k1,secp192r1,sect163k1, + sect163r1,sect163r2,secp160k1,secp160r1,secp160r2]; +ecc_curves(Minor) -> + TLSCurves = ecc_curves(all), + ecc_curves(Minor, TLSCurves). + +-spec ecc_curves(1..3, [named_curve()]) -> [named_curve()]. +ecc_curves(_Minor, TLSCurves) -> CryptoCurves = crypto:ec_curves(), lists:foldr(fun(Curve, Curves) -> case proplists:get_bool(Curve, CryptoCurves) of @@ -414,6 +430,7 @@ ecc_curves(_Minor) -> end end, [], TLSCurves). + %% ECC curves from draft-ietf-tls-ecc-12.txt (Oct. 17, 2005) oid_to_enum(?sect163k1) -> 1; oid_to_enum(?sect163r1) -> 2; diff --git a/lib/ssl/test/ssl_ECC_SUITE.erl b/lib/ssl/test/ssl_ECC_SUITE.erl index 258922d128..76999185b6 100644 --- a/lib/ssl/test/ssl_ECC_SUITE.erl +++ b/lib/ssl/test/ssl_ECC_SUITE.erl @@ -46,7 +46,7 @@ groups() -> {'tlsv1', [], all_versions_groups()}, {'erlang_server', [], key_cert_combinations()}, {'erlang_client', [], key_cert_combinations()}, - {'erlang', [], key_cert_combinations() ++ misc()} + {'erlang', [], key_cert_combinations() ++ misc() ++ ecc_negotiation()} ]. all_versions_groups ()-> @@ -68,6 +68,23 @@ key_cert_combinations() -> misc()-> [client_ecdsa_server_ecdsa_with_raw_key]. +ecc_negotiation() -> + [ecc_default_order, + ecc_default_order_custom_curves, + ecc_client_order, + ecc_client_order_custom_curves, + ecc_unknown_curve, + client_ecdh_server_ecdh_ecc_server_custom, + client_rsa_server_ecdh_ecc_server_custom, + client_ecdh_server_rsa_ecc_server_custom, + client_rsa_server_rsa_ecc_server_custom, + client_ecdsa_server_ecdsa_ecc_server_custom, + client_ecdsa_server_rsa_ecc_server_custom, + client_rsa_server_ecdsa_ecc_server_custom, + client_ecdsa_server_ecdsa_ecc_client_custom, + client_rsa_server_ecdsa_ecc_client_custom + ]. + %%-------------------------------------------------------------------- init_per_suite(Config0) -> end_per_suite(Config0), @@ -218,6 +235,132 @@ client_ecdsa_server_ecdsa_with_raw_key(Config) when is_list(Config) -> check_result(Server, SType, Client, CType), close(Server, Client). +ecc_default_order(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [], + case supported_eccs([{eccs, [sect571r1]}]) of + true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +ecc_default_order_custom_curves(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +ecc_client_order(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{honor_ecc_order, false}], + case supported_eccs([{eccs, [sect571r1]}]) of + true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +ecc_client_order_custom_curves(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{honor_ecc_order, false}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(sect571r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +ecc_unknown_curve(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{eccs, ['123_fake_curve']}], + ecc_test_error(COpts, SOpts, [], ECCOpts, Config). + +%% We can only expect to see a named curve on a conn with +%% a server supporting ecdsa. Otherwise the curve is selected +%% but not used and communicated to the client? +client_ecdh_server_ecdh_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_ecdh_rsa_opts, Config), + SOpts = proplists:get_value(server_ecdh_rsa_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_ecdh_server_rsa_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_ecdh_rsa_opts, Config), + SOpts = proplists:get_value(server_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_rsa_server_ecdh_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_opts, Config), + SOpts = proplists:get_value(server_ecdh_rsa_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_rsa_server_rsa_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_opts, Config), + SOpts = proplists:get_value(server_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_ecdsa_server_ecdsa_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_ecdsa_server_rsa_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(undefined, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_rsa_server_ecdsa_ecc_server_custom(Config) -> + COpts = proplists:get_value(client_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{honor_ecc_order, true}, {eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(secp256r1, COpts, SOpts, [], ECCOpts, Config); + false -> {skip, "unsupported named curves"} + end. + +client_ecdsa_server_ecdsa_ecc_client_custom(Config) -> + COpts = proplists:get_value(client_ecdsa_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); + false -> {skip, "unsupported named curves"} + end. + +client_rsa_server_ecdsa_ecc_client_custom(Config) -> + COpts = proplists:get_value(client_opts, Config), + SOpts = proplists:get_value(server_ecdsa_opts, Config), + ECCOpts = [{eccs, [secp256r1, sect571r1]}], + case supported_eccs(ECCOpts) of + true -> ecc_test(secp256r1, COpts, SOpts, ECCOpts, [], Config); + false -> {skip, "unsupported named curves"} + end. + %%-------------------------------------------------------------------- %% Internal functions ------------------------------------------------ %%-------------------------------------------------------------------- @@ -244,6 +387,30 @@ basic_test(ClientCert, ClientKey, ClientCA, ServerCert, ServerKey, ServerCA, Con check_result(Server, SType, Client, CType), close(Server, Client). +ecc_test(Expect, COpts, SOpts, CECCOpts, SECCOpts, Config) -> + CCA = proplists:get_value(cacertfile, COpts), + CCert = proplists:get_value(certfile, COpts), + CKey = proplists:get_value(keyfile, COpts), + SCA = proplists:get_value(cacertfile, SOpts), + SCert = proplists:get_value(certfile, SOpts), + SKey = proplists:get_value(keyfile, SOpts), + {Server, Port} = start_server_ecc(erlang, CCA, SCA, SCert, SKey, Expect, SECCOpts, Config), + Client = start_client_ecc(erlang, Port, SCA, CCA, CCert, CKey, Expect, CECCOpts, Config), + ssl_test_lib:check_result(Server, ok, Client, ok), + close(Server, Client). + +ecc_test_error(COpts, SOpts, CECCOpts, SECCOpts, Config) -> + CCA = proplists:get_value(cacertfile, COpts), + CCert = proplists:get_value(certfile, COpts), + CKey = proplists:get_value(keyfile, COpts), + SCA = proplists:get_value(cacertfile, SOpts), + SCert = proplists:get_value(certfile, SOpts), + SKey = proplists:get_value(keyfile, SOpts), + {Server, Port} = start_server_ecc_error(erlang, CCA, SCA, SCert, SKey, SECCOpts, Config), + Client = start_client_ecc_error(erlang, Port, SCA, CCA, CCert, CKey, CECCOpts, Config), + Error = {error, {tls_alert, "insufficient security"}}, + ssl_test_lib:check_result(Server, Error, Client, Error). + start_client(openssl, Port, PeerCA, OwnCa, Cert, Key, _Config) -> CA = new_openssl_ca("openssl_client_ca", PeerCA, OwnCa), Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), @@ -267,6 +434,31 @@ start_client(erlang, Port, PeerCA, OwnCa, Cert, Key, Config) -> {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]). +start_client_ecc(erlang, Port, PeerCA, OwnCa, Cert, Key, Expect, ECCOpts, Config) -> + CA = new_ca("erlang_client_ca", PeerCA, OwnCa), + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, check_ecc, [client, Expect]}}, + {options, + ECCOpts ++ + [{verify, verify_peer}, + {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]). + +start_client_ecc_error(erlang, Port, PeerCA, OwnCa, Cert, Key, ECCOpts, Config) -> + CA = new_ca("erlang_client_ca", PeerCA, OwnCa), + {ClientNode, _, Hostname} = ssl_test_lib:run_where(Config), + ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {options, + ECCOpts ++ + [{verify, verify_peer}, + {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]). + start_server(openssl, PeerCA, OwnCa, Cert, Key, _Config) -> CA = new_openssl_ca("openssl_server_ca", PeerCA, OwnCa), Port = ssl_test_lib:inet_port(node()), @@ -290,6 +482,7 @@ start_server(erlang, PeerCA, OwnCa, Cert, Key, Config) -> [{verify, verify_peer}, {cacertfile, CA}, {certfile, Cert}, {keyfile, Key}]}]), {Server, ssl_test_lib:inet_port(Server)}. + start_server_with_raw_key(erlang, PeerCA, OwnCa, Cert, Key, Config) -> CA = new_ca("erlang_server_ca", PeerCA, OwnCa), {_, ServerNode, _} = ssl_test_lib:run_where(Config), @@ -303,6 +496,29 @@ start_server_with_raw_key(erlang, PeerCA, OwnCa, Cert, Key, Config) -> {certfile, Cert}, {key, Key}]}]), {Server, ssl_test_lib:inet_port(Server)}. +start_server_ecc(erlang, PeerCA, OwnCa, Cert, Key, Expect, ECCOpts, Config) -> + CA = new_ca("erlang_server_ca", PeerCA, OwnCa), + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, check_ecc, [server, Expect]}}, + {options, + ECCOpts ++ + [{verify, verify_peer}, {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]), + {Server, ssl_test_lib:inet_port(Server)}. + +start_server_ecc_error(erlang, PeerCA, OwnCa, Cert, Key, ECCOpts, Config) -> + CA = new_ca("erlang_server_ca", PeerCA, OwnCa), + {_, ServerNode, _} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0}, + {from, self()}, + {options, + ECCOpts ++ + [{verify, verify_peer}, {cacertfile, CA}, + {certfile, Cert}, {keyfile, Key}]}]), + {Server, ssl_test_lib:inet_port(Server)}. + check_result(Server, erlang, Client, erlang) -> ssl_test_lib:check_result(Server, ok, Client, ok); check_result(Server, erlang, _, _) -> @@ -350,15 +566,20 @@ new_openssl_ca(FileName, CA, OwnCa) -> E1 = public_key:pem_decode(P1), {ok, P2} = file:read_file(OwnCa), E2 = public_key:pem_decode(P2), - case os:cmd("openssl version") of - "OpenSSL 1.0.1p-freebsd" ++ _ -> - Pem = public_key:pem_encode(E1 ++E2), - file:write_file(FileName, Pem); - "LibreSSL" ++ _ -> - Pem = public_key:pem_encode(E1 ++E2), - file:write_file(FileName, Pem); - _ -> - Pem = public_key:pem_encode(E2 ++E1), - file:write_file(FileName, Pem) - end, + Pem = public_key:pem_encode(E2 ++E1), + file:write_file(FileName, Pem), FileName. + +supported_eccs(Opts) -> + ToCheck = proplists:get_value(eccs, Opts, []), + Supported = ssl:eccs(), + lists:all(fun(Curve) -> lists:member(Curve, Supported) end, ToCheck). + +check_ecc(SSL, Role, Expect) -> + {ok, Data} = ssl:connection_information(SSL), + case lists:keyfind(ecc, 1, Data) of + {ecc, {named_curve, Expect}} -> ok; + false when Expect =:= undefined -> ok; + Other -> {error, Role, Expect, Other} + end. + diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1be43c56c4..392da738ec 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -150,6 +150,7 @@ api_tests() -> peercert_with_client_cert, sockname, versions, + eccs, controlling_process, getstat, close_with_timeout, @@ -456,6 +457,15 @@ init_per_testcase(accept_pool, Config) -> init_per_testcase(controller_dies, Config) -> ct:timetrap({seconds, 10}), Config; +init_per_testcase(eccs, Config) -> + case ssl:eccs() of + [] -> + {skip, "named curves not supported"}; + [_|_] -> + ssl_test_lib:ct_log_supported_protocol_versions(Config), + ct:timetrap({seconds, 5}), + Config + end; init_per_testcase(_TestCase, Config) -> ssl_test_lib:ct_log_supported_protocol_versions(Config), ct:timetrap({seconds, 5}), @@ -1504,6 +1514,25 @@ versions(Config) when is_list(Config) -> [_|_] = Versions = ssl:versions(), ct:log("~p~n", [Versions]). + +%%-------------------------------------------------------------------- +eccs() -> + [{doc, "Test API functions eccs/0 and eccs/1"}]. + +eccs(Config) when is_list(Config) -> + [_|_] = All = ssl:eccs(), + [] = SSL3 = ssl:eccs({3,0}), + [_|_] = Tls = ssl:eccs({3,1}), + [_|_] = Tls1 = ssl:eccs({3,2}), + [_|_] = Tls2 = ssl:eccs({3,3}), + [] = SSL3 = ssl:eccs(sslv3), + [_|_] = Tls = ssl:eccs(tlsv1), + [_|_] = Tls1 = ssl:eccs('tlsv1.1'), + [_|_] = Tls2 = ssl:eccs('tlsv1.2'), + %% ordering is currently unverified by the test + true = lists:sort(All) =:= lists:usort(SSL3 ++ Tls ++ Tls1 ++ Tls2), + ok. + %%-------------------------------------------------------------------- send_recv() -> [{doc,""}]. @@ -2164,7 +2193,7 @@ ciphers_dsa_signed_certs() -> ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(), + Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, dsa). %%------------------------------------------------------------------- @@ -2305,7 +2334,7 @@ ciphers_ecdsa_signed_certs() -> ciphers_ecdsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdsa_suites(), + Ciphers = ssl_test_lib:ecdsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdsa). %%-------------------------------------------------------------------- @@ -2323,7 +2352,7 @@ ciphers_ecdh_rsa_signed_certs() -> ciphers_ecdh_rsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:ecdh_rsa_suites(), + Ciphers = ssl_test_lib:ecdh_rsa_suites(tls_record:protocol_version(Version)), ct:log("~p erlang cipher suites ~p~n", [Version, Ciphers]), run_suites(Ciphers, Version, Config, ecdh_rsa). %%-------------------------------------------------------------------- @@ -3634,9 +3663,10 @@ no_rizzo_rc4() -> [{doc,"Test that there is no 1/n-1-split for RC4 as it is not vunrable to Rizzo/Dungon attack"}]. no_rizzo_rc4(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(),Y == rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + Ciphers = [ssl_cipher:erl_suite_definition(Suite) || + Suite <- ssl_test_lib:rc4_suites(tls_record:protocol_version(Version))], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -3644,9 +3674,10 @@ rizzo_one_n_minus_one() -> [{doc,"Test that the 1/n-1-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. rizzo_one_n_minus_one(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_rizzo, []}). @@ -3654,9 +3685,10 @@ rizzo_zero_n() -> [{doc,"Test that the 0/n-split mitigation of Rizzo/Dungon attack can be explicitly selected"}]. rizzo_zero_n(Config) when is_list(Config) -> - Ciphers = [X || X ={_,Y,_} <- ssl:cipher_suites(), Y =/= rc4_128], Prop = proplists:get_value(tc_group_properties, Config), Version = proplists:get_value(name, Prop), + AllSuites = ssl_test_lib:available_suites(tls_record:protocol_version(Version)), + Ciphers = [X || X ={_,Y,_} <- AllSuites, Y =/= rc4_128], run_send_recv_rizzo(Ciphers, Config, Version, {?MODULE, send_recv_result_active_no_rizzo, []}). @@ -4407,7 +4439,7 @@ rizzo_test(Cipher, Config, Version, Mfa) -> {host, Hostname}, {from, self()}, {mfa, Mfa}, - {options, [{active, true} | ClientOpts]}]), + {options, [{active, true}, {ciphers, [Cipher]}| ClientOpts]}]), Result = ssl_test_lib:check_result(Server, ok, Client, ok), ssl_test_lib:close(Server), @@ -4698,3 +4730,4 @@ first_rsa_suite([_ | Rest]) -> wait_for_send(Socket) -> %% Make sure TLS process processed send message event _ = ssl:connection_information(Socket). + diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 4c6f1d7c01..5265c87e29 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -1097,7 +1097,8 @@ client_with_cert_cipher_suites_handshake(Config) when is_list(Config) -> {mfa, {ssl_test_lib, send_recv_result_active, []}}, {options, [{active, true}, - {ciphers, ssl_test_lib:rsa_non_signed_suites()} + {ciphers, + ssl_test_lib:rsa_non_signed_suites(tls_record:highest_protocol_version([]))} | ServerOpts]}]), Port = ssl_test_lib:inet_port(Server), Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, diff --git a/lib/ssl/test/ssl_packet_SUITE.erl b/lib/ssl/test/ssl_packet_SUITE.erl index 942e68967a..3446a566c4 100644 --- a/lib/ssl/test/ssl_packet_SUITE.erl +++ b/lib/ssl/test/ssl_packet_SUITE.erl @@ -41,9 +41,9 @@ -define(MANY, 1000). -define(SOME, 50). --define(BASE_TIMEOUT_SECONDS, 30). --define(SOME_SCALE, 20). --define(MANY_SCALE, 20). +-define(BASE_TIMEOUT_SECONDS, 5). +-define(SOME_SCALE, 2). +-define(MANY_SCALE, 3). %%-------------------------------------------------------------------- %% Common Test interface functions ----------------------------------- diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index cab22a60a8..9632103696 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -462,9 +462,10 @@ cert_options(Config) -> make_dsa_cert(Config) -> - - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, dsa, ""), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, dsa, ""), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, dsa, dsa, "", []), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, dsa, dsa, "", []), [{server_dsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -490,8 +491,10 @@ make_ecdsa_cert(Config) -> CryptoSupport = crypto:supports(), case proplists:get_bool(ecdsa, proplists:get_value(public_keys, CryptoSupport)) of true -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, ec, ec, ""), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, ec, ec, ""), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, ec, ec, "", [{digest, appropriate_sha(CryptoSupport)}]), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, ec, ec, "", [{digest, appropriate_sha(CryptoSupport)}]), [{server_ecdsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -507,6 +510,14 @@ make_ecdsa_cert(Config) -> Config end. +appropriate_sha(CryptoSupport) -> + case proplists:get_bool(sha256, CryptoSupport) of + true -> + sha256; + false -> + sha1 + end. + %% RFC 4492, Sect. 2.3. ECDH_RSA %% %% This key exchange algorithm is the same as ECDH_ECDSA except that the @@ -515,8 +526,10 @@ make_ecdh_rsa_cert(Config) -> CryptoSupport = crypto:supports(), case proplists:get_bool(ecdh, proplists:get_value(public_keys, CryptoSupport)) of true -> - {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, rsa, ec, "rsa_"), - {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, rsa, ec, "rsa_"), + {ServerCaCertFile, ServerCertFile, ServerKeyFile} = + make_cert_files("server", Config, rsa, ec, "rsa_", []), + {ClientCaCertFile, ClientCertFile, ClientKeyFile} = + make_cert_files("client", Config, rsa, ec, "rsa_",[]), [{server_ecdh_rsa_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -534,9 +547,9 @@ make_ecdh_rsa_cert(Config) -> make_mix_cert(Config) -> {ServerCaCertFile, ServerCertFile, ServerKeyFile} = make_cert_files("server", Config, dsa, - rsa, "mix"), + rsa, "mix", []), {ClientCaCertFile, ClientCertFile, ClientKeyFile} = make_cert_files("client", Config, dsa, - rsa, "mix"), + rsa, "mix", []), [{server_mix_opts, [{ssl_imp, new},{reuseaddr, true}, {cacertfile, ServerCaCertFile}, {certfile, ServerCertFile}, {keyfile, ServerKeyFile}]}, @@ -549,11 +562,11 @@ make_mix_cert(Config) -> {certfile, ClientCertFile}, {keyfile, ClientKeyFile}]} | Config]. -make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix) -> +make_cert_files(RoleStr, Config, Alg1, Alg2, Prefix, Opts) -> Alg1Str = atom_to_list(Alg1), Alg2Str = atom_to_list(Alg2), - CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}]), - {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo}]), + CaInfo = {CaCert, _} = erl_make_certs:make_cert([{key, Alg1}| Opts]), + {Cert, CertKey} = erl_make_certs:make_cert([{key, Alg2}, {issuer, CaInfo} | Opts]), CaCertFile = filename:join([proplists:get_value(priv_dir, Config), RoleStr, Prefix ++ Alg1Str ++ "_cacerts.pem"]), CertFile = filename:join([proplists:get_value(priv_dir, Config), @@ -840,37 +853,42 @@ common_ciphers(openssl) -> lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) ]. -rsa_non_signed_suites() -> +available_suites(Version) -> + [ssl_cipher:erl_suite_definition(Suite) || + Suite <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]. + + +rsa_non_signed_suites(Version) -> lists:filter(fun({rsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -dsa_suites() -> +dsa_suites(Version) -> lists:filter(fun({dhe_dss, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -ecdsa_suites() -> +ecdsa_suites(Version) -> lists:filter(fun({ecdhe_ecdsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). -ecdh_rsa_suites() -> +ecdh_rsa_suites(Version) -> lists:filter(fun({ecdh_rsa, _, _}) -> true; (_) -> false end, - ssl:cipher_suites()). + available_suites(Version)). openssl_rsa_suites(CounterPart) -> Ciphers = ssl:cipher_suites(openssl), @@ -1174,14 +1192,15 @@ is_fips(_) -> false. cipher_restriction(Config0) -> + Version = tls_record:protocol_version(protocol_version(Config0)), case is_sane_ecc(openssl) of false -> Opts = proplists:get_value(server_opts, Config0), Config1 = proplists:delete(server_opts, Config0), VerOpts = proplists:get_value(server_verification_opts, Config1), Config = proplists:delete(server_verification_opts, Config1), - Restricted0 = ssl:cipher_suites() -- ecdsa_suites(), - Restricted = Restricted0 -- ecdh_rsa_suites(), + Restricted0 = ssl:cipher_suites() -- ecdsa_suites(Version), + Restricted = Restricted0 -- ecdh_rsa_suites(Version), [{server_opts, [{ciphers, Restricted} | Opts]}, {server_verification_opts, [{ciphers, Restricted} | VerOpts] } | Config]; true -> Config0 diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 9ecfe5b0ea..e99340822d 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -834,7 +834,7 @@ ciphers_dsa_signed_certs() -> [{doc,"Test cipher suites that uses dsa certs"}]. ciphers_dsa_signed_certs(Config) when is_list(Config) -> Version = ssl_test_lib:protocol_version(Config), - Ciphers = ssl_test_lib:dsa_suites(), + Ciphers = ssl_test_lib:dsa_suites(tls_record:protocol_version(Version)), run_suites(Ciphers, Version, Config, dsa). %%-------------------------------------------------------------------- diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 64267c2af5..fd498ee82e 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -533,7 +533,7 @@ handle_event(_, _, State, Data) -> Type <c>info</c> originates from regular process messages sent to the <c>gen_statem</c>. Also, the state machine implementation can generate events of types - <c>timeout</c>, <c>state_timeout</c>, <c>enter</c>, + <c>timeout</c>, <c>state_timeout</c>, and <c>internal</c> to itself. </p> </desc> @@ -639,6 +639,20 @@ handle_event(_, _, State, Data) -> </p> <list type="ordered"> <item> + <p> + If the state changes or is the initial state, and + <seealso marker="#type-state_enter"><em>state enter calls</em></seealso> + are used, the <c>gen_statem</c> calls + the new state callback with arguments + <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>. + Any + <seealso marker="#type-enter_action"><c>actions</c></seealso> + returned from this call are handled as if they were + appended to the actions + returned by the state callback that changed states. + </p> + </item> + <item> <p> All <seealso marker="#type-action">actions</seealso> @@ -668,36 +682,36 @@ handle_event(_, _, State, Data) -> </p> </item> <item> - <p> - If the state changes or is the initial state, and - <seealso marker="#type-state_enter"><em>state enter calls</em></seealso> - are used, the <c>gen_statem</c> calls - the new state callback with arguments - <seealso marker="#type-state_enter">(enter, OldState, Data)</seealso>. - Any - <seealso marker="#type-enter_action"><c>actions</c></seealso> - returned from this call are handled as if they were - appended to the actions - returned by the state callback that changed states. - </p> - </item> - <item> - <p> - If there are enqueued events the (possibly new) - <seealso marker="#state callback">state callback</seealso> - is called with the oldest enqueued event, - and we start again from the top of this list. - </p> - </item> - <item> <p> Timeout timers <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso> and <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso> - are handled. This may lead to a time-out zero event - being generated to the + are handled. Time-outs with zero time are guaranteed to be + delivered to the state machine before any external + not yet received event so if there is such a timeout requested, + the corresponding time-out zero event is enqueued as + the newest event. + </p> + <p> + Any event cancels an + <seealso marker="#type-event_timeout"><c>event_timeout()</c></seealso> + so a zero time event time-out is only generated + if the event queue is empty. + </p> + <p> + A state change cancels a + <seealso marker="#type-state_timeout"><c>state_timeout()</c></seealso> + and any new transition option of this type + belongs to the new state. + </p> + </item> + <item> + <p> + If there are enqueued events the <seealso marker="#state callback">state callback</seealso> + for the possibly new state + is called with the oldest enqueued event, and we start again from the top of this list. </p> </item> @@ -759,8 +773,9 @@ handle_event(_, _, State, Data) -> after this time (in milliseconds) unless another event arrives or has arrived in which case this time-out is cancelled. - Note that a retried, inserted or state time-out zero - events counts as arrived. + Note that a retried or inserted event counts as arrived. + So does a state time-out zero event, if it was generated + before this timer is requested. </p> <p> If the value is <c>infinity</c>, no timer is started, as @@ -802,7 +817,7 @@ handle_event(_, _, State, Data) -> <p> Setting this timer while it is running will restart it with the new time-out value. Therefore it is possible to cancel - this timeout by setting it to <c>infinity</c>. + this time-out by setting it to <c>infinity</c>. </p> </desc> </datatype> @@ -1130,7 +1145,7 @@ handle_event(_, _, State, Data) -> <c><anno>Timeout</anno></c> can also be a tuple <c>{clean_timeout,<anno>T</anno>}</c> or <c>{dirty_timeout,<anno>T</anno>}</c>, where - <c><anno>T</anno></c> is the timeout time. + <c><anno>T</anno></c> is the time-out time. <c>{clean_timeout,<anno>T</anno>}</c> works like just <c>T</c> described in the note above and uses a proxy process for <c>T < infinity</c>, @@ -1773,7 +1788,7 @@ handle_event(_, _, State, Data) -> StateFunctionResult </name> <name>Module:handle_event(enter, OldState, State, Data) -> - StateEnterResult + StateEnterResult(State) </name> <name>Module:handle_event(EventType, EventContent, State, Data) -> HandleEventResult @@ -1802,8 +1817,8 @@ handle_event(_, _, State, Data) -> <seealso marker="#type-event_handler_result">event_handler_result</seealso>(<seealso marker="#type-state_name">state_name()</seealso>) </v> <v> - StateEnterResult = - <seealso marker="#type-state_enter_result">state_enter_result</seealso>(<seealso marker="#type-state">state()</seealso>) + StateEnterResult(State) = + <seealso marker="#type-state_enter_result">state_enter_result(State)</seealso> </v> <v> HandleEventResult = diff --git a/lib/stdlib/doc/src/maps.xml b/lib/stdlib/doc/src/maps.xml index e1edbadcd3..8c7270816b 100644 --- a/lib/stdlib/doc/src/maps.xml +++ b/lib/stdlib/doc/src/maps.xml @@ -160,7 +160,7 @@ val1 <p><em>Example:</em></p> <code type="none"> > Map = #{"42" => value}. -#{"42"> => value} +#{"42" => value} > maps:is_key("42",Map). true > maps:is_key(value,Map). diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml index 1dcc3de000..1364a3277b 100644 --- a/lib/stdlib/doc/src/rand.xml +++ b/lib/stdlib/doc/src/rand.xml @@ -41,6 +41,11 @@ Sebastiano Vigna</url>. The normal distribution algorithm uses the <url href="http://www.jstatsoft.org/v05/i08">Ziggurat Method by Marsaglia and Tsang</url>.</p> + <p>For some algorithms, jump functions are provided for generating + non-overlapping sequences for parallel computations. + The jump functions perform calculations + equivalent to perform a large number of repeated calls + for calculating new states. </p> <p>The following algorithms are provided:</p> @@ -48,14 +53,17 @@ <tag><c>exsplus</c></tag> <item> <p>Xorshift116+, 58 bits precision and period of 2^116-1</p> + <p>Jump function: equivalent to 2^64 calls</p> </item> <tag><c>exs64</c></tag> <item> <p>Xorshift64*, 64 bits precision and a period of 2^64-1</p> + <p>Jump function: not available</p> </item> <tag><c>exs1024</c></tag> <item> <p>Xorshift1024*, 64 bits precision and a period of 2^1024-1</p> + <p>Jump function: equivalent to 2^512 calls</p> </item> </taglist> @@ -156,6 +164,33 @@ S0 = rand:seed_s(exsplus), </func> <func> + <name name="jump" arity="0"/> + <fsummary>Return the seed after performing jump calculation + to the state in the process dictionary.</fsummary> + <desc><marker id="jump-0" /> + <p>Returns the state + after performing jump calculation + to the state in the process dictionary.</p> + <p>This function generates a <c>not_implemented</c> error exception + when the jump function is not implemented for + the algorithm specified in the state + in the process dictionary.</p> + </desc> + </func> + + <func> + <name name="jump" arity="1"/> + <fsummary>Return the seed after performing jump calculation.</fsummary> + <desc><marker id="jump-1" /> + <p>Returns the state after performing jump calculation + to the given state. </p> + <p>This function generates a <c>not_implemented</c> error exception + when the jump function is not implemented for + the algorithm specified in the state.</p> + </desc> + </func> + + <func> <name name="normal" arity="0"/> <fsummary>Return a standard normal distributed random float.</fsummary> <desc> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 17d1ebecec..018aca90e6 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -85,7 +85,8 @@ -type state_enter() :: 'state_enter'. -type transition_option() :: - postpone() | hibernate() | event_timeout(). + postpone() | hibernate() | + event_timeout() | state_timeout(). -type postpone() :: %% If 'true' postpone the current event %% and retry it when the state changes (=/=) @@ -108,7 +109,7 @@ %% * All action()s are executed in order of apperance. %% * Postponing the current event is performed %% iff 'postpone' is 'true'. - %% * A state timer is started iff 'timeout' is set. + %% * A state timeout is started iff 'timeout' is set. %% * Pending events are handled or if there are %% no pending events the server goes into receive %% or hibernate (iff 'hibernate' is 'true') @@ -154,12 +155,12 @@ -type handle_event_result() :: event_handler_result(state()). %% --type state_enter_result(StateType) :: +-type state_enter_result(State) :: {'next_state', % {next_state,NextState,NewData,[]} - State :: StateType, + State, NewData :: data()} | {'next_state', % State transition, maybe to the same state - State :: StateType, + State, NewData :: data(), Actions :: [enter_action()] | enter_action()} | state_callback_result(enter_action()). @@ -231,9 +232,9 @@ -callback handle_event( 'enter', OldState :: state(), - State :: state(), % Current state + State, % Current state Data :: data()) -> - state_enter_result(state()); + state_enter_result(State); (event_type(), EventContent :: term(), State :: state(), % Current state @@ -596,8 +597,8 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> data => Data, postponed => P, %% The rest of the fields are set from to the arguments to - %% loop_event_actions/9 when it finally loops back to loop/3 - %% in loop_events_done/9 + %% loop_event_actions/10 when it finally loops back to loop/3 + %% in loop_events/10 %% %% Marker for initial state, cleared immediately when used init_state => true @@ -605,9 +606,10 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), case call_callback_mode(S) of {ok,NewS} -> - StateTimer = undefined, + TimerRefs = #{}, + TimerTypes = #{}, loop_event_actions( - Parent, NewDebug, NewS, StateTimer, + Parent, NewDebug, NewS, TimerRefs, TimerTypes, Events, Event, State, Data, NewActions); {Class,Reason,Stacktrace} -> terminate( @@ -747,6 +749,10 @@ print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> io:format( Dev, "*DBG* ~p send ~p to ~p from state ~p~n", [Name,Reply,To,State]); +print_event(Dev, {terminate,Reason}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p terminate ~p in state ~p~n", + [Name,Reason,State]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = case NextState of @@ -806,7 +812,7 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) -> %% Entry point for wakeup_from_hibernate/3 loop_receive( - Parent, Debug, #{timer := Timer, state_timer := StateTimer} = S) -> + Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> receive Msg -> case Msg of @@ -822,18 +828,23 @@ loop_receive( %% but this will stand out in the crash report... terminate( exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); - {timeout,Timer,Content} - when Timer =/= undefined -> - loop_receive_result( - Parent, Debug, S, StateTimer, - {timeout,Content}); - {timeout,StateTimer,Content} - when StateTimer =/= undefined -> - loop_receive_result( - Parent, Debug, S, undefined, - {state_timeout,Content}); + {timeout,TimerRef,TimerMsg} -> + case TimerRefs of + #{TimerRef := TimerType} -> + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + Event); + _ -> + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end; _ -> - cancel_timer(Timer), Event = case Msg of {'$gen_call',From,Request} -> @@ -844,12 +855,15 @@ loop_receive( {info,Msg} end, loop_receive_result( - Parent, Debug, S, StateTimer, Event) + Parent, Debug, S, + TimerRefs, TimerTypes, Event) end end. -loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) -> - %% The fields 'timer', 'state_timer' and 'hibernate' +loop_receive_result( + Parent, Debug, #{state := State} = S, + TimerRefs, TimerTypes, Event) -> + %% The fields 'timer_refs', 'timer_types' and 'hibernate' %% are now invalid in state map S - they will be recalculated %% and restored when we return to loop/3 %% @@ -857,82 +871,196 @@ loop_receive_result(Parent, Debug, #{state := State} = S, StateTimer, Event) -> %% Here the queue of not yet handled events is created Events = [], Hibernate = false, - loop_event(Parent, NewDebug, S, StateTimer, Events, Event, Hibernate). + loop_event( + Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). -%% Process the event queue, or if it is empty -%% loop back to loop/3 to receive a new event -loop_events( - Parent, Debug, S, StateTimeout, - [Event|Events], _Timeout, State, Data, P, Hibernate) -> +%% Entry point for handling an event, received or enqueued +loop_event( + Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Events, {Type,Content} = Event, Hibernate) -> %% - %% If there was an event timer requested we just ignore that - %% since we have events to handle which cancels the timer - loop_event( - Parent, Debug, S, StateTimeout, - Events, Event, State, Data, P, Hibernate); -loop_events( - Parent, Debug, S, {state_timeout,Time,EventContent}, - [] = Events, Timeout, State, Data, P, Hibernate) -> - if - Time =:= 0 -> - %% Simulate an immediate timeout - %% so we do not get the timeout message - %% after any received event - %% - %% This faked event will cancel - %& any not yet started event timer - Event = {state_timeout,EventContent}, - StateTimer = undefined, - loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate); - true -> - StateTimer = erlang:start_timer(Time, self(), EventContent), - loop_events( - Parent, Debug, S, StateTimer, - Events, Timeout, State, Data, P, Hibernate) - end; -loop_events( - Parent, Debug, S, StateTimer, - [] = Events, Timeout, State, Data, P, Hibernate) -> - case Timeout of - {timeout,0,EventContent} -> - %% Simulate an immediate timeout - %% so we do not get the timeout message - %% after any received event - %% - Event = {timeout,EventContent}, - loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate); - {timeout,Time,EventContent} -> - Timer = erlang:start_timer(Time, self(), EventContent), - loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer); - undefined -> - %% No event timeout has been requested - Timer = undefined, - loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer) + %% If Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there + %% were events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened + Hibernate andalso garbage_collect(), + case call_state_function(S, Type, Content, State, Data) of + {ok,Result,NewS} -> + %% Cancel event timeout + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type( + timeout, TimerRefs, TimerTypes), + {NewData,NextState,Actions} = + parse_event_result( + true, Debug, NewS, Result, + Events, Event, State, Data), + loop_event_actions( + Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Events, Event, NextState, NewData, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -%% Back to the top -loop_events_done( - Parent, Debug, S, StateTimer, - State, Data, P, Hibernate, Timer) -> +loop_event_actions( + Parent, Debug, + #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, Actions) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> + if + StateEnter, NextState =/= State -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + StateEnter -> + case maps:is_key(init_state, S) of + true -> + %% Avoid infinite loop in initial state + %% with state entry events + NewS = maps:remove(init_state, S), + loop_event_enter( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR); + false -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + true -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{data := NewData}, [Event|Events]) + end. + +loop_event_enter( + Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + case call_state_function(S, enter, State, NextState, NewData) of + {ok,Result,NewS} -> + {NewerData,_,Actions} = + parse_event_result( + false, Debug, NewS, Result, + Events, Event, NextState, NewData), + loop_event_enter_actions( + Parent, Debug, NewS, TimerRefs, TimerTypes, + Events, Event, NextState, NewerData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_enter_actions( + Parent, Debug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + case + parse_enter_actions( + Debug, S, NextState, Actions, + Hibernate, TimeoutsR) + of + {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> + loop_event_result( + Parent, NewDebug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + NewHibernate, NewTimeoutsR, Postpone, NextEventsR); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_result( + Parent, Debug, + #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + %% + %% All options have been collected and next_events are buffered. + %% Do the actual state transition. + %% + {NewDebug,P_1} = % Move current event to postponed if Postpone + case Postpone of + true -> + {sys_debug(Debug, S, State, {postpone,Event,State}), + [Event|P_0]}; + false -> + {sys_debug(Debug, S, State, {consume,Event,State}), + P_0} + end, + {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} = + %% Move all postponed events to queue and cancel the + %% state timeout if the state changes + if + NextState =:= State -> + {Events,P_1,{TimerRefs_0,TimerTypes_0}}; + true -> + {lists:reverse(P_1, Events),[], + cancel_timer_by_type( + state_timeout, TimerRefs_0, TimerTypes_0)} + end, + {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + %% Stop and start timers non-event timers + parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR), + %% Place next events last in reversed queue + Events_2R = lists:reverse(Events_1, NextEventsR), + %% Enqueue immediate timeout events and start event timer + {NewTimerRefs,NewTimerTypes,Events_3R} = + process_timeout_events( + TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R), + NewEvents = lists:reverse(Events_3R), + loop_events( + Parent, NewDebug, S, NewTimerRefs, NewTimerTypes, + NewEvents, Hibernate, NextState, NewData, NewP). + +%% Loop until out of enqueued events +%% +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [] = _Events, Hibernate, State, Data, P) -> + %% Update S and loop back to loop/3 to receive a new event NewS = S#{ state := State, data := Data, postponed := P, hibernate => Hibernate, - timer => Timer, - state_timer => StateTimer}, - loop(Parent, Debug, NewS). + timer_refs => TimerRefs, + timer_types => TimerTypes}, + loop(Parent, Debug, NewS); +loop_events( + Parent, Debug, S, TimerRefs, TimerTypes, + [Event|Events], Hibernate, State, Data, P) -> + %% Update S and continue with enqueued events + NewS = + S#{ + state := State, + data := Data, + postponed := P}, + loop_event( + Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate). + +%%--------------------------------------------------------------------------- +%% Server loop helpers call_callback_mode(#{module := Module} = S) -> try Module:callback_mode() of @@ -996,6 +1124,7 @@ parse_callback_mode([H|T], CBMode, StateEnter) -> parse_callback_mode(_, _CBMode, StateEnter) -> {undefined,StateEnter}. + call_state_function( #{callback_mode := undefined} = S, Type, Content, State, Data) -> @@ -1061,42 +1190,6 @@ call_state_function( {Class,Reason,erlang:get_stacktrace()} end. -%% Update S and continue -loop_event( - Parent, Debug, S, StateTimer, - Events, Event, State, Data, P, Hibernate) -> - NewS = - S#{ - state := State, - data := Data, - postponed := P}, - loop_event(Parent, Debug, NewS, StateTimer, Events, Event, Hibernate). - -loop_event( - Parent, Debug, #{state := State, data := Data} = S, StateTimer, - Events, {Type,Content} = Event, Hibernate) -> - %% - %% If Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there - %% were events in queue, so we do what the user - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), - case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> - {NewData,NextState,Actions} = - parse_event_result( - true, Debug, NewS, Result, - Events, Event, State, Data), - loop_event_actions( - Parent, Debug, S, StateTimer, - Events, Event, NextState, NewData, Actions); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, S, [Event|Events]) - end. %% Interpret all callback return variants parse_event_result( @@ -1146,32 +1239,32 @@ parse_event_result( Debug, S, [Event|Events]) end. + parse_enter_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout) -> + Hibernate, TimeoutsR) -> Postpone = forbidden, - NextEvents = forbidden, + NextEventsR = forbidden, parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, StateTimeout, Postpone, NextEvents). + Hibernate, TimeoutsR, Postpone, NextEventsR). parse_actions(Debug, S, State, Actions) -> Hibernate = false, - Timeout = undefined, - StateTimeout = undefined, + TimeoutsR = [], Postpone = false, - NextEvents = [], + NextEventsR = [], parse_actions( Debug, S, State, listify(Actions), - Hibernate, Timeout, StateTimeout, Postpone, NextEvents). + Hibernate, TimeoutsR, Postpone, NextEventsR). %% parse_actions( Debug, _S, _State, [], - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - {ok,Debug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents}; + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; parse_actions( Debug, S, State, [Action|Actions], - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> + Hibernate, TimeoutsR, Postpone, NextEventsR) -> case Action of %% Actual actions {reply,From,Reply} -> @@ -1180,8 +1273,7 @@ parse_actions( NewDebug = do_reply(Debug, S, State, From, Reply), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents); + Hibernate, TimeoutsR, Postpone, NextEventsR); false -> {error, {bad_action_from_state_function,Action}, @@ -1191,7 +1283,7 @@ parse_actions( {hibernate,NewHibernate} when is_boolean(NewHibernate) -> parse_actions( Debug, S, State, Actions, - NewHibernate, Timeout, StateTimeout, Postpone, NextEvents); + NewHibernate, TimeoutsR, Postpone, NextEventsR); {hibernate,_} -> {error, {bad_action_from_state_function,Action}, @@ -1199,43 +1291,44 @@ parse_actions( hibernate -> parse_actions( Debug, S, State, Actions, - true, Timeout, StateTimeout, Postpone, NextEvents); - {state_timeout,Time,_} = NewStateTimeout + true, TimeoutsR, Postpone, NextEventsR); + {state_timeout,Time,_} = StateTimeout when is_integer(Time), Time >= 0; Time =:= infinity -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, NewStateTimeout, Postpone, NextEvents); + Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR); {state_timeout,_,_} -> {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - {timeout,infinity,_} -> % Clear timer - it will never trigger + {timeout,infinity,_} -> + %% Ignore - timeout will never happen and already cancelled parse_actions( Debug, S, State, Actions, - Hibernate, undefined, StateTimeout, Postpone, NextEvents); - {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> + Hibernate, TimeoutsR, Postpone, NextEventsR); + {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 -> parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); {timeout,_,_} -> {error, {bad_action_from_state_function,Action}, ?STACKTRACE()}; - infinity -> % Clear timer - it will never trigger + infinity -> % Ignore - timeout will never happen parse_actions( Debug, S, State, Actions, - Hibernate, undefined, StateTimeout, Postpone, NextEvents); + Hibernate, TimeoutsR, Postpone, NextEventsR); Time when is_integer(Time), Time >= 0 -> - NewTimeout = {timeout,Time,Time}, + Timeout = {timeout,Time,Time}, parse_actions( Debug, S, State, Actions, - Hibernate, NewTimeout, StateTimeout, Postpone, NextEvents); + Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR); {postpone,NewPostpone} when is_boolean(NewPostpone), Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout, NewPostpone, NextEvents); + Hibernate, TimeoutsR, NewPostpone, NextEventsR); {postpone,_} -> {error, {bad_action_from_state_function,Action}, @@ -1243,16 +1336,16 @@ parse_actions( postpone when Postpone =/= forbidden -> parse_actions( Debug, S, State, Actions, - Hibernate, Timeout, StateTimeout, true, NextEvents); + Hibernate, TimeoutsR, true, NextEventsR); {next_event,Type,Content} -> case event_type(Type) of - true when NextEvents =/= forbidden -> + true when NextEventsR =/= forbidden -> NewDebug = sys_debug(Debug, S, State, {in,{Type,Content}}), parse_actions( NewDebug, S, State, Actions, - Hibernate, Timeout, StateTimeout, - Postpone, [{Type,Content}|NextEvents]); + Hibernate, TimeoutsR, Postpone, + [{Type,Content}|NextEventsR]); _ -> {error, {bad_action_from_state_function,Action}, @@ -1264,158 +1357,92 @@ parse_actions( ?STACKTRACE()} end. -loop_event_actions( - Parent, Debug, - #{state := State, state_enter := StateEnter} = S, StateTimer, - Events, Event, NextState, NewData, Actions) -> - case parse_actions(Debug, S, State, Actions) of - {ok,NewDebug,Hibernate,Timeout,StateTimeout,Postpone,NextEvents} -> + +%% Stop and start timers as well as create timeout zero events +%% and pending event timer +%% +%% Stop and start timers non-event timers +parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +%% +parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + {TimerType,Time,TimerMsg} = Timeout, + case Seen of + #{TimerType := _} -> + %% Type seen before - ignore + parse_timers( + TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents); + #{} -> + %% Unseen type - handle + NewSeen = Seen#{TimerType => true}, + %% Cancel any running timer + {NewTimerRefs,NewTimerTypes} = + cancel_timer_by_type(TimerType, TimerRefs, TimerTypes), if - StateEnter, NextState =/= State -> - loop_event_enter( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents); - StateEnter -> - case maps:is_key(init_state, S) of - true -> - %% Avoid infinite loop in initial state - %% with state entry events - NewS = maps:remove(init_state, S), - loop_event_enter( - Parent, NewDebug, NewS, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents); - false -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, - Postpone, NextEvents) - end; + Time =:= infinity -> + %% Ignore - timer will never fire + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, TimeoutEvents); + TimerType =:= timeout -> + %% Handle event timer later + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [Timeout|TimeoutEvents]); + Time =:= 0 -> + %% Handle zero time timeouts later + TimeoutEvent = {TimerType,TimerMsg}, + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [TimeoutEvent|TimeoutEvents]); true -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{data := NewData}, [Event|Events]) + %% Start a new timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + parse_timers( + NewTimerRefs#{TimerRef => TimerType}, + NewTimerTypes#{TimerType => TimerRef}, + TimeoutsR, NewSeen, TimeoutEvents) + end end. -loop_event_enter( - Parent, Debug, #{state := State} = S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - case call_state_function(S, enter, State, NextState, NewData) of - {ok,Result,NewS} -> - {NewerData,_,Actions} = - parse_event_result( - false, Debug, NewS, Result, - Events, Event, NextState, NewData), - loop_event_enter_actions( - Parent, Debug, NewS, StateTimer, - Events, Event, NextState, NewerData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, - [Event|Events]) - end. +%% Enqueue immediate timeout events and start event timer +process_timeout_events(TimerRefs, TimerTypes, [], EventsR) -> + {TimerRefs, TimerTypes, EventsR}; +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,0,TimerMsg}|TimeoutEvents], []) -> + %% No enqueued events - insert a timeout zero event + TimeoutEvent = {timeout,TimerMsg}, + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent]); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,Time,TimerMsg}], []) -> + %% No enqueued events - start event timer + TimerRef = erlang:start_timer(Time, self(), TimerMsg), + process_timeout_events( + TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef}, + [], []); +process_timeout_events( + TimerRefs, TimerTypes, + [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) -> + %% There will be some other event so optimize by not starting + %% an event timer to just have to cancel it again + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, EventsR); +process_timeout_events( + TimerRefs, TimerTypes, + [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) -> + process_timeout_events( + TimerRefs, TimerTypes, + TimeoutEvents, [TimeoutEvent|EventsR]). -loop_event_enter_actions( - Parent, Debug, S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents, Actions) -> - case - parse_enter_actions( - Debug, S, NextState, Actions, - Hibernate, Timeout, StateTimeout) - of - {ok,NewDebug,NewHibernate,NewTimeout,NewStateTimeout,_,_} -> - loop_event_result( - Parent, NewDebug, S, StateTimer, - Events, Event, NextState, NewData, - NewHibernate, NewTimeout, NewStateTimeout, Postpone, NextEvents); - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, - Debug, S#{state := NextState, data := NewData}, - [Event|Events]) - end. -loop_event_result( - Parent, Debug, - #{state := State, postponed := P_0} = S, StateTimer, - Events, Event, NextState, NewData, - Hibernate, Timeout, StateTimeout, Postpone, NextEvents) -> - %% - %% All options have been collected and next_events are buffered. - %% Do the actual state transition. - %% - NewStateTimeout = - case StateTimeout of - {state_timeout,Time,_} -> - %% New timeout -> cancel timer - case StateTimer of - {state_timeout,_,_} -> - ok; - _ -> - cancel_timer(StateTimer) - end, - case Time of - infinity -> - undefined; - _ -> - StateTimeout - end; - undefined when NextState =/= State -> - %% State change -> cancel timer - case StateTimer of - {state_timeout,_,_} -> - ok; - _ -> - cancel_timer(StateTimer) - end, - undefined; - undefined -> - StateTimer - end, - %% - P_1 = % Move current event to postponed if Postpone - case Postpone of - true -> - [Event|P_0]; - false -> - P_0 - end, - {Events_1,NewP} = % Move all postponed events to queue if state change - if - NextState =:= State -> - {Events,P_1}; - true -> - {lists:reverse(P_1, Events),[]} - end, - %% Place next events first in queue - NewEvents = lists:reverse(NextEvents, Events_1), - %% - NewDebug = - sys_debug( - Debug, S, State, - case Postpone of - true -> - {postpone,Event,State}; - false -> - {consume,Event,State} - end), - %% - loop_events( - Parent, NewDebug, S, NewStateTimeout, - NewEvents, Timeout, NextState, NewData, NewP, Hibernate). %%--------------------------------------------------------------------------- %% Server helpers @@ -1474,16 +1501,20 @@ terminate( sys:print_log(Debug), erlang:raise(C, R, ST) end, - case Reason of - normal -> ok; - shutdown -> ok; - {shutdown,_} -> ok; - _ -> - error_info( - Class, Reason, Stacktrace, S, Q, P, - format_status(terminate, get(), S)), - sys:print_log(Debug) - end, + _ = + case Reason of + normal -> + sys_debug(Debug, S, State, {terminate,Reason}); + shutdown -> + sys_debug(Debug, S, State, {terminate,Reason}); + {shutdown,_} -> + sys_debug(Debug, S, State, {terminate,Reason}); + _ -> + error_info( + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug) + end, case Stacktrace of [] -> erlang:Class(Reason); @@ -1605,8 +1636,19 @@ listify(Item) when is_list(Item) -> listify(Item) -> [Item]. -cancel_timer(undefined) -> - ok; +%% Cancel timer if running, otherwise no op +cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> + case TimerTypes of + #{TimerType := TimerRef} -> + cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes)}; + #{} -> + {TimerRefs,TimerTypes} + end. + +%%cancel_timer(undefined) -> +%% ok; cancel_timer(TRef) -> case erlang:cancel_timer(TRef) of false -> diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index 93409d95df..3b1767e731 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -19,7 +19,7 @@ %% %% ===================================================================== %% Multiple PRNG module for Erlang/OTP -%% Copyright (c) 2015 Kenji Rikitake +%% Copyright (c) 2015-2016 Kenji Rikitake %% ===================================================================== -module(rand). @@ -27,11 +27,14 @@ -export([seed_s/1, seed_s/2, seed/1, seed/2, export_seed/0, export_seed_s/1, uniform/0, uniform/1, uniform_s/1, uniform_s/2, + jump/0, jump/1, normal/0, normal_s/1 ]). -compile({inline, [exs64_next/1, exsplus_next/1, + exsplus_jump/1, exs1024_next/1, exs1024_calc/2, + exs1024_jump/1, get_52/1, normal_kiwi/1]}). -define(DEFAULT_ALG_HANDLER, exsplus). @@ -48,7 +51,8 @@ max := integer(), next := fun(), uniform := fun(), - uniform_n := fun()}. + uniform_n := fun(), + jump := fun()}. %% Internal state -opaque state() :: {alg_handler(), alg_seed()}. @@ -79,9 +83,7 @@ export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}. -spec seed(AlgOrExpState::alg() | export_state()) -> state(). seed(Alg) -> - R = seed_s(Alg), - _ = seed_put(R), - R. + seed_put(seed_s(Alg)). -spec seed_s(AlgOrExpState::alg() | export_state()) -> state(). seed_s(Alg) when is_atom(Alg) -> @@ -97,9 +99,7 @@ seed_s({Alg0, Seed}) -> -spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state(). seed(Alg0, S0) -> - State = seed_s(Alg0, S0), - _ = seed_put(State), - State. + seed_put(seed_s(Alg0, S0)). -spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state(). seed_s(Alg0, S0 = {_, _, _}) -> @@ -150,6 +150,25 @@ uniform_s(N, State0 = {#{uniform:=Uniform}, _}) {F, State} = Uniform(State0), {trunc(F * N) + 1, State}. +%% jump/1: given a state, jump/1 +%% returns a new state which is equivalent to that +%% after a large number of call defined for each algorithm. +%% The large number is algorithm dependent. + +-spec jump(state()) -> {NewS :: state()}. +jump(State = {#{jump:=Jump}, _}) -> + Jump(State). + +%% jump/0: read the internal state and +%% apply the jump function for the state as in jump/1 +%% and write back the new value to the internal state, +%% then returns the new value. + +-spec jump() -> {NewS :: state()}. + +jump() -> + seed_put(jump(seed_get())). + %% normal/0: returns a random float with standard normal distribution %% updating the state in the process dictionary. @@ -192,9 +211,10 @@ normal_s(State0) -> -type uint64() :: 0..16#ffffffffffffffff. -type uint58() :: 0..16#03ffffffffffffff. --spec seed_put(state()) -> undefined | state(). +-spec seed_put(state()) -> state(). seed_put(Seed) -> - put(?SEED_DICT, Seed). + put(?SEED_DICT, Seed), + Seed. seed_get() -> case get(?SEED_DICT) of @@ -205,15 +225,18 @@ seed_get() -> %% Setup alg record mk_alg(exs64) -> {#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1, - uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2}, + uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2, + jump=>fun exs64_jump/1}, fun exs64_seed/1}; mk_alg(exsplus) -> {#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1, - uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2}, + uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2, + jump=>fun exsplus_jump/1}, fun exsplus_seed/1}; mk_alg(exs1024) -> {#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1, - uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2}, + uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2, + jump=>fun exs1024_jump/1}, fun exs1024_seed/1}. %% ===================================================================== @@ -246,6 +269,9 @@ exs64_uniform(Max, {Alg, R}) -> {V, R1} = exs64_next(R), {(V rem Max) + 1, {Alg, R1}}. +exs64_jump(_) -> + erlang:error(not_implemented). + %% ===================================================================== %% exsplus PRNG: Xorshift116+ %% Algorithm by Sebastiano Vigna @@ -283,6 +309,42 @@ exsplus_uniform(Max, {Alg, R}) -> {V, R1} = exsplus_next(R), {(V rem Max) + 1, {Alg, R1}}. +%% This is the jump function for the exsplus generator, equivalent +%% to 2^64 calls to next/1; it can be used to generate 2^52 +%% non-overlapping subsequences for parallel computations. +%% Note: the jump function takes 116 times of the execution time of +%% next/1. + +%% -define(JUMPCONST, 16#000d174a83e17de2302f8ea6bc32c797). +%% split into 58-bit chunks +%% and two iterative executions + +-define(JUMPCONST1, 16#02f8ea6bc32c797). +-define(JUMPCONST2, 16#345d2a0f85f788c). +-define(JUMPELEMLEN, 58). + +-spec exsplus_jump(exsplus_state()) -> exsplus_state(). + +exsplus_jump({Alg, S}) -> + {S1, AS1} = exsplus_jump(S, [0|0], ?JUMPCONST1, ?JUMPELEMLEN), + {_, AS2} = exsplus_jump(S1, AS1, ?JUMPCONST2, ?JUMPELEMLEN), + {Alg, AS2}. + +-spec exsplus_jump(state(), state(), pos_integer(), pos_integer()) -> + {state(), state()}. + +exsplus_jump(S, AS, _, 0) -> + {S, AS}; +exsplus_jump(S, [AS0|AS1], J, N) -> + {_, NS} = exsplus_next(S), + case (J band 1) of + 1 -> + [S0|S1] = S, + exsplus_jump(NS, [(AS0 bxor S0)|(AS1 bxor S1)], J bsr 1, N-1); + 0 -> + exsplus_jump(NS, [AS0|AS1], J bsr 1, N-1) + end. + %% ===================================================================== %% exs1024 PRNG: Xorshift1024* %% Algorithm by Sebastiano Vigna @@ -340,6 +402,64 @@ exs1024_uniform(Max, {Alg, R}) -> {V, R1} = exs1024_next(R), {(V rem Max) + 1, {Alg, R1}}. +%% This is the jump function for the exs1024 generator, equivalent +%% to 2^512 calls to next(); it can be used to generate 2^512 +%% non-overlapping subsequences for parallel computations. +%% Note: the jump function takes ~2000 times of the execution time of +%% next/1. + +%% Jump constant here split into 58 bits for speed +-define(JUMPCONSTHEAD, 16#00242f96eca9c41d). +-define(JUMPCONSTTAIL, + [16#0196e1ddbe5a1561, + 16#0239f070b5837a3c, + 16#03f393cc68796cd2, + 16#0248316f404489af, + 16#039a30088bffbac2, + 16#02fea70dc2d9891f, + 16#032ae0d9644caec4, + 16#0313aac17d8efa43, + 16#02f132e055642626, + 16#01ee975283d71c93, + 16#00552321b06f5501, + 16#00c41d10a1e6a569, + 16#019158ecf8aa1e44, + 16#004e9fc949d0b5fc, + 16#0363da172811fdda, + 16#030e38c3b99181f2, + 16#0000000a118038fc]). +-define(JUMPTOTALLEN, 1024). +-define(RINGLEN, 16). + +-spec exs1024_jump(state()) -> state(). + +exs1024_jump({Alg, {L, RL}}) -> + P = length(RL), + AS = exs1024_jump({L, RL}, + [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0], + ?JUMPCONSTTAIL, ?JUMPCONSTHEAD, ?JUMPELEMLEN, ?JUMPTOTALLEN), + {ASL, ASR} = lists:split(?RINGLEN - P, AS), + {Alg, {ASL, lists:reverse(ASR)}}. + +-spec exs1024_jump(state(), list(non_neg_integer()), + list(non_neg_integer()), non_neg_integer(), + non_neg_integer(), non_neg_integer()) -> list(non_neg_integer()). + +exs1024_jump(_, AS, _, _, _, 0) -> + AS; +exs1024_jump(S, AS, [H|T], _, 0, TN) -> + exs1024_jump(S, AS, T, H, ?JUMPELEMLEN, TN); +exs1024_jump({L, RL}, AS, JL, J, N, TN) -> + {_, NS} = exs1024_next({L, RL}), + case (J band 1) of + 1 -> + AS2 = lists:zipwith(fun(X, Y) -> X bxor Y end, + AS, L ++ lists:reverse(RL)), + exs1024_jump(NS, AS2, JL, J bsr 1, N-1, TN-1); + 0 -> + exs1024_jump(NS, AS, JL, J bsr 1, N-1, TN-1) + end. + %% ===================================================================== %% Ziggurat cont %% ===================================================================== diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl index 3e70450320..c65a13b22e 100644 --- a/lib/stdlib/src/sets.erl +++ b/lib/stdlib/src/sets.erl @@ -128,14 +128,14 @@ is_element(E, S) -> Set2 :: set(Element). add_element(E, S0) -> Slot = get_slot(S0, E), - {S1,Ic} = on_bucket(fun (B0) -> add_bkt_el(E, B0, B0) end, S0, Slot), - maybe_expand(S1, Ic). - --spec add_bkt_el(T, [T], [T]) -> {[T], 0 | 1}. -add_bkt_el(E, [E|_], Bkt) -> {Bkt,0}; -add_bkt_el(E, [_|B], Bkt) -> - add_bkt_el(E, B, Bkt); -add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}. + Bkt = get_bucket(S0, Slot), + case lists:member(E, Bkt) of + true -> + S0; + false -> + S1 = update_bucket(S0, Slot, [E | Bkt]), + maybe_expand(S1) + end. %% del_element(Element, Set) -> Set. %% Return Set but with Element removed. @@ -144,15 +144,28 @@ add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}. Set2 :: set(Element). del_element(E, S0) -> Slot = get_slot(S0, E), - {S1,Dc} = on_bucket(fun (B0) -> del_bkt_el(E, B0) end, S0, Slot), - maybe_contract(S1, Dc). + Bkt = get_bucket(S0, Slot), + case lists:member(E, Bkt) of + false -> + S0; + true -> + S1 = update_bucket(S0, Slot, lists:delete(E, Bkt)), + maybe_contract(S1, 1) + end. --spec del_bkt_el(T, [T]) -> {[T], 0 | 1}. -del_bkt_el(E, [E|Bkt]) -> {Bkt,1}; -del_bkt_el(E, [Other|Bkt0]) -> - {Bkt1,Dc} = del_bkt_el(E, Bkt0), - {[Other|Bkt1],Dc}; -del_bkt_el(_, []) -> {[],0}. +%% update_bucket(Set, Slot, NewBucket) -> UpdatedSet. +%% Replace bucket in Slot by NewBucket +-spec update_bucket(Set1, Slot, Bkt) -> Set2 when + Set1 :: set(Element), + Set2 :: set(Element), + Slot :: non_neg_integer(), + Bkt :: [Element]. +update_bucket(Set, Slot, NewBucket) -> + SegI = ((Slot-1) div ?seg_size) + 1, + BktI = ((Slot-1) rem ?seg_size) + 1, + Segs = Set#set.segs, + Seg = element(SegI, Segs), + Set#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, NewBucket))}. %% union(Set1, Set2) -> Set %% Return the union of Set1 and Set2. @@ -272,19 +285,6 @@ get_slot(T, Key) -> -spec get_bucket(set(), non_neg_integer()) -> term(). get_bucket(T, Slot) -> get_bucket_s(T#set.segs, Slot). -%% on_bucket(Fun, Hashdb, Slot) -> {NewHashDb,Result}. -%% Apply Fun to the bucket in Slot and replace the returned bucket. --spec on_bucket(fun((_) -> {[_], 0 | 1}), set(E), non_neg_integer()) -> - {set(E), 0 | 1}. -on_bucket(F, T, Slot) -> - SegI = ((Slot-1) div ?seg_size) + 1, - BktI = ((Slot-1) rem ?seg_size) + 1, - Segs = T#set.segs, - Seg = element(SegI, Segs), - B0 = element(BktI, Seg), - {B1, Res} = F(B0), %Op on the bucket. - {T#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, B1))},Res}. - %% fold_set(Fun, Acc, Dictionary) -> Dictionary. %% filter_set(Fun, Dictionary) -> Dictionary. @@ -349,8 +349,8 @@ put_bucket_s(Segs, Slot, Bkt) -> Seg = setelement(BktI, element(SegI, Segs), Bkt), setelement(SegI, Segs, Seg). --spec maybe_expand(set(E), 0 | 1) -> set(E). -maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> +-spec maybe_expand(set(E)) -> set(E). +maybe_expand(T0) when T0#set.size + 1 > T0#set.exp_size -> T = maybe_expand_segs(T0), %Do we need more segments. N = T#set.n + 1, %Next slot to expand into Segs0 = T#set.segs, @@ -360,12 +360,12 @@ maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size -> {B1,B2} = rehash(B, Slot1, Slot2, T#set.maxn), Segs1 = put_bucket_s(Segs0, Slot1, B1), Segs2 = put_bucket_s(Segs1, Slot2, B2), - T#set{size = T#set.size + Ic, + T#set{size = T#set.size + 1, n = N, exp_size = N * ?expand_load, con_size = N * ?contract_load, segs = Segs2}; -maybe_expand(T, Ic) -> T#set{size = T#set.size + Ic}. +maybe_expand(T) -> T#set{size = T#set.size + 1}. -spec maybe_expand_segs(set(E)) -> set(E). maybe_expand_segs(T) when T#set.n =:= T#set.maxn -> diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index e917b7ea1f..979161fef7 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -18,9 +18,7 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.* %% Down to - max one major revision back - [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* - {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.* }. diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl index 9176a3664a..d0abe5c961 100644 --- a/lib/stdlib/test/base64_SUITE.erl +++ b/lib/stdlib/test/base64_SUITE.erl @@ -23,9 +23,7 @@ -include_lib("common_test/include/ct.hrl"). %% Test server specific exports --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2, end_per_testcase/2]). +-export([all/0, suite/0, groups/0, group/1]). %% Test cases must be exported. -export([base64_encode/1, base64_decode/1, base64_otp_5635/1, @@ -33,41 +31,26 @@ mime_decode_to_string/1, roundtrip_1/1, roundtrip_2/1, roundtrip_3/1, roundtrip_4/1]). -init_per_testcase(_, Config) -> - Config. - -end_per_testcase(_, _Config) -> - ok. - %%------------------------------------------------------------------------- %% Test cases starts here. %%------------------------------------------------------------------------- + suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,4}}]. -all() -> +all() -> [base64_encode, base64_decode, base64_otp_5635, base64_otp_6279, big, illegal, mime_decode, mime_decode_to_string, {group, roundtrip}]. -groups() -> +groups() -> [{roundtrip, [parallel], [roundtrip_1, roundtrip_2, roundtrip_3, roundtrip_4]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - +group(roundtrip) -> + %% valgrind needs a lot of time + [{timetrap,{minutes,10}}]. %%------------------------------------------------------------------------- %% Test base64:encode/1. @@ -78,9 +61,9 @@ base64_encode(Config) when is_list(Config) -> %% One pad <<"SGVsbG8gV29ybGQ=">> = base64:encode(<<"Hello World">>), %% No pad - "QWxhZGRpbjpvcGVuIHNlc2Ft" = + "QWxhZGRpbjpvcGVuIHNlc2Ft" = base64:encode_to_string("Aladdin:open sesam"), - + "MDEyMzQ1Njc4OSFAIzBeJiooKTs6PD4sLiBbXXt9" = base64:encode_to_string(<<"0123456789!@#0^&*();:<>,. []{}">>), ok. @@ -93,7 +76,7 @@ base64_decode(Config) when is_list(Config) -> %% One pad <<"Hello World">> = base64:decode(<<"SGVsbG8gV29ybGQ=">>), %% No pad - <<"Aladdin:open sesam">> = + <<"Aladdin:open sesam">> = base64:decode("QWxhZGRpbjpvcGVuIHNlc2Ft"), Alphabet = list_to_binary(lists:seq(0, 255)), @@ -208,7 +191,7 @@ mime_decode_to_string(Config) when is_list(Config) -> %% One pad to ignore, followed by more text "Hello World!!" = base64:mime_decode_to_string(<<"SGVsb)(G8gV29ybGQ=h IQ= =">>), %% No pad - "Aladdin:open sesam" = + "Aladdin:open sesam" = base64:mime_decode_to_string("QWxhZGRpbjpvcG¤\")(VuIHNlc2Ft"), %% Encoded base 64 strings may be divided by non base 64 chars. %% In this cases whitespaces. @@ -314,7 +297,7 @@ interleaved_ws_roundtrip_1([], Base64List, Bin, List) -> random_byte_list(0, Acc) -> Acc; -random_byte_list(N, Acc) -> +random_byte_list(N, Acc) -> random_byte_list(N-1, [rand:uniform(255)|Acc]). make_big_binary(N) -> diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 9a14c7014c..f68d5eca3f 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -19,7 +19,7 @@ %% -module(ets_SUITE). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). -export([default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1, privacy/1,privacy_owner/2]). @@ -31,15 +31,14 @@ -export([match_delete3/1]). -export([firstnext/1,firstnext_concurrent/1]). -export([slot/1]). --export([ match1/1, match2/1, match_object/1, match_object2/1]). --export([ dups/1, misc1/1, safe_fixtable/1, info/1, tab2list/1]). --export([ tab2file/1, tab2file2/1, tabfile_ext1/1, - tabfile_ext2/1, tabfile_ext3/1, tabfile_ext4/1, badfile/1]). --export([ heavy_lookup/1, heavy_lookup_element/1, heavy_concurrent/1]). --export([ lookup_element_mult/1]). --export([]). +-export([match1/1, match2/1, match_object/1, match_object2/1]). +-export([dups/1, misc1/1, safe_fixtable/1, info/1, tab2list/1]). +-export([tab2file/1, tab2file2/1, tabfile_ext1/1, + tabfile_ext2/1, tabfile_ext3/1, tabfile_ext4/1, badfile/1]). +-export([heavy_lookup/1, heavy_lookup_element/1, heavy_concurrent/1]). +-export([lookup_element_mult/1]). -export([foldl_ordered/1, foldr_ordered/1, foldl/1, foldr/1, fold_empty/1]). --export([t_delete_object/1, t_init_table/1, t_whitebox/1, +-export([t_delete_object/1, t_init_table/1, t_whitebox/1, t_delete_all_objects/1, t_insert_list/1, t_test_ms/1, t_select_delete/1,t_ets_dets/1]). @@ -61,8 +60,7 @@ -export([otp_7665/1]). -export([meta_wb/1]). -export([grow_shrink/1, grow_pseudo_deleted/1, shrink_pseudo_deleted/1]). --export([ - meta_lookup_unnamed_read/1, meta_lookup_unnamed_write/1, +-export([meta_lookup_unnamed_read/1, meta_lookup_unnamed_write/1, meta_lookup_named_read/1, meta_lookup_named_write/1, meta_newdel_unnamed/1, meta_newdel_named/1]). -export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1, @@ -95,7 +93,7 @@ rename_do/1, rename_unnamed_do/1, interface_equality_do/1, ordered_match_do/1, ordered_do/1, privacy_do/1, empty_do/1, badinsert_do/1, time_lookup_do/1, lookup_order_do/1, lookup_element_mult_do/1, delete_tab_do/1, delete_elem_do/1, - match_delete_do/1, match_delete3_do/1, firstnext_do/1, + match_delete_do/1, match_delete3_do/1, firstnext_do/1, slot_do/1, match1_do/1, match2_do/1, match_object_do/1, match_object2_do/1, misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1, heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1, @@ -129,7 +127,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap,{minutes,5}}]. -all() -> +all() -> [{group, new}, {group, insert}, {group, lookup}, {group, delete}, firstnext, firstnext_concurrent, slot, {group, match}, t_match_spec_run, @@ -161,7 +159,7 @@ all() -> memory_check_summary]. % MUST BE LAST -groups() -> +groups() -> [{new, [], [default, setbag, badnew, verybadnew, named, keypos2, privacy]}, @@ -249,6 +247,7 @@ t_bucket_disappears_do(Opts) -> %% Check ets:match_spec_run/2. t_match_spec_run(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot init_externals(), EtsMem = etsmem(), @@ -703,7 +702,7 @@ adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) -> {A0+TabSz, B0+HTabSz, C0+HTabSz, D0+HTabSz}. %% Misc. whitebox tests -t_whitebox(Config) when is_list(Config) -> +t_whitebox(Config) when is_list(Config) -> EtsMem = etsmem(), repeat_for_opts(whitebox_1), repeat_for_opts(whitebox_1), @@ -1044,6 +1043,7 @@ do_reverse_chunked({L,C},Acc) -> %% Test the ets:select_delete/2 and ets:select_count/2 BIFs. t_select_delete(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot EtsMem = etsmem(), Tables = fill_sets_int(10000) ++ fill_sets_int(10000,[{write_concurrency,true}]), lists:foreach @@ -1489,15 +1489,15 @@ update_element(Config) when is_list(Config) -> verify_etsmem(EtsMem). update_element_opts(Opts) -> - TupleCases = [{{key,val}, 1 ,2}, - {{val,key}, 2, 1}, - {{key,val}, 1 ,[2]}, + TupleCases = [{{key,val}, 1 ,2}, + {{val,key}, 2, 1}, + {{key,val}, 1 ,[2]}, {{key,val,val}, 1, [2,3]}, {{val,key,val,val}, 2, [3,4,1]}, {{val,val,key,val}, 3, [1,4,1,2]}, % update pos1 twice {{val,val,val,key}, 4, [2,1,2,3]}],% update pos2 twice - lists:foreach(fun({Tuple,KeyPos,UpdPos}) -> update_element_opts(Tuple,KeyPos,UpdPos,Opts) end, + lists:foreach(fun({Tuple,KeyPos,UpdPos}) -> update_element_opts(Tuple,KeyPos,UpdPos,Opts) end, TupleCases), update_element_neg(Opts). @@ -1513,9 +1513,9 @@ update_element_opts(Tuple,KeyPos,UpdPos,Opts) -> true = ets:delete(OrdSet), ok. -update_element(T,Tuple,KeyPos,UpdPos) -> +update_element(T,Tuple,KeyPos,UpdPos) -> KeyList = [17,"seventeen",<<"seventeen">>,{17},list_to_binary(lists:seq(1,100)),make_ref(), self()], - lists:foreach(fun(Key) -> + lists:foreach(fun(Key) -> TupleWithKey = setelement(KeyPos,Tuple,Key), update_element_do(T,TupleWithKey,Key,UpdPos) end, @@ -1550,29 +1550,29 @@ update_element_do(Tab,Tuple,Key,UpdPos) -> {Pos, element(ToIx+1,Values)} % single {pos,value} arg end, - UpdateF = fun(ToIx,Rand) -> - PosValArg = PosValArgF(ToIx,[],UpdPos,Rand,PosValArgF), - %%io:format("update_element(~p)~n",[PosValArg]), - ArgHash = erlang:phash2({Tab,Key,PosValArg}), - true = ets:update_element(Tab, Key, PosValArg), - ArgHash = erlang:phash2({Tab,Key,PosValArg}), - NewTuple = update_tuple(PosValArg,Tuple), - [NewTuple] = ets:lookup(Tab,Key) + UpdateF = fun(ToIx,Rand) -> + PosValArg = PosValArgF(ToIx,[],UpdPos,Rand,PosValArgF), + %%io:format("update_element(~p)~n",[PosValArg]), + ArgHash = erlang:phash2({Tab,Key,PosValArg}), + true = ets:update_element(Tab, Key, PosValArg), + ArgHash = erlang:phash2({Tab,Key,PosValArg}), + NewTuple = update_tuple(PosValArg,Tuple), + [NewTuple] = ets:lookup(Tab,Key) end, - LoopF = fun(_FromIx, Incr, _Times, Checksum, _MeF) when Incr >= Length -> + LoopF = fun(_FromIx, Incr, _Times, Checksum, _MeF) when Incr >= Length -> Checksum; % done - (FromIx, Incr, 0, Checksum, MeF) -> + (FromIx, Incr, 0, Checksum, MeF) -> MeF(FromIx, Incr+1, Length, Checksum, MeF); - (FromIx, Incr, Times, Checksum, MeF) -> + (FromIx, Incr, Times, Checksum, MeF) -> ToIx = (FromIx + Incr) rem Length, UpdateF(ToIx,Checksum), - if + if Incr =:= 0 -> UpdateF(ToIx,Checksum); % extra update to same value true -> true - end, + end, MeF(ToIx, Incr, Times-1, Checksum+ToIx+1, MeF) end, @@ -1616,7 +1616,7 @@ update_element_neg_do(T) -> Object = {key, 0, "Hej"}, true = ets:insert(T,Object), - UpdateF = fun(Arg3) -> + UpdateF = fun(Arg3) -> ArgHash = erlang:phash2({T,key,Arg3}), {'EXIT',{badarg,_}} = (catch ets:update_element(T,key,Arg3)), ArgHash = erlang:phash2({T,key,Arg3}), @@ -1691,7 +1691,7 @@ update_counter_for(T) -> true = ets:lookup(T, b) =:= [setelement(1, NewObj, b)], ets:delete(T, b), Myself(NewObj,Times-1,Arg3,Myself) - end, + end, LoopF = fun(Obj, Times, Arg3) -> %%io:format("Loop start:\nObj = ~p\nArg3=~p\n",[Obj,Arg3]), @@ -1800,7 +1800,7 @@ uc_mimic(Obj, [Pits|Tail], Acc) -> uc_adder(Init, {_Pos, Add}) -> Init + Add; -uc_adder(Init, {_Pos, Add, Thres, Warp}) -> +uc_adder(Init, {_Pos, Add, Thres, Warp}) -> case Init + Add of X when X > Thres, Add > 0 -> Warp; @@ -1832,7 +1832,7 @@ update_counter_neg_for(T) -> Object = {key,0,false,1}, true = ets:insert(T,Object), - UpdateF = fun(Arg3) -> + UpdateF = fun(Arg3) -> ArgHash = erlang:phash2({T,key,Arg3}), {'EXIT',{badarg,_}} = (catch ets:update_counter(T,key,Arg3)), ArgHash = erlang:phash2({T,key,Arg3}), @@ -1972,15 +1972,16 @@ fixtable_next_do(Opts) -> verify_etsmem(EtsMem). do_fixtable_next(Tab) -> - F = fun(X,T,FF) -> case X of - 0 -> true; - _ -> - ets:insert(T, {X, - integer_to_list(X), - X rem 10}), - FF(X-1,T,FF) - end - end, + F = fun(X,T,FF) -> + case X of + 0 -> true; + _ -> + ets:insert(T, {X, + integer_to_list(X), + X rem 10}), + FF(X-1,T,FF) + end + end, F(100,Tab,F), ets:safe_fixtable(Tab,true), First = ets:first(Tab), @@ -1995,7 +1996,7 @@ do_fixtable_next(Tab) -> %% Check inserts of deleted keys in fixed bags. fixtable_insert(Config) when is_list(Config) -> - Combos = [[Type,{write_concurrency,WC}] || Type<- [bag,duplicate_bag], + Combos = [[Type,{write_concurrency,WC}] || Type<- [bag,duplicate_bag], WC <- [false,true]], lists:foreach(fun(Opts) -> fixtable_insert_do(Opts) end, Combos), @@ -2111,7 +2112,7 @@ heir_do(Opts) -> %% Different types of heir data and link/monitor relations TestFun = fun(Arg) -> {EtsMem,Arg} end, - Combos = [{Data,Mode} || Data<-[foo_data, <<"binary">>, + Combos = [{Data,Mode} || Data<-[foo_data, <<"binary">>, lists:seq(1,10), {17,TestFun,self()}, "The busy heir"], Mode<-[none,link,monitor]], @@ -2151,7 +2152,7 @@ heir_do(Opts) -> Founder4 ! {go, Heir4}, {'DOWN', MrefH4, process, Heir4, normal} = receive_any(), erts_debug:set_internal_state(next_pid, NextPidIx), - DoppelGanger = spawn_monitor_with_pid(Heir4, + DoppelGanger = spawn_monitor_with_pid(Heir4, fun()-> die_please = receive_any() end), Founder4 ! die_please, {'DOWN', MrefF4, process, Founder4, normal} = receive_any(), @@ -2164,12 +2165,12 @@ heir_do(Opts) -> failed -> io:format("Failed to spawn process with pid ~p\n", [Heir4]), true % try again - end + end end), verify_etsmem(EtsMem). -heir_founder(Master, HeirData, Opts) -> +heir_founder(Master, HeirData, Opts) -> {go,Heir} = receive_any(), HeirTpl = case Heir of none -> {heir,none}; @@ -2242,7 +2243,7 @@ heir_1(HeirData,Mode,Opts) -> {'DOWN', Mref, process, Heir, normal} = receive_any(). %% Test ets:give_way/3. -give_away(Config) when is_list(Config) -> +give_away(Config) when is_list(Config) -> repeat_for_opts(give_away_do). give_away_do(Opts) -> @@ -2381,7 +2382,7 @@ bad_table(Config) when is_list(Config) -> ok. bad_table_do(Opts, DummyFile) -> - Parent = self(), + Parent = self(), {Pid,Mref} = my_spawn_opt(fun()-> ets_new(priv,[private,named_table | Opts]), Priv = ets_new(priv,[private | Opts]), ets_new(prot,[protected,named_table | Opts]), @@ -2436,7 +2437,7 @@ bad_table_do(Opts, DummyFile) -> ], Info = {Opts, Priv, Prot}, lists:foreach(fun(Op) -> bad_table_op(Info, Op) end, - OpList), + OpList), Pid ! die_please, {'DOWN', Mref, process, Pid, normal} = receive_any(), ok. @@ -2571,14 +2572,14 @@ interface_equality_do(Opts) -> Set = ets_new(set,[set | Opts]), OrderedSet = ets_new(ordered_set,[ordered_set | Opts]), F = fun(X,T,FF) -> case X of - 0 -> true; - _ -> - ets:insert(T, {X, - integer_to_list(X), - X rem 10}), - FF(X-1,T,FF) - end - end, + 0 -> true; + _ -> + ets:insert(T, {X, + integer_to_list(X), + X rem 10}), + FF(X-1,T,FF) + end + end, F(100,Set,F), F(100,OrderedSet,F), equal_results(ets, insert, Set, OrderedSet, [{a,"a"}]), @@ -2647,20 +2648,20 @@ ordered_match_do(Opts) -> F(3000,T1,F), [[3,3],[3,3],[3,3]] = ets:match(T1, {'_','_','$1','$2',3}), F2 = fun(X,Rem,Res,FF) -> case X of - 0 -> []; - _ -> + 0 -> []; + _ -> case X rem Rem of Res -> FF(X-1,Rem,Res,FF) ++ [{X, - integer_to_list(X), + integer_to_list(X), X rem 10, X rem 100, X rem 1000}]; _ -> FF(X-1,Rem,Res,FF) end - end + end end, OL1 = F2(3000,100,2,F2), OL1 = ets:match_object(T1, {'_','_','_',2,'_'}), @@ -2738,7 +2739,7 @@ pick_all_backwards(T) -> %% Small test case for both set and bag type ets tables. -setbag(Config) when is_list(Config) -> +setbag(Config) when is_list(Config) -> EtsMem = etsmem(), Set = ets_new(set,[set]), Bag = ets_new(bag,[bag]), @@ -2815,7 +2816,7 @@ privacy_do(Opts) -> privacy_check(pub,prot,priv), - Owner ! {shift,1,{pub,prot,priv}}, + Owner ! {shift,1,{pub,prot,priv}}, receive {Pub1,Prot1,Priv1} -> ok = privacy_check(Pub1,Prot1,Priv1), @@ -2954,7 +2955,7 @@ badlookup(Config) when is_list(Config) -> verify_etsmem(EtsMem). %% Test that lookup returns objects in order of insertion for bag and dbag. -lookup_order(Config) when is_list(Config) -> +lookup_order(Config) when is_list(Config) -> EtsMem = etsmem(), repeat_for_opts(lookup_order_do, [write_concurrency,[bag,duplicate_bag]]), verify_etsmem(EtsMem), @@ -2976,7 +2977,7 @@ lookup_order_2(Opts, Fixed) -> case Fixed of true -> ets:safe_fixtable(T,true); false -> ok - end, + end, S10 = {T,[],key}, S20 = check_insert(S10,A), S30 = check_insert(S20,B), @@ -2988,7 +2989,7 @@ lookup_order_2(Opts, Fixed) -> S80 = check_delete(S70,D2b), S90 = check_insert(S80,D2a), SA0 = check_delete(S90,D3a), - SB0 = check_delete(SA0,D3b), + SB0 = check_delete(SA0,D3b), check_insert_new(SB0,D3b), true = ets:delete(T) @@ -3001,7 +3002,7 @@ check_insert({T,List0,Key},Val) -> ets:insert(T,{Key,Val}), List1 = case (ets:info(T,type) =:= bag andalso lists:member({Key,Val},List0)) of - true -> List0; + true -> List0; false -> [{Key,Val} | List0] end, check_check({T,List1,Key}). @@ -3034,8 +3035,6 @@ check_check(S={T,List,Key}) -> Items = length(List), S. - - fill_tab(Tab,Val) -> ets:insert(Tab,{key,Val}), ets:insert(Tab,{{a,144},Val}), @@ -3063,13 +3062,11 @@ lookup_element_mult_do(Opts) -> verify_etsmem(EtsMem). lem_data() -> - [ - {service,'eddie2@boromir',{150,236,14,103},httpd88,self()}, + [{service,'eddie2@boromir',{150,236,14,103},httpd88,self()}, {service,'eddie2@boromir',{150,236,14,103},httpd80,self()}, {service,'eddie3@boromir',{150,236,14,107},httpd88,self()}, {service,'eddie3@boromir',{150,236,14,107},httpd80,self()}, - {service,'eddie4@boromir',{150,236,14,108},httpd88,self()} - ]. + {service,'eddie4@boromir',{150,236,14,108},httpd88,self()}]. lem_crash(T) -> L = ets:lookup_element(T, 'eddie2@boromir', 3), @@ -3120,6 +3117,7 @@ delete_tab_do(Opts) -> %% Check that ets:delete/1 works and that other processes can run. delete_large_tab(Config) when is_list(Config) -> + ct:timetrap({minutes,30}), %% valgrind needs a lot Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 200000)], EtsMem = etsmem(), repeat_for_opts(fun(Opts) -> delete_large_tab_do(Opts,Data) end), @@ -3142,7 +3140,7 @@ delete_large_tab_1(Name, Flags, Data, Fix) -> lists:foreach(fun({K,_}) -> ets:delete(Tab, K) end, Data) end, - {priority, Prio} = process_info(self(), priority), + {priority, Prio} = process_info(self(), priority), Deleter = self(), [SchedTracer] = start_loopers(1, @@ -3189,7 +3187,7 @@ delete_large_tab_1(Name, Flags, Data, Fix) -> %% Delete a large name table and try to create a new table with %% the same name in another process. -delete_large_named_table(Config) when is_list(Config) -> +delete_large_named_table(Config) when is_list(Config) -> Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 200000)], EtsMem = etsmem(), repeat_for_opts(fun(Opts) -> delete_large_named_table_do(Opts,Data) end), @@ -3562,7 +3560,7 @@ dyn_lookup(T) -> dyn_lookup(T, ets:first(T)). dyn_lookup(_T, '$end_of_table') -> []; dyn_lookup(T, K) -> - NextKey=ets:next(T,K), + NextKey = ets:next(T,K), case ets:next(T,K) of NextKey -> dyn_lookup(T, NextKey); @@ -4081,9 +4079,9 @@ tabfile_ext2_do(Opts,Config) -> Name = make_ref(), [ets:insert(T,{X,integer_to_list(X)}) || X <- L], ok = ets:tab2file(T,FName,[{extended_info,[md5sum]}]), - true = lists:sort(ets:tab2list(T)) =:= + true = lists:sort(ets:tab2list(T)) =:= lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))), - true = lists:sort(ets:tab2list(T)) =:= + true = lists:sort(ets:tab2list(T)) =:= lists:sort(ets:tab2list( element(2,ets:file2tab(FName,[{verify,true}])))), {ok, Name} = disk_log:open([{name,Name},{file,FName}]), @@ -4098,9 +4096,9 @@ tabfile_ext2_do(Opts,Config) -> ets:tab2list( element(2,ets:file2tab(FName2)))), {error,checksum_error} = ets:file2tab(FName2,[{verify,true}]), - {value,{extended_info,[md5sum]}} = + {value,{extended_info,[md5sum]}} = lists:keysearch(extended_info,1,element(2,ets:tabfile_info(FName2))), - {value,{extended_info,[md5sum]}} = + {value,{extended_info,[md5sum]}} = lists:keysearch(extended_info,1,element(2,ets:tabfile_info(FName))), file:delete(FName), file:delete(FName2), @@ -4145,15 +4143,14 @@ tabfile_ext4(Config) when is_list(Config) -> Name2 = make_ref(), [ets:insert(TL,{X,integer_to_list(X)}) || X <- LL], ok = ets:tab2file(TL,FName,[{extended_info,[md5sum]}]), - {ok, Name2} = disk_log:open([{name, Name2}, {file, FName}, + {ok, Name2} = disk_log:open([{name, Name2}, {file, FName}, {mode, read_only}]), {C,[_|_]} = disk_log:chunk(Name2,start), {_,[_|_]} = disk_log:chunk(Name2,C), disk_log:close(Name2), - true = lists:sort(ets:tab2list(TL)) =:= + true = lists:sort(ets:tab2list(TL)) =:= lists:sort(ets:tab2list(element(2,ets:file2tab(FName)))), - Res = [ - begin + Res = [begin {ok,FD} = file:open(FName,[binary,read,write]), {ok, Bin} = file:pread(FD,0,1000), <<B1:N/binary,Ch:8,B2/binary>> = Bin, @@ -4163,7 +4160,7 @@ tabfile_ext4(Config) when is_list(Config) -> ok = file:close(FD), X = case ets:file2tab(FName) of {ok,TL2} -> - true = lists:sort(ets:tab2list(TL)) =/= + true = lists:sort(ets:tab2list(TL)) =/= lists:sort(ets:tab2list(TL2)); _ -> totally_broken @@ -4171,7 +4168,7 @@ tabfile_ext4(Config) when is_list(Config) -> {error,Y} = ets:file2tab(FName,[{verify,true}]), ets:tab2file(TL,FName,[{extended_info,[md5sum]}]), {X,Y} - end || N <- lists:seq(500,600) ], + end || N <- lists:seq(500,600)], io:format("~p~n",[Res]), file:delete(FName), ok. @@ -4402,16 +4399,14 @@ member_do(Opts) -> build_table(L1,L2,Num) -> - T = ets_new(xxx, [ordered_set] - ), + T = ets_new(xxx, [ordered_set]), lists:foreach( fun(X1) -> lists:foreach( fun(X2) -> F = fun(FF,N) -> - ets:insert(T,{{X1,X2,N}, - X1, X2, N}), - case N of + ets:insert(T,{{X1,X2,N}, X1, X2, N}), + case N of 0 -> ok; _ -> @@ -4424,16 +4419,14 @@ build_table(L1,L2,Num) -> T. build_table2(L1,L2,Num) -> - T = ets_new(xxx, [ordered_set] - ), + T = ets_new(xxx, [ordered_set]), lists:foreach( fun(X1) -> lists:foreach( fun(X2) -> F = fun(FF,N) -> - ets:insert(T,{{N,X1,X2}, - N, X1, X2}), - case N of + ets:insert(T,{{N,X1,X2}, N, X1, X2}), + case N of 0 -> ok; _ -> @@ -4724,7 +4717,7 @@ del_one_by_one_dbag_3(T,From,To) -> N = (ets:info(T,size) + 1), Obj2 = {From, integer_to_list(From)}, ets:delete_object(T,Obj2), - N = (ets:info(T,size) + 2) + N = (ets:info(T,size) + 2) end, Next = if From < To -> @@ -4771,14 +4764,14 @@ gen_dets_filename(Config,N) -> filename:join(proplists:get_value(priv_dir,Config), "testdets_" ++ integer_to_list(N) ++ ".dets"). -otp_6842_select_1000(Config) when is_list(Config) -> +otp_6842_select_1000(Config) when is_list(Config) -> Tab = ets_new(xxx,[ordered_set]), [ets:insert(Tab,{X,X}) || X <- lists:seq(1,10000)], AllTrue = lists:duplicate(10,true), AllTrue = [ length( element(1, - ets:select(Tab,[{'_',[],['$_']}],X*1000))) =:= + ets:select(Tab,[{'_',[],['$_']}],X*1000))) =:= X*1000 || X <- lists:seq(1,10) ], Sequences = [[1000,1000,1000,1000,1000,1000,1000,1000,1000,1000], [2000,2000,2000,2000,2000], @@ -4804,7 +4797,13 @@ check_seq(A,B,C) -> false. otp_6338(Config) when is_list(Config) -> - L = binary_to_term(<<131,108,0,0,0,2,104,2,108,0,0,0,2,103,100,0,19,112,112,98,49,95,98,115,49,50,64,98,108,97,100,101,95,48,95,53,0,0,33,50,0,0,0,4,1,98,0,0,23,226,106,100,0,4,101,120,105,116,104,2,108,0,0,0,2,104,2,100,0,3,115,98,109,100,0,19,112,112,98,50,95,98,115,49,50,64,98,108,97,100,101,95,48,95,56,98,0,0,18,231,106,100,0,4,114,101,99,118,106>>), + L = binary_to_term(<<131,108,0,0,0,2,104,2,108,0,0,0,2,103,100,0,19,112,112, + 98,49,95,98,115,49,50,64,98,108,97,100,101,95,48,95,53, + 0,0,33,50,0,0,0,4,1,98,0,0,23,226,106,100,0,4,101,120, + 105,116,104,2,108,0,0,0,2,104,2,100,0,3,115,98,109,100, + 0,19,112,112,98,50,95,98,115,49,50,64,98,108,97,100, + 101,95,48,95,56,98,0,0,18,231,106,100,0,4,114,101,99, + 118,106>>), T = ets_new(xxx,[ordered_set]), lists:foreach(fun(X) -> ets:insert(T,X) end,L), [[4839,recv]] = ets:match(T,{[{sbm,ppb2_bs12@blade_0_8},'$1'],'$2'}), @@ -4823,7 +4822,7 @@ otp_5340_do(Opts) -> ets:delete(T). w(_,0, _) -> ok; -w(T,N, Id) -> +w(T,N, Id) -> ets:insert(T, {N, Id}), w(T,N-1,Id). @@ -4913,7 +4912,7 @@ meta_wb_new(Name, _, Tabs, Opts) -> case (catch ets_new(Name,[named_table|Opts])) of Name -> false = lists:member(Name, Tabs), - [Name | Tabs]; + [Name | Tabs]; {'EXIT',{badarg,_}} -> true = lists:member(Name, Tabs), Tabs @@ -5088,7 +5087,7 @@ meta_lookup_unnamed_read(Config) when is_list(Config) -> Tab end, ExecF = fun(Tab) -> [{key,data}] = ets:lookup(Tab,key), - Tab + Tab end, FiniF = fun(Tab) -> true = ets:delete(Tab) end, @@ -5112,7 +5111,7 @@ meta_lookup_named_read(Config) when is_list(Config) -> Tab end, ExecF = fun(Tab) -> [{key,data}] = ets:lookup(Tab,key), - Tab + Tab end, FiniF = fun(Tab) -> true = ets:delete(Tab) end, @@ -5171,9 +5170,9 @@ smp_fixed_delete_do() -> ets:safe_fixtable(T,true), Buckets = num_of_buckets(T), InitF = fun([ProcN,NumOfProcs|_]) -> {ProcN,NumOfProcs} end, - ExecF = fun({Key,_}) when Key > NumOfObjs -> + ExecF = fun({Key,_}) when Key > NumOfObjs -> [end_of_work]; - ({Key,Increment}) -> + ({Key,Increment}) -> true = ets:delete(T,Key), {Key+Increment,Increment} end, @@ -5202,7 +5201,7 @@ smp_unfix_fix_do() -> T = ets_new(foo,[public,{write_concurrency,true}]), %%Mem = ets:info(T,memory), NumOfObjs = 100000, - Deleted = 50000, + Deleted = 50000, filltabint(T,NumOfObjs), ets:safe_fixtable(T,true), Buckets = num_of_buckets(T), @@ -5215,7 +5214,7 @@ smp_unfix_fix_do() -> true = ets:info(T,fixed), Deleted = get_kept_objects(T), - {Child, Mref} = + {Child, Mref} = my_spawn_opt( fun()-> true = ets:info(T,fixed), @@ -5274,22 +5273,19 @@ otp_8166_do(WC) -> NumOfObjs = 3000, %% Need more than 1000 live objects for match_object to trap one time Deleted = NumOfObjs div 2, filltabint(T,NumOfObjs), - {ReaderPid, ReaderMref} = - my_spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, - [link, monitor, {scheduler,2}]), - {ZombieCrPid, ZombieCrMref} = - my_spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, - [link, monitor, {scheduler,3}]), + {ReaderPid, ReaderMref} = my_spawn_opt(fun()-> otp_8166_reader(T,NumOfObjs) end, + [link, monitor, {scheduler,2}]), + {ZombieCrPid, ZombieCrMref} = my_spawn_opt(fun()-> otp_8166_zombie_creator(T,Deleted) end, + [link, monitor, {scheduler,3}]), repeat(fun() -> ZombieCrPid ! {loop, self()}, zombies_created = receive_any(), otp_8166_trapper(T, 10, ZombieCrPid) - end, - 100), + end, 100), ReaderPid ! quit, {'DOWN', ReaderMref, process, ReaderPid, normal} = receive_any(), - ZombieCrPid ! quit, + ZombieCrPid ! quit, {'DOWN', ZombieCrMref, process, ZombieCrPid, normal} = receive_any(), false = ets:info(T,fixed), 0 = get_kept_objects(T), @@ -5299,7 +5295,7 @@ otp_8166_do(WC) -> %% Keep reading the table otp_8166_reader(T, NumOfObjs) -> - repeat_while(fun(0) -> + repeat_while(fun(0) -> receive quit -> {false,done} after 0 -> {true,NumOfObjs} end; @@ -5313,14 +5309,14 @@ otp_8166_reader(T, NumOfObjs) -> otp_8166_trapper(T, Try, ZombieCrPid) -> [] = ets:match_object(T,{'_',"Pink Unicorn"}), case {ets:info(T,fixed),Try} of - {true,1} -> + {true,1} -> io:format("failed to provoke unsafe unfix, give up...\n",[]), ZombieCrPid ! unfix; - {true,_} -> + {true,_} -> io:format("trapper too fast, trying again...\n",[]), otp_8166_trapper(T, Try-1, ZombieCrPid); {false,_} -> done - end. + end. %% Fixate table and create some pseudo-deleted objects (zombies) @@ -5340,7 +5336,7 @@ otp_8166_zombie_creator(T,Deleted) -> repeat_while(fun() -> case ets:info(T,safe_fixed_monotonic_time) of {_,[_P1,_P2]} -> false; - _ -> + _ -> receive unfix -> false after 0 -> true end @@ -5397,7 +5393,7 @@ smp_select_delete(Config) when is_list(Config) -> Mod = 17, Zeros = erlang:make_tuple(Mod,0), InitF = fun(_) -> Zeros end, - ExecF = fun(Diffs0) -> + ExecF = fun(Diffs0) -> case rand:uniform(20) of 1 -> Mod = 17, @@ -5419,7 +5415,7 @@ smp_select_delete(Config) when is_list(Config) -> Diffs1; false -> Diffs0 end - end + end end, FiniF = fun(Result) -> Result end, Results = run_workers_do(InitF,ExecF,FiniF,20000), @@ -5430,7 +5426,7 @@ smp_select_delete(Config) when is_list(Config) -> 0, TotCnts), io:format("LeftInTab = ~p\n",[LeftInTab]), LeftInTab = ets:info(T,size), - lists:foldl(fun(Cnt,Eq) -> + lists:foldl(fun(Cnt,Eq) -> WasCnt = ets:select_count(T, [{{'_', '$1'}, [{'=:=', {'rem', '$1', Mod}, Eq}], @@ -5438,7 +5434,7 @@ smp_select_delete(Config) when is_list(Config) -> io:format("~p: ~p =?= ~p\n",[Eq,Cnt,WasCnt]), Cnt = WasCnt, Eq+1 - end, + end, 0, TotCnts), %% May fail as select_delete does not shrink table (enough) %%verify_table_load(T), @@ -5477,8 +5473,8 @@ types_do(Opts) -> %% OTP-9932: Memory overwrite when inserting large integers in compressed bag. %% Will crash with segv on 64-bit opt if not fixed. otp_9932(Config) when is_list(Config) -> - T = ets:new(xxx, [bag, compressed]), - Fun = fun(N) -> + T = ets:new(xxx, [bag, compressed]), + Fun = fun(N) -> Key = {1316110174588445 bsl N,1316110174588583 bsl N}, S = {Key, Key}, true = ets:insert(T, S), @@ -5494,9 +5490,9 @@ otp_9932(Config) when is_list(Config) -> %% write_concurrency table. otp_9423(Config) when is_list(Config) -> InitF = fun(_) -> {0,0} end, - ExecF = fun({S,F}) -> - receive - stop -> + ExecF = fun({S,F}) -> + receive + stop -> io:format("~p got stop\n", [self()]), [end_of_work | {"Succeded=",S,"Failed=",F}] after 0 -> @@ -5592,12 +5588,12 @@ take(Config) when is_list(Config) -> %% Utility functions: %% -add_lists(L1,L2) -> +add_lists(L1,L2) -> add_lists(L1,L2,[]). add_lists([],[],Acc) -> lists:reverse(Acc); add_lists([E1|T1], [E2|T2], Acc) -> - add_lists(T1, T2, [E1+E2 | Acc]). + add_lists(T1, T2, [E1+E2 | Acc]). run_workers(InitF,ExecF,FiniF,Laps) -> run_workers(InitF,ExecF,FiniF,Laps, 0). @@ -5643,9 +5639,9 @@ worker_loop(infinite, ExecF, State) -> worker_loop(N, ExecF, State) -> worker_loop(N-1,ExecF,ExecF(State)). -wait_pids(Pids) -> +wait_pids(Pids) -> wait_pids(Pids,[]). -wait_pids([],Acc) -> +wait_pids([],Acc) -> Acc; wait_pids(Pids, Acc) -> receive @@ -5682,7 +5678,7 @@ etsmem() -> wait_for_memory_deallocations(), AllTabs = lists:map(fun(T) -> {T,ets:info(T,name),ets:info(T,size), - ets:info(T,memory),ets:info(T,type)} + ets:info(T,memory),ets:info(T,type)} end, ets:all()), EtsAllocInfo = erlang:system_info({allocator,ets_alloc}), @@ -5912,7 +5908,7 @@ receive_any() -> receive_any_spinning() -> receive_any_spinning(1000000). receive_any_spinning(Loops) -> - receive_any_spinning(Loops,Loops,1). + receive_any_spinning(Loops,Loops,1). receive_any_spinning(Loops,0,Tries) -> receive M -> io:format("Spinning process ~p got msg ~p after ~p tries\n", [self(),M,Tries]), diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 300baaf1c6..8f2ba0cab2 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -742,26 +742,40 @@ state_timeout(_Config) -> %% Verify that {state_timeout,0,_} %% comes after next_event and that %% {timeout,0,_} is cancelled by - %% {state_timeout,0,_} + %% pending {state_timeout,0,_} {keep_state, {ok,2,Data}, [{timeout,0,3}]}; - (state_timeout, 2, {ok,2,{Time,From}}) -> - {next_state, state3, 3, + (state_timeout, 2, {ok,2,Data}) -> + %% Verify that timeout 0's are processed + %% in order + {keep_state, {ok,3,Data}, + [{timeout,0,4},{state_timeout,0,5}]}; + (timeout, 4, {ok,3,Data}) -> + %% Verify that timeout 0 is cancelled by + %% enqueued state_timeout 0 and that + %% multiple state_timeout 0 can be enqueued + {keep_state, {ok,4,Data}, + [{state_timeout,0,6},{timeout,0,7}]}; + (state_timeout, 5, {ok,4,Data}) -> + {keep_state, {ok,5,Data}}; + (state_timeout, 6, {ok,5,{Time,From}}) -> + {next_state, state3, 6, [{reply,From,ok}, - {state_timeout,Time,3}]} + {state_timeout,Time,8}]} end, state3 => fun - (info, message_to_self, 3) -> - {keep_state, '3'}; - ({call,From}, check, '3') -> + (info, message_to_self, 6) -> + {keep_state, 7}; + ({call,From}, check, 7) -> {keep_state, From}; - (state_timeout, 3, From) -> + (state_timeout, 8, From) -> {stop_and_reply, normal, {reply,From,ok}} end}, {ok,STM} = gen_statem:start_link(?MODULE, {map_statem,Machine,[]}, []), + sys:trace(STM, true), TRef = erlang:start_timer(1000, self(), kull), ok = gen_statem:call(STM, {go,500}), ok = gen_statem:call(STM, check), diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl index cb778c96d4..8e7ac223a7 100644 --- a/lib/stdlib/test/rand_SUITE.erl +++ b/lib/stdlib/test/rand_SUITE.erl @@ -18,13 +18,18 @@ %% %CopyrightEnd% -module(rand_SUITE). --export([all/0, suite/0,groups/0]). +-compile({nowarn_deprecated_function,[{random,seed,1}, + {random,uniform_s,1}, + {random,uniform_s,2}]}). + +-export([all/0, suite/0, groups/0, group/1]). -export([interval_int/1, interval_float/1, seed/1, api_eq/1, reference/1, basic_stats_uniform_1/1, basic_stats_uniform_2/1, basic_stats_normal/1, - plugin/1, measure/1]). + plugin/1, measure/1, + reference_jump_state/1, reference_jump_procdict/1]). -export([test/0, gen/1]). @@ -41,24 +46,35 @@ all() -> api_eq, reference, {group, basic_stats}, - plugin, measure]. + plugin, measure, + {group, reference_jump} + ]. groups() -> [{basic_stats, [parallel], - [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}]. + [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}, + {reference_jump, [parallel], + [reference_jump_state, reference_jump_procdict]}]. + +group(basic_stats) -> + %% valgrind needs a lot of time + [{timetrap,{minutes,10}}]; +group(reference_jump) -> + %% valgrind needs a lot of time + [{timetrap,{minutes,10}}]. %% A simple helper to test without test_server during dev test() -> Tests = all(), lists:foreach(fun(Test) -> - try - ok = ?MODULE:Test([]), - io:format("~p: ok~n", [Test]) - catch _:Reason -> - io:format("Failed: ~p: ~p ~p~n", - [Test, Reason, erlang:get_stacktrace()]) - end - end, Tests). + try + ok = ?MODULE:Test([]), + io:format("~p: ok~n", [Test]) + catch _:Reason -> + io:format("Failed: ~p: ~p ~p~n", + [Test, Reason, erlang:get_stacktrace()]) + end + end, Tests). algs() -> [exs64, exsplus, exs1024]. @@ -220,7 +236,7 @@ interval_float_1(N) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Check if exs64 algorithm generates the proper sequence. +%% Check if each algorithm generates the proper sequence. reference(Config) when is_list(Config) -> [reference_1(Alg) || Alg <- algs()], ok. @@ -234,7 +250,7 @@ reference_1(Alg) -> io:format("Failed: ~p~n",[Alg]), io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), - ok + exit(wrong_value) end. gen(Algo) -> @@ -426,6 +442,112 @@ measure_2(N, State0, Fun) when N > 0 -> measure_2(0, _, _) -> ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% The jump sequence tests has two parts +%% for those with the functional API (jump/1) +%% and for those with the internal state +%% in process dictionary (jump/0). + +-define(LOOP_JUMP, (?LOOP div 1000)). + +%% Check if each algorithm generates the proper jump sequence +%% with the functional API. +reference_jump_state(Config) when is_list(Config) -> + [reference_jump_1(Alg) || Alg <- algs()], + ok. + +reference_jump_1(Alg) -> + Refval = reference_jump_val(Alg), + Testval = gen_jump_1(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + exit(wrong_value) + end. + +gen_jump_1(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed_s({exsplus, [12345678|12345678]}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed_s({exs1024, {lists:duplicate(16, 12345678), []}}); + exs64 -> %% Test exception of not_implemented notice + try rand:jump(rand:seed_s(exs64)) + catch + error:not_implemented -> not_implemented + end; + _ -> % unimplemented + not_implemented + end, + case Seed of + not_implemented -> [not_implemented]; + S -> gen_jump_1(?LOOP_JUMP, S, []) + end. + +gen_jump_1(N, State0 = {#{max:=Max}, _}, Acc) when N > 0 -> + {_, State1} = rand:uniform_s(Max, State0), + {Random, State2} = rand:uniform_s(Max, rand:jump(State1)), + case N rem (?LOOP_JUMP div 100) of + 0 -> gen_jump_1(N-1, State2, [Random|Acc]); + _ -> gen_jump_1(N-1, State2, Acc) + end; +gen_jump_1(_, _, Acc) -> lists:reverse(Acc). + +%% Check if each algorithm generates the proper jump sequence +%% with the internal state in the process dictionary. +reference_jump_procdict(Config) when is_list(Config) -> + [reference_jump_0(Alg) || Alg <- algs()], + ok. + +reference_jump_0(Alg) -> + Refval = reference_jump_val(Alg), + Testval = gen_jump_0(Alg), + case Refval =:= Testval of + true -> ok; + false -> + io:format("Failed: ~p~n",[Alg]), + io:format("Length ~p ~p~n",[length(Refval), length(Testval)]), + io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]), + exit(wrong_value) + end. + +gen_jump_0(Algo) -> + Seed = case Algo of + exsplus -> %% Printed with orig 'C' code and this seed + rand:seed({exsplus, [12345678|12345678]}); + exs1024 -> %% Printed with orig 'C' code and this seed + rand:seed({exs1024, {lists:duplicate(16, 12345678), []}}); + exs64 -> %% Test exception of not_implemented notice + try + _ = rand:seed(exs64), + rand:jump() + catch + error:not_implemented -> not_implemented + end; + _ -> % unimplemented + not_implemented + end, + case Seed of + not_implemented -> [not_implemented]; + S -> + {Seedmap=#{}, _} = S, + Max = maps:get(max, Seedmap), + gen_jump_0(?LOOP_JUMP, Max, []) + end. + +gen_jump_0(N, Max, Acc) when N > 0 -> + _ = rand:uniform(Max), + _ = rand:jump(), + Random = rand:uniform(Max), + case N rem (?LOOP_JUMP div 100) of + 0 -> gen_jump_0(N-1, Max, [Random|Acc]); + _ -> gen_jump_0(N-1, Max, Acc) + end; +gen_jump_0(_, _, Acc) -> lists:reverse(Acc). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Data reference_val(exs64) -> [16#3737ad0c703ff6c3,16#3868a78fe71adbbd,16#1f01b62b4338b605,16#50876a917437965f, @@ -507,3 +629,61 @@ reference_val(exsplus) -> 16#36f715a249f4ec2,16#1c27629826c50d3,16#914d9a6648726a,16#27f5bf5ce2301e8, 16#3dd493b8012970f,16#be13bed1e00e5c,16#ceef033b74ae10,16#3da38c6a50abe03, 16#15cbd1a421c7a8c,16#22794e3ec6ef3b1,16#26154d26e7ea99f,16#3a66681359a6ab6]. + +%%% + +reference_jump_val(exsplus) -> + [82445318862816932, 145810727464480743, 16514517716894509, 247642377064868650, + 162385642339156908, 251810707075252101, 82288275771998924, 234412731596926322, + 49960883129071044, 200690077681656596, 213743196668671647, 131182800982967108, + 144200072021941728, 263557425008503277, 194858522616874272, 185869394820993172, + 80384502675241453, 262654144824057588, 90033295011291362, 4494510449302659, + 226005372746479588, 116780561309220553, 47048528594475843, 39168929349768743, + 139615163424415552, 55330632656603925, 237575574720486569, 102381140288455025, + 18452933910354323, 150248612130579752, 269358096791922740, 61313433522002187, + 160327361842676597, 185187983548528938, 57378981505594193, 167510799293984067, + 105117045862954303, 176126685946302943, 123590876906828803, 69185336947273487, + 9098689247665808, 49906154674145057, 131575138412788650, 161843880211677185, + 30743946051071186, 187578920583823612, 45008401528636978, 122454158686456658, + 111195992644229524, 17962783958752862, 13579507636941108, 130137843317798663, + 144202635170576832, 132539563255093922, 159785575703967124, 187241848364816640, + 183044737781926478, 12921559769912263, 83553932242922001, 96698298841984688, + 281664320227537824, 224233030818578263, 77812932110318774, 169729351013291728, + 164475402723178734, 242780633011249051, 51095111179609125, 19249189591963554, + 221412426221439180, 265700202856282653, 265342254311932308, 241218503498385511, + 255400887248486575, 212083616929812076, 227947034485840579, 268261881651571692, + 104846262373404908, 49690734329496661, 213259196633566308, 186966479726202436, + 282157378232384574, 11272948584603747, 166540426999573480, 50628164001018755, + 65235580992800860, 230664399047956956, 64575592354687978, 40519393736078511, + 108341851194332747, 115426411532008961, 120656817002338193, 234537867870809797, + 12504080415362731, 45083100453836317, 270968267812126657, 93505647407734103, + 252852934678537969, 258758309277167202, 74250882143432077, 141629095984552833]; + +reference_jump_val(exs1024) -> + [2655961906500790629, 17003395417078685063, 10466831598958356428, 7603399148503548021, + 1650550950190587188, 12294992315080723704, 15743995773860389219, 5492181000145247327, + 14118165228742583601, 1024386975263610703, 10124872895886669513, 6445624517813169301, + 6238575554686562601, 14108646153524288915, 11804141635807832816, 8421575378006186238, + 6354993374304550369, 838493020029548163, 14759355804308819469, 12212491527912522022, + 16943204735100571602, 198964074252287588, 7325922870779721649, 15853102065526570574, + 16294058349151823341, 6153379962047409781, 15874031679495957261, 17299265255608442340, + 984658421210027171, 17408042033939375278, 3326465916992232353, 5222817718770538733, + 13262385796795170510, 15648751121811336061, 6718721549566546451, 7353765235619801875, + 16110995049882478788, 14559143407227563441, 4189805181268804683, 10938587948346538224, + 1635025506014383478, 12619562911869525411, 17469465615861488695, 125252234176411528, + 2004192558503448853, 13175467866790974840, 17712272336167363518, 1710549840100880318, + 17486892343528340916, 5337910082227550967, 8333082060923612691, 6284787745504163856, + 8072221024586708290, 6077032673910717705, 11495200863352251610, 11722792537523099594, + 14642059504258647996, 8595733246938141113, 17223366528010341891, 17447739753327015776, + 6149800490736735996, 11155866914574313276, 7123864553063709909, 15982886296520662323, + 5775920250955521517, 8624640108274906072, 8652974210855988961, 8715770416136907275, + 11841689528820039868, 10991309078149220415, 11758038663970841716, 7308750055935299261, + 15939068400245256963, 6920341533033919644, 8017706063646646166, 15814376391419160498, + 13529376573221932937, 16749061963269842448, 14639730709921425830, 3265850480169354066, + 4569394597532719321, 16594515239012200038, 13372824240764466517, 16892840440503406128, + 11260004846380394643, 2441660009097834955, 10566922722880085440, 11463315545387550692, + 5252492021914937692, 10404636333478845345, 11109538423683960387, 5525267334484537655, + 17936751184378118743, 4224632875737239207, 15888641556987476199, 9586888813112229805, + 9476861567287505094, 14909536929239540332, 17996844556292992842, 2699310519182298856]; + +reference_jump_val(exs64) -> [not_implemented]. diff --git a/lib/tools/emacs/Makefile b/lib/tools/emacs/Makefile index e1b195ef97..35c93ba4ed 100644 --- a/lib/tools/emacs/Makefile +++ b/lib/tools/emacs/Makefile @@ -38,6 +38,7 @@ MAN_FILES= \ tags.3 EMACS_FILES= \ + erldoc \ erlang-skels \ erlang-skels-old \ erlang_appwiz \ diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el index f9a6d24b2c..160057e179 100644 --- a/lib/tools/emacs/erlang-start.el +++ b/lib/tools/emacs/erlang-start.el @@ -78,9 +78,23 @@ (autoload 'erlang-find-tag-other-window "erlang" "Like `find-tag-other-window'. Capable of retreiving Erlang modules.") +;; +;; Declare functions in "erlang-edoc.el". +;; + (autoload 'erlang-edoc-mode "erlang-edoc" "Toggle Erlang-Edoc mode on or off." t) ;; +;; Declare functions in "erldoc.el". +;; + +(autoload 'erldoc-browse "erldoc" "\n\n(fn MFA)" t nil) +(autoload 'erldoc-browse-topic "erldoc" "\n\n(fn TOPIC)" t nil) +(autoload 'erldoc-apropos "erldoc" "\n\n(fn PATTERN)" t nil) +(autoload 'erldoc-eldoc-function "erldoc" "\ +A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil) + +;; ;; Associate files extensions ".erl" and ".hrl" with Erlang mode. ;; diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 2bde21dbed..12ef00f6a8 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -1442,6 +1442,11 @@ Other commands: (erlang-skel-init) (when (fboundp 'tempo-use-tag-list) (tempo-use-tag-list 'erlang-tempo-tags)) + (when (and (fboundp 'add-function) (fboundp 'erldoc-eldoc-function)) + (or eldoc-documentation-function + (setq-local eldoc-documentation-function #'ignore)) + (add-function :before-until (local 'eldoc-documentation-function) + #'erldoc-eldoc-function)) (run-hooks 'erlang-mode-hook) (if (zerop (buffer-size)) (run-hooks 'erlang-new-file-hook))) diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el new file mode 100644 index 0000000000..cb355374d9 --- /dev/null +++ b/lib/tools/emacs/erldoc.el @@ -0,0 +1,508 @@ +;;; erldoc.el --- browse Erlang/OTP documentation -*- lexical-binding: t; -*- + +;; %CopyrightBegin% +;; +;; Copyright Ericsson AB 2016. All Rights Reserved. +;; +;; Licensed under the Apache License, Version 2.0 (the "License"); +;; you may not use this file except in compliance with the License. +;; You may obtain a copy of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. +;; +;; %CopyrightEnd% + +;;; Commentary: + +;; Crawl Erlang/OTP HTML documentation and generate lookup tables. +;; +;; This package depends on `cl-lib', `pcase' and +;; `libxml-parse-html-region'; emacs 24+ compiled with libxml2 should +;; work. On emacs 24.1 and 24.2 do `M-x package-install RET cl-lib +;; RET' to install `cl-lib'. +;; +;; Please customise `erldoc-man-index' to point to your local OTP +;; documentation. +;; +;; To use: +;; +;; (define-key help-map "u" 'erldoc-browse) +;; (define-key help-map "t" 'erldoc-browse-topic) +;; (define-key help-map "a" 'erldoc-apropos) +;; +;; Note: these commands trigger indexing OTP documentation on first +;; run with cache to disk which may take 1-2 minutes. + + +;;; Examples: + +;; 1. `M-x erldoc-browse RET erlang:integer_to_binary/2 RET' opens the +;; `erlang' manual anchored on the entry for `integer_to_binary/2'. +;; +;; 2. `M-x erldoc-apropos RET first RET' list all MFAs matching +;; substring `first'. +;; +;; 3. `M-x erldoc-browse-topic RET efficiency_guide#Introduction RET' +;; opens chapter `Introduction' of the `Efficiency Guide' in the +;; browser. + +;;; History: + +;; Written in December 2013 as a temporary solution to help me browse +;; the rich Erlang/OTP documentation. Three years on I find myself +;; still using it every day. - Leo (2016) + +;;; Code: + +(eval-when-compile (require 'url-parse)) +(require 'cl-lib) +(require 'erlang) + +(eval-and-compile ;for emacs < 24.3 + (or (fboundp 'user-error) (defalias 'user-error 'error))) + +(defgroup erldoc nil + "Browse Erlang document." + :group 'help) + +(defcustom erldoc-man-index "http://www.erlang.org/doc/man_index.html" + "The URL to the man_index.html page. +Note it is advisable to customise this to a local URL for example +`file:///usr/local/19.1/lib/erlang/doc/man_index.html' to speed +up the indexing." + :type 'string + :group 'erldoc) + +(defcustom erldoc-verify-man-path nil + "If non-nil verify man path existence for `file://'." + :type 'boolean + :group 'erldoc) + +(defcustom erldoc-output-file (locate-user-emacs-file "cache/erldoc") + "File to store the parsed results." + :type 'file + :group 'erldoc) + +(defun erldoc-strip-string (s) + (let* ((re "[ \t\n\r\f\v\u00a0]+") + (from (if (string-match (concat "\\`" re) s) (match-end 0) 0)) + (to (and (string-match (concat re "\\'") s) (match-beginning 0)))) + (substring s from (and to (max to from))))) + +;; Note: don't know how to get the BASE-URL to +;; `libxml-parse-html-region' to work. +(defun erldoc-expand-url (url base-url) + (if (url-type (url-generic-parse-url url)) + url + (let* ((base (url-generic-parse-url base-url)) + (dir (directory-file-name (file-name-directory (url-filename base))))) + (setf (url-filename base) (expand-file-name url dir)) + (url-recreate-url base)))) + +(defun erldoc-parse-html (url) + (with-temp-buffer + (url-insert-file-contents url) + (libxml-parse-html-region (point-min) (point-max)))) + +(defalias 'erldoc-dom-text-node-p #'stringp) + +(defun erldoc-dom-attributes (dom) + (and (not (erldoc-dom-text-node-p dom)) (cadr dom))) + +(defun erldoc-dom-get-attribute (dom attrib-name) + (cdr (assq attrib-name (erldoc-dom-attributes dom)))) + +(defun erldoc-dom-children (dom) + (and (not (erldoc-dom-text-node-p dom)) (cddr dom))) + +(defun erldoc-dom-get-text (dom) + (let ((text (car (last (erldoc-dom-children dom))))) + (and (erldoc-dom-text-node-p text) text))) + +(defvar erldoc-dom-walk-parent nil) +(defvar erldoc-dom-walk-siblings nil) + +(defun erldoc-dom-walk (dom k) + (funcall k dom) + (let ((erldoc-dom-walk-parent dom) + (erldoc-dom-walk-siblings (unless (erldoc-dom-text-node-p dom) + (cddr dom)))) + (dolist (child erldoc-dom-walk-siblings) + (erldoc-dom-walk child k)))) + +(defun erldoc-dom-get-element (dom element-name) + (catch 'return + (erldoc-dom-walk dom (lambda (d) + (when (eq (car-safe d) element-name) + (throw 'return d)))))) + +(defun erldoc-dom-get-element-by-id (dom id) + (catch 'return + (erldoc-dom-walk dom (lambda (d) + (when (equal (erldoc-dom-get-attribute d 'id) id) + (throw 'return d)))))) + +(defun erldoc-dom-get-elements-by-id (dom id) + (let (result) + (erldoc-dom-walk dom (lambda (d) + (when (equal (erldoc-dom-get-attribute d 'id) id) + (push d result)))) + (nreverse result))) + +(defun erldoc-fix-path (url) + (if (and erldoc-verify-man-path + ;; Could only verify local files + (equal (url-type (url-generic-parse-url url)) "file")) + (let* ((obj (url-generic-parse-url url)) + (new (car (file-expand-wildcards + (replace-regexp-in-string + "-[0-9]+\\(?:[.][0-9]+\\)*" "*" + (url-filename obj)))))) + (or new (error "File %s does not exist" (url-filename obj))) + (setf (url-filename obj) new) + (url-recreate-url obj)) + url)) + +(defun erldoc-parse-man-index (url) + (let ((table (erldoc-dom-get-element (erldoc-parse-html url) 'table)) + (mans)) + (erldoc-dom-walk + table + (lambda (d) + (when (eq (car-safe d) 'a) + (let ((href (erldoc-dom-get-attribute d 'href))) + (when (and href (not (string-match-p "index\\.html\\'" href))) + (with-demoted-errors "erldoc-parse-man-index: %S" + (push (cons (erldoc-dom-get-text d) + (erldoc-fix-path (erldoc-expand-url href url))) + mans))))))) + (nreverse mans))) + +(defun erldoc-parse-man (man) + (let ((dom (erldoc-parse-html (cdr man))) + (table (make-hash-table :test #'equal))) + (erldoc-dom-walk + (erldoc-dom-get-element-by-id dom "loadscrollpos") + (lambda (d) + (let ((href (erldoc-dom-get-attribute d 'href))) + (when (and href (string-match "#" href)) + (puthash (substring href (match-end 0)) + (list (concat (car man) ":" (erldoc-strip-string + (erldoc-dom-get-text d))) + (erldoc-expand-url href (cdr man))) + table))))) + (let ((span-content + (lambda (span) + (let ((texts)) + (erldoc-dom-walk span + (lambda (d) + (and (erldoc-dom-text-node-p d) + (push (erldoc-strip-string d) texts)))) + (and texts (mapconcat 'identity (nreverse texts) " "))))) + entries) + (erldoc-dom-walk + dom + (lambda (d) + ;; Get the full function signature. + (when (and (eq (car-safe d) 'a) + (gethash (erldoc-dom-get-attribute d 'name) table)) + (push (append (gethash (erldoc-dom-get-attribute d 'name) table) + (list (funcall span-content + (or (erldoc-dom-get-element d 'span) + (cadr (memq d erldoc-dom-walk-siblings)))))) + entries)) + ;; Get data types + (when (and (eq (car-safe d) 'a) + (string-prefix-p "type-" + (or (erldoc-dom-get-attribute d 'name) ""))) + (push (list (concat (car man) ":" (funcall span-content d)) + (concat (cdr man) "#" (erldoc-dom-get-attribute d 'name)) + (funcall span-content erldoc-dom-walk-parent)) + entries)))) + entries))) + +(defun erldoc-parse-all (man-index output &optional json) + (let* ((output (expand-file-name output)) + (table (make-hash-table :size 11503 :test #'equal)) + (mans (erldoc-parse-man-index man-index)) + (progress 1) + (reporter (make-progress-reporter "Parsing Erlang/OTP documentation" + progress (length mans))) + fails all) + (dolist (man mans) + (condition-case err + (push (erldoc-parse-man man) all) + (error (push (error-message-string err) fails))) + (accept-process-output nil 0.01) + (progress-reporter-update reporter (cl-incf progress))) + (when fails + (display-warning 'erldoc-parse-all + (format "\n\n%s" (mapconcat #'identity fails "\n")) + :error)) + (progress-reporter-done reporter) + (mapc (lambda (x) (puthash (car x) (cdr x) table)) + (apply #'nconc (nreverse all))) + (with-temp-buffer + (if (not json) + (pp table (current-buffer)) + (eval-and-compile (require 'json)) + (let ((json-encoding-pretty-print t)) + (insert (json-encode table)))) + (unless (file-directory-p (file-name-directory output)) + (make-directory (file-name-directory output) t)) + (write-region nil nil output nil nil nil 'ask)))) + +(defun erldoc-otp-release () + "Get the otp release version (as string) or nil if not found." + (let ((otp (erldoc-dom-get-text + (erldoc-dom-get-element + (erldoc-parse-html + (erldoc-expand-url "index.html" erldoc-man-index)) + 'title)))) + (and (string-match "[0-9.]+\\'" otp) (match-string 0 otp)))) + +(defvar erldoc-browse-history nil) +(defvar erldoc-lookup-table nil) + +(defun erldoc-lookup-table () + (or erldoc-lookup-table + (progn + (unless (file-exists-p erldoc-output-file) + (let ((of (pcase (erldoc-otp-release) + (`nil erldoc-output-file) + (ver (concat erldoc-output-file "-" ver))))) + (unless (file-exists-p of) + (erldoc-parse-all erldoc-man-index of)) + (unless (string= erldoc-output-file of) + (make-symbolic-link of erldoc-output-file)))) + (setq erldoc-lookup-table + (with-temp-buffer + (insert-file-contents erldoc-output-file) + (read (current-buffer))))))) + +(defun erldoc-best-matches (mfa) + (pcase mfa + ((and `(,m ,f) (let a (erlang-get-function-arity))) + (let ((mfa (format "%s:%s/%s" m f a))) + (cond ((gethash mfa (erldoc-lookup-table)) (list mfa)) + (m (all-completions (concat m ":" f "/") (erldoc-lookup-table))) + (t (let* ((mod (erlang-get-module)) + (mf1 (and mod (concat mod ":" f "/"))) + (mf2 (concat "erlang:" f "/")) + (re (concat ":" (regexp-quote f) "/"))) + (or (and mf1 (all-completions mf1 (erldoc-lookup-table))) + (all-completions mf2 (erldoc-lookup-table)) + (cl-loop for k being the hash-keys of (erldoc-lookup-table) + when (string-match-p re k) + collect k))))))))) + +;;;###autoload +(defun erldoc-browse (mfa) + (interactive + (let ((default + ;; `erlang-mode-syntax-table' is lazily initialised. + (with-syntax-table (or erlang-mode-syntax-table (standard-syntax-table)) + (ignore-errors + (erldoc-best-matches + (or (erlang-get-function-under-point) + (save-excursion + (goto-char (or (cadr (syntax-ppss)) (point))) + (erlang-get-function-under-point)))))))) + (list (completing-read (format (if default "Function {%d %s} (default %s): " + "Function: ") + (length default) + (if (= (length default) 1) "guess" "guesses") + (car default)) + (erldoc-lookup-table) + nil t nil 'erldoc-browse-history default)))) + (or (stringp mfa) + (signal 'wrong-type-argument (list 'string mfa 'mfa))) + (browse-url (or (car (gethash mfa (erldoc-lookup-table))) + (user-error "No documentation for %s" mfa)))) + +;;;###autoload +(defun erldoc-apropos (pattern) + (interactive "sPattern: ") + (with-help-window (help-buffer) + (with-current-buffer standard-output + (princ (concat "Erldoc apropos pattern: " pattern "\n\n")) + (maphash (lambda (k v) + (when (string-match-p pattern k) + (insert-text-button k :type 'help-url + 'help-args (list (car v))) + (insert "\n"))) + (erldoc-lookup-table))))) + +(defun erldoc-tokenize-signature (sig) + ;; Divide SIG into (MF ARGLIST RETTYPE) + (let ((from (if (string-match "\\`.+?(" sig) + (1- (match-end 0)) + 0)) + (to (and (string-match "\\s-*->\\s-*.*?\\'" sig) (match-beginning 0)))) + (list (erldoc-strip-string (substring sig 0 from)) + (erldoc-strip-string (substring sig from (and to (max from to)))) + (and to (erldoc-strip-string (substring sig to)))))) + +(defun erldoc-format-signature (mod fn) + (when (and mod fn (or erldoc-lookup-table + (file-exists-p erldoc-output-file))) + (let ((re (concat "\\`" mod ":" fn "/\\([0-9]+\\)\\'")) + (sigs)) + (maphash (lambda (k v) + (when (string-match re k) + (push (cons (string-to-number (match-string 1 k)) + (cdr (erldoc-tokenize-signature (cadr v)))) + sigs))) + (erldoc-lookup-table)) + (when sigs + ;; Mostly single return type but there are exceptions such as + ;; `beam_lib:chunks/2,3'. + (let ((single-rettype + (cl-reduce (lambda (x1 x2) (and x1 x2 (equal x1 x2) x1)) + sigs :key #'cl-caddr)) + (sigs (sort sigs #'car-less-than-car))) + (if single-rettype + (concat mod ":" fn (mapconcat #'cadr sigs " | ") " " single-rettype) + (mapconcat (lambda (x) (concat mod ":" fn (nth 1 x) " " (nth 2 x))) + sigs "\n"))))))) + +;;;###autoload +(defun erldoc-eldoc-function () + "A function suitable for `eldoc-documentation-function'." + (save-excursion + (pcase (erlang-get-function-under-point) + (`(,_ nil) ) + (`(nil ,fn) (erldoc-format-signature "erlang" fn)) + (`(,mod ,fn) (erldoc-format-signature mod fn))))) + +(defun erldoc-parse-eeps-index () + (let* ((url "http://www.erlang.org/eeps/") + (table (catch 'return + (erldoc-dom-walk (erldoc-parse-html url) + (lambda (d) + (and (eq (car-safe d) 'table) + (equal (erldoc-dom-get-attribute d 'summary) + "Numerical Index of EEPs") + (throw 'return d)))))) + (fix-title (lambda (title) + (replace-regexp-in-string + "`` *" "" (replace-regexp-in-string " *``, *" " by " title)))) + (result)) + (erldoc-dom-walk + table (lambda (d) + (when (eq (car-safe d) 'a) + (push (cons (funcall fix-title (erldoc-dom-get-attribute d 'title)) + (erldoc-expand-url + (erldoc-dom-get-attribute d 'href) + url)) + result)))) + (nreverse result))) + +(defvar erldoc-user-guides nil) + +(defvar erldoc-missing-user-guides + '("compiler" "hipe" "kernel" "os_mon" "parsetools" "typer") + "List of standard Erlang applications with no user guides.") + +;; Search in `code:lib_dir/0' using find LIB_DIR -type f -name +;; '*_app.html'. +(defvar erldoc-app-manuals '("crypto" "diameter" "erl_docgen" + "kernel" "observer" "os_mon" + "runtime_tools" "sasl" "snmp" + "ssl" "test_server" + ("ssh" . "SSH") ("stdlib" . "STDLIB") + ("hipe" . "HiPE") ("typer" . "TypEr")) + "List of applications that come with a manual.") + +(defun erldoc-user-guide-chapters (user-guide) + (pcase-let ((`(,name . ,url) user-guide)) + (unless (member name erldoc-missing-user-guides) + (let ((chaps (erldoc-dom-get-elements-by-id + (erldoc-dom-get-element-by-id (erldoc-parse-html url) "leftnav") + "no"))) + (or chaps (warn "erldoc-user-guide-chapters no chapters found for `%s'" + (cdr user-guide))) + (mapcar (lambda (li) + (cons (concat name "#" (erldoc-dom-get-attribute li 'title)) + (erldoc-expand-url (erldoc-dom-get-attribute + (erldoc-dom-get-element li 'a) 'href) + url))) + chaps))))) + +(defun erldoc-user-guides-1 () + (let ((url (erldoc-expand-url "applications.html" erldoc-man-index)) + app-guides app-mans) + (erldoc-dom-walk + (erldoc-parse-html url) + (lambda (d) + (when (and (eq (car-safe d) 'a) + (not (string-match-p "\\`[0-9.]+\\'" (erldoc-dom-get-text d)))) + (with-demoted-errors "erldoc-user-guides-1: %S" + (let ((name (erldoc-strip-string (erldoc-dom-get-text d))) + (index-page (erldoc-fix-path (erldoc-expand-url + (erldoc-dom-get-attribute d 'href) url)))) + (push (cons name (if (member name erldoc-missing-user-guides) + index-page + (erldoc-expand-url "users_guide.html" index-page))) + app-guides) + ;; Collect application manuals. + (pcase (assoc name (mapcar (lambda (x) (if (consp x) x (cons x x))) + erldoc-app-manuals)) + (`(,_ . ,manual) + (push (cons name + (erldoc-expand-url (format "%s_app.html" manual) + index-page)) + app-mans)))))))) + (list (nreverse app-guides) + (nreverse app-mans)))) + +(defun erldoc-user-guides () + (or erldoc-user-guides + (let ((file (concat erldoc-output-file "-topics"))) + (unless (file-exists-p file) + (unless (file-directory-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (with-temp-buffer + (pcase-let ((`(,guides ,mans) (erldoc-user-guides-1))) + (pp (append (cl-mapcan #'erldoc-user-guide-chapters + (append (mapcar + (lambda (dir) + (cons dir (erldoc-expand-url + (concat dir "/users_guide.html") + erldoc-man-index))) + '("design_principles" + "efficiency_guide" + "embedded" + "getting_started" + "installation_guide" + "oam" + "programming_examples" + "reference_manual" + "system_architecture_intro" + "system_principles" + "tutorial")) + guides)) + (mapcar (lambda (man) + (pcase-let ((`(,name . ,url) man)) + (cons (concat name " (App)") url))) + mans) + (erldoc-parse-eeps-index)) + (current-buffer))) + (write-region nil nil file nil nil nil 'ask))) + (setq erldoc-user-guides (with-temp-buffer (insert-file-contents file) + (read (current-buffer))))))) + +;;;###autoload +(defun erldoc-browse-topic (topic) + (interactive + (list (completing-read "User guide: " (erldoc-user-guides) nil t))) + (browse-url (cdr (assoc topic (erldoc-user-guides))))) + +(provide 'erldoc) +;;; erldoc.el ends here |