diff options
Diffstat (limited to 'lib')
81 files changed, 1802 insertions, 770 deletions
diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl index c7f446dee9..b630a51835 100644 --- a/lib/common_test/src/ct_cover.erl +++ b/lib/common_test/src/ct_cover.erl @@ -174,7 +174,7 @@ get_spec_test(File) -> [] -> [#cover{app=none, level=details}]; _ -> Res end, - case get_cover_opts(Apps, Terms, []) of + case get_cover_opts(Apps, Terms, Dir, []) of E = {error,_} -> E; [CoverSpec] -> @@ -205,124 +205,125 @@ collect_apps([], Apps) -> %% get_cover_opts(Terms) -> AppCoverInfo %% AppCoverInfo: [#cover{app=App,...}] -get_cover_opts([App | Apps], Terms, CoverInfo) -> - case get_app_info(App, Terms) of +get_cover_opts([App | Apps], Terms, Dir, CoverInfo) -> + case get_app_info(App, Terms, Dir) of E = {error,_} -> E; AppInfo -> AppInfo1 = files2mods(AppInfo), - get_cover_opts(Apps, Terms, [AppInfo1|CoverInfo]) + get_cover_opts(Apps, Terms, Dir, [AppInfo1|CoverInfo]) end; -get_cover_opts([], _, CoverInfo) -> +get_cover_opts([], _, _, CoverInfo) -> lists:reverse(CoverInfo). -%% get_app_info(App, Terms) -> App1 +%% get_app_info(App, Terms, Dir) -> App1 -get_app_info(App=#cover{app=none}, [{incl_dirs,Dirs}|Terms]) -> - get_app_info(App, [{incl_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", false, []) of +get_app_info(App=#cover{app=none}, [{incl_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{incl_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", false, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{incl_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{incl_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", true, []) of +get_app_info(App=#cover{app=none}, [{incl_dirs_r,Dirs}|Terms], Dir) -> + get_app_info(App, [{incl_dirs_r,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_dirs_r,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", true, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{incl_mods,Mods1}|Terms]) -> - get_app_info(App, [{incl_mods,none,Mods1}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_mods,Name,Mods1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{incl_mods,Mods1}|Terms], Dir) -> + get_app_info(App, [{incl_mods,none,Mods1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_mods,Name,Mods1}|Terms], Dir) -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms); + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{excl_dirs,Dirs}|Terms]) -> - get_app_info(App, [{excl_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", false, []) of +get_app_info(App=#cover{app=none}, [{excl_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{excl_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{excl_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", false, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{excl_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{excl_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", true, []) of +get_app_info(App=#cover{app=none}, [{excl_dirs_r,Dirs}|Terms],Dir) -> + get_app_info(App, [{excl_dirs_r,none,Dirs}|Terms],Dir); +get_app_info(App=#cover{app=Name}, [{excl_dirs_r,Name,Dirs}|Terms],Dir) -> + case get_files(Dirs, Dir, ".beam", true, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{excl_mods,Mods1}|Terms]) -> - get_app_info(App, [{excl_mods,none,Mods1}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_mods,Name,Mods1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{excl_mods,Mods1}|Terms], Dir) -> + get_app_info(App, [{excl_mods,none,Mods1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{excl_mods,Name,Mods1}|Terms], Dir) -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms); + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{cross,Cross}|Terms]) -> - get_app_info(App, [{cross,none,Cross}|Terms]); -get_app_info(App=#cover{app=Name}, [{cross,Name,Cross1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{cross,Cross}|Terms], Dir) -> + get_app_info(App, [{cross,none,Cross}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{cross,Name,Cross1}|Terms], Dir) -> Cross = App#cover.cross, - get_app_info(App#cover{cross=Cross++Cross1},Terms); + get_app_info(App#cover{cross=Cross++Cross1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{src_dirs,Dirs}|Terms]) -> - get_app_info(App, [{src_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".erl", false, []) of +get_app_info(App=#cover{app=none}, [{src_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{src_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".erl", false, []) of E = {error,_} -> E; Src1 -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms) + get_app_info(App#cover{src=Src++Src1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{src_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{src_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".erl", true, []) of +get_app_info(App=#cover{app=none}, [{src_dirs_r,Dirs}|Terms], Dir) -> + get_app_info(App, [{src_dirs_r,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_dirs_r,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".erl", true, []) of E = {error,_} -> E; Src1 -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms) + get_app_info(App#cover{src=Src++Src1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{src_files,Src1}|Terms]) -> - get_app_info(App, [{src_files,none,Src1}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_files,Name,Src1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{src_files,Src1}|Terms], Dir) -> + get_app_info(App, [{src_files,none,Src1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_files,Name,Src1}|Terms], Dir) -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms); + get_app_info(App#cover{src=Src++Src1},Terms,Dir); -get_app_info(App, [_|Terms]) -> - get_app_info(App, Terms); +get_app_info(App, [_|Terms], Dir) -> + get_app_info(App, Terms, Dir); -get_app_info(App, []) -> +get_app_info(App, [], _) -> App. %% get_files(...) -get_files([Dir|Dirs], Ext, Recurse, Files) -> - case file:list_dir(Dir) of +get_files([Dir|Dirs], RootDir, Ext, Recurse, Files) -> + DirAbs = filename:absname(Dir, RootDir), + case file:list_dir(DirAbs) of {ok,Entries} -> - {SubDirs,Matches} = analyse_files(Entries, Dir, Ext, [], []), + {SubDirs,Matches} = analyse_files(Entries, DirAbs, Ext, [], []), if Recurse == false -> - get_files(Dirs, Ext, Recurse, Files++Matches); + get_files(Dirs, RootDir, Ext, Recurse, Files++Matches); true -> - Files1 = get_files(SubDirs, Ext, Recurse, Files++Matches), - get_files(Dirs, Ext, Recurse, Files1) + Files1 = get_files(SubDirs, RootDir, Ext, Recurse, Files++Matches), + get_files(Dirs, RootDir, Ext, Recurse, Files1) end; {error,Reason} -> - {error,{Reason,Dir}} + {error,{Reason,DirAbs}} end; -get_files([], _Ext, _R, Files) -> +get_files([], _RootDir, _Ext, _R, Files) -> Files. %% analyse_files(...) diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 00d0aab507..4a12481214 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -293,10 +293,10 @@ script_start1(Parent, Args) -> application:set_env(common_test, auto_compile, true), InclDirs = case proplists:get_value(include, Args) of - Incl when is_list(hd(Incl)) -> - Incl; + Incls when is_list(hd(Incls)) -> + [filename:absname(IDir) || IDir <- Incls]; Incl when is_list(Incl) -> - [Incl]; + [filename:absname(Incl)]; undefined -> [] end, @@ -774,7 +774,8 @@ script_usage() -> "\n\t[-basic_html]\n\n"), io:format("Run tests from command line:\n\n" "\tct_run [-dir TestDir1 TestDir2 .. TestDirN] |" - "\n\t[-suite Suite1 Suite2 .. SuiteN [-case Case1 Case2 .. CaseN]]" + "\n\t[[-dir TestDir] -suite Suite1 Suite2 .. SuiteN" + "\n\t [[-group Groups1 Groups2 .. GroupsN] [-case Case1 Case2 .. CaseN]]]" "\n\t[-step [config | keep_inactive]]" "\n\t[-config ConfigFile1 ConfigFile2 .. ConfigFileN]" "\n\t[-userconfig CallbackModule ConfigFile1 .. ConfigFileN]" @@ -1023,10 +1024,10 @@ run_test2(StartOpts) -> case proplists:get_value(include, StartOpts) of undefined -> []; - Incl when is_list(hd(Incl)) -> - Incl; + Incls when is_list(hd(Incls)) -> + [filename:absname(IDir) || IDir <- Incls]; Incl when is_list(Incl) -> - [Incl] + [filename:absname(Incl)] end, case os:getenv("CT_INCLUDE_PATH") of false -> @@ -1393,6 +1394,7 @@ run_testspec2(TestSpec) -> EnvInclude++Opts#opts.include end, application:set_env(common_test, include, AllInclude), + LogDir1 = which(logdir,Opts#opts.logdir), case check_and_install_configfiles( Opts#opts.config, LogDir1, Opts) of @@ -2134,6 +2136,14 @@ do_run_test(Tests, Skip, Opts0) -> case check_and_add(Tests, [], []) of {ok,AddedToPath} -> ct_util:set_testdata({stats,{0,0,{0,0}}}), + + %% test_server needs to know the include path too + InclPath = case application:get_env(common_test, include) of + {ok,Incls} -> Incls; + _ -> [] + end, + application:set_env(test_server, include, InclPath), + test_server_ctrl:start_link(local), %% let test_server expand the test tuples and count no of cases diff --git a/lib/common_test/test/ct_cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE.erl index 87ba4ae1b9..1dab425509 100644 --- a/lib/common_test/test/ct_cover_SUITE.erl +++ b/lib/common_test/test/ct_cover_SUITE.erl @@ -77,7 +77,11 @@ all() -> ct_cover_add_remove_nodes, otp_9956, cross, - export_import + export_import, + relative_incl_dirs, + absolute_incl_dirs, + relative_excl_dirs, + absolute_excl_dirs ]. %%-------------------------------------------------------------------- @@ -215,6 +219,45 @@ export_import(Config) -> check_calls(Events2,2), ok. +relative_incl_dirs(Config) -> + false = check_cover(Config), + RelDir = rel_path(?config(priv_dir, Config), ?config(data_dir, Config)), + CoverSpec = [{incl_dirs, [RelDir]}], + CoverFile = create_cover_file(rel_incl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(rel_incl_dirs, default, Opts, Config), + check_calls(Events, 1), + ok. + +absolute_incl_dirs(Config) -> + false = check_cover(Config), + CoverSpec = [{incl_dirs, [?config(data_dir, Config)]}], + CoverFile = create_cover_file(abs_incl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(abs_incl_dirs, default, Opts, Config), + check_calls(Events, 1), + ok. + +relative_excl_dirs(Config) -> + false = check_cover(Config), + RelDir = rel_path(?config(priv_dir, Config), ?config(data_dir, Config)), + CoverSpec = default_cover_file_content() ++ [{excl_dirs, [RelDir]}], + CoverFile = create_cover_file(rel_excl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(rel_excl_dirs, default_no_cover, Opts, Config), + check_no_cover_compiled(Events), + ok. + +absolute_excl_dirs(Config) -> + false = check_cover(Config), + AbsDir = ?config(data_dir, Config), + CoverSpec = default_cover_file_content() ++ [{excl_dirs, [AbsDir]}], + CoverFile = create_cover_file(abs_excl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(abs_excl_dirs, default_no_cover, Opts, Config), + check_no_cover_compiled(Events), + ok. + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -288,23 +331,36 @@ get_log_dirs(Events) -> {ct_test_support_eh, {event,start_logging,_Node,LogDir}} <- Events]. +%% Check if a module was compiled without cover +check_no_cover_compiled(Events) -> + check_no_cover_compiled(Events, ?mod). +check_no_cover_compiled(Events, Mod) -> + [ {error, {not_cover_compiled, Mod}} = analyse_log(CoverLog, Mod) + || CoverLog <- cover_logs(Events) ]. + %% Check that each coverlog includes N calls to ?mod:foo/0 check_calls(Events,N) -> check_calls(Events,{?mod,foo,0},N). check_calls(Events,MFA,N) -> - CoverLogs = [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)], - do_check_logs(CoverLogs,MFA,N). + do_check_logs(cover_logs(Events),MFA,N). do_check_logs([CoverLog|CoverLogs],{Mod,_,_} = MFA,N) -> - {ok,_} = cover:start(), - ok = cover:import(CoverLog), - {ok,Calls} = cover:analyse(Mod,calls,function), - ok = cover:stop(), + {ok, Calls} = analyse_log(CoverLog, Mod), {MFA,N} = lists:keyfind(MFA,1,Calls), do_check_logs(CoverLogs,MFA,N); do_check_logs([],_,_) -> ok. +cover_logs(Events) -> + [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)]. + +analyse_log(CoverLog, Mod) -> + {ok, _} = cover:start(), + ok = cover:import(CoverLog), + Result = cover:analyse(Mod, calls, function), + ok = cover:stop(), + Result. + fullname(Name) -> {ok,Host} = inet:gethostname(), list_to_atom(atom_to_list(Name) ++ "@" ++ Host). @@ -333,3 +389,12 @@ start_slave(Name,Args) -> {boot_timeout,10}, % extending some timers for slow test hosts {init_timeout,10}, {startup_timeout,10}]). + +rel_path(From, To) -> + Segments = do_rel_path(filename:split(From), filename:split(To)), + filename:join(Segments). + +do_rel_path([Seg|RestA], [Seg|RestB]) -> + do_rel_path(RestA, RestB); +do_rel_path(PathA, PathB) -> + lists:duplicate(length(PathA), "..") ++ PathB. diff --git a/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl index 83d368c53d..789e48bd96 100644 --- a/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl +++ b/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl @@ -71,6 +71,10 @@ default(_Config) -> cover_test_mod:foo(), ok. +default_no_cover(_Config) -> + cover_test_mod:foo(), + ok. + slave(_Config) -> cover_compiled = code:which(cover_test_mod), cover_test_mod:foo(), diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 5a4621dc37..a452d30b61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> %% There was a reference to a boolean expression %% from inside a protected block (try/catch), to %% a boolean expression outside. - throw:protected_barrier -> + throw:protected_barrier -> failed; - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> failed; - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> failed; - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> failed; - throw:registers_used -> + throw:registers_used -> failed; - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed; + + %% Failed to work out the live registers for a GC + %% BIF. For example, if the number of live registers + %% needed to be 4 because {x,3} was a source register, + %% but {x,2} was not known to be initialized, this + %% exception would be thrown. + throw:gc_bif_alloc_failure -> failed + end end. @@ -665,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}]. fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). -live_regs(Regs) -> - foldl(fun ({I,_}, _) -> - I - end, -1, Regs)+1. +live_regs([{_,reserved}|_]) -> + %% We are not sure that this register is initialized, so we must + %% abort the optimization. + throw(gc_bif_alloc_failure); +live_regs([{I,_}]) -> + I+1; +live_regs([{_,_}|Regs]) -> + live_regs(Regs); +live_regs([]) -> + 0. %%% diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 2792fd8fa5..0d95971f91 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -212,6 +212,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) -> vu_pattern_list(V, Es, St); vu_pattern(V, #c_binary{segments=Ss}, St) -> vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_map{es=Es}, St) -> + vu_map_pairs(V, Es, St); vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> case vu_pattern(V, Var, St0) of {true,_}=St1 -> St1; @@ -234,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 82817a987a..ed8f609082 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1229,6 +1229,11 @@ is_non_numeric([H|T]) -> is_non_numeric(H) andalso is_non_numeric(T); is_non_numeric(Tuple) when is_tuple(Tuple) -> is_non_numeric_tuple(Tuple, tuple_size(Tuple)); +is_non_numeric(Map) when is_map(Map) -> + %% Note that 17.x and 18.x compare keys in different ways. + %% Be very conservative -- require that both keys and values + %% are non-numeric. + is_non_numeric(maps:to_list(Map)); is_non_numeric(Num) when is_number(Num) -> false; is_non_numeric(_) -> true. @@ -1338,9 +1343,12 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) {ok,#c_tuple{es=Elements}} -> if 1 =< Pos, Pos =< length(Elements) -> - case lists:nth(Pos, Elements) of - #c_alias{var=Alias} -> Alias; - Res -> Res + El = lists:nth(Pos, Elements), + try + pat_to_expr(El) + catch + throw:impossible -> + Call end; true -> eval_failure(Call, badarg) @@ -2040,17 +2048,18 @@ case_opt_args([], Cs, _Sub, _LitExpr, Acc) -> %% Try to expand one argument to several arguments (if tuple/list) %% or to remove a literal argument. %% -case_opt_arg(E0, Sub, Cs, LitExpr) -> +case_opt_arg(E0, Sub, Cs0, LitExpr) -> E = maybe_replace_var(E0, Sub), case cerl:is_data(E) of false -> - {error,Cs}; + {error,Cs0}; true -> + Cs = case_opt_nomatch(E, Cs0, LitExpr), case cerl:data_type(E) of {atomic,_} -> - case_opt_lit(E, Cs, LitExpr); + case_opt_lit(E, Cs); _ -> - case_opt_data(E, Cs, LitExpr) + case_opt_data(E, Cs) end end. @@ -2072,19 +2081,67 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> false -> E; true -> - cerl_trees:map(fun(C) -> - case cerl:is_c_alias(C) of - false -> C; - true -> cerl:alias_pat(C) - end - end, T0) + %% The pattern was a tuple. Now we must make sure + %% that the elements of the tuple are suitable. In + %% particular, we don't want binary or map + %% construction here, since that means that the + %% binary or map will be constructed in the 'case' + %% argument. That is wasteful for binaries. Even + %% worse is that any map pattern that use the ':=' + %% operator will fail when used in map + %% construction (only the '=>' operator is allowed + %% when constructing a map from scratch). + ToData = fun coerce_to_data/1, + try + cerl_trees:map(ToData, T0) + catch + throw:impossible -> + %% Something unsuitable was found (map or + %% or binary). Keep the variable. + E + end end; error -> E end. -%% case_opt_lit(Literal, Clauses0, LitExpr) -> -%% {ok,[],Clauses} | error +%% coerce_to_data(Core) -> Core' +%% Coerce an element originally from a pattern to an data item or or +%% variable. Throw an 'impossible' exception if non-data Core Erlang +%% terms such as binary construction or map construction are +%% encountered. + +coerce_to_data(C) -> + case cerl:is_c_alias(C) of + false -> + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) + end; + true -> + coerce_to_data(cerl:alias_pat(C)) + end. + +%% case_opt_nomatch(E, Clauses, LitExpr) -> Clauses' +%% Remove all clauses that cannot possibly match. + +case_opt_nomatch(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> + case cerl_clauses:match(P, E) of + none -> + %% The pattern will not match the case expression. Remove + %% the clause. Unless the entire case expression is a + %% literal, also emit a warning. + case LitExpr of + false -> add_warning(C, nomatch_clause_type); + true -> ok + end, + case_opt_nomatch(E, Cs, LitExpr); + _ -> + [Current|case_opt_nomatch(E, Cs, LitExpr)] + end; +case_opt_nomatch(_, [], _) -> []. + +%% case_opt_lit(Literal, Clauses0) -> {ok,[],Clauses} | error %% The current part of the case expression is a literal. That %% means that we will know at compile-time whether a clause %% will match, and we can remove the corresponding pattern from @@ -2093,68 +2150,48 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> %% The only complication is if the literal is a binary. Binary %% pattern matching is tricky, so we will give up in that case. -case_opt_lit(Lit, Cs0, LitExpr) -> - Cs1 = case_opt_lit_1(Lit, Cs0, LitExpr), - try case_opt_lit_2(Lit, Cs1) of +case_opt_lit(Lit, Cs0) -> + try case_opt_lit_1(Lit, Cs0) of Cs -> {ok,[],Cs} catch throw:impossible -> - {error,Cs1} + {error,Cs0} end. -case_opt_lit_1(E, [{[P|_],C,_,_}=Current|Cs], LitExpr) -> - case cerl_clauses:match(P, E) of - none -> - %% The pattern will not match the literal. Remove the clause. - %% Unless the entire case expression is a literal, also - %% emit a warning. - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_lit_1(E, Cs, LitExpr); - _ -> - [Current|case_opt_lit_1(E, Cs, LitExpr)] - end; -case_opt_lit_1(_, [], _) -> []. - -case_opt_lit_2(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> - %% Non-matching clauses have already been removed in case_opt_lit_1/3. +case_opt_lit_1(E, [{[P|Ps],C,PsAcc,Bs0}|Cs]) -> + %% Non-matching clauses have already been removed + %% in case_opt_nomatch/3. case cerl_clauses:match(P, E) of {true,Bs} -> %% The pattern matches the literal. Remove the pattern %% and update the bindings. - [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_2(E, Cs)]; + [{Ps,C,PsAcc,Bs++Bs0}|case_opt_lit_1(E, Cs)]; {false,_} -> %% Binary literal and pattern. We are not sure whether %% the pattern will match. throw(impossible) end; -case_opt_lit_2(_, []) -> []. +case_opt_lit_1(_, []) -> []. %% case_opt_data(Expr, Clauses0, LitExpr) -> {ok,Exprs,Clauses} -case_opt_data(E, Cs0, LitExpr) -> +case_opt_data(E, Cs0) -> Es = cerl:data_es(E), - Cs = case_opt_data_1(Cs0, Es, - {cerl:data_type(E),cerl:data_arity(E)}, - LitExpr), - {ok,Es,Cs}. - -case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig, LitExpr) -> - case case_data_pat(P, TypeSig) of - {ok,Ps1,Bs1} -> - [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| - case_opt_data_1(Cs, Es, TypeSig,LitExpr)]; - error -> - case LitExpr of - false -> add_warning(C, nomatch_clause_type); - true -> ok - end, - case_opt_data_1(Cs, Es, TypeSig, LitExpr) - end; -case_opt_data_1([], _, _, _) -> []. + TypeSig = {cerl:data_type(E),cerl:data_arity(E)}, + try case_opt_data_1(Cs0, Es, TypeSig) of + Cs -> + {ok,Es,Cs} + catch + throw:impossible -> + {error,Cs0} + end. + +case_opt_data_1([{[P|Ps0],C,PsAcc,Bs0}|Cs], Es, TypeSig) -> + {ok,Ps1,Bs1} = case_data_pat(P, TypeSig), + [{Ps1++Ps0,C,PsAcc,Bs1++Bs0}| + case_opt_data_1(Cs, Es, TypeSig)]; +case_opt_data_1([], _, _) -> []. %% case_data_pat(Pattern, Type, Arity) -> {ok,[Pattern],[{AliasVar,Pat}]} | error. @@ -2163,12 +2200,7 @@ case_data_pat(P, TypeSig) -> false -> case_data_pat_var(P, TypeSig); true -> - case {cerl:data_type(P),cerl:data_arity(P)} of - TypeSig -> - {ok,cerl:data_es(P),[]}; - {_,_} -> - error - end + {ok,cerl:data_es(P),[]} end. %% case_data_pat_var(Pattern, {DataType,ArityType}) -> @@ -2188,35 +2220,38 @@ case_data_pat_var(P, {Type,Arity}=TypeSig) -> alias -> V = cerl:alias_var(P), Apat = cerl:alias_pat(P), - case case_data_pat(Apat, TypeSig) of - {ok,Ps,Bs} -> - {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, unalias_pat_list(Ps))}|Bs]}; - error -> - error - end; - _ -> - error + {ok,Ps,Bs} = case_data_pat(Apat, TypeSig), + {ok,Ps,[{V,cerl:ann_make_data(Ann, Type, + pat_to_expr_list(Ps))}|Bs]} end. -%% unalias_pat(Pattern) -> Pattern. -%% Remove all the aliases in a pattern but using the alias variables -%% instead of the values. We KNOW they will be bound. +%% pat_to_expr(Pattern) -> Expression. +%% Convert a pattern to an expression if possible. We KNOW that +%% all variables in the pattern will be bound. +%% +%% Throw an 'impossible' exception if a map or (non-literal) +%% binary is encountered. Trying to use a map pattern as an +%% expression is incorrect, while rebuilding a potentially +%% huge binary in an expression would be wasteful. -unalias_pat(P) -> - case cerl:is_c_alias(P) of - true -> +pat_to_expr(P) -> + case cerl:type(P) of + alias -> cerl:alias_var(P); - false -> + var -> + P; + _ -> case cerl:is_data(P) of false -> - P; + %% Map or binary. + throw(impossible); true -> - Es = unalias_pat_list(cerl:data_es(P)), + Es = pat_to_expr_list(cerl:data_es(P)), cerl:update_data(P, cerl:data_type(P), Es) end end. -unalias_pat_list(Ps) -> [unalias_pat(P) || P <- Ps]. +pat_to_expr_list(Ps) -> [pat_to_expr(P) || P <- Ps]. make_vars(A, Max) -> make_vars(A, 1, Max). diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 149b9bbb8f..10e3451e8f 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1,calling_a_binary/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition,calling_a_binary]}]. + no_partition,calling_a_binary,binary_in_map]}]. init_per_suite(Config) -> @@ -1189,6 +1189,26 @@ call_binary(<<>>, Acc) -> call_binary(<<H,T/bits>>, Acc) -> T(<<Acc/binary,H>>). +binary_in_map(Config) when is_list(Config) -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 6a7036d728..2de17e7653 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -60,6 +60,12 @@ t_element(Config) when is_list(Config) -> X = make_ref(), ?line X = id(element(1, {X,y,z})), ?line b = id(element(2, {a,b,c,d})), + (fun() -> + case {a,#{k=>X}} of + {a,#{k:=X}}=Tuple -> + #{k:=X} = id(element(2, Tuple)) + end + end)(), %% No optimization, but should work. Tuple = id({x,y,z}), @@ -204,6 +210,16 @@ eq(Config) when is_list(Config) -> ?line ?CMP_DIFF(a, [a]), ?line ?CMP_DIFF(a, {1,2,3}), + ?CMP_SAME(#{a=>1.0,b=>2}, #{b=>2.0,a=>1}), + ?CMP_SAME(#{a=>[1.0],b=>[2]}, #{b=>[2.0],a=>[1]}), + + %% The rule for comparing keys are different in 17.x and 18.x. + %% Just test that the results are consistent. + Bool = id(#{1=>a}) == id(#{1.0=>a}), %Unoptimizable. + Bool = id(#{1=>a}) == #{1.0=>a}, %Optimizable. + Bool = #{1=>a} == #{1.0=>a}, %Optimizable. + io:format("Bool = ~p\n", [Bool]), + ok. %% OTP-7117. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index eb205d09a7..34bfdeb1e5 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -1556,6 +1556,24 @@ bad_constants(Config) when is_list(Config) -> bad_guards(Config) when is_list(Config) -> if erlang:float(self()); true -> ok end, + + fc(catch bad_guards_1(1, [])), + fc(catch bad_guards_1(1, [2])), + fc(catch bad_guards_1(atom, [2])), + + fc(catch bad_guards_2(#{a=>0,b=>0}, [])), + fc(catch bad_guards_2(#{a=>0,b=>0}, [x])), + fc(catch bad_guards_2(not_a_map, [x])), + fc(catch bad_guards_2(42, [x])), + ok. + +%% beam_bool used to produce GC BIF instructions whose +%% Live operands included uninitialized registers. + +bad_guards_1(X, [_]) when {{X}}, -X -> + ok. + +bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> ok. %% Call this function to turn off constant propagation. diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index ae7d764535..1e778dca24 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,coverage/1]). + selectify/1,underscore/1,match_map/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [pmatch,mixed,aliases,match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + shortcut_boolean,letify_guard,selectify, + underscore,match_map,coverage]}]. init_per_suite(Config) -> @@ -400,6 +401,24 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +-record(s, {map,t}). + +match_map(Config) when is_list(Config) -> + Map = #{key=>{x,y},ignore=>anything}, + #s{map=Map,t={x,y}} = do_match_map(#s{map=Map}), + {a,#{k:={a,b,c}}} = do_match_map_2(#{k=>{a,b,c}}), + ok. + +do_match_map(#s{map=#{key:=Val}}=S) -> + %% Would crash with a 'badarg' exception. + S#s{t=Val}. + +do_match_map_2(Map) -> + case {a,Map} of + {a,#{k:=_}}=Tuple -> + Tuple + end. + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index e7215eeb64..26e2486dc2 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1644,14 +1644,15 @@ static ERL_NIF_TERM aes_cfb_8_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM int new_ivlen = 0; ERL_NIF_TERM ret; - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16 + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !(key.size == 16 || key.size == 24 || key.size == 32) || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { return enif_make_badarg(env); } memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, 128, &aes_key); + AES_set_encrypt_key(key.data, key.size * 8, &aes_key); AES_cfb8_encrypt((unsigned char *) text.data, enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, &new_ivlen, @@ -1670,14 +1671,15 @@ static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TE CHECK_OSE_CRYPTO(); - if (!enif_inspect_iolist_as_binary(env, argv[0], &key) || key.size != 16 + if (!enif_inspect_iolist_as_binary(env, argv[0], &key) + || !(key.size == 16 || key.size == 24 || key.size == 32) || !enif_inspect_binary(env, argv[1], &ivec) || ivec.size != 16 || !enif_inspect_iolist_as_binary(env, argv[2], &text)) { return enif_make_badarg(env); } memcpy(ivec_clone, ivec.data, 16); - AES_set_encrypt_key(key.data, 128, &aes_key); + AES_set_encrypt_key(key.data, key.size * 8, &aes_key); AES_cfb128_encrypt((unsigned char *) text.data, enif_make_new_binary(env, text.size, &ret), text.size, &aes_key, ivec_clone, &new_ivlen, diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index 03aa3964a5..53e29af338 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1185,6 +1185,38 @@ aes_cfb8() -> {aes_cfb8, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + {aes_cfb8, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb8, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("cdc80d6fddf18cab34c25909c99a4174"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb8, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("67ce7f7f81173621961a2b70171d3d7a"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb8, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("2e1e8a1dd59b88b1c8e60fed1efac4c9"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + {aes_cfb8, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb8, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("dc7e84bfda79164b7ecd8486985d3860"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb8, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("39ffed143b28b1c832113c6331e5407b"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb8, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("df10132415e54b92a13ed0a8267ae2f9"), hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} ]. @@ -1204,6 +1236,38 @@ aes_cfb128() -> {aes_cfb128, hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), hexstr2bin("26751F67A3CBB140B1808CF187A4F4DF"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + {aes_cfb128, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb128, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("cdc80d6fddf18cab34c25909c99a4174"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb128, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("67ce7f7f81173621961a2b70171d3d7a"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb128, + hexstr2bin("8e73b0f7da0e6452c810f32b809079e562f8ead2522c6b7b"), + hexstr2bin("2e1e8a1dd59b88b1c8e60fed1efac4c9"), + hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")}, + {aes_cfb128, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("000102030405060708090a0b0c0d0e0f"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a")}, + {aes_cfb128, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("dc7e84bfda79164b7ecd8486985d3860"), + hexstr2bin("ae2d8a571e03ac9c9eb76fac45af8e51")}, + {aes_cfb128, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("39ffed143b28b1c832113c6331e5407b"), + hexstr2bin("30c81c46a35ce411e5fbc1191a0a52ef")}, + {aes_cfb128, + hexstr2bin("603deb1015ca71be2b73aef0857d77811f352c073b6108d72d9810a30914dff4"), + hexstr2bin("df10132415e54b92a13ed0a8267ae2f9"), hexstr2bin("f69f2445df4f9b17ad2b417be66c3710")} ]. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl new file mode 100644 index 0000000000..945b2a9144 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl @@ -0,0 +1,23 @@ +%% In 17, the linter says that map(A) redefines 'type map', which is +%% allowed until next release. However, Dialyzer used to replace +%% map(A) with #{}, which resulted in warnings. + +-module(maps_redef2). + +-export([t/0]). + +-type map(_A) :: integer(). + +t() -> + M = new(), + t1(M). + +-spec t1(map(_)) -> map(_). + +t1(A) -> + A + A. + +-spec new() -> map(_). + +new() -> + 3. diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 689600258f..80718bc106 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -395,7 +395,7 @@ parse_args([{port, Port}|T], Cpid, Data) when is_integer(Port) -> parse_args([{timeout, Timeout}|T], Cpid, Data) when is_integer(Timeout),Timeout>0 -> parse_args(T, Cpid, Data#eldap{timeout = Timeout}); parse_args([{anon_auth, true}|T], Cpid, Data) -> - parse_args(T, Cpid, Data#eldap{anon_auth = false}); + parse_args(T, Cpid, Data#eldap{anon_auth = true}); parse_args([{anon_auth, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{ssl, true}|T], Cpid, Data) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 4b2bec5fa8..4215448c61 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2014. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -4230,7 +4230,7 @@ t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) -> {t_arity(), []}; t_from_form({type, _L, array, []}, TypeNames, RecDict, VarDict) -> - builtin_type(array, t_array(), TypeNames, RecDict, VarDict); + builtin_type(array, t_array(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) -> {t_atom(), []}; t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4253,9 +4253,9 @@ t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) -> {t_char(), []}; t_from_form({type, _L, dict, []}, TypeNames, RecDict, VarDict) -> - builtin_type(dict, t_dict(), TypeNames, RecDict, VarDict); + builtin_type(dict, t_dict(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, digraph, []}, TypeNames, RecDict, VarDict) -> - builtin_type(digraph, t_digraph(), TypeNames, RecDict, VarDict); + builtin_type(digraph, t_digraph(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) -> {t_float(), []}; t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4272,9 +4272,9 @@ t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict), {t_fun(L, T), R1 ++ R2}; t_from_form({type, _L, gb_set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_set, t_gb_set(), TypeNames, RecDict, VarDict); + builtin_type(gb_set, t_gb_set(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, gb_tree, []}, TypeNames, RecDict, VarDict) -> - builtin_type(gb_tree, t_gb_tree(), TypeNames, RecDict, VarDict); + builtin_type(gb_tree, t_gb_tree(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) -> {t_identifier(), []}; t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4288,8 +4288,12 @@ t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) -> t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) -> {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict), {t_list(T), R}; -t_from_form({type, _L, map, _}, TypeNames, RecDict, VarDict) -> - builtin_type(map, t_map([]), TypeNames, RecDict, VarDict); +t_from_form({type, _L, map, As0}, TypeNames, RecDict, VarDict) -> + As = case is_list(As0) of + true -> As0; + false -> [] + end, + builtin_type(map, t_map([]), As, TypeNames, RecDict, VarDict); t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) -> {t_mfa(), []}; t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) -> @@ -4348,7 +4352,7 @@ t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) -> {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict), {t_product(L), R}; t_from_form({type, _L, queue, []}, TypeNames, RecDict, VarDict) -> - builtin_type(queue, t_queue(), TypeNames, RecDict, VarDict); + builtin_type(queue, t_queue(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, range, [From, To]} = Type, _TypeNames, _RecDict, _VarDict) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of @@ -4361,13 +4365,13 @@ t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) -> t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) -> {t_reference(), []}; t_from_form({type, _L, set, []}, TypeNames, RecDict, VarDict) -> - builtin_type(set, t_set(), TypeNames, RecDict, VarDict); + builtin_type(set, t_set(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) -> {t_string(), []}; t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) -> {t_any(), []}; t_from_form({type, _L, tid, []}, TypeNames, RecDict, VarDict) -> - builtin_type(tid, t_tid(), TypeNames, RecDict, VarDict); + builtin_type(tid, t_tid(), [], TypeNames, RecDict, VarDict); t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) -> {t_timeout(), []}; t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) -> @@ -4384,10 +4388,10 @@ t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict, _VarDict) -> {t_opaque(Mod, Name, Args, Rep), []}. -builtin_type(Name, Type, TypeNames, RecDict, VarDict) -> - case lookup_type(Name, 0, RecDict) of +builtin_type(Name, Type, Args, TypeNames, RecDict, VarDict) -> + case lookup_type(Name, length(Args), RecDict) of {_, {_M, _T, _A}} -> - type_from_form(Name, [], TypeNames, RecDict, VarDict); + type_from_form(Name, Args, TypeNames, RecDict, VarDict); error -> {Type, []} end. @@ -4588,7 +4592,7 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; -t_form_to_string({type, _L, map, _}) -> +t_form_to_string({type, _L, map, Args}) when not is_list(Args) -> "#{}"; t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 7dfa56df29..a55fc137c3 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -102,10 +102,18 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map), - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src - I2 = mk_fconv(Dst, Src), + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), + I2 = + case hipe_ppc:is_temp(Src) of + true -> + mk_fconv(Dst, Src); + false -> + Tmp = new_untagged_temp(), + mk_li(Tmp, Src, + mk_fconv(Dst, Tmp)) + end, {I2, Map1, Data}. mk_fconv(Dst, Src) -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index bc61bec0bd..2f62dd79ad 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -413,11 +413,11 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. -move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. -move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +move_src_update(M, NewSrc) -> false = is_fpreg(NewSrc), M#move{src=NewSrc}. %% is_move(#move{}) -> true; %% is_move(_) -> false. @@ -469,7 +469,11 @@ phi_remove_pred(Phi, Pred) -> case NewArgList of [Arg] -> %% the phi should be turned into a move instruction {_Label,Var} = Arg, - mk_move(phi_dst(Phi), Var); + Dst = phi_dst(Phi), + case {is_fpreg(Dst), is_fpreg(Var)} of + {true, true} -> mk_fmove(Dst, Var); + {false, false} -> mk_move(Dst, Var) + end; %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), [_|_] -> Phi#phi{arglist=NewArgList} @@ -836,11 +840,11 @@ fp_unop_op(#fp_unop{op=Op}) -> Op. %% fmove %% -mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +mk_fmove(X, Y) -> true = is_fpreg(X), true = is_fpreg(Y), #fmove{dst=X, src=Y}. fmove_dst(#fmove{dst=Dst}) -> Dst. -fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_dst_update(M, NewDst) -> true = is_fpreg(NewDst), M#fmove{dst=NewDst}. fmove_src(#fmove{src=Src}) -> Src. -fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. +fmove_src_update(M, NewSrc) -> true = is_fpreg(NewSrc), M#fmove{src=NewSrc}. %% %% fconv diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index dc001f865e..fd21be3ae7 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -85,17 +85,17 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1), I2 = mk_fconv(Src, Dst), {I2, Map2, Data}. mk_fconv(Src, Dst) -> CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6 - Disp = hipe_sparc:mk_simm13(100), - [hipe_sparc:mk_store('stw', Src, CSP, Disp), - hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true), + Offset = 100, + mk_store('stw', Src, CSP, Offset) ++ + [hipe_sparc:mk_pseudo_fload(CSP, hipe_sparc:mk_simm13(Offset), Dst, true), hipe_sparc:mk_fp_unary('fitod', Dst, Dst)]. conv_fmove(I, Map, Data) -> diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index d77e4fed3b..36da2f4d44 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -236,7 +236,7 @@ conv_insn(I, Map, Data) -> #fconv{} -> {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map), {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), - I2 = [hipe_x86:mk_fmove(Src, Dst)], + I2 = conv_fconv(Dst, Src), {I2, Map1, Data}; X -> %% gctest?? @@ -712,6 +712,19 @@ vmap_lookup(Map, Key) -> vmap_bind(Map, Key, Val) -> gb_trees:insert(Key, Val, Map). +%%% Finalise the conversion of an Integer-to-Float operation. + +conv_fconv(Dst, Src) -> + case hipe_x86:is_imm(Src) of + false -> + [hipe_x86:mk_fmove(Src, Dst)]; + true -> + %% cvtsi2sd does not allow src to be an immediate + Tmp = new_untagged_temp(), + [hipe_x86:mk_move(Src, Tmp), + hipe_x86:mk_fmove(Tmp, Dst)] + end. + %%% Finalise the conversion of a 2-address FP operation. conv_fp_unary(Dst, Src, FpUnOp) -> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 4ca038cc99..20c8a6b1b1 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -249,7 +249,16 @@ <p>Limits the size of the message header of HTTP request. Defaults to 10240. </p> </item> - + + <marker id="prop_max_content_length"></marker> + <tag>{max_content_length, integer()}</tag> + <item> + <p>Maximum Content-Length in an incoming request, in bytes. Requests + with content larger than this are answered with Status 413. + Defaults to 100000000 (100 MB). + </p> + </item> + <marker id="prop_max_uri"></marker> <tag>{max_uri_size, integer()}</tag> <item> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index fb7034498c..7f73aa5e7b 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,7 +32,40 @@ <file>notes.xml</file> </header> - <section><title>Inets 5.10.4</title> + <section><title>Inets 5.10.5</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + mod_alias now handles https-URIs properly</p> + <p> + Consistent view of configuration parameter + keep_alive_timeout, should be presented in the + httpd:info/[1,2] function in the same unit as it is + inputted.</p> + <p> + Own Id: OTP-12436 Aux Id: seq12786 </p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Gracefully handle invalid content-lenght headers instead + of crashing in list_to_integer.</p> + <p> + Own Id: OTP-12429</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 5.10.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/examples/httpd_load_test/hdlt_slave.erl b/lib/inets/examples/httpd_load_test/hdlt_slave.erl index 52af9b5b90..41361418bc 100644 --- a/lib/inets/examples/httpd_load_test/hdlt_slave.erl +++ b/lib/inets/examples/httpd_load_test/hdlt_slave.erl @@ -180,7 +180,7 @@ ssh_slave_start(Host, ErlCmd) -> ?DEBUG("ssh_exec_erl -> done", []), {ok, Connection, Channel}; Error3 -> - ?LOG("failed exec comand: ~p", [Error3]), + ?LOG("failed exec command: ~p", [Error3]), throw({error, {ssh_exec_failed, Error3}}) end. diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 134115bdfa..ed306a84f5 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -334,9 +334,23 @@ add_domain(Str, #http_cookie{domain_default = true}) -> add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. +is_set_cookie_valid("") -> + %% an empty Set-Cookie header is not valid + false; +is_set_cookie_valid([$=|_]) -> + %% a Set-Cookie header without name is not valid + false; +is_set_cookie_valid(SetCookieHeader) -> + %% a Set-Cookie header without name/value is not valid + case string:chr(SetCookieHeader, $=) of + 0 -> false; + _ -> true + end. + parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - %% empty Set-Cookie header is invalid according to RFC but some sites violate it - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], + %% filter invalid Set-Cookie headers + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, + is_set_cookie_valid(Value)], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), @@ -348,6 +362,8 @@ parse_set_cookie(CookieHeader, {DefaultPath, DefaultDomain}) -> Name = string:substr(CookieHeader, 1, Pos - 1), {Value, Attrs} = case string:substr(CookieHeader, Pos + 1) of + [] -> + {"", ""}; [$;|ValueAndAttrs] -> {"", string:tokens(ValueAndAttrs, ";")}; ValueAndAttrs -> diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 53b776c4e7..54425740b5 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -28,6 +28,7 @@ -define(HTTP_MAX_URI_SIZE, nolimit). -define(HTTP_MAX_VERSION_STRING, 8). -define(HTTP_MAX_METHOD_STRING, 20). +-define(HTTP_MAX_CONTENT_LENGTH, 100000000). -ifndef(HTTP_DEFAULT_SSL_KIND). -define(HTTP_DEFAULT_SSL_KIND, essl). diff --git a/lib/inets/src/http_lib/http_request.erl b/lib/inets/src/http_lib/http_request.erl index f295453bdd..a0833ddf01 100644 --- a/lib/inets/src/http_lib/http_request.erl +++ b/lib/inets/src/http_lib/http_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,8 +21,16 @@ -include("http_internal.hrl"). --export([headers/2, http_headers/1, is_absolut_uri/1]). +-export([headers/2, http_headers/1, is_absolut_uri/1, key_value/1]). + +key_value(KeyValueStr) -> + case lists:splitwith(fun($:) -> false; (_) -> true end, KeyValueStr) of + {Key, [$: | Value]} -> + {http_util:to_lower(string:strip(Key)), string:strip(Value)}; + {_, []} -> + undefined + end. %%------------------------------------------------------------------------- %% headers(HeaderList, #http_request_h{}) -> #http_request_h{} %% HeaderList - ["HeaderField:Value"] @@ -34,14 +42,12 @@ %%------------------------------------------------------------------------- headers([], Headers) -> Headers; -headers([Header | Tail], Headers) -> - case lists:splitwith(fun($:) -> false; (_) -> true end, Header) of - {Key, [$: | Value]} -> - headers(Tail, headers(http_util:to_lower(string:strip(Key)), - string:strip(Value), Headers)); - {_, []} -> - headers(Tail, Headers) - end. +headers([{Key, Value} | Tail], Headers) -> + headers(Tail, headers(Key, Value, Headers)); +headers([undefined], Headers) -> + Headers; +headers(KeyValues, Headers) -> + headers([key_value(KeyValue) || KeyValue <- KeyValues], Headers). %%------------------------------------------------------------------------- %% headers(#http_request_h{}) -> HeaderList diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 8f68d9fcd5..78dda794db 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -205,13 +205,13 @@ load("MaxURISize " ++ MaxHeaderSize, []) -> " is an invalid number of MaxHeaderSize")} end; -load("MaxBodySize " ++ MaxBodySize, []) -> - case make_integer(MaxBodySize) of +load("MaxContentLength " ++ Max, []) -> + case make_integer(Max) of {ok, Integer} -> - {ok, [], {max_body_size,Integer}}; + {ok, [], {max_content_length, Integer}}; {error, _} -> - {error, ?NICE(clean(MaxBodySize) ++ - " is an invalid number of MaxBodySize")} + {error, ?NICE(clean(Max) ++ + " is an invalid number of MaxContentLength")} end; load("ServerName " ++ ServerName, []) -> @@ -337,7 +337,7 @@ load("MaxKeepAliveRequest " ++ MaxRequests, []) -> load("KeepAliveTimeout " ++ Timeout, []) -> case make_integer(Timeout) of {ok, Integer} -> - {ok, [], {keep_alive_timeout, Integer*1000}}; + {ok, [], {keep_alive_timeout, Integer}}; {error, _} -> {error, ?NICE(clean(Timeout)++" is an invalid KeepAliveTimeout")} end; @@ -569,6 +569,12 @@ validate_config_params([{max_body_size, Value} | Rest]) validate_config_params([{max_body_size, Value} | _]) -> throw({max_body_size, Value}); +validate_config_params([{max_content_length, Value} | Rest]) + when is_integer(Value) andalso (Value > 0) -> + validate_config_params(Rest); +validate_config_params([{max_content_length, Value} | _]) -> + throw({max_content_length, Value}); + validate_config_params([{server_name, Value} | Rest]) when is_list(Value) -> validate_config_params(Rest); @@ -635,7 +641,7 @@ validate_config_params([{max_keep_alive_request, Value} | Rest]) when is_integer(Value) andalso (Value > 0) -> validate_config_params(Rest); validate_config_params([{max_keep_alive_request, Value} | _]) -> - throw({max_header_size, Value}); + throw({max_keep_alive_request, Value}); validate_config_params([{keep_alive_timeout, Value} | Rest]) when is_integer(Value) andalso (Value >= 0) -> @@ -799,7 +805,7 @@ store({server_tokens, ServerTokens} = Entry, _ConfigList) -> Server = server(ServerTokens), {ok, [Entry, {server, Server}]}; store({keep_alive_timeout, KeepAliveTimeout}, _ConfigList) -> - {ok, {keep_alive_timeout, KeepAliveTimeout * 1000}}; + {ok, {keep_alive_timeout, KeepAliveTimeout}}; store(ConfigListEntry, _ConfigList) -> {ok, ConfigListEntry}. diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index 712c73599f..6985065c3e 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2014. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -118,18 +118,17 @@ validate(Method, Uri, Version) -> %% create it. %% ---------------------------------------------------------------------- update_mod_data(ModData, Method, RequestURI, HTTPVersion, Headers)-> - ParsedHeaders = tagup_header(Headers), - PersistentConn = get_persistens(HTTPVersion, ParsedHeaders, + PersistentConn = get_persistens(HTTPVersion, Headers, ModData#mod.config_db), {ok, ModData#mod{data = [], method = Method, absolute_uri = format_absolute_uri(RequestURI, - ParsedHeaders), + Headers), request_uri = format_request_uri(RequestURI), http_version = HTTPVersion, request_line = Method ++ " " ++ RequestURI ++ " " ++ HTTPVersion, - parsed_header = ParsedHeaders, + parsed_header = Headers, connection = PersistentConn}}. %%%======================================================================== @@ -146,14 +145,14 @@ parse_method(_, _, _, Max, _, _) -> %% We do not know the version of the client as it comes after the %% method send the lowest version in the response so that the client %% will be able to handle it. - {error, {too_long, Max, 413, "Method unreasonably long"}, lowest_version()}. + {error, {size_error, Max, 413, "Method unreasonably long"}, lowest_version()}. parse_uri(_, _, Current, MaxURI, _, _) when (Current > MaxURI) andalso (MaxURI =/= nolimit) -> %% We do not know the version of the client as it comes after the %% uri send the lowest version in the response so that the client %% will be able to handle it. - {error, {too_long, MaxURI, 414, "URI unreasonably long"},lowest_version()}; + {error, {size_error, MaxURI, 414, "URI unreasonably long"},lowest_version()}; parse_uri(<<>>, URI, Current, Max, MaxSizes, Result) -> {?MODULE, parse_uri, [URI, Current, Max, MaxSizes, Result]}; parse_uri(<<?SP, Rest/binary>>, URI, _, _, MaxSizes, Result) -> @@ -179,12 +178,12 @@ parse_version(<<?CR>> = Data, Version, Current, Max, MaxSizes, Result) -> parse_version(<<Octet, Rest/binary>>, Version, Current, Max, MaxSizes, Result) when Current =< Max -> parse_version(Rest, [Octet | Version], Current + 1, Max, MaxSizes, Result); parse_version(_, _, _, Max,_,_) -> - {error, {too_long, Max, 413, "Version string unreasonably long"}, lowest_version()}. + {error, {size_error, Max, 413, "Version string unreasonably long"}, lowest_version()}. parse_headers(_, _, _, Current, Max, _, Result) when Max =/= nolimit andalso Current > Max -> HttpVersion = lists:nth(3, lists:reverse(Result)), - {error, {too_long, Max, 413, "Headers unreasonably long"}, HttpVersion}; + {error, {size_error, Max, 413, "Headers unreasonably long"}, HttpVersion}; parse_headers(<<>>, Header, Headers, Current, Max, MaxSizes, Result) -> {?MODULE, parse_headers, [<<>>, Header, Headers, Current, Max, @@ -204,14 +203,22 @@ parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, [], [], _, _, _, Result) -> Result])), {ok, NewResult}; parse_headers(<<?CR,?LF,?CR,?LF,Body/binary>>, Header, Headers, _, _, - _, Result) -> - HTTPHeaders = [lists:reverse(Header) | Headers], - RequestHeaderRcord = - http_request:headers(HTTPHeaders, #http_request_h{}), - NewResult = - list_to_tuple(lists:reverse([Body, {RequestHeaderRcord, - HTTPHeaders} | Result])), - {ok, NewResult}; + MaxSizes, Result) -> + case http_request:key_value(lists:reverse(Header)) of + undefined -> %% Skip headers with missing : + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers(Headers, #http_request_h{}), Headers} | Result]))}; + NewHeader -> + case check_header(NewHeader, MaxSizes) of + ok -> + {ok, list_to_tuple(lists:reverse([Body, {http_request:headers([NewHeader | Headers], + #http_request_h{}), + [NewHeader | Headers]} | Result]))}; + + {error, Reason} -> + HttpVersion = lists:nth(3, lists:reverse(Result)), + {error, Reason, HttpVersion} + end + end; parse_headers(<<?CR,?LF,?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> @@ -243,8 +250,21 @@ parse_headers(<<?LF, Octet, Rest/binary>>, Header, Headers, Current, Max, MaxSizes, Result); parse_headers(<<?CR,?LF, Octet, Rest/binary>>, Header, Headers, _, Max, MaxSizes, Result) -> - parse_headers(Rest, [Octet], [lists:reverse(Header) | Headers], - 0, Max, MaxSizes, Result); + case http_request:key_value(lists:reverse(Header)) of + undefined -> %% Skip headers with missing : + parse_headers(Rest, [Octet], Headers, + 0, Max, MaxSizes, Result); + NewHeader -> + case check_header(NewHeader, MaxSizes) of + ok -> + parse_headers(Rest, [Octet], [NewHeader | Headers], + 0, Max, MaxSizes, Result); + {error, Reason} -> + HttpVersion = lists:nth(3, lists:reverse(Result)), + {error, Reason, HttpVersion} + end + end; + parse_headers(<<?CR>> = Data, Header, Headers, Current, Max, MaxSizes, Result) -> {?MODULE, parse_headers, [Data, Header, Headers, Current, Max, @@ -388,29 +408,25 @@ get_persistens(HTTPVersion,ParsedHeader,ConfigDB)-> false end. - -%%---------------------------------------------------------------------- -%% tagup_header -%% -%% Parses the header of a HTTP request and returns a key,value tuple -%% list containing Name and Value of each header directive as of: -%% -%% Content-Type: multipart/mixed -> {"Content-Type", "multipart/mixed"} -%% -%% But in http/1.1 the field-names are case insencitive so now it must be -%% Content-Type: multipart/mixed -> {"content-type", "multipart/mixed"} -%% The standard furthermore says that leading and traling white space -%% is not a part of the fieldvalue and shall therefore be removed. -%%---------------------------------------------------------------------- -tagup_header([]) -> []; -tagup_header([Line|Rest]) -> [tag(Line, [])|tagup_header(Rest)]. - -tag([], Tag) -> - {http_util:to_lower(lists:reverse(Tag)), ""}; -tag([$:|Rest], Tag) -> - {http_util:to_lower(lists:reverse(Tag)), string:strip(Rest)}; -tag([Chr|Rest], Tag) -> - tag(Rest, [Chr|Tag]). - lowest_version()-> "HTTP/0.9". + +check_header({"content-length", Value}, Maxsizes) -> + Max = proplists:get_value(max_content_length, Maxsizes), + MaxLen = length(integer_to_list(Max)), + case length(Value) =< MaxLen of + true -> + try + _ = list_to_integer(Value), + ok + catch _:_ -> + {error, {size_error, Max, 411, "content-length not an integer"}} + end; + false -> + {error, {size_error, Max, 413, "content-length unreasonably long"}} + end; +check_header(_, _) -> + ok. + + + diff --git a/lib/inets/src/http_server/httpd_request_handler.erl b/lib/inets/src/http_server/httpd_request_handler.erl index 9bea58cc9e..f7a9fe5d49 100644 --- a/lib/inets/src/http_server/httpd_request_handler.erl +++ b/lib/inets/src/http_server/httpd_request_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -96,8 +96,9 @@ init([Manager, ConfigDB, AcceptTimeout]) -> proc_lib:init_ack({ok, self()}), {SocketType, Socket} = await_socket_ownership_transfer(AcceptTimeout), - - KeepAliveTimeOut = httpd_util:lookup(ConfigDB, keep_alive_timeout, 150000), + + %%Timeout value is in seconds we want it in milliseconds + KeepAliveTimeOut = 1000 * httpd_util:lookup(ConfigDB, keep_alive_timeout, 150), case http_transport:negotiate(SocketType, Socket, ?HANDSHAKE_TIMEOUT) of {error, _Error} -> @@ -119,11 +120,15 @@ continue_init(Manager, ConfigDB, SocketType, Socket, TimeOut) -> MaxHeaderSize = max_header_size(ConfigDB), MaxURISize = max_uri_size(ConfigDB), NrOfRequest = max_keep_alive_request(ConfigDB), - + MaxContentLen = max_content_length(ConfigDB), + {_, Status} = httpd_manager:new_connection(Manager), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, - {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, MaxContentLen} + ]]}, State = #state{mod = Mod, manager = Manager, @@ -207,7 +212,7 @@ handle_info({Proto, Socket, Data}, set_new_data_size(cancel_request_timeout(State), NewDataSize) end, handle_http_msg(Result, NewState); - {error, {too_long, MaxSize, ErrCode, ErrStr}, Version} -> + {error, {size_error, MaxSize, ErrCode, ErrStr}, Version} -> NewModData = ModData#mod{http_version = Version}, httpd_response:send_status(NewModData, ErrCode, ErrStr), Reason = io_lib:format("~p: ~p max size is ~p~n", @@ -444,8 +449,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, error_log(Reason, ModData), {stop, normal, State#state{response_sent = true}}; _ -> - Length = - list_to_integer(Headers#http_request_h.'content-length'), + Length = list_to_integer(Headers#http_request_h.'content-length'), case ((Length =< MaxBodySize) or (MaxBodySize == nolimit)) of true -> case httpd_request:whole_body(Body, Length) of @@ -454,7 +458,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, ModData#mod.socket, [{active, once}]), {noreply, State#state{mfa = - {Module, Function, Args}}}; + {Module, Function, Args}}}; {ok, NewBody} -> handle_response( @@ -471,7 +475,7 @@ handle_body(#state{headers = Headers, body = Body, mod = ModData} = State, handle_expect(#state{headers = Headers, mod = #mod{config_db = ConfigDB} = ModData} = State, MaxBodySize) -> - Length = Headers#http_request_h.'content-length', + Length = list_to_integer(Headers#http_request_h.'content-length'), case expect(Headers, ModData#mod.http_version, ConfigDB) of continue when (MaxBodySize > Length) orelse (MaxBodySize =:= nolimit) -> httpd_response:send_status(ModData, 100, ""), @@ -545,9 +549,13 @@ handle_next_request(#state{mod = #mod{connection = true} = ModData, init_data = ModData#mod.init_data}, MaxHeaderSize = max_header_size(ModData#mod.config_db), MaxURISize = max_uri_size(ModData#mod.config_db), + MaxContentLen = max_content_length(ModData#mod.config_db), MFA = {httpd_request, parse, [[{max_uri, MaxURISize}, {max_header, MaxHeaderSize}, - {max_version, ?HTTP_MAX_VERSION_STRING}, {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_version, ?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, MaxContentLen} + ]]}, TmpState = State#state{mod = NewModData, mfa = MFA, max_keep_alive_request = decrease(Max), @@ -630,3 +638,5 @@ max_body_size(ConfigDB) -> max_keep_alive_request(ConfigDB) -> httpd_util:lookup(ConfigDB, max_keep_alive_request, infinity). +max_content_length(ConfigDB) -> + httpd_util:lookup(ConfigDB, max_content_length, ?HTTP_MAX_CONTENT_LENGTH). diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 0b9fe4cfe0..5039cd56b5 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -55,6 +55,7 @@ do(#mod{data = Data} = Info) -> do_alias(#mod{config_db = ConfigDB, request_uri = ReqURI, + socket_type = SocketType, data = Data}) -> {ShortPath, Path, AfterPath} = real_name(ConfigDB, ReqURI, which_alias(ConfigDB)), @@ -70,8 +71,9 @@ do_alias(#mod{config_db = ConfigDB, (LastChar =/= $/)) -> ?hdrt("directory and last-char is a /", []), ServerName = which_server_name(ConfigDB), - Port = port_string( which_port(ConfigDB) ), - URL = "http://" ++ ServerName ++ Port ++ ReqURI ++ "/", + Port = port_string(which_port(ConfigDB)), + Protocol = get_protocol(SocketType), + URL = Protocol ++ ServerName ++ Port ++ ReqURI ++ "/", ReasonPhrase = httpd_util:reason_phrase(301), Message = httpd_util:message(301, URL, ConfigDB), {proceed, @@ -94,6 +96,12 @@ port_string(80) -> port_string(Port) -> ":" ++ integer_to_list(Port). +get_protocol(ip_comm) -> + "http://"; +get_protocol(_) -> + %% Should clean up to have only one ssl type essl vs ssl is not relevant any more + "https://". + %% real_name real_name(ConfigDB, RequestURI, []) -> diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl index d4a3f28f38..5952e9fd6e 100644 --- a/lib/inets/test/http_format_SUITE.erl +++ b/lib/inets/test/http_format_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -355,10 +355,12 @@ http_request(Config) when is_list(Config) -> "http://www.erlang.org", "HTTP/1.1", {#http_request_h{host = "www.erlang.org", te = []}, - ["te: ","host:www.erlang.org"]}, <<>>} = + [{"te", []}, {"host", "www.erlang.org"}]}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead), HttpHead1 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -369,7 +371,9 @@ http_request(Config) when is_list(Config) -> {#http_request_h{}, []}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead1), + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead1), HttpHead2 = ["GET http://www.erlang.org HTTP/1.1" ++ @@ -380,7 +384,9 @@ http_request(Config) when is_list(Config) -> {#http_request_h{}, []}, <<>>} = parse(httpd_request, parse, [[{max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version, ?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], HttpHead2), + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], HttpHead2), %% Note the following body is not related to the headers above HttpBody = ["<HTML>\n<HEAD>\n<TITLE> dummy </TITLE>\n</HEAD>\n<BODY>\n", diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c535d59b9f..21be7862cb 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2014. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -91,6 +91,7 @@ only_simulated() -> cookie, cookie_profile, empty_set_cookie, + invalid_set_cookie, trace, stream_once, stream_single_chunk, @@ -568,6 +569,18 @@ empty_set_cookie(Config) when is_list(Config) -> ok = httpc:set_options([{cookies, disabled}]). %%------------------------------------------------------------------------- +invalid_set_cookie(doc) -> + ["Test ignoring invalid Set-Cookie header"]; +invalid_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + URL = url(group_name(Config), "/invalid_set_cookie.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, []}, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -1246,8 +1259,9 @@ dummy_server_init(Caller, ip_comm, Inet, _) -> dummy_ipcomm_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]}, - [], ListenSocket); + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH}]]}, + [], ListenSocket); dummy_server_init(Caller, ssl, Inet, SSLOptions) -> BaseOpts = [binary, {reuseaddr,true}, {active, false} | @@ -1261,7 +1275,9 @@ dummy_ssl_server_init(Caller, BaseOpts, Inet) -> dummy_ssl_server_loop({httpd_request, parse, [[{max_uri, ?HTTP_MAX_URI_SIZE}, {max_method, ?HTTP_MAX_METHOD_STRING}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]]}, [], ListenSocket). dummy_ipcomm_server_loop(MFA, Handlers, ListenSocket) -> @@ -1338,16 +1354,20 @@ handle_request(Module, Function, Args, Socket) -> stop -> stop; <<>> -> - {httpd_request, parse, [[<<>>, [{max_uri, ?HTTP_MAX_URI_SIZE}, + {httpd_request, parse, [[{max_uri,?HTTP_MAX_URI_SIZE}, {max_header, ?HTTP_MAX_HEADER_SIZE}, {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]]]}; + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]]}; Data -> handle_request(httpd_request, parse, [Data, [{max_uri, ?HTTP_MAX_URI_SIZE}, - {max_header, ?HTTP_MAX_HEADER_SIZE}, - {max_version,?HTTP_MAX_VERSION_STRING}, - {max_method, ?HTTP_MAX_METHOD_STRING}]], Socket) + {max_header, ?HTTP_MAX_HEADER_SIZE}, + {max_version,?HTTP_MAX_VERSION_STRING}, + {max_method, ?HTTP_MAX_METHOD_STRING}, + {max_content_length, ?HTTP_MAX_CONTENT_LENGTH} + ]], Socket) end; NewMFA -> NewMFA @@ -1437,7 +1457,7 @@ dummy_ssl_server_hang_loop(_) -> ensure_host_header_with_port([]) -> false; -ensure_host_header_with_port(["host: " ++ Host| _]) -> +ensure_host_header_with_port([{"host", Host}| _]) -> case string:tokens(Host, [$:]) of [_ActualHost, _Port] -> true; @@ -1449,7 +1469,7 @@ ensure_host_header_with_port([_|T]) -> auth_header([]) -> auth_header_not_found; -auth_header(["authorization:" ++ Value | _]) -> +auth_header([{"authorization", Value} | _]) -> {ok, string:strip(Value)}; auth_header([_ | Tail]) -> auth_header(Tail). @@ -1466,7 +1486,7 @@ handle_auth("Basic " ++ UserInfo, Challange, DefaultResponse) -> check_cookie([]) -> ct:fail(no_cookie_header); -check_cookie(["cookie:" ++ _Value | _]) -> +check_cookie([{"cookie", _} | _]) -> ok; check_cookie([_Head | Tail]) -> check_cookie(Tail). @@ -1686,6 +1706,14 @@ handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/invalid_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: =\r\n" ++ + "set-cookie: name=\r\n" ++ + "set-cookie: name-or-value\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index 4010597657..342004f19b 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -132,6 +132,7 @@ http_get() -> bad_hex, missing_CR, max_header, + max_content_length, ipv6 ]. @@ -979,13 +980,22 @@ max_header(Config) when is_list(Config) -> Host = ?config(host, Config), case Version of "HTTP/0.9" -> - {skip, no_implemented}; + {skip, not_implemented}; _ -> dos_hostname(?config(type, Config), ?config(port, Config), Host, ?config(node, Config), Version, ?MAX_HEADER_SIZE) end. %%------------------------------------------------------------------------- +max_content_length() -> + ["Denial Of Service (DOS) attack, prevented by max_content_length"]. +max_content_length(Config) when is_list(Config) -> + Version = ?config(http_version, Config), + Host = ?config(host, Config), + garbage_content_length(?config(type, Config), ?config(port, Config), Host, + ?config(node, Config), Version). + +%%------------------------------------------------------------------------- security_1_1(Config) when is_list(Config) -> security([{http_version, "HTTP/1.1"} | Config]). @@ -1368,7 +1378,9 @@ server_config(http_reload, Config) -> server_config(https_reload, Config) -> [{keep_alive_timeout, 2}] ++ server_config(https, Config); server_config(http_limit, Config) -> - [{max_clients, 1}] ++ server_config(http, Config); + [{max_clients, 1}, + %% Make sure option checking code is run + {max_content_length, 100000002}] ++ server_config(http, Config); server_config(https_limit, Config) -> [{max_clients, 1}] ++ server_config(https, Config); server_config(http_basic_auth, Config) -> @@ -1814,7 +1826,7 @@ dos_hostname(Type, Port, Host, Node, Version, Max) -> ok = httpd_test_lib:verify_request(Type, Host, Port, Node, dos_hostname_request(TooLongHeader, Version), - [{statuscode, dos_code(Version)}, + [{statuscode, request_entity_too_large_code(Version)}, {version, Version}]). dos_hostname_request(Host, Version) -> dos_http_request("GET / ", Version, Host). @@ -1824,11 +1836,32 @@ dos_http_request(Request, "HTTP/1.1" = Version, Host) -> dos_http_request(Request, Version, Host) -> Request ++ Version ++ "\r\nhost:" ++ Host ++ "\r\n\r\n". -dos_code("HTTP/1.0") -> +request_entity_too_large_code("HTTP/1.0") -> 403; %% 413 not defined in HTTP/1.0 -dos_code(_) -> +request_entity_too_large_code(_) -> 413. +length_required_code("HTTP/1.0") -> + 403; %% 411 not defined in HTTP/1.0 +length_required_code(_) -> + 411. + +garbage_content_length(Type, Port, Host, Node, Version) -> + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + garbage_content_length_request("GET / ", Version, Host, "aaaa"), + [{statuscode, length_required_code(Version)}, + {version, Version}]), + ok = httpd_test_lib:verify_request(Type, Host, Port, Node, + garbage_content_length_request("GET / ", Version, Host, + lists:duplicate($a, 100)), + [{statuscode, request_entity_too_large_code(Version)}, + {version, Version}]). + +garbage_content_length_request(Request, Version, Host, Garbage) -> + http_request(Request, Version, Host, + {"content-length:" ++ Garbage, "Body with garbage content length indicator"}). + + update_password(Node, ServerRoot, _Address, Port, AuthPrefix, Dir, Old, New)-> Directory = filename:join([ServerRoot, "htdocs", AuthPrefix ++ Dir]), rpc:call(Node, mod_auth, update_password, diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index dbae5e4b3c..7d11916454 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,6 +18,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.10.4 +INETS_VSN = 5.10.5 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/inet.xml b/lib/kernel/doc/src/inet.xml index 8dd311e5cd..77a8caaaf6 100644 --- a/lib/kernel/doc/src/inet.xml +++ b/lib/kernel/doc/src/inet.xml @@ -332,23 +332,23 @@ fe80::204:acff:fe17:bf38 <taglist> <tag><c>recv_avg</c></tag> <item> - <p>Average size of packets in bytes received to the socket.</p> + <p>Average size of packets in bytes received by the socket.</p> </item> <tag><c>recv_cnt</c></tag> <item> - <p>Number of packets received to the socket.</p> + <p>Number of packets received by the socket.</p> </item> <tag><c>recv_dvi</c></tag> <item> - <p>Average packet size deviation in bytes received to the socket.</p> + <p>Average packet size deviation in bytes received by the socket.</p> </item> <tag><c>recv_max</c></tag> <item> - <p>The size of the largest packet in bytes received to the socket.</p> + <p>The size of the largest packet in bytes received by the socket.</p> </item> <tag><c>recv_oct</c></tag> <item> - <p>Number of bytes received to the socket.</p> + <p>Number of bytes received by the socket.</p> </item> <tag><c>send_avg</c></tag> diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index daad45b6c2..6635885aaf 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1615,7 +1615,6 @@ conv([Key, Val | T]) -> [{make_term(Key), make_term(Val)} | conv(T)]; conv(_) -> []. -%%% Fix some day: eliminate the duplicated code here make_term(Str) -> case erl_scan:string(Str) of {ok, Tokens, _} -> @@ -1623,16 +1622,17 @@ make_term(Str) -> {ok, Term} -> Term; {error, {_,M,Reason}} -> - error_logger:format("application_controller: ~ts: ~ts~n", - [M:format_error(Reason), Str]), - throw({error, {bad_environment_value, Str}}) + handle_make_term_error(M, Reason, Str) end; {error, {_,M,Reason}, _} -> - error_logger:format("application_controller: ~ts: ~ts~n", - [M:format_error(Reason), Str]), - throw({error, {bad_environment_value, Str}}) + handle_make_term_error(M, Reason, Str) end. +handle_make_term_error(Mod, Reason, Str) -> + error_logger:format("application_controller: ~ts: ~ts~n", + [Mod:format_error(Reason), Str]), + throw({error, {bad_environment_value, Str}}). + get_env_i(Name, #state{conf_data = ConfData}) when is_list(ConfData) -> case lists:keyfind(Name, 1, ConfData) of {_Name, Env} -> Env; diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 70dceb3679..860eec10a0 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -78,7 +78,7 @@ ipv6_v6only. -type socket() :: port(). --export_type([option/0, option_name/0]). +-export_type([option/0, option_name/0, socket/0]). -spec open(Port) -> {ok, Socket} | {error, Reason} when Port :: inet:port_number(), diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index 43bab8bcf0..ec2c350931 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1070,7 +1070,7 @@ gethostbyname_tm(Name, Type, Timer, [wins|_]=Opts) -> gethostbyname_tm_native(Name, Type, Timer, Opts); gethostbyname_tm(Name, Type, Timer, [native|_]=Opts) -> gethostbyname_tm_native(Name, Type, Timer, Opts); -gethostbyname_tm(Name, Type, Timer, [_|_]=Opts) -> +gethostbyname_tm(Name, Type, Timer, [_|Opts]) -> gethostbyname_tm(Name, Type, Timer, Opts); %% Make sure we always can look up our own hostname. gethostbyname_tm(Name, Type, Timer, []) -> diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 10cf77e0d4..1c43063937 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -63,7 +63,7 @@ server(PortName,PortSettings) -> run(Port). run(P) -> - put(unicode,false), + put(encoding, latin1), server_loop(P). server_loop(Port) -> @@ -95,25 +95,47 @@ do_io_request(Req, From, ReplyAs, Port) -> io_reply(From, ReplyAs, Reply). %% New in R13B -% Wide characters (Unicode) -io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port); -io_request({put_chars,Encoding,Mod,Func,Args}, Port) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port); +%% Encoding option (unicode/latin1) +io_request({put_chars,unicode,Chars}, Port) -> + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars}}; + Bin -> + put_chars(Bin, Port) + end; +io_request({put_chars,unicode,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + error -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Chars}, Port) -> + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port); + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data, latin1, get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + _ -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; %% BC if called from pre-R13 node io_request({put_chars,Chars}, Port) -> io_request({put_chars,latin1,Chars}, Port); @@ -134,10 +156,10 @@ io_request({get_geometry,rows},Port) -> _ -> {error,{error,enotsup}} end; -io_request({getopts,[]}, Port) -> - getopts(Port); -io_request({setopts,Opts}, Port) when is_list(Opts) -> - setopts(Opts, Port); +io_request(getopts, _Port) -> + getopts(); +io_request({setopts,Opts}, _Port) when is_list(Opts) -> + setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -176,47 +198,48 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port) when is_binary(Chars) -> _ = put_port(Chars, Port), - {ok,ok}; -put_chars(Chars, Port) -> - case catch list_to_binary(Chars) of - Binary when is_binary(Binary) -> - put_chars(Binary, Port); - _ -> - {error,{error,put_chars}} - end. + {ok,ok}. %% setopts -setopts(Opts0,Port) -> - Opts = proplists:unfold( - proplists:substitute_negations( - [{latin1,unicode}], - Opts0)), +setopts(Opts0) -> + Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of - true -> - do_setopts(Opts,Port); - false -> - {error,{error,enotsup}} + true -> + do_setopts(Opts); + false -> + {error,{error,enotsup}} end. + check_valid_opts([]) -> true; -check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; + Valid =:= utf8; Valid =:= latin1 -> check_valid_opts(T); check_valid_opts(_) -> false. -do_setopts(Opts, _Port) -> - case proplists:get_value(unicode,Opts) of - Valid when Valid =:= true; Valid =:= utf8 -> - put(unicode,true); - false -> - put(unicode,false); - undefined -> - ok +expand_encoding([]) -> + []; +expand_encoding([latin1 | T]) -> + [{encoding,latin1} | expand_encoding(T)]; +expand_encoding([unicode | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([H|T]) -> + [H|expand_encoding(T)]. + +do_setopts(Opts) -> + case proplists:get_value(encoding, Opts) of + Valid when Valid =:= unicode; Valid =:= utf8 -> + put(encoding, unicode); + latin1 -> + put(encoding, latin1); + undefined -> + ok end, {ok,ok}. -getopts(_Port) -> - Uni = {unicode, get(unicode) =:= true}, +getopts() -> + Uni = {encoding,get(encoding)}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> @@ -227,17 +250,17 @@ wrap_characters_to_binary(Chars,From,To) -> _Else -> 16#10ffff end, - unicode:characters_to_binary( - [ case X of - $\n -> - if - TrNl -> - "\r\n"; - true -> - $\n - end; - High when High > Limit -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Ordinary -> - Ordinary - end || X <- unicode:characters_to_list(Chars,From) ],unicode,To). + case catch unicode:characters_to_list(Chars, From) of + L when is_list(L) -> + unicode:characters_to_binary( + [ case X of + $\n when TrNl -> + "\r\n"; + High when High > Limit -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ], unicode, To); + _ -> + error + end. diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index f1b8a105ed..ef351a25fb 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -77,7 +77,8 @@ MODULES= \ ignore_cores \ zlib_SUITE \ loose_node \ - sendfile_SUITE + sendfile_SUITE \ + standard_error_SUITE APP_FILES = \ appinc.app \ diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl index d45dfc2173..849013ac79 100644 --- a/lib/kernel/test/inet_SUITE.erl +++ b/lib/kernel/test/inet_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -36,6 +36,7 @@ gethostnative_parallell/1, cname_loop/1, gethostnative_soft_restart/0, gethostnative_soft_restart/1, gethostnative_debug_level/0, gethostnative_debug_level/1, + lookup_bad_search_option/1, getif/1, getif_ifr_name_overflow/1,getservbyname_overflow/1, getifaddrs/1, parse_strict_address/1, simple_netns/1, simple_netns_open/1]). @@ -52,6 +53,7 @@ all() -> ipv4_to_ipv6, host_and_addr, {group, parse}, t_gethostnative, gethostnative_parallell, cname_loop, gethostnative_debug_level, gethostnative_soft_restart, + lookup_bad_search_option, getif, getif_ifr_name_overflow, getservbyname_overflow, getifaddrs, parse_strict_address, simple_netns, simple_netns_open]. @@ -908,6 +910,21 @@ lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) -> +lookup_bad_search_option(suite) -> + []; +lookup_bad_search_option(doc) -> + ["Test lookup with erroneously configured lookup option (OTP-12133)"]; +lookup_bad_search_option(Config) when is_list(Config) -> + Db = inet_db, + %% The bad option can not enter through inet_db:set_lookup/1, + %% but through e.g .inetrc. + ets:insert(Db, {res_lookup,[lookup_bad_search_option]}), + {ok,Hostname} = inet:gethostname(), + {ok,_Hent} = inet:gethostbyname(Hostname), % Will hang loop for this bug + ok. + + + getif(suite) -> []; getif(doc) -> diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl new file mode 100644 index 0000000000..b290454b40 --- /dev/null +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(standard_error_SUITE). + +-export([all/0,suite/0]). +-export([badarg/1,getopts/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [badarg,getopts]. + +badarg(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])), + true = erlang:is_process_alive(whereis(standard_error)), + ok. + +getopts(Config) when is_list(Config) -> + [{encoding,latin1}] = io:getopts(standard_error), + ok. diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index 65b950bd46..127c23e0f7 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -867,6 +867,7 @@ ok </section> <section> + <marker id="event_handling"></marker> <title>Mnesia Event Handling</title> <p>System events and table events are the two categories of events that Mnesia will generate in various situations. diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index c23c2cb226..ed5b879f7f 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -863,7 +863,7 @@ mnesia:create_table(person, {attributes, record_info(fields,person)}]). </code> <p>The specification of <c>index</c> and <c>attributes</c> may be - hard coded as <c>{index, [2]}</c> and + hard coded as <c>{index, [4]}</c> and <c>{attributes, [name, age, address, salary, children]}</c> respectively. </p> @@ -2188,12 +2188,13 @@ mnesia:create_table(employee, </desc> </func> <func> - <name>subscribe(EventCategory)</name> + <name>subscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Ensures that a copy of all events of type <c>EventCategory</c> are sent to the caller. The event - types available are described in the Mnesia User's Guide.</p> + types available are described in the Mnesia User's Guide at <seealso marker="Mnesia_chap5#event_handling">Mnesia Event Handling</seealso>.</p> + <p><c>Node</c> is the local node. For table events to be subscribed, mnesia must have a readable local copy of the table on the node.</p> </desc> </func> <func> @@ -2861,11 +2862,12 @@ raise(Name, Amount) -> </desc> </func> <func> - <name>unsubscribe(EventCategory)</name> + <name>unsubscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Stops sending events of type <c>EventCategory</c> to the caller.</p> + <p><c>Node</c> is the local node.</p> </desc> </func> <func> diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index b6492707e2..eeb4fa0ced 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -689,12 +689,29 @@ handle_call({connect_nodes, Ns}, From, State) -> %% called from handle_info gen_server:reply(From, {[], AlreadyConnected}), {noreply, State}; - GoodNodes -> + ProbablyGoodNodes -> %% Now we have agreed upon a protocol with some new nodes - %% and we may use them when we recover transactions + %% and we may use them when we recover transactions. + %% + %% Just in case Mnesia was stopped on some of those nodes + %% between the protocol negotiation and now, we check one + %% more time the state of Mnesia. + %% + %% Of course, there is still a chance that mnesia_down + %% events occur during this check and we miss them. To + %% prevent it, handle_cast({mnesia_down, ...}, ...) removes + %% the down node again, in addition to mnesia_down/1. + %% + %% See a comment in handle_cast({mnesia_down, ...}, ...). + Verify = fun(N) -> + Run = mnesia_lib:is_running(N), + Run =:= yes orelse Run =:= starting + end, + GoodNodes = [N || N <- ProbablyGoodNodes, Verify(N)], + mnesia_lib:add_list(recover_nodes, GoodNodes), cast({announce_all, GoodNodes}), - case get_master_nodes(schema) of + case get_master_nodes(schema) of [] -> Context = starting_partitioned_network, mnesia_monitor:detect_inconcistency(GoodNodes, Context); @@ -842,6 +859,14 @@ handle_cast({what_decision, Node, OtherD}, State) -> {noreply, State}; handle_cast({mnesia_down, Node}, State) -> + %% The node was already removed from recover_nodes in mnesia_down/1, + %% but we do it again here in the mnesia_recover process, in case + %% another event incorrectly added it back. This can happen during + %% Mnesia startup which takes time betweenthe connection, the + %% protocol negotiation and the merge of the schema. + %% + %% See a comment in handle_call({connect_nodes, ...), ...). + mnesia_lib:del(recover_nodes, Node), case State#state.unclear_decision of undefined -> {noreply, State}; diff --git a/lib/os_mon/c_src/memsup.c b/lib/os_mon/c_src/memsup.c index 409db84aa7..5dcab07dd8 100644 --- a/lib/os_mon/c_src/memsup.c +++ b/lib/os_mon/c_src/memsup.c @@ -104,7 +104,7 @@ #if !defined (__OpenBSD__) && !defined (__NetBSD__) #include <vm/vm_param.h> #endif -#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) +#if defined (__FreeBSD__) || defined(__DragonFly__) || defined (__NetBSD__) || defined(__OpenBSD__) #include <sys/vmmeter.h> #endif #endif diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 186563ab74..c2de57d40b 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -778,50 +778,50 @@ tracer_init(Handler, HandlerData) -> tracer_loop(Handler, HandlerData). tracer_loop(Handler, Hdata) -> - receive - Msg -> - %% Don't match in receive to avoid giving EXIT message higher - %% priority than the trace messages. - case Msg of - {'EXIT',_Pid,_Reason} -> - ok; - Trace -> - NewData = recv_all_traces(Trace, Handler, Hdata), - tracer_loop(Handler, NewData) - end + {State, Suspended, Traces} = recv_all_traces(), + NewHdata = handle_traces(Suspended, Traces, Handler, Hdata), + case State of + done -> + exit(normal); + loop -> + tracer_loop(Handler, NewHdata) end. - -recv_all_traces(Trace, Handler, Hdata) -> - Suspended = suspend(Trace, []), - recv_all_traces(Suspended, Handler, Hdata, [Trace]). -recv_all_traces(Suspended0, Handler, Hdata, Traces) -> +recv_all_traces() -> + recv_all_traces([], [], infinity). + +recv_all_traces(Suspended0, Traces, Timeout) -> receive Trace when is_tuple(Trace), element(1, Trace) == trace -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == trace_ts -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == seq_trace -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); Trace when is_tuple(Trace), element(1, Trace) == drop -> Suspended = suspend(Trace, Suspended0), - recv_all_traces(Suspended, Handler, Hdata, [Trace|Traces]); + recv_all_traces(Suspended, [Trace|Traces], 0); + {'EXIT', _Pid, _Reason} -> + {done, Suspended0, Traces}; Other -> %%% Is this really a good idea? io:format(user,"** tracer received garbage: ~p~n", [Other]), - recv_all_traces(Suspended0, Handler, Hdata, Traces) - after 0 -> - case catch invoke_handler(Traces, Handler, Hdata) of - {'EXIT',Reason} -> - resume(Suspended0), - exit({trace_handler_crashed,Reason}); - NewHdata -> - resume(Suspended0), - NewHdata - end + recv_all_traces(Suspended0, Traces, Timeout) + after Timeout -> + {loop, Suspended0, Traces} + end. + +handle_traces(Suspended, Traces, Handler, Hdata) -> + case catch invoke_handler(Traces, Handler, Hdata) of + {'EXIT',Reason} -> + resume(Suspended), + exit({trace_handler_crashed,Reason}); + NewHdata -> + resume(Suspended), + NewHdata end. invoke_handler([Tr|Traces], Handler, Hdata0) -> diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl index dfae52ed1d..0bcbd67d05 100644 --- a/lib/runtime_tools/test/dbg_SUITE.erl +++ b/lib/runtime_tools/test/dbg_SUITE.erl @@ -25,7 +25,7 @@ ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1, ip_port_busy/1, wrap_port/1, wrap_port_time/1, with_seq_trace/1, dead_suspend/1, local_trace/1, - saved_patterns/1]). + saved_patterns/1, tracer_exit_on_stop/1]). -export([init_per_testcase/2, end_per_testcase/2]). -export([tracee1/1, tracee2/1]). -export([dummy/0, exported/1]). @@ -47,7 +47,7 @@ all() -> [big, tiny, simple, message, distributed, ip_port, file_port, file_port2, file_port_schedfix, ip_port_busy, wrap_port, wrap_port_time, with_seq_trace, dead_suspend, - local_trace, saved_patterns]. + local_trace, saved_patterns, tracer_exit_on_stop]. groups() -> []. @@ -742,6 +742,38 @@ run_dead_suspend() -> dummy() -> ok. +%% Test that a tracer process does not ignore an exit signal message when it has +%% received (but not handled) trace messages +tracer_exit_on_stop(_) -> + %% Tracer blocks waiting for fun to complete so that the trace message and + %% the exit signal message from the dbg process are in its message queue. + Fun = fun() -> + ?MODULE:dummy(), + Ref = erlang:trace_delivered(self()), + receive {trace_delivered, _, Ref} -> stop() end + end, + {ok, _} = dbg:tracer(process, {fun spawn_once_handler/2, {self(), Fun}}), + {ok, Tracer} = dbg:get_tracer(), + MRef = monitor(process, Tracer), + {ok, _} = dbg:p(self(), [call]), + {ok, _} = dbg:p(new, [call]), + {ok, _} = dbg:tp(?MODULE, dummy, []), + ?MODULE:dummy(), + receive {'DOWN', MRef, _, _, normal} -> ok end, + [{trace,_,call,{?MODULE, dummy,[]}}, + {trace,_,call,{?MODULE, dummy,[]}}] = flush(), + ok. + +spawn_once_handler(Event, {Pid, done} = State) -> + Pid ! Event, + State; +spawn_once_handler(Event, {Pid, Fun}) -> + {_, Ref} = spawn_monitor(Fun), + receive + {'DOWN', Ref, _, _, _} -> + Pid ! Event, + {Pid, done} + end. %% %% Support functions diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index bd7414fbb4..b7c5f34f58 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1802,11 +1802,17 @@ upgrade_gg(cleanup,Config) -> %%%----------------------------------------------------------------- %%% OTP-10463, Bug - release_handler could not handle regexp in appup %%% files. -otp_10463_upgrade_script_regexp(_Config) -> - %% Assuming that kernel always has a regexp in it's appup - KernelVsn = vsn(kernel,current), - {ok,KernelVsn,_} = - release_handler:upgrade_script(kernel,code:lib_dir(kernel)), +otp_10463_upgrade_script_regexp(Config) -> + DataDir = ?config(data_dir,Config), + code:add_path(filename:join([DataDir,regexp_appup,app1,ebin])), + application:start(app1), + {ok,"1.1",_} = release_handler:upgrade_script(app1,code:lib_dir(app1)), + ok. + +otp_10463_upgrade_script_regexp(cleanup,Config) -> + DataDir = ?config(data_dir,Config), + application:stop(app1), + code:del_path(filename:join([DataDir,regexp_appup,app1,ebin])), ok. no_dot_erlang(Conf) -> diff --git a/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app new file mode 100644 index 0000000000..ba6d09cd42 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% This is an -*- erlang -*- file. +%% +{application, app1, + [ + {description, "Test that release_handler can read appup with regexp"}, + {vsn, "1.1"}, + {modules, []}, + {registered, []}, + {applications, []} + ] +}. diff --git a/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup new file mode 100644 index 0000000000..9c657232d0 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup @@ -0,0 +1,23 @@ +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"1.1", + %% Up from + [{<<"1(\\.[0-9]+)*">>,[{restart_application,app1}]}], + %% Down to + [{<<"1(\\.[0-9]+)*">>,[{restart_application,app1}]}] +}. diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml index 9f5d1c003d..d481a75c9a 100644 --- a/lib/ssh/doc/src/ssh.xml +++ b/lib/ssh/doc/src/ssh.xml @@ -234,11 +234,11 @@ <taglist> <tag><c><![CDATA[{inet, inet | inet6}]]></c></tag> <item> IP version to use when the host address is specified as <c>any</c>. </item> - <tag><c><![CDATA[{subsystems, [subsystem_spec()]]]></c></tag> + <tag><c><![CDATA[{subsystems, [subsystem_spec()]}]]></c></tag> <item> Provides specifications for handling of subsystems. The "sftp" subsystem spec can be retrieved by calling - ssh_sftpd:subsystem_spec/1. If the subsystems option in + ssh_sftpd:subsystem_spec/1. If the subsystems option is not present the value of <c>[ssh_sftpd:subsystem_spec([])]</c> will be used. It is of course possible to set the option to the empty list if diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 9ab71260d3..46178d4018 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -79,7 +79,7 @@ <p> The option user_dir defaults to the users ~/.ssh directory</p> <p>In the following example we generate new keys and host keys as - to be able to run the example without having root privilages</p> + to be able to run the example without having root privileges</p> <code> $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 915060c426..68523aa72b 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1711,7 +1711,7 @@ handshake(Pid, Ref, Timeout) -> {error, Reason} after Timeout -> stop(Pid), - {error, Timeout} + {error, timeout} end. start_timeout(_,_, infinity) -> diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 52665635f0..04ae6b11e2 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -559,56 +559,73 @@ stat(ReqId, RelPath, State0=#state{file_handler=FileMod, send_status({error, E}, ReqId, State1) end. -decode_4_open_flag(create_new) -> - [write]; -decode_4_open_flag(create_truncate) -> - [write]; -decode_4_open_flag(truncate_existing) -> - [write]; -decode_4_open_flag(open_existing) -> - [read]. - -decode_4_flags([OpenFlag | Flags]) -> - decode_4_flags(Flags, decode_4_open_flag(OpenFlag)). - -decode_4_flags([], Flags) -> - Flags; -decode_4_flags([append_data|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([append_data_atomic|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([_|R], Flags) -> - decode_4_flags(R, Flags). - -decode_4_access_flag(read_data) -> - [read]; -decode_4_access_flag(list_directory) -> - [read]; -decode_4_access_flag(write_data) -> - [write]; -decode_4_access_flag(add_file) -> - [write]; -decode_4_access_flag(add_subdirectory) -> - [read]; -decode_4_access_flag(append_data) -> - [append]; -decode_4_access_flag(write_attributes) -> - [write]; -decode_4_access_flag(_) -> - [read]. - -decode_4_acess([_ | _] = Flags) -> +sftp_to_erlang_flag(read, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(write, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(append, Vsn) when Vsn == 3; + Vsn == 4 -> + append; +sftp_to_erlang_flag(creat, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(trunc, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(excl, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(create_new, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(create_truncate, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(open_existing, Vsn) when Vsn > 4 -> + read; +sftp_to_erlang_flag(open_or_create, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(truncate_existing, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(append_data, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(append_data_atomic, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(_, _) -> + read. + +sftp_to_erlang_flags(Flags, Vsn) -> lists:map(fun(Flag) -> - [decode_4_access_flag(Flag)] - end, Flags); -decode_4_acess([]) -> - []. + sftp_to_erlang_flag(Flag, Vsn) + end, Flags). + +sftp_to_erlang_access_flag(read_data, _) -> + read; +sftp_to_erlang_access_flag(list_directory, _) -> + read; +sftp_to_erlang_access_flag(write_data, _) -> + write; +sftp_to_erlang_access_flag(append_data, _) -> + append; +sftp_to_erlang_access_flag(add_subdirectory, _) -> + read; +sftp_to_erlang_access_flag(add_file, _) -> + write; +sftp_to_erlang_access_flag(write_attributes, _) -> + write; +sftp_to_erlang_access_flag(_, _) -> + read. +sftp_to_erlang_access_flags(Flags, Vsn) -> + lists:map(fun(Flag) -> + sftp_to_erlang_access_flag(Flag, Vsn) + end, Flags). open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, Path = unicode:characters_to_list(BPath), - Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), + FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn)), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), @@ -616,15 +633,12 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> Path = unicode:characters_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), - %% TODO: This is to make sure the Access flags are not ignored - %% but this should be thought through better. This solution should - %% be considered a hack in order to buy some time. At least - %% it works better than when the Access flags where totally ignored. - %% A better solution may need some code refactoring that we do - %% not have time for right now. - AcessFlags = decode_4_acess(AcessBits), - Flags = lists:append(lists:umerge( - [[decode_4_flags(FlagBits)] | AcessFlags])), + %% TODO: There are still flags that are not + %% fully handled as SSH_FXF_ACCESS_TEXT_MODE and + %% a lot a ACE flags, the later we may not need + %% to understand as they are NFS flags + AcessFlags = sftp_to_erlang_access_flags(AcessBits, Vsn), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn) ++ AcessFlags), do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 415cb9fc9c..cb1b4ae945 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -723,7 +723,7 @@ ssh_connect_arg4_timeout(_Config) -> %% Wait for client reaction on the connection try: receive - {done, Client, {error,_E}, T0} -> + {done, Client, {error,timeout}, T0} -> Msp = ms_passed(T0, now()), exit(Server,hasta_la_vista___baby), Low = 0.9*Timeout, @@ -733,6 +733,11 @@ ssh_connect_arg4_timeout(_Config) -> Low<Msp, Msp<High -> ok; true -> {fail, "timeout not within limits"} end; + + {done, Client, {error,Other}, _T0} -> + ct:log("Error message \"~p\" from the client is unexpected.",[{error,Other}]), + {fail, "Unexpected error message"}; + {done, Client, {ok,_Ref}, _T0} -> {fail,"ssh-connected ???"} after diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 7b22e45d5e..0ce8eec906 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -56,7 +56,8 @@ all() -> retrieve_attributes, set_attributes, links, - ver3_rename, + ver3_rename, + ver3_open_flags, relpath, sshd_read_file, ver6_basic]. @@ -193,6 +194,39 @@ open_close_file(Config) when is_list(Config) -> ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, ?SSH_FXF_OPEN_EXISTING). +ver3_open_flags() -> + [{doc, "Test open flags"}]. +ver3_open_flags(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "not_exist.txt"), + {Cm, Channel} = ?config(sftp, Config), + ReqId = 0, + + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = + open_file_v3(FileName, Cm, Channel, ReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_TRUNC), + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(Handle, ReqId, + Cm, Channel), + + NewFileName = filename:join(PrivDir, "not_exist2.txt"), + NewReqId = ReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), NewHandle/binary>>, _} = + open_file_v3(NewFileName, Cm, Channel, NewReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_EXCL), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle, NewReqId, + Cm, Channel), + + NewFileName1 = filename:join(PrivDir, "test.txt"), + NewReqId1 = NewReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId1), NewHandle1/binary>>, _} = + open_file_v3(NewFileName1, Cm, Channel, NewReqId1, + ?SSH_FXF_READ bor ?SSH_FXF_WRITE bor ?SSH_FXF_APPEND), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle1, NewReqId1, + Cm, Channel). + %%-------------------------------------------------------------------- open_close_dir() -> [{doc,"Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"}]. @@ -662,6 +696,16 @@ open_file(File, Cm, Channel, ReqId, Access, Flags) -> ?SSH_FXP_OPEN, Data/binary>>), reply(Cm, Channel). +open_file_v3(File, Cm, Channel, ReqId, Flags) -> + + Data = list_to_binary([?uint32(ReqId), + ?binary(list_to_binary(File)), + ?uint32(Flags), + ?REG_ATTERS]), + Size = 1 + size(Data), + ssh_connection:send(Cm, Channel, <<?UINT32(Size), + ?SSH_FXP_OPEN, Data/binary>>), + reply(Cm, Channel). close(Handle, ReqId, Cm , Channel) -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index b53344e381..249fee5760 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2014</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -163,7 +163,7 @@ is supplied it will override the certfile option.</item> <tag>{certfile, path()}</tag> - <item>Path to a file containing the user's certificate.</item> + <item>Path to a file containing the user's PEM encoded certificate.</item> <tag>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey' |'PrivateKeyInfo', der_encoded()}}</tag> <item> The DER encoded users private key. If this option @@ -348,11 +348,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </item> + <tag>{padding_check, boolean()}</tag> + <item> + <p> This option only affects TLS-1.0 connections. + If set to false it disables the block cipher padding check + to be able to interoperate with legacy software. + </p> + + <warning><p> Using this option makes TLS vulnerable to + the Poodle attack</p></warning> + + </item> + </taglist> - + </section> - - <section> + + <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> <p>Options described here are client specific or has a slightly different @@ -538,7 +550,19 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </desc> </func> - + + <func> + <name>clear_pem_cache() -> ok </name> + <fsummary> Clears the pem cache</fsummary> + + <desc><p>PEM files, used by ssl API-functions, are cached. The + cache is regularly checked to see if any cache entries should be + invalidated, however this function provides a way to + unconditionally clear the whole cache. + </p> + </desc> + </func> + <func> <name>connect(Socket, SslOptions) -> </name> <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index 43cb3934f7..f1377cabda 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -4,7 +4,7 @@ <appref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -82,7 +82,16 @@ callback module, defaults to []. </p> </item> - + + <tag><c><![CDATA[ssl_pem_cache_clean = integer() <optional>]]></c></tag> + <item> + <p> + Number of milliseconds between PEM cache validations. + </p> + <seealso + marker="ssl#clear_pem_cache-0">ssl:clear_pem_cache/0</seealso> + + </item> </taglist> </section> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index a7bbb6bc40..ae35dd7ea4 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -146,7 +146,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, = ConnnectionStates0) -> CompressAlg = SecParams#security_parameters.compression_algorithm, {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0), + CipherFragment, ReadState0, true), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index b4bea25942..4b7f49547b 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -656,7 +656,8 @@ handle_options(Opts0) -> log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), honor_cipher_order = handle_option(honor_cipher_order, Opts, false), - protocol = proplists:get_value(protocol, Opts, tls) + protocol = proplists:get_value(protocol, Opts, tls), + padding_check = proplists:get_value(padding_check, Opts, true) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -669,7 +670,7 @@ handle_options(Opts0) -> cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, client_preferred_next_protocols, log_alert, - server_name_indication, honor_cipher_order], + server_name_indication, honor_cipher_order, padding_check], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -847,6 +848,8 @@ validate_option(server_name_indication, undefined) -> undefined; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; +validate_option(padding_check, Value) when is_boolean(Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 9c0ed181fe..30d224fee2 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -282,7 +282,7 @@ other_issuer(OtpCert, CertDbHandle) -> handle_path({BinCert, OTPCert}, Path, PartialChainHandler) -> case public_key:pkix_is_self_signed(OTPCert) of true -> - {BinCert, Path}; + {BinCert, lists:delete(BinCert, Path)}; false -> handle_incomplete_chain(Path, PartialChainHandler) end. diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index 72467ea2a0..ff9c618a35 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,8 +33,7 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - decipher/5, cipher/5, - suite/1, suites/1, all_suites/1, + decipher/6, cipher/5, suite/1, suites/1, all_suites/1, ec_keyed_suites/0, anonymous_suites/0, psk_suites/1, srp_suites/0, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). @@ -143,17 +142,18 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, {T, CS0#cipher_state{iv=NextIV}}. %%-------------------------------------------------------------------- --spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), ssl_record:ssl_version()) -> +-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), + ssl_record:ssl_version(), boolean()) -> {binary(), binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and the MAC using cipher described %% by cipher_enum() and updating the cipher state. %%------------------------------------------------------------------- -decipher(?NULL, _HashSz, CipherState, Fragment, _) -> +decipher(?NULL, _HashSz, CipherState, Fragment, _, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState, Fragment, _) -> +decipher(?RC4, HashSz, CipherState, Fragment, _, _) -> State0 = case CipherState#cipher_state.state of - undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); + undefined -> crypto:stream_init(rc4, CipherState#cipher_state.key); S -> S end, try crypto:stream_decrypt(State0, Fragment) of @@ -171,23 +171,23 @@ decipher(?RC4, HashSz, CipherState, Fragment, _) -> ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; -decipher(?DES, HashSz, CipherState, Fragment, Version) -> +decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) -> crypto:block_decrypt(des_cbc, Key, IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?'3DES', HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?AES, HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?AES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) - end, CipherState, HashSz, Fragment, Version). + end, CipherState, HashSz, Fragment, Version, PaddingCheck). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, - HashSz, Fragment, Version) -> + HashSz, Fragment, Version, PaddingCheck) -> try Text = Fun(Key, IV, Fragment), NextIV = next_iv(Fragment, IV), @@ -195,7 +195,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, Content = GBC#generic_block_cipher.content, Mac = GBC#generic_block_cipher.mac, CipherState1 = CipherState0#cipher_state{iv=GBC#generic_block_cipher.next_iv}, - case is_correct_padding(GBC, Version) of + case is_correct_padding(GBC, Version, PaddingCheck) of true -> {Content, Mac, CipherState1}; false -> @@ -1288,16 +1288,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -%% For interoperability reasons we do not check the padding content in -%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks -%% interopability with for instance Google. is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, {3, N}) - when N == 0; N == 1 -> - Len == byte_size(Padding); -%% Padding must be check in TLS 1.1 and after + padding = Padding}, {3, 0}, _) -> + Len == byte_size(Padding); %% Only length check is done in SSL 3.0 spec +%% For interoperability reasons it is possible to disable +%% the padding check when using TLS 1.0, as it is not strictly required +%% in the spec (only recommended), howerver this makes TLS 1.0 vunrable to the Poodle attack +%% so by default this clause will not match +is_correct_padding(GenBlockCipher, {3, 1}, false) -> + is_correct_padding(GenBlockCipher, {3, 0}, false); +%% Padding must be checked in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, _) -> + padding = Padding}, _, _) -> Len == byte_size(Padding) andalso list_to_binary(lists:duplicate(Len, Len)) == Padding. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 75efb64e3f..bb4e732517 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -117,7 +117,8 @@ server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false + honor_cipher_order = false, + padding_check = true }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index d6e5064c39..c4f1f7f193 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -30,10 +30,10 @@ lookup_trusted_cert/4, new_session_id/1, clean_cert_db/2, register_session/2, register_session/3, invalidate_session/2, - invalidate_session/3, clear_pem_cache/0, manager_name/1]). + invalidate_session/3, invalidate_pem/1, clear_pem_cache/0, manager_name/1]). % Spawn export --export([init_session_validator/1]). +-export([init_session_validator/1, init_pem_cache_validator/1]). %% gen_server callbacks -export([init/1, handle_call/3, handle_cast/2, handle_info/2, @@ -49,7 +49,9 @@ session_lifetime, certificate_db, session_validation_timer, - last_delay_timer = {undefined, undefined}%% Keep for testing purposes + last_delay_timer = {undefined, undefined},%% Keep for testing purposes + last_pem_check, + clear_pem_cache }). -define('24H_in_msec', 86400000). @@ -117,14 +119,13 @@ connection_init(Trustedcerts, Role) -> %% Description: Cache a pem file and return its content. %%-------------------------------------------------------------------- cache_pem_file(File, DbHandle) -> - MD5 = crypto:hash(md5, File), - case ssl_pkix_db:lookup_cached_pem(DbHandle, MD5) of + case ssl_pkix_db:lookup_cached_pem(DbHandle, File) of [{Content,_}] -> {ok, Content}; [Content] -> {ok, Content}; undefined -> - call({cache_pem, {MD5, File}}) + call({cache_pem, File}) end. %%-------------------------------------------------------------------- @@ -191,6 +192,11 @@ invalidate_session(Host, Port, Session) -> invalidate_session(Port, Session) -> cast({invalidate_session, Port, Session}). + +-spec invalidate_pem(File::binary()) -> ok. +invalidate_pem(File) -> + cast({invalidate_pem, File}). + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -212,12 +218,16 @@ init([Name, Opts]) -> SessionCache = CacheCb:init(proplists:get_value(session_cb_init_args, Opts, [])), Timer = erlang:send_after(SessionLifeTime * 1000 + 5000, self(), validate_sessions), - erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), + Interval = pem_check_interval(), + erlang:send_after(Interval, self(), clear_pem_cache), {ok, #state{certificate_db = CertDb, session_cache = SessionCache, session_cache_cb = CacheCb, session_lifetime = SessionLifeTime, - session_validation_timer = Timer}}. + session_validation_timer = Timer, + last_pem_check = os:timestamp(), + clear_pem_cache = Interval + }}. %%-------------------------------------------------------------------- -spec handle_call(msg(), from(), #state{}) -> {reply, reply(), #state{}}. @@ -256,7 +266,7 @@ handle_call({{new_session_id,Port}, _}, {reply, Id, State}; -handle_call({{cache_pem, File}, _Pid}, _, +handle_call({{cache_pem,File}, _Pid}, _, #state{certificate_db = Db} = State) -> try ssl_pkix_db:cache_pem_file(File, Db) of Result -> @@ -303,7 +313,12 @@ handle_cast({invalidate_session, Host, Port, handle_cast({invalidate_session, Port, #session{session_id = ID} = Session}, #state{session_cache = Cache, session_cache_cb = CacheCb} = State) -> - invalidate_session(Cache, CacheCb, {Port, ID}, Session, State). + invalidate_session(Cache, CacheCb, {Port, ID}, Session, State); + +handle_cast({invalidate_pem, File}, + #state{certificate_db = [_, _, PemCache]} = State) -> + ssl_pkix_db:remove(File, PemCache), + {noreply, State}. %%-------------------------------------------------------------------- -spec handle_info(msg(), #state{}) -> {noreply, #state{}}. @@ -328,15 +343,13 @@ handle_info({delayed_clean_session, Key}, #state{session_cache = Cache, CacheCb:delete(Cache, Key), {noreply, State}; -handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace]} = State) -> - case ssl_pkix_db:db_size(PemChace) of - N when N < ?NOT_TO_BIG -> - ok; - _ -> - ssl_pkix_db:clear(PemChace) - end, - erlang:send_after(?CLEAR_PEM_CACHE, self(), clear_pem_cache), - {noreply, State}; +handle_info(clear_pem_cache, #state{certificate_db = [_,_,PemChace], + clear_pem_cache = Interval, + last_pem_check = CheckPoint} = State) -> + NewCheckPoint = os:timestamp(), + start_pem_cache_validator(PemChace, CheckPoint), + erlang:send_after(Interval, self(), clear_pem_cache), + {noreply, State#state{last_pem_check = NewCheckPoint}}; handle_info({clean_cert_db, Ref, File}, @@ -482,10 +495,9 @@ new_id(Port, Tries, Cache, CacheCb) -> clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> case ssl_pkix_db:ref_count(Ref, RefDb, 0) of 0 -> - MD5 = crypto:hash(md5, File), - case ssl_pkix_db:lookup_cached_pem(PemCache, MD5) of + case ssl_pkix_db:lookup_cached_pem(PemCache, File) of [{Content, Ref}] -> - ssl_pkix_db:insert(MD5, Content, PemCache); + ssl_pkix_db:insert(File, Content, PemCache); _ -> ok end, @@ -494,3 +506,39 @@ clean_cert_db(Ref, CertDb, RefDb, PemCache, File) -> _ -> ok end. + +start_pem_cache_validator(PemCache, CheckPoint) -> + spawn_link(?MODULE, init_pem_cache_validator, + [[get(ssl_manager), PemCache, CheckPoint]]). + +init_pem_cache_validator([SslManagerName, PemCache, CheckPoint]) -> + put(ssl_manager, SslManagerName), + ssl_pkix_db:foldl(fun pem_cache_validate/2, + CheckPoint, PemCache). + +pem_cache_validate({File, _}, CheckPoint) -> + case file:read_file_info(File, []) of + {ok, #file_info{mtime = Time}} -> + case is_before_checkpoint(Time, CheckPoint) of + true -> + ok; + false -> + invalidate_pem(File) + end; + _ -> + invalidate_pem(File) + end, + CheckPoint. + +pem_check_interval() -> + case application:get_env(ssl, ssl_pem_cache_clean) of + {ok, Interval} when is_integer(Interval) -> + Interval; + _ -> + ?CLEAR_PEM_CACHE + end. + +is_before_checkpoint(Time, CheckPoint) -> + calendar:datetime_to_gregorian_seconds(calendar:now_to_datetime(CheckPoint)) - + calendar:datetime_to_gregorian_seconds(Time) > 0. + diff --git a/lib/ssl/src/ssl_pkix_db.erl b/lib/ssl/src/ssl_pkix_db.erl index e59aba0618..8531445ba4 100644 --- a/lib/ssl/src/ssl_pkix_db.erl +++ b/lib/ssl/src/ssl_pkix_db.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -81,10 +81,10 @@ lookup_trusted_cert(DbHandle, Ref, SerialNumber, Issuer) -> {ok, Certs} end. -lookup_cached_pem([_, _, PemChache], MD5) -> - lookup_cached_pem(PemChache, MD5); -lookup_cached_pem(PemChache, MD5) -> - lookup(MD5, PemChache). +lookup_cached_pem([_, _, PemChache], File) -> + lookup_cached_pem(PemChache, File); +lookup_cached_pem(PemChache, File) -> + lookup(File, PemChache). %%-------------------------------------------------------------------- -spec add_trusted_certs(pid(), {erlang:timestamp(), string()} | @@ -100,36 +100,35 @@ add_trusted_certs(_Pid, {der, DerList}, [CerDb, _,_]) -> {ok, NewRef}; add_trusted_certs(_Pid, File, [CertsDb, RefDb, PemChache] = Db) -> - MD5 = crypto:hash(md5, File), - case lookup_cached_pem(Db, MD5) of + case lookup_cached_pem(Db, File) of [{_Content, Ref}] -> ref_count(Ref, RefDb, 1), {ok, Ref}; [Content] -> Ref = make_ref(), update_counter(Ref, 1, RefDb), - insert(MD5, {Content, Ref}, PemChache), + insert(File, {Content, Ref}, PemChache), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}; undefined -> - new_trusted_cert_entry({MD5, File}, Db) + new_trusted_cert_entry(File, Db) end. %%-------------------------------------------------------------------- %% %% Description: Cache file as binary in DB %%-------------------------------------------------------------------- --spec cache_pem_file({binary(), binary()}, [db_handle()]) -> {ok, term()}. -cache_pem_file({MD5, File}, [_CertsDb, _RefDb, PemChache]) -> +-spec cache_pem_file(binary(), [db_handle()]) -> {ok, term()}. +cache_pem_file(File, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), - insert(MD5, Content, PemChache), + insert(File, Content, PemChache), {ok, Content}. --spec cache_pem_file(reference(), {binary(), binary()}, [db_handle()]) -> {ok, term()}. -cache_pem_file(Ref, {MD5, File}, [_CertsDb, _RefDb, PemChache]) -> +-spec cache_pem_file(reference(), binary(), [db_handle()]) -> {ok, term()}. +cache_pem_file(Ref, File, [_CertsDb, _RefDb, PemChache]) -> {ok, PemBin} = file:read_file(File), Content = public_key:pem_decode(PemBin), - insert(MD5, {Content, Ref}, PemChache), + insert(File, {Content, Ref}, PemChache), {ok, Content}. %%-------------------------------------------------------------------- @@ -245,9 +244,9 @@ add_certs(Cert, Ref, CertsDb) -> error_logger:info_report(Report) end. -new_trusted_cert_entry(FileRef, [CertsDb, RefDb, _] = Db) -> +new_trusted_cert_entry(File, [CertsDb, RefDb, _] = Db) -> Ref = make_ref(), update_counter(Ref, 1, RefDb), - {ok, Content} = cache_pem_file(Ref, FileRef, Db), + {ok, Content} = cache_pem_file(Ref, File, Db), add_certs_from_pem(Content, Ref, CertsDb), {ok, Ref}. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 7337225bc4..025a46bf65 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2]). +-export([cipher/4, decipher/4, is_correct_mac/2]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -376,8 +376,9 @@ cipher(Version, Fragment, {CipherFragment, CipherS1} = ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MacHash, Fragment, Version), {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. + %%-------------------------------------------------------------------- --spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. +-spec decipher(ssl_version(), binary(), #connection_state{}, boolean()) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- @@ -387,8 +388,8 @@ decipher(Version, CipherFragment, BulkCipherAlgo, hash_size = HashSz}, cipher_state = CipherS0 - } = ReadState) -> - case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version) of + } = ReadState, PaddingCheck) -> + case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version, PaddingCheck) of {PlainFragment, Mac, CipherS1} -> CS1 = ReadState#connection_state{cipher_state = CipherS1}, {PlainFragment, Mac, CS1}; diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 7df73fb581..77d3aa7889 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -482,8 +482,9 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_ci next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0) of + connection_states = ConnStates0, + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case tls_record:decode_cipher_text(CT, ConnStates0, Check) of {Plain, ConnStates} -> {Plain, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = Rest}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index f50ea22f39..ed61da2d62 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ -export([get_tls_records/2]). %% Decoding --export([decode_cipher_text/2]). +-export([decode_cipher_text/3]). %% Encoding -export([encode_plain_text/4]). @@ -142,19 +142,21 @@ encode_plain_text(Type, Version, Data, {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}. %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> +-spec decode_cipher_text(#ssl_tls{}, #connection_states{}, boolean()) -> {#ssl_tls{}, #connection_states{}}| #alert{}. %% %% Description: Decode cipher text %%-------------------------------------------------------------------- decode_cipher_text(#ssl_tls{type = Type, version = Version, - fragment = CipherFragment} = CipherText, ConnnectionStates0) -> - ReadState0 = ConnnectionStates0#connection_states.current_read, - #connection_state{compression_state = CompressionS0, - sequence_number = Seq, - security_parameters = SecParams} = ReadState0, - CompressAlg = SecParams#security_parameters.compression_algorithm, - case ssl_record:decipher(Version, CipherFragment, ReadState0) of + fragment = CipherFragment} = CipherText, + #connection_states{current_read = + #connection_state{ + compression_state = CompressionS0, + sequence_number = Seq, + security_parameters= + #security_parameters{compression_algorithm = CompressAlg} + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 2f8ff6f04e..0d241707d9 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2013. All Rights Reserved. +# Copyright Ericsson AB 1999-2015. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ MODULES = \ ssl_npn_handshake_SUITE \ ssl_packet_SUITE \ ssl_payload_SUITE \ + ssl_pem_cache_SUITE \ ssl_session_cache_SUITE \ ssl_to_openssl_SUITE \ ssl_ECC_SUITE \ diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index 1da4e88077..2d4d2452e3 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -256,11 +256,6 @@ init_per_testcase(Case, Config) when Case == unordered_protocol_versions_client _ -> {skip, "TLS 1.2 need but not supported on this platform"} end; -init_per_testcase(no_authority_key_identifier, Config) -> - %% Clear cach so that root cert will not - %% be found. - ssl:clear_pem_cache(), - Config; init_per_testcase(protocol_versions, Config) -> ssl:stop(), diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index b7864ba6e7..dab7a941db 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -443,7 +443,7 @@ verify_fun_always_run_client(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} @@ -482,7 +482,7 @@ verify_fun_always_run_server(Config) when is_list(Config) -> {unknown, UserState}; (_, valid, [ChainLen]) -> {valid, [ChainLen + 1]}; - (_, valid_peer, [2]) -> + (_, valid_peer, [1]) -> {fail, "verify_fun_was_always_run"}; (_, valid_peer, UserState) -> {valid, UserState} diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index 45e91786d4..0e48b674e0 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [aes_decipher_good, aes_decipher_good_tls11, aes_decipher_fail, aes_decipher_fail_tls11]. + [aes_decipher_good, aes_decipher_fail, padding_test]. groups() -> []. @@ -73,93 +73,123 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- aes_decipher_good() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a correct key"}]. aes_decipher_good(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. - -%%-------------------------------------------------------------------- - -aes_decipher_good_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% the fragment is actuall a TLS 1.1 record, with -%% Version = TLS 1.1, we get the correct NextIV in #cipher_state -aes_decipher_good_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<"HELLO\n">>, - NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = correct_cipher_state(), + decipher_check_good(HashSz, CipherState, {3,0}), + decipher_check_good(HashSz, CipherState, {3,1}), + decipher_check_good(HashSz, CipherState, {3,2}), + decipher_check_good(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- aes_decipher_fail() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a incorrect key"}]. -%% same as above, last byte of key replaced aes_decipher_fail(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - 32 = byte_size(Content), - 32 = byte_size(Mac), - Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - 32 = byte_size(Content1), - 32 = byte_size(Mac1), - ok. -%%-------------------------------------------------------------------- - -aes_decipher_fail_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% same as above, last byte of key replaced -%% stricter padding checks in TLS 1.1 mean we get an alert instead -aes_decipher_fail_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,2}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version), - Version1 = {3,3}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = incorrect_cipher_state(), + decipher_check_fail(HashSz, CipherState, {3,0}), + decipher_check_fail(HashSz, CipherState, {3,1}), + decipher_check_fail(HashSz, CipherState, {3,2}), + decipher_check_fail(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- +padding_test(Config) when is_list(Config) -> + HashSz = 16, + CipherState = correct_cipher_state(), + pad_test(HashSz, CipherState, {3,0}), + pad_test(HashSz, CipherState, {3,1}), + pad_test(HashSz, CipherState, {3,2}), + pad_test(HashSz, CipherState, {3,3}). + +%%-------------------------------------------------------------------- +% Internal functions -------------------------------------------------------- +%%-------------------------------------------------------------------- +decipher_check_good(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +decipher_check_fail(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + true = {Content, Mac, #cipher_state{iv = NextIV}} =/= + ssl_cipher:decipher(?AES, HashSz, CipherState, aes_fragment(Version), Version, true). + +pad_test(HashSz, CipherState, {3,0} = Version) -> + %% 3.0 does not have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, true), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, false); +pad_test(HashSz, CipherState, {3,1} = Version) -> + %% 3.1 should have padding test, but may be disabled + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}) , {3,1}, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES, HashSz, CipherState, badpad_aes_fragment({3,1}), {3,1}, true); +pad_test(HashSz, CipherState, Version) -> + %% 3.2 and 3.3 must have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES, HashSz, CipherState, + badpad_aes_fragment(Version), Version, true). + +aes_fragment({3,N}) when N == 0; N == 1-> + <<197,9,6,109,242,87,80,154,85,250,110,81,119,95,65,185,53,206,216,153,246,169, + 119,177,178,238,248,174,253,220,242,81,33,0,177,251,91,44,247,53,183,198,165, + 63,20,194,159,107>>; + +aes_fragment(_) -> + <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>. + +badpad_aes_fragment({3,N}) when N == 0; N == 1 -> + <<186,139,125,10,118,21,26,248,120,108,193,104,87,118,145,79,225,55,228,10,105, + 30,190,37,1,88,139,243,210,99,65,41>>; +badpad_aes_fragment(_) -> + <<137,31,14,77,228,80,76,103,183,125,55,250,68,190,123,131,117,23,229,180,207, + 94,121,137,117,157,109,99,113,61,190,138,131,229,201,120,142,179,172,48,77, + 234,19,240,33,38,91,93>>. + +content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<33,0, 177,251, 91,44, 247,53, 183,198, 165,63, 20,194, 159,107>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}; +content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}. + +badpad_content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<225,55,228,10,105,30,190,37,1,88,139,243,210,99,65,41>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }; +badpad_content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<133,211,45,189,179,229,56,86,11,178,239,159,14,160,253,140>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }. + +badpad_content(Content) -> + %% BadContent will fail mac test + <<16#F0, Content/binary>>. + +correct_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}. + +incorrect_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}. diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl new file mode 100644 index 0000000000..843079e2fe --- /dev/null +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -0,0 +1,127 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/.2 +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_pem_cache_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). +-include_lib("kernel/include/file.hrl"). + +-define(CLEANUP_INTERVAL, 5000). + +%%-------------------------------------------------------------------- +%% Common Test interface functions ----------------------------------- +%%-------------------------------------------------------------------- +all() -> + [pem_cleanup]. + +groups() -> + []. + +init_per_suite(Config0) -> + catch crypto:stop(), + try crypto:start() of + ok -> + ssl:start(), + %% make rsa certs using oppenssl + Result = + (catch make_certs:all(?config(data_dir, Config0), + ?config(priv_dir, Config0))), + ct:log("Make certs ~p~n", [Result]), + + Config1 = ssl_test_lib:make_dsa_cert(Config0), + ssl_test_lib:cert_options(Config1) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(_Config) -> + application:stop(crypto). + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_testcase(pem_cleanup, Config) -> + ssl:stop(), + application:load(ssl), + application:set_env(ssl, ssl_pem_cache_clean, ?CLEANUP_INTERVAL), + ssl:start(), + Config. + +end_per_testcase(_TestCase, Config) -> + %%ssl:stop(), + Config. + +%%-------------------------------------------------------------------- +%% Test Cases -------------------------------------------------------- +%%-------------------------------------------------------------------- +pem_cleanup() -> + [{doc, "Test pem cache invalidate mechanism"}]. +pem_cleanup(Config)when is_list(Config) -> + process_flag(trap_exit, true), + ClientOpts = ?config(client_opts, Config), + ServerOpts = ?config(server_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = + ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, no_result, []}}, + {options, ServerOpts}]), + Port = ssl_test_lib:inet_port(Server), + Client = + ssl_test_lib:start_client([{node, ClientNode}, + {port, Port}, {host, Hostname}, + {mfa, {ssl_test_lib, no_result, []}}, + {from, self()}, {options, ClientOpts}]), + + Size = ssl_pkix_db:db_size(get_pem_cache()), + Certfile = proplists:get_value(certfile, ServerOpts), + {ok, FileInfo} = file:read_file_info(Certfile), + Time = later(), + ok = file:write_file_info(Certfile, FileInfo#file_info{mtime = Time}), + ct:sleep(2 * ?CLEANUP_INTERVAL), + Size1 = ssl_pkix_db:db_size(get_pem_cache()), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + false = Size == Size1. + +get_pem_cache() -> + {status, _, _, StatusInfo} = sys:get_status(whereis(ssl_manager)), + [_, _,_, _, Prop] = StatusInfo, + State = ssl_test_lib:state(Prop), + case element(5, State) of + [_CertDb, _FileRefDb, PemChace] -> + PemChace; + _ -> + undefined + end. + +later()-> + DateTime = calendar:now_to_local_time(os:timestamp()), + Gregorian = calendar:datetime_to_gregorian_seconds(DateTime), + calendar:gregorian_seconds_to_datetime(Gregorian + (2 * ?CLEANUP_INTERVAL)). + diff --git a/lib/stdlib/doc/src/re.xml b/lib/stdlib/doc/src/re.xml index a1833f6a51..5af1468e9b 100644 --- a/lib/stdlib/doc/src/re.xml +++ b/lib/stdlib/doc/src/re.xml @@ -150,7 +150,11 @@ This option makes it possible to include comments inside complicated patterns. N <tag><c>no_start_optimize</c></tag> <item>This option disables optimization that may malfunction if "Special start-of-pattern items" are present in the regular expression. A typical example would be when matching "DEFABC" against "(*COMMIT)ABC", where the start optimization of PCRE would skip the subject up to the "A" and would never realize that the (*COMMIT) instruction should have made the matching fail. This option is only relevant if you use "start-of-pattern items", as discussed in the section "PCRE regular expression details" below.</item> <tag><c>ucp</c></tag> - <item>Specifies that Unicode Character Properties should be used when resolving \B, \b, \D, \d, \S, \s, \Wand \w. Without this flag, only ISO-Latin-1 properties are used. Using Unicode properties hurts performance, but is semantically correct when working with Unicode characters beyond the ISO-Latin-1 range.</item> + <item>Specifies that Unicode Character Properties should be used when + resolving \B, \b, \D, \d, \S, \s, \W and \w. Without this flag, only + ISO-Latin-1 properties are used. Using Unicode properties hurts + performance, but is semantically correct when working with Unicode + characters beyond the ISO-Latin-1 range.</item> <tag><c>never_utf</c></tag> <item>Specifies that the (*UTF) and/or (*UTF8) "start-of-pattern items" are forbidden. This flag can not be combined with <c>unicode</c>. Useful if ISO-Latin-1 patterns from an external source are to be compiled.</item> </taglist> @@ -966,7 +970,7 @@ appearance causes an error. </quote> <p>This has the same effect as setting the <c>ucp</c> option: it causes sequences such as \d and \w to use Unicode properties to determine character types, -instead of recognizing only characters with codes less than 128 via a lookup +instead of recognizing only characters with codes less than 256 via a lookup table. </p> @@ -1307,7 +1311,8 @@ By default, the definition of letters and digits is controlled by PCRE's low-valued character tables, in Erlang's case (and without the <c>unicode</c> option), the ISO-Latin-1 character set.</p> -<p>By default, in <c>unicode</c> mode, characters with values greater than 128 never match +<p>By default, in <c>unicode</c> mode, characters with values greater than 255, +i.e. all characters outside the ISO-Latin-1 character set, never match \d, \s, or \w, and always match \D, \S, and \W. These sequences retain their original meanings from before UTF support was available, mainly for efficiency reasons. However, if the <c>ucp</c> option is set, the behaviour is changed so that Unicode @@ -1954,10 +1959,10 @@ can be included in a class as a literal string of data units, or by using the upper case and lower case versions, so for example, a caseless [aeiou] matches "A" as well as "a", and a caseless [^aeiou] does not match "A", whereas a caseful version would. In a UTF mode, PCRE always understands the concept of -case for characters whose values are less than 128, so caseless matching is +case for characters whose values are less than 256, so caseless matching is always possible. For characters with higher values, the concept of case is supported if PCRE is compiled with Unicode property support, but not otherwise. -If you want to use caseless matching in a UTF mode for characters 128 and +If you want to use caseless matching in a UTF mode for characters 256 and above, you must ensure that PCRE is compiled with Unicode property support as well as with UTF support.</p> @@ -1989,7 +1994,7 @@ matches the letters in either case. For example, [W-c] is equivalent to [][\\^_`wxyzabc], matched caselessly, and in a non-UTF mode, if character tables for a French locale are in use, [\xc8-\xcb] matches accented E characters in both cases. In UTF modes, PCRE supports the concept of case for -characters with values greater than 128 only when it is compiled with Unicode +characters with values greater than 255 only when it is compiled with Unicode property support.</p> <p>The character escape sequences \d, \D, \h, \H, \p, \P, \s, \S, \v, @@ -2062,7 +2067,7 @@ by a ^ character after the colon. For example,</p> syntax [.ch.] and [=ch=] where "ch" is a "collating element", but these are not supported, and an error is given if they are encountered.</p> -<p>By default, in UTF modes, characters with values greater than 128 do not match +<p>By default, in UTF modes, characters with values greater than 255 do not match any of the POSIX character classes. However, if the PCRE_UCP option is passed to <b>pcre_compile()</b>, some of the classes are changed so that Unicode character properties are used. This is achieved by replacing the POSIX classes @@ -2081,7 +2086,7 @@ by other sequences, as follows:</p> <p>Negated versions, such as [:^alpha:] use \P instead of \p. The other POSIX classes are unchanged, and match only characters with code points less than -128.</p> +256.</p> </section> diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index c2256c0cf9..9860adf04d 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -509,9 +509,12 @@ m(M) -> {exports,E} = lists:keyfind(exports, 1, L), Time = get_compile_time(L), COpts = get_compile_options(L), - format("Module ~w compiled: ",[M]), print_time(Time), - format("Compiler options: ~p~n", [COpts]), + format("Module: ~w~n", [M]), + print_md5(L), + format("Compiled: "), + print_time(Time), print_object_file(M), + format("Compiler options: ~p~n", [COpts]), format("Exports: ~n",[]), print_exports(keysort(1, E)). print_object_file(Mod) -> @@ -522,6 +525,12 @@ print_object_file(Mod) -> ignore end. +print_md5(L) -> + case lists:keyfind(md5, 1, L) of + {md5,<<MD5:128>>} -> io:format("MD5: ~.16b~n",[MD5]); + _ -> ok + end. + get_compile_time(L) -> case get_compile_info(L, time) of {ok,Val} -> Val; @@ -569,8 +578,8 @@ split_print_exports([{F1, A1}|T1], [{F2, A2} | T2]) -> split_print_exports([], []) -> ok. print_time({Year,Month,Day,Hour,Min,_Secs}) -> - format("Date: ~s ~w ~w, ", [month(Month),Day,Year]), - format("Time: ~.2.0w.~.2.0w~n", [Hour,Min]); + format("~s ~w ~w, ", [month(Month),Day,Year]), + format("~.2.0w:~.2.0w~n", [Hour,Min]); print_time(notime) -> format("No compile time info available~n",[]). diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e12eab1b5..3ca7a8197e 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -88,7 +88,7 @@ %% This is a so-called Erlang I/O ErrorInfo structure; see the {@link %% //stdlib/io} module for details. --type errorinfo() :: term(). % {integer(), atom(), term()}. +-type errorinfo() :: {integer(), atom(), term()}. -type option() :: atom() | {atom(), term()}. @@ -208,8 +208,8 @@ do_parse_file(DefEncoding, File, Parser, Options) -> try Parser(Dev, 1, Options) after ok = file:close(Dev) end; - {error, _} = Error -> - Error + {error, Error} -> + {error, {0, file, Error}} % defer to file:format_error/1 end. find_invalid_unicode([H|T]) -> diff --git a/lib/test_server/src/erl2html2.erl b/lib/test_server/src/erl2html2.erl index b9b45cda25..7cfaa2c325 100644 --- a/lib/test_server/src/erl2html2.erl +++ b/lib/test_server/src/erl2html2.erl @@ -22,11 +22,11 @@ %%%------------------------------------------------------------------ -module(erl2html2). --export([convert/2, convert/3]). +-export([convert/3, convert/4]). -convert([], _Dest) -> % Fake clause. +convert([], _Dest, _InclPath) -> % Fake clause. ok; -convert(File, Dest) -> +convert(File, Dest, InclPath) -> %% The generated code uses the BGCOLOR attribute in the %% BODY tag, which wasn't valid until HTML 3.2. Also, %% good HTML should either override all colour attributes @@ -48,12 +48,12 @@ convert(File, Dest) -> "</head>\n\n" "<body bgcolor=\"white\" text=\"black\"" " link=\"blue\" vlink=\"purple\" alink=\"red\">\n"], - convert(File, Dest, Header). + convert(File, Dest, InclPath, Header). -convert(File, Dest, Header) -> +convert(File, Dest, InclPath, Header) -> %% statistics(runtime), - case parse_file(File) of + case parse_file(File, InclPath) of {ok,Functions} -> %% {_, Time1} = statistics(runtime), %% io:format("Parsed file in ~.2f Seconds.~n",[Time1/1000]), @@ -92,8 +92,8 @@ convert(File, Dest, Header) -> %%% Use expanded preprocessor directives if possible (epp). Only if %%% this fails, fall back on using non-expanded code (epp_dodger). -parse_file(File) -> - case epp:open(File, [], []) of +parse_file(File, InclPath) -> + case epp:open(File, InclPath, []) of {ok,Epp} -> try parse_preprocessed_file(Epp,File,false) of Forms -> @@ -145,13 +145,15 @@ parse_non_preprocessed_file(File) -> parse_non_preprocessed_file(Epp, File, Location) -> case epp_dodger:parse_form(Epp, Location) of {ok,Tree,Location1} -> - case erl_syntax:revert(Tree) of + try erl_syntax:revert(Tree) of {function,L,F,A,[_|C]} -> Clauses = [{clause,CL} || {clause,CL,_,_,_} <- C], [{atom_to_list(F),A,L} | Clauses] ++ parse_non_preprocessed_file(Epp, File, Location1); _ -> parse_non_preprocessed_file(Epp, File, Location1) + catch + _:_ -> parse_non_preprocessed_file(Epp, File, Location1) end; {error,_E,Location1} -> parse_non_preprocessed_file(Epp, File, Location1); diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index af8921fe75..488f38d05d 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1927,15 +1927,20 @@ html_possibly_convert(Src, SrcInfo, Dest) -> {ok,DestInfo} when DestInfo#file_info.mtime >= SrcInfo#file_info.mtime -> ok; % dest file up to date _ -> + InclPath = case application:get_env(test_server, include) of + {ok,Incls} -> Incls; + _ -> [] + end, + OutDir = get(test_server_log_dir_base), case test_server_sup:framework_call(get_html_wrapper, ["Module "++Src,false, OutDir,undefined, encoding(Src)], "") of Empty when (Empty == "") ; (element(2,Empty) == "") -> - erl2html2:convert(Src, Dest); + erl2html2:convert(Src, Dest, InclPath); {_,Header,_} -> - erl2html2:convert(Src, Dest, Header) + erl2html2:convert(Src, Dest, InclPath, Header) end end. diff --git a/lib/test_server/test/erl2html2_SUITE.erl b/lib/test_server/test/erl2html2_SUITE.erl index 37c2b74d8e..908985c879 100644 --- a/lib/test_server/test/erl2html2_SUITE.erl +++ b/lib/test_server/test/erl2html2_SUITE.erl @@ -161,7 +161,7 @@ convert_module(Mod,Config) -> Src = filename:join(DataDir,Mod++".erl"), Dst = filename:join(PrivDir,Mod++".erl.html"), io:format("<a href=\"~s\">~s</a>\n",[Src,filename:basename(Src)]), - ok = erl2html2:convert(Src, Dst, "<html><body>"), + ok = erl2html2:convert(Src, Dst, [], "<html><body>"), io:format("<a href=\"~s\">~s</a>\n",[Dst,filename:basename(Dst)]), {Src,Dst}. diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index f1251fddab..d5ba8aa52f 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -305,7 +305,7 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks {true, true} -> locks_ids(Filtered); _ -> [] end, - Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), case proplists:get_value(locations, Opts) of true -> lists:foreach(fun @@ -329,9 +329,8 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks end end, Combos); _ -> - Print1 = locks2print(Combos, Duration), - Print2 = filter_print(Print1, Opts), - print_lock_information(Print2, proplists:get_value(print, Opts)) + Print = filter_print(locks2print(Combos, Duration), Opts), + print_lock_information(Print, proplists:get_value(print, Opts)) end, {reply, ok, State}; @@ -357,8 +356,7 @@ handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, loc {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), Prints = locks2print([L], Duration), print_lock_information(Prints, proplists:get_value(print, Opts1)), - print_full_histogram(SumStats#stats.hist), - io:format("~n") + print_full_histogram(SumStats#stats.hist) end, Combos), {reply, ok, State}; @@ -509,20 +507,23 @@ filter_locks(Locks, Lockname) -> % 4. max length of locks filter_print(PLs, Opts) -> - TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), - SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), - CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), - reverse_locks(CLs, not proplists:get_value(reverse,Opts, false)). - -sort_locks(Locks, name) -> lists:keysort(#print.name, Locks); -sort_locks(Locks, id) -> lists:keysort(#print.id, Locks); -sort_locks(Locks, type) -> lists:keysort(#print.type, Locks); -sort_locks(Locks, tries) -> lists:keysort(#print.tries, Locks); -sort_locks(Locks, colls) -> lists:keysort(#print.colls, Locks); -sort_locks(Locks, ratio) -> lists:keysort(#print.cr, Locks); -sort_locks(Locks, time) -> lists:keysort(#print.time, Locks); + TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), + SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), + CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), + reverse_locks(CLs, proplists:get_value(reverse, Opts, false)). + +sort_locks(Locks, name) -> reverse_sort_locks(#print.name, Locks); +sort_locks(Locks, id) -> reverse_sort_locks(#print.id, Locks); +sort_locks(Locks, type) -> reverse_sort_locks(#print.type, Locks); +sort_locks(Locks, tries) -> reverse_sort_locks(#print.tries, Locks); +sort_locks(Locks, colls) -> reverse_sort_locks(#print.colls, Locks); +sort_locks(Locks, ratio) -> reverse_sort_locks(#print.cr, Locks); +sort_locks(Locks, time) -> reverse_sort_locks(#print.time, Locks); sort_locks(Locks, _) -> sort_locks(Locks, time). +reverse_sort_locks(Ix, Locks) -> + lists:reverse(lists:keysort(Ix, Locks)). + % cut locks not above certain thresholds threshold_locks(Locks, Thresholds) -> Tries = proplists:get_value(tries, Thresholds, -1), @@ -647,15 +648,19 @@ format_histogram(Tup) when is_tuple(Tup) -> _ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs]) end. -string_histogram([0|Vs]) -> - [$\s|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.66 -> - [$X|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.33 -> - [$x|string_histogram(Vs)]; -string_histogram([_|Vs]) -> - [$.|string_histogram(Vs)]; -string_histogram([]) -> []. +string_histogram(Vs) -> + [$||histogram_values_to_string(Vs,$|)]. + +histogram_values_to_string([0|Vs],End) -> + [$\s|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.66 -> + [$X|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.33 -> + [$x|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([_|Vs],End) -> + [$.|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([],End) -> + [End]. %% state making @@ -778,7 +783,7 @@ auto_print_width(Locks, Print) -> ({print,print}, Out) -> [print|Out]; ({Str, Len}, Out) -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out] end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max))))) - end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14, hist=20 }, + end, #print{ id=4, type=5, entry=5, name=6, tries=8, colls=13, cr=16, time=11, dtr=14, hist=20 }, Locks), % Setup the offsets for later pruning Offsets = [ @@ -820,7 +825,7 @@ print_header(Opts) -> cr = "collisions [%]", time = "time [us]", dtr = "duration [%]", - hist = "histogram" + hist = "histogram [log2(us)]" }, Divider = #print{ name = lists:duplicate(1 + length(Header#print.name), 45), @@ -863,9 +868,9 @@ format_lock(L, [Opt|Opts]) -> {time, W} -> [{space, W, s(L#print.time) } | format_lock(L, Opts)]; duration -> [{space, 20, s(L#print.dtr) } | format_lock(L, Opts)]; {duration, W} -> [{space, W, s(L#print.dtr) } | format_lock(L, Opts)]; - histogram -> [{space, 0, s(L#print.hist) } | format_lock(L, Opts)]; - {histogram, W} -> [{space, W, s(L#print.hist) } | format_lock(L, Opts)]; - _ -> format_lock(L, Opts) + histogram -> [{space, 20, s(L#print.hist) } | format_lock(L, Opts)]; + {histogram, W} -> [{left, W - length(s(L#print.hist)) - 1, s(L#print.hist)} | format_lock(L, Opts)]; + _ -> format_lock(L, Opts) end. print_state_information(#state{locks = Locks} = State) -> @@ -926,6 +931,7 @@ s(T) -> term2string(T). strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); +strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). |