aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/compiler/src/core_lib.erl9
-rw-r--r--lib/compiler/src/sys_core_fold.erl157
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl24
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl16
-rw-r--r--lib/compiler/test/match_SUITE.erl7
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl23
-rw-r--r--lib/hipe/cerl/erl_types.erl34
-rw-r--r--lib/hipe/ppc/hipe_rtl_to_ppc.erl14
-rw-r--r--lib/hipe/rtl/hipe_rtl.erl18
-rw-r--r--lib/hipe/sparc/hipe_rtl_to_sparc.erl10
-rw-r--r--lib/hipe/x86/hipe_rtl_to_x86.erl15
-rw-r--r--lib/inets/doc/src/httpd.xml13
-rw-r--r--lib/inets/doc/src/notes.xml35
-rw-r--r--lib/inets/examples/httpd_load_test/hdlt_slave.erl2
-rw-r--r--lib/inets/src/http_client/httpc_cookie.erl20
-rw-r--r--lib/inets/src/http_lib/http_internal.hrl3
-rw-r--r--lib/inets/src/http_lib/http_request.erl26
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl24
-rw-r--r--lib/inets/src/http_server/httpd_request.erl102
-rw-r--r--lib/inets/src/http_server/httpd_request_handler.erl32
-rw-r--r--lib/inets/src/http_server/mod_alias.erl14
-rw-r--r--lib/inets/test/http_format_SUITE.erl16
-rw-r--r--lib/inets/test/httpc_SUITE.erl52
-rw-r--r--lib/inets/test/httpd_SUITE.erl45
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/src/standard_error.erl155
-rw-r--r--lib/kernel/test/Makefile3
-rw-r--r--lib/kernel/test/standard_error_SUITE.erl38
-rw-r--r--lib/mnesia/doc/src/Mnesia_chap5.xmlsrc1
-rw-r--r--lib/mnesia/doc/src/mnesia.xml8
-rw-r--r--lib/mnesia/src/mnesia_recover.erl31
-rw-r--r--lib/ssh/doc/src/using_ssh.xml2
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl2
-rw-r--r--lib/ssh/src/ssh_sftpd.erl122
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl7
-rw-r--r--lib/ssh/test/ssh_sftpd_SUITE.erl48
-rw-r--r--lib/ssl/doc/src/ssl.xml36
-rw-r--r--lib/ssl/doc/src/ssl_app.xml13
-rw-r--r--lib/ssl/src/dtls_record.erl4
-rw-r--r--lib/ssl/src/ssl.erl9
-rw-r--r--lib/ssl/src/ssl_certificate.erl2
-rw-r--r--lib/ssl/src/ssl_cipher.erl48
-rw-r--r--lib/ssl/src/ssl_internal.hrl5
-rw-r--r--lib/ssl/src/ssl_manager.erl96
-rw-r--r--lib/ssl/src/ssl_pkix_db.erl33
-rw-r--r--lib/ssl/src/ssl_record.erl11
-rw-r--r--lib/ssl/src/tls_connection.erl7
-rw-r--r--lib/ssl/src/tls_record.erl22
-rw-r--r--lib/ssl/test/Makefile3
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl7
-rw-r--r--lib/ssl/test/ssl_certificate_verify_SUITE.erl4
-rw-r--r--lib/ssl/test/ssl_cipher_SUITE.erl188
-rw-r--r--lib/ssl/test/ssl_pem_cache_SUITE.erl127
-rw-r--r--lib/tools/src/lcnt.erl70
54 files changed, 1249 insertions, 566 deletions
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 09716d0866..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.
@@ -2113,8 +2122,26 @@ coerce_to_data(C) ->
coerce_to_data(cerl:alias_pat(C))
end.
-%% case_opt_lit(Literal, Clauses0, LitExpr) ->
-%% {ok,[],Clauses} | error
+%% 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
@@ -2123,68 +2150,48 @@ coerce_to_data(C) ->
%% 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.
@@ -2193,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}) ->
@@ -2218,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/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index e5aaf49d6f..1e778dca24 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -406,12 +406,19 @@ underscore(Config) when is_list(Config) ->
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/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/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/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/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 b2de8b6946..ed5b879f7f 100644
--- a/lib/mnesia/doc/src/mnesia.xml
+++ b/lib/mnesia/doc/src/mnesia.xml
@@ -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/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..f2d82a66d3 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{}}.
@@ -325,18 +340,16 @@ handle_info(validate_sessions, #state{session_cache_cb = CacheCb,
handle_info({delayed_clean_session, Key}, #state{session_cache = Cache,
session_cache_cb = CacheCb
} = State) ->
- CacheCb:delete(Cache, Key),
+ CacheCb:remove(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..36c2a17a50
--- /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(erlang:timestamp()),
+ Gregorian = calendar:datetime_to_gregorian_seconds(DateTime),
+ calendar:gregorian_seconds_to_datetime(Gregorian + (2 * ?CLEANUP_INTERVAL)).
+
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])).