aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/src/asn1ct.erl40
-rw-r--r--lib/asn1/src/asn1ct_gen.erl47
-rw-r--r--lib/common_test/doc/src/Makefile4
-rw-r--r--lib/compiler/doc/src/Makefile2
-rw-r--r--lib/compiler/doc/src/notes.xml16
-rw-r--r--lib/compiler/src/beam_asm.erl9
-rw-r--r--lib/compiler/src/beam_listing.erl14
-rw-r--r--lib/compiler/src/compile.erl6
-rw-r--r--lib/compiler/test/compile_SUITE.erl12
-rw-r--r--lib/compiler/test/compile_SUITE_data/deterministic_module.erl21
-rw-r--r--lib/crypto/c_src/crypto.c51
-rw-r--r--lib/crypto/c_src/otp_test_engine.c10
-rw-r--r--lib/crypto/doc/src/Makefile2
-rw-r--r--lib/crypto/doc/src/crypto.xml3
-rw-r--r--lib/crypto/doc/src/engine_keys.xml129
-rw-r--r--lib/crypto/doc/src/usersguide.xml1
-rw-r--r--lib/crypto/src/crypto.erl10
-rw-r--r--lib/crypto/test/engine_SUITE.erl108
-rw-r--r--lib/debugger/doc/src/Makefile2
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl6
-rw-r--r--lib/dialyzer/src/dialyzer_typesig.erl12
-rw-r--r--lib/dialyzer/test/map_SUITE_data/results/map_anon_fun2
-rw-r--r--lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl9
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl40
-rw-r--r--lib/edoc/src/edoc_specs.erl2
-rw-r--r--lib/eldap/doc/src/Makefile2
-rw-r--r--lib/erl_docgen/src/docgen_edoc_xml_cb.erl2
-rw-r--r--lib/erl_interface/doc/src/Makefile2
-rw-r--r--lib/erl_interface/src/Makefile2
-rw-r--r--lib/erl_interface/src/Makefile.in2
-rw-r--r--lib/hipe/cerl/erl_types.erl4
-rw-r--r--lib/hipe/doc/src/Makefile2
-rw-r--r--lib/inets/doc/src/Makefile1
-rw-r--r--lib/inets/src/http_client/httpc_handler.erl16
-rw-r--r--lib/inets/src/http_client/httpc_manager.erl4
-rw-r--r--lib/inets/test/httpc_SUITE.erl3
-rw-r--r--lib/jinterface/doc/src/Makefile3
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile3
-rw-r--r--lib/kernel/doc/src/Makefile2
-rw-r--r--lib/kernel/doc/src/gen_tcp.xml7
-rw-r--r--lib/kernel/src/erts_debug.erl26
-rw-r--r--lib/kernel/src/kernel.appup.src6
-rw-r--r--lib/mnesia/doc/src/Makefile1
-rw-r--r--lib/mnesia/src/mnesia.erl3
-rw-r--r--lib/observer/doc/src/Makefile4
-rw-r--r--lib/observer/src/crashdump_viewer.erl414
-rw-r--r--lib/observer/test/crashdump_helper.erl14
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl10
-rw-r--r--lib/public_key/doc/src/notes.xml24
-rw-r--r--lib/public_key/test/public_key_SUITE.erl62
-rw-r--r--lib/public_key/vsn.mk2
-rw-r--r--lib/runtime_tools/doc/src/Makefile6
-rw-r--r--lib/sasl/doc/src/Makefile3
-rw-r--r--lib/ssh/doc/src/Makefile2
-rw-r--r--lib/ssh/doc/src/notes.xml27
-rw-r--r--lib/ssh/src/ssh.hrl2
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl63
-rw-r--r--lib/ssh/src/ssh_transport.erl12
-rw-r--r--lib/ssh/test/ssh_engine_SUITE.erl1
-rw-r--r--lib/ssh/test/ssh_options_SUITE.erl23
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/doc/src/Makefile2
-rw-r--r--lib/ssl/doc/src/notes.xml233
-rw-r--r--lib/ssl/doc/src/pkix_certs.xml59
-rw-r--r--lib/ssl/doc/src/ssl.xml6
-rw-r--r--lib/ssl/src/dtls_connection.erl1057
-rw-r--r--lib/ssl/src/dtls_handshake.erl154
-rw-r--r--lib/ssl/src/dtls_record.erl284
-rw-r--r--lib/ssl/src/ssl_connection.erl435
-rw-r--r--lib/ssl/src/ssl_connection.hrl1
-rw-r--r--lib/ssl/src/ssl_handshake.erl1924
-rw-r--r--lib/ssl/src/ssl_record.erl12
-rw-r--r--lib/ssl/src/tls_connection.erl619
-rw-r--r--lib/ssl/src/tls_handshake.erl191
-rw-r--r--lib/ssl/src/tls_record.erl236
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/Makefile3
-rw-r--r--lib/stdlib/doc/src/unicode.xml9
-rw-r--r--lib/stdlib/src/string.erl748
-rw-r--r--lib/stdlib/test/string_SUITE.erl121
-rw-r--r--lib/stdlib/test/unicode_util_SUITE.erl17
-rwxr-xr-xlib/stdlib/uc_spec/gen_unicode_mod.escript31
-rw-r--r--lib/tools/doc/src/Makefile3
83 files changed, 4360 insertions, 3107 deletions
diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl
index f36d71a601..81a2735a0d 100644
--- a/lib/asn1/src/asn1ct.erl
+++ b/lib/asn1/src/asn1ct.erl
@@ -1335,25 +1335,39 @@ test_value(Module, Type, Value) ->
in_process(fun() ->
case catch Module:encode(Type, Value) of
{ok, Bytes} ->
- NewBytes = prepare_bytes(Bytes),
- case Module:decode(Type, NewBytes) of
- {ok, Value} ->
- {ok, {Module, Type, Value}};
- {ok, Res} ->
- {error, {asn1,
- {encode_decode_mismatch,
- {{Module, Type, Value}, Res}}}};
- Error ->
- {error, {asn1,
- {{decode,
- {Module, Type, Value}, Error}}}}
- end;
+ test_value_decode(Module, Type, Value, Bytes);
+ Bytes when is_binary(Bytes) ->
+ test_value_decode(Module, Type, Value, Bytes);
Error ->
{error, {asn1,
{encode, {{Module, Type, Value}, Error}}}}
end
end).
+
+test_value_decode(Module, Type, Value, Bytes) ->
+ NewBytes = prepare_bytes(Bytes),
+ case Module:decode(Type, NewBytes) of
+ {ok,Value} -> {ok, {Module,Type,Value}};
+ {ok,Value,<<>>} -> {ok, {Module,Type,Value}};
+ Value -> {ok, {Module,Type,Value}};
+ {Value,<<>>} -> {ok, {Module,Type,Value}};
+
+ %% Errors:
+ {ok, Res} ->
+ {error, {asn1,
+ {encode_decode_mismatch,
+ {{Module, Type, Value}, Res}}}};
+ {ok, Res, Rest} ->
+ {error, {asn1,
+ {encode_decode_mismatch,
+ {{Module, Type, Value}, {Res,Rest}}}}};
+ Error ->
+ {error, {asn1,
+ {{decode,
+ {Module, Type, Value}, Error}}}}
+ end.
+
value(Module, Type) -> value(Module, Type, []).
value(Module, Type, Includes) ->
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl
index 806f8420ec..da9f6ac559 100644
--- a/lib/asn1/src/asn1ct_gen.erl
+++ b/lib/asn1/src/asn1ct_gen.erl
@@ -707,6 +707,7 @@ gen_exports([_|_]=L0, Prefix, Arity) ->
pgen_dispatcher(Erules, []) ->
gen_info_functions(Erules);
pgen_dispatcher(Gen, Types) ->
+ %% MODULE HEAD
emit(["-export([encode/2,decode/2]).",nl,nl]),
gen_info_functions(Gen),
@@ -714,6 +715,7 @@ pgen_dispatcher(Gen, Types) ->
NoFinalPadding = lists:member(no_final_padding, Options),
NoOkWrapper = proplists:get_bool(no_ok_wrapper, Options),
+ %% ENCODER
Call = case Gen of
#gen{erule=per,aligned=true} ->
asn1ct_func:need({per,complete,1}),
@@ -740,6 +742,7 @@ pgen_dispatcher(Gen, Types) ->
end,
emit([nl,nl]),
+ %% DECODER
ReturnRest = proplists:get_bool(undec_rest, Gen#gen.options),
Data = case Gen#gen.erule =:= ber andalso ReturnRest of
true -> "Data0";
@@ -747,6 +750,12 @@ pgen_dispatcher(Gen, Types) ->
end,
emit(["decode(Type, ",Data,") ->",nl]),
+
+ case NoOkWrapper of
+ false -> emit(["try",nl]);
+ true -> ok
+ end,
+
DecWrap =
case {Gen,ReturnRest} of
{#gen{erule=ber},false} ->
@@ -754,32 +763,38 @@ pgen_dispatcher(Gen, Types) ->
"element(1, ber_decode_nif(Data))";
{#gen{erule=ber},true} ->
asn1ct_func:need({ber,ber_decode_nif,1}),
- emit(["{Data,Rest} = ber_decode_nif(Data0),",nl]),
+ emit([" {Data,Rest} = ber_decode_nif(Data0),",nl]),
"Data";
{_,_} ->
"Data"
end,
- emit([case NoOkWrapper of
- false -> "try";
- true -> "case"
- end, " decode_disp(Type, ",DecWrap,") of",nl]),
- case Gen of
- #gen{erule=ber} ->
- emit([" Result ->",nl]);
- #gen{erule=per} ->
- emit([" {Result,Rest} ->",nl])
- end,
- case ReturnRest of
- false -> result_line(NoOkWrapper, ["Result"]);
- true -> result_line(NoOkWrapper, ["Result","Rest"])
+
+ DecodeDisp = ["decode_disp(Type, ",DecWrap,")"],
+ case {Gen,ReturnRest} of
+ {#gen{erule=ber},true} ->
+ emit([" Result = ",DecodeDisp,",",nl]),
+ result_line(NoOkWrapper, ["Result","Rest"]);
+ {#gen{erule=ber},false} ->
+ emit([" Result = ",DecodeDisp,",",nl]),
+ result_line(NoOkWrapper, ["Result"]);
+
+
+ {#gen{erule=per},true} ->
+ emit([" {Result,Rest} = ",DecodeDisp,",",nl]),
+ result_line(NoOkWrapper, ["Result","Rest"]);
+ {#gen{erule=per},false} ->
+ emit([" {Result,_Rest} = ",DecodeDisp,",",nl]),
+ result_line(NoOkWrapper, ["Result"])
end,
+
case NoOkWrapper of
false ->
emit([nl,try_catch(),nl,nl]);
true ->
- emit([nl,"end.",nl,nl])
+ emit([".",nl,nl])
end,
+ %% REST of MODULE
gen_decode_partial_incomplete(Gen),
gen_partial_inc_dispatcher(Gen),
@@ -787,7 +802,7 @@ pgen_dispatcher(Gen, Types) ->
gen_dispatcher(Types, "decode_disp", "dec_").
result_line(NoOkWrapper, Items) ->
- S = [" "|case NoOkWrapper of
+ S = [" "|case NoOkWrapper of
false -> result_line_1(["ok"|Items]);
true -> result_line_1(Items)
end],
diff --git a/lib/common_test/doc/src/Makefile b/lib/common_test/doc/src/Makefile
index b60b04c4ae..293ef591cb 100644
--- a/lib/common_test/doc/src/Makefile
+++ b/lib/common_test/doc/src/Makefile
@@ -60,6 +60,7 @@ XML_REF6_FILES = common_test_app.xml
XML_PART_FILES = part.xml
XML_CHAPTER_FILES = \
+ introduction.xml \
basics_chapter.xml \
getting_started_chapter.xml \
install_chapter.xml \
@@ -74,8 +75,7 @@ XML_CHAPTER_FILES = \
event_handler_chapter.xml \
ct_hooks_chapter.xml \
dependencies_chapter.xml \
- notes.xml \
- notes_history.xml
+ notes.xml
BOOK_FILES = book.xml
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile
index 254445c111..13210de040 100644
--- a/lib/compiler/doc/src/Makefile
+++ b/lib/compiler/doc/src/Makefile
@@ -39,7 +39,7 @@ XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = compile.xml
XML_PART_FILES =
-XML_CHAPTER_FILES = notes.xml notes_history.xml
+XML_CHAPTER_FILES = notes.xml
BOOK_FILES = book.xml
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index 433fc3b86e..2aec75a2aa 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -510,6 +510,22 @@
</section>
+
+<section><title>Compiler 6.0.3.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fail labels on guard BIFs weren't taken into account
+ during an optimization pass, and a bug in the validation
+ pass sometimes prevented this from being noticed when a
+ fault occurred.</p>
+ <p>
+ Own Id: OTP-14522 Aux Id: ERIERL-48 </p>
+ </item>
+ </list>
+ </section>
+</section>
+
<section><title>Compiler 6.0.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index c35efdfc9d..f7c838e392 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -182,7 +182,8 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, ExtraChunks, SourceFile, Opts,
Essentials1 = [iolist_to_binary(C) || C <- Essentials0],
MD5 = module_md5(Essentials1),
Essentials = finalize_fun_table(Essentials1, MD5),
- {Attributes,Compile} = build_attributes(Opts, SourceFile, Attr, MD5),
+ {Attributes,Compile} = build_attributes(Opts, CompilerOpts, SourceFile,
+ Attr, MD5),
AttrChunk = chunk(<<"Attr">>, Attributes),
CompileChunk = chunk(<<"CInf">>, Compile),
@@ -264,16 +265,16 @@ flatten_exports(Exps) ->
flatten_imports(Imps) ->
list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)).
-build_attributes(Opts, SourceFile, Attr, MD5) ->
+build_attributes(Opts, CompilerOpts, SourceFile, Attr, MD5) ->
Misc0 = case SourceFile of
[] -> [];
[_|_] -> [{source,SourceFile}]
end,
- Misc = case member(slim, Opts) of
+ Misc = case member(slim, CompilerOpts) of
false -> Misc0;
true -> []
end,
- Compile = case member(deterministic, Opts) of
+ Compile = case member(deterministic, CompilerOpts) of
false ->
[{options,Opts},{version,?COMPILER_VSN}|Misc];
true ->
diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl
index 94b47cf568..836378727b 100644
--- a/lib/compiler/src/beam_listing.erl
+++ b/lib/compiler/src/beam_listing.erl
@@ -24,6 +24,7 @@
-include("core_parse.hrl").
-include("v3_kernel.hrl").
-include("v3_life.hrl").
+-include("beam_disasm.hrl").
-import(lists, [foreach/2]).
@@ -59,6 +60,19 @@ module(Stream, {Mod,Exp,Attr,Code,NumLabels}) ->
[Name, Arity, Entry]),
io:put_chars(Stream, format_asm(Asm))
end, Code);
+module(Stream, Code) when is_binary(Code) ->
+ #beam_file{ module = Module, compile_info = CInfo } = beam_disasm:file(Code),
+ Loaded = code:is_loaded(Module),
+ Sticky = code:is_sticky(Module),
+ [code:unstick_mod(Module) || Sticky],
+
+ {module, Module} = code:load_binary(Module, proplists:get_value(source, CInfo), Code),
+ ok = erts_debug:df(Stream, Module),
+
+ %% Restore loaded module
+ _ = [{module, Module} = code:load_file(Module) || Loaded =/= false],
+ [code:stick_mod(Module) || Sticky],
+ ok;
module(Stream, [_|_]=Fs) ->
%% Form-based abstract format.
foreach(fun (F) -> io:format(Stream, "~p.\n", [F]) end, Fs).
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index aa2d224bb4..50b0ba76f8 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -787,8 +787,10 @@ asm_passes() ->
| binary_passes()].
binary_passes() ->
- [{native_compile,fun test_native/1,fun native_compile/2},
- {unless,binary,?pass(save_binary,not_werror)}].
+ [{iff,'to_dis',{listing,"dis"}},
+ {native_compile,fun test_native/1,fun native_compile/2},
+ {unless,binary,?pass(save_binary,not_werror)}
+ ].
%%%
%%% Compiler passes.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index f647a4030d..96897d612d 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -119,9 +119,19 @@ file_1(Config) when is_list(Config) ->
true = exists(Target),
passed = run(Target, test, []),
+ %% Test option 'deterministic' as a compiler attribute.
+ Det = deterministic_module,
+ {DetPath, DetTarget} = get_files(Config, Det, "det_target"),
+ {ok,Det,DetCode} = compile:file(DetPath, [binary]),
+ {module,Det} = code:load_binary(Det, "", DetCode),
+ [{version,_}] = Det:module_info(compile),
+ true = code:delete(Det),
+ false = code:purge(Det),
+
%% Cleanup.
ok = file:delete(Target),
ok = file:del_dir(filename:dirname(Target)),
+ ok = file:del_dir(filename:dirname(DetTarget)),
%% There should not be any messages in the messages.
receive
@@ -398,6 +408,7 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->
ok = file:delete(filename:join(Listings, File ++ ".core")),
do_listing(Simple, TargetDir, to_core, ".core"),
do_listing(Simple, TargetDir, to_kernel, ".kernel"),
+ do_listing(Simple, TargetDir, to_dis, ".dis"),
%% Final clean up.
lists:foreach(fun(F) -> ok = file:delete(F) end,
@@ -413,6 +424,7 @@ listings_big(Config) when is_list(Config) ->
do_listing(Big, TargetDir, 'E'),
do_listing(Big, TargetDir, 'P'),
do_listing(Big, TargetDir, dkern, ".kernel"),
+ do_listing(Big, TargetDir, to_dis, ".dis"),
TargetNoext = filename:rootname(Target, code:objfile_extension()),
{ok,big} = compile:file(TargetNoext, [from_asm,{outdir,TargetDir}]),
diff --git a/lib/compiler/test/compile_SUITE_data/deterministic_module.erl b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl
new file mode 100644
index 0000000000..5e0e29c25e
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/deterministic_module.erl
@@ -0,0 +1,21 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(deterministic_module).
+-compile([deterministic]).
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index b29c5082ba..3914a48679 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -4011,7 +4011,7 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_
return PKEY_BADARG;
password = get_key_password(env, key);
*pkey = ENGINE_load_private_key(e, id, NULL, password);
- if (!pkey)
+ if (!*pkey)
return PKEY_BADARG;
enif_free(id);
#else
@@ -4657,7 +4657,6 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
enif_alloc_binary(outlen, &out_bin);
- ERL_VALGRIND_ASSERT_MEM_DEFINED(out_bin.data, out_bin.size);
if (is_private) {
if (is_encrypt) {
/* private_encrypt */
@@ -4795,7 +4794,6 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI
EVP_PKEY *pkey;
ERL_NIF_TERM alg = argv[0];
ERL_NIF_TERM result[8];
-
if (get_pkey_private_key(env, alg, argv[1], &pkey) != PKEY_OK) {
return enif_make_badarg(env);
}
@@ -4827,9 +4825,10 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI
} else if (argv[0] == atom_ecdsa) {
#if defined(HAVE_EC)
- EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
- if (ec) {
- /* Example of result:
+ /* not yet implemented
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ if (ec) {
+ / * Example of result:
{
Curve = {Field, Prime, Point, Order, CoFactor} =
{
@@ -4843,7 +4842,7 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI
CoFactor = <<1>>
},
Key = <<151,...,62>>
- }
+ }
or
{
Curve =
@@ -4854,16 +4853,13 @@ static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NI
},
Key
}
- */
+ * /
EVP_PKEY_free(pkey);
- return atom_notsup;
- }
-#else
- EVP_PKEY_free(pkey);
- return atom_notsup;
+ return enif_make_list_from_array(env, ..., ...);
+ */
#endif
}
-
+
if (pkey) EVP_PKEY_free(pkey);
return enif_make_badarg(env);
}
@@ -4888,7 +4884,6 @@ static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
#ifdef HAS_ENGINE_SUPPORT
ERL_NIF_TERM ret;
ErlNifBinary engine_id_bin;
- unsigned int engine_id_len = 0;
char *engine_id;
ENGINE *engine;
struct engine_ctx *ctx;
@@ -4898,14 +4893,14 @@ static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
PRINTF_ERR0("engine_by_id_nif Leaved: badarg");
return enif_make_badarg(env);
} else {
- engine_id_len = engine_id_bin.size+1;
- engine_id = enif_alloc(engine_id_len);
- (void) memcpy(engine_id, engine_id_bin.data, engine_id_len);
- engine_id[engine_id_len-1] = '\0';
+ engine_id = enif_alloc(engine_id_bin.size+1);
+ (void) memcpy(engine_id, engine_id_bin.data, engine_id_bin.size);
+ engine_id[engine_id_bin.size] = '\0';
}
engine = ENGINE_by_id(engine_id);
if(!engine) {
+ enif_free(engine_id);
PRINTF_ERR0("engine_by_id_nif Leaved: {error, bad_engine_id}");
return enif_make_tuple2(env, atom_error, atom_bad_engine_id);
}
@@ -5040,7 +5035,8 @@ static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const
error:
for(i = 0; cmds != NULL && cmds[i] != NULL; i++)
- enif_free(cmds[i]);
+ enif_free(cmds[i]);
+ enif_free(cmds);
return ret;
#else
return atom_notsup;
@@ -5379,7 +5375,6 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha
ErlNifBinary tmpbin;
int arity;
char* tmpstr;
- int tmplen = 0;
if(!enif_is_empty_list(env, term)) {
if(!enif_get_list_cell(env, term, &head, &tail)) {
@@ -5394,10 +5389,9 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha
cmds[i] = NULL;
return -1;
} else {
- tmplen = tmpbin.size+1;
- tmpstr = enif_alloc(tmplen);
- (void) memcpy(tmpstr, tmpbin.data, tmplen);
- tmpstr[tmplen-1] = '\0';
+ tmpstr = enif_alloc(tmpbin.size+1);
+ (void) memcpy(tmpstr, tmpbin.data, tmpbin.size);
+ tmpstr[tmpbin.size] = '\0';
cmds[i++] = tmpstr;
}
if(!enif_inspect_binary(env, tmp_tuple[1], &tmpbin)) {
@@ -5407,10 +5401,9 @@ static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, cha
if(tmpbin.size == 0)
cmds[i++] = NULL;
else {
- tmplen = tmpbin.size+1;
- tmpstr = enif_alloc(tmplen);
- (void) memcpy(tmpstr, tmpbin.data, tmplen);
- tmpstr[tmplen-1] = '\0';
+ tmpstr = enif_alloc(tmpbin.size+1);
+ (void) memcpy(tmpstr, tmpbin.data, tmpbin.size);
+ tmpstr[tmpbin.size] = '\0';
cmds[i++] = tmpstr;
}
}
diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c
index a66bee2ddf..5c6122c06a 100644
--- a/lib/crypto/c_src/otp_test_engine.c
+++ b/lib/crypto/c_src/otp_test_engine.c
@@ -218,9 +218,9 @@ EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *
fclose(f);
if (!pkey) {
- fprintf(stderr, "%s:%d Key read from file failed. ", __FILE__,__LINE__);
+ fprintf(stderr, "%s:%d Key read from file %s failed.\r\n", __FILE__,__LINE__,id);
if (callback_data)
- fprintf(stderr, "Pwd = \"%s\". ", (char *)callback_data);
+ fprintf(stderr, "Pwd = \"%s\".\r\n", (char *)callback_data);
fprintf(stderr, "Contents of file \"%s\":\r\n",id);
f = fopen(id, "r");
{ /* Print the contents of the key file */
@@ -228,12 +228,14 @@ EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *
while (!feof(f)) {
switch (c=fgetc(f)) {
case '\n':
- case '\r': putc('\r',stdout); putc('\n',stdout); break;
- default: putc(c, stdout);
+ case '\r': putc('\r',stderr); putc('\n',stderr); break;
+ default: putc(c, stderr);
}
}
}
+ fprintf(stderr, "File contents printed.\r\n");
fclose(f);
+ return NULL;
}
return pkey;
diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile
index a902779383..aa987d2b39 100644
--- a/lib/crypto/doc/src/Makefile
+++ b/lib/crypto/doc/src/Makefile
@@ -39,7 +39,7 @@ XML_REF3_FILES = crypto.xml
XML_REF6_FILES = crypto_app.xml
XML_PART_FILES = usersguide.xml
-XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml
+XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml
BOOK_FILES = book.xml
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 8e2d33c928..dbc42812a8 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -136,11 +136,12 @@
See also <seealso marker="#supports-0">crypto:supports/0</seealso>
</p>
+ <marker id="engine_key_ref_type"/>
<code>engine_key_ref() = #{engine := engine_ref(),
key_id := key_id(),
password => password()}</code>
- <code>engine_key_ref() = term()</code>
+ <code>engine_ref() = term()</code>
<p>The result of a call to <seealso marker="#engine_load-3">engine_load/3</seealso>.
</p>
diff --git a/lib/crypto/doc/src/engine_keys.xml b/lib/crypto/doc/src/engine_keys.xml
new file mode 100644
index 0000000000..38714fed8a
--- /dev/null
+++ b/lib/crypto/doc/src/engine_keys.xml
@@ -0,0 +1,129 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE chapter SYSTEM "chapter.dtd">
+
+<chapter>
+ <header>
+ <copyright>
+ <year>2017</year><year>2017</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ 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.
+ </legalnotice>
+ <title>Engine Stored Keys</title>
+ <prepared>Hans Nilsson</prepared>
+ <date>2017-11-10</date>
+ <file>engine_keys.xml</file>
+ </header>
+ <p>
+ <marker id="engine_key"></marker>
+ This chapter describes the support in the crypto application for using public and private keys stored in encryption engines.
+ </p>
+
+ <section>
+ <title>Background</title>
+ <p>
+ <url href="https://www.openssl.org/">OpenSSL</url> exposes an Engine API, which makes
+ it possible to plug in alternative implementations for some of the cryptographic
+ operations implemented by OpenSSL.
+ See the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ for details and how to load an Engine.
+ </p>
+ <p>
+ An engine could among other tasks provide a storage for
+ private or public keys. Such a storage could be made safer than the normal file system. Thoose techniques are not
+ described in this User's Guide. Here we concentrate on how to use private or public keys stored in
+ such an engine.
+ </p>
+ <p>
+ The storage engine must call <c>ENGINE_set_load_privkey_function</c> and <c>ENGINE_set_load_pubkey_function</c>.
+ See the OpenSSL cryptolib's <url href="https://www.openssl.org/docs/manpages.html">manpages</url>.
+ </p>
+ <p>
+ OTP/Crypto requires that the user provides two or three items of information about the key. The application used
+ by the user is usually on a higher level, for example in
+ <seealso marker="ssl:ssl#key_option_def">SSL</seealso>. If using
+ the crypto application directly, it is required that:
+ </p>
+ <list>
+ <item>an Engine is loaded, see the chapter on <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ or the <seealso marker="crypto:crypto#engine_load-3">Reference Manual</seealso>
+ </item>
+ <item>a reference to a key in the Engine is available. This should be an Erlang string or binary and depends
+ on the Engine loaded
+ </item>
+ <item>an Erlang map is constructed with the Engine reference, the key reference and possibly a key passphrase if
+ needed by the Engine. See the <seealso marker="crypto:crypto#engine_key_ref_type">Reference Manual</seealso> for
+ details of the map.
+ </item>
+ </list>
+ </section>
+
+ <section>
+ <title>Use Cases</title>
+ <section>
+ <title>Sign with an engine stored private key</title>
+ <p>
+ This example shows how to construct a key reference that is used in a sign operation.
+ The actual key is stored in the engine that is loaded at prompt 1.
+ </p>
+ <code>
+1> {ok, EngineRef} = crypto:engine_load(....).
+...
+{ok,#Ref&lt;0.2399045421.3028942852.173962>}
+2> PrivKey = #{engine => EngineRef,
+ key_id => "id of the private key in Engine"}.
+...
+3> Signature = crypto:sign(rsa, sha, &lt;&lt;"The message">>, PrivKey).
+&lt;&lt;65,6,125,254,54,233,84,77,83,63,168,28,169,214,121,76,
+ 207,177,124,183,156,185,160,243,36,79,125,230,231,...>>
+ </code>
+ </section>
+
+ <section>
+ <title>Verify with an engine stored public key</title>
+ <p>
+ Here the signature and message in the last example is verifyed using the public key.
+ The public key is stored in an engine, only to exemplify that it is possible. The public
+ key could of course be handled openly as usual.
+ </p>
+ <code>
+4> PublicKey = #{engine => EngineRef,
+ key_id => "id of the public key in Engine"}.
+...
+5> crypto:verify(rsa, sha, &lt;&lt;"The message">>, Signature, PublicKey).
+true
+6>
+ </code>
+ </section>
+
+ <section>
+ <title>Using a password protected private key</title>
+ <p>
+ The same example as the first sign example, except that a password protects the key down in the Engine.
+ </p>
+ <code>
+6> PrivKeyPwd = #{engine => EngineRef,
+ key_id => "id of the pwd protected private key in Engine",
+ password => "password"}.
+...
+7> crypto:sign(rsa, sha, &lt;&lt;"The message">>, PrivKeyPwd).
+&lt;&lt;140,80,168,101,234,211,146,183,231,190,160,82,85,163,
+ 175,106,77,241,141,120,72,149,181,181,194,154,175,76,
+ 223,...>>
+8>
+ </code>
+
+ </section>
+
+ </section>
+</chapter>
diff --git a/lib/crypto/doc/src/usersguide.xml b/lib/crypto/doc/src/usersguide.xml
index f637a1db79..e2ba1fe160 100644
--- a/lib/crypto/doc/src/usersguide.xml
+++ b/lib/crypto/doc/src/usersguide.xml
@@ -49,4 +49,5 @@
<xi:include href="licenses.xml"/>
<xi:include href="fips.xml"/>
<xi:include href="engine_load.xml"/>
+ <xi:include href="engine_keys.xml"/>
</part>
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index 0d39dcc76e..641e526537 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -1061,9 +1061,17 @@ ec_curve(X) ->
privkey_to_pubkey(Alg, EngineMap) when Alg == rsa; Alg == dss; Alg == ecdsa ->
- case privkey_to_pubkey_nif(Alg, format_pkey(Alg,EngineMap)) of
+ try privkey_to_pubkey_nif(Alg, format_pkey(Alg,EngineMap))
+ of
[_|_]=L -> map_ensure_bin_as_int(L);
X -> X
+ catch
+ error:badarg when Alg==ecdsa ->
+ {error, notsup};
+ error:badarg ->
+ {error, not_found};
+ error:notsup ->
+ {error, notsup}
end.
privkey_to_pubkey_nif(_Alg, _EngineMap) -> ?nif_stub.
diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl
index 72bd59f8ab..06cce832ac 100644
--- a/lib/crypto/test/engine_SUITE.erl
+++ b/lib/crypto/test/engine_SUITE.erl
@@ -53,10 +53,15 @@ groups() ->
sign_verify_dsa,
sign_verify_ecdsa,
sign_verify_rsa_pwd,
+ sign_verify_rsa_pwd_bad_pwd,
priv_encrypt_pub_decrypt_rsa,
priv_encrypt_pub_decrypt_rsa_pwd,
pub_encrypt_priv_decrypt_rsa,
pub_encrypt_priv_decrypt_rsa_pwd,
+ get_pub_from_priv_key_rsa,
+ get_pub_from_priv_key_rsa_pwd,
+ get_pub_from_priv_key_rsa_pwd_no_pwd,
+ get_pub_from_priv_key_rsa_pwd_bad_pwd,
get_pub_from_priv_key_dsa,
get_pub_from_priv_key_ecdsa
]}].
@@ -382,6 +387,18 @@ sign_verify_rsa_pwd(Config) ->
key_id => key_id(Config, "rsa_public_key_pwd.pem")},
sign_verify(rsa, sha, Priv, Pub).
+sign_verify_rsa_pwd_bad_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key_pwd.pem"),
+ password => "Bad password"},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_public_key_pwd.pem")},
+ try sign_verify(rsa, sha, Priv, Pub) of
+ _ -> {fail, "PWD prot pubkey sign succeded with no pwd!"}
+ catch
+ error:badarg -> ok
+ end.
+
priv_encrypt_pub_decrypt_rsa(Config) ->
Priv = #{engine => engine_ref(Config),
key_id => key_id(Config, "rsa_private_key.pem")},
@@ -406,33 +423,100 @@ pub_encrypt_priv_decrypt_rsa(Config) ->
pub_encrypt_priv_decrypt_rsa_pwd(Config) ->
Priv = #{engine => engine_ref(Config),
- key_id => key_id(Config, "rsa_private_key.pem"),
+ key_id => key_id(Config, "rsa_private_key_pwd.pem"),
password => "password"},
Pub = #{engine => engine_ref(Config),
- key_id => key_id(Config, "rsa_public_key.pem")},
+ key_id => key_id(Config, "rsa_public_key_pwd.pem")},
pub_enc_priv_dec(rsa, Pub, Priv, rsa_pkcs1_padding).
get_pub_from_priv_key_rsa(Config) ->
Priv = #{engine => engine_ref(Config),
key_id => key_id(Config, "rsa_private_key.pem")},
- Pub = crypto:privkey_to_pubkey(rsa, Priv),
- ct:log("rsa Pub = ~p",[Pub]),
- sign_verify(rsa, sha, Priv, Pub).
+ case crypto:privkey_to_pubkey(rsa, Priv) of
+ {error, not_found} ->
+ {fail, "Key not found"};
+ {error, notsup} ->
+ {skip, "RSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
+ ct:log("rsa Pub = ~p",[Pub]),
+ sign_verify(rsa, sha, Priv, Pub)
+ end.
+
+get_pub_from_priv_key_rsa_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key_pwd.pem"),
+ password => "password"},
+ case crypto:privkey_to_pubkey(rsa, Priv) of
+ {error, not_found} ->
+ {fail, "Key not found"};
+ {error, notsup} ->
+ {skip, "RSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
+ ct:log("rsa Pub = ~p",[Pub]),
+ sign_verify(rsa, sha, Priv, Pub)
+ end.
+
+get_pub_from_priv_key_rsa_pwd_no_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key_pwd.pem")},
+ case crypto:privkey_to_pubkey(rsa, Priv) of
+ {error, not_found} ->
+ ok;
+ {error, notsup} ->
+ {skip, "RSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
+ ct:log("rsa Pub = ~p",[Pub]),
+ {fail, "PWD prot pubkey fetch succeded although no pwd!"}
+ end.
+
+get_pub_from_priv_key_rsa_pwd_bad_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key_pwd.pem"),
+ password => "Bad password"},
+ case crypto:privkey_to_pubkey(rsa, Priv) of
+ {error, not_found} ->
+ ok;
+ {error, notsup} ->
+ {skip, "RSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
+ ct:log("rsa Pub = ~p",[Pub]),
+ {fail, "PWD prot pubkey fetch succeded with bad pwd!"}
+ end.
get_pub_from_priv_key_dsa(Config) ->
Priv = #{engine => engine_ref(Config),
key_id => key_id(Config, "dsa_private_key.pem")},
- Pub = crypto:privkey_to_pubkey(dss, Priv),
- ct:log("dsa Pub = ~p",[Pub]),
- sign_verify(dss, sha, Priv, Pub).
+ case crypto:privkey_to_pubkey(dss, Priv) of
+ {error, not_found} ->
+ {fail, "Key not found"};
+ {error, notsup} ->
+ {skip, "DSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
+ ct:log("dsa Pub = ~p",[Pub]),
+ sign_verify(dss, sha, Priv, Pub)
+ end.
get_pub_from_priv_key_ecdsa(Config) ->
Priv = #{engine => engine_ref(Config),
key_id => key_id(Config, "ecdsa_private_key.pem")},
- Pub = crypto:privkey_to_pubkey(ecdsa, Priv),
- case Pub of
- notsup -> {skip, "ECDSA not implemented"};
- _ ->
+ case crypto:privkey_to_pubkey(ecdsa, Priv) of
+ {error, not_found} ->
+ {fail, "Key not found"};
+ {error, notsup} ->
+ {skip, "ECDSA not supported"};
+ {error, Error} ->
+ {fail, {wrong_error,Error}};
+ Pub ->
ct:log("ecdsa Pub = ~p",[Pub]),
sign_verify(ecdsa, sha, Priv, Pub)
end.
diff --git a/lib/debugger/doc/src/Makefile b/lib/debugger/doc/src/Makefile
index 0f724b6f17..cc0b8861d3 100644
--- a/lib/debugger/doc/src/Makefile
+++ b/lib/debugger/doc/src/Makefile
@@ -41,7 +41,7 @@ XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = debugger.xml i.xml int.xml
XML_PART_FILES = part.xml
-XML_CHAPTER_FILES = debugger_chapter.xml notes.xml
+XML_CHAPTER_FILES = introduction.xml debugger_chapter.xml notes.xml
BOOK_FILES = book.xml
diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
index a4b42c9367..9993c68fed 100644
--- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl
@@ -165,7 +165,11 @@ analysis_start(Parent, Analysis, LegalWarnings) ->
remote_type_postprocessing(TmpCServer, Args) ->
Fun = fun() ->
- exit(remote_type_postproc(TmpCServer, Args))
+ exit(try remote_type_postproc(TmpCServer, Args) of
+ R -> R
+ catch
+ throw:{error,_}=Error -> Error
+ end)
end,
{Pid, Ref} = erlang:spawn_monitor(Fun),
dialyzer_codeserver:give_away(TmpCServer, Pid),
diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl
index c4d8f45447..d03326ec97 100644
--- a/lib/dialyzer/src/dialyzer_typesig.erl
+++ b/lib/dialyzer/src/dialyzer_typesig.erl
@@ -41,7 +41,7 @@
t_is_float/1, t_is_fun/1,
t_is_integer/1, t_non_neg_integer/0,
t_is_list/1, t_is_nil/1, t_is_none/1, t_is_number/1,
- t_is_singleton/1,
+ t_is_singleton/1, t_is_none_or_unit/1,
t_limit/2, t_list/0, t_list/1,
t_list_elements/1, t_nonempty_list/1, t_maybe_improper_list/0,
@@ -528,13 +528,14 @@ traverse(Tree, DefinedVars, State) ->
false -> t_any();
true ->
MT = t_inf(lookup_type(MapVar, Map), t_map()),
- case t_is_none(MT) of
+ case t_is_none_or_unit(MT) of
true -> t_none();
false ->
DisjointFromKeyType =
fun(ShadowKey) ->
- t_is_none(t_inf(lookup_type(ShadowKey, Map),
- KeyType))
+ ST = t_inf(lookup_type(ShadowKey, Map),
+ KeyType),
+ t_is_none_or_unit(ST)
end,
case lists:all(DisjointFromKeyType, ShadowKeys) of
true -> t_map_get(KeyType, MT);
@@ -567,7 +568,8 @@ traverse(Tree, DefinedVars, State) ->
case cerl:is_literal(OpTree) andalso
cerl:concrete(OpTree) =:= exact of
true ->
- case t_is_none(t_inf(ShadowedKeys, KeyType)) of
+ ST = t_inf(ShadowedKeys, KeyType),
+ case t_is_none_or_unit(ST) of
true ->
t_map_put({KeyType, t_any()}, AccType);
false ->
diff --git a/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun b/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun
new file mode 100644
index 0000000000..cfca5b1407
--- /dev/null
+++ b/lib/dialyzer/test/map_SUITE_data/results/map_anon_fun
@@ -0,0 +1,2 @@
+
+map_anon_fun.erl:4: Function g/1 will never be called
diff --git a/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl b/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl
new file mode 100644
index 0000000000..e77016d68a
--- /dev/null
+++ b/lib/dialyzer/test/map_SUITE_data/src/map_anon_fun.erl
@@ -0,0 +1,9 @@
+-module(map_anon_fun).
+
+%% Not exported.
+g(A) ->
+ maps:map(fun F(K, {V, _C}) ->
+ F(K, V);
+ F(_K, _V) ->
+ #{ system => {A} }
+ end, #{}).
diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl
index ebe79b2a6d..680f5b5088 100644
--- a/lib/dialyzer/test/plt_SUITE.erl
+++ b/lib/dialyzer/test/plt_SUITE.erl
@@ -9,14 +9,14 @@
-export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1,
local_fun_same_as_callback/1,
remove_plt/1, run_plt_check/1, run_succ_typings/1,
- bad_dialyzer_attr/1, merge_plts/1]).
+ bad_dialyzer_attr/1, merge_plts/1, bad_record_type/1]).
suite() ->
[{timetrap, ?plt_timeout}].
all() -> [build_plt, beam_tests, update_plt, run_plt_check,
remove_plt, run_succ_typings, local_fun_same_as_callback,
- bad_dialyzer_attr, merge_plts].
+ bad_dialyzer_attr, merge_plts, bad_record_type].
build_plt(Config) ->
OutDir = ?config(priv_dir, Config),
@@ -283,8 +283,8 @@ bad_dialyzer_attr(Config) ->
{dialyzer_error,
"Analysis failed with error:\n" ++ Str1} =
(catch dialyzer:run(Opts)),
- P1 = string:str(Str1, "dial.erl:2: function undef/0 undefined"),
- true = P1 > 0,
+ S1 = string:find(Str1, "dial.erl:2: function undef/0 undefined"),
+ true = is_list(S1),
Prog2 = <<"-module(dial).
-dialyzer({no_return, [{undef,1,2}]}).">>,
@@ -292,9 +292,9 @@ bad_dialyzer_attr(Config) ->
{dialyzer_error,
"Analysis failed with error:\n" ++ Str2} =
(catch dialyzer:run(Opts)),
- P2 = string:str(Str2, "dial.erl:2: badly formed dialyzer "
- "attribute: {no_return,{undef,1,2}}"),
- true = P2 > 0,
+ S2 = string:find(Str2, "dial.erl:2: badly formed dialyzer "
+ "attribute: {no_return,{undef,1,2}}"),
+ true = is_list(S2),
ok.
@@ -369,6 +369,32 @@ create_plts(Mod1, Mod2, Config) ->
%% End of merge_plts().
+bad_record_type(Config) ->
+ PrivDir = ?config(priv_dir, Config),
+ Source = lists:concat([bad_record_type, ".erl"]),
+ Filename = filename:join(PrivDir, Source),
+ PltFilename = dialyzer_common:plt_file(PrivDir),
+
+ Opts = [{files, [Filename]},
+ {check_plt, false},
+ {from, src_code},
+ {init_plt, PltFilename}],
+
+ Prog = <<"-module(bad_record_type).
+ -export([r/0]).
+ -record(r, {f = 3 :: integer()}).
+ -spec r() -> #r{f :: atom()}.
+ r() ->
+ #r{}.">>,
+ ok = file:write_file(Filename, Prog),
+ {dialyzer_error,
+ "Analysis failed with error:\n" ++ Str} =
+ (catch dialyzer:run(Opts)),
+ P = string:str(Str,
+ "bad_record_type.erl:4: Illegal declaration of #r{f}"),
+ true = P > 0,
+ ok.
+
erlang_beam() ->
case code:where_is_file("erlang.beam") of
non_existing ->
diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl
index fb04bfce0e..4e45e42f20 100644
--- a/lib/edoc/src/edoc_specs.erl
+++ b/lib/edoc/src/edoc_specs.erl
@@ -372,7 +372,7 @@ d2e({type,_,binary,[Base,Unit]}, _Prec) ->
{integer,_,U} = erl_eval:partial_eval(Unit),
#t_binary{base_size = B, unit_size = U};
d2e({type,_,map,any}, _Prec) ->
- #t_map{types = []};
+ #t_type{name = #t_name{name = map}, args = []};
d2e({type,_,map,Es}, _Prec) ->
#t_map{types = d2e(Es) };
d2e({type,_,map_field_assoc,[K,V]}, Prec) ->
diff --git a/lib/eldap/doc/src/Makefile b/lib/eldap/doc/src/Makefile
index ac869e446f..aff1da4a9a 100644
--- a/lib/eldap/doc/src/Makefile
+++ b/lib/eldap/doc/src/Makefile
@@ -37,7 +37,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = eldap.xml
-XML_PART_FILES = release_notes.xml usersguide.xml
+XML_PART_FILES = usersguide.xml
XML_CHAPTER_FILES = notes.xml
BOOK_FILES = book.xml
diff --git a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
index 7cdbb502d9..91422c8910 100644
--- a/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
+++ b/lib/erl_docgen/src/docgen_edoc_xml_cb.erl
@@ -489,6 +489,8 @@ otp_xmlify_a_href("#"++_ = Marker, Es0) -> % <seealso marker="#what">
{Marker, Es0};
otp_xmlify_a_href("http:"++_ = URL, Es0) -> % external URL
{URL, Es0};
+otp_xmlify_a_href("https:"++_ = URL, Es0) -> % external URL
+ {URL, Es0};
otp_xmlify_a_href("OTPROOT"++AppRef, Es0) -> % <.. marker="App:FileRef
[AppS, "doc", FileRef1] = split(AppRef, "/"),
FileRef = AppS++":"++otp_xmlify_a_fileref(FileRef1, AppS),
diff --git a/lib/erl_interface/doc/src/Makefile b/lib/erl_interface/doc/src/Makefile
index a96ef62786..8ef7e9648c 100644
--- a/lib/erl_interface/doc/src/Makefile
+++ b/lib/erl_interface/doc/src/Makefile
@@ -53,7 +53,7 @@ XML_APPLICATION_FILES = ref_man.xml
#ref_man_ei.xml ref_man_erl_interface.xml
XML_PART_FILES = \
part.xml
-XML_CHAPTER_FILES = ei_users_guide.xml notes.xml notes_history.xml
+XML_CHAPTER_FILES = ei_users_guide.xml notes.xml
XML_FILES = $(XML_REF1_FILES) $(XML_REF3_FILES) $(BOOK_FILES) \
$(XML_APPLICATION_FILES) $(XML_PART_FILES) $(XML_CHAPTER_FILES)
diff --git a/lib/erl_interface/src/Makefile b/lib/erl_interface/src/Makefile
index 31f34d4bba..135522397b 100644
--- a/lib/erl_interface/src/Makefile
+++ b/lib/erl_interface/src/Makefile
@@ -29,5 +29,5 @@ include $(ERL_TOP)/make/target.mk
debug opt shared purify quantify purecov gcov:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile TYPE=$@
-clean depend docs release release_docs tests release_tests check:
+clean depend docs release release_docs tests release_tests check xmllint:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile $@
diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in
index 4f393e952c..69b5b6003d 100644
--- a/lib/erl_interface/src/Makefile.in
+++ b/lib/erl_interface/src/Makefile.in
@@ -854,3 +854,5 @@ endif
release_docs:
release_tests:
+
+xmllint:
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index abb6c259f6..4e0f93212d 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -1877,6 +1877,7 @@ t_map_put(KV, Map, Opaques) ->
%% Key and Value are *not* unopaqued, but the map is
map_put(_, ?none, _) -> ?none;
+map_put(_, ?unit, _) -> ?none;
map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) ->
case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of
true -> ?none;
@@ -1902,6 +1903,7 @@ t_map_update(KV, Map) ->
-spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type().
t_map_update(_, ?none, _) -> ?none;
+t_map_update(_, ?unit, _) -> ?none;
t_map_update(KV={Key, _}, M, Opaques) ->
case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of
false -> ?none;
@@ -1922,6 +1924,7 @@ t_map_get(Key, Map, Opaques) ->
end).
map_get(_, ?none) -> ?none;
+map_get(_, ?unit) -> ?none;
map_get(Key, ?map(Pairs, DefK, DefV)) ->
DefRes =
case t_do_overlap(DefK, Key) of
@@ -1957,6 +1960,7 @@ t_map_is_key(Key, Map, Opaques) ->
end).
map_is_key(_, ?none) -> ?none;
+map_is_key(_, ?unit) -> ?none;
map_is_key(Key, ?map(Pairs, DefK, _DefV)) ->
case is_singleton_type(Key) of
true ->
diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile
index 63154abd6a..1c774d3357 100644
--- a/lib/hipe/doc/src/Makefile
+++ b/lib/hipe/doc/src/Makefile
@@ -38,7 +38,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES =
-XML_PART_FILES =
+XML_PART_FILES = hipe_app.xml
XML_CHAPTER_FILES = notes.xml
BOOK_FILES = book.xml
diff --git a/lib/inets/doc/src/Makefile b/lib/inets/doc/src/Makefile
index 14f12ee949..cbfa5c9e30 100644
--- a/lib/inets/doc/src/Makefile
+++ b/lib/inets/doc/src/Makefile
@@ -39,6 +39,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN)
XML_APPLICATION_FILES = ref_man.xml
XML_CHAPTER_FILES = \
+ introduction.xml \
inets_services.xml \
http_client.xml \
http_server.xml \
diff --git a/lib/inets/src/http_client/httpc_handler.erl b/lib/inets/src/http_client/httpc_handler.erl
index 6907bf5262..1482f4f922 100644
--- a/lib/inets/src/http_client/httpc_handler.erl
+++ b/lib/inets/src/http_client/httpc_handler.erl
@@ -109,7 +109,7 @@ start_link(Parent, Request, Options, ProfileName) ->
%% to be called by the httpc manager process.
%%--------------------------------------------------------------------
send(Request, Pid) ->
- call(Request, Pid, 5000).
+ call(Request, Pid).
%%--------------------------------------------------------------------
@@ -712,12 +712,16 @@ do_handle_info({'EXIT', _, _}, State = #state{request = undefined}) ->
do_handle_info({'EXIT', _, _}, State) ->
{noreply, State#state{status = close}}.
-
call(Msg, Pid) ->
- call(Msg, Pid, infinity).
-
-call(Msg, Pid, Timeout) ->
- gen_server:call(Pid, Msg, Timeout).
+ try gen_server:call(Pid, Msg)
+ catch
+ exit:{noproc, _} ->
+ {error, closed};
+ exit:{normal, _} ->
+ {error, closed};
+ exit:{{shutdown, _},_} ->
+ {error, closed}
+ end.
cast(Msg, Pid) ->
gen_server:cast(Pid, Msg).
diff --git a/lib/inets/src/http_client/httpc_manager.erl b/lib/inets/src/http_client/httpc_manager.erl
index a63864493f..ffdf1603b3 100644
--- a/lib/inets/src/http_client/httpc_manager.erl
+++ b/lib/inets/src/http_client/httpc_manager.erl
@@ -849,11 +849,11 @@ pipeline_or_keep_alive(#request{id = Id,
from = From} = Request,
HandlerPid,
#state{handler_db = HandlerDb} = State) ->
- case (catch httpc_handler:send(Request, HandlerPid)) of
+ case httpc_handler:send(Request, HandlerPid) of
ok ->
HandlerInfo = {Id, HandlerPid, From},
ets:insert(HandlerDb, HandlerInfo);
- _ -> % timeout pipelining failed
+ {error, closed} -> % timeout pipelining failed
start_handler(Request, State)
end.
diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl
index cc166d522e..75b50f3420 100644
--- a/lib/inets/test/httpc_SUITE.erl
+++ b/lib/inets/test/httpc_SUITE.erl
@@ -58,7 +58,7 @@ all() ->
groups() ->
[
{http, [], real_requests()},
- {sim_http, [], only_simulated()},
+ {sim_http, [], only_simulated() ++ [process_leak_on_keepalive]},
{https, [], real_requests()},
{sim_https, [], only_simulated()},
{misc, [], misc()}
@@ -119,7 +119,6 @@ only_simulated() ->
empty_response_header,
remote_socket_close,
remote_socket_close_async,
- process_leak_on_keepalive,
transfer_encoding,
transfer_encoding_identity,
redirect_loop,
diff --git a/lib/jinterface/doc/src/Makefile b/lib/jinterface/doc/src/Makefile
index 7eb0e20b4d..37de0a35c5 100644
--- a/lib/jinterface/doc/src/Makefile
+++ b/lib/jinterface/doc/src/Makefile
@@ -46,12 +46,11 @@ XML_PART_FILES = \
part.xml
XML_CHAPTER_FILES = \
notes.xml \
- notes_history.xml \
jinterface_users_guide.xml
BOOK_FILES = book.xml
-XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) \
+XML_FILES = $(BOOK_FILES) $(XML_APP_FILES) $(XML_REF3_FILES) \
$(XML_PART_FILES) $(XML_CHAPTER_FILES)
GIF_FILES =
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile
index e55cfa62ea..001acfdd2e 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile
@@ -130,7 +130,6 @@ release_spec: opt
release_docs_spec:
-
-
+xmllint:
# ----------------------------------------------------
diff --git a/lib/kernel/doc/src/Makefile b/lib/kernel/doc/src/Makefile
index c9d23ac4c4..0759f362d4 100644
--- a/lib/kernel/doc/src/Makefile
+++ b/lib/kernel/doc/src/Makefile
@@ -71,7 +71,7 @@ XML_REF4_FILES = app.xml config.xml
XML_REF6_FILES = kernel_app.xml
XML_PART_FILES =
-XML_CHAPTER_FILES = notes.xml notes_history.xml
+XML_CHAPTER_FILES = notes.xml
BOOK_FILES = book.xml
diff --git a/lib/kernel/doc/src/gen_tcp.xml b/lib/kernel/doc/src/gen_tcp.xml
index 070782e1f3..e6104b0c76 100644
--- a/lib/kernel/doc/src/gen_tcp.xml
+++ b/lib/kernel/doc/src/gen_tcp.xml
@@ -51,6 +51,7 @@ server() ->
{ok, Sock} = gen_tcp:accept(LSock),
{ok, Bin} = do_recv(Sock, []),
ok = gen_tcp:close(Sock),
+ ok = gen_tcp:close(LSock),
Bin.
do_recv(Sock, Bs) ->
@@ -309,9 +310,9 @@ do_recv(Sock, Bs) ->
<seealso marker="inet#setopts/2"><c>inet:setopts/2</c></seealso>.
</p></item>
</taglist>
- <p>The returned socket <c><anno>ListenSocket</anno></c> can only be
- used in calls to
- <seealso marker="#accept/1"><c>accept/1,2</c></seealso>.</p>
+ <p>The returned socket <c><anno>ListenSocket</anno></c> should be used
+ in calls to <seealso marker="#accept/1"><c>accept/1,2</c></seealso> to
+ accept incoming connection requests.</p>
<note>
<p>The default values for options specified to <c>listen</c> can
be affected by the Kernel configuration parameter
diff --git a/lib/kernel/src/erts_debug.erl b/lib/kernel/src/erts_debug.erl
index 480db6814e..9662f8fa90 100644
--- a/lib/kernel/src/erts_debug.erl
+++ b/lib/kernel/src/erts_debug.erl
@@ -21,7 +21,7 @@
%% Low-level debugging support. EXPERIMENTAL!
--export([size/1,df/1,df/2,df/3,ic/1]).
+-export([size/1,df/1,df/2,df/3,df/4,ic/1]).
%% This module contains the following *experimental* BIFs:
%% disassemble/1
@@ -347,31 +347,39 @@ is_term_seen(_, []) -> false.
-spec df(module()) -> df_ret().
df(Mod) when is_atom(Mod) ->
+ df(lists:concat([Mod, ".dis"]), Mod).
+
+-spec df(module(), atom()) -> df_ret();
+ (file:io_device() | file:filename(), module()) -> df_ret().
+
+df(Mod, Func) when is_atom(Mod), is_atom(Func) ->
+ df(lists:concat([Mod, "_", Func, ".dis"]), Mod, Func);
+df(Name, Mod) when is_atom(Mod) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
- Name = lists:concat([Mod, ".dis"]),
Fs = [{Mod,Func,Arity} || {Func,Arity} <- Fs0],
dff(Name, Fs)
catch _:_ -> {undef,Mod}
end.
--spec df(module(), atom()) -> df_ret().
-df(Mod, Func) when is_atom(Mod), is_atom(Func) ->
+-spec df(module(), atom(), arity()) -> df_ret();
+ (file:io_device() | file:filename(), module(), atom()) -> df_ret().
+
+df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
+ df(lists:concat([Mod, "_", Func, "_", Arity, ".dis"]), Mod, Func, Arity);
+df(Name, Mod, Func) when is_atom(Mod), is_atom(Func) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
- Name = lists:concat([Mod, "_", Func, ".dis"]),
Fs = [{Mod,Func1,Arity} || {Func1,Arity} <- Fs0, Func1 =:= Func],
dff(Name, Fs)
catch _:_ -> {undef,Mod}
end.
--spec df(module(), atom(), arity()) -> df_ret().
-
-df(Mod, Func, Arity) when is_atom(Mod), is_atom(Func) ->
+-spec df(file:io_device() | file:filename(), module(), atom(), arity()) -> df_ret().
+df(Name, Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
try Mod:module_info(functions) of
Fs0 when is_list(Fs0) ->
- Name = lists:concat([Mod, "_", Func, "_", Arity, ".dis"]),
Fs = [{Mod,Func1,Arity1} || {Func1,Arity1} <- Fs0,
Func1 =:= Func, Arity1 =:= Arity],
dff(Name, Fs)
diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src
index f1ef70a373..4ee497bbbd 100644
--- a/lib/kernel/src/kernel.appup.src
+++ b/lib/kernel/src/kernel.appup.src
@@ -18,7 +18,9 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*, OTP-20.0
+ [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-20.1+
%% Down to - max one major revision back
- [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*, OTP-20.0
+ [{<<"5\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*, OTP-20.0
+ {<<"5\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-20.1+
}.
diff --git a/lib/mnesia/doc/src/Makefile b/lib/mnesia/doc/src/Makefile
index da7a9e9516..82fcf66256 100644
--- a/lib/mnesia/doc/src/Makefile
+++ b/lib/mnesia/doc/src/Makefile
@@ -48,6 +48,7 @@ XML_PART_FILES = \
XML_CHAPTER_FILES = \
Mnesia_chap1.xml \
+ Mnesia_overview.xml \
Mnesia_chap2.xml \
Mnesia_chap3.xml \
Mnesia_chap4.xml \
diff --git a/lib/mnesia/src/mnesia.erl b/lib/mnesia/src/mnesia.erl
index b68b2de028..1842769778 100644
--- a/lib/mnesia/src/mnesia.erl
+++ b/lib/mnesia/src/mnesia.erl
@@ -151,7 +151,8 @@
{'snmp', SnmpStruct::term()} |
{'storage_properties', [{Backend::module(), [BackendProp::_]}]} |
{'type', 'set' | 'ordered_set' | 'bag'} |
- {'local_content', boolean()}.
+ {'local_content', boolean()} |
+ {'user_properties', proplists:proplist()}.
-type t_result(Res) :: {'atomic', Res} | {'aborted', Reason::term()}.
-type activity() :: 'ets' | 'async_dirty' | 'sync_dirty' | 'transaction' | 'sync_transaction' |
diff --git a/lib/observer/doc/src/Makefile b/lib/observer/doc/src/Makefile
index a3b0663041..11bfee1bdb 100644
--- a/lib/observer/doc/src/Makefile
+++ b/lib/observer/doc/src/Makefile
@@ -48,12 +48,12 @@ XML_PART_FILES = \
part.xml
XML_CHAPTER_FILES = \
+ introduction_ug.xml \
crashdump_ug.xml \
etop_ug.xml \
observer_ug.xml \
ttb_ug.xml \
- notes.xml \
- notes_history.xml
+ notes.xml
BOOK_FILES = book.xml
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index 40450a2873..feaec5c678 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -105,8 +105,10 @@
% line_head/1 function can return
-define(not_available,"N/A").
-define(binary_size_progress_limit,10000).
--define(max_dump_version,[0,4]).
+-define(max_dump_version,[0,5]).
+%% The value of the next define must be divisible by 4.
+-define(base64_chunk_size, (4*256)).
%% All possible tags - use macros in order to avoid misspelling in the code
-define(abort,abort).
@@ -145,6 +147,7 @@
-record(state,{file,dump_vsn,wordsize=4,num_atoms="unknown"}).
+-record(dec_opts, {bin_addr_adj=0,base64=true}).
%%%-----------------------------------------------------------------
%%% Debugging
@@ -367,10 +370,12 @@ handle_call(general_info,_From,State=#state{file=File}) ->
ets:insert(cdv_reg_proc_table,
{cdv_dump_node_name,GenInfo#general_info.node_name}),
{reply,{ok,GenInfo,TW},State#state{wordsize=WS, num_atoms=NumAtoms}};
-handle_call({expand_binary,{Offset,Size,Pos}},_From,State=#state{file=File}) ->
+handle_call({expand_binary,{Offset,Size,Pos}},_From,
+ #state{file=File,dump_vsn=DumpVsn}=State) ->
Fd = open(File),
pos_bof(Fd,Pos),
- {Bin,_Line} = get_binary(Offset,Size,bytes(Fd)),
+ DecodeOpts = get_decode_opts(DumpVsn),
+ {Bin,_Line} = get_binary(Offset,Size,bytes(Fd),DecodeOpts),
close(Fd),
{reply,{ok,Bin},State};
handle_call(procs_summary,_From,State=#state{file=File,wordsize=WS}) ->
@@ -443,9 +448,11 @@ handle_call(loaded_mods,_From,State=#state{file=File}) ->
TW = truncated_warning([?mod]),
{_CC,_OC,Mods} = loaded_mods(File),
{reply,{ok,Mods,TW},State};
-handle_call({loaded_mod_details,Mod},_From,State=#state{file=File}) ->
+handle_call({loaded_mod_details,Mod},_From,
+ #state{dump_vsn=DumpVsn,file=File}=State) ->
TW = truncated_warning([{?mod,Mod}]),
- ModInfo = get_loaded_mod_details(File,Mod),
+ DecodeOpts = get_decode_opts(DumpVsn),
+ ModInfo = get_loaded_mod_details(File,Mod,DecodeOpts),
{reply,{ok,ModInfo,TW},State};
handle_call(funs,_From,State=#state{file=File}) ->
TW = truncated_warning([?fu]),
@@ -828,8 +835,8 @@ do_read_file(File) ->
reset_tables(),
insert_index(Tag,Id,N1+1),
put_last_tag(Tag,""),
- AddrAdj = get_bin_addr_adj(DumpVsn),
- indexify(Fd,AddrAdj,Rest,N1),
+ DecodeOpts = get_decode_opts(DumpVsn),
+ indexify(Fd,DecodeOpts,Rest,N1),
end_progress(),
check_if_truncated(),
close(Fd),
@@ -877,7 +884,7 @@ check_dump_version(Vsn) ->
{ok,DumpVsn}
end.
-indexify(Fd,AddrAdj,Bin,N) ->
+indexify(Fd,DecodeOpts,Bin,N) ->
case binary:match(Bin,<<"\n=">>) of
{Start,Len} ->
Pos = Start+Len,
@@ -890,7 +897,7 @@ indexify(Fd,AddrAdj,Bin,N) ->
%% order to minimize lookup time. Key is the
%% translated address.
{HexAddr,_} = get_hex(Id),
- Addr = HexAddr bor AddrAdj,
+ Addr = HexAddr bor DecodeOpts#dec_opts.bin_addr_adj,
insert_binary_index(Addr,NewPos);
_ ->
insert_index(Tag,Id,NewPos)
@@ -914,7 +921,7 @@ indexify(Fd,AddrAdj,Bin,N) ->
end;
_ -> ok
end,
- indexify(Fd,AddrAdj,Rest,N1);
+ indexify(Fd,DecodeOpts,Rest,N1);
nomatch ->
case progress_read(Fd) of
{ok,Chunk0} when is_binary(Chunk0) ->
@@ -925,7 +932,7 @@ indexify(Fd,AddrAdj,Bin,N) ->
_ ->
{Chunk0,N+byte_size(Bin)}
end,
- indexify(Fd,AddrAdj,Chunk,N1);
+ indexify(Fd,DecodeOpts,Chunk,N1);
eof ->
eof
end
@@ -1441,21 +1448,21 @@ maybe_other_node2(Channel) ->
expand_memory(Fd,Pid,DumpVsn) ->
- BinAddrAdj = get_bin_addr_adj(DumpVsn),
+ DecodeOpts = get_decode_opts(DumpVsn),
put(fd,Fd),
Dict0 = case get(?literals) of
undefined ->
- Literals = read_literals(Fd),
+ Literals = read_literals(Fd,DecodeOpts),
put(?literals,Literals),
put(fd,Fd),
Literals;
Literals ->
Literals
end,
- Dict = read_heap(Fd,Pid,BinAddrAdj,Dict0),
- Expanded = {read_stack_dump(Fd,Pid,BinAddrAdj,Dict),
- read_messages(Fd,Pid,BinAddrAdj,Dict),
- read_dictionary(Fd,Pid,BinAddrAdj,Dict)},
+ Dict = read_heap(Fd,Pid,DecodeOpts,Dict0),
+ Expanded = {read_stack_dump(Fd,Pid,DecodeOpts,Dict),
+ read_messages(Fd,Pid,DecodeOpts,Dict),
+ read_dictionary(Fd,Pid,DecodeOpts,Dict)},
erase(fd),
IncompleteWarning =
case erase(incomplete_heap) of
@@ -1467,52 +1474,59 @@ expand_memory(Fd,Pid,DumpVsn) ->
end,
{Expanded,IncompleteWarning}.
-read_literals(Fd) ->
+read_literals(Fd,DecodeOpts) ->
case lookup_index(?literals,[]) of
[{_,Start}] ->
[{_,Chars}] = ets:lookup(cdv_heap_file_chars,literals),
init_progress("Reading literals",Chars),
pos_bof(Fd,Start),
- read_heap(0,gb_trees:empty());
+ read_heap(DecodeOpts,gb_trees:empty());
[] ->
gb_trees:empty()
end.
-%%%-----------------------------------------------------------------
-%%% This is a workaround for a bug in dump versions prior to 0.3:
-%%% Addresses were truncated to 32 bits. This could cause binaries to
-%%% get the same address as heap terms in the dump. To work around it
-%%% we always store binaries on very high addresses in the gb_tree.
-get_bin_addr_adj(DumpVsn) when DumpVsn < [0,3] ->
- 16#f bsl 64;
-get_bin_addr_adj(_) ->
- 0.
+get_decode_opts(DumpVsn) ->
+ BinAddrAdj = if
+ DumpVsn < [0,3] ->
+ %% This is a workaround for a bug in dump
+ %% versions prior to 0.3: Addresses were
+ %% truncated to 32 bits. This could cause
+ %% binaries to get the same address as heap
+ %% terms in the dump. To work around it we
+ %% always store binaries on very high
+ %% addresses in the gb_tree.
+ 16#f bsl 64;
+ true ->
+ 0
+ end,
+ Base64 = DumpVsn >= [0,5],
+ #dec_opts{bin_addr_adj=BinAddrAdj,base64=Base64}.
%%%
%%% Read top level section.
%%%
-read_stack_dump(Fd,Pid,BinAddrAdj,Dict) ->
+read_stack_dump(Fd,Pid,DecodeOpts,Dict) ->
case lookup_index(?proc_stack,Pid) of
[{_,Start}] ->
pos_bof(Fd,Start),
- read_stack_dump1(Fd,BinAddrAdj,Dict,[]);
+ read_stack_dump1(Fd,DecodeOpts,Dict,[]);
[] ->
[]
end.
-read_stack_dump1(Fd,BinAddrAdj,Dict,Acc) ->
+read_stack_dump1(Fd,DecodeOpts,Dict,Acc) ->
%% This function is never called if the dump is truncated in {?proc_heap,Pid}
case bytes(Fd) of
"=" ++ _next_tag ->
lists:reverse(Acc);
Line ->
- Stack = parse_top(Line,BinAddrAdj,Dict),
- read_stack_dump1(Fd,BinAddrAdj,Dict,[Stack|Acc])
+ Stack = parse_top(Line,DecodeOpts,Dict),
+ read_stack_dump1(Fd,DecodeOpts,Dict,[Stack|Acc])
end.
-parse_top(Line0, BinAddrAdj, D) ->
+parse_top(Line0, DecodeOpts, D) ->
{Label,Line1} = get_label(Line0),
- {Term,Line,D} = parse_term(Line1, BinAddrAdj, D),
+ {Term,Line,D} = parse_term(Line1, DecodeOpts, D),
[] = skip_blanks(Line),
{Label,Term}.
@@ -1520,27 +1534,27 @@ parse_top(Line0, BinAddrAdj, D) ->
%%% Read message queue.
%%%
-read_messages(Fd,Pid,BinAddrAdj,Dict) ->
+read_messages(Fd,Pid,DecodeOpts,Dict) ->
case lookup_index(?proc_messages,Pid) of
[{_,Start}] ->
pos_bof(Fd,Start),
- read_messages1(Fd,BinAddrAdj,Dict,[]);
+ read_messages1(Fd,DecodeOpts,Dict,[]);
[] ->
[]
end.
-read_messages1(Fd,BinAddrAdj,Dict,Acc) ->
+read_messages1(Fd,DecodeOpts,Dict,Acc) ->
%% This function is never called if the dump is truncated in {?proc_heap,Pid}
case bytes(Fd) of
"=" ++ _next_tag ->
lists:reverse(Acc);
Line ->
- Msg = parse_message(Line,BinAddrAdj,Dict),
- read_messages1(Fd,BinAddrAdj,Dict,[Msg|Acc])
+ Msg = parse_message(Line,DecodeOpts,Dict),
+ read_messages1(Fd,DecodeOpts,Dict,[Msg|Acc])
end.
-parse_message(Line0, BinAddrAdj, D) ->
- {Msg,":"++Line1,_} = parse_term(Line0, BinAddrAdj, D),
- {Token,Line,_} = parse_term(Line1, BinAddrAdj, D),
+parse_message(Line0, DecodeOpts, D) ->
+ {Msg,":"++Line1,_} = parse_term(Line0, DecodeOpts, D),
+ {Token,Line,_} = parse_term(Line1, DecodeOpts, D),
[] = skip_blanks(Line),
{Msg,Token}.
@@ -1548,26 +1562,26 @@ parse_message(Line0, BinAddrAdj, D) ->
%%% Read process dictionary
%%%
-read_dictionary(Fd,Pid,BinAddrAdj,Dict) ->
+read_dictionary(Fd,Pid,DecodeOpts,Dict) ->
case lookup_index(?proc_dictionary,Pid) of
[{_,Start}] ->
pos_bof(Fd,Start),
- read_dictionary1(Fd,BinAddrAdj,Dict,[]);
+ read_dictionary1(Fd,DecodeOpts,Dict,[]);
[] ->
[]
end.
-read_dictionary1(Fd,BinAddrAdj,Dict,Acc) ->
+read_dictionary1(Fd,DecodeOpts,Dict,Acc) ->
%% This function is never called if the dump is truncated in {?proc_heap,Pid}
case bytes(Fd) of
"=" ++ _next_tag ->
lists:reverse(Acc);
Line ->
- Msg = parse_dictionary(Line,BinAddrAdj,Dict),
- read_dictionary1(Fd,BinAddrAdj,Dict,[Msg|Acc])
+ Msg = parse_dictionary(Line,DecodeOpts,Dict),
+ read_dictionary1(Fd,DecodeOpts,Dict,[Msg|Acc])
end.
-parse_dictionary(Line0, BinAddrAdj, D) ->
- {Entry,Line,_} = parse_term(Line0, BinAddrAdj, D),
+parse_dictionary(Line0, DecodeOpts, D) ->
+ {Entry,Line,_} = parse_term(Line0, DecodeOpts, D),
[] = skip_blanks(Line),
Entry.
@@ -1575,18 +1589,18 @@ parse_dictionary(Line0, BinAddrAdj, D) ->
%%% Read heap data.
%%%
-read_heap(Fd,Pid,BinAddrAdj,Dict0) ->
+read_heap(Fd,Pid,DecodeOpts,Dict0) ->
case lookup_index(?proc_heap,Pid) of
[{_,Pos}] ->
[{_,Chars}] = ets:lookup(cdv_heap_file_chars,Pid),
init_progress("Reading process heap",Chars),
pos_bof(Fd,Pos),
- read_heap(BinAddrAdj,Dict0);
+ read_heap(DecodeOpts,Dict0);
[] ->
Dict0
end.
-read_heap(BinAddrAdj,Dict0) ->
+read_heap(DecodeOpts,Dict0) ->
%% This function is never called if the dump is truncated in {?proc_heap,Pid}
case get(fd) of
end_of_heap ->
@@ -1600,14 +1614,14 @@ read_heap(BinAddrAdj,Dict0) ->
Dict0;
Line ->
update_progress(length(Line)+1),
- Dict = parse(Line,BinAddrAdj,Dict0),
- read_heap(BinAddrAdj,Dict)
+ Dict = parse(Line,DecodeOpts,Dict0),
+ read_heap(DecodeOpts,Dict)
end
end.
-parse(Line0, BinAddrAdj, Dict0) ->
+parse(Line0, DecodeOpts, Dict0) ->
{Addr,":"++Line1} = get_hex(Line0),
- {_Term,Line,Dict} = parse_heap_term(Line1, Addr, BinAddrAdj, Dict0),
+ {_Term,Line,Dict} = parse_heap_term(Line1, Addr, DecodeOpts, Dict0),
[] = skip_blanks(Line),
Dict.
@@ -1927,12 +1941,15 @@ get_nodeinfo(Fd,Nod) ->
%%-----------------------------------------------------------------
%% Page with details about one loaded modules
-get_loaded_mod_details(File,Mod) ->
+get_loaded_mod_details(File,Mod,DecodeOpts) ->
[{_,Start}] = lookup_index(?mod,Mod),
Fd = open(File),
pos_bof(Fd,Start),
InitLM = #loaded_mod{mod=Mod,old_size="No old code exists"},
- ModInfo = get_loaded_mod_info(Fd,InitLM,fun all_modinfo/3),
+ Fun = fun(F, LM, LineHead) ->
+ all_modinfo(F, LM, LineHead, DecodeOpts)
+ end,
+ ModInfo = get_loaded_mod_info(Fd,InitLM,Fun),
close(Fd),
ModInfo.
@@ -1990,59 +2007,44 @@ get_loaded_mod_info(Fd,LM,Fun) ->
main_modinfo(_Fd,LM,_LineHead) ->
LM.
-all_modinfo(Fd,LM,LineHead) ->
+all_modinfo(Fd,LM,LineHead,DecodeOpts) ->
case LineHead of
"Current attributes" ->
- Str = hex_to_str(bytes(Fd,"")),
+ Str = get_attribute(Fd, DecodeOpts),
LM#loaded_mod{current_attrib=Str};
"Current compilation info" ->
- Str = hex_to_str(bytes(Fd,"")),
+ Str = get_attribute(Fd, DecodeOpts),
LM#loaded_mod{current_comp_info=Str};
"Old attributes" ->
- Str = hex_to_str(bytes(Fd,"")),
+ Str = get_attribute(Fd, DecodeOpts),
LM#loaded_mod{old_attrib=Str};
"Old compilation info" ->
- Str = hex_to_str(bytes(Fd,"")),
+ Str = get_attribute(Fd, DecodeOpts),
LM#loaded_mod{old_comp_info=Str};
Other ->
unexpected(Fd,Other,"loaded modules info"),
LM
end.
-
-hex_to_str(Hex) ->
- Term = hex_to_term(Hex,[]),
- io_lib:format("~tp~n",[Term]).
-
-hex_to_term([X,Y|Hex],Acc) ->
- MS = hex_to_dec([X]),
- LS = hex_to_dec([Y]),
- Z = 16*MS+LS,
- hex_to_term(Hex,[Z|Acc]);
-hex_to_term([],Acc) ->
- Bin = list_to_binary(lists:reverse(Acc)),
- case catch binary_to_term(Bin) of
- {'EXIT',_Reason} ->
- {"WARNING: The term is probably truncated!",
- "I can not do binary_to_term.",
- Bin};
- Term ->
- Term
- end;
-hex_to_term(Rest,Acc) ->
- {"WARNING: The term is probably truncated!",
- "I can not convert hex to term.",
- Rest,list_to_binary(lists:reverse(Acc))}.
-
-
-hex_to_dec("F") -> 15;
-hex_to_dec("E") -> 14;
-hex_to_dec("D") -> 13;
-hex_to_dec("C") -> 12;
-hex_to_dec("B") -> 11;
-hex_to_dec("A") -> 10;
-hex_to_dec(N) -> list_to_integer(N).
-
+get_attribute(Fd, DecodeOpts) ->
+ Bytes = bytes(Fd, ""),
+ try get_binary(Bytes, DecodeOpts) of
+ {Bin,_} ->
+ try binary_to_term(Bin) of
+ Term ->
+ io_lib:format("~tp~n",[Term])
+ catch
+ _:_ ->
+ {"WARNING: The term is probably truncated!",
+ "I cannot do binary_to_term/1.",
+ Bin}
+ end
+ catch
+ _:_ ->
+ {"WARNING: The term is probably truncated!",
+ "I cannot convert to binary.",
+ Bytes}
+ end.
%%-----------------------------------------------------------------
%% Page with list of all funs
@@ -2599,112 +2601,110 @@ get_limited_stack(Fd, N, Ds) ->
%%%-----------------------------------------------------------------
%%% Parse memory in crashdump version 0.1 and newer
%%%
-parse_heap_term([$l|Line0], Addr, BinAddrAdj, D0) -> %Cons cell.
- {H,"|"++Line1,D1} = parse_term(Line0, BinAddrAdj, D0),
- {T,Line,D2} = parse_term(Line1, BinAddrAdj, D1),
+parse_heap_term([$l|Line0], Addr, DecodeOpts, D0) -> %Cons cell.
+ {H,"|"++Line1,D1} = parse_term(Line0, DecodeOpts, D0),
+ {T,Line,D2} = parse_term(Line1, DecodeOpts, D1),
Term = [H|T],
D = gb_trees:insert(Addr, Term, D2),
{Term,Line,D};
-parse_heap_term([$t|Line0], Addr, BinAddrAdj, D) -> %Tuple
+parse_heap_term([$t|Line0], Addr, DecodeOpts, D) -> %Tuple
{N,":"++Line} = get_hex(Line0),
- parse_tuple(N, Line, Addr, BinAddrAdj, D, []);
-parse_heap_term([$F|Line0], Addr, _BinAddrAdj, D0) -> %Float
+ parse_tuple(N, Line, Addr, DecodeOpts, D, []);
+parse_heap_term([$F|Line0], Addr, _DecodeOpts, D0) -> %Float
{N,":"++Line1} = get_hex(Line0),
{Chars,Line} = get_chars(N, Line1),
Term = list_to_float(Chars),
D = gb_trees:insert(Addr, Term, D0),
{Term,Line,D};
-parse_heap_term("B16#"++Line0, Addr, _BinAddrAdj, D0) -> %Positive big number.
+parse_heap_term("B16#"++Line0, Addr, _DecodeOpts, D0) -> %Positive big number.
{Term,Line} = get_hex(Line0),
D = gb_trees:insert(Addr, Term, D0),
{Term,Line,D};
-parse_heap_term("B-16#"++Line0, Addr, _BinAddrAdj, D0) -> %Negative big number
+parse_heap_term("B-16#"++Line0, Addr, _DecodeOpts, D0) -> %Negative big number
{Term0,Line} = get_hex(Line0),
Term = -Term0,
D = gb_trees:insert(Addr, Term, D0),
{Term,Line,D};
-parse_heap_term("B"++Line0, Addr, _BinAddrAdj, D0) -> %Decimal big num
+parse_heap_term("B"++Line0, Addr, _DecodeOpts, D0) -> %Decimal big num
case string:to_integer(Line0) of
{Int,Line} when is_integer(Int) ->
D = gb_trees:insert(Addr, Int, D0),
{Int,Line,D}
end;
-parse_heap_term([$P|Line0], Addr, _BinAddrAdj, D0) -> % External Pid.
+parse_heap_term([$P|Line0], Addr, _DecodeOpts, D0) -> % External Pid.
{Pid0,Line} = get_id(Line0),
Pid = ['#CDVPid'|Pid0],
D = gb_trees:insert(Addr, Pid, D0),
{Pid,Line,D};
-parse_heap_term([$p|Line0], Addr, _BinAddrAdj, D0) -> % External Port.
+parse_heap_term([$p|Line0], Addr, _DecodeOpts, D0) -> % External Port.
{Port0,Line} = get_id(Line0),
Port = ['#CDVPort'|Port0],
D = gb_trees:insert(Addr, Port, D0),
{Port,Line,D};
-parse_heap_term("E"++Line0, Addr, _BinAddrAdj, D0) -> %Term encoded in external format.
- {Bin,Line} = get_binary(Line0),
+parse_heap_term("E"++Line0, Addr, DecodeOpts, D0) -> %Term encoded in external format.
+ {Bin,Line} = get_binary(Line0, DecodeOpts),
Term = binary_to_term(Bin),
D = gb_trees:insert(Addr, Term, D0),
{Term,Line,D};
-parse_heap_term("Yh"++Line0, Addr, _BinAddrAdj, D0) -> %Heap binary.
- {Term,Line} = get_binary(Line0),
+parse_heap_term("Yh"++Line0, Addr, DecodeOpts, D0) -> %Heap binary.
+ {Term,Line} = get_binary(Line0, DecodeOpts),
D = gb_trees:insert(Addr, Term, D0),
{Term,Line,D};
-parse_heap_term("Yc"++Line0, Addr, BinAddrAdj, D0) -> %Reference-counted binary.
+parse_heap_term("Yc"++Line0, Addr, DecodeOpts, D0) -> %Reference-counted binary.
{Binp0,":"++Line1} = get_hex(Line0),
{Offset,":"++Line2} = get_hex(Line1),
{Sz,Line} = get_hex(Line2),
- Binp = Binp0 bor BinAddrAdj,
- Term = case lookup_binary_index(Binp) of
- [{_,Start}] -> cdvbin(Offset,Sz,{'#CDVBin',Start});
- [] -> '#CDVNonexistingBinary'
- end,
- D = gb_trees:insert(Addr, Term, D0),
- {Term,Line,D};
-parse_heap_term("Ys"++Line0, Addr, BinAddrAdj, D0) -> %Sub binary.
+ Binp = Binp0 bor DecodeOpts#dec_opts.bin_addr_adj,
+ case lookup_binary_index(Binp) of
+ [{_,Start}] ->
+ SymbolicBin = {'#CDVBin',Start},
+ Term = cdvbin(Offset, Sz, SymbolicBin),
+ D1 = gb_trees:insert(Addr, Term, D0),
+ D = gb_trees:insert(Binp, SymbolicBin, D1),
+ {Term,Line,D};
+ [] ->
+ Term = '#CDVNonexistingBinary',
+ D1 = gb_trees:insert(Addr, Term, D0),
+ D = gb_trees:insert(Binp, Term, D1),
+ {Term,Line,D}
+ end;
+parse_heap_term("Ys"++Line0, Addr, DecodeOpts, D0) -> %Sub binary.
{Binp0,":"++Line1} = get_hex(Line0),
{Offset,":"++Line2} = get_hex(Line1),
- {Sz,Line} = get_hex(Line2),
- Binp = Binp0 bor BinAddrAdj,
- Term = case lookup_binary_index(Binp) of
- [{_,Start}] -> cdvbin(Offset,Sz,{'#CDVBin',Start});
- [] ->
- %% Might it be on the heap?
- case gb_trees:lookup(Binp, D0) of
- {value,Bin} -> cdvbin(Offset,Sz,Bin);
- none -> '#CDVNonexistingBinary'
- end
- end,
- D = gb_trees:insert(Addr, Term, D0),
+ {Sz,Line3} = get_hex(Line2),
+ {Term,Line,D1} = deref_bin(Binp0, Offset, Sz, Line3, DecodeOpts, D0),
+ D = gb_trees:insert(Addr, Term, D1),
{Term,Line,D};
-parse_heap_term("Mf"++Line0, Addr, BinAddrAdj, D0) -> %Flatmap.
+parse_heap_term("Mf"++Line0, Addr, DecodeOpts, D0) -> %Flatmap.
{Size,":"++Line1} = get_hex(Line0),
- {Keys,":"++Line2,D1} = parse_term(Line1, BinAddrAdj, D0),
- {Values,Line,D2} = parse_tuple(Size, Line2, Addr,BinAddrAdj, D1, []),
+ {Keys,":"++Line2,D1} = parse_term(Line1, DecodeOpts, D0),
+ {Values,Line,D2} = parse_tuple(Size, Line2, Addr,DecodeOpts, D1, []),
Pairs = zip_tuples(tuple_size(Keys), Keys, Values, []),
Map = maps:from_list(Pairs),
D = gb_trees:update(Addr, Map, D2),
{Map,Line,D};
-parse_heap_term("Mh"++Line0, Addr, BinAddrAdj, D0) -> %Head node in a hashmap.
+parse_heap_term("Mh"++Line0, Addr, DecodeOpts, D0) -> %Head node in a hashmap.
{MapSize,":"++Line1} = get_hex(Line0),
{N,":"++Line2} = get_hex(Line1),
- {Nodes,Line,D1} = parse_tuple(N, Line2, Addr, BinAddrAdj, D0, []),
+ {Nodes,Line,D1} = parse_tuple(N, Line2, Addr, DecodeOpts, D0, []),
Map = maps:from_list(flatten_hashmap_nodes(Nodes)),
MapSize = maps:size(Map), %Assertion.
D = gb_trees:update(Addr, Map, D1),
{Map,Line,D};
-parse_heap_term("Mn"++Line0, Addr, BinAddrAdj, D) -> %Interior node in a hashmap.
+parse_heap_term("Mn"++Line0, Addr, DecodeOpts, D) -> %Interior node in a hashmap.
{N,":"++Line} = get_hex(Line0),
- parse_tuple(N, Line, Addr, BinAddrAdj, D, []).
+ parse_tuple(N, Line, Addr, DecodeOpts, D, []).
parse_tuple(0, Line, Addr, _, D0, Acc) ->
Tuple = list_to_tuple(lists:reverse(Acc)),
D = gb_trees:insert(Addr, Tuple, D0),
{Tuple,Line,D};
-parse_tuple(N, Line0, Addr, BinAddrAdj, D0, Acc) ->
- case parse_term(Line0, BinAddrAdj, D0) of
+parse_tuple(N, Line0, Addr, DecodeOpts, D0, Acc) ->
+ case parse_term(Line0, DecodeOpts, D0) of
{Term,[$,|Line],D} when N > 1 ->
- parse_tuple(N-1, Line, Addr, BinAddrAdj, D, [Term|Acc]);
+ parse_tuple(N-1, Line, Addr, DecodeOpts, D, [Term|Acc]);
{Term,Line,D}->
- parse_tuple(N-1, Line, Addr, BinAddrAdj, D, [Term|Acc])
+ parse_tuple(N-1, Line, Addr, DecodeOpts, D, [Term|Acc])
end.
zip_tuples(0, _T1, _T2, Acc) ->
@@ -2726,9 +2726,9 @@ flatten_hashmap_nodes_1(N, Tuple0, Acc0) ->
flatten_hashmap_nodes_1(tuple_size(Tuple), Tuple, Acc)
end.
-parse_term([$H|Line0], BinAddrAdj, D) -> %Pointer to heap term.
+parse_term([$H|Line0], DecodeOpts, D) -> %Pointer to heap term.
{Ptr,Line} = get_hex(Line0),
- deref_ptr(Ptr, Line, BinAddrAdj, D);
+ deref_ptr(Ptr, Line, DecodeOpts, D);
parse_term([$N|Line], _, D) -> %[] (nil).
{[],Line,D};
parse_term([$I|Line0], _, D) -> %Small.
@@ -2745,11 +2745,11 @@ parse_term([$p|Line0], _, D) -> %Port.
parse_term([$S|Str0], _, D) -> %Information string.
Str = lists:reverse(skip_blanks(lists:reverse(Str0))),
{Str,[],D};
-parse_term([$D|Line0], _, D) -> %DistExternal
+parse_term([$D|Line0], DecodeOpts, D) -> %DistExternal
try
{AttabSize,":"++Line1} = get_hex(Line0),
{Attab, "E"++Line2} = parse_atom_translation_table(AttabSize, Line1, []),
- {Bin,Line3} = get_binary(Line2),
+ {Bin,Line3} = get_binary(Line2, DecodeOpts),
{try
erts_debug:dist_ext_to_term(Attab, Bin)
catch
@@ -2782,11 +2782,39 @@ parse_atom_translation_table(0, Line0, As) ->
parse_atom_translation_table(N, Line0, As) ->
{A, Line1, _} = parse_atom(Line0, []),
parse_atom_translation_table(N-1, Line1, [A|As]).
-
-
-deref_ptr(Ptr, Line, BinAddrAdj, D0) ->
- case gb_trees:lookup(Ptr, D0) of
+
+deref_ptr(Ptr, Line, DecodeOpts, D) ->
+ Lookup = fun(D0) ->
+ gb_trees:lookup(Ptr, D0)
+ end,
+ do_deref_ptr(Lookup, Line, DecodeOpts, D).
+
+deref_bin(Binp0, Offset, Sz, Line, DecodeOpts, D) ->
+ Binp = Binp0 bor DecodeOpts#dec_opts.bin_addr_adj,
+ Lookup = fun(D0) ->
+ lookup_binary(Binp, Offset, Sz, D0)
+ end,
+ do_deref_ptr(Lookup, Line, DecodeOpts, D).
+
+lookup_binary(Binp, Offset, Sz, D) ->
+ case lookup_binary_index(Binp) of
+ [{_,Start}] ->
+ Term = cdvbin(Offset, Sz, {'#CDVBin',Start}),
+ {value,Term};
+ [] ->
+ case gb_trees:lookup(Binp, D) of
+ {value,<<_:Offset/bytes,Sub:Sz/bytes,_/bytes>>} ->
+ {value,Sub};
+ {value,SymbolicBin} ->
+ {value,cdvbin(Offset, Sz, SymbolicBin)};
+ none ->
+ none
+ end
+ end.
+
+do_deref_ptr(Lookup, Line, DecodeOpts, D0) ->
+ case Lookup(D0) of
{value,Term} ->
{Term,Line,D0};
none ->
@@ -2798,11 +2826,11 @@ deref_ptr(Ptr, Line, BinAddrAdj, D0) ->
case bytes(Fd) of
"="++_ ->
put(fd, end_of_heap),
- deref_ptr(Ptr, Line, BinAddrAdj, D0);
+ do_deref_ptr(Lookup, Line, DecodeOpts, D0);
L ->
update_progress(length(L)+1),
- D = parse(L, BinAddrAdj, D0),
- deref_ptr(Ptr, Line, BinAddrAdj, D)
+ D = parse(L, DecodeOpts, D0),
+ do_deref_ptr(Lookup, Line, DecodeOpts, D)
end
end
end.
@@ -2865,36 +2893,80 @@ get_label([$:|Line], Acc) ->
get_label([H|T], Acc) ->
get_label(T, [H|Acc]).
-get_binary(Line0) ->
+get_binary(Line0,DecodeOpts) ->
case get_hex(Line0) of
{N,":"++Line} ->
- do_get_binary(N, Line, [], false);
+ get_binary_1(N, Line, DecodeOpts);
_ ->
{'#CDVTruncatedBinary',[]}
end.
-get_binary(Offset,Size,Line0) ->
+get_binary_1(N,Line,#dec_opts{base64=false}) ->
+ get_binary_hex(N, Line, [], false);
+get_binary_1(N,Line0,#dec_opts{base64=true}) ->
+ NumBytes = ((N+2) div 3) * 4,
+ {Base64,Line} = lists:split(NumBytes, Line0),
+ Bin = get_binary_base64(list_to_binary(Base64), <<>>, false),
+ {Bin,Line}.
+
+get_binary(Offset,Size,Line0,DecodeOpts) ->
case get_hex(Line0) of
{_N,":"++Line} ->
- Progress = Size>?binary_size_progress_limit,
- Progress andalso init_progress("Reading binary",Size),
- do_get_binary(Size, lists:sublist(Line,(Offset*2)+1,Size*2), [],
- Progress);
- _ ->
- {'#CDVTruncatedBinary',[]}
- end.
-
-do_get_binary(0, Line, Acc, Progress) ->
+ get_binary_1(Offset,Size,Line,DecodeOpts);
+ _ ->
+ {'#CDVTruncatedBinary',[]}
+ end.
+
+get_binary_1(Offset,Size,Line,#dec_opts{base64=false}) ->
+ Progress = Size > ?binary_size_progress_limit,
+ Progress andalso init_progress("Reading binary",Size),
+ get_binary_hex(Size, lists:sublist(Line,(Offset*2)+1,Size*2), [],
+ Progress);
+get_binary_1(StartOffset,Size,Line,#dec_opts{base64=true}) ->
+ Progress = Size > ?binary_size_progress_limit,
+ Progress andalso init_progress("Reading binary",Size),
+ EndOffset = StartOffset + Size,
+ StartByte = (StartOffset div 3) * 4,
+ EndByte = ((EndOffset + 2) div 3) * 4,
+ NumBytes = EndByte - StartByte,
+ case list_to_binary(Line) of
+ <<_:StartByte/bytes,Base64:NumBytes/bytes,_/bytes>> ->
+ Bin0 = get_binary_base64(Base64, <<>>, Progress),
+ Skip = StartOffset - (StartOffset div 3) * 3,
+ <<_:Skip/bytes,Bin:Size/bytes,_/bytes>> = Bin0,
+ {Bin,[]};
+ _ ->
+ {'#CDVTruncatedBinary',[]}
+ end.
+
+get_binary_hex(0, Line, Acc, Progress) ->
Progress andalso end_progress(),
{list_to_binary(lists:reverse(Acc)),Line};
-do_get_binary(N, [A,B|Line], Acc, Progress) ->
+get_binary_hex(N, [A,B|Line], Acc, Progress) ->
Byte = (get_hex_digit(A) bsl 4) bor get_hex_digit(B),
Progress andalso update_progress(),
- do_get_binary(N-1, Line, [Byte|Acc], Progress);
-do_get_binary(_N, [], _Acc, Progress) ->
+ get_binary_hex(N-1, Line, [Byte|Acc], Progress);
+get_binary_hex(_N, [], _Acc, Progress) ->
Progress andalso end_progress(),
{'#CDVTruncatedBinary',[]}.
+get_binary_base64(<<Chunk0:?base64_chunk_size/bytes,T/bytes>>,
+ Acc0, Progress) ->
+ Chunk = base64:decode(Chunk0),
+ Acc = <<Acc0/binary,Chunk/binary>>,
+ Progress andalso update_progress(?base64_chunk_size * 3 div 4),
+ get_binary_base64(T, Acc, Progress);
+get_binary_base64(Chunk0, Acc, Progress) ->
+ case Progress of
+ true ->
+ update_progress(?base64_chunk_size * 3 div 4),
+ end_progress();
+ false ->
+ ok
+ end,
+ Chunk = base64:decode(Chunk0),
+ <<Acc/binary,Chunk/binary>>.
+
cdvbin(Offset,Size,{'#CDVBin',Pos}) ->
['#CDVBin',Offset,Size,Pos];
cdvbin(Offset,Size,['#CDVBin',_,_,Pos]) ->
diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl
index 41041682c2..bb1755f530 100644
--- a/lib/observer/test/crashdump_helper.erl
+++ b/lib/observer/test/crashdump_helper.erl
@@ -21,7 +21,7 @@
-module(crashdump_helper).
-export([n1_proc/2,remote_proc/2,
dump_maps/0,create_maps/0,
- create_binaries/0]).
+ create_binaries/0,create_sub_binaries/1]).
-compile(r18).
-include_lib("common_test/include/ct.hrl").
@@ -64,6 +64,7 @@ n1_proc(Creator,_N2,Pid2,Port2,_L) ->
put(bin,Bin),
put(bins,create_binaries()),
put(sub_bin,SubBin),
+ put(sub_bins,create_sub_binaries(get(bins))),
put(bignum,83974938738373873),
put(neg_bignum,-38748762783736367),
put(ext_pid,Pid2),
@@ -104,6 +105,17 @@ create_binaries() ->
<<Data:Size/unit:8>>
end || Size <- Sizes].
+create_sub_binaries(Bins) ->
+ [create_sub_binary(Bin, Start, LenSub) ||
+ Bin <- Bins,
+ Start <- [0,1,2,3,4,5,10,22],
+ LenSub <- [0,1,2,3,4,6,9]].
+
+create_sub_binary(Bin, Start, LenSub) ->
+ Len = byte_size(Bin) - LenSub - Start,
+ <<_:Start/bytes,Sub:Len/bytes,_/bytes>> = Bin,
+ Sub.
+
%%%
%%% Test dumping of maps. Dumping of maps only from OTP 20.2.
%%%
diff --git a/lib/observer/test/crashdump_viewer_SUITE.erl b/lib/observer/test/crashdump_viewer_SUITE.erl
index 29b9e406ae..9fbd1a62a4 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -403,6 +403,10 @@ special(File,Procs) ->
verify_binaries(Binaries, proplists:get_value(bins,Dict)),
io:format(" binaries ok",[]),
+ SubBinaries = crashdump_helper:create_sub_binaries(Binaries),
+ verify_binaries(SubBinaries, proplists:get_value(sub_bins,Dict)),
+ io:format(" sub binaries ok",[]),
+
#proc{last_calls=LastCalls} = ProcDetails,
true = length(LastCalls) =< 4,
@@ -461,7 +465,9 @@ special(File,Procs) ->
%% i.e. no binary exist in the dump
[#proc{pid=Pid0}|_Rest] = lists:keysort(#proc.name,Procs),
Pid = pid_to_list(Pid0),
- {ok,ProcDetails=#proc{},[]} = crashdump_viewer:proc_details(Pid),
+ %%WarnIncompleteHeap = ["WARNING: This process has an incomplete heap. Some information might be missing."],
+ {ok,ProcDetails=#proc{},[]} =
+ crashdump_viewer:proc_details(Pid),
io:format(" process details ok",[]),
#proc{dict=Dict} = ProcDetails,
@@ -668,7 +674,7 @@ truncate_dump(File) ->
end,
%% Split after "our binary" created by crashdump_helper
%% (it may not be the first binary).
- RE = <<"\n=binary:(?=[0-9A-Z]+",NewLine/binary,"FF:010203)">>,
+ RE = <<"\n=binary:(?=[0-9A-Z]+",NewLine/binary,"FF:AQID)">>,
[StartBin,AfterTag] = re:split(Bin,RE,[{parts,2}]),
[AddrAndSize,BinaryAndRest] = binary:split(AfterTag,Colon),
[Binary,_Rest] = binary:split(BinaryAndRest,NewLine),
diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml
index 7a7c828760..a4c0194328 100644
--- a/lib/public_key/doc/src/notes.xml
+++ b/lib/public_key/doc/src/notes.xml
@@ -35,6 +35,30 @@
<file>notes.xml</file>
</header>
+<section><title>Public_Key 1.5.1</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Hostname verification: Add handling of the general name
+ <c>iPAddress</c> in certificate's subject alternative
+ name extension (<c>subjAltName</c>).</p>
+ <p>
+ Own Id: OTP-14653</p>
+ </item>
+ <item>
+ <p>
+ Correct key handling in pkix_test_data/1 and use a
+ generic example mail address instead of an existing one.</p>
+ <p>
+ Own Id: OTP-14766</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Public_Key 1.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/public_key/test/public_key_SUITE.erl b/lib/public_key/test/public_key_SUITE.erl
index 38e8f30a25..449d1fc040 100644
--- a/lib/public_key/test/public_key_SUITE.erl
+++ b/lib/public_key/test/public_key_SUITE.erl
@@ -64,7 +64,9 @@ all() ->
groups() ->
[{pem_decode_encode, [], [dsa_pem, rsa_pem, ec_pem, encrypted_pem,
dh_pem, cert_pem, pkcs7_pem, pkcs10_pem, ec_pem2,
- ec_pem_encode_generated, gen_ec_param]},
+ ec_pem_encode_generated,
+ gen_ec_param_prime_field, gen_ec_param_char_2_field
+ ]},
{ssh_public_key_decode_encode, [],
[ssh_rsa_public_key, ssh_dsa_public_key, ssh_ecdsa_public_key,
ssh_rfc4716_rsa_comment, ssh_rfc4716_dsa_comment,
@@ -105,18 +107,11 @@ init_per_testcase(pkix_test_data_all_default, Config) ->
init_common_per_testcase(Config)
end;
-init_per_testcase(gen_ec_param, Config) ->
- case crypto:ec_curves() of
- [] ->
- {skip, missing_ecc_support};
- Curves ->
- case lists:member(secp521r1, Curves) of
- true ->
- init_common_per_testcase(Config);
- false ->
- {skip, missing_ecc_secp52r1_support}
- end
- end;
+init_per_testcase(gen_ec_param_prime_field=TC, Config) ->
+ init_per_testcase_gen_ec_param(TC, secp521r1, Config);
+
+init_per_testcase(gen_ec_param_char_2_field=TC, Config) ->
+ init_per_testcase_gen_ec_param(TC, sect571r1, Config);
init_per_testcase(TestCase, Config) ->
case TestCase of
@@ -1034,8 +1029,6 @@ pkix_verify_hostname_subjAltName_IP(Config) ->
true = public_key:pkix_verify_hostname(Cert, [{ip, {10,67,16,75}}]),
false = public_key:pkix_verify_hostname(Cert, [{ip, {1,2,3,4}}]),
false = public_key:pkix_verify_hostname(Cert, [{ip, {10,11,12,13}}]).
-
-
%%--------------------------------------------------------------------
pkix_iso_rsa_oid() ->
[{doc, "Test workaround for supporting certs that use ISO oids"
@@ -1220,12 +1213,19 @@ short_crl_issuer_hash(Config) when is_list(Config) ->
Issuer = public_key:pkix_crl_issuer(CrlDER),
CrlIssuerHash = public_key:short_name_hash(Issuer).
+
%%--------------------------------------------------------------------
-gen_ec_param() ->
- [{doc, "Generate key with EC parameters"}].
-gen_ec_param(Config) when is_list(Config) ->
+gen_ec_param_prime_field() ->
+ [{doc, "Generate key with EC prime_field parameters"}].
+gen_ec_param_prime_field(Config) when is_list(Config) ->
+ Datadir = proplists:get_value(data_dir, Config),
+ do_gen_ec_param(filename:join(Datadir, "ec_key_param0.pem")).
+
+%%--------------------------------------------------------------------
+gen_ec_param_char_2_field() ->
+ [{doc, "Generate key with EC characteristic_two_field parameters"}].
+gen_ec_param_char_2_field(Config) when is_list(Config) ->
Datadir = proplists:get_value(data_dir, Config),
- do_gen_ec_param(filename:join(Datadir, "ec_key_param0.pem")),
do_gen_ec_param(filename:join(Datadir, "ec_key_param1.pem")).
%%--------------------------------------------------------------------
@@ -1312,6 +1312,30 @@ do_gen_ec_param(File) ->
ct:fail({key_gen_fail, File})
end.
+init_per_testcase_gen_ec_param(TC, Curve, Config) ->
+ case crypto:ec_curves() of
+ [] ->
+ {skip, missing_ec_support};
+ Curves ->
+ case lists:member(Curve, Curves)
+ andalso crypto_supported_curve(Curve, Curves)
+ of
+ true ->
+ init_common_per_testcase(Config);
+ false ->
+ {skip, {missing_ec_support, Curve}}
+ end
+ end.
+
+
+crypto_supported_curve(Curve, Curves) ->
+ try crypto:generate_key(ecdh, Curve) of
+ {error,_} -> false; % Just in case crypto is changed in the future...
+ _-> true
+ catch
+ _:_-> false
+ end.
+
incorrect_countryname_pkix_cert() ->
<<48,130,5,186,48,130,4,162,160,3,2,1,2,2,7,7,250,61,63,6,140,137,48,13,6,9,42, 134,72,134,247,13,1,1,5,5,0,48,129,220,49,11,48,9,6,3,85,4,6,19,2,85,83,49, 16,48,14,6,3,85,4,8,19,7,65,114,105,122,111,110,97,49,19,48,17,6,3,85,4,7,19, 10,83,99,111,116,116,115,100,97,108,101,49,37,48,35,6,3,85,4,10,19,28,83,116, 97,114,102,105,101,108,100,32,84,101,99,104,110,111,108,111,103,105,101,115, 44,32,73,110,99,46,49,57,48,55,6,3,85,4,11,19,48,104,116,116,112,58,47,47,99, 101,114,116,105,102,105,99,97,116,101,115,46,115,116,97,114,102,105,101,108, 100,116,101,99,104,46,99,111,109,47,114,101,112,111,115,105,116,111,114,121, 49,49,48,47,6,3,85,4,3,19,40,83,116,97,114,102,105,101,108,100,32,83,101,99, 117,114,101,32,67,101,114,116,105,102,105,99,97,116,105,111,110,32,65,117, 116,104,111,114,105,116,121,49,17,48,15,6,3,85,4,5,19,8,49,48,54,56,56,52,51, 53,48,30,23,13,49,48,49,48,50,51,48,49,51,50,48,53,90,23,13,49,50,49,48,50, 51,48,49,51,50,48,53,90,48,122,49,11,48,9,6,3,85,4,6,12,2,85,83,49,11,48,9,6, 3,85,4,8,12,2,65,90,49,19,48,17,6,3,85,4,7,12,10,83,99,111,116,116,115,100, 97,108,101,49,38,48,36,6,3,85,4,10,12,29,83,112,101,99,105,97,108,32,68,111, 109,97,105,110,32,83,101,114,118,105,99,101,115,44,32,73,110,99,46,49,33,48, 31,6,3,85,4,3,12,24,42,46,108,111,103,105,110,46,115,101,99,117,114,101,115, 101,114,118,101,114,46,110,101,116,48,130,1,34,48,13,6,9,42,134,72,134,247, 13,1,1,1,5,0,3,130,1,15,0,48,130,1,10,2,130,1,1,0,185,136,240,80,141,36,124, 245,182,130,73,19,188,74,166,117,72,228,185,209,43,129,244,40,44,193,231,11, 209,12,234,88,43,142,1,162,48,122,17,95,230,105,171,131,12,147,46,204,36,80, 250,171,33,253,35,62,83,22,71,212,186,141,14,198,89,89,121,204,224,122,246, 127,110,188,229,162,67,95,6,74,231,127,99,131,7,240,85,102,203,251,50,58,58, 104,245,103,181,183,134,32,203,121,232,54,32,188,139,136,112,166,126,14,91, 223,153,172,164,14,61,38,163,208,215,186,210,136,213,143,70,147,173,109,217, 250,169,108,31,211,104,238,103,93,182,59,165,43,196,189,218,241,30,148,240, 109,90,69,176,194,52,116,173,151,135,239,10,209,179,129,192,102,75,11,25,168, 223,32,174,84,223,134,70,167,55,172,143,27,130,123,226,226,7,34,142,166,39, 48,246,96,231,150,84,220,106,133,193,55,95,159,227,24,249,64,36,1,142,171,16, 202,55,126,7,156,15,194,22,116,53,113,174,104,239,203,120,45,131,57,87,84, 163,184,27,83,57,199,91,200,34,43,98,61,180,144,76,65,170,177,2,3,1,0,1,163, 130,1,224,48,130,1,220,48,15,6,3,85,29,19,1,1,255,4,5,48,3,1,1,0,48,29,6,3, 85,29,37,4,22,48,20,6,8,43,6,1,5,5,7,3,1,6,8,43,6,1,5,5,7,3,2,48,14,6,3,85, 29,15,1,1,255,4,4,3,2,5,160,48,56,6,3,85,29,31,4,49,48,47,48,45,160,43,160, 41,134,39,104,116,116,112,58,47,47,99,114,108,46,115,116,97,114,102,105,101, 108,100,116,101,99,104,46,99,111,109,47,115,102,115,50,45,48,46,99,114,108, 48,83,6,3,85,29,32,4,76,48,74,48,72,6,11,96,134,72,1,134,253,110,1,7,23,2,48, 57,48,55,6,8,43,6,1,5,5,7,2,1,22,43,104,116,116,112,115,58,47,47,99,101,114, 116,115,46,115,116,97,114,102,105,101,108,100,116,101,99,104,46,99,111,109, 47,114,101,112,111,115,105,116,111,114,121,47,48,129,141,6,8,43,6,1,5,5,7,1, 1,4,129,128,48,126,48,42,6,8,43,6,1,5,5,7,48,1,134,30,104,116,116,112,58,47, 47,111,99,115,112,46,115,116,97,114,102,105,101,108,100,116,101,99,104,46,99, 111,109,47,48,80,6,8,43,6,1,5,5,7,48,2,134,68,104,116,116,112,58,47,47,99, 101,114,116,105,102,105,99,97,116,101,115,46,115,116,97,114,102,105,101,108, 100,116,101,99,104,46,99,111,109,47,114,101,112,111,115,105,116,111,114,121, 47,115,102,95,105,110,116,101,114,109,101,100,105,97,116,101,46,99,114,116, 48,31,6,3,85,29,35,4,24,48,22,128,20,73,75,82,39,209,27,188,242,161,33,106, 98,123,81,66,122,138,215,213,86,48,59,6,3,85,29,17,4,52,48,50,130,24,42,46, 108,111,103,105,110,46,115,101,99,117,114,101,115,101,114,118,101,114,46,110, 101,116,130,22,108,111,103,105,110,46,115,101,99,117,114,101,115,101,114,118, 101,114,46,110,101,116,48,29,6,3,85,29,14,4,22,4,20,138,233,191,208,157,203, 249,85,242,239,20,195,48,10,148,49,144,101,255,116,48,13,6,9,42,134,72,134, 247,13,1,1,5,5,0,3,130,1,1,0,82,31,121,162,49,50,143,26,167,202,143,61,71, 189,201,199,57,81,122,116,90,192,88,24,102,194,174,48,157,74,27,87,210,223, 253,93,3,91,150,109,120,1,110,27,11,200,198,141,222,246,14,200,71,105,41,138, 13,114,122,106,63,17,197,181,234,121,61,89,74,65,41,231,248,219,129,83,176, 219,55,107,55,211,112,98,38,49,69,77,96,221,108,123,152,12,210,159,157,141, 43,226,55,187,129,3,82,49,136,66,81,196,91,234,196,10,82,48,6,80,163,83,71, 127,102,177,93,209,129,26,104,2,84,24,255,248,161,3,244,169,234,92,122,110, 43,4,17,113,185,235,108,219,210,236,132,216,177,227,17,169,58,162,159,182, 162,93,160,229,200,9,163,229,110,121,240,168,232,14,91,214,188,196,109,210, 164,222,0,109,139,132,113,91,16,118,173,178,176,80,132,34,41,199,51,206,250, 224,132,60,115,192,94,107,163,219,212,226,225,65,169,148,108,213,46,174,173, 103,110,189,229,166,149,254,31,51,44,144,108,187,182,11,251,201,206,86,138, 208,59,51,86,132,235,81,225,88,34,190,8,184>>.
diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk
index bb96c2237d..c01d8820f2 100644
--- a/lib/public_key/vsn.mk
+++ b/lib/public_key/vsn.mk
@@ -1 +1 @@
-PUBLIC_KEY_VSN = 1.5
+PUBLIC_KEY_VSN = 1.5.1
diff --git a/lib/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile
index dad229e193..ec19a4ce59 100644
--- a/lib/runtime_tools/doc/src/Makefile
+++ b/lib/runtime_tools/doc/src/Makefile
@@ -45,7 +45,7 @@ XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.x
XML_REF6_FILES = runtime_tools_app.xml
XML_PART_FILES = part.xml
-XML_CHAPTER_FILES = notes.xml notes_history.xml LTTng.xml
+XML_CHAPTER_FILES = notes.xml LTTng.xml
GENERATED_XML_FILES = DTRACE.xml SYSTEMTAP.xml
@@ -54,7 +54,8 @@ BOOK_FILES = book.xml
XML_FILES = \
$(BOOK_FILES) $(XML_CHAPTER_FILES) \
$(XML_PART_FILES) $(XML_REF3_FILES) \
- $(XML_REF6_FILES) $(XML_APPLICATION_FILES)
+ $(XML_REF6_FILES) $(XML_APPLICATION_FILES) \
+ $(GENERATED_XML_FILES)
GIF_FILES =
@@ -89,7 +90,6 @@ SPECS_FLAGS = -I../../include -I../../../kernel/src
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-$(XML_FILES): $(GENERATED_XML_FILES)
%.xml: $(ERL_TOP)/HOWTO/%.md $(ERL_TOP)/make/emd2exml
$(ERL_TOP)/make/emd2exml $< $@
diff --git a/lib/sasl/doc/src/Makefile b/lib/sasl/doc/src/Makefile
index 76746e44e7..baf563ca62 100644
--- a/lib/sasl/doc/src/Makefile
+++ b/lib/sasl/doc/src/Makefile
@@ -47,8 +47,7 @@ XML_REF6_FILES = sasl_app.xml
XML_PART_FILES = part.xml
XML_CHAPTER_FILES = sasl_intro.xml \
error_logging.xml \
- notes.xml \
- notes_history.xml
+ notes.xml
BOOK_FILES = book.xml
diff --git a/lib/ssh/doc/src/Makefile b/lib/ssh/doc/src/Makefile
index e066b787f3..f54f5e0708 100644
--- a/lib/ssh/doc/src/Makefile
+++ b/lib/ssh/doc/src/Makefile
@@ -52,9 +52,9 @@ XML_PART_FILES = \
usersguide.xml
XML_CHAPTER_FILES = notes.xml \
introduction.xml \
- ssh_protocol.xml \
using_ssh.xml \
configure_algos.xml
+# ssh_protocol.xml \
BOOK_FILES = book.xml
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index ef3e94a1e1..c9e153f30c 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -30,12 +30,37 @@
<file>notes.xml</file>
</header>
-<section><title>Ssh 4.6.1</title>
+<section><title>Ssh 4.6.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
<item>
<p>
+ Trailing white space was removed at end of the
+ hello-string. This caused interoperability problems with
+ some other ssh-implementations (e.g OpenSSH 7.3p1 on
+ Solaris 11)</p>
+ <p>
+ Own Id: OTP-14763 Aux Id: ERIERL-74 </p>
+ </item>
+ <item>
+ <p>
+ Fixes that tcp connections that was immediately closed
+ (SYN, SYNACK, ACK, RST) by a client could be left in a
+ zombie state.</p>
+ <p>
+ Own Id: OTP-14778 Aux Id: ERIERL-104 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Ssh 4.6.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
Fixed broken printout</p>
<p>
Own Id: OTP-14645</p>
diff --git a/lib/ssh/src/ssh.hrl b/lib/ssh/src/ssh.hrl
index d6d412db43..3dee1c5521 100644
--- a/lib/ssh/src/ssh.hrl
+++ b/lib/ssh/src/ssh.hrl
@@ -63,8 +63,8 @@
-define(uint16(X), << ?UINT16(X) >> ).
-define(uint32(X), << ?UINT32(X) >> ).
-define(uint64(X), << ?UINT64(X) >> ).
--define(string(X), << ?STRING(list_to_binary(X)) >> ).
-define(string_utf8(X), << ?STRING(unicode:characters_to_binary(X)) >> ).
+-define(string(X), ?string_utf8(X)).
-define(binary(X), << ?STRING(X) >>).
%% Cipher details
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 802bf62570..0ca960ef96 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -325,23 +325,32 @@ renegotiate_data(ConnectionHandler) ->
%% Internal process state
%%====================================================================
-record(data, {
- starter :: pid(),
+ starter :: pid()
+ | undefined,
auth_user :: string()
| undefined,
connection_state :: #connection{},
- latest_channel_id = 0 :: non_neg_integer(),
+ latest_channel_id = 0 :: non_neg_integer()
+ | undefined,
idle_timer_ref :: undefined
| infinity
| reference(),
idle_timer_value = infinity :: infinity
| pos_integer(),
- transport_protocol :: atom(), % ex: tcp
- transport_cb :: atom(), % ex: gen_tcp
- transport_close_tag :: atom(), % ex: tcp_closed
- ssh_params :: #ssh{},
- socket :: inet:socket(),
- decrypted_data_buffer = <<>> :: binary(),
- encrypted_data_buffer = <<>> :: binary(),
+ transport_protocol :: atom()
+ | undefined, % ex: tcp
+ transport_cb :: atom()
+ | undefined, % ex: gen_tcp
+ transport_close_tag :: atom()
+ | undefined, % ex: tcp_closed
+ ssh_params :: #ssh{}
+ | undefined,
+ socket :: inet:socket()
+ | undefined,
+ decrypted_data_buffer = <<>> :: binary()
+ | undefined,
+ encrypted_data_buffer = <<>> :: binary()
+ | undefined,
undecrypted_packet_length :: undefined | non_neg_integer(),
key_exchange_init_msg :: #ssh_msg_kexinit{}
| undefined,
@@ -370,16 +379,17 @@ init_connection_handler(Role, Socket, Opts) ->
StartState,
D);
- {stop, enotconn} ->
- %% Handles the abnormal sequence:
- %% SYN->
- %% <-SYNACK
- %% ACK->
- %% RST->
- exit({shutdown, "TCP connection to server was prematurely closed by the client"});
-
- {stop, OtherError} ->
- exit({shutdown, {init,OtherError}})
+ {stop, Error} ->
+ Sups = ?GET_INTERNAL_OPT(supervisors, Opts),
+ C = #connection{system_supervisor = proplists:get_value(system_sup, Sups),
+ sub_system_supervisor = proplists:get_value(subsystem_sup, Sups),
+ connection_supervisor = proplists:get_value(connection_sup, Sups)
+ },
+ gen_statem:enter_loop(?MODULE,
+ [],
+ {init_error,Error},
+ #data{connection_state=C,
+ socket=Socket})
end.
@@ -531,6 +541,21 @@ renegotiation(_) -> false.
callback_mode() ->
handle_event_function.
+
+handle_event(_, _Event, {init_error,Error}, _) ->
+ case Error of
+ enotconn ->
+ %% Handles the abnormal sequence:
+ %% SYN->
+ %% <-SYNACK
+ %% ACK->
+ %% RST->
+ {stop, {shutdown,"TCP connenction to server was prematurely closed by the client"}};
+
+ OtherError ->
+ {stop, {shutdown,{init,OtherError}}}
+ end;
+
%%% ######## {hello, client|server} ####
%% The very first event that is sent when the we are set as controlling process of Socket
handle_event(_, socket_control, {hello,_}, D) ->
diff --git a/lib/ssh/src/ssh_transport.erl b/lib/ssh/src/ssh_transport.erl
index 892db6b64f..90a94a7e86 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -2027,12 +2027,6 @@ same(Algs) -> [{client2server,Algs}, {server2client,Algs}].
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
trim_tail(Str) ->
- lists:reverse(trim_head(lists:reverse(Str))).
-
-trim_head([$\s|Cs]) -> trim_head(Cs);
-trim_head([$\t|Cs]) -> trim_head(Cs);
-trim_head([$\n|Cs]) -> trim_head(Cs);
-trim_head([$\r|Cs]) -> trim_head(Cs);
-trim_head(Cs) -> Cs.
-
-
+ lists:takewhile(fun(C) ->
+ C=/=$\r andalso C=/=$\n
+ end, Str).
diff --git a/lib/ssh/test/ssh_engine_SUITE.erl b/lib/ssh/test/ssh_engine_SUITE.erl
index 035446932b..daf93891e9 100644
--- a/lib/ssh/test/ssh_engine_SUITE.erl
+++ b/lib/ssh/test/ssh_engine_SUITE.erl
@@ -57,7 +57,6 @@ init_per_suite(Config) ->
?CHECK_CRYPTO(
case load_engine() of
{ok,E} ->
- ssh_dbg:messages(fun ct:pal/2),
[{engine,E}|Config];
{error, notsup} ->
{skip, "Engine not supported on this OpenSSL version"};
diff --git a/lib/ssh/test/ssh_options_SUITE.erl b/lib/ssh/test/ssh_options_SUITE.erl
index 8b454ffe5d..144ec7f8fd 100644
--- a/lib/ssh/test/ssh_options_SUITE.erl
+++ b/lib/ssh/test/ssh_options_SUITE.erl
@@ -36,7 +36,9 @@
id_string_no_opt_client/1,
id_string_no_opt_server/1,
id_string_own_string_client/1,
+ id_string_own_string_client_trail_space/1,
id_string_own_string_server/1,
+ id_string_own_string_server_trail_space/1,
id_string_random_client/1,
id_string_random_server/1,
max_sessions_sftp_start_channel_parallel/1,
@@ -116,9 +118,11 @@ all() ->
hostkey_fingerprint_check_list,
id_string_no_opt_client,
id_string_own_string_client,
+ id_string_own_string_client_trail_space,
id_string_random_client,
id_string_no_opt_server,
id_string_own_string_server,
+ id_string_own_string_server_trail_space,
id_string_random_server,
{group, hardening_tests}
].
@@ -1035,6 +1039,19 @@ id_string_own_string_client(Config) ->
end.
%%--------------------------------------------------------------------
+id_string_own_string_client_trail_space(Config) ->
+ {Server, _Host, Port} = fake_daemon(Config),
+ {error,_} = ssh:connect("localhost", Port, [{id_string,"Pelle "}], 1000),
+ receive
+ {id,Server,"SSH-2.0-Pelle \r\n"} ->
+ ok;
+ {id,Server,Other} ->
+ ct:fail("Unexpected id: ~s.",[Other])
+ after 5000 ->
+ {fail,timeout}
+ end.
+
+%%--------------------------------------------------------------------
id_string_random_client(Config) ->
{Server, _Host, Port} = fake_daemon(Config),
{error,_} = ssh:connect("localhost", Port, [{id_string,random}], 1000),
@@ -1063,6 +1080,12 @@ id_string_own_string_server(Config) ->
{ok,"SSH-2.0-Olle\r\n"} = gen_tcp:recv(S1, 0, 2000).
%%--------------------------------------------------------------------
+id_string_own_string_server_trail_space(Config) ->
+ {_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,"Olle "}]),
+ {ok,S1}=ssh_test_lib:gen_tcp_connect(Host,Port,[{active,false},{packet,line}]),
+ {ok,"SSH-2.0-Olle \r\n"} = gen_tcp:recv(S1, 0, 2000).
+
+%%--------------------------------------------------------------------
id_string_random_server(Config) ->
{_Server, Host, Port} = ssh_test_lib:std_daemon(Config, [{id_string,random}]),
{ok,S1}=ssh_test_lib:gen_tcp_connect(Host,Port,[{active,false},{packet,line}]),
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 5154658e8a..59775d2d7f 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,5 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 4.6.1
+SSH_VSN = 4.6.2
APP_VSN = "ssh-$(SSH_VSN)"
diff --git a/lib/ssl/doc/src/Makefile b/lib/ssl/doc/src/Makefile
index d54ef47461..f9128e8e45 100644
--- a/lib/ssl/doc/src/Makefile
+++ b/lib/ssl/doc/src/Makefile
@@ -43,9 +43,9 @@ XML_REF6_FILES = ssl_app.xml
XML_PART_FILES = usersguide.xml
XML_CHAPTER_FILES = \
+ ssl_introduction.xml \
ssl_protocol.xml \
using_ssl.xml \
- pkix_certs.xml \
ssl_distribution.xml \
notes.xml
diff --git a/lib/ssl/doc/src/notes.xml b/lib/ssl/doc/src/notes.xml
index 4c6a204e63..37c916e585 100644
--- a/lib/ssl/doc/src/notes.xml
+++ b/lib/ssl/doc/src/notes.xml
@@ -27,6 +27,81 @@
</header>
<p>This document describes the changes made to the SSL application.</p>
+<section><title>SSL 8.2.2</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ TLS sessions must be registered with SNI if provided, so
+ that sessions where client hostname verification would
+ fail can not connect reusing a session created when the
+ server name verification succeeded.</p>
+ <p>
+ Own Id: OTP-14632</p>
+ </item>
+ <item>
+ <p> An erlang TLS server configured with cipher suites
+ using rsa key exchange, may be vulnerable to an Adaptive
+ Chosen Ciphertext attack (AKA Bleichenbacher attack)
+ against RSA, which when exploited, may result in
+ plaintext recovery of encrypted messages and/or a
+ Man-in-the-middle (MiTM) attack, despite the attacker not
+ having gained access to the server’s private key
+ itself. <url
+ href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url>
+ </p> <p> Exploiting this vulnerability to perform
+ plaintext recovery of encrypted messages will, in most
+ practical cases, allow an attacker to read the plaintext
+ only after the session has completed. Only TLS sessions
+ established using RSA key exchange are vulnerable to this
+ attack. </p> <p> Exploiting this vulnerability to conduct
+ a MiTM attack requires the attacker to complete the
+ initial attack, which may require thousands of server
+ requests, during the handshake phase of the targeted
+ session within the window of the configured handshake
+ timeout. This attack may be conducted against any TLS
+ session using RSA signatures, but only if cipher suites
+ using RSA key exchange are also enabled on the server.
+ The limited window of opportunity, limitations in
+ bandwidth, and latency make this attack significantly
+ more difficult to execute. </p> <p> RSA key exchange is
+ enabled by default although least prioritized if server
+ order is honored. For such a cipher suite to be chosen it
+ must also be supported by the client and probably the
+ only shared cipher suite. </p> <p> Captured TLS sessions
+ encrypted with ephemeral cipher suites (DHE or ECDHE) are
+ not at risk for subsequent decryption due to this
+ vulnerability. </p> <p> As a workaround if default cipher
+ suite configuration was used you can configure the server
+ to not use vulnerable suites with the ciphers option like
+ this: </p> <c> {ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p>
+ that is your code will look somethingh like this: </p>
+ <c> ssl:listen(Port, [{ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]).
+ </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and
+ Craig Young for reporting this vulnerability. </p>
+ <p>
+ Own Id: OTP-14748</p>
+ </item>
+ </list>
+ </section>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ If no SNI is available and the hostname is an IP-address
+ also check for IP-address match. This check is not as
+ good as a DNS hostname check and certificates using
+ IP-address are not recommended.</p>
+ <p>
+ Own Id: OTP-14655</p>
+ </item>
+ </list>
+ </section>
+
+</section>
<section><title>SSL 8.2.1</title>
@@ -175,9 +250,59 @@
</item>
</list>
</section>
-
</section>
+<section><title>SSL 8.1.3.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> An erlang TLS server configured with cipher suites
+ using rsa key exchange, may be vulnerable to an Adaptive
+ Chosen Ciphertext attack (AKA Bleichenbacher attack)
+ against RSA, which when exploited, may result in
+ plaintext recovery of encrypted messages and/or a
+ Man-in-the-middle (MiTM) attack, despite the attacker not
+ having gained access to the server’s private key
+ itself. <url
+ href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url>
+ </p> <p> Exploiting this vulnerability to perform
+ plaintext recovery of encrypted messages will, in most
+ practical cases, allow an attacker to read the plaintext
+ only after the session has completed. Only TLS sessions
+ established using RSA key exchange are vulnerable to this
+ attack. </p> <p> Exploiting this vulnerability to conduct
+ a MiTM attack requires the attacker to complete the
+ initial attack, which may require thousands of server
+ requests, during the handshake phase of the targeted
+ session within the window of the configured handshake
+ timeout. This attack may be conducted against any TLS
+ session using RSA signatures, but only if cipher suites
+ using RSA key exchange are also enabled on the server.
+ The limited window of opportunity, limitations in
+ bandwidth, and latency make this attack significantly
+ more difficult to execute. </p> <p> RSA key exchange is
+ enabled by default although least prioritized if server
+ order is honored. For such a cipher suite to be chosen it
+ must also be supported by the client and probably the
+ only shared cipher suite. </p> <p> Captured TLS sessions
+ encrypted with ephemeral cipher suites (DHE or ECDHE) are
+ not at risk for subsequent decryption due to this
+ vulnerability. </p> <p> As a workaround if default cipher
+ suite configuration was used you can configure the server
+ to not use vulnerable suites with the ciphers option like
+ this: </p> <c> {ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p>
+ that is your code will look somethingh like this: </p>
+ <c> ssl:listen(Port, [{ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]).
+ </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and
+ Craig Young for reporting this vulnerability. </p>
+ <p>
+ Own Id: OTP-14748</p>
+ </item>
+ </list>
+ </section>
+</section>
<section><title>SSL 8.1.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -556,6 +681,60 @@
</section>
+ <section><title>SSL 7.3.3.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> An erlang TLS server configured with cipher suites
+ using rsa key exchange, may be vulnerable to an Adaptive
+ Chosen Ciphertext attack (AKA Bleichenbacher attack)
+ against RSA, which when exploited, may result in
+ plaintext recovery of encrypted messages and/or a
+ Man-in-the-middle (MiTM) attack, despite the attacker not
+ having gained access to the server’s private key
+ itself. <url
+ href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url>
+ </p> <p> Exploiting this vulnerability to perform
+ plaintext recovery of encrypted messages will, in most
+ practical cases, allow an attacker to read the plaintext
+ only after the session has completed. Only TLS sessions
+ established using RSA key exchange are vulnerable to this
+ attack. </p> <p> Exploiting this vulnerability to conduct
+ a MiTM attack requires the attacker to complete the
+ initial attack, which may require thousands of server
+ requests, during the handshake phase of the targeted
+ session within the window of the configured handshake
+ timeout. This attack may be conducted against any TLS
+ session using RSA signatures, but only if cipher suites
+ using RSA key exchange are also enabled on the server.
+ The limited window of opportunity, limitations in
+ bandwidth, and latency make this attack significantly
+ more difficult to execute. </p> <p> RSA key exchange is
+ enabled by default although least prioritized if server
+ order is honored. For such a cipher suite to be chosen it
+ must also be supported by the client and probably the
+ only shared cipher suite. </p> <p> Captured TLS sessions
+ encrypted with ephemeral cipher suites (DHE or ECDHE) are
+ not at risk for subsequent decryption due to this
+ vulnerability. </p> <p> As a workaround if default cipher
+ suite configuration was used you can configure the server
+ to not use vulnerable suites with the ciphers option like
+ this: </p> <c> {ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p>
+ that is your code will look somethingh like this: </p>
+ <c> ssl:listen(Port, [{ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]).
+ </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and
+ Craig Young for reporting this vulnerability. </p>
+ <p>
+ Own Id: OTP-14748</p>
+ </item>
+ </list>
+ </section>
+
+ </section>
+
<section><title>SSL 7.3.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -585,7 +764,59 @@
</list>
</section>
+ <section><title>SSL 7.3.3.0.1</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p> An erlang TLS server configured with cipher suites
+ using rsa key exchange, may be vulnerable to an Adaptive
+ Chosen Ciphertext attack (AKA Bleichenbacher attack)
+ against RSA, which when exploited, may result in
+ plaintext recovery of encrypted messages and/or a
+ Man-in-the-middle (MiTM) attack, despite the attacker not
+ having gained access to the server’s private key
+ itself. <url
+ href="https://nvd.nist.gov/vuln/detail/CVE-2017-1000385">CVE-2017-1000385</url>
+ </p> <p> Exploiting this vulnerability to perform
+ plaintext recovery of encrypted messages will, in most
+ practical cases, allow an attacker to read the plaintext
+ only after the session has completed. Only TLS sessions
+ established using RSA key exchange are vulnerable to this
+ attack. </p> <p> Exploiting this vulnerability to conduct
+ a MiTM attack requires the attacker to complete the
+ initial attack, which may require thousands of server
+ requests, during the handshake phase of the targeted
+ session within the window of the configured handshake
+ timeout. This attack may be conducted against any TLS
+ session using RSA signatures, but only if cipher suites
+ using RSA key exchange are also enabled on the server.
+ The limited window of opportunity, limitations in
+ bandwidth, and latency make this attack significantly
+ more difficult to execute. </p> <p> RSA key exchange is
+ enabled by default although least prioritized if server
+ order is honored. For such a cipher suite to be chosen it
+ must also be supported by the client and probably the
+ only shared cipher suite. </p> <p> Captured TLS sessions
+ encrypted with ephemeral cipher suites (DHE or ECDHE) are
+ not at risk for subsequent decryption due to this
+ vulnerability. </p> <p> As a workaround if default cipher
+ suite configuration was used you can configure the server
+ to not use vulnerable suites with the ciphers option like
+ this: </p> <c> {ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,Suite) =/= rsa]} </c> <p>
+ that is your code will look somethingh like this: </p>
+ <c> ssl:listen(Port, [{ciphers, [Suite || Suite &lt;-
+ ssl:cipher_suites(), element(1,S) =/= rsa]} | Options]).
+ </c> <p> Thanks to Hanno Böck, Juraj Somorovsky and
+ Craig Young for reporting this vulnerability. </p>
+ <p>
+ Own Id: OTP-14748</p>
+ </item>
+ </list>
+ </section>
+
+ </section>
<section><title>Improvements and New Features</title>
<list>
<item>
diff --git a/lib/ssl/doc/src/pkix_certs.xml b/lib/ssl/doc/src/pkix_certs.xml
deleted file mode 100644
index f365acef4d..0000000000
--- a/lib/ssl/doc/src/pkix_certs.xml
+++ /dev/null
@@ -1,59 +0,0 @@
-<?xml version="1.0" encoding="utf-8" ?>
-<!DOCTYPE chapter SYSTEM "chapter.dtd">
-
-<chapter>
- <header>
- <copyright>
- <year>2003</year><year>2016</year>
- <holder>Ericsson AB. All Rights Reserved.</holder>
- </copyright>
- <legalnotice>
- Licensed under the Apache License, Version 2.0 (the "License");
- you may not use this file except in compliance with the License.
- You may obtain a copy of the License at
-
- http://www.apache.org/licenses/LICENSE-2.0
-
- Unless required by applicable law or agreed to in writing, software
- distributed under the License is distributed on an "AS IS" BASIS,
- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
- See the License for the specific language governing permissions and
- limitations under the License.
-
- </legalnotice>
-
- <title>PKIX Certificates</title>
- <prepared>UAB/F/P Peter H&ouml;gfeldt</prepared>
- <docno></docno>
- <date>2003-06-09</date>
- <rev>A</rev>
- <file>pkix_certs.xml</file>
- </header>
-
- <section>
- <title>Introduction to Certificates</title>
- <p>Certificates were originally defined by ITU (CCITT) and the latest
- definitions are described in <cite id="X.509"></cite>, but those definitions
- are (as always) not working.
- </p>
- <p>Working certificate definitions for the Internet Community are found
- in the the PKIX RFCs <cite id="rfc3279"></cite> and <cite id="rfc3280"></cite>.
- The parsing of certificates in the Erlang/OTP SSL application is
- based on those RFCS.
- </p>
- <p>Certificates are defined in terms of ASN.1 (<cite id="X.680"></cite>).
- For an introduction to ASN.1 see <url href="http://asn1.elibel.tm.fr/">ASN.1 Information Site</url>.
- </p>
- </section>
-
- <section>
- <title>PKIX Certificates</title>
- <p>Certificate handling is now handled by the <c>public_key</c> application.</p>
- <p>
- DER encoded certificates returned by <c>ssl:peercert/1</c> can for example
- be decoded by the <c>public_key:pkix_decode_cert/2</c> function.
- </p>
- </section>
-</chapter>
-
-
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index bda8e8ec7d..8fcda78ed5 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -203,12 +203,14 @@
<tag><c>{certfile, path()}</c></tag>
<item><p>Path to a file containing the user certificate.</p></item>
- <tag><c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
+ <tag>
+ <marker id="key_option_def"/>
+ <c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
|'PrivateKeyInfo', public_key:der_encoded()} | #{algorithm := rsa | dss | ecdsa,
engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></tag>
<item><p>The DER-encoded user's private key or a map refering to a crypto
engine and its key reference that optionally can be password protected,
- seealso <seealso marker="crypto:engine_load-4"> crypto:engine_load/4
+ seealso <seealso marker="crypto:crypto#engine_load-4"> crypto:engine_load/4
</seealso> and <seealso marker="crypto:engine_load"> Crypto's Users Guide</seealso>. If this option
is supplied, it overrides option <c>keyfile</c>.</p></item>
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 7d2605e013..073cb4009b 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -39,20 +39,18 @@
-export([start_fsm/8, start_link/7, init/1]).
%% State transition handling
--export([next_record/1, next_event/3, next_event/4]).
+-export([next_record/1, next_event/3, next_event/4, handle_common_event/4]).
%% Handshake handling
--export([renegotiate/2,
- reinit_handshake_data/1,
- send_handshake/2, queue_handshake/2, queue_change_cipher/2,
- select_sni_extension/1, empty_connection_state/2]).
+-export([renegotiate/2, send_handshake/2,
+ queue_handshake/2, queue_change_cipher/2,
+ reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]).
%% Alert and close handling
-export([encode_alert/3,send_alert/2, close/5, protocol_name/0]).
%% Data handling
-
--export([encode_data/3, passive_receive/2, next_record_if_active/1, handle_common_event/4,
+-export([encode_data/3, passive_receive/2, next_record_if_active/1,
send/3, socket/5, setopts/3, getopts/3]).
%% gen_statem state functions
@@ -64,6 +62,9 @@
%%====================================================================
%% Internal application API
+%%====================================================================
+%%====================================================================
+%% Setup
%%====================================================================
start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts,
User, {CbModule, _,_, _} = CbInfo,
@@ -79,6 +80,218 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker}
Error
end.
+%%--------------------------------------------------------------------
+-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
+ {ok, pid()} | ignore | {error, reason()}.
+%%
+%% Description: Creates a gen_statem process which calls Module:init/1 to
+%% initialize.
+%%--------------------------------------------------------------------
+start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
+ {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}.
+
+init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
+ process_flag(trap_exit, true),
+ State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
+ try
+ State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0),
+ gen_statem:enter_loop(?MODULE, [], init, State)
+ catch
+ throw:Error ->
+ gen_statem:enter_loop(?MODULE, [], error, {Error,State0})
+ end.
+%%====================================================================
+%% State transition handling
+%%====================================================================
+next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 ->
+ {no_record, State#state{unprocessed_handshake_events = N-1}};
+
+next_record(#state{protocol_buffers =
+ #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]}
+ = Buffers,
+ connection_states = #{current_read := #{epoch := Epoch}} = ConnectionStates} = State) ->
+ CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read),
+ case dtls_record:replay_detect(CT, CurrentRead) of
+ false ->
+ decode_cipher_text(State#state{connection_states = ConnectionStates}) ;
+ true ->
+ %% Ignore replayed record
+ next_record(State#state{protocol_buffers =
+ Buffers#protocol_buffers{dtls_cipher_texts = Rest},
+ connection_states = ConnectionStates})
+ end;
+next_record(#state{protocol_buffers =
+ #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} | Rest]}
+ = Buffers,
+ connection_states = #{current_read := #{epoch := CurrentEpoch}} = ConnectionStates} = State)
+ when Epoch > CurrentEpoch ->
+ %% TODO Buffer later Epoch message, drop it for now
+ next_record(State#state{protocol_buffers =
+ Buffers#protocol_buffers{dtls_cipher_texts = Rest},
+ connection_states = ConnectionStates});
+next_record(#state{protocol_buffers =
+ #protocol_buffers{dtls_cipher_texts = [ _ | Rest]}
+ = Buffers,
+ connection_states = ConnectionStates} = State) ->
+ %% Drop old epoch message
+ next_record(State#state{protocol_buffers =
+ Buffers#protocol_buffers{dtls_cipher_texts = Rest},
+ connection_states = ConnectionStates});
+next_record(#state{role = server,
+ socket = {Listener, {Client, _}},
+ transport_cb = gen_udp} = State) ->
+ dtls_udp_listener:active_once(Listener, Client, self()),
+ {no_record, State};
+next_record(#state{role = client,
+ socket = {_Server, Socket},
+ transport_cb = Transport} = State) ->
+ dtls_socket:setopts(Transport, Socket, [{active,once}]),
+ {no_record, State};
+next_record(State) ->
+ {no_record, State}.
+
+next_event(StateName, Record, State) ->
+ next_event(StateName, Record, State, []).
+
+next_event(connection = StateName, no_record,
+ #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
+ case next_record_if_active(State0) of
+ {no_record, State} ->
+ ssl_connection:hibernate_after(StateName, State, Actions);
+ {#ssl_tls{epoch = CurrentEpoch,
+ type = ?HANDSHAKE,
+ version = Version} = Record, State1} ->
+ State = dtls_version(StateName, Version, State1),
+ {next_state, StateName, State,
+ [{next_event, internal, {protocol_record, Record}} | Actions]};
+ {#ssl_tls{epoch = CurrentEpoch} = Record, State} ->
+ {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
+ {#ssl_tls{epoch = Epoch,
+ type = ?HANDSHAKE,
+ version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
+ {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
+ {NextRecord, State} = next_record(State2),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
+ %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
+ {#ssl_tls{epoch = Epoch,
+ type = ?CHANGE_CIPHER_SPEC,
+ version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
+ {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
+ {NextRecord, State} = next_record(State2),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
+ {#ssl_tls{epoch = _Epoch,
+ version = _Version}, State1} ->
+ %% TODO maybe buffer later epoch
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State, Actions);
+ {#alert{} = Alert, State} ->
+ {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ end;
+next_event(connection = StateName, Record,
+ #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
+ case Record of
+ #ssl_tls{epoch = CurrentEpoch,
+ type = ?HANDSHAKE,
+ version = Version} = Record ->
+ State = dtls_version(StateName, Version, State0),
+ {next_state, StateName, State,
+ [{next_event, internal, {protocol_record, Record}} | Actions]};
+ #ssl_tls{epoch = CurrentEpoch} ->
+ {next_state, StateName, State0, [{next_event, internal, {protocol_record, Record}} | Actions]};
+ #ssl_tls{epoch = Epoch,
+ type = ?HANDSHAKE,
+ version = _Version} when Epoch == CurrentEpoch-1 ->
+ {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
+ {NextRecord, State} = next_record(State1),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
+ %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
+ #ssl_tls{epoch = Epoch,
+ type = ?CHANGE_CIPHER_SPEC,
+ version = _Version} when Epoch == CurrentEpoch-1 ->
+ {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
+ {NextRecord, State} = next_record(State1),
+ next_event(StateName, NextRecord, State, Actions ++ MoreActions);
+ _ ->
+ next_event(StateName, no_record, State0, Actions)
+ end;
+next_event(StateName, Record,
+ #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
+ case Record of
+ no_record ->
+ {next_state, StateName, State0, Actions};
+ #ssl_tls{epoch = CurrentEpoch,
+ version = Version} = Record ->
+ State = dtls_version(StateName, Version, State0),
+ {next_state, StateName, State,
+ [{next_event, internal, {protocol_record, Record}} | Actions]};
+ #ssl_tls{epoch = _Epoch,
+ version = _Version} = _Record ->
+ %% TODO maybe buffer later epoch
+ {Record, State} = next_record(State0),
+ next_event(StateName, Record, State, Actions);
+ #alert{} = Alert ->
+ {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]}
+ end.
+
+handle_common_event(internal, #alert{} = Alert, StateName,
+ #state{negotiated_version = Version} = State) ->
+ handle_own_alert(Alert, Version, StateName, State);
+%%% DTLS record protocol level handshake messages
+handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
+ fragment = Data},
+ StateName,
+ #state{protocol_buffers = Buffers0,
+ negotiated_version = Version} = State0) ->
+ try
+ case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of
+ {[], Buffers} ->
+ {Record, State} = next_record(State0#state{protocol_buffers = Buffers}),
+ next_event(StateName, Record, State);
+ {Packets, Buffers} ->
+ State = State0#state{protocol_buffers = Buffers},
+ Events = dtls_handshake_events(Packets),
+ {next_state, StateName,
+ State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
+ end
+ catch throw:#alert{} = Alert ->
+ handle_own_alert(Alert, Version, StateName, State0)
+ end;
+%%% DTLS record protocol level application data messages
+handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
+ {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]};
+%%% DTLS record protocol level change cipher messages
+handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) ->
+ {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
+%%% DTLS record protocol level Alert messages
+handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
+ #state{negotiated_version = Version} = State) ->
+ case decode_alerts(EncAlerts) of
+ Alerts = [_|_] ->
+ handle_alerts(Alerts, {next_state, StateName, State});
+ #alert{} = Alert ->
+ handle_own_alert(Alert, Version, StateName, State)
+ end;
+%% Ignore unknown TLS record level protocol messages
+handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
+ {next_state, StateName, State}.
+
+%%====================================================================
+%% Handshake handling
+%%====================================================================
+
+renegotiate(#state{role = client} = State, Actions) ->
+ %% Handle same way as if server requested
+ %% the renegotiation
+ {next_state, connection, State,
+ [{next_event, internal, #hello_request{}} | Actions]};
+
+renegotiate(#state{role = server} = State0, Actions) ->
+ HelloRequest = ssl_handshake:hello_request(),
+ State1 = prepare_flight(State0),
+ {State2, MoreActions} = send_handshake(HelloRequest, State1),
+ {Record, State} = next_record(State2),
+ next_event(hello, Record, State, Actions ++ MoreActions).
+
send_handshake(Handshake, #state{connection_states = ConnectionStates} = State) ->
#{epoch := Epoch} = ssl_record:current_connection_state(ConnectionStates, write),
send_handshake_flight(queue_handshake(Handshake, State), Epoch).
@@ -104,85 +317,12 @@ queue_handshake(Handshake0, #state{tls_handshake_history = Hist0,
next_sequence => Seq +1},
tls_handshake_history = Hist}.
-
-send_handshake_flight(#state{socket = Socket,
- transport_cb = Transport,
- flight_buffer = #{handshakes := Flight,
- change_cipher_spec := undefined},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
- %% TODO remove hardcoded Max size
- {Encoded, ConnectionStates} =
- encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0),
- send(Transport, Socket, Encoded),
- {State0#state{connection_states = ConnectionStates}, []};
-
-send_handshake_flight(#state{socket = Socket,
- transport_cb = Transport,
- flight_buffer = #{handshakes := [_|_] = Flight0,
- change_cipher_spec := ChangeCipher,
- handshakes_after_change_cipher_spec := []},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
- {HsBefore, ConnectionStates1} =
- encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0),
- {EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1),
-
- send(Transport, Socket, [HsBefore, EncChangeCipher]),
- {State0#state{connection_states = ConnectionStates}, []};
-
-send_handshake_flight(#state{socket = Socket,
- transport_cb = Transport,
- flight_buffer = #{handshakes := [_|_] = Flight0,
- change_cipher_spec := ChangeCipher,
- handshakes_after_change_cipher_spec := Flight1},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
- {HsBefore, ConnectionStates1} =
- encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0),
- {EncChangeCipher, ConnectionStates2} =
- encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates1),
- {HsAfter, ConnectionStates} =
- encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2),
- send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]),
- {State0#state{connection_states = ConnectionStates}, []};
-
-send_handshake_flight(#state{socket = Socket,
- transport_cb = Transport,
- flight_buffer = #{handshakes := [],
- change_cipher_spec := ChangeCipher,
- handshakes_after_change_cipher_spec := Flight1},
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Epoch) ->
- {EncChangeCipher, ConnectionStates1} =
- encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0),
- {HsAfter, ConnectionStates} =
- encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1),
- send(Transport, Socket, [EncChangeCipher, HsAfter]),
- {State0#state{connection_states = ConnectionStates}, []}.
-
queue_change_cipher(ChangeCipher, #state{flight_buffer = Flight,
connection_states = ConnectionStates0} = State) ->
ConnectionStates =
dtls_record:next_epoch(ConnectionStates0, write),
State#state{flight_buffer = Flight#{change_cipher_spec => ChangeCipher},
connection_states = ConnectionStates}.
-
-send_alert(Alert, #state{negotiated_version = Version,
- socket = Socket,
- transport_cb = Transport,
- connection_states = ConnectionStates0} = State0) ->
- {BinMsg, ConnectionStates} =
- encode_alert(Alert, Version, ConnectionStates0),
- send(Transport, Socket, BinMsg),
- State0#state{connection_states = ConnectionStates}.
-
-close(downgrade, _,_,_,_) ->
- ok;
-%% Other
-close(_, Socket, Transport, _,_) ->
- dtls_socket:close(Transport,Socket).
-
reinit_handshake_data(#state{protocol_buffers = Buffers} = State) ->
State#state{premaster_secret = undefined,
public_key_info = undefined,
@@ -200,54 +340,81 @@ select_sni_extension(#client_hello{extensions = HelloExtensions}) ->
HelloExtensions#hello_extensions.sni;
select_sni_extension(_) ->
undefined.
+
empty_connection_state(ConnectionEnd, BeastMitigation) ->
Empty = ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation),
dtls_record:empty_connection_state(Empty).
-socket(Pid, Transport, Socket, Connection, _) ->
- dtls_socket:socket(Pid, Transport, Socket, Connection).
+%%====================================================================
+%% Alert and close handling
+%%====================================================================
+encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
+ dtls_record:encode_alert_record(Alert, Version, ConnectionStates).
-setopts(Transport, Socket, Other) ->
- dtls_socket:setopts(Transport, Socket, Other).
-getopts(Transport, Socket, Tag) ->
- dtls_socket:getopts(Transport, Socket, Tag).
+send_alert(Alert, #state{negotiated_version = Version,
+ socket = Socket,
+ transport_cb = Transport,
+ connection_states = ConnectionStates0} = State0) ->
+ {BinMsg, ConnectionStates} =
+ encode_alert(Alert, Version, ConnectionStates0),
+ send(Transport, Socket, BinMsg),
+ State0#state{connection_states = ConnectionStates}.
+
+close(downgrade, _,_,_,_) ->
+ ok;
+%% Other
+close(_, Socket, Transport, _,_) ->
+ dtls_socket:close(Transport,Socket).
protocol_name() ->
"DTLS".
%%====================================================================
-%% tls_connection_sup API
-%%====================================================================
+%% Data handling
+%%====================================================================
-%%--------------------------------------------------------------------
--spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
- {ok, pid()} | ignore | {error, reason()}.
-%%
-%% Description: Creates a gen_fsm process which calls Module:init/1 to
-%% initialize. To ensure a synchronized start-up procedure, this function
-%% does not return until Module:init/1 has returned.
-%%--------------------------------------------------------------------
-start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
- {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}.
+encode_data(Data, Version, ConnectionStates0)->
+ dtls_record:encode_data(Data, Version, ConnectionStates0).
-init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
- process_flag(trap_exit, true),
- State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
- try
- State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0),
- gen_statem:enter_loop(?MODULE, [], init, State)
- catch
- throw:Error ->
- gen_statem:enter_loop(?MODULE, [], error, {Error,State0})
+passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) ->
+ case Buffer of
+ <<>> ->
+ {Record, State} = next_record(State0),
+ next_event(StateName, Record, State);
+ _ ->
+ {Record, State} = ssl_connection:read_application_data(<<>>, State0),
+ next_event(StateName, Record, State)
end.
+next_record_if_active(State =
+ #state{socket_options =
+ #socket_options{active = false}}) ->
+ {no_record ,State};
-callback_mode() ->
- [state_functions, state_enter].
+next_record_if_active(State) ->
+ next_record(State).
+
+send(Transport, {_, {{_,_}, _} = Socket}, Data) ->
+ send(Transport, Socket, Data);
+send(Transport, Socket, Data) ->
+ dtls_socket:send(Transport, Socket, Data).
+
+socket(Pid, Transport, Socket, Connection, _) ->
+ dtls_socket:socket(Pid, Transport, Socket, Connection).
+
+setopts(Transport, Socket, Other) ->
+ dtls_socket:setopts(Transport, Socket, Other).
+
+getopts(Transport, Socket, Tag) ->
+ dtls_socket:getopts(Transport, Socket, Tag).
%%--------------------------------------------------------------------
%% State functions
%%--------------------------------------------------------------------
-
+%%--------------------------------------------------------------------
+-spec init(gen_statem:event_type(),
+ {start, timeout()} | term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
init(enter, _, State) ->
{keep_state, State};
init({call, From}, {start, Timeout},
@@ -277,28 +444,32 @@ init({call, From}, {start, Timeout},
{Record, State} = next_record(State3),
next_event(hello, Record, State, Actions);
init({call, _} = Type, Event, #state{role = server, transport_cb = gen_udp} = State) ->
- Result = ssl_connection:?FUNCTION_NAME(Type, Event,
- State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
- protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(),
- previous_cookie_secret => <<>>,
- ignored_alerts => 0,
- max_ignored_alerts => 10}},
- ?MODULE),
+ Result = gen_handshake(?FUNCTION_NAME, Type, Event,
+ State#state{flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT},
+ protocol_specific = #{current_cookie_secret => dtls_v1:cookie_secret(),
+ previous_cookie_secret => <<>>,
+ ignored_alerts => 0,
+ max_ignored_alerts => 10}}),
erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret),
Result;
init({call, _} = Type, Event, #state{role = server} = State) ->
%% I.E. DTLS over sctp
- ssl_connection:?FUNCTION_NAME(Type, Event, State#state{flight_state = reliable}, ?MODULE);
+ gen_handshake(?FUNCTION_NAME, Type, Event, State#state{flight_state = reliable});
init(Type, Event, State) ->
- ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
-
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+
+%%--------------------------------------------------------------------
+-spec error(gen_statem:event_type(),
+ {start, timeout()} | term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
error(enter, _, State) ->
{keep_state, State};
error({call, From}, {start, _Timeout}, {Error, State}) ->
{stop_and_reply, normal, {reply, From, {error, Error}}, State};
-error({call, From}, Msg, State) ->
- handle_call(Msg, From, ?FUNCTION_NAME, State);
+error({call, _} = Call, Msg, State) ->
+ gen_handshake(?FUNCTION_NAME, Call, Msg, State);
error(_, _, _) ->
{keep_state_and_data, [postpone]}.
@@ -393,49 +564,60 @@ hello(internal, {handshake, {#hello_verify_request{} = Handshake, _}}, State) ->
%% hello_verify should not be in handshake history
{next_state, ?FUNCTION_NAME, State, [{next_event, internal, Handshake}]};
hello(info, Event, State) ->
- handle_info(Event, ?FUNCTION_NAME, State);
+ gen_info(Event, ?FUNCTION_NAME, State);
hello(state_timeout, Event, State) ->
handle_state_timeout(Event, ?FUNCTION_NAME, State);
hello(Type, Event, State) ->
- ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+%%--------------------------------------------------------------------
+-spec abbreviated(gen_statem:event_type(), term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
abbreviated(enter, _, State0) ->
{State, Actions} = handle_flight_timer(State0),
{keep_state, State, Actions};
abbreviated(info, Event, State) ->
- handle_info(Event, ?FUNCTION_NAME, State);
+ gen_info(Event, ?FUNCTION_NAME, State);
abbreviated(internal = Type,
#change_cipher_spec{type = <<1>>} = Event,
#state{connection_states = ConnectionStates0} = State) ->
ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read),
ConnectionStates = dtls_record:next_epoch(ConnectionStates1, read),
- ssl_connection:?FUNCTION_NAME(Type, Event, State#state{connection_states = ConnectionStates}, ?MODULE);
+ gen_handshake(?FUNCTION_NAME, Type, Event, State#state{connection_states = ConnectionStates});
abbreviated(internal = Type, #finished{} = Event, #state{connection_states = ConnectionStates} = State) ->
- ssl_connection:?FUNCTION_NAME(Type, Event,
- prepare_flight(State#state{connection_states = ConnectionStates,
- flight_state = connection}), ?MODULE);
+ gen_handshake(?FUNCTION_NAME, Type, Event,
+ prepare_flight(State#state{connection_states = ConnectionStates,
+ flight_state = connection}));
abbreviated(state_timeout, Event, State) ->
handle_state_timeout(Event, ?FUNCTION_NAME, State);
abbreviated(Type, Event, State) ->
- ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
-
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+%%--------------------------------------------------------------------
+-spec certify(gen_statem:event_type(), term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
certify(enter, _, State0) ->
{State, Actions} = handle_flight_timer(State0),
{keep_state, State, Actions};
certify(info, Event, State) ->
- handle_info(Event, ?FUNCTION_NAME, State);
+ gen_info(Event, ?FUNCTION_NAME, State);
certify(internal = Type, #server_hello_done{} = Event, State) ->
ssl_connection:certify(Type, Event, prepare_flight(State), ?MODULE);
certify(state_timeout, Event, State) ->
handle_state_timeout(Event, ?FUNCTION_NAME, State);
certify(Type, Event, State) ->
- ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
+%%--------------------------------------------------------------------
+-spec cipher(gen_statem:event_type(), term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
cipher(enter, _, State0) ->
{State, Actions} = handle_flight_timer(State0),
{keep_state, State, Actions};
cipher(info, Event, State) ->
- handle_info(Event, ?FUNCTION_NAME, State);
+ gen_info(Event, ?FUNCTION_NAME, State);
cipher(internal = Type, #change_cipher_spec{type = <<1>>} = Event,
#state{connection_states = ConnectionStates0} = State) ->
ConnectionStates1 = dtls_record:save_current_connection_state(ConnectionStates0, read),
@@ -451,10 +633,15 @@ cipher(state_timeout, Event, State) ->
cipher(Type, Event, State) ->
ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
+%%--------------------------------------------------------------------
+-spec connection(gen_statem:event_type(),
+ #hello_request{} | #client_hello{}| term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
connection(enter, _, State) ->
{keep_state, State};
connection(info, Event, State) ->
- handle_info(Event, ?FUNCTION_NAME, State);
+ gen_info(Event, ?FUNCTION_NAME, State);
connection(internal, #hello_request{}, #state{host = Host, port = Port,
session = #session{own_certificate = Cert} = Session0,
session_cache = Cache, session_cache_cb = CacheCb,
@@ -492,136 +679,24 @@ connection(Type, Event, State) ->
ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
%%TODO does this make sense for DTLS ?
+%%--------------------------------------------------------------------
+-spec downgrade(gen_statem:event_type(), term(), #state{}) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
downgrade(enter, _, State) ->
{keep_state, State};
downgrade(Type, Event, State) ->
ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
%%--------------------------------------------------------------------
-%% Description: This function is called by a gen_fsm when it receives any
-%% other message than a synchronous or asynchronous event
-%% (or a system message).
+%% gen_statem callbacks
%%--------------------------------------------------------------------
+callback_mode() ->
+ [state_functions, state_enter].
-%% raw data from socket, unpack records
-handle_info({Protocol, _, _, _, Data}, StateName,
- #state{data_tag = Protocol} = State0) ->
- case next_dtls_record(Data, State0) of
- {Record, State} ->
- next_event(StateName, Record, State);
- #alert{} = Alert ->
- ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
- {stop, {shutdown, own_alert}}
- end;
-handle_info({CloseTag, Socket}, StateName,
- #state{socket = Socket,
- socket_options = #socket_options{active = Active},
- protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs},
- close_tag = CloseTag,
- negotiated_version = Version} = State) ->
- %% Note that as of DTLS 1.2 (TLS 1.1),
- %% failure to properly close a connection no longer requires that a
- %% session not be resumed. This is a change from DTLS 1.0 to conform
- %% with widespread implementation practice.
- case (Active == false) andalso (CTs =/= []) of
- false ->
- case Version of
- {254, N} when N =< 253 ->
- ok;
- _ ->
- %% As invalidate_sessions here causes performance issues,
- %% we will conform to the widespread implementation
- %% practice and go aginst the spec
- %%invalidate_session(Role, Host, Port, Session)
- ok
- end,
- ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, {shutdown, transport_closed}};
- true ->
- %% Fixes non-delivery of final DTLS record in {active, once}.
- %% Basically allows the application the opportunity to set {active, once} again
- %% and then receive the final message.
- next_event(StateName, no_record, State)
- end;
-
-handle_info(new_cookie_secret, StateName,
- #state{protocol_specific = #{current_cookie_secret := Secret} = CookieInfo} = State) ->
- erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret),
- {next_state, StateName, State#state{protocol_specific =
- CookieInfo#{current_cookie_secret => dtls_v1:cookie_secret(),
- previous_cookie_secret => Secret}}};
-handle_info(Msg, StateName, State) ->
- ssl_connection:handle_info(Msg, StateName, State).
-
-handle_call(Event, From, StateName, State) ->
- ssl_connection:handle_call(Event, From, StateName, State, ?MODULE).
-
-handle_common_event(internal, #alert{} = Alert, StateName,
- #state{negotiated_version = Version} = State) ->
- handle_own_alert(Alert, Version, StateName, State);
-%%% DTLS record protocol level handshake messages
-handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE,
- fragment = Data},
- StateName,
- #state{protocol_buffers = Buffers0,
- negotiated_version = Version} = State0) ->
- try
- case dtls_handshake:get_dtls_handshake(Version, Data, Buffers0) of
- {[], Buffers} ->
- {Record, State} = next_record(State0#state{protocol_buffers = Buffers}),
- next_event(StateName, Record, State);
- {Packets, Buffers} ->
- State = State0#state{protocol_buffers = Buffers},
- Events = dtls_handshake_events(Packets),
- {next_state, StateName,
- State#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
- end
- catch throw:#alert{} = Alert ->
- handle_own_alert(Alert, Version, StateName, State0)
- end;
-%%% DTLS record protocol level application data messages
-handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
- {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]};
-%%% DTLS record protocol level change cipher messages
-handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) ->
- {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
-%%% DTLS record protocol level Alert messages
-handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
- #state{negotiated_version = Version} = State) ->
- case decode_alerts(EncAlerts) of
- Alerts = [_|_] ->
- handle_alerts(Alerts, {next_state, StateName, State});
- #alert{} = Alert ->
- handle_own_alert(Alert, Version, StateName, State)
- end;
-%% Ignore unknown TLS record level protocol messages
-handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
- {next_state, StateName, State}.
-
-handle_state_timeout(flight_retransmission_timeout, StateName,
- #state{flight_state = {retransmit, NextTimeout}} = State0) ->
- {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}},
- retransmit_epoch(StateName, State0)),
- {Record, State} = next_record(State1),
- next_event(StateName, Record, State, Actions).
-
-send(Transport, {_, {{_,_}, _} = Socket}, Data) ->
- send(Transport, Socket, Data);
-send(Transport, Socket, Data) ->
- dtls_socket:send(Transport, Socket, Data).
-%%--------------------------------------------------------------------
-%% Description:This function is called by a gen_fsm when it is about
-%% to terminate. It should be the opposite of Module:init/1 and do any
-%% necessary cleaning up. When it returns, the gen_fsm terminates with
-%% Reason. The return value is ignored.
-%%--------------------------------------------------------------------
terminate(Reason, StateName, State) ->
ssl_connection:terminate(Reason, StateName, State).
-%%--------------------------------------------------------------------
-%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
code_change(_OldVsn, StateName, State, _Extra) ->
{ok, StateName, State}.
@@ -631,55 +706,6 @@ format_status(Type, Data) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-handle_client_hello(#client_hello{client_version = ClientVersion} = Hello,
- #state{connection_states = ConnectionStates0,
- port = Port, session = #session{own_certificate = Cert} = Session0,
- renegotiation = {Renegotiation, _},
- session_cache = Cache,
- session_cache_cb = CacheCb,
- negotiated_protocol = CurrentProtocol,
- key_algorithm = KeyExAlg,
- ssl_options = SslOpts} = State0) ->
-
- case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
- ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of
- #alert{} = Alert ->
- handle_own_alert(Alert, ClientVersion, hello, State0);
- {Version, {Type, Session},
- ConnectionStates, Protocol0, ServerHelloExt, HashSign} ->
- Protocol = case Protocol0 of
- undefined -> CurrentProtocol;
- _ -> Protocol0
- end,
-
- State = prepare_flight(State0#state{connection_states = ConnectionStates,
- negotiated_version = Version,
- hashsign_algorithm = HashSign,
- session = Session,
- negotiated_protocol = Protocol}),
-
- ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt},
- State, ?MODULE)
- end.
-
-encode_handshake_flight(Flight, Version, MaxFragmentSize, Epoch, ConnectionStates) ->
- Fragments = lists:map(fun(Handshake) ->
- dtls_handshake:fragment_handshake(Handshake, MaxFragmentSize)
- end, Flight),
- dtls_record:encode_handshake(Fragments, Version, Epoch, ConnectionStates).
-
-encode_change_cipher(#change_cipher_spec{}, Version, Epoch, ConnectionStates) ->
- dtls_record:encode_change_cipher_spec(Version, Epoch, ConnectionStates).
-
-encode_data(Data, Version, ConnectionStates0)->
- dtls_record:encode_data(Data, Version, ConnectionStates0).
-
-encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
- dtls_record:encode_alert_record(Alert, Version, ConnectionStates).
-
-decode_alerts(Bin) ->
- ssl_alert:decode(Bin).
-
initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User,
{CbModule, DataTag, CloseTag, ErrorTag}) ->
#ssl_options{beast_mitigation = BeastMitigation} = SSLOptions,
@@ -733,153 +759,10 @@ next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{
Alert
end.
-next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 ->
- {no_record, State#state{unprocessed_handshake_events = N-1}};
-
-next_record(#state{protocol_buffers =
- #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} = CT | Rest]}
- = Buffers,
- connection_states = #{current_read := #{epoch := Epoch}} = ConnectionStates} = State) ->
- CurrentRead = dtls_record:get_connection_state_by_epoch(Epoch, ConnectionStates, read),
- case dtls_record:replay_detect(CT, CurrentRead) of
- false ->
- decode_cipher_text(State#state{connection_states = ConnectionStates}) ;
- true ->
- %% Ignore replayed record
- next_record(State#state{protocol_buffers =
- Buffers#protocol_buffers{dtls_cipher_texts = Rest},
- connection_states = ConnectionStates})
- end;
-next_record(#state{protocol_buffers =
- #protocol_buffers{dtls_cipher_texts = [#ssl_tls{epoch = Epoch} | Rest]}
- = Buffers,
- connection_states = #{current_read := #{epoch := CurrentEpoch}} = ConnectionStates} = State)
- when Epoch > CurrentEpoch ->
- %% TODO Buffer later Epoch message, drop it for now
- next_record(State#state{protocol_buffers =
- Buffers#protocol_buffers{dtls_cipher_texts = Rest},
- connection_states = ConnectionStates});
-next_record(#state{protocol_buffers =
- #protocol_buffers{dtls_cipher_texts = [ _ | Rest]}
- = Buffers,
- connection_states = ConnectionStates} = State) ->
- %% Drop old epoch message
- next_record(State#state{protocol_buffers =
- Buffers#protocol_buffers{dtls_cipher_texts = Rest},
- connection_states = ConnectionStates});
-next_record(#state{role = server,
- socket = {Listener, {Client, _}},
- transport_cb = gen_udp} = State) ->
- dtls_udp_listener:active_once(Listener, Client, self()),
- {no_record, State};
-next_record(#state{role = client,
- socket = {_Server, Socket},
- transport_cb = Transport} = State) ->
- dtls_socket:setopts(Transport, Socket, [{active,once}]),
- {no_record, State};
-next_record(State) ->
- {no_record, State}.
-
-next_record_if_active(State =
- #state{socket_options =
- #socket_options{active = false}}) ->
- {no_record ,State};
-
-next_record_if_active(State) ->
- next_record(State).
-
-passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) ->
- case Buffer of
- <<>> ->
- {Record, State} = next_record(State0),
- next_event(StateName, Record, State);
- _ ->
- {Record, State} = ssl_connection:read_application_data(<<>>, State0),
- next_event(StateName, Record, State)
- end.
-
-next_event(StateName, Record, State) ->
- next_event(StateName, Record, State, []).
-
-next_event(connection = StateName, no_record,
- #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
- case next_record_if_active(State0) of
- {no_record, State} ->
- ssl_connection:hibernate_after(StateName, State, Actions);
- {#ssl_tls{epoch = CurrentEpoch,
- type = ?HANDSHAKE,
- version = Version} = Record, State1} ->
- State = dtls_version(StateName, Version, State1),
- {next_state, StateName, State,
- [{next_event, internal, {protocol_record, Record}} | Actions]};
- {#ssl_tls{epoch = CurrentEpoch} = Record, State} ->
- {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
- {#ssl_tls{epoch = Epoch,
- type = ?HANDSHAKE,
- version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
- {NextRecord, State} = next_record(State2),
- next_event(StateName, NextRecord, State, Actions ++ MoreActions);
- %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
- {#ssl_tls{epoch = Epoch,
- type = ?CHANGE_CIPHER_SPEC,
- version = _Version}, State1} = _Record when Epoch == CurrentEpoch-1 ->
- {State2, MoreActions} = send_handshake_flight(State1, CurrentEpoch),
- {NextRecord, State} = next_record(State2),
- next_event(StateName, NextRecord, State, Actions ++ MoreActions);
- {#ssl_tls{epoch = _Epoch,
- version = _Version}, State1} ->
- %% TODO maybe buffer later epoch
- {Record, State} = next_record(State1),
- next_event(StateName, Record, State, Actions);
- {#alert{} = Alert, State} ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
- end;
-next_event(connection = StateName, Record,
- #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
- case Record of
- #ssl_tls{epoch = CurrentEpoch,
- type = ?HANDSHAKE,
- version = Version} = Record ->
- State = dtls_version(StateName, Version, State0),
- {next_state, StateName, State,
- [{next_event, internal, {protocol_record, Record}} | Actions]};
- #ssl_tls{epoch = CurrentEpoch} ->
- {next_state, StateName, State0, [{next_event, internal, {protocol_record, Record}} | Actions]};
- #ssl_tls{epoch = Epoch,
- type = ?HANDSHAKE,
- version = _Version} when Epoch == CurrentEpoch-1 ->
- {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
- {NextRecord, State} = next_record(State1),
- next_event(StateName, NextRecord, State, Actions ++ MoreActions);
- %% From FLIGHT perspective CHANGE_CIPHER_SPEC is treated as a handshake
- #ssl_tls{epoch = Epoch,
- type = ?CHANGE_CIPHER_SPEC,
- version = _Version} when Epoch == CurrentEpoch-1 ->
- {State1, MoreActions} = send_handshake_flight(State0, CurrentEpoch),
- {NextRecord, State} = next_record(State1),
- next_event(StateName, NextRecord, State, Actions ++ MoreActions);
- _ ->
- next_event(StateName, no_record, State0, Actions)
- end;
-next_event(StateName, Record,
- #state{connection_states = #{current_read := #{epoch := CurrentEpoch}}} = State0, Actions) ->
- case Record of
- no_record ->
- {next_state, StateName, State0, Actions};
- #ssl_tls{epoch = CurrentEpoch,
- version = Version} = Record ->
- State = dtls_version(StateName, Version, State0),
- {next_state, StateName, State,
- [{next_event, internal, {protocol_record, Record}} | Actions]};
- #ssl_tls{epoch = _Epoch,
- version = _Version} = _Record ->
- %% TODO maybe buffer later epoch
- {Record, State} = next_record(State0),
- next_event(StateName, Record, State, Actions);
- #alert{} = Alert ->
- {next_state, StateName, State0, [{next_event, internal, Alert} | Actions]}
- end.
+dtls_handshake_events(Packets) ->
+ lists:map(fun(Packet) ->
+ {next_event, internal, {handshake, Packet}}
+ end, Packets).
decode_cipher_text(#state{protocol_buffers = #protocol_buffers{dtls_cipher_texts = [ CT | Rest]} = Buffers,
connection_states = ConnStates0} = State) ->
@@ -897,6 +780,176 @@ dtls_version(hello, Version, #state{role = server} = State) ->
dtls_version(_,_, State) ->
State.
+handle_client_hello(#client_hello{client_version = ClientVersion} = Hello,
+ #state{connection_states = ConnectionStates0,
+ port = Port, session = #session{own_certificate = Cert} = Session0,
+ renegotiation = {Renegotiation, _},
+ session_cache = Cache,
+ session_cache_cb = CacheCb,
+ negotiated_protocol = CurrentProtocol,
+ key_algorithm = KeyExAlg,
+ ssl_options = SslOpts} = State0) ->
+
+ case dtls_handshake:hello(Hello, SslOpts, {Port, Session0, Cache, CacheCb,
+ ConnectionStates0, Cert, KeyExAlg}, Renegotiation) of
+ #alert{} = Alert ->
+ handle_own_alert(Alert, ClientVersion, hello, State0);
+ {Version, {Type, Session},
+ ConnectionStates, Protocol0, ServerHelloExt, HashSign} ->
+ Protocol = case Protocol0 of
+ undefined -> CurrentProtocol;
+ _ -> Protocol0
+ end,
+
+ State = prepare_flight(State0#state{connection_states = ConnectionStates,
+ negotiated_version = Version,
+ hashsign_algorithm = HashSign,
+ client_hello_version = ClientVersion,
+ session = Session,
+ negotiated_protocol = Protocol}),
+
+ ssl_connection:hello(internal, {common_client_hello, Type, ServerHelloExt},
+ State, ?MODULE)
+ end.
+
+
+%% raw data from socket, unpack records
+handle_info({Protocol, _, _, _, Data}, StateName,
+ #state{data_tag = Protocol} = State0) ->
+ case next_dtls_record(Data, State0) of
+ {Record, State} ->
+ next_event(StateName, Record, State);
+ #alert{} = Alert ->
+ ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
+ {stop, {shutdown, own_alert}}
+ end;
+handle_info({CloseTag, Socket}, StateName,
+ #state{socket = Socket,
+ socket_options = #socket_options{active = Active},
+ protocol_buffers = #protocol_buffers{dtls_cipher_texts = CTs},
+ close_tag = CloseTag,
+ negotiated_version = Version} = State) ->
+ %% Note that as of DTLS 1.2 (TLS 1.1),
+ %% failure to properly close a connection no longer requires that a
+ %% session not be resumed. This is a change from DTLS 1.0 to conform
+ %% with widespread implementation practice.
+ case (Active == false) andalso (CTs =/= []) of
+ false ->
+ case Version of
+ {254, N} when N =< 253 ->
+ ok;
+ _ ->
+ %% As invalidate_sessions here causes performance issues,
+ %% we will conform to the widespread implementation
+ %% practice and go aginst the spec
+ %%invalidate_session(Role, Host, Port, Session)
+ ok
+ end,
+ ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
+ {stop, {shutdown, transport_closed}};
+ true ->
+ %% Fixes non-delivery of final DTLS record in {active, once}.
+ %% Basically allows the application the opportunity to set {active, once} again
+ %% and then receive the final message.
+ next_event(StateName, no_record, State)
+ end;
+
+handle_info(new_cookie_secret, StateName,
+ #state{protocol_specific = #{current_cookie_secret := Secret} = CookieInfo} = State) ->
+ erlang:send_after(dtls_v1:cookie_timeout(), self(), new_cookie_secret),
+ {next_state, StateName, State#state{protocol_specific =
+ CookieInfo#{current_cookie_secret => dtls_v1:cookie_secret(),
+ previous_cookie_secret => Secret}}};
+handle_info(Msg, StateName, State) ->
+ ssl_connection:StateName(info, Msg, State, ?MODULE).
+
+handle_state_timeout(flight_retransmission_timeout, StateName,
+ #state{flight_state = {retransmit, NextTimeout}} = State0) ->
+ {State1, Actions} = send_handshake_flight(State0#state{flight_state = {retransmit, NextTimeout}},
+ retransmit_epoch(StateName, State0)),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State, Actions).
+
+handle_alerts([], Result) ->
+ Result;
+handle_alerts(_, {stop,_} = Stop) ->
+ Stop;
+handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
+ handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State));
+handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
+ handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
+
+handle_own_alert(Alert, Version, StateName, #state{transport_cb = gen_udp,
+ role = Role,
+ ssl_options = Options} = State0) ->
+ case ignore_alert(Alert, State0) of
+ {true, State} ->
+ log_ignore_alert(Options#ssl_options.log_alert, StateName, Alert, Role),
+ {next_state, StateName, State};
+ {false, State} ->
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State)
+ end;
+handle_own_alert(Alert, Version, StateName, State) ->
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State).
+
+encode_handshake_flight(Flight, Version, MaxFragmentSize, Epoch, ConnectionStates) ->
+ Fragments = lists:map(fun(Handshake) ->
+ dtls_handshake:fragment_handshake(Handshake, MaxFragmentSize)
+ end, Flight),
+ dtls_record:encode_handshake(Fragments, Version, Epoch, ConnectionStates).
+
+encode_change_cipher(#change_cipher_spec{}, Version, Epoch, ConnectionStates) ->
+ dtls_record:encode_change_cipher_spec(Version, Epoch, ConnectionStates).
+
+decode_alerts(Bin) ->
+ ssl_alert:decode(Bin).
+
+gen_handshake(StateName, Type, Event,
+ #state{negotiated_version = Version} = State) ->
+ try ssl_connection:StateName(Type, Event, State, ?MODULE) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data),
+ Version, StateName, State)
+ end.
+
+gen_info(Event, connection = StateName, #state{negotiated_version = Version} = State) ->
+ try handle_info(Event, StateName, State) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?INTERNAL_ERROR,
+ malformed_data),
+ Version, StateName, State)
+ end;
+
+gen_info(Event, StateName, #state{negotiated_version = Version} = State) ->
+ try handle_info(Event, StateName, State) of
+ Result ->
+ Result
+ catch
+ _:_ ->
+ ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE,
+ malformed_handshake_data),
+ Version, StateName, State)
+ end.
+unprocessed_events(Events) ->
+ %% The first handshake event will be processed immediately
+ %% as it is entered first in the event queue and
+ %% when it is processed there will be length(Events)-1
+ %% handshake events left to process before we should
+ %% process more TLS-records received on the socket.
+ erlang:length(Events)-1.
+
+update_handshake_history(#hello_verify_request{}, _, Hist) ->
+ Hist;
+update_handshake_history(_, Handshake, Hist) ->
+ %% DTLS never needs option "v2_hello_compatible" to be true
+ ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false).
prepare_flight(#state{flight_buffer = Flight,
connection_states = ConnectionStates0,
protocol_buffers =
@@ -937,67 +990,67 @@ new_timeout(N) when N =< 30 ->
new_timeout(_) ->
60.
-dtls_handshake_events(Packets) ->
- lists:map(fun(Packet) ->
- {next_event, internal, {handshake, Packet}}
- end, Packets).
+send_handshake_flight(#state{socket = Socket,
+ transport_cb = Transport,
+ flight_buffer = #{handshakes := Flight,
+ change_cipher_spec := undefined},
+ negotiated_version = Version,
+ connection_states = ConnectionStates0} = State0, Epoch) ->
+ %% TODO remove hardcoded Max size
+ {Encoded, ConnectionStates} =
+ encode_handshake_flight(lists:reverse(Flight), Version, 1400, Epoch, ConnectionStates0),
+ send(Transport, Socket, Encoded),
+ {State0#state{connection_states = ConnectionStates}, []};
-renegotiate(#state{role = client} = State, Actions) ->
- %% Handle same way as if server requested
- %% the renegotiation
- %% Hs0 = ssl_handshake:init_handshake_history(),
- {next_state, connection, State,
- [{next_event, internal, #hello_request{}} | Actions]};
+send_handshake_flight(#state{socket = Socket,
+ transport_cb = Transport,
+ flight_buffer = #{handshakes := [_|_] = Flight0,
+ change_cipher_spec := ChangeCipher,
+ handshakes_after_change_cipher_spec := []},
+ negotiated_version = Version,
+ connection_states = ConnectionStates0} = State0, Epoch) ->
+ {HsBefore, ConnectionStates1} =
+ encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch, ConnectionStates0),
+ {EncChangeCipher, ConnectionStates} = encode_change_cipher(ChangeCipher, Version, Epoch, ConnectionStates1),
-renegotiate(#state{role = server} = State0, Actions) ->
- HelloRequest = ssl_handshake:hello_request(),
- State1 = prepare_flight(State0),
- {State2, MoreActions} = send_handshake(HelloRequest, State1),
- {Record, State} = next_record(State2),
- next_event(hello, Record, State, Actions ++ MoreActions).
+ send(Transport, Socket, [HsBefore, EncChangeCipher]),
+ {State0#state{connection_states = ConnectionStates}, []};
-handle_alerts([], Result) ->
- Result;
-handle_alerts(_, {stop,_} = Stop) ->
- Stop;
-handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
- handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State));
-handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
- handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
+send_handshake_flight(#state{socket = Socket,
+ transport_cb = Transport,
+ flight_buffer = #{handshakes := [_|_] = Flight0,
+ change_cipher_spec := ChangeCipher,
+ handshakes_after_change_cipher_spec := Flight1},
+ negotiated_version = Version,
+ connection_states = ConnectionStates0} = State0, Epoch) ->
+ {HsBefore, ConnectionStates1} =
+ encode_handshake_flight(lists:reverse(Flight0), Version, 1400, Epoch-1, ConnectionStates0),
+ {EncChangeCipher, ConnectionStates2} =
+ encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates1),
+ {HsAfter, ConnectionStates} =
+ encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates2),
+ send(Transport, Socket, [HsBefore, EncChangeCipher, HsAfter]),
+ {State0#state{connection_states = ConnectionStates}, []};
+
+send_handshake_flight(#state{socket = Socket,
+ transport_cb = Transport,
+ flight_buffer = #{handshakes := [],
+ change_cipher_spec := ChangeCipher,
+ handshakes_after_change_cipher_spec := Flight1},
+ negotiated_version = Version,
+ connection_states = ConnectionStates0} = State0, Epoch) ->
+ {EncChangeCipher, ConnectionStates1} =
+ encode_change_cipher(ChangeCipher, Version, Epoch-1, ConnectionStates0),
+ {HsAfter, ConnectionStates} =
+ encode_handshake_flight(lists:reverse(Flight1), Version, 1400, Epoch, ConnectionStates1),
+ send(Transport, Socket, [EncChangeCipher, HsAfter]),
+ {State0#state{connection_states = ConnectionStates}, []}.
retransmit_epoch(_StateName, #state{connection_states = ConnectionStates}) ->
#{epoch := Epoch} =
ssl_record:current_connection_state(ConnectionStates, write),
Epoch.
-update_handshake_history(#hello_verify_request{}, _, Hist) ->
- Hist;
-update_handshake_history(_, Handshake, Hist) ->
- %% DTLS never needs option "v2_hello_compatible" to be true
- ssl_handshake:update_handshake_history(Hist, iolist_to_binary(Handshake), false).
-
-unprocessed_events(Events) ->
- %% The first handshake event will be processed immediately
- %% as it is entered first in the event queue and
- %% when it is processed there will be length(Events)-1
- %% handshake events left to process before we should
- %% process more TLS-records received on the socket.
- erlang:length(Events)-1.
-
-handle_own_alert(Alert, Version, StateName, #state{transport_cb = gen_udp,
- role = Role,
- ssl_options = Options} = State0) ->
- case ignore_alert(Alert, State0) of
- {true, State} ->
- log_ignore_alert(Options#ssl_options.log_alert, StateName, Alert, Role),
- {next_state, StateName, State};
- {false, State} ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State)
- end;
-handle_own_alert(Alert, Version, StateName, State) ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State).
-
-
ignore_alert(#alert{level = ?FATAL}, #state{protocol_specific = #{ignored_alerts := N,
max_ignored_alerts := N}} = State) ->
{false, State};
diff --git a/lib/ssl/src/dtls_handshake.erl b/lib/ssl/src/dtls_handshake.erl
index 37a46b862e..1d6f0a42c8 100644
--- a/lib/ssl/src/dtls_handshake.erl
+++ b/lib/ssl/src/dtls_handshake.erl
@@ -16,6 +16,11 @@
%% limitations under the License.
%%
%% %CopyrightEnd%
+
+%%----------------------------------------------------------------------
+%% Purpose: Help funtions for handling the DTLS (specific parts of)
+%%% SSL/TLS/DTLS handshake protocol
+%%----------------------------------------------------------------------
-module(dtls_handshake).
-include("dtls_connection.hrl").
@@ -24,15 +29,21 @@
-include("ssl_internal.hrl").
-include("ssl_alert.hrl").
+%% Handshake handling
-export([client_hello/8, client_hello/9, cookie/4, hello/4,
- hello_verify_request/2, get_dtls_handshake/3, fragment_handshake/2,
- handshake_bin/2, encode_handshake/3]).
+ hello_verify_request/2]).
+
+%% Handshake encoding
+-export([fragment_handshake/2, encode_handshake/3]).
+
+%% Handshake decodeing
+-export([get_dtls_handshake/3]).
-type dtls_handshake() :: #client_hello{} | #hello_verify_request{} |
ssl_handshake:ssl_handshake().
%%====================================================================
-%% Internal application API
+%% Handshake handling
%%====================================================================
%%--------------------------------------------------------------------
-spec client_hello(host(), inet:port_number(), ssl_record:connection_states(),
@@ -66,7 +77,8 @@ client_hello(Host, Port, Cookie, ConnectionStates,
CipherSuites = ssl_handshake:available_suites(UserSuites, TLSVersion),
Extensions = ssl_handshake:client_hello_extensions(TLSVersion, CipherSuites,
- SslOpts, ConnectionStates, Renegotiation),
+ SslOpts, ConnectionStates,
+ Renegotiation),
Id = ssl_session:client_id({Host, Port, SslOpts}, Cache, CacheCb, OwnCert),
#client_hello{session_id = Id,
@@ -87,11 +99,11 @@ hello(#server_hello{server_version = Version, random = Random,
case dtls_record:is_acceptable_version(Version, SupportedVersions) of
true ->
handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
- Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation);
+ Compression, HelloExt, SslOpt,
+ ConnectionStates0, Renegotiation);
false ->
?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)
end;
-
hello(#client_hello{client_version = ClientVersion} = Hello,
#ssl_options{versions = Versions} = SslOpts,
Info, Renegotiation) ->
@@ -107,7 +119,7 @@ cookie(Key, Address, Port, #client_hello{client_version = {Major, Minor},
<<?BYTE(Major), ?BYTE(Minor)>>,
Random, SessionId, CipherSuites, CompressionMethods],
crypto:hmac(sha, Key, CookieData).
-
+%%--------------------------------------------------------------------
-spec hello_verify_request(binary(), dtls_record:dtls_version()) -> #hello_verify_request{}.
%%
%% Description: Creates a hello verify request message sent by server to
@@ -117,11 +129,8 @@ hello_verify_request(Cookie, Version) ->
#hello_verify_request{protocol_version = Version, cookie = Cookie}.
%%--------------------------------------------------------------------
-
-encode_handshake(Handshake, Version, Seq) ->
- {MsgType, Bin} = enc_handshake(Handshake, Version),
- Len = byte_size(Bin),
- [MsgType, ?uint24(Len), ?uint16(Seq), ?uint24(0), ?uint24(Len), Bin].
+%%% Handshake encoding
+%%--------------------------------------------------------------------
fragment_handshake(Bin, _) when is_binary(Bin)->
%% This is the change_cipher_spec not a "real handshake" but part of the flight
@@ -129,10 +138,15 @@ fragment_handshake(Bin, _) when is_binary(Bin)->
fragment_handshake([MsgType, Len, Seq, _, Len, Bin], Size) ->
Bins = bin_fragments(Bin, Size),
handshake_fragments(MsgType, Seq, Len, Bins, []).
+encode_handshake(Handshake, Version, Seq) ->
+ {MsgType, Bin} = enc_handshake(Handshake, Version),
+ Len = byte_size(Bin),
+ [MsgType, ?uint24(Len), ?uint16(Seq), ?uint24(0), ?uint24(Len), Bin].
+
+%%--------------------------------------------------------------------
+%%% Handshake decodeing
+%%--------------------------------------------------------------------
-handshake_bin([Type, Length, Data], Seq) ->
- handshake_bin(Type, Length, Seq, Data).
-
%%--------------------------------------------------------------------
-spec get_dtls_handshake(dtls_record:dtls_version(), binary(), #protocol_buffers{}) ->
{[dtls_handshake()], #protocol_buffers{}}.
@@ -147,16 +161,19 @@ get_dtls_handshake(Version, Fragment, ProtocolBuffers) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-handle_client_hello(Version, #client_hello{session_id = SugesstedId,
- cipher_suites = CipherSuites,
- compression_methods = Compressions,
- random = Random,
- extensions =
- #hello_extensions{elliptic_curves = Curves,
- signature_algs = ClientHashSigns} = HelloExt},
+handle_client_hello(Version,
+ #client_hello{session_id = SugesstedId,
+ cipher_suites = CipherSuites,
+ compression_methods = Compressions,
+ random = Random,
+ extensions =
+ #hello_extensions{elliptic_curves = Curves,
+ signature_algs = ClientHashSigns}
+ = HelloExt},
#ssl_options{versions = Versions,
signature_algs = SupportedHashSigns} = SslOpts,
- {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) ->
+ {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _},
+ Renegotiation) ->
case dtls_record:is_acceptable_version(Version, Versions) of
true ->
TLSVersion = dtls_v1:corresponding_tls_version(Version),
@@ -164,7 +181,8 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId,
ClientHashSigns, SupportedHashSigns, Cert,TLSVersion),
ECCCurve = ssl_handshake:select_curve(Curves, ssl_handshake:supported_ecc(TLSVersion)),
{Type, #session{cipher_suite = CipherSuite} = Session1}
- = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions,
+ = ssl_handshake:select_session(SugesstedId, CipherSuites,
+ AvailableHashSigns, Compressions,
Port, Session0#session{ecc = ECCCurve}, TLSVersion,
SslOpts, Cache, CacheCb, Cert),
case CipherSuite of
@@ -190,7 +208,8 @@ handle_client_hello_extensions(Version, Type, Random, CipherSuites,
HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) ->
try ssl_handshake:handle_client_hello_extensions(dtls_record, Random, CipherSuites,
HelloExt, dtls_v1:corresponding_tls_version(Version),
- SslOpts, Session0, ConnectionStates0, Renegotiation) of
+ SslOpts, Session0,
+ ConnectionStates0, Renegotiation) of
#alert{} = Alert ->
Alert;
{Session, ConnectionStates, Protocol, ServerHelloExt} ->
@@ -212,7 +231,7 @@ handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
end.
-%%%%%%% Encodeing %%%%%%%%%%%%%
+%%--------------------------------------------------------------------
enc_handshake(#hello_verify_request{protocol_version = {Major, Minor},
cookie = Cookie}, _Version) ->
@@ -220,7 +239,6 @@ enc_handshake(#hello_verify_request{protocol_version = {Major, Minor},
{?HELLO_VERIFY_REQUEST, <<?BYTE(Major), ?BYTE(Minor),
?BYTE(CookieLength),
Cookie:CookieLength/binary>>};
-
enc_handshake(#hello_request{}, _Version) ->
{?HELLO_REQUEST, <<>>};
enc_handshake(#client_hello{client_version = {Major, Minor},
@@ -243,19 +261,29 @@ enc_handshake(#client_hello{client_version = {Major, Minor},
?BYTE(CookieLength), Cookie/binary,
?UINT16(CsLength), BinCipherSuites/binary,
?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>};
-
enc_handshake(#server_hello{} = HandshakeMsg, Version) ->
{Type, <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>} =
ssl_handshake:encode_handshake(HandshakeMsg, Version),
{DTLSMajor, DTLSMinor} = dtls_v1:corresponding_dtls_version({Major, Minor}),
{Type, <<?BYTE(DTLSMajor), ?BYTE(DTLSMinor), Rest/binary>>};
-
enc_handshake(HandshakeMsg, Version) ->
ssl_handshake:encode_handshake(HandshakeMsg, dtls_v1:corresponding_tls_version(Version)).
+handshake_bin(#handshake_fragment{
+ type = Type,
+ length = Len,
+ message_seq = Seq,
+ fragment_length = Len,
+ fragment_offset = 0,
+ fragment = Fragment}) ->
+ handshake_bin(Type, Len, Seq, Fragment).
+handshake_bin(Type, Length, Seq, FragmentData) ->
+ <<?BYTE(Type), ?UINT24(Length),
+ ?UINT16(Seq), ?UINT24(0), ?UINT24(Length),
+ FragmentData:Length/binary>>.
+
bin_fragments(Bin, Size) ->
bin_fragments(Bin, size(Bin), Size, 0, []).
-
bin_fragments(Bin, BinSize, FragSize, Offset, Fragments) ->
case (BinSize - Offset - FragSize) > 0 of
true ->
@@ -279,7 +307,7 @@ address_to_bin({A,B,C,D}, Port) ->
address_to_bin({A,B,C,D,E,F,G,H}, Port) ->
<<A:16,B:16,C:16,D:16,E:16,F:16,G:16,H:16,Port:16>>.
-%%%%%%% Decodeing %%%%%%%%%%%%%
+%%--------------------------------------------------------------------
handle_fragments(Version, FragmentData, Buffers0, Acc) ->
Fragments = decode_handshake_fragments(FragmentData),
@@ -322,7 +350,6 @@ decode_handshake(_Version, ?CLIENT_HELLO, <<?UINT24(_), ?UINT16(_),
compression_methods = Comp_methods,
extensions = DecodedExtensions
};
-
decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_),
?UINT24(_), ?UINT24(_),
?BYTE(Major), ?BYTE(Minor),
@@ -330,7 +357,6 @@ decode_handshake(_Version, ?HELLO_VERIFY_REQUEST, <<?UINT24(_), ?UINT16(_),
Cookie:CookieLength/binary>>) ->
#hello_verify_request{protocol_version = {Major, Minor},
cookie = Cookie};
-
decode_handshake(Version, Tag, <<?UINT24(_), ?UINT16(_),
?UINT24(_), ?UINT24(_), Msg/binary>>) ->
%% DTLS specifics stripped
@@ -370,9 +396,10 @@ reassemble(Version, #handshake_fragment{message_seq = Seq} = Fragment,
end;
reassemble(_, #handshake_fragment{message_seq = FragSeq} = Fragment,
#protocol_buffers{dtls_handshake_next_seq = Seq,
- dtls_handshake_later_fragments = LaterFragments} = Buffers0) when FragSeq > Seq->
- {more_data,
- Buffers0#protocol_buffers{dtls_handshake_later_fragments = [Fragment | LaterFragments]}};
+ dtls_handshake_later_fragments = LaterFragments}
+ = Buffers0) when FragSeq > Seq->
+ {more_data,
+ Buffers0#protocol_buffers{dtls_handshake_later_fragments = [Fragment | LaterFragments]}};
reassemble(_, _, Buffers) ->
%% Disregard fragments FragSeq < Seq
{more_data, Buffers}.
@@ -396,26 +423,6 @@ merge_fragment(Frag0, [Frag1 | Rest]) ->
Frag ->
merge_fragment(Frag, Rest)
end.
-
-is_complete_handshake(#handshake_fragment{length = Length, fragment_length = Length}) ->
- true;
-is_complete_handshake(_) ->
- false.
-
-next_fragments(LaterFragments) ->
- case lists:keysort(#handshake_fragment.message_seq, LaterFragments) of
- [] ->
- {[], []};
- [#handshake_fragment{message_seq = Seq} | _] = Fragments ->
- split_frags(Fragments, Seq, [])
- end.
-
-split_frags([#handshake_fragment{message_seq = Seq} = Frag | Rest], Seq, Acc) ->
- split_frags(Rest, Seq, [Frag | Acc]);
-split_frags(Frags, _, Acc) ->
- {lists:reverse(Acc), Frags}.
-
-
%% Duplicate
merge_fragments(#handshake_fragment{
fragment_offset = PreviousOffSet,
@@ -486,17 +493,26 @@ merge_fragments(#handshake_fragment{
%% No merge there is a gap
merge_fragments(Previous, Current) ->
[Previous, Current].
-
-handshake_bin(#handshake_fragment{
- type = Type,
- length = Len,
- message_seq = Seq,
- fragment_length = Len,
- fragment_offset = 0,
- fragment = Fragment}) ->
- handshake_bin(Type, Len, Seq, Fragment).
-handshake_bin(Type, Length, Seq, FragmentData) ->
- <<?BYTE(Type), ?UINT24(Length),
- ?UINT16(Seq), ?UINT24(0), ?UINT24(Length),
- FragmentData:Length/binary>>.
+next_fragments(LaterFragments) ->
+ case lists:keysort(#handshake_fragment.message_seq, LaterFragments) of
+ [] ->
+ {[], []};
+ [#handshake_fragment{message_seq = Seq} | _] = Fragments ->
+ split_frags(Fragments, Seq, [])
+ end.
+
+split_frags([#handshake_fragment{message_seq = Seq} = Frag | Rest], Seq, Acc) ->
+ split_frags(Rest, Seq, [Frag | Acc]);
+split_frags(Frags, _, Acc) ->
+ {lists:reverse(Acc), Frags}.
+
+is_complete_handshake(#handshake_fragment{length = Length, fragment_length = Length}) ->
+ true;
+is_complete_handshake(_) ->
+ false.
+
+
+
+
+
diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl
index a8520717e5..2dcc6efc91 100644
--- a/lib/ssl/src/dtls_record.erl
+++ b/lib/ssl/src/dtls_record.erl
@@ -32,13 +32,15 @@
%% Handling of incoming data
-export([get_dtls_records/2, init_connection_states/2, empty_connection_state/1]).
-%% Decoding
--export([decode_cipher_text/2]).
+-export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2,
+ init_connection_state_seq/2, current_connection_state_epoch/2]).
%% Encoding
-export([encode_handshake/4, encode_alert_record/3,
- encode_change_cipher_spec/3, encode_data/3]).
--export([encode_plain_text/5]).
+ encode_change_cipher_spec/3, encode_data/3, encode_plain_text/5]).
+
+%% Decoding
+-export([decode_cipher_text/2]).
%% Protocol version handling
-export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2,
@@ -46,9 +48,6 @@
is_higher/2, supported_protocol_versions/0,
is_acceptable_version/2, hello_version/2]).
--export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2]).
-
--export([init_connection_state_seq/2, current_connection_state_epoch/2]).
-export_type([dtls_version/0, dtls_atom_version/0]).
@@ -60,7 +59,7 @@
-compile(inline).
%%====================================================================
-%% Internal application API
+%% Handling of incoming data
%%====================================================================
%%--------------------------------------------------------------------
-spec init_connection_states(client | server, one_n_minus_one | zero_n | disabled) ->
@@ -86,7 +85,6 @@ init_connection_states(Role, BeastMitigation) ->
empty_connection_state(Empty) ->
Empty#{epoch => undefined, replay_window => init_replay_window(?REPLAY_WINDOW_SIZE)}.
-
%%--------------------------------------------------------------------
-spec save_current_connection_state(ssl_record:connection_states(), read | write) ->
ssl_record:connection_states().
@@ -137,6 +135,34 @@ set_connection_state_by_epoch(ReadState, Epoch, #{saved_read := #{epoch := Epoch
States#{saved_read := ReadState}.
%%--------------------------------------------------------------------
+-spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) ->
+ ssl_record:connection_state().
+%%
+%% Description: Copy the read sequence number to the write sequence number
+%% This is only valid for DTLS in the first client_hello
+%%--------------------------------------------------------------------
+init_connection_state_seq({254, _},
+ #{current_read := #{epoch := 0, sequence_number := Seq},
+ current_write := #{epoch := 0} = Write} = ConnnectionStates0) ->
+ ConnnectionStates0#{current_write => Write#{sequence_number => Seq}};
+init_connection_state_seq(_, ConnnectionStates) ->
+ ConnnectionStates.
+
+%%--------------------------------------------------------
+-spec current_connection_state_epoch(ssl_record:connection_states(), read | write) ->
+ integer().
+%%
+%% Description: Returns the epoch the connection_state record
+%% that is currently defined as the current connection state.
+%%--------------------------------------------------------------------
+current_connection_state_epoch(#{current_read := #{epoch := Epoch}},
+ read) ->
+ Epoch;
+current_connection_state_epoch(#{current_write := #{epoch := Epoch}},
+ write) ->
+ Epoch.
+
+%%--------------------------------------------------------------------
-spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}.
%%
%% Description: Given old buffer and new data from UDP/SCTP, packs up a records
@@ -148,55 +174,10 @@ get_dtls_records(Data, <<>>) ->
get_dtls_records(Data, Buffer) ->
get_dtls_records_aux(list_to_binary([Buffer, Data]), []).
-get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length), Data:Length/binary, Rest/binary>>,
- Acc) ->
- get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA,
- version = {MajVer, MinVer},
- epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
-get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length),
- Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 ->
- get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE,
- version = {MajVer, MinVer},
- epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
-get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length), Data:Length/binary,
- Rest/binary>>, Acc) ->
- get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT,
- version = {MajVer, MinVer},
- epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
-get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer),
- ?UINT16(Epoch), ?UINT48(SequenceNumber),
- ?UINT16(Length), Data:Length/binary, Rest/binary>>,
- Acc) ->
- get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
- version = {MajVer, MinVer},
- epoch = Epoch, sequence_number = SequenceNumber,
- fragment = Data} | Acc]);
-get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer),
- ?UINT16(Length), _/binary>>,
- _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
- ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-
-get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc)
- when Length0 > ?MAX_CIPHER_TEXT_LENGTH ->
- ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
-
-get_dtls_records_aux(Data, Acc) ->
- case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of
- true ->
- {lists:reverse(Acc), Data};
- false ->
- ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE)
- end.
+%%====================================================================
+%% Encoding DTLS records
+%%====================================================================
%%--------------------------------------------------------------------
-spec encode_handshake(iolist(), dtls_version(), integer(), ssl_record:connection_states()) ->
@@ -245,11 +226,19 @@ encode_plain_text(Type, Version, Epoch, Data, ConnectionStates) ->
{CipherText, Write} = encode_dtls_cipher_text(Type, Version, CipherFragment, Write1),
{CipherText, set_connection_state_by_epoch(Write, Epoch, ConnectionStates, write)}.
+%%====================================================================
+%% Decoding
+%%====================================================================
decode_cipher_text(#ssl_tls{epoch = Epoch} = CipherText, ConnnectionStates0) ->
ReadState = get_connection_state_by_epoch(Epoch, ConnnectionStates0, read),
decode_cipher_text(CipherText, ReadState, ConnnectionStates0).
+
+%%====================================================================
+%% Protocol version handling
+%%====================================================================
+
%%--------------------------------------------------------------------
-spec protocol_version(dtls_atom_version() | dtls_version()) ->
dtls_version() | dtls_atom_version().
@@ -381,35 +370,6 @@ supported_protocol_versions([_|_] = Vsns) ->
is_acceptable_version(Version, Versions) ->
lists:member(Version, Versions).
-
-%%--------------------------------------------------------------------
--spec init_connection_state_seq(dtls_version(), ssl_record:connection_states()) ->
- ssl_record:connection_state().
-%%
-%% Description: Copy the read sequence number to the write sequence number
-%% This is only valid for DTLS in the first client_hello
-%%--------------------------------------------------------------------
-init_connection_state_seq({254, _},
- #{current_read := #{epoch := 0, sequence_number := Seq},
- current_write := #{epoch := 0} = Write} = ConnnectionStates0) ->
- ConnnectionStates0#{current_write => Write#{sequence_number => Seq}};
-init_connection_state_seq(_, ConnnectionStates) ->
- ConnnectionStates.
-
-%%--------------------------------------------------------
--spec current_connection_state_epoch(ssl_record:connection_states(), read | write) ->
- integer().
-%%
-%% Description: Returns the epoch the connection_state record
-%% that is currently defined as the current connection state.
-%%--------------------------------------------------------------------
-current_connection_state_epoch(#{current_read := #{epoch := Epoch}},
- read) ->
- Epoch;
-current_connection_state_epoch(#{current_write := #{epoch := Epoch}},
- write) ->
- Epoch.
-
-spec hello_version(dtls_version(), [dtls_version()]) -> dtls_version().
hello_version(Version, Versions) ->
case dtls_v1:corresponding_tls_version(Version) of
@@ -438,15 +398,93 @@ initial_connection_state(ConnectionEnd, BeastMitigation) ->
server_verify_data => undefined
}.
-lowest_list_protocol_version(Ver, []) ->
- Ver;
-lowest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
- lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest).
+get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer),
+ ?UINT16(Epoch), ?UINT48(SequenceNumber),
+ ?UINT16(Length), Data:Length/binary, Rest/binary>>,
+ Acc) ->
+ get_dtls_records_aux(Rest, [#ssl_tls{type = ?APPLICATION_DATA,
+ version = {MajVer, MinVer},
+ epoch = Epoch, sequence_number = SequenceNumber,
+ fragment = Data} | Acc]);
+get_dtls_records_aux(<<?BYTE(?HANDSHAKE),?BYTE(MajVer),?BYTE(MinVer),
+ ?UINT16(Epoch), ?UINT48(SequenceNumber),
+ ?UINT16(Length),
+ Data:Length/binary, Rest/binary>>, Acc) when MajVer >= 128 ->
+ get_dtls_records_aux(Rest, [#ssl_tls{type = ?HANDSHAKE,
+ version = {MajVer, MinVer},
+ epoch = Epoch, sequence_number = SequenceNumber,
+ fragment = Data} | Acc]);
+get_dtls_records_aux(<<?BYTE(?ALERT),?BYTE(MajVer),?BYTE(MinVer),
+ ?UINT16(Epoch), ?UINT48(SequenceNumber),
+ ?UINT16(Length), Data:Length/binary,
+ Rest/binary>>, Acc) ->
+ get_dtls_records_aux(Rest, [#ssl_tls{type = ?ALERT,
+ version = {MajVer, MinVer},
+ epoch = Epoch, sequence_number = SequenceNumber,
+ fragment = Data} | Acc]);
+get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer),
+ ?UINT16(Epoch), ?UINT48(SequenceNumber),
+ ?UINT16(Length), Data:Length/binary, Rest/binary>>,
+ Acc) ->
+ get_dtls_records_aux(Rest, [#ssl_tls{type = ?CHANGE_CIPHER_SPEC,
+ version = {MajVer, MinVer},
+ epoch = Epoch, sequence_number = SequenceNumber,
+ fragment = Data} | Acc]);
-highest_list_protocol_version(Ver, []) ->
- Ver;
-highest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
- highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest).
+get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer),
+ ?UINT16(Length), _/binary>>,
+ _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH ->
+ ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
+
+get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc)
+ when Length0 > ?MAX_CIPHER_TEXT_LENGTH ->
+ ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW);
+
+get_dtls_records_aux(Data, Acc) ->
+ case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of
+ true ->
+ {lists:reverse(Acc), Data};
+ false ->
+ ?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE)
+ end.
+%%--------------------------------------------------------------------
+
+init_replay_window(Size) ->
+ #{size => Size,
+ top => Size,
+ bottom => 0,
+ mask => 0 bsl 64
+ }.
+
+replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) ->
+ is_replay(SequenceNumber, Window).
+
+
+is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom ->
+ true;
+is_replay(SequenceNumber, #{size := Size,
+ top := Top,
+ bottom := Bottom,
+ mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) ->
+ Index = (SequenceNumber rem Size),
+ (Index band Mask) == 1;
+
+is_replay(_, _) ->
+ false.
+
+update_replay_window(SequenceNumber, #{replay_window := #{size := Size,
+ top := Top,
+ bottom := Bottom,
+ mask := Mask0} = Window0} = ConnectionStates) ->
+ NoNewBits = SequenceNumber - Top,
+ Index = SequenceNumber rem Size,
+ Mask = (Mask0 bsl NoNewBits) bor Index,
+ Window = Window0#{top => SequenceNumber,
+ bottom => Bottom + NoNewBits,
+ mask => Mask},
+ ConnectionStates#{replay_window := Window}.
+
+%%--------------------------------------------------------------------
encode_dtls_cipher_text(Type, {MajVer, MinVer}, Fragment,
#{epoch := Epoch, sequence_number := Seq} = WriteState) ->
@@ -490,6 +528,7 @@ encode_plain_text(Type, Version, Fragment, #{compression_state := CompS0,
ssl_cipher:cipher(BulkCipherAlgo, CipherS0, MAC, Fragment, TLSVersion),
{CipherFragment, WriteState0#{cipher_state => CipherS1}}.
+%%--------------------------------------------------------------------
decode_cipher_text(#ssl_tls{type = Type, version = Version,
epoch = Epoch,
sequence_number = Seq,
@@ -541,6 +580,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version,
false ->
?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
end.
+%%--------------------------------------------------------------------
calc_mac_hash(Type, Version, #{mac_secret := MacSecret,
security_parameters := #security_parameters{mac_algorithm = MacAlg}},
@@ -549,16 +589,6 @@ calc_mac_hash(Type, Version, #{mac_secret := MacSecret,
mac_hash(Version, MacAlg, MacSecret, Epoch, SeqNo, Type,
Length, Fragment).
-highest_protocol_version() ->
- highest_protocol_version(supported_protocol_versions()).
-
-lowest_protocol_version() ->
- lowest_protocol_version(supported_protocol_versions()).
-
-sufficient_dtlsv1_2_crypto_support() ->
- CryptoSupport = crypto:supports(),
- proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)).
-
mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment) ->
Value = [<<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type),
?BYTE(Major), ?BYTE(Minor), ?UINT16(Length)>>,
@@ -568,37 +598,25 @@ mac_hash({Major, Minor}, MacAlg, MacSecret, Epoch, SeqNo, Type, Length, Fragment
calc_aad(Type, {MajVer, MinVer}, Epoch, SeqNo) ->
<<?UINT16(Epoch), ?UINT48(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
-init_replay_window(Size) ->
- #{size => Size,
- top => Size,
- bottom => 0,
- mask => 0 bsl 64
- }.
+%%--------------------------------------------------------------------
-replay_detect(#ssl_tls{sequence_number = SequenceNumber}, #{replay_window := Window}) ->
- is_replay(SequenceNumber, Window).
+lowest_list_protocol_version(Ver, []) ->
+ Ver;
+lowest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
+ lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest).
+highest_list_protocol_version(Ver, []) ->
+ Ver;
+highest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
+ highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest).
-is_replay(SequenceNumber, #{bottom := Bottom}) when SequenceNumber < Bottom ->
- true;
-is_replay(SequenceNumber, #{size := Size,
- top := Top,
- bottom := Bottom,
- mask := Mask}) when (SequenceNumber >= Bottom) andalso (SequenceNumber =< Top) ->
- Index = (SequenceNumber rem Size),
- (Index band Mask) == 1;
+highest_protocol_version() ->
+ highest_protocol_version(supported_protocol_versions()).
-is_replay(_, _) ->
- false.
+lowest_protocol_version() ->
+ lowest_protocol_version(supported_protocol_versions()).
+
+sufficient_dtlsv1_2_crypto_support() ->
+ CryptoSupport = crypto:supports(),
+ proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)).
-update_replay_window(SequenceNumber, #{replay_window := #{size := Size,
- top := Top,
- bottom := Bottom,
- mask := Mask0} = Window0} = ConnectionStates) ->
- NoNewBits = SequenceNumber - Top,
- Index = SequenceNumber rem Size,
- Mask = (Mask0 bsl NoNewBits) bor Index,
- Window = Window0#{top => SequenceNumber,
- bottom => Bottom + NoNewBits,
- mask => Mask},
- ConnectionStates#{replay_window := Window}.
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index 2146a9272e..3531cdda11 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -44,31 +44,31 @@
-export([send/2, recv/3, close/2, shutdown/2,
new_user/2, get_opts/2, set_opts/2,
peer_certificate/1, renegotiation/1, negotiated_protocol/1, prf/5,
- connection_information/2, handle_common_event/5
+ connection_information/2
]).
-%% General gen_statem state functions with extra callback argument
-%% to determine if it is an SSL/TLS or DTLS gen_statem machine
--export([init/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]).
-
-%% gen_statem callbacks
--export([terminate/3, format_status/2]).
-
-%%
--export([handle_info/3, handle_call/5, handle_session/7, ssl_config/3,
- prepare_connection/2, hibernate_after/3]).
-
%% Alert and close handling
--export([handle_own_alert/4,handle_alert/3,
+-export([handle_own_alert/4, handle_alert/3,
handle_normal_shutdown/3
]).
%% Data handling
-export([write_application_data/3, read_application_data/2]).
+%% Help functions for tls|dtls_connection.erl
+-export([handle_session/7, ssl_config/3,
+ prepare_connection/2, hibernate_after/3]).
+
+%% General gen_statem state functions with extra callback argument
+%% to determine if it is an SSL/TLS or DTLS gen_statem machine
+-export([init/4, error/4, hello/4, abbreviated/4, certify/4, cipher/4, connection/4, downgrade/4]).
+
+%% gen_statem callbacks
+-export([terminate/3, format_status/2]).
+
+%%====================================================================
+%% Setup
%%====================================================================
-%% Internal application API
-%%====================================================================
%%--------------------------------------------------------------------
-spec connect(tls_connection | dtls_connection,
host(), inet:port_number(),
@@ -164,6 +164,16 @@ socket_control(dtls_connection = Connection, {_, Socket}, Pid, Transport, Listen
{error, Reason} ->
{error, Reason}
end.
+
+start_or_recv_cancel_timer(infinity, _RecvFrom) ->
+ undefined;
+start_or_recv_cancel_timer(Timeout, RecvFrom) ->
+ erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}).
+
+%%====================================================================
+%% User events
+%%====================================================================
+
%%--------------------------------------------------------------------
-spec send(pid(), iodata()) -> ok | {error, reason()}.
%%
@@ -272,6 +282,161 @@ renegotiation(ConnectionPid) ->
prf(ConnectionPid, Secret, Label, Seed, WantedLength) ->
call(ConnectionPid, {prf, Secret, Label, Seed, WantedLength}).
+%%====================================================================
+%% Alert and close handling
+%%====================================================================
+handle_own_alert(Alert, Version, StateName,
+ #state{role = Role,
+ transport_cb = Transport,
+ socket = Socket,
+ protocol_cb = Connection,
+ connection_states = ConnectionStates,
+ ssl_options = SslOpts} = State) ->
+ try %% Try to tell the other side
+ {BinMsg, _} =
+ Connection:encode_alert(Alert, Version, ConnectionStates),
+ Connection:send(Transport, Socket, BinMsg)
+ catch _:_ -> %% Can crash if we are in a uninitialized state
+ ignore
+ end,
+ try %% Try to tell the local user
+ log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}),
+ handle_normal_shutdown(Alert,StateName, State)
+ catch _:_ ->
+ ok
+ end,
+ {stop, {shutdown, own_alert}}.
+
+handle_normal_shutdown(Alert, _, #state{socket = Socket,
+ transport_cb = Transport,
+ protocol_cb = Connection,
+ start_or_recv_from = StartFrom,
+ tracker = Tracker,
+ role = Role, renegotiation = {false, first}}) ->
+ alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role, Connection);
+
+handle_normal_shutdown(Alert, StateName, #state{socket = Socket,
+ socket_options = Opts,
+ transport_cb = Transport,
+ protocol_cb = Connection,
+ user_application = {_Mon, Pid},
+ tracker = Tracker,
+ start_or_recv_from = RecvFrom, role = Role}) ->
+ alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection).
+
+handle_alert(#alert{level = ?FATAL} = Alert, StateName,
+ #state{socket = Socket, transport_cb = Transport,
+ protocol_cb = Connection,
+ ssl_options = SslOpts, start_or_recv_from = From, host = Host,
+ port = Port, session = Session, user_application = {_Mon, Pid},
+ role = Role, socket_options = Opts, tracker = Tracker}) ->
+ invalidate_session(Role, Host, Port, Session),
+ log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(),
+ StateName, Alert#alert{role = opposite_role(Role)}),
+ alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
+ {stop, normal};
+
+handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
+ StateName, State) ->
+ handle_normal_shutdown(Alert, StateName, State),
+ {stop, {shutdown, peer_close}};
+
+handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
+ #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) ->
+ log_alert(SslOpts#ssl_options.log_alert, Role,
+ Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
+ handle_normal_shutdown(Alert, StateName, State),
+ {stop, {shutdown, peer_close}};
+
+handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
+ #state{role = Role,
+ ssl_options = SslOpts, renegotiation = {true, From},
+ protocol_cb = Connection} = State0) ->
+ log_alert(SslOpts#ssl_options.log_alert, Role,
+ Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
+ gen_statem:reply(From, {error, renegotiation_rejected}),
+ {Record, State1} = Connection:next_record(State0),
+ %% Go back to connection!
+ State = Connection:reinit_handshake_data(State1#state{renegotiation = undefined}),
+ Connection:next_event(connection, Record, State);
+
+%% Gracefully log and ignore all other warning alerts
+handle_alert(#alert{level = ?WARNING} = Alert, StateName,
+ #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) ->
+ log_alert(SslOpts#ssl_options.log_alert, Role,
+ Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
+ {Record, State} = Connection:next_record(State0),
+ Connection:next_event(StateName, Record, State).
+
+%%====================================================================
+%% Data handling
+%%====================================================================
+write_application_data(Data0, From,
+ #state{socket = Socket,
+ negotiated_version = Version,
+ protocol_cb = Connection,
+ transport_cb = Transport,
+ connection_states = ConnectionStates0,
+ socket_options = SockOpts,
+ ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) ->
+ Data = encode_packet(Data0, SockOpts),
+
+ case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of
+ true ->
+ Connection:renegotiate(State#state{renegotiation = {true, internal}},
+ [{next_event, {call, From}, {application_data, Data0}}]);
+ false ->
+ {Msgs, ConnectionStates} = Connection:encode_data(Data, Version, ConnectionStates0),
+ Result = Connection:send(Transport, Socket, Msgs),
+ ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates},
+ [{reply, From, Result}])
+ end.
+
+read_application_data(Data, #state{user_application = {_Mon, Pid},
+ socket = Socket,
+ protocol_cb = Connection,
+ transport_cb = Transport,
+ socket_options = SOpts,
+ bytes_to_read = BytesToRead,
+ start_or_recv_from = RecvFrom,
+ timer = Timer,
+ user_data_buffer = Buffer0,
+ tracker = Tracker} = State0) ->
+ Buffer1 = if
+ Buffer0 =:= <<>> -> Data;
+ Data =:= <<>> -> Buffer0;
+ true -> <<Buffer0/binary, Data/binary>>
+ end,
+ case get_data(SOpts, BytesToRead, Buffer1) of
+ {ok, ClientData, Buffer} -> % Send data
+ SocketOpt = deliver_app_data(Transport, Socket, SOpts,
+ ClientData, Pid, RecvFrom, Tracker, Connection),
+ cancel_timer(Timer),
+ State = State0#state{user_data_buffer = Buffer,
+ start_or_recv_from = undefined,
+ timer = undefined,
+ bytes_to_read = undefined,
+ socket_options = SocketOpt
+ },
+ if
+ SocketOpt#socket_options.active =:= false; Buffer =:= <<>> ->
+ %% Passive mode, wait for active once or recv
+ %% Active and empty, get more data
+ Connection:next_record_if_active(State);
+ true -> %% We have more data
+ read_application_data(<<>>, State)
+ end;
+ {more, Buffer} -> % no reply, we need more data
+ Connection:next_record(State0#state{user_data_buffer = Buffer});
+ {passive, Buffer} ->
+ Connection:next_record_if_active(State0#state{user_data_buffer = Buffer});
+ {error,_Reason} -> %% Invalid packet in packet mode
+ deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection),
+ {stop, normal, State0}
+ end.
+%%====================================================================
+%% Help functions for tls|dtls_connection.erl
+%%====================================================================
%%--------------------------------------------------------------------
-spec handle_session(#server_hello{}, ssl_record:ssl_version(),
binary(), ssl_record:connection_states(), _,_, #state{}) ->
@@ -340,7 +505,7 @@ ssl_config(Opts, Role, State) ->
ssl_options = Opts}.
%%====================================================================
-%% gen_statem state functions
+%% gen_statem general state functions with connection cb argument
%%====================================================================
%%--------------------------------------------------------------------
-spec init(gen_statem:event_type(),
@@ -371,6 +536,15 @@ init(_Type, _Event, _State, _Connection) ->
{keep_state_and_data, [postpone]}.
%%--------------------------------------------------------------------
+-spec error(gen_statem:event_type(),
+ {start, timeout()} | term(), #state{},
+ tls_connection | dtls_connection) ->
+ gen_statem:state_function_result().
+%%--------------------------------------------------------------------
+error({call, From}, Msg, State, Connection) ->
+ handle_call(Msg, From, ?FUNCTION_NAME, State, Connection).
+
+%%--------------------------------------------------------------------
-spec hello(gen_statem:event_type(),
#hello_request{} | #server_hello{} | term(),
#state{}, tls_connection | dtls_connection) ->
@@ -393,7 +567,6 @@ hello(Type, Msg, State, Connection) ->
%%--------------------------------------------------------------------
abbreviated({call, From}, Msg, State, Connection) ->
handle_call(Msg, From, ?FUNCTION_NAME, State, Connection);
-
abbreviated(internal, #finished{verify_data = Data} = Finished,
#state{role = server,
negotiated_version = Version,
@@ -414,7 +587,6 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
-
abbreviated(internal, #finished{verify_data = Data} = Finished,
#state{role = client, tls_handshake_history = Handshake0,
session = #session{master_secret = MasterSecret},
@@ -434,7 +606,6 @@ abbreviated(internal, #finished{verify_data = Data} = Finished,
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
-
%% only allowed to send next_protocol message after change cipher spec
%% & before finished message and it is not allowed during renegotiation
abbreviated(internal, #next_protocol{selected_protocol = SelectedProtocol},
@@ -475,7 +646,6 @@ certify(internal, #certificate{asn1_certificates = []},
State, _) ->
Alert = ?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE),
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State);
-
certify(internal, #certificate{asn1_certificates = []},
#state{role = server,
ssl_options = #ssl_options{verify = verify_peer,
@@ -484,7 +654,6 @@ certify(internal, #certificate{asn1_certificates = []},
{Record, State} =
Connection:next_record(State0#state{client_certificate_requested = false}),
Connection:next_event(?FUNCTION_NAME, Record, State);
-
certify(internal, #certificate{},
#state{role = server,
negotiated_version = Version,
@@ -492,7 +661,6 @@ certify(internal, #certificate{},
State, _) ->
Alert = ?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE, unrequested_certificate),
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State);
-
certify(internal, #certificate{} = Cert,
#state{negotiated_version = Version,
role = Role,
@@ -509,7 +677,6 @@ certify(internal, #certificate{} = Cert,
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State)
end;
-
certify(internal, #server_key_exchange{exchange_keys = Keys},
#state{role = client, negotiated_version = Version,
key_algorithm = Alg,
@@ -542,7 +709,6 @@ certify(internal, #server_key_exchange{exchange_keys = Keys},
Version, ?FUNCTION_NAME, State)
end
end;
-
certify(internal, #certificate_request{} = CertRequest,
#state{session = #session{own_certificate = Cert},
role = client,
@@ -556,7 +722,6 @@ certify(internal, #certificate_request{} = CertRequest,
Connection:next_event(?FUNCTION_NAME, Record,
State#state{cert_hashsign_algorithm = NegotiatedHashSign})
end;
-
%% PSK and RSA_PSK might bypass the Server-Key-Exchange
certify(internal, #server_hello_done{},
#state{session = #session{master_secret = undefined},
@@ -575,7 +740,6 @@ certify(internal, #server_hello_done{},
State0#state{premaster_secret = PremasterSecret}),
client_certify_and_key_exchange(State, Connection)
end;
-
certify(internal, #server_hello_done{},
#state{session = #session{master_secret = undefined},
ssl_options = #ssl_options{user_lookup_fun = PSKLookup},
@@ -596,7 +760,6 @@ certify(internal, #server_hello_done{},
State0#state{premaster_secret = RSAPremasterSecret}),
client_certify_and_key_exchange(State, Connection)
end;
-
%% Master secret was determined with help of server-key exchange msg
certify(internal, #server_hello_done{},
#state{session = #session{master_secret = MasterSecret} = Session,
@@ -612,7 +775,6 @@ certify(internal, #server_hello_done{},
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
-
%% Master secret is calculated from premaster_secret
certify(internal, #server_hello_done{},
#state{session = Session0,
@@ -630,7 +792,6 @@ certify(internal, #server_hello_done{},
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
-
certify(internal = Type, #client_key_exchange{} = Msg,
#state{role = server,
client_certificate_requested = true,
@@ -638,7 +799,6 @@ certify(internal = Type, #client_key_exchange{} = Msg,
Connection) ->
%% We expect a certificate here
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection);
-
certify(internal, #client_key_exchange{exchange_keys = Keys},
State = #state{key_algorithm = KeyAlg, negotiated_version = Version}, Connection) ->
try
@@ -648,7 +808,6 @@ certify(internal, #client_key_exchange{exchange_keys = Keys},
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State)
end;
-
certify(Type, Msg, State, Connection) ->
handle_common_event(Type, Msg, ?FUNCTION_NAME, State, Connection).
@@ -660,10 +819,8 @@ certify(Type, Msg, State, Connection) ->
%%--------------------------------------------------------------------
cipher({call, From}, Msg, State, Connection) ->
handle_call(Msg, From, ?FUNCTION_NAME, State, Connection);
-
cipher(info, Msg, State, _) ->
handle_info(Msg, ?FUNCTION_NAME, State);
-
cipher(internal, #certificate_verify{signature = Signature,
hashsign_algorithm = CertHashSign},
#state{role = server,
@@ -686,14 +843,12 @@ cipher(internal, #certificate_verify{signature = Signature,
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State0)
end;
-
%% client must send a next protocol message if we are expecting it
cipher(internal, #finished{},
#state{role = server, expecting_next_protocol_negotiation = true,
negotiated_protocol = undefined, negotiated_version = Version} = State0,
_Connection) ->
handle_own_alert(?ALERT_REC(?FATAL,?UNEXPECTED_MESSAGE), Version, ?FUNCTION_NAME, State0);
-
cipher(internal, #finished{verify_data = Data} = Finished,
#state{negotiated_version = Version,
host = Host,
@@ -716,7 +871,6 @@ cipher(internal, #finished{verify_data = Data} = Finished,
#alert{} = Alert ->
handle_own_alert(Alert, Version, ?FUNCTION_NAME, State)
end;
-
%% only allowed to send next_protocol message after change cipher spec
%% & before finished message and it is not allowed during renegotiation
cipher(internal, #next_protocol{selected_protocol = SelectedProtocol},
@@ -958,25 +1112,21 @@ handle_info({ErrorTag, Socket, econnaborted}, StateName,
alert_user(Transport, Tracker,Socket,
StartFrom, ?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), Role, Connection),
{stop, normal, State};
-
handle_info({ErrorTag, Socket, Reason}, StateName, #state{socket = Socket,
error_tag = ErrorTag} = State) ->
Report = io_lib:format("SSL: Socket error: ~p ~n", [Reason]),
error_logger:info_report(Report),
handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
{stop, normal, State};
-
handle_info({'DOWN', MonitorRef, _, _, _}, _,
State = #state{user_application={MonitorRef,_Pid}}) ->
{stop, normal, State};
-
%%% So that terminate will be run when supervisor issues shutdown
handle_info({'EXIT', _Sup, shutdown}, _StateName, State) ->
{stop, shutdown, State};
handle_info({'EXIT', Socket, normal}, _StateName, #state{socket = Socket} = State) ->
%% Handle as transport close"
{stop, {shutdown, transport_closed}, State};
-
handle_info(allow_renegotiate, StateName, State) ->
{next_state, StateName, State#state{allow_renegotiate = true}};
@@ -984,13 +1134,11 @@ handle_info({cancel_start_or_recv, StartFrom}, StateName,
#state{renegotiation = {false, first}} = State) when StateName =/= connection ->
{stop_and_reply, {shutdown, user_timeout},
{reply, StartFrom, {error, timeout}}, State#state{timer = undefined}};
-
handle_info({cancel_start_or_recv, RecvFrom}, StateName,
#state{start_or_recv_from = RecvFrom} = State) when RecvFrom =/= undefined ->
{next_state, StateName, State#state{start_or_recv_from = undefined,
bytes_to_read = undefined,
timer = undefined}, [{reply, RecvFrom, {error, timeout}}]};
-
handle_info({cancel_start_or_recv, _RecvFrom}, StateName, State) ->
{next_state, StateName, State#state{timer = undefined}};
@@ -999,9 +1147,9 @@ handle_info(Msg, StateName, #state{socket = Socket, error_tag = Tag} = State) ->
error_logger:info_report(Report),
{next_state, StateName, State}.
-%%--------------------------------------------------------------------
-%% gen_statem callbacks
-%%--------------------------------------------------------------------
+%%====================================================================
+%% general gen_statem callbacks
+%%====================================================================
terminate(_, _, #state{terminated = true}) ->
%% Happens when user closes the connection using ssl:close/1
%% we want to guarantee that Transport:close has been called
@@ -1010,7 +1158,6 @@ terminate(_, _, #state{terminated = true}) ->
%% returning. In both cases terminate has been run manually
%% before run by gen_statem which will end up here
ok;
-
terminate({shutdown, transport_closed} = Reason,
_StateName, #state{protocol_cb = Connection,
socket = Socket, transport_cb = Transport} = State) ->
@@ -1037,7 +1184,6 @@ terminate(Reason, connection, #state{negotiated_version = Version,
{BinAlert, ConnectionStates} = terminate_alert(Reason, Version, ConnectionStates0, Connection),
Connection:send(Transport, Socket, BinAlert),
Connection:close(Reason, Socket, Transport, ConnectionStates, Check);
-
terminate(Reason, _StateName, #state{transport_cb = Transport, protocol_cb = Connection,
socket = Socket
} = State) ->
@@ -1071,119 +1217,6 @@ format_status(terminate, [_, StateName, State]) ->
}}]}].
%%--------------------------------------------------------------------
-%%%
-%%--------------------------------------------------------------------
-write_application_data(Data0, From,
- #state{socket = Socket,
- negotiated_version = Version,
- protocol_cb = Connection,
- transport_cb = Transport,
- connection_states = ConnectionStates0,
- socket_options = SockOpts,
- ssl_options = #ssl_options{renegotiate_at = RenegotiateAt}} = State) ->
- Data = encode_packet(Data0, SockOpts),
-
- case time_to_renegotiate(Data, ConnectionStates0, RenegotiateAt) of
- true ->
- Connection:renegotiate(State#state{renegotiation = {true, internal}},
- [{next_event, {call, From}, {application_data, Data0}}]);
- false ->
- {Msgs, ConnectionStates} = Connection:encode_data(Data, Version, ConnectionStates0),
- Result = Connection:send(Transport, Socket, Msgs),
- ssl_connection:hibernate_after(connection, State#state{connection_states = ConnectionStates},
- [{reply, From, Result}])
- end.
-
-read_application_data(Data, #state{user_application = {_Mon, Pid},
- socket = Socket,
- protocol_cb = Connection,
- transport_cb = Transport,
- socket_options = SOpts,
- bytes_to_read = BytesToRead,
- start_or_recv_from = RecvFrom,
- timer = Timer,
- user_data_buffer = Buffer0,
- tracker = Tracker} = State0) ->
- Buffer1 = if
- Buffer0 =:= <<>> -> Data;
- Data =:= <<>> -> Buffer0;
- true -> <<Buffer0/binary, Data/binary>>
- end,
- case get_data(SOpts, BytesToRead, Buffer1) of
- {ok, ClientData, Buffer} -> % Send data
- SocketOpt = deliver_app_data(Transport, Socket, SOpts,
- ClientData, Pid, RecvFrom, Tracker, Connection),
- cancel_timer(Timer),
- State = State0#state{user_data_buffer = Buffer,
- start_or_recv_from = undefined,
- timer = undefined,
- bytes_to_read = undefined,
- socket_options = SocketOpt
- },
- if
- SocketOpt#socket_options.active =:= false; Buffer =:= <<>> ->
- %% Passive mode, wait for active once or recv
- %% Active and empty, get more data
- Connection:next_record_if_active(State);
- true -> %% We have more data
- read_application_data(<<>>, State)
- end;
- {more, Buffer} -> % no reply, we need more data
- Connection:next_record(State0#state{user_data_buffer = Buffer});
- {passive, Buffer} ->
- Connection:next_record_if_active(State0#state{user_data_buffer = Buffer});
- {error,_Reason} -> %% Invalid packet in packet mode
- deliver_packet_error(Transport, Socket, SOpts, Buffer1, Pid, RecvFrom, Tracker, Connection),
- {stop, normal, State0}
- end.
-%%--------------------------------------------------------------------
-%%%
-%%--------------------------------------------------------------------
-handle_alert(#alert{level = ?FATAL} = Alert, StateName,
- #state{socket = Socket, transport_cb = Transport,
- protocol_cb = Connection,
- ssl_options = SslOpts, start_or_recv_from = From, host = Host,
- port = Port, session = Session, user_application = {_Mon, Pid},
- role = Role, socket_options = Opts, tracker = Tracker}) ->
- invalidate_session(Role, Host, Port, Session),
- log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(),
- StateName, Alert#alert{role = opposite_role(Role)}),
- alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, From, Alert, Role, Connection),
- {stop, normal};
-
-handle_alert(#alert{level = ?WARNING, description = ?CLOSE_NOTIFY} = Alert,
- StateName, State) ->
- handle_normal_shutdown(Alert, StateName, State),
- {stop, {shutdown, peer_close}};
-
-handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{role = Role, ssl_options = SslOpts, protocol_cb = Connection, renegotiation = {true, internal}} = State) ->
- log_alert(SslOpts#ssl_options.log_alert, Role,
- Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
- handle_normal_shutdown(Alert, StateName, State),
- {stop, {shutdown, peer_close}};
-
-handle_alert(#alert{level = ?WARNING, description = ?NO_RENEGOTIATION} = Alert, StateName,
- #state{role = Role,
- ssl_options = SslOpts, renegotiation = {true, From},
- protocol_cb = Connection} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, Role,
- Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
- gen_statem:reply(From, {error, renegotiation_rejected}),
- {Record, State1} = Connection:next_record(State0),
- %% Go back to connection!
- State = Connection:reinit_handshake_data(State1#state{renegotiation = undefined}),
- Connection:next_event(connection, Record, State);
-
-%% Gracefully log and ignore all other warning alerts
-handle_alert(#alert{level = ?WARNING} = Alert, StateName,
- #state{ssl_options = SslOpts, protocol_cb = Connection, role = Role} = State0) ->
- log_alert(SslOpts#ssl_options.log_alert, Role,
- Connection:protocol_name(), StateName, Alert#alert{role = opposite_role(Role)}),
- {Record, State} = Connection:next_record(State0),
- Connection:next_event(StateName, Record, State).
-
-%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
connection_info(#state{sni_hostname = SNIHostname,
@@ -1300,7 +1333,6 @@ handle_peer_cert_key(client, _,
ECDHKey = public_key:generate_key(PublicKeyParams),
PremasterSecret = ssl_handshake:premaster_secret(PublicKey, ECDHKey),
master_secret(PremasterSecret, State#state{diffie_hellman_keys = ECDHKey});
-
%% We do currently not support cipher suites that use fixed DH.
%% If we want to implement that the following clause can be used
%% to extract DH parameters form cert.
@@ -1320,7 +1352,6 @@ certify_client(#state{client_certificate_requested = true, role = client,
= State, Connection) ->
Certificate = ssl_handshake:certificate(OwnCert, CertDbHandle, CertDbRef, client),
Connection:queue_handshake(Certificate, State);
-
certify_client(#state{client_certificate_requested = false} = State, _) ->
State.
@@ -1370,10 +1401,26 @@ server_certify_and_key_exchange(State0, Connection) ->
request_client_cert(State2, Connection).
certify_client_key_exchange(#encrypted_premaster_secret{premaster_secret= EncPMS},
- #state{private_key = Key} = State, Connection) ->
- PremasterSecret = ssl_handshake:premaster_secret(EncPMS, Key),
+ #state{private_key = Key, client_hello_version = {Major, Minor} = Version} = State, Connection) ->
+ FakeSecret = make_premaster_secret(Version, rsa),
+ %% Countermeasure for Bleichenbacher attack always provide some kind of premaster secret
+ %% and fail handshake later.RFC 5246 section 7.4.7.1.
+ PremasterSecret =
+ try ssl_handshake:premaster_secret(EncPMS, Key) of
+ Secret when erlang:byte_size(Secret) == ?NUM_OF_PREMASTERSECRET_BYTES ->
+ case Secret of
+ <<?BYTE(Major), ?BYTE(Minor), Rest/binary>> -> %% Correct
+ <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>;
+ <<?BYTE(_), ?BYTE(_), Rest/binary>> -> %% Version mismatch
+ <<?BYTE(Major), ?BYTE(Minor), Rest/binary>>
+ end;
+ _ -> %% erlang:byte_size(Secret) =/= ?NUM_OF_PREMASTERSECRET_BYTES
+ FakeSecret
+ catch
+ #alert{description = ?DECRYPT_ERROR} ->
+ FakeSecret
+ end,
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
-
certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPublicDhKey},
#state{diffie_hellman_params = #'DHParameter'{} = Params,
diffie_hellman_keys = {_, ServerDhPrivateKey}} = State,
@@ -1385,14 +1432,12 @@ certify_client_key_exchange(#client_ec_diffie_hellman_public{dh_public = ClientP
#state{diffie_hellman_keys = ECDHKey} = State, Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(#'ECPoint'{point = ClientPublicEcDhPoint}, ECDHKey),
calculate_master_secret(PremasterSecret, State, Connection, certify, cipher);
-
certify_client_key_exchange(#client_psk_identity{} = ClientKey,
#state{ssl_options =
#ssl_options{user_lookup_fun = PSKLookup}} = State0,
Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(ClientKey, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
-
certify_client_key_exchange(#client_dhe_psk_identity{} = ClientKey,
#state{diffie_hellman_params = #'DHParameter'{} = Params,
diffie_hellman_keys = {_, ServerDhPrivateKey},
@@ -1409,7 +1454,6 @@ certify_client_key_exchange(#client_rsa_psk_identity{} = ClientKey,
Connection) ->
PremasterSecret = ssl_handshake:premaster_secret(ClientKey, Key, PSKLookup),
calculate_master_secret(PremasterSecret, State0, Connection, certify, cipher);
-
certify_client_key_exchange(#client_srp_public{} = ClientKey,
#state{srp_params = Params,
srp_keys = Key
@@ -1423,7 +1467,6 @@ certify_server(#state{key_algorithm = Algo} = State, _) when Algo == dh_anon;
Algo == dhe_psk;
Algo == srp_anon ->
State;
-
certify_server(#state{cert_db = CertDbHandle,
cert_db_ref = CertDbRef,
session = #session{own_certificate = OwnCert}} = State, Connection) ->
@@ -1457,7 +1500,6 @@ key_exchange(#state{role = server, key_algorithm = Algo,
PrivateKey}),
State = Connection:queue_handshake(Msg, State0),
State#state{diffie_hellman_keys = DHKeys};
-
key_exchange(#state{role = server, private_key = Key, key_algorithm = Algo} = State, _)
when Algo == ecdh_ecdsa; Algo == ecdh_rsa ->
State#state{diffie_hellman_keys = Key};
@@ -1483,7 +1525,6 @@ key_exchange(#state{role = server, key_algorithm = Algo,
PrivateKey}),
State = Connection:queue_handshake(Msg, State0),
State#state{diffie_hellman_keys = ECDHKeys};
-
key_exchange(#state{role = server, key_algorithm = psk,
ssl_options = #ssl_options{psk_identity = undefined}} = State, _) ->
State;
@@ -1504,7 +1545,6 @@ key_exchange(#state{role = server, key_algorithm = psk,
ServerRandom,
PrivateKey}),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = server, key_algorithm = dhe_psk,
ssl_options = #ssl_options{psk_identity = PskIdentityHint},
hashsign_algorithm = HashSignAlgo,
@@ -1526,7 +1566,6 @@ key_exchange(#state{role = server, key_algorithm = dhe_psk,
PrivateKey}),
State = Connection:queue_handshake(Msg, State0),
State#state{diffie_hellman_keys = DHKeys};
-
key_exchange(#state{role = server, key_algorithm = rsa_psk,
ssl_options = #ssl_options{psk_identity = undefined}} = State, _) ->
State;
@@ -1547,7 +1586,6 @@ key_exchange(#state{role = server, key_algorithm = rsa_psk,
ServerRandom,
PrivateKey}),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = server, key_algorithm = Algo,
ssl_options = #ssl_options{user_lookup_fun = LookupFun},
hashsign_algorithm = HashSignAlgo,
@@ -1578,7 +1616,6 @@ key_exchange(#state{role = server, key_algorithm = Algo,
State = Connection:queue_handshake(Msg, State0),
State#state{srp_params = SrpParams,
srp_keys = Keys};
-
key_exchange(#state{role = client,
key_algorithm = rsa,
public_key_info = PublicKeyInfo,
@@ -1586,7 +1623,6 @@ key_exchange(#state{role = client,
premaster_secret = PremasterSecret} = State0, Connection) ->
Msg = rsa_key_exchange(ssl:tls_version(Version), PremasterSecret, PublicKeyInfo),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = client,
key_algorithm = Algorithm,
negotiated_version = Version,
@@ -1607,7 +1643,6 @@ key_exchange(#state{role = client,
Algorithm == ecdh_anon ->
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version), {ecdh, Keys}),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = client,
ssl_options = SslOpts,
key_algorithm = psk,
@@ -1615,7 +1650,6 @@ key_exchange(#state{role = client,
Msg = ssl_handshake:key_exchange(client, ssl:tls_version(Version),
{psk, SslOpts#ssl_options.psk_identity}),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = client,
ssl_options = SslOpts,
key_algorithm = dhe_psk,
@@ -1635,7 +1669,6 @@ key_exchange(#state{role = client,
Msg = rsa_psk_key_exchange(ssl:tls_version(Version), SslOpts#ssl_options.psk_identity,
PremasterSecret, PublicKeyInfo),
Connection:queue_handshake(Msg, State0);
-
key_exchange(#state{role = client,
key_algorithm = Algorithm,
negotiated_version = Version,
@@ -2005,10 +2038,7 @@ set_socket_opts(_,_, _, [{active, _} = Opt| _], SockOpts, _) ->
set_socket_opts(ConnectionCb, Transport, Socket, [Opt | Opts], SockOpts, Other) ->
set_socket_opts(ConnectionCb, Transport, Socket, Opts, SockOpts, [Opt | Other]).
-start_or_recv_cancel_timer(infinity, _RecvFrom) ->
- undefined;
-start_or_recv_cancel_timer(Timeout, RecvFrom) ->
- erlang:send_after(Timeout, self(), {cancel_start_or_recv, RecvFrom}).
+
hibernate_after(connection = StateName,
#state{ssl_options=#ssl_options{hibernate_after = HibernateAfter}} = State,
@@ -2393,45 +2423,6 @@ log_alert(true, Role, ProtocolName, StateName, Alert) ->
log_alert(false, _, _, _, _) ->
ok.
-handle_own_alert(Alert, Version, StateName,
- #state{role = Role,
- transport_cb = Transport,
- socket = Socket,
- protocol_cb = Connection,
- connection_states = ConnectionStates,
- ssl_options = SslOpts} = State) ->
- try %% Try to tell the other side
- {BinMsg, _} =
- Connection:encode_alert(Alert, Version, ConnectionStates),
- Connection:send(Transport, Socket, BinMsg)
- catch _:_ -> %% Can crash if we are in a uninitialized state
- ignore
- end,
- try %% Try to tell the local user
- log_alert(SslOpts#ssl_options.log_alert, Role, Connection:protocol_name(), StateName, Alert#alert{role = Role}),
- handle_normal_shutdown(Alert,StateName, State)
- catch _:_ ->
- ok
- end,
- {stop, {shutdown, own_alert}}.
-
-handle_normal_shutdown(Alert, _, #state{socket = Socket,
- transport_cb = Transport,
- protocol_cb = Connection,
- start_or_recv_from = StartFrom,
- tracker = Tracker,
- role = Role, renegotiation = {false, first}}) ->
- alert_user(Transport, Tracker,Socket, StartFrom, Alert, Role, Connection);
-
-handle_normal_shutdown(Alert, StateName, #state{socket = Socket,
- socket_options = Opts,
- transport_cb = Transport,
- protocol_cb = Connection,
- user_application = {_Mon, Pid},
- tracker = Tracker,
- start_or_recv_from = RecvFrom, role = Role}) ->
- alert_user(Transport, Tracker, Socket, StateName, Opts, Pid, RecvFrom, Alert, Role, Connection).
-
invalidate_session(client, Host, Port, Session) ->
ssl_manager:invalidate_session(Host, Port, Session);
invalidate_session(server, _, Port, Session) ->
diff --git a/lib/ssl/src/ssl_connection.hrl b/lib/ssl/src/ssl_connection.hrl
index 3e26f67de1..f9d2149170 100644
--- a/lib/ssl/src/ssl_connection.hrl
+++ b/lib/ssl/src/ssl_connection.hrl
@@ -57,6 +57,7 @@
session_cache_cb :: atom(),
crl_db :: term(),
negotiated_version :: ssl_record:ssl_version() | 'undefined',
+ client_hello_version :: ssl_record:ssl_version() | 'undefined',
client_certificate_requested = false :: boolean(),
key_algorithm :: ssl_cipher:key_algo(),
hashsign_algorithm = {undefined, undefined},
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index b47a11dc0d..17bc407d26 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -44,46 +44,44 @@
#client_key_exchange{} | #finished{} | #certificate_verify{} |
#hello_request{} | #next_protocol{}.
-%% Handshake messages
+%% Create handshake messages
-export([hello_request/0, server_hello/4, server_hello_done/0,
- certificate/4, certificate_request/5, key_exchange/3,
+ certificate/4, client_certificate_verify/6, certificate_request/5, key_exchange/3,
finished/5, next_protocol/1]).
%% Handle handshake messages
--export([certify/7, client_certificate_verify/6, certificate_verify/6, verify_signature/5,
+-export([certify/7, certificate_verify/6, verify_signature/5,
master_secret/4, server_key_exchange_hash/2, verify_connection/6,
- init_handshake_history/0, update_handshake_history/3, verify_server_key/5
+ init_handshake_history/0, update_handshake_history/3, verify_server_key/5,
+ select_version/3
]).
-%% Encode/Decode
+%% Encode
-export([encode_handshake/2, encode_hello_extensions/1,
- encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1,
- decode_handshake/3, decode_hello_extensions/1,
+ encode_client_protocol_negotiation/2, encode_protocols_advertised_on_server/1]).
+%% Decode
+-export([decode_handshake/3, decode_hello_extensions/1,
decode_server_key/3, decode_client_key/3,
decode_suites/2
]).
%% Cipher suites handling
--export([available_suites/2, available_signature_algs/2, cipher_suites/2,
- select_session/11, supported_ecc/1, available_signature_algs/4]).
+-export([available_suites/2, available_signature_algs/2, available_signature_algs/4,
+ cipher_suites/2, prf/6, select_session/11, supported_ecc/1,
+ premaster_secret/2, premaster_secret/3, premaster_secret/4]).
%% Extensions handling
-export([client_hello_extensions/5,
handle_client_hello_extensions/9, %% Returns server hello extensions
- handle_server_hello_extensions/9, select_curve/2, select_curve/3
+ handle_server_hello_extensions/9, select_curve/2, select_curve/3,
+ select_hashsign/4, select_hashsign/5,
+ select_hashsign_algs/3
]).
-%% MISC
--export([select_version/3, prf/6, select_hashsign/4, select_hashsign/5,
- select_hashsign_algs/3,
- premaster_secret/2, premaster_secret/3, premaster_secret/4]).
-
%%====================================================================
-%% Internal application API
+%% Create handshake messages
%%====================================================================
-%% ---------- Create handshake messages ----------
-
%%--------------------------------------------------------------------
-spec hello_request() -> #hello_request{}.
%%
@@ -119,31 +117,6 @@ server_hello(SessionId, Version, ConnectionStates, Extensions) ->
server_hello_done() ->
#server_hello_done{}.
-client_hello_extensions(Version, CipherSuites,
- #ssl_options{signature_algs = SupportedHashSigns,
- eccs = SupportedECCs} = SslOpts, ConnectionStates, Renegotiation) ->
- {EcPointFormats, EllipticCurves} =
- case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of
- true ->
- client_ecc_extensions(SupportedECCs);
- false ->
- {undefined, undefined}
- end,
- SRP = srp_user(SslOpts),
-
- #hello_extensions{
- renegotiation_info = renegotiation_info(tls_record, client,
- ConnectionStates, Renegotiation),
- srp = SRP,
- signature_algs = available_signature_algs(SupportedHashSigns, Version),
- ec_point_formats = EcPointFormats,
- elliptic_curves = EllipticCurves,
- alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation),
- next_protocol_negotiation =
- encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector,
- Renegotiation),
- sni = sni(SslOpts#ssl_options.server_name_indication)}.
-
%%--------------------------------------------------------------------
-spec certificate(der_cert(), db_handle(), certdb_ref(), client | server) -> #certificate{} | #alert{}.
%%
@@ -171,14 +144,6 @@ certificate(OwnCert, CertDbHandle, CertDbRef, server) ->
end.
%%--------------------------------------------------------------------
--spec next_protocol(binary()) -> #next_protocol{}.
-%%
-%% Description: Creates a next protocol message
-%%-------------------------------------------------------------------
-next_protocol(SelectedProtocol) ->
- #next_protocol{selected_protocol = SelectedProtocol}.
-
-%%--------------------------------------------------------------------
-spec client_certificate_verify(undefined | der_cert(), binary(),
ssl_record:ssl_version(), term(), public_key:private_key(),
ssl_handshake_history()) ->
@@ -328,22 +293,51 @@ key_exchange(server, Version, {srp, {PublicKey, _},
finished(Version, Role, PrfAlgo, MasterSecret, {Handshake, _}) -> % use the current handshake
#finished{verify_data =
calc_finished(Version, Role, PrfAlgo, MasterSecret, Handshake)}.
+%%--------------------------------------------------------------------
+-spec next_protocol(binary()) -> #next_protocol{}.
+%%
+%% Description: Creates a next protocol message
+%%-------------------------------------------------------------------
+next_protocol(SelectedProtocol) ->
+ #next_protocol{selected_protocol = SelectedProtocol}.
-%% ---------- Handle handshake messages ----------
+%%====================================================================
+%% Handle handshake messages
+%%====================================================================
+%%--------------------------------------------------------------------
+-spec certify(#certificate{}, db_handle(), certdb_ref(), #ssl_options{}, term(),
+ client | server, inet:hostname() | inet:ip_address()) -> {der_cert(), public_key_info()} | #alert{}.
+%%
+%% Description: Handles a certificate handshake message
+%%--------------------------------------------------------------------
+certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
+ Opts, CRLDbHandle, Role, Host) ->
-verify_server_key(#server_key_params{params_bin = EncParams,
- signature = Signature},
- HashSign = {HashAlgo, _},
- ConnectionStates, Version, PubKeyInfo) ->
- #{security_parameters := SecParams} =
- ssl_record:pending_connection_state(ConnectionStates, read),
- #security_parameters{client_random = ClientRandom,
- server_random = ServerRandom} = SecParams,
- Hash = server_key_exchange_hash(HashAlgo,
- <<ClientRandom/binary,
- ServerRandom/binary,
- EncParams/binary>>),
- verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo).
+ ServerName = server_name(Opts#ssl_options.server_name_indication, Host, Role),
+ [PeerCert | _] = ASN1Certs,
+ try
+ {TrustedCert, CertPath} =
+ ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef,
+ Opts#ssl_options.partial_chain),
+ ValidationFunAndState = validation_fun_and_state(Opts#ssl_options.verify_fun, Role,
+ CertDbHandle, CertDbRef, ServerName,
+ Opts#ssl_options.crl_check, CRLDbHandle, CertPath),
+ case public_key:pkix_path_validation(TrustedCert,
+ CertPath,
+ [{max_path_length, Opts#ssl_options.depth},
+ {verify_fun, ValidationFunAndState}]) of
+ {ok, {PublicKeyInfo,_}} ->
+ {PeerCert, PublicKeyInfo};
+ {error, Reason} ->
+ path_validation_alert(Reason)
+ end
+ catch
+ error:{badmatch,{asn1, Asn1Reason}} ->
+ %% ASN-1 decode of certificate somehow failed
+ ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason});
+ error:OtherReason ->
+ ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason})
+ end.
%%--------------------------------------------------------------------
-spec certificate_verify(binary(), public_key_info(), ssl_record:ssl_version(), term(),
@@ -386,43 +380,55 @@ verify_signature(_, Hash, {HashAlgo, _SignAlg}, Signature,
{?'id-ecPublicKey', PublicKey, PublicKeyParams}) ->
public_key:verify({digest, Hash}, HashAlgo, Signature, {PublicKey, PublicKeyParams}).
-
%%--------------------------------------------------------------------
--spec certify(#certificate{}, db_handle(), certdb_ref(), #ssl_options{}, term(),
- client | server, inet:hostname() | inet:ip_address()) -> {der_cert(), public_key_info()} | #alert{}.
+-spec master_secret(ssl_record:ssl_version(), #session{} | binary(), ssl_record:connection_states(),
+ client | server) -> {binary(), ssl_record:connection_states()} | #alert{}.
%%
-%% Description: Handles a certificate handshake message
-%%--------------------------------------------------------------------
-certify(#certificate{asn1_certificates = ASN1Certs}, CertDbHandle, CertDbRef,
- Opts, CRLDbHandle, Role, Host) ->
+%% Description: Sets or calculates the master secret and calculate keys,
+%% updating the pending connection states. The Mastersecret and the update
+%% connection states are returned or an alert if the calculation fails.
+%%-------------------------------------------------------------------
+master_secret(Version, #session{master_secret = Mastersecret},
+ ConnectionStates, Role) ->
+ #{security_parameters := SecParams} =
+ ssl_record:pending_connection_state(ConnectionStates, read),
+ try master_secret(Version, Mastersecret, SecParams,
+ ConnectionStates, Role)
+ catch
+ exit:_ ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, key_calculation_failure)
+ end;
- ServerName = server_name(Opts#ssl_options.server_name_indication, Host, Role),
- [PeerCert | _] = ASN1Certs,
- try
- {TrustedCert, CertPath} =
- ssl_certificate:trusted_cert_and_path(ASN1Certs, CertDbHandle, CertDbRef,
- Opts#ssl_options.partial_chain),
- ValidationFunAndState = validation_fun_and_state(Opts#ssl_options.verify_fun, Role,
- CertDbHandle, CertDbRef, ServerName,
- Opts#ssl_options.crl_check, CRLDbHandle, CertPath),
- case public_key:pkix_path_validation(TrustedCert,
- CertPath,
- [{max_path_length, Opts#ssl_options.depth},
- {verify_fun, ValidationFunAndState}]) of
- {ok, {PublicKeyInfo,_}} ->
- {PeerCert, PublicKeyInfo};
- {error, Reason} ->
- path_validation_alert(Reason)
- end
+master_secret(Version, PremasterSecret, ConnectionStates, Role) ->
+ #{security_parameters := SecParams} =
+ ssl_record:pending_connection_state(ConnectionStates, read),
+
+ #security_parameters{prf_algorithm = PrfAlgo,
+ client_random = ClientRandom,
+ server_random = ServerRandom} = SecParams,
+ try master_secret(Version,
+ calc_master_secret(Version,PrfAlgo,PremasterSecret,
+ ClientRandom, ServerRandom),
+ SecParams, ConnectionStates, Role)
catch
- error:{badmatch,{asn1, Asn1Reason}} ->
- %% ASN-1 decode of certificate somehow failed
- ?ALERT_REC(?FATAL, ?CERTIFICATE_UNKNOWN, {failed_to_decode_certificate, Asn1Reason});
- error:OtherReason ->
- ?ALERT_REC(?FATAL, ?INTERNAL_ERROR, {unexpected_error, OtherReason})
+ exit:_ ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, master_secret_calculation_failure)
end.
%%--------------------------------------------------------------------
+-spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary().
+%%
+%% Description: Calculate server key exchange hash
+%%--------------------------------------------------------------------
+server_key_exchange_hash(md5sha, Value) ->
+ MD5 = crypto:hash(md5, Value),
+ SHA = crypto:hash(sha, Value),
+ <<MD5/binary, SHA/binary>>;
+
+server_key_exchange_hash(Hash, Value) ->
+ crypto:hash(Hash, Value).
+
+%%--------------------------------------------------------------------
-spec verify_connection(ssl_record:ssl_version(), #finished{}, client | server, integer(), binary(),
ssl_handshake_history()) -> verified | #alert{}.
%%
@@ -469,275 +475,31 @@ update_handshake_history(Handshake, % special-case SSL2 client hello
update_handshake_history({Handshake0, _Prev}, Data, _) ->
{[Data|Handshake0], Handshake0}.
-%% %%--------------------------------------------------------------------
-%% -spec decrypt_premaster_secret(binary(), #'RSAPrivateKey'{}) -> binary().
-
-%% %%
-%% %% Description: Public key decryption using the private key.
-%% %%--------------------------------------------------------------------
-%% decrypt_premaster_secret(Secret, RSAPrivateKey) ->
-%% try public_key:decrypt_private(Secret, RSAPrivateKey,
-%% [{rsa_pad, rsa_pkcs1_padding}])
-%% catch
-%% _:_ ->
-%% throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR))
-%% end.
-
-premaster_secret(OtherPublicDhKey, MyPrivateKey, #'DHParameter'{} = Params) ->
- try
- public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params)
- catch
- error:computation_failed ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
- end;
-premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g = Base}) ->
- try
- crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base])
- catch
- error:computation_failed ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
- end;
-premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime,
- verifier = Verifier}) ->
- case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of
- error ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER));
- PremasterSecret ->
- PremasterSecret
- end;
-premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public},
- ClientKeys, {Username, Password}) ->
- case ssl_srp_primes:check_srp_params(Generator, Prime) of
- ok ->
- DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]),
- case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of
- error ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER));
- PremasterSecret ->
- PremasterSecret
- end;
- _ ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
- end;
-premaster_secret(#client_rsa_psk_identity{
- identity = PSKIdentity,
- exchange_keys = #encrypted_premaster_secret{premaster_secret = EncPMS}
- }, #'RSAPrivateKey'{} = Key, PSKLookup) ->
- PremasterSecret = premaster_secret(EncPMS, Key),
- psk_secret(PSKIdentity, PSKLookup, PremasterSecret);
-premaster_secret(#server_dhe_psk_params{
- hint = IdentityHint,
- dh_params = #server_dh_params{dh_y = PublicDhKey} = Params},
- PrivateDhKey,
- LookupFun) ->
- PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params),
- psk_secret(IdentityHint, LookupFun, PremasterSecret);
-premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) ->
- psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret).
-
-premaster_secret(#client_dhe_psk_identity{
- identity = PSKIdentity,
- dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) ->
- PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params),
- psk_secret(PSKIdentity, PSKLookup, PremasterSecret).
-premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) ->
- psk_secret(PSKIdentity, PSKLookup);
-premaster_secret({psk, PSKIdentity}, PSKLookup) ->
- psk_secret(PSKIdentity, PSKLookup);
-premaster_secret(#'ECPoint'{} = ECPoint, #'ECPrivateKey'{} = ECDHKeys) ->
- public_key:compute_key(ECPoint, ECDHKeys);
-premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) ->
- try public_key:decrypt_private(EncSecret, RSAPrivateKey,
- [{rsa_pad, rsa_pkcs1_padding}])
- catch
- _:_ ->
- throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR))
- end.
-%%--------------------------------------------------------------------
--spec server_key_exchange_hash(md5sha | md5 | sha | sha224 |sha256 | sha384 | sha512, binary()) -> binary().
-%%
-%% Description: Calculate server key exchange hash
-%%--------------------------------------------------------------------
-server_key_exchange_hash(md5sha, Value) ->
- MD5 = crypto:hash(md5, Value),
- SHA = crypto:hash(sha, Value),
- <<MD5/binary, SHA/binary>>;
-
-server_key_exchange_hash(Hash, Value) ->
- crypto:hash(Hash, Value).
-%%--------------------------------------------------------------------
--spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) ->
- {ok, binary()} | {error, undefined}.
-%%
-%% Description: use the TLS PRF to generate key material
-%%--------------------------------------------------------------------
-prf({3,0}, _, _, _, _, _) ->
- {error, undefined};
-prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) ->
- {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}.
-
-
-%%--------------------------------------------------------------------
--spec select_hashsign(#hash_sign_algos{} | undefined, undefined | binary(),
- atom(), [atom()], ssl_record:ssl_version()) ->
- {atom(), atom()} | undefined | #alert{}.
-
-%%
-%% Description: Handles signature_algorithms hello extension (server)
-%%--------------------------------------------------------------------
-select_hashsign(_, undefined, _, _, _Version) ->
- {null, anon};
-%% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have
-%% negotiated a lower version.
-select_hashsign(HashSigns, Cert, KeyExAlgo,
- undefined, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3->
- select_hashsign(HashSigns, Cert, KeyExAlgo, tls_v1:default_signature_algs(Version), Version);
-select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, SupportedHashSigns,
- {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
- #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
- #'OTPCertificate'{tbsCertificate = TBSCert,
- signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp),
- #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} =
- TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
-
- Sign = sign_algo(SignAlgo),
- SubSing = sign_algo(SubjAlgo),
-
- case lists:filter(fun({_, S} = Algos) when S == Sign ->
- is_acceptable_hash_sign(Algos, Sign,
- SubSing, KeyExAlgo, SupportedHashSigns);
- (_) ->
- false
- end, HashSigns) of
- [] ->
- ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm);
- [HashSign | _] ->
- HashSign
- end;
-select_hashsign(_, Cert, _, _, Version) ->
- #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
- #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
- select_hashsign_algs(undefined, Algo, Version).
-%%--------------------------------------------------------------------
--spec select_hashsign(#certificate_request{}, binary(),
- [atom()], ssl_record:ssl_version()) ->
- {atom(), atom()} | #alert{}.
-
-%%
-%% Description: Handles signature algorithms selection for certificate requests (client)
-%%--------------------------------------------------------------------
-select_hashsign(#certificate_request{}, undefined, _, {Major, Minor}) when Major >= 3 andalso Minor >= 3->
- %% There client does not have a certificate and will send an empty reply, the server may fail
- %% or accept the connection by its own preference. No signature algorihms needed as there is
- %% no certificate to verify.
- {undefined, undefined};
-
-select_hashsign(#certificate_request{hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSigns},
- certificate_types = Types}, Cert, SupportedHashSigns,
- {Major, Minor}) when Major >= 3 andalso Minor >= 3->
- #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
- #'OTPCertificate'{tbsCertificate = TBSCert,
- signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp),
- #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} =
- TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
-
- Sign = sign_algo(SignAlgo),
- SubSign = sign_algo(SubjAlgo),
-
- case is_acceptable_cert_type(SubSign, HashSigns, Types) andalso is_supported_sign(Sign, HashSigns) of
- true ->
- case lists:filter(fun({_, S} = Algos) when S == SubSign ->
- is_acceptable_hash_sign(Algos, SupportedHashSigns);
- (_) ->
- false
- end, HashSigns) of
- [] ->
- ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm);
- [HashSign | _] ->
- HashSign
- end;
- false ->
- ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm)
- end;
-select_hashsign(#certificate_request{}, Cert, _, Version) ->
- select_hashsign(undefined, Cert, undefined, [], Version).
-
-%%--------------------------------------------------------------------
--spec select_hashsign_algs({atom(), atom()}| undefined, oid(), ssl_record:ssl_version()) ->
- {atom(), atom()}.
-
-%% Description: For TLS 1.2 hash function and signature algorithm pairs can be
-%% negotiated with the signature_algorithms extension,
-%% for previous versions always use appropriate defaults.
-%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
-%% If the client does not send the signature_algorithms extension, the
-%% server MUST do the following: (e.i defaults for TLS 1.2)
-%%
-%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
-%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
-%% sent the value {sha1,rsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
-%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
-%%
-%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
-%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
-
-%%--------------------------------------------------------------------
-select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
- Major >= 3 andalso Minor >= 3 ->
- HashSign;
-select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
- {sha, rsa};
-select_hashsign_algs(undefined,?'id-ecPublicKey', _) ->
- {sha, ecdsa};
-select_hashsign_algs(undefined, ?rsaEncryption, _) ->
- {md5sha, rsa};
-select_hashsign_algs(undefined, ?'id-dsa', _) ->
- {sha, dsa}.
-
-
-%%--------------------------------------------------------------------
--spec master_secret(ssl_record:ssl_version(), #session{} | binary(), ssl_record:connection_states(),
- client | server) -> {binary(), ssl_record:connection_states()} | #alert{}.
-%%
-%% Description: Sets or calculates the master secret and calculate keys,
-%% updating the pending connection states. The Mastersecret and the update
-%% connection states are returned or an alert if the calculation fails.
-%%-------------------------------------------------------------------
-master_secret(Version, #session{master_secret = Mastersecret},
- ConnectionStates, Role) ->
- #{security_parameters := SecParams} =
- ssl_record:pending_connection_state(ConnectionStates, read),
- try master_secret(Version, Mastersecret, SecParams,
- ConnectionStates, Role)
- catch
- exit:_ ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, key_calculation_failure)
- end;
-
-master_secret(Version, PremasterSecret, ConnectionStates, Role) ->
+verify_server_key(#server_key_params{params_bin = EncParams,
+ signature = Signature},
+ HashSign = {HashAlgo, _},
+ ConnectionStates, Version, PubKeyInfo) ->
#{security_parameters := SecParams} =
ssl_record:pending_connection_state(ConnectionStates, read),
-
- #security_parameters{prf_algorithm = PrfAlgo,
- client_random = ClientRandom,
+ #security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
- try master_secret(Version,
- calc_master_secret(Version,PrfAlgo,PremasterSecret,
- ClientRandom, ServerRandom),
- SecParams, ConnectionStates, Role)
- catch
- exit:_ ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, master_secret_calculation_failure)
- end.
+ Hash = server_key_exchange_hash(HashAlgo,
+ <<ClientRandom/binary,
+ ServerRandom/binary,
+ EncParams/binary>>),
+ verify_signature(Version, Hash, HashSign, Signature, PubKeyInfo).
+
+select_version(RecordCB, ClientVersion, Versions) ->
+ do_select_version(RecordCB, ClientVersion, Versions).
+
+%%====================================================================
+%% Encode handshake
+%%====================================================================
-%%-------------Encode/Decode --------------------------------
encode_handshake(#next_protocol{selected_protocol = SelectedProtocol}, _Version) ->
PaddingLength = 32 - ((byte_size(SelectedProtocol) + 2) rem 32),
{?NEXT_PROTOCOL, <<?BYTE((byte_size(SelectedProtocol))), SelectedProtocol/binary,
?BYTE(PaddingLength), 0:(PaddingLength * 8)>>};
-
encode_handshake(#server_hello{server_version = {Major, Minor},
random = Random,
session_id = Session_ID,
@@ -859,70 +621,6 @@ encode_hello_extensions([#sni{hostname = Hostname} | Rest], Acc) ->
?UINT16(HostLen), HostnameBin/binary,
Acc/binary>>).
-enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo},
- ClientRandom, ServerRandom, PrivateKey) ->
- EncParams = encode_server_key(Params),
- case HashAlgo of
- null ->
- #server_key_params{params = Params,
- params_bin = EncParams,
- hashsign = {null, anon},
- signature = <<>>};
- _ ->
- Hash =
- server_key_exchange_hash(HashAlgo, <<ClientRandom/binary,
- ServerRandom/binary,
- EncParams/binary>>),
- Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey),
- #server_key_params{params = Params,
- params_bin = EncParams,
- hashsign = {HashAlgo, SignAlgo},
- signature = Signature}
- end.
-
-%%--------------------------------------------------------------------
--spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) ->
- #encrypted_premaster_secret{}
- | #client_diffie_hellman_public{}
- | #client_ec_diffie_hellman_public{}
- | #client_psk_identity{}
- | #client_dhe_psk_identity{}
- | #client_rsa_psk_identity{}
- | #client_srp_public{}.
-%%
-%% Description: Decode client_key data and return appropriate type
-%%--------------------------------------------------------------------
-decode_client_key(ClientKey, Type, Version) ->
- dec_client_key(ClientKey, key_exchange_alg(Type), Version).
-
-%%--------------------------------------------------------------------
--spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) ->
- #server_key_params{}.
-%%
-%% Description: Decode server_key data and return appropriate type
-%%--------------------------------------------------------------------
-decode_server_key(ServerKey, Type, Version) ->
- dec_server_key(ServerKey, key_exchange_alg(Type), Version).
-
-%%
-%% Description: Encode and decode functions for ALPN extension data.
-%%--------------------------------------------------------------------
-
-%% While the RFC opens the door to allow ALPN during renegotiation, in practice
-%% this does not work and it is recommended to ignore any ALPN extension during
-%% renegotiation, as done here.
-encode_alpn(_, true) ->
- undefined;
-encode_alpn(undefined, _) ->
- undefined;
-encode_alpn(Protocols, _) ->
- #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}.
-
-decode_alpn(undefined) ->
- undefined;
-decode_alpn(#alpn{extension_data=Data}) ->
- decode_protocols(Data, []).
-
encode_client_protocol_negotiation(undefined, _) ->
undefined;
encode_client_protocol_negotiation(_, false) ->
@@ -936,6 +634,10 @@ encode_protocols_advertised_on_server(undefined) ->
encode_protocols_advertised_on_server(Protocols) ->
#next_protocol_negotiation{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}.
+%%====================================================================
+%% Decode handshake
+%%====================================================================
+
decode_handshake(_, ?HELLO_REQUEST, <<>>) ->
#hello_request{};
decode_handshake(_, ?NEXT_PROTOCOL, <<?BYTE(SelectedProtocolLength),
@@ -968,7 +670,6 @@ decode_handshake(_Version, ?SERVER_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:3
cipher_suite = Cipher_suite,
compression_method = Comp_method,
extensions = HelloExtensions};
-
decode_handshake(_Version, ?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) ->
#certificate{asn1_certificates = certs_to_list(ASN1Certs)};
decode_handshake(_Version, ?SERVER_KEY_EXCHANGE, Keys) ->
@@ -1015,66 +716,29 @@ decode_hello_extensions({client, <<?UINT16(ExtLen), Extensions:ExtLen/binary>>})
decode_hello_extensions(Extensions) ->
dec_hello_extensions(Extensions, #hello_extensions{}).
-dec_server_key(<<?UINT16(PLen), P:PLen/binary,
- ?UINT16(GLen), G:GLen/binary,
- ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct,
- ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) ->
- Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y},
- {BinMsg, HashSign, Signature} = dec_server_key_params(PLen + GLen + YLen + 6, KeyStruct, Version),
- #server_key_params{params = Params,
- params_bin = BinMsg,
- hashsign = HashSign,
- signature = Signature};
-%% ECParameters with named_curve
-%% TODO: explicit curve
-dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID),
- ?BYTE(PointLen), ECPoint:PointLen/binary,
- _/binary>> = KeyStruct,
- ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) ->
- Params = #server_ecdh_params{curve = {namedCurve, tls_v1:enum_to_oid(CurveID)},
- public = ECPoint},
- {BinMsg, HashSign, Signature} = dec_server_key_params(PointLen + 4, KeyStruct, Version),
- #server_key_params{params = Params,
- params_bin = BinMsg,
- hashsign = HashSign,
- signature = Signature};
-dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruct,
- KeyExchange, Version)
- when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK ->
- Params = #server_psk_params{
- hint = PskIdentityHint},
- {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2, KeyStruct, Version),
- #server_key_params{params = Params,
- params_bin = BinMsg,
- hashsign = HashSign,
- signature = Signature};
-dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary,
- ?UINT16(PLen), P:PLen/binary,
- ?UINT16(GLen), G:GLen/binary,
- ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct,
- ?KEY_EXCHANGE_DHE_PSK, Version) ->
- DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y},
- Params = #server_dhe_psk_params{
- hint = IdentityHint,
- dh_params = DHParams},
- {BinMsg, HashSign, Signature} = dec_server_key_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version),
- #server_key_params{params = Params,
- params_bin = BinMsg,
- hashsign = HashSign,
- signature = Signature};
-dec_server_key(<<?UINT16(NLen), N:NLen/binary,
- ?UINT16(GLen), G:GLen/binary,
- ?BYTE(SLen), S:SLen/binary,
- ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct,
- ?KEY_EXCHANGE_SRP, Version) ->
- Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B},
- {BinMsg, HashSign, Signature} = dec_server_key_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version),
- #server_key_params{params = Params,
- params_bin = BinMsg,
- hashsign = HashSign,
- signature = Signature};
-dec_server_key(_, KeyExchange, _) ->
- throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_key_exchange, KeyExchange})).
+%%--------------------------------------------------------------------
+-spec decode_server_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) ->
+ #server_key_params{}.
+%%
+%% Description: Decode server_key data and return appropriate type
+%%--------------------------------------------------------------------
+decode_server_key(ServerKey, Type, Version) ->
+ dec_server_key(ServerKey, key_exchange_alg(Type), Version).
+
+%%--------------------------------------------------------------------
+-spec decode_client_key(binary(), ssl_cipher:key_algo(), ssl_record:ssl_version()) ->
+ #encrypted_premaster_secret{}
+ | #client_diffie_hellman_public{}
+ | #client_ec_diffie_hellman_public{}
+ | #client_psk_identity{}
+ | #client_dhe_psk_identity{}
+ | #client_rsa_psk_identity{}
+ | #client_srp_public{}.
+%%
+%% Description: Decode client_key data and return appropriate type
+%%--------------------------------------------------------------------
+decode_client_key(ClientKey, Type, Version) ->
+ dec_client_key(ClientKey, key_exchange_alg(Type), Version).
%%--------------------------------------------------------------------
-spec decode_suites('2_bytes'|'3_bytes', binary()) -> list().
@@ -1086,7 +750,9 @@ decode_suites('2_bytes', Dec) ->
decode_suites('3_bytes', Dec) ->
from_3bytes(Dec).
-%%-------------Cipeher suite handling --------------------------------
+%%====================================================================
+%% Cipher suite handling
+%%====================================================================
available_suites(UserSuites, Version) ->
lists:filtermap(fun(Suite) ->
@@ -1099,60 +765,37 @@ available_suites(ServerCert, UserSuites, Version, undefined, Curve) ->
available_suites(ServerCert, UserSuites, Version, HashSigns, Curve) ->
Suites = available_suites(ServerCert, UserSuites, Version, undefined, Curve),
filter_hashsigns(Suites, [ssl_cipher:suite_definition(Suite) || Suite <- Suites], HashSigns, []).
-filter_hashsigns([], [], _, Acc) ->
- lists:reverse(Acc);
-filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns,
- Acc) when KeyExchange == dhe_ecdsa;
- KeyExchange == ecdhe_ecdsa ->
- do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc);
-
-filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns,
- Acc) when KeyExchange == rsa;
- KeyExchange == dhe_rsa;
- KeyExchange == ecdhe_rsa;
- KeyExchange == srp_rsa;
- KeyExchange == rsa_psk ->
- do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc);
-filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
- KeyExchange == dhe_dss;
- KeyExchange == srp_dss ->
- do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc);
-filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
- KeyExchange == dh_dss;
- KeyExchange == dh_rsa;
- KeyExchange == dh_ecdsa;
- KeyExchange == ecdh_rsa;
- KeyExchange == ecdh_ecdsa ->
- %% Fixed DH certificates MAY be signed with any hash/signature
- %% algorithm pair appearing in the hash_sign extension. The names
- %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical.
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
-filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
- KeyExchange == dh_anon;
- KeyExchange == ecdh_anon;
- KeyExchange == srp_anon;
- KeyExchange == psk;
- KeyExchange == dhe_psk ->
- %% In this case hashsigns is not used as the kexchange is anonaymous
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]).
-do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) ->
- case lists:keymember(SignAlgo, 2, HashSigns) of
- true ->
- filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
- false ->
- filter_hashsigns(Suites, Algos, HashSigns, Acc)
- end.
-
-unavailable_ecc_suites(no_curve) ->
- ssl_cipher:ec_keyed_suites();
-unavailable_ecc_suites(_) ->
- [].
+available_signature_algs(undefined, _) ->
+ undefined;
+available_signature_algs(SupportedHashSigns, Version) when Version >= {3, 3} ->
+ #hash_sign_algos{hash_sign_algos = SupportedHashSigns};
+available_signature_algs(_, _) ->
+ undefined.
+available_signature_algs(undefined, SupportedHashSigns, _, Version) when
+ Version >= {3,3} ->
+ SupportedHashSigns;
+available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns,
+ _, Version) when Version >= {3,3} ->
+ sets:to_list(sets:intersection(sets:from_list(ClientHashSigns),
+ sets:from_list(SupportedHashSigns)));
+available_signature_algs(_, _, _, _) ->
+ undefined.
cipher_suites(Suites, false) ->
[?TLS_EMPTY_RENEGOTIATION_INFO_SCSV | Suites];
cipher_suites(Suites, true) ->
Suites.
+%%--------------------------------------------------------------------
+-spec prf(ssl_record:ssl_version(), non_neg_integer(), binary(), binary(), [binary()], non_neg_integer()) ->
+ {ok, binary()} | {error, undefined}.
+%%
+%% Description: use the TLS PRF to generate key material
+%%--------------------------------------------------------------------
+prf({3,0}, _, _, _, _, _) ->
+ {error, undefined};
+prf({3,_N}, PRFAlgo, Secret, Label, Seed, WantedLength) ->
+ {ok, tls_v1:prf(PRFAlgo, Secret, Label, Seed, WantedLength)}.
select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port, #session{ecc = ECCCurve} =
Session, Version,
@@ -1173,68 +816,109 @@ select_session(SuggestedSessionId, CipherSuites, HashSigns, Compressions, Port,
{resumed, Resumed}
end.
-%% Deprecated?
supported_ecc({Major, Minor}) when ((Major == 3) and (Minor >= 1)) orelse (Major > 3) ->
Curves = tls_v1:ecc_curves(Minor),
#elliptic_curves{elliptic_curve_list = Curves};
supported_ecc(_) ->
#elliptic_curves{elliptic_curve_list = []}.
-%%-------------certificate handling --------------------------------
-
-certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 ->
- case proplists:get_bool(ecdsa,
- proplists:get_value(public_keys, crypto:supports())) of
- true ->
- <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>;
- false ->
- <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>
+premaster_secret(OtherPublicDhKey, MyPrivateKey, #'DHParameter'{} = Params) ->
+ try
+ public_key:compute_key(OtherPublicDhKey, MyPrivateKey, Params)
+ catch
+ error:computation_failed ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
+ end;
+premaster_secret(PublicDhKey, PrivateDhKey, #server_dh_params{dh_p = Prime, dh_g = Base}) ->
+ try
+ crypto:compute_key(dh, PublicDhKey, PrivateDhKey, [Prime, Base])
+ catch
+ error:computation_failed ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
end;
+premaster_secret(#client_srp_public{srp_a = ClientPublicKey}, ServerKey, #srp_user{prime = Prime,
+ verifier = Verifier}) ->
+ case crypto:compute_key(srp, ClientPublicKey, ServerKey, {host, [Verifier, Prime, '6a']}) of
+ error ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER));
+ PremasterSecret ->
+ PremasterSecret
+ end;
+premaster_secret(#server_srp_params{srp_n = Prime, srp_g = Generator, srp_s = Salt, srp_b = Public},
+ ClientKeys, {Username, Password}) ->
+ case ssl_srp_primes:check_srp_params(Generator, Prime) of
+ ok ->
+ DerivedKey = crypto:hash(sha, [Salt, crypto:hash(sha, [Username, <<$:>>, Password])]),
+ case crypto:compute_key(srp, Public, ClientKeys, {user, [DerivedKey, Prime, Generator, '6a']}) of
+ error ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER));
+ PremasterSecret ->
+ PremasterSecret
+ end;
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
+ end;
+premaster_secret(#client_rsa_psk_identity{
+ identity = PSKIdentity,
+ exchange_keys = #encrypted_premaster_secret{premaster_secret = EncPMS}
+ }, #'RSAPrivateKey'{} = Key, PSKLookup) ->
+ PremasterSecret = premaster_secret(EncPMS, Key),
+ psk_secret(PSKIdentity, PSKLookup, PremasterSecret);
+premaster_secret(#server_dhe_psk_params{
+ hint = IdentityHint,
+ dh_params = #server_dh_params{dh_y = PublicDhKey} = Params},
+ PrivateDhKey,
+ LookupFun) ->
+ PremasterSecret = premaster_secret(PublicDhKey, PrivateDhKey, Params),
+ psk_secret(IdentityHint, LookupFun, PremasterSecret);
+premaster_secret({rsa_psk, PSKIdentity}, PSKLookup, RSAPremasterSecret) ->
+ psk_secret(PSKIdentity, PSKLookup, RSAPremasterSecret).
-certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == rsa;
- KeyExchange == dh_rsa;
- KeyExchange == dhe_rsa;
- KeyExchange == ecdhe_rsa ->
- <<?BYTE(?RSA_SIGN)>>;
-
-certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_dss;
- KeyExchange == dhe_dss;
- KeyExchange == srp_dss ->
- <<?BYTE(?DSS_SIGN)>>;
-
-certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_ecdsa;
- KeyExchange == dhe_ecdsa;
- KeyExchange == ecdh_ecdsa;
- KeyExchange == ecdhe_ecdsa ->
- <<?BYTE(?ECDSA_SIGN)>>;
-
-certificate_types(_, _) ->
- <<?BYTE(?RSA_SIGN)>>.
-
-certificate_authorities(CertDbHandle, CertDbRef) ->
- Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef),
- Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) ->
- OTPSubj = TBSCert#'OTPTBSCertificate'.subject,
- DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp),
- DNEncodedLen = byte_size(DNEncodedBin),
- <<?UINT16(DNEncodedLen), DNEncodedBin/binary>>
- end,
- list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]).
-
-certificate_authorities_from_db(CertDbHandle, CertDbRef) when is_reference(CertDbRef) ->
- ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef ->
- [Cert | Acc];
- (_, Acc) ->
- Acc
- end,
- ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle);
-certificate_authorities_from_db(_CertDbHandle, {extracted, CertDbData}) ->
- %% Cache disabled, Ref contains data
- lists:foldl(fun({decoded, {_Key,Cert}}, Acc) -> [Cert | Acc] end,
- [], CertDbData).
-
+premaster_secret(#client_dhe_psk_identity{
+ identity = PSKIdentity,
+ dh_public = PublicDhKey}, PrivateKey, #'DHParameter'{} = Params, PSKLookup) ->
+ PremasterSecret = premaster_secret(PublicDhKey, PrivateKey, Params),
+ psk_secret(PSKIdentity, PSKLookup, PremasterSecret).
+premaster_secret(#client_psk_identity{identity = PSKIdentity}, PSKLookup) ->
+ psk_secret(PSKIdentity, PSKLookup);
+premaster_secret({psk, PSKIdentity}, PSKLookup) ->
+ psk_secret(PSKIdentity, PSKLookup);
+premaster_secret(#'ECPoint'{} = ECPoint, #'ECPrivateKey'{} = ECDHKeys) ->
+ public_key:compute_key(ECPoint, ECDHKeys);
+premaster_secret(EncSecret, #'RSAPrivateKey'{} = RSAPrivateKey) ->
+ try public_key:decrypt_private(EncSecret, RSAPrivateKey,
+ [{rsa_pad, rsa_pkcs1_padding}])
+ catch
+ _:_ ->
+ throw(?ALERT_REC(?FATAL, ?DECRYPT_ERROR))
+ end.
+%%====================================================================
+%% Extensions handling
+%%====================================================================
+client_hello_extensions(Version, CipherSuites,
+ #ssl_options{signature_algs = SupportedHashSigns,
+ eccs = SupportedECCs} = SslOpts, ConnectionStates, Renegotiation) ->
+ {EcPointFormats, EllipticCurves} =
+ case advertises_ec_ciphers(lists:map(fun ssl_cipher:suite_definition/1, CipherSuites)) of
+ true ->
+ client_ecc_extensions(SupportedECCs);
+ false ->
+ {undefined, undefined}
+ end,
+ SRP = srp_user(SslOpts),
-%%-------------Extension handling --------------------------------
+ #hello_extensions{
+ renegotiation_info = renegotiation_info(tls_record, client,
+ ConnectionStates, Renegotiation),
+ srp = SRP,
+ signature_algs = available_signature_algs(SupportedHashSigns, Version),
+ ec_point_formats = EcPointFormats,
+ elliptic_curves = EllipticCurves,
+ alpn = encode_alpn(SslOpts#ssl_options.alpn_advertised_protocols, Renegotiation),
+ next_protocol_negotiation =
+ encode_client_protocol_negotiation(SslOpts#ssl_options.next_protocol_selector,
+ Renegotiation),
+ sni = sni(SslOpts#ssl_options.server_name_indication)}.
handle_client_hello_extensions(RecordCB, Random, ClientCipherSuites,
#hello_extensions{renegotiation_info = Info,
@@ -1311,231 +995,209 @@ handle_server_hello_extensions(RecordCB, Random, CipherSuite, Compression,
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, too_many_protocols_in_server_hello)
end.
-select_version(RecordCB, ClientVersion, Versions) ->
- do_select_version(RecordCB, ClientVersion, Versions).
-
-do_select_version(_, ClientVersion, []) ->
- ClientVersion;
-do_select_version(RecordCB, ClientVersion, [Version | Versions]) ->
- case RecordCB:is_higher(Version, ClientVersion) of
- true ->
- %% Version too high for client - keep looking
- do_select_version(RecordCB, ClientVersion, Versions);
- false ->
- %% Version ok for client - look for a higher
- do_select_version(RecordCB, ClientVersion, Versions, Version)
- end.
-%%
-do_select_version(_, _, [], GoodVersion) ->
- GoodVersion;
-do_select_version(
- RecordCB, ClientVersion, [Version | Versions], GoodVersion) ->
- BetterVersion =
- case RecordCB:is_higher(Version, ClientVersion) of
- true ->
- %% Version too high for client
- GoodVersion;
- false ->
- %% Version ok for client
- case RecordCB:is_higher(Version, GoodVersion) of
- true ->
- %% Use higher version
- Version;
- false ->
- GoodVersion
- end
- end,
- do_select_version(RecordCB, ClientVersion, Versions, BetterVersion).
+select_curve(Client, Server) ->
+ select_curve(Client, Server, false).
-renegotiation_info(_, client, _, false) ->
- #renegotiation_info{renegotiated_connection = undefined};
-renegotiation_info(_RecordCB, server, ConnectionStates, false) ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- case maps:get(secure_renegotiation, ConnectionState) of
- true ->
- #renegotiation_info{renegotiated_connection = ?byte(0)};
- false ->
- #renegotiation_info{renegotiated_connection = undefined}
- end;
-renegotiation_info(_RecordCB, client, ConnectionStates, true) ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- case maps:get(secure_renegotiation, ConnectionState) of
- true ->
- Data = maps:get(client_verify_data, ConnectionState),
- #renegotiation_info{renegotiated_connection = Data};
- false ->
- #renegotiation_info{renegotiated_connection = undefined}
+select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves},
+ #elliptic_curves{elliptic_curve_list = ServerCurves},
+ ServerOrder) ->
+ case ServerOrder of
+ false ->
+ select_shared_curve(ClientCurves, ServerCurves);
+ true ->
+ select_shared_curve(ServerCurves, ClientCurves)
end;
+select_curve(undefined, _, _) ->
+ %% Client did not send ECC extension use default curve if
+ %% ECC cipher is negotiated
+ {namedCurve, ?secp256r1}.
-renegotiation_info(_RecordCB, server, ConnectionStates, true) ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- case maps:get(secure_renegotiation, ConnectionState) of
- true ->
- CData = maps:get(client_verify_data, ConnectionState),
- SData = maps:get(server_verify_data, ConnectionState),
- #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>};
- false ->
- #renegotiation_info{renegotiated_connection = undefined}
- end.
+%%--------------------------------------------------------------------
+-spec select_hashsign(#hash_sign_algos{} | undefined, undefined | binary(),
+ atom(), [atom()], ssl_record:ssl_version()) ->
+ {atom(), atom()} | undefined | #alert{}.
-handle_renegotiation_info(_RecordCB, _, #renegotiation_info{renegotiated_connection = ?byte(0)},
- ConnectionStates, false, _, _) ->
- {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
+%%
+%% Description: Handles signature_algorithms hello extension (server)
+%%--------------------------------------------------------------------
+select_hashsign(_, undefined, _, _, _Version) ->
+ {null, anon};
+%% The signature_algorithms extension was introduced with TLS 1.2. Ignore it if we have
+%% negotiated a lower version.
+select_hashsign(HashSigns, Cert, KeyExAlgo,
+ undefined, {Major, Minor} = Version) when Major >= 3 andalso Minor >= 3->
+ select_hashsign(HashSigns, Cert, KeyExAlgo, tls_v1:default_signature_algs(Version), Version);
+select_hashsign(#hash_sign_algos{hash_sign_algos = HashSigns}, Cert, KeyExAlgo, SupportedHashSigns,
+ {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
+ #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
+ #'OTPCertificate'{tbsCertificate = TBSCert,
+ signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp),
+ #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} =
+ TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
-handle_renegotiation_info(_RecordCB, server, undefined, ConnectionStates, _, _, CipherSuites) ->
- case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
- true ->
- {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
- false ->
- {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}
+ Sign = sign_algo(SignAlgo),
+ SubSing = sign_algo(SubjAlgo),
+
+ case lists:filter(fun({_, S} = Algos) when S == Sign ->
+ is_acceptable_hash_sign(Algos, Sign,
+ SubSing, KeyExAlgo, SupportedHashSigns);
+ (_) ->
+ false
+ end, HashSigns) of
+ [] ->
+ ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm);
+ [HashSign | _] ->
+ HashSign
end;
+select_hashsign(_, Cert, _, _, Version) ->
+ #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
+ #'OTPSubjectPublicKeyInfo'{algorithm = {_,Algo, _}} = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
+ select_hashsign_algs(undefined, Algo, Version).
+%%--------------------------------------------------------------------
+-spec select_hashsign(#certificate_request{}, binary(),
+ [atom()], ssl_record:ssl_version()) ->
+ {atom(), atom()} | #alert{}.
-handle_renegotiation_info(_RecordCB, _, undefined, ConnectionStates, false, _, _) ->
- {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)};
+%%
+%% Description: Handles signature algorithms selection for certificate requests (client)
+%%--------------------------------------------------------------------
+select_hashsign(#certificate_request{}, undefined, _, {Major, Minor}) when Major >= 3 andalso Minor >= 3->
+ %% There client does not have a certificate and will send an empty reply, the server may fail
+ %% or accept the connection by its own preference. No signature algorihms needed as there is
+ %% no certificate to verify.
+ {undefined, undefined};
+
+select_hashsign(#certificate_request{hashsign_algorithms = #hash_sign_algos{hash_sign_algos = HashSigns},
+ certificate_types = Types}, Cert, SupportedHashSigns,
+ {Major, Minor}) when Major >= 3 andalso Minor >= 3->
+ #'OTPCertificate'{tbsCertificate = TBSCert} = public_key:pkix_decode_cert(Cert, otp),
+ #'OTPCertificate'{tbsCertificate = TBSCert,
+ signatureAlgorithm = {_,SignAlgo, _}} = public_key:pkix_decode_cert(Cert, otp),
+ #'OTPSubjectPublicKeyInfo'{algorithm = {_, SubjAlgo, _}} =
+ TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo,
-handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_connection = ClientServerVerify},
- ConnectionStates, true, _, _) ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- CData = maps:get(client_verify_data, ConnectionState),
- SData = maps:get(server_verify_data, ConnectionState),
- case <<CData/binary, SData/binary>> == ClientServerVerify of
+ Sign = sign_algo(SignAlgo),
+ SubSign = sign_algo(SubjAlgo),
+
+ case is_acceptable_cert_type(SubSign, HashSigns, Types) andalso is_supported_sign(Sign, HashSigns) of
true ->
- {ok, ConnectionStates};
+ case lists:filter(fun({_, S} = Algos) when S == SubSign ->
+ is_acceptable_hash_sign(Algos, SupportedHashSigns);
+ (_) ->
+ false
+ end, HashSigns) of
+ [] ->
+ ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm);
+ [HashSign | _] ->
+ HashSign
+ end;
false ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation)
+ ?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_signature_algorithm)
end;
-handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify},
- ConnectionStates, true, _, CipherSuites) ->
-
- case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
- true ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv});
- false ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- Data = maps:get(client_verify_data, ConnectionState),
- case Data == ClientVerify of
- true ->
- {ok, ConnectionStates};
- false ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation)
- end
- end;
+select_hashsign(#certificate_request{}, Cert, _, Version) ->
+ select_hashsign(undefined, Cert, undefined, [], Version).
-handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) ->
- handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation);
+%%--------------------------------------------------------------------
+-spec select_hashsign_algs({atom(), atom()}| undefined, oid(), ssl_record:ssl_version()) ->
+ {atom(), atom()}.
-handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) ->
- case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
- true ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv});
- false ->
- handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation)
- end.
+%% Description: For TLS 1.2 hash function and signature algorithm pairs can be
+%% negotiated with the signature_algorithms extension,
+%% for previous versions always use appropriate defaults.
+%% RFC 5246, Sect. 7.4.1.4.1. Signature Algorithms
+%% If the client does not send the signature_algorithms extension, the
+%% server MUST do the following: (e.i defaults for TLS 1.2)
+%%
+%% - If the negotiated key exchange algorithm is one of (RSA, DHE_RSA,
+%% DH_RSA, RSA_PSK, ECDH_RSA, ECDHE_RSA), behave as if client had
+%% sent the value {sha1,rsa}.
+%%
+%% - If the negotiated key exchange algorithm is one of (DHE_DSS,
+%% DH_DSS), behave as if the client had sent the value {sha1,dsa}.
+%%
+%% - If the negotiated key exchange algorithm is one of (ECDH_ECDSA,
+%% ECDHE_ECDSA), behave as if the client had sent value {sha1,ecdsa}.
-handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) ->
- ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
- case {SecureRenegotation, maps:get(secure_renegotiation, ConnectionState)} of
- {_, true} ->
- ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure);
- {true, false} ->
- ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION);
- {false, false} ->
- {ok, ConnectionStates}
- end.
+%%--------------------------------------------------------------------
+select_hashsign_algs(HashSign, _, {Major, Minor}) when HashSign =/= undefined andalso
+ Major >= 3 andalso Minor >= 3 ->
+ HashSign;
+select_hashsign_algs(undefined, ?rsaEncryption, {Major, Minor}) when Major >= 3 andalso Minor >= 3 ->
+ {sha, rsa};
+select_hashsign_algs(undefined,?'id-ecPublicKey', _) ->
+ {sha, ecdsa};
+select_hashsign_algs(undefined, ?rsaEncryption, _) ->
+ {md5sha, rsa};
+select_hashsign_algs(undefined, ?'id-dsa', _) ->
+ {sha, dsa}.
-hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo,
- srp = SRP,
- signature_algs = HashSigns,
- ec_point_formats = EcPointFormats,
- elliptic_curves = EllipticCurves,
- alpn = ALPN,
- next_protocol_negotiation = NextProtocolNegotiation,
- sni = Sni}) ->
- [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns,
- EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined].
srp_user(#ssl_options{srp_identity = {UserName, _}}) ->
#srp{username = UserName};
srp_user(_) ->
undefined.
-client_ecc_extensions(SupportedECCs) ->
- CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
- case proplists:get_bool(ecdh, CryptoSupport) of
- true ->
- EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]},
- EllipticCurves = SupportedECCs,
- {EcPointFormats, EllipticCurves};
- _ ->
- {undefined, undefined}
- end.
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+%%------------- Create handshake messages ----------------------------
-server_ecc_extension(_Version, EcPointFormats) ->
- CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
- case proplists:get_bool(ecdh, CryptoSupport) of
+int_to_bin(I) ->
+ L = (length(integer_to_list(I, 16)) + 1) div 2,
+ <<I:(L*8)>>.
+
+certificate_types(_, {N, M}) when N >= 3 andalso M >= 3 ->
+ case proplists:get_bool(ecdsa,
+ proplists:get_value(public_keys, crypto:supports())) of
true ->
- handle_ecc_point_fmt_extension(EcPointFormats);
+ <<?BYTE(?ECDSA_SIGN), ?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>;
false ->
- undefined
- end.
+ <<?BYTE(?RSA_SIGN), ?BYTE(?DSS_SIGN)>>
+ end;
-handle_ecc_point_fmt_extension(undefined) ->
- undefined;
-handle_ecc_point_fmt_extension(_) ->
- #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}.
+certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == rsa;
+ KeyExchange == dh_rsa;
+ KeyExchange == dhe_rsa;
+ KeyExchange == ecdhe_rsa ->
+ <<?BYTE(?RSA_SIGN)>>;
-advertises_ec_ciphers([]) ->
- false;
-advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) ->
- true;
-advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) ->
- true;
-advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) ->
- true;
-advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) ->
- true;
-advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) ->
- true;
-advertises_ec_ciphers([_| Rest]) ->
- advertises_ec_ciphers(Rest).
+certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_dss;
+ KeyExchange == dhe_dss;
+ KeyExchange == srp_dss ->
+ <<?BYTE(?DSS_SIGN)>>;
-select_curve(Client, Server) ->
- select_curve(Client, Server, false).
+certificate_types({KeyExchange, _, _, _}, _) when KeyExchange == dh_ecdsa;
+ KeyExchange == dhe_ecdsa;
+ KeyExchange == ecdh_ecdsa;
+ KeyExchange == ecdhe_ecdsa ->
+ <<?BYTE(?ECDSA_SIGN)>>;
-select_curve(#elliptic_curves{elliptic_curve_list = ClientCurves},
- #elliptic_curves{elliptic_curve_list = ServerCurves},
- ServerOrder) ->
- case ServerOrder of
- false ->
- select_shared_curve(ClientCurves, ServerCurves);
- true ->
- select_shared_curve(ServerCurves, ClientCurves)
- end;
-select_curve(undefined, _, _) ->
- %% Client did not send ECC extension use default curve if
- %% ECC cipher is negotiated
- {namedCurve, ?secp256r1}.
+certificate_types(_, _) ->
+ <<?BYTE(?RSA_SIGN)>>.
-select_shared_curve([], _) ->
- no_curve;
-select_shared_curve([Curve | Rest], Curves) ->
- case lists:member(Curve, Curves) of
- true ->
- {namedCurve, Curve};
- false ->
- select_shared_curve(Rest, Curves)
- end.
+certificate_authorities(CertDbHandle, CertDbRef) ->
+ Authorities = certificate_authorities_from_db(CertDbHandle, CertDbRef),
+ Enc = fun(#'OTPCertificate'{tbsCertificate=TBSCert}) ->
+ OTPSubj = TBSCert#'OTPTBSCertificate'.subject,
+ DNEncodedBin = public_key:pkix_encode('Name', OTPSubj, otp),
+ DNEncodedLen = byte_size(DNEncodedBin),
+ <<?UINT16(DNEncodedLen), DNEncodedBin/binary>>
+ end,
+ list_to_binary([Enc(Cert) || {_, Cert} <- Authorities]).
-sni(undefined) ->
- undefined;
-sni(disable) ->
- undefined;
-sni(Hostname) ->
- #sni{hostname = Hostname}.
+certificate_authorities_from_db(CertDbHandle, CertDbRef) when is_reference(CertDbRef) ->
+ ConnectionCerts = fun({{Ref, _, _}, Cert}, Acc) when Ref == CertDbRef ->
+ [Cert | Acc];
+ (_, Acc) ->
+ Acc
+ end,
+ ssl_pkix_db:foldl(ConnectionCerts, [], CertDbHandle);
+certificate_authorities_from_db(_CertDbHandle, {extracted, CertDbData}) ->
+ %% Cache disabled, Ref contains data
+ lists:foldl(fun({decoded, {_Key,Cert}}, Acc) -> [Cert | Acc] end,
+ [], CertDbData).
-%%--------------------------------------------------------------------
-%%% Internal functions
-%%--------------------------------------------------------------------
+%%-------------Handle handshake messages --------------------------------
validation_fun_and_state({Fun, UserState0}, Role, CertDbHandle, CertDbRef,
ServerNameIndication, CRLCheck, CRLDbHandle, CertPath) ->
{fun(OtpCert, {extension, _} = Extension, {SslState, UserState}) ->
@@ -1627,17 +1289,6 @@ path_validation_alert({bad_cert, unknown_ca}) ->
path_validation_alert(Reason) ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason).
-encrypted_premaster_secret(Secret, RSAPublicKey) ->
- try
- PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey,
- [{rsa_pad,
- rsa_pkcs1_padding}]),
- #encrypted_premaster_secret{premaster_secret = PreMasterSecret}
- catch
- _:_->
- throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed))
- end.
-
digitally_signed(Version, Hashes, HashAlgo, PrivateKey) ->
try do_digitally_signed(Version, Hashes, HashAlgo, PrivateKey) of
Signature ->
@@ -1663,6 +1314,106 @@ do_digitally_signed({3, _}, Hash, HashAlgo, #{algorithm := Alg} = Engine) ->
do_digitally_signed(_Version, Hash, HashAlgo, Key) ->
public_key:sign({digest, Hash}, HashAlgo, Key).
+bad_key(#'DSAPrivateKey'{}) ->
+ unacceptable_dsa_key;
+bad_key(#'RSAPrivateKey'{}) ->
+ unacceptable_rsa_key;
+bad_key(#'ECPrivateKey'{}) ->
+ unacceptable_ecdsa_key.
+
+crl_check(_, false, _,_,_, _, _) ->
+ valid;
+crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option.
+ valid;
+crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) ->
+ Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) ->
+ ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
+ DBInfo})
+ end, {CertDbHandle, CertDbRef}}},
+ {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end},
+ {undetermined_details, true}
+ ],
+ case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of
+ no_dps ->
+ crl_check_same_issuer(OtpCert, Check,
+ dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer),
+ Options);
+ DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed
+ %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined}
+ case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of
+ {bad_cert, {revocation_status_undetermined, _}} ->
+ crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback,
+ CRLDbHandle, same_issuer), Options);
+ Other ->
+ Other
+ end
+ end.
+
+crl_check_same_issuer(OtpCert, best_effort, Dps, Options) ->
+ case public_key:pkix_crls_validate(OtpCert, Dps, Options) of
+ {bad_cert, {revocation_status_undetermined, _}} ->
+ valid;
+ Other ->
+ Other
+ end;
+crl_check_same_issuer(OtpCert, _, Dps, Options) ->
+ public_key:pkix_crls_validate(OtpCert, Dps, Options).
+
+dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) ->
+ case public_key:pkix_dist_points(OtpCert) of
+ [] ->
+ no_dps;
+ DistPoints ->
+ Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer,
+ CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle),
+ dps_and_crls(DistPoints, CRLs, [])
+ end;
+
+dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
+ DP = #'DistributionPoint'{distributionPoint = {fullName, GenNames}} =
+ public_key:pkix_dist_point(OtpCert),
+ CRLs = lists:flatmap(fun({directoryName, Issuer}) ->
+ Callback:select(Issuer, CRLDbHandle);
+ (_) ->
+ []
+ end, GenNames),
+ [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs].
+
+dps_and_crls([], _, Acc) ->
+ Acc;
+dps_and_crls([DP | Rest], CRLs, Acc) ->
+ DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs],
+ dps_and_crls(Rest, CRLs, DpCRL ++ Acc).
+
+distpoints_lookup([],_, _, _) ->
+ [];
+distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
+ Result =
+ try Callback:lookup(DistPoint, Issuer, CRLDbHandle)
+ catch
+ error:undef ->
+ %% The callback module still uses the 2-argument
+ %% version of the lookup function.
+ Callback:lookup(DistPoint, CRLDbHandle)
+ end,
+ case Result of
+ not_available ->
+ distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle);
+ CRLs ->
+ CRLs
+ end.
+
+encrypted_premaster_secret(Secret, RSAPublicKey) ->
+ try
+ PreMasterSecret = public_key:encrypt_public(Secret, RSAPublicKey,
+ [{rsa_pad,
+ rsa_pkcs1_padding}]),
+ #encrypted_premaster_secret{premaster_secret = PreMasterSecret}
+ catch
+ _:_->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, premaster_encryption_failed))
+ end.
+
calc_certificate_verify({3, 0}, HashAlgo, MasterSecret, Handshake) ->
ssl_v3:certificate_verify(HashAlgo, MasterSecret, lists:reverse(Handshake));
calc_certificate_verify({3, N}, HashAlgo, _MasterSecret, Handshake) ->
@@ -1715,24 +1466,7 @@ calc_master_secret({3,0}, _PrfAlgo, PremasterSecret, ClientRandom, ServerRandom)
calc_master_secret({3,_}, PrfAlgo, PremasterSecret, ClientRandom, ServerRandom) ->
tls_v1:master_secret(PrfAlgo, PremasterSecret, ClientRandom, ServerRandom).
-
-handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite,
- ClientCipherSuites, Compression,
- ConnectionStates0, Renegotiation, SecureRenegotation) ->
- case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0,
- Renegotiation, SecureRenegotation,
- ClientCipherSuites) of
- {ok, ConnectionStates} ->
- hello_pending_connection_states(RecordCB, Role,
- Version,
- NegotiatedCipherSuite,
- Random,
- Compression,
- ConnectionStates);
- #alert{} = Alert ->
- throw(Alert)
- end.
-
+
%% Update pending connection states with parameters exchanged via
%% hello messages
%% NOTE : Role is the role of the receiver of the hello message
@@ -1772,7 +1506,43 @@ hello_security_parameters(server, Version, #{security_parameters := SecParams},
compression_algorithm = Compression
}.
-%%-------------Encode/Decode --------------------------------
+select_compression(_CompressionMetodes) ->
+ ?NULL.
+
+do_select_version(_, ClientVersion, []) ->
+ ClientVersion;
+do_select_version(RecordCB, ClientVersion, [Version | Versions]) ->
+ case RecordCB:is_higher(Version, ClientVersion) of
+ true ->
+ %% Version too high for client - keep looking
+ do_select_version(RecordCB, ClientVersion, Versions);
+ false ->
+ %% Version ok for client - look for a higher
+ do_select_version(RecordCB, ClientVersion, Versions, Version)
+ end.
+%%
+do_select_version(_, _, [], GoodVersion) ->
+ GoodVersion;
+do_select_version(
+ RecordCB, ClientVersion, [Version | Versions], GoodVersion) ->
+ BetterVersion =
+ case RecordCB:is_higher(Version, ClientVersion) of
+ true ->
+ %% Version too high for client
+ GoodVersion;
+ false ->
+ %% Version ok for client
+ case RecordCB:is_higher(Version, GoodVersion) of
+ true ->
+ %% Use higher version
+ Version;
+ false ->
+ GoodVersion
+ end
+ end,
+ do_select_version(RecordCB, ClientVersion, Versions, BetterVersion).
+
+%%-------------Encode handshakes --------------------------------
encode_server_key(#server_dh_params{dh_p = P, dh_g = G, dh_y = Y}) ->
PLen = byte_size(P),
@@ -1860,6 +1630,110 @@ encode_protocol(Protocol, Acc) ->
Len = byte_size(Protocol),
<<Acc/binary, ?BYTE(Len), Protocol/binary>>.
+enc_server_key_exchange(Version, Params, {HashAlgo, SignAlgo},
+ ClientRandom, ServerRandom, PrivateKey) ->
+ EncParams = encode_server_key(Params),
+ case HashAlgo of
+ null ->
+ #server_key_params{params = Params,
+ params_bin = EncParams,
+ hashsign = {null, anon},
+ signature = <<>>};
+ _ ->
+ Hash =
+ server_key_exchange_hash(HashAlgo, <<ClientRandom/binary,
+ ServerRandom/binary,
+ EncParams/binary>>),
+ Signature = digitally_signed(Version, Hash, HashAlgo, PrivateKey),
+ #server_key_params{params = Params,
+ params_bin = EncParams,
+ hashsign = {HashAlgo, SignAlgo},
+ signature = Signature}
+ end.
+
+%% While the RFC opens the door to allow ALPN during renegotiation, in practice
+%% this does not work and it is recommended to ignore any ALPN extension during
+%% renegotiation, as done here.
+encode_alpn(_, true) ->
+ undefined;
+encode_alpn(undefined, _) ->
+ undefined;
+encode_alpn(Protocols, _) ->
+ #alpn{extension_data = lists:foldl(fun encode_protocol/2, <<>>, Protocols)}.
+
+hello_extensions_list(#hello_extensions{renegotiation_info = RenegotiationInfo,
+ srp = SRP,
+ signature_algs = HashSigns,
+ ec_point_formats = EcPointFormats,
+ elliptic_curves = EllipticCurves,
+ alpn = ALPN,
+ next_protocol_negotiation = NextProtocolNegotiation,
+ sni = Sni}) ->
+ [Ext || Ext <- [RenegotiationInfo, SRP, HashSigns,
+ EcPointFormats, EllipticCurves, ALPN, NextProtocolNegotiation, Sni], Ext =/= undefined].
+
+%%-------------Decode handshakes---------------------------------
+dec_server_key(<<?UINT16(PLen), P:PLen/binary,
+ ?UINT16(GLen), G:GLen/binary,
+ ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct,
+ ?KEY_EXCHANGE_DIFFIE_HELLMAN, Version) ->
+ Params = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(PLen + GLen + YLen + 6, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
+%% ECParameters with named_curve
+%% TODO: explicit curve
+dec_server_key(<<?BYTE(?NAMED_CURVE), ?UINT16(CurveID),
+ ?BYTE(PointLen), ECPoint:PointLen/binary,
+ _/binary>> = KeyStruct,
+ ?KEY_EXCHANGE_EC_DIFFIE_HELLMAN, Version) ->
+ Params = #server_ecdh_params{curve = {namedCurve, tls_v1:enum_to_oid(CurveID)},
+ public = ECPoint},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(PointLen + 4, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
+dec_server_key(<<?UINT16(Len), PskIdentityHint:Len/binary, _/binary>> = KeyStruct,
+ KeyExchange, Version)
+ when KeyExchange == ?KEY_EXCHANGE_PSK; KeyExchange == ?KEY_EXCHANGE_RSA_PSK ->
+ Params = #server_psk_params{
+ hint = PskIdentityHint},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(Len + 2, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
+dec_server_key(<<?UINT16(Len), IdentityHint:Len/binary,
+ ?UINT16(PLen), P:PLen/binary,
+ ?UINT16(GLen), G:GLen/binary,
+ ?UINT16(YLen), Y:YLen/binary, _/binary>> = KeyStruct,
+ ?KEY_EXCHANGE_DHE_PSK, Version) ->
+ DHParams = #server_dh_params{dh_p = P, dh_g = G, dh_y = Y},
+ Params = #server_dhe_psk_params{
+ hint = IdentityHint,
+ dh_params = DHParams},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(Len + PLen + GLen + YLen + 8, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
+dec_server_key(<<?UINT16(NLen), N:NLen/binary,
+ ?UINT16(GLen), G:GLen/binary,
+ ?BYTE(SLen), S:SLen/binary,
+ ?UINT16(BLen), B:BLen/binary, _/binary>> = KeyStruct,
+ ?KEY_EXCHANGE_SRP, Version) ->
+ Params = #server_srp_params{srp_n = N, srp_g = G, srp_s = S, srp_b = B},
+ {BinMsg, HashSign, Signature} = dec_server_key_params(NLen + GLen + SLen + BLen + 7, KeyStruct, Version),
+ #server_key_params{params = Params,
+ params_bin = BinMsg,
+ hashsign = HashSign,
+ signature = Signature};
+dec_server_key(_, KeyExchange, _) ->
+ throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {unknown_or_malformed_key_exchange, KeyExchange})).
+
dec_client_key(PKEPMS, ?KEY_EXCHANGE_RSA, {3, 0}) ->
#encrypted_premaster_secret{premaster_secret = PKEPMS};
dec_client_key(<<?UINT16(_), PKEPMS/binary>>, ?KEY_EXCHANGE_RSA, _) ->
@@ -2001,6 +1875,11 @@ dec_sni(<<?BYTE(?SNI_NAMETYPE_HOST_NAME), ?UINT16(Len),
dec_sni(<<?BYTE(_), ?UINT16(Len), _:Len, Rest/binary>>) -> dec_sni(Rest);
dec_sni(_) -> undefined.
+decode_alpn(undefined) ->
+ undefined;
+decode_alpn(#alpn{extension_data=Data}) ->
+ decode_protocols(Data, []).
+
decode_next_protocols({next_protocol_negotiation, Protocols}) ->
decode_protocols(Protocols, []).
@@ -2045,6 +1924,7 @@ from_2bytes(<<>>, Acc) ->
lists:reverse(Acc);
from_2bytes(<<?UINT16(N), Rest/binary>>, Acc) ->
from_2bytes(Rest, [?uint16(N) | Acc]).
+
key_exchange_alg(rsa) ->
?KEY_EXCHANGE_RSA;
key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss;
@@ -2066,8 +1946,122 @@ key_exchange_alg(Alg)
key_exchange_alg(_) ->
?NULL.
+%%-------------Cipher suite handling -----------------------------
+select_cipher_suite(CipherSuites, Suites, false) ->
+ select_cipher_suite(CipherSuites, Suites);
+select_cipher_suite(CipherSuites, Suites, true) ->
+ select_cipher_suite(Suites, CipherSuites).
+
+select_cipher_suite([], _) ->
+ no_suite;
+select_cipher_suite([Suite | ClientSuites], SupportedSuites) ->
+ case is_member(Suite, SupportedSuites) of
+ true ->
+ Suite;
+ false ->
+ select_cipher_suite(ClientSuites, SupportedSuites)
+ end.
+
+is_member(Suite, SupportedSuites) ->
+ lists:member(Suite, SupportedSuites).
+
+psk_secret(PSKIdentity, PSKLookup) ->
+ case handle_psk_identity(PSKIdentity, PSKLookup) of
+ {ok, PSK} when is_binary(PSK) ->
+ Len = erlang:byte_size(PSK),
+ <<?UINT16(Len), 0:(Len*8), ?UINT16(Len), PSK/binary>>;
+ #alert{} = Alert ->
+ Alert;
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
+ end.
+
+psk_secret(PSKIdentity, PSKLookup, PremasterSecret) ->
+ case handle_psk_identity(PSKIdentity, PSKLookup) of
+ {ok, PSK} when is_binary(PSK) ->
+ Len = erlang:byte_size(PremasterSecret),
+ PSKLen = erlang:byte_size(PSK),
+ <<?UINT16(Len), PremasterSecret/binary, ?UINT16(PSKLen), PSK/binary>>;
+ #alert{} = Alert ->
+ Alert;
+ _ ->
+ throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
+ end.
+
+handle_psk_identity(_PSKIdentity, LookupFun)
+ when LookupFun == undefined ->
+ error;
+handle_psk_identity(PSKIdentity, {Fun, UserState}) ->
+ Fun(psk, PSKIdentity, UserState).
+
+filter_hashsigns([], [], _, Acc) ->
+ lists:reverse(Acc);
+filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns,
+ Acc) when KeyExchange == dhe_ecdsa;
+ KeyExchange == ecdhe_ecdsa ->
+ do_filter_hashsigns(ecdsa, Suite, Suites, Algos, HashSigns, Acc);
+
+filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns,
+ Acc) when KeyExchange == rsa;
+ KeyExchange == dhe_rsa;
+ KeyExchange == ecdhe_rsa;
+ KeyExchange == srp_rsa;
+ KeyExchange == rsa_psk ->
+ do_filter_hashsigns(rsa, Suite, Suites, Algos, HashSigns, Acc);
+filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
+ KeyExchange == dhe_dss;
+ KeyExchange == srp_dss ->
+ do_filter_hashsigns(dsa, Suite, Suites, Algos, HashSigns, Acc);
+filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
+ KeyExchange == dh_dss;
+ KeyExchange == dh_rsa;
+ KeyExchange == dh_ecdsa;
+ KeyExchange == ecdh_rsa;
+ KeyExchange == ecdh_ecdsa ->
+ %% Fixed DH certificates MAY be signed with any hash/signature
+ %% algorithm pair appearing in the hash_sign extension. The names
+ %% DH_DSS, DH_RSA, ECDH_ECDSA, and ECDH_RSA are historical.
+ filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
+filter_hashsigns([Suite | Suites], [{KeyExchange,_,_,_} | Algos], HashSigns, Acc) when
+ KeyExchange == dh_anon;
+ KeyExchange == ecdh_anon;
+ KeyExchange == srp_anon;
+ KeyExchange == psk;
+ KeyExchange == dhe_psk ->
+ %% In this case hashsigns is not used as the kexchange is anonaymous
+ filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]).
+
+do_filter_hashsigns(SignAlgo, Suite, Suites, Algos, HashSigns, Acc) ->
+ case lists:keymember(SignAlgo, 2, HashSigns) of
+ true ->
+ filter_hashsigns(Suites, Algos, HashSigns, [Suite| Acc]);
+ false ->
+ filter_hashsigns(Suites, Algos, HashSigns, Acc)
+ end.
+
+unavailable_ecc_suites(no_curve) ->
+ ssl_cipher:ec_keyed_suites();
+unavailable_ecc_suites(_) ->
+ [].
%%-------------Extension handling --------------------------------
+handle_renegotiation_extension(Role, RecordCB, Version, Info, Random, NegotiatedCipherSuite,
+ ClientCipherSuites, Compression,
+ ConnectionStates0, Renegotiation, SecureRenegotation) ->
+ case handle_renegotiation_info(RecordCB, Role, Info, ConnectionStates0,
+ Renegotiation, SecureRenegotation,
+ ClientCipherSuites) of
+ {ok, ConnectionStates} ->
+ hello_pending_connection_states(RecordCB, Role,
+ Version,
+ NegotiatedCipherSuite,
+ Random,
+ Compression,
+ ConnectionStates);
+ #alert{} = Alert ->
+ throw(Alert)
+ end.
+
%% Receive protocols, choose one from the list, return it.
handle_alpn_extension(_, {error, Reason}) ->
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, Reason);
@@ -2130,150 +2124,6 @@ handle_srp_extension(undefined, Session) ->
handle_srp_extension(#srp{username = Username}, Session) ->
Session#session{srp_username = Username}.
-%%-------------Misc --------------------------------
-
-select_cipher_suite(CipherSuites, Suites, false) ->
- select_cipher_suite(CipherSuites, Suites);
-select_cipher_suite(CipherSuites, Suites, true) ->
- select_cipher_suite(Suites, CipherSuites).
-
-select_cipher_suite([], _) ->
- no_suite;
-select_cipher_suite([Suite | ClientSuites], SupportedSuites) ->
- case is_member(Suite, SupportedSuites) of
- true ->
- Suite;
- false ->
- select_cipher_suite(ClientSuites, SupportedSuites)
- end.
-
-int_to_bin(I) ->
- L = (length(integer_to_list(I, 16)) + 1) div 2,
- <<I:(L*8)>>.
-
-is_member(Suite, SupportedSuites) ->
- lists:member(Suite, SupportedSuites).
-
-select_compression(_CompressionMetodes) ->
- ?NULL.
-
-available_signature_algs(undefined, _) ->
- undefined;
-available_signature_algs(SupportedHashSigns, Version) when Version >= {3, 3} ->
- #hash_sign_algos{hash_sign_algos = SupportedHashSigns};
-available_signature_algs(_, _) ->
- undefined.
-
-psk_secret(PSKIdentity, PSKLookup) ->
- case handle_psk_identity(PSKIdentity, PSKLookup) of
- {ok, PSK} when is_binary(PSK) ->
- Len = erlang:byte_size(PSK),
- <<?UINT16(Len), 0:(Len*8), ?UINT16(Len), PSK/binary>>;
- #alert{} = Alert ->
- Alert;
- _ ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
- end.
-
-psk_secret(PSKIdentity, PSKLookup, PremasterSecret) ->
- case handle_psk_identity(PSKIdentity, PSKLookup) of
- {ok, PSK} when is_binary(PSK) ->
- Len = erlang:byte_size(PremasterSecret),
- PSKLen = erlang:byte_size(PSK),
- <<?UINT16(Len), PremasterSecret/binary, ?UINT16(PSKLen), PSK/binary>>;
- #alert{} = Alert ->
- Alert;
- _ ->
- throw(?ALERT_REC(?FATAL, ?ILLEGAL_PARAMETER))
- end.
-
-handle_psk_identity(_PSKIdentity, LookupFun)
- when LookupFun == undefined ->
- error;
-handle_psk_identity(PSKIdentity, {Fun, UserState}) ->
- Fun(psk, PSKIdentity, UserState).
-
-crl_check(_, false, _,_,_, _, _) ->
- valid;
-crl_check(_, peer, _, _,_, valid, _) -> %% Do not check CAs with this option.
- valid;
-crl_check(OtpCert, Check, CertDbHandle, CertDbRef, {Callback, CRLDbHandle}, _, CertPath) ->
- Options = [{issuer_fun, {fun(_DP, CRL, Issuer, DBInfo) ->
- ssl_crl:trusted_cert_and_path(CRL, Issuer, {CertPath,
- DBInfo})
- end, {CertDbHandle, CertDbRef}}},
- {update_crl, fun(DP, CRL) -> Callback:fresh_crl(DP, CRL) end},
- {undetermined_details, true}
- ],
- case dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) of
- no_dps ->
- crl_check_same_issuer(OtpCert, Check,
- dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer),
- Options);
- DpsAndCRLs -> %% This DP list may be empty if relevant CRLs existed
- %% but could not be retrived, will result in {bad_cert, revocation_status_undetermined}
- case public_key:pkix_crls_validate(OtpCert, DpsAndCRLs, Options) of
- {bad_cert, {revocation_status_undetermined, _}} ->
- crl_check_same_issuer(OtpCert, Check, dps_and_crls(OtpCert, Callback,
- CRLDbHandle, same_issuer), Options);
- Other ->
- Other
- end
- end.
-
-crl_check_same_issuer(OtpCert, best_effort, Dps, Options) ->
- case public_key:pkix_crls_validate(OtpCert, Dps, Options) of
- {bad_cert, {revocation_status_undetermined, _}} ->
- valid;
- Other ->
- Other
- end;
-crl_check_same_issuer(OtpCert, _, Dps, Options) ->
- public_key:pkix_crls_validate(OtpCert, Dps, Options).
-
-dps_and_crls(OtpCert, Callback, CRLDbHandle, ext) ->
- case public_key:pkix_dist_points(OtpCert) of
- [] ->
- no_dps;
- DistPoints ->
- Issuer = OtpCert#'OTPCertificate'.tbsCertificate#'OTPTBSCertificate'.issuer,
- CRLs = distpoints_lookup(DistPoints, Issuer, Callback, CRLDbHandle),
- dps_and_crls(DistPoints, CRLs, [])
- end;
-
-dps_and_crls(OtpCert, Callback, CRLDbHandle, same_issuer) ->
- DP = #'DistributionPoint'{distributionPoint = {fullName, GenNames}} =
- public_key:pkix_dist_point(OtpCert),
- CRLs = lists:flatmap(fun({directoryName, Issuer}) ->
- Callback:select(Issuer, CRLDbHandle);
- (_) ->
- []
- end, GenNames),
- [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs].
-
-dps_and_crls([], _, Acc) ->
- Acc;
-dps_and_crls([DP | Rest], CRLs, Acc) ->
- DpCRL = [{DP, {CRL, public_key:der_decode('CertificateList', CRL)}} || CRL <- CRLs],
- dps_and_crls(Rest, CRLs, DpCRL ++ Acc).
-
-distpoints_lookup([],_, _, _) ->
- [];
-distpoints_lookup([DistPoint | Rest], Issuer, Callback, CRLDbHandle) ->
- Result =
- try Callback:lookup(DistPoint, Issuer, CRLDbHandle)
- catch
- error:undef ->
- %% The callback module still uses the 2-argument
- %% version of the lookup function.
- Callback:lookup(DistPoint, CRLDbHandle)
- end,
- case Result of
- not_available ->
- distpoints_lookup(Rest, Issuer, Callback, CRLDbHandle);
- CRLs ->
- CRLs
- end.
sign_algo(?rsaEncryption) ->
rsa;
@@ -2323,7 +2173,6 @@ is_acceptable_hash_sign(_, _, _, KeyExAlgo, _) when
true;
is_acceptable_hash_sign(_,_, _,_,_) ->
false.
-
is_acceptable_hash_sign(Algos, SupportedHashSigns) ->
lists:member(Algos, SupportedHashSigns).
@@ -2343,27 +2192,162 @@ sign_type(dsa) ->
sign_type(ecdsa) ->
?ECDSA_SIGN.
-
-bad_key(#'DSAPrivateKey'{}) ->
- unacceptable_dsa_key;
-bad_key(#'RSAPrivateKey'{}) ->
- unacceptable_rsa_key;
-bad_key(#'ECPrivateKey'{}) ->
- unacceptable_ecdsa_key.
-
-available_signature_algs(undefined, SupportedHashSigns, _, Version) when
- Version >= {3,3} ->
- SupportedHashSigns;
-available_signature_algs(#hash_sign_algos{hash_sign_algos = ClientHashSigns}, SupportedHashSigns,
- _, Version) when Version >= {3,3} ->
- sets:to_list(sets:intersection(sets:from_list(ClientHashSigns),
- sets:from_list(SupportedHashSigns)));
-available_signature_algs(_, _, _, _) ->
- undefined.
-
server_name(_, _, server) ->
undefined; %% Not interesting to check your own name.
server_name(undefined, Host, client) ->
{fallback, Host}; %% Fallback to Host argument to connect
server_name(SNI, _, client) ->
SNI. %% If Server Name Indication is available
+
+client_ecc_extensions(SupportedECCs) ->
+ CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
+ case proplists:get_bool(ecdh, CryptoSupport) of
+ true ->
+ EcPointFormats = #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]},
+ EllipticCurves = SupportedECCs,
+ {EcPointFormats, EllipticCurves};
+ _ ->
+ {undefined, undefined}
+ end.
+
+server_ecc_extension(_Version, EcPointFormats) ->
+ CryptoSupport = proplists:get_value(public_keys, crypto:supports()),
+ case proplists:get_bool(ecdh, CryptoSupport) of
+ true ->
+ handle_ecc_point_fmt_extension(EcPointFormats);
+ false ->
+ undefined
+ end.
+
+handle_ecc_point_fmt_extension(undefined) ->
+ undefined;
+handle_ecc_point_fmt_extension(_) ->
+ #ec_point_formats{ec_point_format_list = [?ECPOINT_UNCOMPRESSED]}.
+
+advertises_ec_ciphers([]) ->
+ false;
+advertises_ec_ciphers([{ecdh_ecdsa, _,_,_} | _]) ->
+ true;
+advertises_ec_ciphers([{ecdhe_ecdsa, _,_,_} | _]) ->
+ true;
+advertises_ec_ciphers([{ecdh_rsa, _,_,_} | _]) ->
+ true;
+advertises_ec_ciphers([{ecdhe_rsa, _,_,_} | _]) ->
+ true;
+advertises_ec_ciphers([{ecdh_anon, _,_,_} | _]) ->
+ true;
+advertises_ec_ciphers([_| Rest]) ->
+ advertises_ec_ciphers(Rest).
+
+select_shared_curve([], _) ->
+ no_curve;
+select_shared_curve([Curve | Rest], Curves) ->
+ case lists:member(Curve, Curves) of
+ true ->
+ {namedCurve, Curve};
+ false ->
+ select_shared_curve(Rest, Curves)
+ end.
+
+sni(undefined) ->
+ undefined;
+sni(disable) ->
+ undefined;
+sni(Hostname) ->
+ #sni{hostname = Hostname}.
+
+renegotiation_info(_, client, _, false) ->
+ #renegotiation_info{renegotiated_connection = undefined};
+renegotiation_info(_RecordCB, server, ConnectionStates, false) ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ case maps:get(secure_renegotiation, ConnectionState) of
+ true ->
+ #renegotiation_info{renegotiated_connection = ?byte(0)};
+ false ->
+ #renegotiation_info{renegotiated_connection = undefined}
+ end;
+renegotiation_info(_RecordCB, client, ConnectionStates, true) ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ case maps:get(secure_renegotiation, ConnectionState) of
+ true ->
+ Data = maps:get(client_verify_data, ConnectionState),
+ #renegotiation_info{renegotiated_connection = Data};
+ false ->
+ #renegotiation_info{renegotiated_connection = undefined}
+ end;
+
+renegotiation_info(_RecordCB, server, ConnectionStates, true) ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ case maps:get(secure_renegotiation, ConnectionState) of
+ true ->
+ CData = maps:get(client_verify_data, ConnectionState),
+ SData = maps:get(server_verify_data, ConnectionState),
+ #renegotiation_info{renegotiated_connection = <<CData/binary, SData/binary>>};
+ false ->
+ #renegotiation_info{renegotiated_connection = undefined}
+ end.
+
+handle_renegotiation_info(_RecordCB, _, #renegotiation_info{renegotiated_connection = ?byte(0)},
+ ConnectionStates, false, _, _) ->
+ {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
+
+handle_renegotiation_info(_RecordCB, server, undefined, ConnectionStates, _, _, CipherSuites) ->
+ case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
+ true ->
+ {ok, ssl_record:set_renegotiation_flag(true, ConnectionStates)};
+ false ->
+ {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)}
+ end;
+
+handle_renegotiation_info(_RecordCB, _, undefined, ConnectionStates, false, _, _) ->
+ {ok, ssl_record:set_renegotiation_flag(false, ConnectionStates)};
+
+handle_renegotiation_info(_RecordCB, client, #renegotiation_info{renegotiated_connection = ClientServerVerify},
+ ConnectionStates, true, _, _) ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ CData = maps:get(client_verify_data, ConnectionState),
+ SData = maps:get(server_verify_data, ConnectionState),
+ case <<CData/binary, SData/binary>> == ClientServerVerify of
+ true ->
+ {ok, ConnectionStates};
+ false ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, client_renegotiation)
+ end;
+handle_renegotiation_info(_RecordCB, server, #renegotiation_info{renegotiated_connection = ClientVerify},
+ ConnectionStates, true, _, CipherSuites) ->
+
+ case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
+ true ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv});
+ false ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ Data = maps:get(client_verify_data, ConnectionState),
+ case Data == ClientVerify of
+ true ->
+ {ok, ConnectionStates};
+ false ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, server_renegotiation)
+ end
+ end;
+
+handle_renegotiation_info(RecordCB, client, undefined, ConnectionStates, true, SecureRenegotation, _) ->
+ handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation);
+
+handle_renegotiation_info(RecordCB, server, undefined, ConnectionStates, true, SecureRenegotation, CipherSuites) ->
+ case is_member(?TLS_EMPTY_RENEGOTIATION_INFO_SCSV, CipherSuites) of
+ true ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, {server_renegotiation, empty_renegotiation_info_scsv});
+ false ->
+ handle_renegotiation_info(RecordCB, ConnectionStates, SecureRenegotation)
+ end.
+
+handle_renegotiation_info(_RecordCB, ConnectionStates, SecureRenegotation) ->
+ ConnectionState = ssl_record:current_connection_state(ConnectionStates, read),
+ case {SecureRenegotation, maps:get(secure_renegotiation, ConnectionState)} of
+ {_, true} ->
+ ?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, already_secure);
+ {true, false} ->
+ ?ALERT_REC(?FATAL, ?NO_RENEGOTIATION);
+ {false, false} ->
+ {ok, ConnectionStates}
+ end.
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index 003ad4994b..dd6a3e8521 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -53,11 +53,11 @@
-type ssl_atom_version() :: tls_record:tls_atom_version().
-type connection_states() :: term(). %% Map
-type connection_state() :: term(). %% Map
+
%%====================================================================
-%% Internal application API
+%% Connection state handling
%%====================================================================
-
%%--------------------------------------------------------------------
-spec current_connection_state(connection_states(), read | write) ->
connection_state().
@@ -267,6 +267,9 @@ set_pending_cipher_state(#{pending_read := Read,
pending_read => Read#{cipher_state => ServerState},
pending_write => Write#{cipher_state => ClientState}}.
+%%====================================================================
+%% Compression
+%%====================================================================
uncompress(?NULL, Data, CS) ->
{Data, CS}.
@@ -282,6 +285,11 @@ compress(?NULL, Data, CS) ->
compressions() ->
[?byte(?NULL)].
+
+%%====================================================================
+%% Payload encryption/decryption
+%%====================================================================
+
%%--------------------------------------------------------------------
-spec cipher(ssl_version(), iodata(), connection_state(), MacHash::binary()) ->
{CipherFragment::binary(), connection_state()}.
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index ccda58e0a9..b033eea261 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -45,10 +45,8 @@
%% Setup
-export([start_fsm/8, start_link/7, init/1]).
--export([encode_data/3, encode_alert/3]).
-
%% State transition handling
--export([next_record/1, next_event/3, next_event/4]).
+-export([next_record/1, next_event/3, next_event/4, handle_common_event/4]).
%% Handshake handling
-export([renegotiate/2, send_handshake/2,
@@ -56,11 +54,11 @@
reinit_handshake_data/1, select_sni_extension/1, empty_connection_state/2]).
%% Alert and close handling
--export([send_alert/2, close/5, protocol_name/0]).
+-export([encode_alert/3, send_alert/2, close/5, protocol_name/0]).
%% Data handling
--export([passive_receive/2, next_record_if_active/1, handle_common_event/4, send/3,
- socket/5, setopts/3, getopts/3]).
+-export([encode_data/3, passive_receive/2, next_record_if_active/1, send/3,
+ socket/5, setopts/3, getopts/3]).
%% gen_statem state functions
-export([init/3, error/3, downgrade/3, %% Initiation and take down states
@@ -72,6 +70,9 @@
%%====================================================================
%% Internal application API
%%====================================================================
+%%====================================================================
+%% Setup
+%%====================================================================
start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_, Tracker} = Opts,
User, {CbModule, _,_, _} = CbInfo,
Timeout) ->
@@ -100,6 +101,165 @@ start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_, Tracker} =
Error
end.
+%%--------------------------------------------------------------------
+-spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
+ {ok, pid()} | ignore | {error, reason()}.
+%%
+%% Description: Creates a gen_statem process which calls Module:init/1 to
+%% initialize.
+%%--------------------------------------------------------------------
+start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
+ {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}.
+
+init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
+ process_flag(trap_exit, true),
+ State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
+ try
+ State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0),
+ gen_statem:enter_loop(?MODULE, [], init, State)
+ catch throw:Error ->
+ gen_statem:enter_loop(?MODULE, [], error, {Error, State0})
+ end.
+%%====================================================================
+%% State transition handling
+%%====================================================================
+next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 ->
+ {no_record, State#state{unprocessed_handshake_events = N-1}};
+
+next_record(#state{protocol_buffers =
+ #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]}
+ = Buffers,
+ 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},
+ connection_states = ConnStates}};
+ #alert{} = Alert ->
+ {Alert, State}
+ end;
+next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []},
+ socket = Socket,
+ close_tag = CloseTag,
+ transport_cb = Transport} = State) ->
+ case tls_socket:setopts(Transport, Socket, [{active,once}]) of
+ ok ->
+ {no_record, State};
+ _ ->
+ self() ! {CloseTag, Socket},
+ {no_record, State}
+ end;
+next_record(State) ->
+ {no_record, State}.
+
+next_event(StateName, Record, State) ->
+ next_event(StateName, Record, State, []).
+
+next_event(connection = StateName, no_record, State0, Actions) ->
+ case next_record_if_active(State0) of
+ {no_record, State} ->
+ ssl_connection:hibernate_after(StateName, State, Actions);
+ {#ssl_tls{} = Record, State} ->
+ {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
+ {#alert{} = Alert, State} ->
+ {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ end;
+next_event(StateName, Record, State, Actions) ->
+ case Record of
+ no_record ->
+ {next_state, StateName, State, Actions};
+ #ssl_tls{} = Record ->
+ {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
+ #alert{} = Alert ->
+ {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
+ end.
+
+handle_common_event(internal, #alert{} = Alert, StateName,
+ #state{negotiated_version = Version} = State) ->
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State);
+%%% TLS record protocol level handshake messages
+handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
+ StateName, #state{protocol_buffers =
+ #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers,
+ negotiated_version = Version,
+ ssl_options = Options} = State0) ->
+ try
+ {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options),
+ State1 =
+ State0#state{protocol_buffers =
+ Buffers#protocol_buffers{tls_handshake_buffer = Buf}},
+ case Packets of
+ [] ->
+ assert_buffer_sanity(Buf, Options),
+ {Record, State} = next_record(State1),
+ next_event(StateName, Record, State);
+ _ ->
+ Events = tls_handshake_events(Packets),
+ case StateName of
+ connection ->
+ ssl_connection:hibernate_after(StateName, State1, Events);
+ _ ->
+ {next_state, StateName,
+ State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
+ end
+ end
+ catch throw:#alert{} = Alert ->
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
+ end;
+%%% TLS record protocol level application data messages
+handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
+ {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]};
+%%% TLS record protocol level change cipher messages
+handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) ->
+ {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
+%%% TLS record protocol level Alert messages
+handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
+ #state{negotiated_version = Version} = State) ->
+ try decode_alerts(EncAlerts) of
+ Alerts = [_|_] ->
+ handle_alerts(Alerts, {next_state, StateName, State});
+ [] ->
+ ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert),
+ Version, StateName, State);
+ #alert{} = Alert ->
+ ssl_connection:handle_own_alert(Alert, Version, StateName, State)
+ catch
+ _:_ ->
+ ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error),
+ Version, StateName, State)
+
+ end;
+%% Ignore unknown TLS record level protocol messages
+handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
+ {next_state, StateName, State}.
+%%====================================================================
+%% Handshake handling
+%%====================================================================
+renegotiate(#state{role = client} = State, Actions) ->
+ %% Handle same way as if server requested
+ %% the renegotiation
+ Hs0 = ssl_handshake:init_handshake_history(),
+ {next_state, connection, State#state{tls_handshake_history = Hs0},
+ [{next_event, internal, #hello_request{}} | Actions]};
+
+renegotiate(#state{role = server,
+ socket = Socket,
+ transport_cb = Transport,
+ negotiated_version = Version,
+ connection_states = ConnectionStates0} = State0, Actions) ->
+ HelloRequest = ssl_handshake:hello_request(),
+ Frag = tls_handshake:encode_handshake(HelloRequest, Version),
+ Hs0 = ssl_handshake:init_handshake_history(),
+ {BinMsg, ConnectionStates} =
+ tls_record:encode_handshake(Frag, Version, ConnectionStates0),
+ send(Transport, Socket, BinMsg),
+ State1 = State0#state{connection_states =
+ ConnectionStates,
+ tls_handshake_history = Hs0},
+ {Record, State} = next_record(State1),
+ next_event(hello, Record, State, Actions).
+
send_handshake(Handshake, State) ->
send_handshake_flight(queue_handshake(Handshake, State)).
@@ -128,15 +288,6 @@ queue_change_cipher(Msg, #state{negotiated_version = Version,
State0#state{connection_states = ConnectionStates,
flight_buffer = Flight0 ++ [BinChangeCipher]}.
-send_alert(Alert, #state{negotiated_version = Version,
- socket = Socket,
- transport_cb = Transport,
- connection_states = ConnectionStates0} = State0) ->
- {BinMsg, ConnectionStates} =
- encode_alert(Alert, Version, ConnectionStates0),
- send(Transport, Socket, BinMsg),
- State0#state{connection_states = ConnectionStates}.
-
reinit_handshake_data(State) ->
%% premaster_secret, public_key_info and tls_handshake_info
%% are only needed during the handshake phase.
@@ -155,8 +306,17 @@ select_sni_extension(_) ->
empty_connection_state(ConnectionEnd, BeastMitigation) ->
ssl_record:empty_connection_state(ConnectionEnd, BeastMitigation).
-encode_data(Data, Version, ConnectionStates0)->
- tls_record:encode_data(Data, Version, ConnectionStates0).
+%%====================================================================
+%% Alert and close handling
+%%====================================================================
+send_alert(Alert, #state{negotiated_version = Version,
+ socket = Socket,
+ transport_cb = Transport,
+ connection_states = ConnectionStates0} = State0) ->
+ {BinMsg, ConnectionStates} =
+ encode_alert(Alert, Version, ConnectionStates0),
+ send(Transport, Socket, BinMsg),
+ State0#state{connection_states = ConnectionStates}.
%%--------------------------------------------------------------------
-spec encode_alert(#alert{}, ssl_record:ssl_version(), ssl_record:connection_states()) ->
@@ -166,42 +326,66 @@ encode_data(Data, Version, ConnectionStates0)->
%%--------------------------------------------------------------------
encode_alert(#alert{} = Alert, Version, ConnectionStates) ->
tls_record:encode_alert_record(Alert, Version, ConnectionStates).
-
+%% User closes or recursive call!
+close({close, Timeout}, Socket, Transport = gen_tcp, _,_) ->
+ tls_socket:setopts(Transport, Socket, [{active, false}]),
+ Transport:shutdown(Socket, write),
+ _ = Transport:recv(Socket, 0, Timeout),
+ ok;
+%% Peer closed socket
+close({shutdown, transport_closed}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
+ close({close, 0}, Socket, Transport, ConnectionStates, Check);
+%% We generate fatal alert
+close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
+ %% Standard trick to try to make sure all
+ %% data sent to the tcp port is really delivered to the
+ %% peer application before tcp port is closed so that the peer will
+ %% get the correct TLS alert message and not only a transport close.
+ %% Will return when other side has closed or after timout millisec
+ %% e.g. we do not want to hang if something goes wrong
+ %% with the network but we want to maximise the odds that
+ %% peer application gets all data sent on the tcp connection.
+ close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check);
+close(downgrade, _,_,_,_) ->
+ ok;
+%% Other
+close(_, Socket, Transport, _,_) ->
+ Transport:close(Socket).
protocol_name() ->
"TLS".
-%%====================================================================
-%% tls_connection_sup API
-%%====================================================================
-%%--------------------------------------------------------------------
--spec start_link(atom(), host(), inet:port_number(), port(), list(), pid(), tuple()) ->
- {ok, pid()} | ignore | {error, reason()}.
-%%
-%% Description: Creates a gen_fsm process which calls Module:init/1 to
-%% initialize. To ensure a synchronized start-up procedure, this function
-%% does not return until Module:init/1 has returned.
-%%--------------------------------------------------------------------
-start_link(Role, Host, Port, Socket, Options, User, CbInfo) ->
- {ok, proc_lib:spawn_link(?MODULE, init, [[Role, Host, Port, Socket, Options, User, CbInfo]])}.
+%%====================================================================
+%% Data handling
+%%====================================================================
+encode_data(Data, Version, ConnectionStates0)->
+ tls_record:encode_data(Data, Version, ConnectionStates0).
-init([Role, Host, Port, Socket, Options, User, CbInfo]) ->
- process_flag(trap_exit, true),
- State0 = initial_state(Role, Host, Port, Socket, Options, User, CbInfo),
- try
- State = ssl_connection:ssl_config(State0#state.ssl_options, Role, State0),
- gen_statem:enter_loop(?MODULE, [], init, State)
- catch throw:Error ->
- gen_statem:enter_loop(?MODULE, [], error, {Error, State0})
+passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) ->
+ case Buffer of
+ <<>> ->
+ {Record, State} = next_record(State0),
+ next_event(StateName, Record, State);
+ _ ->
+ {Record, State} = ssl_connection:read_application_data(<<>>, State0),
+ next_event(StateName, Record, State)
end.
-callback_mode() ->
- state_functions.
+next_record_if_active(State =
+ #state{socket_options =
+ #socket_options{active = false}}) ->
+ {no_record ,State};
+next_record_if_active(State) ->
+ next_record(State).
+
+send(Transport, Socket, Data) ->
+ tls_socket:send(Transport, Socket, Data).
socket(Pid, Transport, Socket, Connection, Tracker) ->
tls_socket:socket(Pid, Transport, Socket, Connection, Tracker).
setopts(Transport, Socket, Other) ->
tls_socket:setopts(Transport, Socket, Other).
+
getopts(Transport, Socket, Tag) ->
tls_socket:getopts(Transport, Socket, Tag).
@@ -244,7 +428,7 @@ init({call, From}, {start, Timeout},
{Record, State} = next_record(State1),
next_event(hello, Record, State);
init(Type, Event, State) ->
- gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
%%--------------------------------------------------------------------
-spec error(gen_statem:event_type(),
@@ -254,8 +438,8 @@ init(Type, Event, State) ->
error({call, From}, {start, _Timeout}, {Error, State}) ->
{stop_and_reply, normal, {reply, From, {error, Error}}, State};
-error({call, From}, Msg, State) ->
- handle_call(Msg, From, ?FUNCTION_NAME, State);
+error({call, _} = Call, Msg, State) ->
+ gen_handshake(?FUNCTION_NAME, Call, Msg, State);
error(_, _, _) ->
{keep_state_and_data, [postpone]}.
@@ -285,13 +469,13 @@ hello(internal, #client_hello{client_version = ClientVersion} = Hello,
undefined -> CurrentProtocol;
_ -> Protocol0
end,
-
- gen_handshake(ssl_connection, hello, internal, {common_client_hello, Type, ServerHelloExt},
- State#state{connection_states = ConnectionStates,
- negotiated_version = Version,
- hashsign_algorithm = HashSign,
- session = Session,
- negotiated_protocol = Protocol})
+ gen_handshake(?FUNCTION_NAME, internal, {common_client_hello, Type, ServerHelloExt},
+ State#state{connection_states = ConnectionStates,
+ negotiated_version = Version,
+ hashsign_algorithm = HashSign,
+ client_hello_version = ClientVersion,
+ session = Session,
+ negotiated_protocol = Protocol})
end;
hello(internal, #server_hello{} = Hello,
#state{connection_states = ConnectionStates0,
@@ -309,7 +493,7 @@ hello(internal, #server_hello{} = Hello,
hello(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
hello(Type, Event, State) ->
- gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
%%--------------------------------------------------------------------
-spec abbreviated(gen_statem:event_type(), term(), #state{}) ->
@@ -318,7 +502,7 @@ hello(Type, Event, State) ->
abbreviated(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
abbreviated(Type, Event, State) ->
- gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
%%--------------------------------------------------------------------
-spec certify(gen_statem:event_type(), term(), #state{}) ->
@@ -327,7 +511,7 @@ abbreviated(Type, Event, State) ->
certify(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
certify(Type, Event, State) ->
- gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
%%--------------------------------------------------------------------
-spec cipher(gen_statem:event_type(), term(), #state{}) ->
@@ -336,7 +520,7 @@ certify(Type, Event, State) ->
cipher(info, Event, State) ->
gen_info(Event, ?FUNCTION_NAME, State);
cipher(Type, Event, State) ->
- gen_handshake(ssl_connection, ?FUNCTION_NAME, Type, Event, State).
+ gen_handshake(?FUNCTION_NAME, Type, Event, State).
%%--------------------------------------------------------------------
-spec connection(gen_statem:event_type(),
@@ -387,156 +571,24 @@ connection(Type, Event, State) ->
downgrade(Type, Event, State) ->
ssl_connection:?FUNCTION_NAME(Type, Event, State, ?MODULE).
-%%--------------------------------------------------------------------
-%% Event handling functions called by state functions to handle
-%% common or unexpected events for the state.
-%%--------------------------------------------------------------------
-handle_call(Event, From, StateName, State) ->
- ssl_connection:handle_call(Event, From, StateName, State, ?MODULE).
-
-%% raw data from socket, unpack records
-handle_info({Protocol, _, Data}, StateName,
- #state{data_tag = Protocol} = State0) ->
- case next_tls_record(Data, State0) of
- {Record, State} ->
- next_event(StateName, Record, State);
- #alert{} = Alert ->
- ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
- {stop, {shutdown, own_alert}}
- end;
-handle_info({CloseTag, Socket}, StateName,
- #state{socket = Socket, close_tag = CloseTag,
- socket_options = #socket_options{active = Active},
- protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs},
- negotiated_version = Version} = State) ->
-
- %% Note that as of TLS 1.1,
- %% failure to properly close a connection no longer requires that a
- %% session not be resumed. This is a change from TLS 1.0 to conform
- %% with widespread implementation practice.
-
- case (Active == false) andalso (CTs =/= []) of
- false ->
- case Version of
- {1, N} when N >= 1 ->
- ok;
- _ ->
- %% As invalidate_sessions here causes performance issues,
- %% we will conform to the widespread implementation
- %% practice and go aginst the spec
- %%invalidate_session(Role, Host, Port, Session)
- ok
- end,
-
- ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, {shutdown, transport_closed}};
- true ->
- %% Fixes non-delivery of final TLS record in {active, once}.
- %% Basically allows the application the opportunity to set {active, once} again
- %% and then receive the final message.
- next_event(StateName, no_record, State)
- end;
-handle_info(Msg, StateName, State) ->
- ssl_connection:handle_info(Msg, StateName, State).
-
-handle_common_event(internal, #alert{} = Alert, StateName,
- #state{negotiated_version = Version} = State) ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State);
-
-%%% TLS record protocol level handshake messages
-handle_common_event(internal, #ssl_tls{type = ?HANDSHAKE, fragment = Data},
- StateName, #state{protocol_buffers =
- #protocol_buffers{tls_handshake_buffer = Buf0} = Buffers,
- negotiated_version = Version,
- ssl_options = Options} = State0) ->
- try
- {Packets, Buf} = tls_handshake:get_tls_handshake(Version,Data,Buf0, Options),
- State1 =
- State0#state{protocol_buffers =
- Buffers#protocol_buffers{tls_handshake_buffer = Buf}},
- case Packets of
- [] ->
- assert_buffer_sanity(Buf, Options),
- {Record, State} = next_record(State1),
- next_event(StateName, Record, State);
- _ ->
- Events = tls_handshake_events(Packets),
- case StateName of
- connection ->
- ssl_connection:hibernate_after(StateName, State1, Events);
- _ ->
- {next_state, StateName,
- State1#state{unprocessed_handshake_events = unprocessed_events(Events)}, Events}
- end
- end
- catch throw:#alert{} = Alert ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State0)
- end;
-%%% TLS record protocol level application data messages
-handle_common_event(internal, #ssl_tls{type = ?APPLICATION_DATA, fragment = Data}, StateName, State) ->
- {next_state, StateName, State, [{next_event, internal, {application_data, Data}}]};
-%%% TLS record protocol level change cipher messages
-handle_common_event(internal, #ssl_tls{type = ?CHANGE_CIPHER_SPEC, fragment = Data}, StateName, State) ->
- {next_state, StateName, State, [{next_event, internal, #change_cipher_spec{type = Data}}]};
-%%% TLS record protocol level Alert messages
-handle_common_event(internal, #ssl_tls{type = ?ALERT, fragment = EncAlerts}, StateName,
- #state{negotiated_version = Version} = State) ->
- try decode_alerts(EncAlerts) of
- Alerts = [_|_] ->
- handle_alerts(Alerts, {next_state, StateName, State});
- [] ->
- ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, empty_alert),
- Version, StateName, State);
- #alert{} = Alert ->
- ssl_connection:handle_own_alert(Alert, Version, StateName, State)
- catch
- _:_ ->
- ssl_connection:handle_own_alert(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, alert_decode_error),
- Version, StateName, State)
-
- end;
-%% Ignore unknown TLS record level protocol messages
-handle_common_event(internal, #ssl_tls{type = _Unknown}, StateName, State) ->
- {next_state, StateName, State}.
-
-send(Transport, Socket, Data) ->
- tls_socket:send(Transport, Socket, Data).
-
-%%--------------------------------------------------------------------
+%--------------------------------------------------------------------
%% gen_statem callbacks
%%--------------------------------------------------------------------
+callback_mode() ->
+ state_functions.
+
terminate(Reason, StateName, State) ->
catch ssl_connection:terminate(Reason, StateName, State).
format_status(Type, Data) ->
ssl_connection:format_status(Type, Data).
-%%--------------------------------------------------------------------
-%% code_change(OldVsn, StateName, State, Extra) -> {ok, StateName, NewState}
-%% Description: Convert process state when code is changed
-%%--------------------------------------------------------------------
-code_change(_OldVsn, StateName, State0, {Direction, From, To}) ->
- State = convert_state(State0, Direction, From, To),
- {ok, StateName, State};
code_change(_OldVsn, StateName, State, _) ->
{ok, StateName, State}.
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) ->
- Frag = tls_handshake:encode_handshake(Handshake, Version),
- Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp),
- {Encoded, ConnectionStates} =
- tls_record:encode_handshake(Frag, Version, ConnectionStates0),
- {Encoded, ConnectionStates, Hist}.
-
-encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
- tls_record:encode_change_cipher_spec(Version, ConnectionStates).
-
-decode_alerts(Bin) ->
- ssl_alert:decode(Bin).
-
initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, User,
{CbModule, DataTag, CloseTag, ErrorTag}) ->
#ssl_options{beast_mitigation = BeastMitigation} = SSLOptions,
@@ -586,108 +638,56 @@ next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buf
#alert{} = Alert ->
Alert
end.
-next_record(#state{unprocessed_handshake_events = N} = State) when N > 0 ->
- {no_record, State#state{unprocessed_handshake_events = N-1}};
-
-next_record(#state{protocol_buffers =
- #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]}
- = Buffers,
- 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},
- connection_states = ConnStates}};
- #alert{} = Alert ->
- {Alert, State}
- end;
-next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = []},
- socket = Socket,
- transport_cb = Transport} = State) ->
- case tls_socket:setopts(Transport, Socket, [{active,once}]) of
- ok ->
- {no_record, State};
- _ ->
- {socket_closed, State}
- end;
-next_record(State) ->
- {no_record, State}.
-
-next_record_if_active(State =
- #state{socket_options =
- #socket_options{active = false}}) ->
- {no_record ,State};
-
-next_record_if_active(State) ->
- next_record(State).
-
-passive_receive(State0 = #state{user_data_buffer = Buffer}, StateName) ->
- case Buffer of
- <<>> ->
- {Record, State} = next_record(State0),
- next_event(StateName, Record, State);
- _ ->
- {Record, State} = ssl_connection:read_application_data(<<>>, State0),
- next_event(StateName, Record, State)
- end.
-
-next_event(StateName, Record, State) ->
- next_event(StateName, Record, State, []).
-
-next_event(StateName, socket_closed, State, _) ->
- ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
- {stop, {shutdown, transport_closed}, State};
-next_event(connection = StateName, no_record, State0, Actions) ->
- case next_record_if_active(State0) of
- {no_record, State} ->
- ssl_connection:hibernate_after(StateName, State, Actions);
- {socket_closed, State} ->
- next_event(StateName, socket_closed, State, Actions);
- {#ssl_tls{} = Record, State} ->
- {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
- {#alert{} = Alert, State} ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
- end;
-next_event(StateName, Record, State, Actions) ->
- case Record of
- no_record ->
- {next_state, StateName, State, Actions};
- #ssl_tls{} = Record ->
- {next_state, StateName, State, [{next_event, internal, {protocol_record, Record}} | Actions]};
- #alert{} = Alert ->
- {next_state, StateName, State, [{next_event, internal, Alert} | Actions]}
- end.
tls_handshake_events(Packets) ->
lists:map(fun(Packet) ->
{next_event, internal, {handshake, Packet}}
end, Packets).
+%% raw data from socket, upack records
+handle_info({Protocol, _, Data}, StateName,
+ #state{data_tag = Protocol} = State0) ->
+ case next_tls_record(Data, State0) of
+ {Record, State} ->
+ next_event(StateName, Record, State);
+ #alert{} = Alert ->
+ ssl_connection:handle_normal_shutdown(Alert, StateName, State0),
+ {stop, {shutdown, own_alert}}
+ end;
+handle_info({CloseTag, Socket}, StateName,
+ #state{socket = Socket, close_tag = CloseTag,
+ socket_options = #socket_options{active = Active},
+ protocol_buffers = #protocol_buffers{tls_cipher_texts = CTs},
+ negotiated_version = Version} = State) ->
-renegotiate(#state{role = client} = State, Actions) ->
- %% Handle same way as if server requested
- %% the renegotiation
- Hs0 = ssl_handshake:init_handshake_history(),
- {next_state, connection, State#state{tls_handshake_history = Hs0},
- [{next_event, internal, #hello_request{}} | Actions]};
+ %% Note that as of TLS 1.1,
+ %% failure to properly close a connection no longer requires that a
+ %% session not be resumed. This is a change from TLS 1.0 to conform
+ %% with widespread implementation practice.
-renegotiate(#state{role = server,
- socket = Socket,
- transport_cb = Transport,
- negotiated_version = Version,
- connection_states = ConnectionStates0} = State0, Actions) ->
- HelloRequest = ssl_handshake:hello_request(),
- Frag = tls_handshake:encode_handshake(HelloRequest, Version),
- Hs0 = ssl_handshake:init_handshake_history(),
- {BinMsg, ConnectionStates} =
- tls_record:encode_handshake(Frag, Version, ConnectionStates0),
- send(Transport, Socket, BinMsg),
- State1 = State0#state{connection_states =
- ConnectionStates,
- tls_handshake_history = Hs0},
- {Record, State} = next_record(State1),
- next_event(hello, Record, State, Actions).
+ case (Active == false) andalso (CTs =/= []) of
+ false ->
+ case Version of
+ {1, N} when N >= 1 ->
+ ok;
+ _ ->
+ %% As invalidate_sessions here causes performance issues,
+ %% we will conform to the widespread implementation
+ %% practice and go aginst the spec
+ %%invalidate_session(Role, Host, Port, Session)
+ ok
+ end,
+
+ ssl_connection:handle_normal_shutdown(?ALERT_REC(?FATAL, ?CLOSE_NOTIFY), StateName, State),
+ {stop, {shutdown, transport_closed}};
+ true ->
+ %% Fixes non-delivery of final TLS record in {active, once}.
+ %% Basically allows the application the opportunity to set {active, once} again
+ %% and then receive the final message.
+ next_event(StateName, no_record, State)
+ end;
+handle_info(Msg, StateName, State) ->
+ ssl_connection:StateName(info, Msg, State, ?MODULE).
handle_alerts([], Result) ->
Result;
@@ -698,47 +698,22 @@ handle_alerts([Alert | Alerts], {next_state, StateName, State}) ->
handle_alerts([Alert | Alerts], {next_state, StateName, State, _Actions}) ->
handle_alerts(Alerts, ssl_connection:handle_alert(Alert, StateName, State)).
+encode_handshake(Handshake, Version, ConnectionStates0, Hist0, V2HComp) ->
+ Frag = tls_handshake:encode_handshake(Handshake, Version),
+ Hist = ssl_handshake:update_handshake_history(Hist0, Frag, V2HComp),
+ {Encoded, ConnectionStates} =
+ tls_record:encode_handshake(Frag, Version, ConnectionStates0),
+ {Encoded, ConnectionStates, Hist}.
-%% User closes or recursive call!
-close({close, Timeout}, Socket, Transport = gen_tcp, _,_) ->
- tls_socket:setopts(Transport, Socket, [{active, false}]),
- Transport:shutdown(Socket, write),
- _ = Transport:recv(Socket, 0, Timeout),
- ok;
-%% Peer closed socket
-close({shutdown, transport_closed}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
- close({close, 0}, Socket, Transport, ConnectionStates, Check);
-%% We generate fatal alert
-close({shutdown, own_alert}, Socket, Transport = gen_tcp, ConnectionStates, Check) ->
- %% Standard trick to try to make sure all
- %% data sent to the tcp port is really delivered to the
- %% peer application before tcp port is closed so that the peer will
- %% get the correct TLS alert message and not only a transport close.
- %% Will return when other side has closed or after timout millisec
- %% e.g. we do not want to hang if something goes wrong
- %% with the network but we want to maximise the odds that
- %% peer application gets all data sent on the tcp connection.
- close({close, ?DEFAULT_TIMEOUT}, Socket, Transport, ConnectionStates, Check);
-close(downgrade, _,_,_,_) ->
- ok;
-%% Other
-close(_, Socket, Transport, _,_) ->
- Transport:close(Socket).
-
-convert_state(#state{ssl_options = Options} = State, up, "5.3.5", "5.3.6") ->
- State#state{ssl_options = convert_options_partial_chain(Options, up)};
-convert_state(#state{ssl_options = Options} = State, down, "5.3.6", "5.3.5") ->
- State#state{ssl_options = convert_options_partial_chain(Options, down)}.
+encode_change_cipher(#change_cipher_spec{}, Version, ConnectionStates) ->
+ tls_record:encode_change_cipher_spec(Version, ConnectionStates).
-convert_options_partial_chain(Options, up) ->
- {Head, Tail} = lists:split(5, tuple_to_list(Options)),
- list_to_tuple(Head ++ [{partial_chain, fun(_) -> unknown_ca end}] ++ Tail);
-convert_options_partial_chain(Options, down) ->
- list_to_tuple(proplists:delete(partial_chain, tuple_to_list(Options))).
+decode_alerts(Bin) ->
+ ssl_alert:decode(Bin).
-gen_handshake(GenConnection, StateName, Type, Event,
+gen_handshake(StateName, Type, Event,
#state{negotiated_version = Version} = State) ->
- try GenConnection:StateName(Type, Event, State, ?MODULE) of
+ try ssl_connection:StateName(Type, Event, State, ?MODULE) of
Result ->
Result
catch
diff --git a/lib/ssl/src/tls_handshake.erl b/lib/ssl/src/tls_handshake.erl
index b54540393a..a38c5704a6 100644
--- a/lib/ssl/src/tls_handshake.erl
+++ b/lib/ssl/src/tls_handshake.erl
@@ -32,13 +32,19 @@
-include("ssl_cipher.hrl").
-include_lib("public_key/include/public_key.hrl").
--export([client_hello/8, hello/4,
- get_tls_handshake/4, encode_handshake/2, decode_handshake/4]).
+%% Handshake handling
+-export([client_hello/8, hello/4]).
+
+%% Handshake encoding
+-export([encode_handshake/2]).
+
+%% Handshake decodeing
+-export([get_tls_handshake/4, decode_handshake/4]).
-type tls_handshake() :: #client_hello{} | ssl_handshake:ssl_handshake().
%%====================================================================
-%% Internal application API
+%% Handshake handling
%%====================================================================
%%--------------------------------------------------------------------
-spec client_hello(host(), inet:port_number(), ssl_record:connection_states(),
@@ -54,15 +60,18 @@ client_hello(Host, Port, ConnectionStates,
} = SslOpts,
Cache, CacheCb, Renegotiation, OwnCert) ->
Version = tls_record:highest_protocol_version(Versions),
- #{security_parameters := SecParams} = ssl_record:pending_connection_state(ConnectionStates, read),
+ #{security_parameters := SecParams} =
+ ssl_record:pending_connection_state(ConnectionStates, read),
AvailableCipherSuites = ssl_handshake:available_suites(UserSuites, Version),
Extensions = ssl_handshake:client_hello_extensions(Version,
AvailableCipherSuites,
- SslOpts, ConnectionStates, Renegotiation),
+ SslOpts, ConnectionStates,
+ Renegotiation),
CipherSuites =
case Fallback of
true ->
- [?TLS_FALLBACK_SCSV | ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation)];
+ [?TLS_FALLBACK_SCSV |
+ ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation)];
false ->
ssl_handshake:cipher_suites(AvailableCipherSuites, Renegotiation)
end,
@@ -85,8 +94,8 @@ client_hello(Host, Port, ConnectionStates,
ssl_record:connection_states(), alpn | npn, binary() | undefined}|
{tls_record:tls_version(), {resumed | new, #session{}},
ssl_record:connection_states(), binary() | undefined,
- #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} | undefined} |
- #alert{}.
+ #hello_extensions{}, {ssl_cipher:hash(), ssl_cipher:sign_algo()} |
+ undefined} | #alert{}.
%%
%% Description: Handles a received hello message
%%--------------------------------------------------------------------
@@ -99,7 +108,8 @@ hello(#server_hello{server_version = Version, random = Random,
case tls_record:is_acceptable_version(Version, SupportedVersions) of
true ->
handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
- Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation);
+ Compression, HelloExt, SslOpt,
+ ConnectionStates0, Renegotiation);
false ->
?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)
end;
@@ -127,18 +137,29 @@ hello(#client_hello{client_version = ClientVersion,
?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, malformed_handshake_data)
end.
+
+%%--------------------------------------------------------------------
+%%% Handshake encodeing
+%%--------------------------------------------------------------------
+
%%--------------------------------------------------------------------
-spec encode_handshake(tls_handshake(), tls_record:tls_version()) -> iolist().
%%
%% Description: Encode a handshake packet
-%%--------------------------------------------------------------------x
+%%--------------------------------------------------------------------
encode_handshake(Package, Version) ->
{MsgType, Bin} = enc_handshake(Package, Version),
Len = byte_size(Bin),
[MsgType, ?uint24(Len), Bin].
+
+%%--------------------------------------------------------------------
+%%% Handshake decodeing
+%%--------------------------------------------------------------------
+
%%--------------------------------------------------------------------
--spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(), #ssl_options{}) ->
+-spec get_tls_handshake(tls_record:tls_version(), binary(), binary() | iolist(),
+ #ssl_options{}) ->
{[tls_handshake()], binary()}.
%%
%% Description: Given buffered and new data from ssl_record, collects
@@ -153,37 +174,45 @@ get_tls_handshake(Version, Data, Buffer, Options) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-handle_client_hello(Version, #client_hello{session_id = SugesstedId,
- cipher_suites = CipherSuites,
- compression_methods = Compressions,
- random = Random,
- extensions = #hello_extensions{elliptic_curves = Curves,
- signature_algs = ClientHashSigns} = HelloExt},
+handle_client_hello(Version,
+ #client_hello{session_id = SugesstedId,
+ cipher_suites = CipherSuites,
+ compression_methods = Compressions,
+ random = Random,
+ extensions =
+ #hello_extensions{elliptic_curves = Curves,
+ signature_algs = ClientHashSigns}
+ = HelloExt},
#ssl_options{versions = Versions,
signature_algs = SupportedHashSigns,
eccs = SupportedECCs,
honor_ecc_order = ECCOrder} = SslOpts,
- {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _}, Renegotiation) ->
+ {Port, Session0, Cache, CacheCb, ConnectionStates0, Cert, _},
+ Renegotiation) ->
case tls_record:is_acceptable_version(Version, Versions) of
true ->
AvailableHashSigns = ssl_handshake:available_signature_algs(
ClientHashSigns, SupportedHashSigns, Cert, Version),
ECCCurve = ssl_handshake:select_curve(Curves, SupportedECCs, ECCOrder),
{Type, #session{cipher_suite = CipherSuite} = Session1}
- = ssl_handshake:select_session(SugesstedId, CipherSuites, AvailableHashSigns, Compressions,
- Port, Session0#session{ecc = ECCCurve}, Version,
- SslOpts, Cache, CacheCb, Cert),
+ = ssl_handshake:select_session(SugesstedId, CipherSuites,
+ AvailableHashSigns, Compressions,
+ Port, Session0#session{ecc = ECCCurve},
+ Version, SslOpts, Cache, CacheCb, Cert),
case CipherSuite of
no_suite ->
?ALERT_REC(?FATAL, ?INSUFFICIENT_SECURITY, no_suitable_ciphers);
_ ->
{KeyExAlg,_,_,_} = ssl_cipher:suite_definition(CipherSuite),
- case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg, SupportedHashSigns, Version) of
+ case ssl_handshake:select_hashsign(ClientHashSigns, Cert, KeyExAlg,
+ SupportedHashSigns, Version) of
#alert{} = Alert ->
Alert;
HashSign ->
- handle_client_hello_extensions(Version, Type, Random, CipherSuites, HelloExt,
- SslOpts, Session1, ConnectionStates0,
+ handle_client_hello_extensions(Version, Type, Random,
+ CipherSuites, HelloExt,
+ SslOpts, Session1,
+ ConnectionStates0,
Renegotiation, HashSign)
end
end;
@@ -191,6 +220,59 @@ handle_client_hello(Version, #client_hello{session_id = SugesstedId,
?ALERT_REC(?FATAL, ?PROTOCOL_VERSION)
end.
+handle_client_hello_extensions(Version, Type, Random, CipherSuites,
+ HelloExt, SslOpts, Session0, ConnectionStates0,
+ Renegotiation, HashSign) ->
+ try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites,
+ HelloExt, Version, SslOpts,
+ Session0, ConnectionStates0,
+ Renegotiation) of
+ #alert{} = Alert ->
+ Alert;
+ {Session, ConnectionStates, Protocol, ServerHelloExt} ->
+ {Version, {Type, Session}, ConnectionStates, Protocol,
+ ServerHelloExt, HashSign}
+ catch throw:Alert ->
+ Alert
+ end.
+
+
+handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
+ Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) ->
+ case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite,
+ Compression, HelloExt, Version,
+ SslOpt, ConnectionStates0,
+ Renegotiation) of
+ #alert{} = Alert ->
+ Alert;
+ {ConnectionStates, ProtoExt, Protocol} ->
+ {Version, SessionId, ConnectionStates, ProtoExt, Protocol}
+ end.
+%%--------------------------------------------------------------------
+enc_handshake(#hello_request{}, _Version) ->
+ {?HELLO_REQUEST, <<>>};
+enc_handshake(#client_hello{client_version = {Major, Minor},
+ random = Random,
+ session_id = SessionID,
+ cipher_suites = CipherSuites,
+ compression_methods = CompMethods,
+ extensions = HelloExtensions}, _Version) ->
+ SIDLength = byte_size(SessionID),
+ BinCompMethods = list_to_binary(CompMethods),
+ CmLength = byte_size(BinCompMethods),
+ BinCipherSuites = list_to_binary(CipherSuites),
+ CsLength = byte_size(BinCipherSuites),
+ ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions),
+
+ {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
+ ?BYTE(SIDLength), SessionID/binary,
+ ?UINT16(CsLength), BinCipherSuites/binary,
+ ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>};
+
+enc_handshake(HandshakeMsg, Version) ->
+ ssl_handshake:encode_handshake(HandshakeMsg, Version).
+
+%%--------------------------------------------------------------------
get_tls_handshake_aux(Version, <<?BYTE(Type), ?UINT24(Length),
Body:Length/binary,Rest/binary>>,
#ssl_options{v2_hello_compatible = V2Hello} = Opts, Acc) ->
@@ -219,11 +301,12 @@ decode_handshake(_Version, ?CLIENT_HELLO, Bin, true) ->
decode_handshake(_Version, ?CLIENT_HELLO, Bin, false) ->
decode_hello(Bin);
-decode_handshake(_Version, ?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
- ?BYTE(SID_length), Session_ID:SID_length/binary,
- ?UINT16(Cs_length), CipherSuites:Cs_length/binary,
- ?BYTE(Cm_length), Comp_methods:Cm_length/binary,
- Extensions/binary>>, _) ->
+decode_handshake(_Version, ?CLIENT_HELLO,
+ <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
+ ?BYTE(SID_length), Session_ID:SID_length/binary,
+ ?UINT16(Cs_length), CipherSuites:Cs_length/binary,
+ ?BYTE(Cm_length), Comp_methods:Cm_length/binary,
+ Extensions/binary>>, _) ->
DecodedExtensions = ssl_handshake:decode_hello_extensions({client, Extensions}),
@@ -268,53 +351,3 @@ decode_v2_hello(<<?BYTE(Major), ?BYTE(Minor),
compression_methods = [?NULL],
extensions = #hello_extensions{}
}.
-
-enc_handshake(#hello_request{}, _Version) ->
- {?HELLO_REQUEST, <<>>};
-enc_handshake(#client_hello{client_version = {Major, Minor},
- random = Random,
- session_id = SessionID,
- cipher_suites = CipherSuites,
- compression_methods = CompMethods,
- extensions = HelloExtensions}, _Version) ->
- SIDLength = byte_size(SessionID),
- BinCompMethods = list_to_binary(CompMethods),
- CmLength = byte_size(BinCompMethods),
- BinCipherSuites = list_to_binary(CipherSuites),
- CsLength = byte_size(BinCipherSuites),
- ExtensionsBin = ssl_handshake:encode_hello_extensions(HelloExtensions),
-
- {?CLIENT_HELLO, <<?BYTE(Major), ?BYTE(Minor), Random:32/binary,
- ?BYTE(SIDLength), SessionID/binary,
- ?UINT16(CsLength), BinCipherSuites/binary,
- ?BYTE(CmLength), BinCompMethods/binary, ExtensionsBin/binary>>};
-
-enc_handshake(HandshakeMsg, Version) ->
- ssl_handshake:encode_handshake(HandshakeMsg, Version).
-
-
-handle_client_hello_extensions(Version, Type, Random, CipherSuites,
- HelloExt, SslOpts, Session0, ConnectionStates0, Renegotiation, HashSign) ->
- try ssl_handshake:handle_client_hello_extensions(tls_record, Random, CipherSuites,
- HelloExt, Version, SslOpts,
- Session0, ConnectionStates0, Renegotiation) of
- #alert{} = Alert ->
- Alert;
- {Session, ConnectionStates, Protocol, ServerHelloExt} ->
- {Version, {Type, Session}, ConnectionStates, Protocol, ServerHelloExt, HashSign}
- catch throw:Alert ->
- Alert
- end.
-
-
-handle_server_hello_extensions(Version, SessionId, Random, CipherSuite,
- Compression, HelloExt, SslOpt, ConnectionStates0, Renegotiation) ->
- case ssl_handshake:handle_server_hello_extensions(tls_record, Random, CipherSuite,
- Compression, HelloExt, Version,
- SslOpt, ConnectionStates0, Renegotiation) of
- #alert{} = Alert ->
- Alert;
- {ConnectionStates, ProtoExt, Protocol} ->
- {Version, SessionId, ConnectionStates, ProtoExt, Protocol}
- end.
-
diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl
index 4ac6cdc6b5..ab179c1bf0 100644
--- a/lib/ssl/src/tls_record.erl
+++ b/lib/ssl/src/tls_record.erl
@@ -39,15 +39,15 @@
encode_change_cipher_spec/2, encode_data/3]).
-export([encode_plain_text/4]).
+%% Decoding
+-export([decode_cipher_text/3]).
+
%% Protocol version handling
-export([protocol_version/1, lowest_protocol_version/1, lowest_protocol_version/2,
highest_protocol_version/1, highest_protocol_version/2,
is_higher/2, supported_protocol_versions/0,
is_acceptable_version/1, is_acceptable_version/2, hello_version/2]).
-%% Decoding
--export([decode_cipher_text/3]).
-
-export_type([tls_version/0, tls_atom_version/0]).
-type tls_version() :: ssl_record:ssl_version().
@@ -56,13 +56,12 @@
-compile(inline).
%%====================================================================
-%% Internal application API
+%% Handling of incoming data
%%====================================================================
%%--------------------------------------------------------------------
-spec init_connection_states(client | server, one_n_minus_one | zero_n | disabled) ->
ssl_record:connection_states().
-%% %
- %
+%%
%% Description: Creates a connection_states record with appropriate
%% values for the initial SSL connection setup.
%%--------------------------------------------------------------------
@@ -87,6 +86,10 @@ get_tls_records(Data, <<>>) ->
get_tls_records(Data, Buffer) ->
get_tls_records_aux(list_to_binary([Buffer, Data]), []).
+%%====================================================================
+%% Encoding
+%%====================================================================
+
%%--------------------------------------------------------------------
-spec encode_handshake(iolist(), tls_version(), ssl_record:connection_states()) ->
{iolist(), ssl_record:connection_states()}.
@@ -141,6 +144,74 @@ encode_data(Frag, Version,
Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH, Version, BCA, BeastMitigation),
encode_iolist(?APPLICATION_DATA, Data, Version, ConnectionStates).
+%%====================================================================
+%% Decoding
+%%====================================================================
+
+%%--------------------------------------------------------------------
+-spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) ->
+ {#ssl_tls{}, ssl_record:connection_states()}| #alert{}.
+%%
+%% Description: Decode cipher text
+%%--------------------------------------------------------------------
+decode_cipher_text(#ssl_tls{type = Type, version = Version,
+ fragment = CipherFragment} = CipherText,
+ #{current_read :=
+ #{compression_state := CompressionS0,
+ sequence_number := Seq,
+ cipher_state := CipherS0,
+ security_parameters :=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ bulk_cipher_algorithm =
+ BulkCipherAlgo,
+ compression_algorithm = CompAlg}
+ } = ReadState0} = ConnnectionStates0, _) ->
+ AAD = calc_aad(Type, Version, ReadState0),
+ case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, Seq, AAD, CipherFragment, Version) of
+ {PlainFragment, CipherS1} ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#{
+ current_read => ReadState0#{
+ cipher_state => CipherS1,
+ sequence_number => Seq + 1,
+ compression_state => CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ #alert{} = Alert ->
+ Alert
+ end;
+
+decode_cipher_text(#ssl_tls{type = Type, version = Version,
+ fragment = CipherFragment} = CipherText,
+ #{current_read :=
+ #{compression_state := CompressionS0,
+ sequence_number := Seq,
+ security_parameters :=
+ #security_parameters{compression_algorithm = CompAlg}
+ } = ReadState0} = ConnnectionStates0, PaddingCheck) ->
+ case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of
+ {PlainFragment, Mac, ReadState1} ->
+ MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1),
+ case ssl_record:is_correct_mac(Mac, MacHash) of
+ true ->
+ {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
+ PlainFragment, CompressionS0),
+ ConnnectionStates = ConnnectionStates0#{
+ current_read => ReadState1#{
+ sequence_number => Seq + 1,
+ compression_state => CompressionS1}},
+ {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
+ false ->
+ ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
+ end;
+ #alert{} = Alert ->
+ Alert
+ end.
+
+%%====================================================================
+%% Protocol version handling
+%%====================================================================
%%--------------------------------------------------------------------
-spec protocol_version(tls_atom_version() | tls_version()) ->
@@ -278,11 +349,6 @@ supported_protocol_versions([_|_] = Vsns) ->
end
end.
-%%--------------------------------------------------------------------
-%%
-%% Description: ssl version 2 is not acceptable security risks are too big.
-%%
-%%--------------------------------------------------------------------
-spec is_acceptable_version(tls_version()) -> boolean().
is_acceptable_version({N,_})
when N >= ?LOWEST_MAJOR_SUPPORTED_VERSION ->
@@ -302,6 +368,7 @@ hello_version(Version, _) when Version >= {3, 3} ->
Version;
hello_version(_, Versions) ->
lowest_protocol_version(Versions).
+
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
@@ -376,37 +443,17 @@ get_tls_records_aux(Data, Acc) ->
false ->
?ALERT_REC(?FATAL, ?UNEXPECTED_MESSAGE)
end.
-
+%%--------------------------------------------------------------------
encode_plain_text(Type, Version, Data, #{current_write := Write0} = ConnectionStates) ->
{CipherFragment, Write1} = do_encode_plain_text(Type, Version, Data, Write0),
{CipherText, Write} = encode_tls_cipher_text(Type, Version, CipherFragment, Write1),
{CipherText, ConnectionStates#{current_write => Write}}.
-lowest_list_protocol_version(Ver, []) ->
- Ver;
-lowest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
- lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest).
-
-highest_list_protocol_version(Ver, []) ->
- Ver;
-highest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
- highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest).
-
encode_tls_cipher_text(Type, {MajVer, MinVer}, Fragment, #{sequence_number := Seq} = Write) ->
Length = erlang:iolist_size(Fragment),
{[<<?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer), ?UINT16(Length)>>, Fragment],
Write#{sequence_number => Seq +1}}.
-highest_protocol_version() ->
- highest_protocol_version(supported_protocol_versions()).
-
-lowest_protocol_version() ->
- lowest_protocol_version(supported_protocol_versions()).
-
-sufficient_tlsv1_2_crypto_support() ->
- CryptoSupport = crypto:supports(),
- proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)).
-
encode_iolist(Type, Data, Version, ConnectionStates0) ->
{ConnectionStates, EncodedMsg} =
lists:foldl(fun(Text, {CS0, Encoded}) ->
@@ -415,6 +462,31 @@ encode_iolist(Type, Data, Version, ConnectionStates0) ->
{CS1, [Enc | Encoded]}
end, {ConnectionStates0, []}, Data),
{lists:reverse(EncodedMsg), ConnectionStates}.
+%%--------------------------------------------------------------------
+do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
+ security_parameters :=
+ #security_parameters{
+ cipher_type = ?AEAD,
+ compression_algorithm = CompAlg}
+ } = WriteState0) ->
+ {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
+ WriteState1 = WriteState0#{compression_state => CompS1},
+ AAD = calc_aad(Type, Version, WriteState1),
+ ssl_record:cipher_aead(Version, Comp, WriteState1, AAD);
+do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
+ security_parameters :=
+ #security_parameters{compression_algorithm = CompAlg}
+ }= WriteState0) ->
+ {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
+ WriteState1 = WriteState0#{compression_state => CompS1},
+ MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1),
+ ssl_record:cipher(Version, Comp, WriteState1, MacHash);
+do_encode_plain_text(_,_,_,CS) ->
+ exit({cs, CS}).
+%%--------------------------------------------------------------------
+calc_aad(Type, {MajVer, MinVer},
+ #{sequence_number := SeqNo}) ->
+ <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
%% 1/n-1 splitting countermeasure Rizzo/Duong-Beast, RC4 chiphers are
%% not vulnerable to this attack.
@@ -440,89 +512,25 @@ do_split_bin(Bin, ChunkSize, Acc) ->
_ ->
lists:reverse(Acc, [Bin])
end.
-
%%--------------------------------------------------------------------
--spec decode_cipher_text(#ssl_tls{}, ssl_record:connection_states(), boolean()) ->
- {#ssl_tls{}, ssl_record:connection_states()}| #alert{}.
-%%
-%% Description: Decode cipher text
-%%--------------------------------------------------------------------
-decode_cipher_text(#ssl_tls{type = Type, version = Version,
- fragment = CipherFragment} = CipherText,
- #{current_read :=
- #{compression_state := CompressionS0,
- sequence_number := Seq,
- cipher_state := CipherS0,
- security_parameters :=
- #security_parameters{
- cipher_type = ?AEAD,
- bulk_cipher_algorithm =
- BulkCipherAlgo,
- compression_algorithm = CompAlg}
- } = ReadState0} = ConnnectionStates0, _) ->
- AAD = calc_aad(Type, Version, ReadState0),
- case ssl_cipher:decipher_aead(BulkCipherAlgo, CipherS0, Seq, AAD, CipherFragment, Version) of
- {PlainFragment, CipherS1} ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
- PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#{
- current_read => ReadState0#{
- cipher_state => CipherS1,
- sequence_number => Seq + 1,
- compression_state => CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
- #alert{} = Alert ->
- Alert
- end;
+lowest_list_protocol_version(Ver, []) ->
+ Ver;
+lowest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
+ lowest_list_protocol_version(lowest_protocol_version(Ver1, Ver2), Rest).
-decode_cipher_text(#ssl_tls{type = Type, version = Version,
- fragment = CipherFragment} = CipherText,
- #{current_read :=
- #{compression_state := CompressionS0,
- sequence_number := Seq,
- security_parameters :=
- #security_parameters{compression_algorithm = CompAlg}
- } = ReadState0} = ConnnectionStates0, PaddingCheck) ->
- case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of
- {PlainFragment, Mac, ReadState1} ->
- MacHash = ssl_cipher:calc_mac_hash(Type, Version, PlainFragment, ReadState1),
- case ssl_record:is_correct_mac(Mac, MacHash) of
- true ->
- {Plain, CompressionS1} = ssl_record:uncompress(CompAlg,
- PlainFragment, CompressionS0),
- ConnnectionStates = ConnnectionStates0#{
- current_read => ReadState1#{
- sequence_number => Seq + 1,
- compression_state => CompressionS1}},
- {CipherText#ssl_tls{fragment = Plain}, ConnnectionStates};
- false ->
- ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC)
- end;
- #alert{} = Alert ->
- Alert
- end.
+highest_list_protocol_version(Ver, []) ->
+ Ver;
+highest_list_protocol_version(Ver1, [Ver2 | Rest]) ->
+ highest_list_protocol_version(highest_protocol_version(Ver1, Ver2), Rest).
+
+highest_protocol_version() ->
+ highest_protocol_version(supported_protocol_versions()).
+
+lowest_protocol_version() ->
+ lowest_protocol_version(supported_protocol_versions()).
+
+sufficient_tlsv1_2_crypto_support() ->
+ CryptoSupport = crypto:supports(),
+ proplists:get_bool(sha256, proplists:get_value(hashs, CryptoSupport)).
-do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
- security_parameters :=
- #security_parameters{
- cipher_type = ?AEAD,
- compression_algorithm = CompAlg}
- } = WriteState0) ->
- {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
- WriteState1 = WriteState0#{compression_state => CompS1},
- AAD = calc_aad(Type, Version, WriteState1),
- ssl_record:cipher_aead(Version, Comp, WriteState1, AAD);
-do_encode_plain_text(Type, Version, Data, #{compression_state := CompS0,
- security_parameters :=
- #security_parameters{compression_algorithm = CompAlg}
- }= WriteState0) ->
- {Comp, CompS1} = ssl_record:compress(CompAlg, Data, CompS0),
- WriteState1 = WriteState0#{compression_state => CompS1},
- MacHash = ssl_cipher:calc_mac_hash(Type, Version, Comp, WriteState1),
- ssl_record:cipher(Version, Comp, WriteState1, MacHash);
-do_encode_plain_text(_,_,_,CS) ->
- exit({cs, CS}).
-calc_aad(Type, {MajVer, MinVer},
- #{sequence_number := SeqNo}) ->
- <<?UINT64(SeqNo), ?BYTE(Type), ?BYTE(MajVer), ?BYTE(MinVer)>>.
diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk
index bb77326751..cf6481d14c 100644
--- a/lib/ssl/vsn.mk
+++ b/lib/ssl/vsn.mk
@@ -1 +1 @@
-SSL_VSN = 8.2.1
+SSL_VSN = 8.2.2
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index 93eac8220d..e7ea38c5c3 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -104,7 +104,8 @@ XML_REF3_FILES = \
XML_REF6_FILES = stdlib_app.xml
XML_PART_FILES = part.xml
-XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml
+XML_CHAPTER_FILES = introduction.xml io_protocol.xml unicode_usage.xml \
+ notes.xml assert_hrl.xml
BOOK_FILES = book.xml
diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml
index e86f45431f..d822aca89c 100644
--- a/lib/stdlib/doc/src/unicode.xml
+++ b/lib/stdlib/doc/src/unicode.xml
@@ -239,8 +239,13 @@
<c><anno>InEncoding</anno></c>.</p>
</item>
</list>
- <p>Only when <c><anno>InEncoding</anno></c> is one of the UTF
- encodings, integers in the list are allowed to be &gt; 255.</p>
+ <p>
+ Note that integers in the list always represent code points
+ regardless of <c><anno>InEncoding</anno></c> passed. If
+ <c><anno>InEncoding</anno> latin1</c> is passed, only code
+ points &lt; 256 are allowed; otherwise, all valid unicode code
+ points are allowed.
+ </p>
<p>If <c><anno>InEncoding</anno></c> is <c>latin1</c>, parameter
<c><anno>Data</anno></c> corresponds to the <c>iodata()</c> type,
but for <c>unicode</c>, parameter <c><anno>Data</anno></c> can
diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl
index 4972da297d..ab041ff53c 100644
--- a/lib/stdlib/src/string.erl
+++ b/lib/stdlib/src/string.erl
@@ -74,19 +74,21 @@
-export([to_upper/1, to_lower/1]).
%%
-import(lists,[member/2]).
-
-compile({no_auto_import,[length/1]}).
+-compile({inline, [btoken/2, rev/1, append/2, stack/2, search_compile/1]}).
+-define(ASCII_LIST(CP1,CP2), CP1 < 256, CP2 < 256, CP1 =/= $\r).
-export_type([grapheme_cluster/0]).
-type grapheme_cluster() :: char() | [char()].
-type direction() :: 'leading' | 'trailing'.
--dialyzer({no_improper_lists, stack/2}).
+-dialyzer({no_improper_lists, [stack/2, length_b/3]}).
%%% BIFs internal (not documented) should not to be used outside of this module
%%% May be removed
-export([list_to_float/1, list_to_integer/1]).
+
%% Uses bifs: string:list_to_float/1 and string:list_to_integer/1
-spec list_to_float(String) -> {Float, Rest} | {'error', Reason} when
String :: string(),
@@ -117,8 +119,10 @@ is_empty(_) -> false.
%% Count the number of grapheme clusters in chardata
-spec length(String::unicode:chardata()) -> non_neg_integer().
+length(<<CP1/utf8, Bin/binary>>) ->
+ length_b(Bin, CP1, 0);
length(CD) ->
- length_1(unicode_util:gc(CD), 0).
+ length_1(CD, 0).
%% Convert a string to a list of grapheme clusters
-spec to_graphemes(String::unicode:chardata()) -> [grapheme_cluster()].
@@ -166,6 +170,8 @@ equal(A, B, true, Norm) ->
%% Reverse grapheme clusters
-spec reverse(String::unicode:chardata()) -> [grapheme_cluster()].
+reverse(<<CP1/utf8, Rest/binary>>) ->
+ reverse_b(Rest, CP1, []);
reverse(CD) ->
reverse_1(CD, []).
@@ -176,7 +182,10 @@ reverse(CD) ->
Start :: non_neg_integer(),
Slice :: unicode:chardata().
slice(CD, N) when is_integer(N), N >= 0 ->
- slice_l(CD, N, is_binary(CD)).
+ case slice_l0(CD, N) of
+ [] when is_binary(CD) -> <<>>;
+ Res -> Res
+ end.
-spec slice(String, Start, Length) -> Slice when
String::unicode:chardata(),
@@ -185,9 +194,15 @@ slice(CD, N) when is_integer(N), N >= 0 ->
Slice :: unicode:chardata().
slice(CD, N, Length)
when is_integer(N), N >= 0, is_integer(Length), Length > 0 ->
- slice_trail(slice_l(CD, N, is_binary(CD)), Length);
+ case slice_l0(CD, N) of
+ [] when is_binary(CD) -> <<>>;
+ L -> slice_trail(L, Length)
+ end;
slice(CD, N, infinity) ->
- slice_l(CD, N, is_binary(CD));
+ case slice_l0(CD, N) of
+ [] when is_binary(CD) -> <<>>;
+ Res -> Res
+ end;
slice(CD, _, 0) ->
case is_binary(CD) of
true -> <<>>;
@@ -246,18 +261,22 @@ trim(Str, Dir) ->
Dir :: direction() | 'both',
Characters :: [grapheme_cluster()].
trim(Str, _, []) -> Str;
+trim(Str, leading, [Sep]) when is_list(Str), Sep < 256 ->
+ trim_ls(Str, Sep);
trim(Str, leading, Sep) when is_list(Sep) ->
- trim_l(Str, search_pattern(Sep));
-trim(Str, trailing, Sep) when is_list(Sep) ->
- trim_t(Str, 0, search_pattern(Sep));
-trim(Str, both, Sep0) when is_list(Sep0) ->
- Sep = search_pattern(Sep0),
- trim_t(trim_l(Str,Sep), 0, Sep).
+ trim_l(Str, Sep);
+trim(Str, trailing, [Sep]) when is_list(Str), Sep < 256 ->
+ trim_ts(Str, Sep);
+trim(Str, trailing, Seps0) when is_list(Seps0) ->
+ Seps = search_pattern(Seps0),
+ trim_t(Str, 0, Seps);
+trim(Str, both, Sep) when is_list(Sep) ->
+ trim(trim(Str,leading,Sep), trailing, Sep).
%% Delete trailing newlines or \r\n
-spec chomp(String::unicode:chardata()) -> unicode:chardata().
chomp(Str) ->
- trim_t(Str,0, {[[$\r,$\n],$\n], [$\r,$\n], [<<$\r>>,<<$\n>>]}).
+ trim(Str, trailing, [[$\r,$\n],$\n]).
%% Split String into two parts where the leading part consists of Characters
-spec take(String, Characters) -> {Leading, Trailing} when
@@ -290,8 +309,7 @@ take(Str, [], Complement, Dir) ->
{true, leading} -> {Str, Empty};
{true, trailing} -> {Empty, Str}
end;
-take(Str, Sep0, false, leading) ->
- Sep = search_pattern(Sep0),
+take(Str, Sep, false, leading) ->
take_l(Str, Sep, []);
take(Str, Sep0, true, leading) ->
Sep = search_pattern(Sep0),
@@ -451,6 +469,7 @@ replace(String, SearchPattern, Replacement, Where) ->
SeparatorList::[grapheme_cluster()]) ->
[unicode:chardata()].
lexemes([], _) -> [];
+lexemes(Str, []) -> [Str];
lexemes(Str, Seps0) when is_list(Seps0) ->
Seps = search_pattern(Seps0),
lexemes_m(Str, Seps, []).
@@ -484,13 +503,13 @@ find(String, SearchPattern, leading) ->
find(String, SearchPattern, trailing) ->
find_r(String, unicode:characters_to_list(SearchPattern), nomatch).
-%% Fetch first codepoint and return rest in tail
+%% Fetch first grapheme cluster and return rest in tail
-spec next_grapheme(String::unicode:chardata()) ->
maybe_improper_list(grapheme_cluster(),unicode:chardata()) |
{error,unicode:chardata()}.
next_grapheme(CD) -> unicode_util:gc(CD).
-%% Fetch first grapheme cluster and return rest in tail
+%% Fetch first codepoint and return rest in tail
-spec next_codepoint(String::unicode:chardata()) ->
maybe_improper_list(char(),unicode:chardata()) |
{error,unicode:chardata()}.
@@ -498,10 +517,23 @@ next_codepoint(CD) -> unicode_util:cp(CD).
%% Internals
-length_1([_|Rest], N) ->
- length_1(unicode_util:gc(Rest), N+1);
-length_1([], N) ->
- N.
+length_1([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2) ->
+ length_1(Cont, N+1);
+length_1(Str, N) ->
+ case unicode_util:gc(Str) of
+ [] -> N;
+ [_|Rest] -> length_1(Rest, N+1)
+ end.
+
+length_b(<<CP2/utf8, Rest/binary>>, CP1, N)
+ when ?ASCII_LIST(CP1,CP2) ->
+ length_b(Rest, CP2, N+1);
+length_b(Bin0, CP1, N) ->
+ [_|Bin1] = unicode_util:gc([CP1|Bin0]),
+ case unicode_util:cp(Bin1) of
+ [] -> N+1;
+ [CP3|Bin] -> length_b(Bin, CP3, N+1)
+ end.
equal_1([A|AR], [B|BR]) when is_integer(A), is_integer(B) ->
A =:= B andalso equal_1(AR, BR);
@@ -540,29 +572,66 @@ equal_norm_nocase(A0, B0, Norm) ->
{L1,L2} when is_list(L1), is_list(L2) -> false
end.
+reverse_1([CP1|[CP2|_]=Cont], Acc) when ?ASCII_LIST(CP1,CP2) ->
+ reverse_1(Cont, [CP1|Acc]);
reverse_1(CD, Acc) ->
case unicode_util:gc(CD) of
[GC|Rest] -> reverse_1(Rest, [GC|Acc]);
[] -> Acc
end.
-slice_l(CD, N, Binary) when N > 0 ->
+reverse_b(<<CP2/utf8, Rest/binary>>, CP1, Acc)
+ when ?ASCII_LIST(CP1,CP2) ->
+ reverse_b(Rest, CP2, [CP1|Acc]);
+reverse_b(Bin0, CP1, Acc) ->
+ [GC|Bin1] = unicode_util:gc([CP1|Bin0]),
+ case unicode_util:cp(Bin1) of
+ [] -> [GC|Acc];
+ [CP3|Bin] -> reverse_b(Bin, CP3, [GC|Acc])
+ end.
+
+slice_l0(<<CP1/utf8, Bin/binary>>, N) when N > 0 ->
+ slice_lb(Bin, CP1, N);
+slice_l0(L, N) ->
+ slice_l(L, N).
+
+slice_l([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 ->
+ slice_l(Cont, N-1);
+slice_l(CD, N) when N > 0 ->
case unicode_util:gc(CD) of
- [_|Cont] -> slice_l(Cont, N-1, Binary);
- [] when Binary -> <<>>;
+ [_|Cont] -> slice_l(Cont, N-1);
[] -> []
end;
-slice_l(Cont, 0, Binary) ->
- case is_empty(Cont) of
- true when Binary -> <<>>;
- _ -> Cont
+slice_l(Cont, 0) ->
+ Cont.
+
+slice_lb(<<CP2/utf8, Bin/binary>>, CP1, N) when ?ASCII_LIST(CP1,CP2), N > 1 ->
+ slice_lb(Bin, CP2, N-1);
+slice_lb(Bin, CP1, N) ->
+ [_|Rest] = unicode_util:gc([CP1|Bin]),
+ if N > 1 ->
+ case unicode_util:cp(Rest) of
+ [CP2|Cont] -> slice_lb(Cont, CP2, N-1);
+ [] -> <<>>
+ end;
+ N =:= 1 ->
+ Rest
end.
+slice_trail(Orig, N) when is_binary(Orig) ->
+ case Orig of
+ <<CP1/utf8, Bin/binary>> when N > 0 ->
+ Length = slice_bin(Bin, CP1, N),
+ Sz = byte_size(Orig) - Length,
+ <<Keep:Sz/binary, _/binary>> = Orig,
+ Keep;
+ _ -> <<>>
+ end;
slice_trail(CD, N) when is_list(CD) ->
- slice_list(CD, N);
-slice_trail(CD, N) when is_binary(CD) ->
- slice_bin(CD, N, CD).
+ slice_list(CD, N).
+slice_list([CP1|[CP2|_]=Cont], N) when ?ASCII_LIST(CP1,CP2),N > 0 ->
+ [CP1|slice_list(Cont, N-1)];
slice_list(CD, N) when N > 0 ->
case unicode_util:gc(CD) of
[GC|Cont] -> append(GC, slice_list(Cont, N-1));
@@ -571,17 +640,16 @@ slice_list(CD, N) when N > 0 ->
slice_list(_, 0) ->
[].
-slice_bin(CD, N, Orig) when N > 0 ->
- case unicode_util:gc(CD) of
- [_|Cont] -> slice_bin(Cont, N-1, Orig);
- [] -> Orig
+slice_bin(<<CP2/utf8, Bin/binary>>, CP1, N) when ?ASCII_LIST(CP1,CP2), N > 0 ->
+ slice_bin(Bin, CP2, N-1);
+slice_bin(CD, CP1, N) when N > 0 ->
+ [_|Bin] = unicode_util:gc([CP1|CD]),
+ case unicode_util:cp(Bin) of
+ [CP2|Cont] -> slice_bin(Cont, CP2, N-1);
+ [] -> 0
end;
-slice_bin([], 0, Orig) ->
- Orig;
-slice_bin(CD, 0, Orig) ->
- Sz = byte_size(Orig) - byte_size(CD),
- <<Keep:Sz/binary, _/binary>> = Orig,
- Keep.
+slice_bin(CD, CP1, 0) ->
+ byte_size(CD)+byte_size(<<CP1/utf8>>).
uppercase_list(CPs0) ->
case unicode_util:uppercase(CPs0) of
@@ -631,16 +699,31 @@ casefold_bin(CPs0, Acc) ->
[] -> Acc
end.
-
+%% Fast path for ascii searching for one character in lists
+trim_ls([CP1|[CP2|_]=Cont]=Str, Sep)
+ when ?ASCII_LIST(CP1,CP2) ->
+ case Sep of
+ CP1 -> trim_ls(Cont, Sep);
+ _ -> Str
+ end;
+trim_ls(Str, Sep) ->
+ trim_l(Str, [Sep]).
+
+trim_l([CP1|[CP2|_]=Cont]=Str, Sep)
+ when ?ASCII_LIST(CP1,CP2) ->
+ case lists:member(CP1, Sep) of
+ true -> trim_l(Cont, Sep);
+ false -> Str
+ end;
trim_l([Bin|Cont0], Sep) when is_binary(Bin) ->
case bin_search_inv(Bin, Cont0, Sep) of
{nomatch, Cont} -> trim_l(Cont, Sep);
Keep -> Keep
end;
-trim_l(Str, {GCs, _, _}=Sep) when is_list(Str) ->
+trim_l(Str, Sep) when is_list(Str) ->
case unicode_util:gc(Str) of
[C|Cs] ->
- case lists:member(C, GCs) of
+ case lists:member(C, Sep) of
true -> trim_l(Cs, Sep);
false -> Str
end;
@@ -652,15 +735,51 @@ trim_l(Bin, Sep) when is_binary(Bin) ->
[Keep] -> Keep
end.
-trim_t([Bin|Cont0], N, Sep) when is_binary(Bin) ->
+%% Fast path for ascii searching for one character in lists
+trim_ts([Sep|Cs1]=Str, Sep) ->
+ case Cs1 of
+ [] -> [];
+ [CP2|_] when ?ASCII_LIST(Sep,CP2) ->
+ Tail = trim_ts(Cs1, Sep),
+ case is_empty(Tail) of
+ true -> [];
+ false -> [Sep|Tail]
+ end;
+ _ ->
+ trim_t(Str, 0, search_pattern([Sep]))
+ end;
+trim_ts([CP|Cont],Sep) when is_integer(CP) ->
+ [CP|trim_ts(Cont, Sep)];
+trim_ts(Str, Sep) ->
+ trim_t(Str, 0, search_pattern([Sep])).
+
+trim_t([CP1|Cont]=Cs0, _, {GCs,CPs,_}=Seps) when is_integer(CP1) ->
+ case lists:member(CP1, CPs) of
+ true ->
+ [GC|Cs1] = unicode_util:gc(Cs0),
+ case lists:member(GC, GCs) of
+ true ->
+ Tail = trim_t(Cs1, 0, Seps),
+ case is_empty(Tail) of
+ true -> [];
+ false -> append(GC,Tail)
+ end;
+ false ->
+ append(GC,trim_t(Cs1, 0, Seps))
+ end;
+ false ->
+ [CP1|trim_t(Cont, 0, Seps)]
+ end;
+trim_t([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search(Rest, Cont0, Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(Rest, Cont0, Seps) of
{nomatch,_} ->
- stack(Bin, trim_t(Cont0, 0, Sep));
+ stack(Bin, trim_t(Cont0, 0, Seps));
[SepStart|Cont1] ->
- case bin_search_inv(SepStart, Cont1, Sep) of
+ case bin_search_inv(SepStart, Cont1, GCs) of
{nomatch, Cont} ->
- Tail = trim_t(Cont, 0, Sep),
+ Tail = trim_t(Cont, 0, Seps),
case is_empty(Tail) of
true ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
@@ -672,67 +791,69 @@ trim_t([Bin|Cont0], N, Sep) when is_binary(Bin) ->
end;
[NonSep|Cont] when is_binary(NonSep) ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- trim_t([Bin|Cont], KeepSz, Sep)
+ trim_t([Bin|Cont], KeepSz, Seps)
end
end;
-trim_t(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) ->
- case unicode_util:cp(Str) of
- [CP|Cs] ->
- case lists:member(CP, CPs) of
+trim_t(Str, 0, {GCs,_,_}=Seps) when is_list(Str) ->
+ case unicode_util:gc(Str) of
+ [GC|Cs1] ->
+ case lists:member(GC, GCs) of
true ->
- [GC|Cs1] = unicode_util:gc(Str),
- case lists:member(GC, GCs) of
- true ->
- Tail = trim_t(Cs1, 0, Sep),
- case is_empty(Tail) of
- true -> [];
- false -> append(GC,Tail)
- end;
- false ->
- append(GC,trim_t(Cs1, 0, Sep))
+ Tail = trim_t(Cs1, 0, Seps),
+ case is_empty(Tail) of
+ true -> [];
+ false -> append(GC,Tail)
end;
false ->
- append(CP,trim_t(Cs, 0, Sep))
+ append(GC,trim_t(Cs1, 0, Seps))
end;
[] -> []
end;
-trim_t(Bin, N, Sep) when is_binary(Bin) ->
+trim_t(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search(Rest, Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(Rest, [], Seps) of
{nomatch,_} -> Bin;
[SepStart] ->
- case bin_search_inv(SepStart, [], Sep) of
+ case bin_search_inv(SepStart, [], GCs) of
{nomatch,_} ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
<<Keep:KeepSz/binary, _/binary>> = Bin,
Keep;
[NonSep] ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- trim_t(Bin, KeepSz, Sep)
+ trim_t(Bin, KeepSz, Seps)
end
end.
-take_l([Bin|Cont0], Sep, Acc) when is_binary(Bin) ->
- case bin_search_inv(Bin, Cont0, Sep) of
+
+take_l([CP1|[CP2|_]=Cont]=Str, Seps, Acc)
+ when ?ASCII_LIST(CP1,CP2) ->
+ case lists:member(CP1, Seps) of
+ true -> take_l(Cont, Seps, [CP1|Acc]);
+ false -> {rev(Acc), Str}
+ end;
+take_l([Bin|Cont0], Seps, Acc) when is_binary(Bin) ->
+ case bin_search_inv(Bin, Cont0, Seps) of
{nomatch, Cont} ->
Used = cp_prefix(Cont0, Cont),
- take_l(Cont, Sep, [unicode:characters_to_binary([Bin|Used])|Acc]);
+ take_l(Cont, Seps, [unicode:characters_to_binary([Bin|Used])|Acc]);
[Bin1|_]=After when is_binary(Bin1) ->
First = byte_size(Bin) - byte_size(Bin1),
<<Keep:First/binary, _/binary>> = Bin,
{btoken(Keep,Acc), After}
end;
-take_l(Str, {GCs, _, _}=Sep, Acc) when is_list(Str) ->
+take_l(Str, Seps, Acc) when is_list(Str) ->
case unicode_util:gc(Str) of
[C|Cs] ->
- case lists:member(C, GCs) of
- true -> take_l(Cs, Sep, append(rev(C),Acc));
+ case lists:member(C, Seps) of
+ true -> take_l(Cs, Seps, append(rev(C),Acc));
false -> {rev(Acc), Str}
end;
[] -> {rev(Acc), []}
end;
-take_l(Bin, Sep, Acc) when is_binary(Bin) ->
- case bin_search_inv(Bin, [], Sep) of
+take_l(Bin, Seps, Acc) when is_binary(Bin) ->
+ case bin_search_inv(Bin, [], Seps) of
{nomatch,_} ->
{btoken(Bin, Acc), <<>>};
[After] ->
@@ -741,27 +862,41 @@ take_l(Bin, Sep, Acc) when is_binary(Bin) ->
{btoken(Keep, Acc), After}
end.
-take_lc([Bin|Cont0], Sep, Acc) when is_binary(Bin) ->
- case bin_search(Bin, Cont0, Sep) of
+
+take_lc([CP1|Cont]=Str0, {GCs,CPs,_}=Seps, Acc) when is_integer(CP1) ->
+ case lists:member(CP1, CPs) of
+ true ->
+ [GC|Str] = unicode_util:gc(Str0),
+ case lists:member(GC, GCs) of
+ false -> take_lc(Str, Seps, append(rev(GC),Acc));
+ true -> {rev(Acc), Str0}
+ end;
+ false ->
+ take_lc(Cont, Seps, append(CP1,Acc))
+ end;
+take_lc([Bin|Cont0], Seps0, Acc) when is_binary(Bin) ->
+ Seps = search_compile(Seps0),
+ case bin_search(Bin, Cont0, Seps) of
{nomatch, Cont} ->
Used = cp_prefix(Cont0, Cont),
- take_lc(Cont, Sep, [unicode:characters_to_binary([Bin|Used])|Acc]);
+ take_lc(Cont, Seps, [unicode:characters_to_binary([Bin|Used])|Acc]);
[Bin1|_]=After when is_binary(Bin1) ->
First = byte_size(Bin) - byte_size(Bin1),
<<Keep:First/binary, _/binary>> = Bin,
{btoken(Keep,Acc), After}
end;
-take_lc(Str, {GCs, _, _}=Sep, Acc) when is_list(Str) ->
+take_lc(Str, {GCs,_,_}=Seps, Acc) when is_list(Str) ->
case unicode_util:gc(Str) of
[C|Cs] ->
case lists:member(C, GCs) of
- false -> take_lc(Cs, Sep, append(rev(C),Acc));
+ false -> take_lc(Cs, Seps, append(rev(C),Acc));
true -> {rev(Acc), Str}
end;
[] -> {rev(Acc), []}
end;
-take_lc(Bin, Sep, Acc) when is_binary(Bin) ->
- case bin_search(Bin, [], Sep) of
+take_lc(Bin, Seps0, Acc) when is_binary(Bin) ->
+ Seps = search_compile(Seps0),
+ case bin_search(Bin, [], Seps) of
{nomatch,_} ->
{btoken(Bin, Acc), <<>>};
[After] ->
@@ -770,148 +905,192 @@ take_lc(Bin, Sep, Acc) when is_binary(Bin) ->
{btoken(Keep, Acc), After}
end.
-take_t([Bin|Cont0], N, Sep) when is_binary(Bin) ->
+
+take_t([CP1|Cont]=Str0, _, {GCs,CPs,_}=Seps) when is_integer(CP1) ->
+ case lists:member(CP1, CPs) of
+ true ->
+ [GC|Str] = unicode_util:gc(Str0),
+ case lists:member(GC, GCs) of
+ true ->
+ {Head, Tail} = take_t(Str, 0, Seps),
+ case is_empty(Head) of
+ true -> {Head, append(GC,Tail)};
+ false -> {append(GC,Head), Tail}
+ end;
+ false ->
+ {Head, Tail} = take_t(Str, 0, Seps),
+ {append(GC,Head), Tail}
+ end;
+ false ->
+ {Head, Tail} = take_t(Cont, 0, Seps),
+ {[CP1|Head], Tail}
+ end;
+take_t([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search(Rest, Cont0, Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(Rest, Cont0, Seps) of
{nomatch,Cont} ->
Used = cp_prefix(Cont0, Cont),
- {Head, Tail} = take_t(Cont, 0, Sep),
+ {Head, Tail} = take_t(Cont, 0, Seps),
{stack(unicode:characters_to_binary([Bin|Used]), Head), Tail};
[SepStart|Cont1] ->
- case bin_search_inv(SepStart, Cont1, Sep) of
+ case bin_search_inv(SepStart, Cont1, GCs) of
{nomatch, Cont} ->
- {Head, Tail} = take_t(Cont, 0, Sep),
+ {Head, Tail} = take_t(Cont, 0, Seps),
Used = cp_prefix(Cont0, Cont),
- case equal(Tail, Cont) of
+ case is_empty(Head) of
true ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
<<Keep:KeepSz/binary, End/binary>> = Bin,
- {stack(Keep,Head), stack(stack(End,Used),Tail)};
+ {Keep, stack(stack(End,Used),Tail)};
false ->
{stack(unicode:characters_to_binary([Bin|Used]),Head), Tail}
end;
[NonSep|Cont] when is_binary(NonSep) ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- take_t([Bin|Cont], KeepSz, Sep)
+ take_t([Bin|Cont], KeepSz, Seps)
end
end;
-take_t(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) ->
- case unicode_util:cp(Str) of
- [CP|Cs] ->
- case lists:member(CP, CPs) of
+take_t(Str, 0, {GCs,_,_}=Seps) when is_list(Str) ->
+ case unicode_util:gc(Str) of
+ [GC|Cs1] ->
+ case lists:member(GC, GCs) of
true ->
- [GC|Cs1] = unicode_util:gc(Str),
- case lists:member(GC, GCs) of
- true ->
- {Head, Tail} = take_t(Cs1, 0, Sep),
- case equal(Tail, Cs1) of
- true -> {Head, append(GC,Tail)};
- false -> {append(GC,Head), Tail}
- end;
- false ->
- {Head, Tail} = take_t(Cs, 0, Sep),
- {append(CP,Head), Tail}
+ {Head, Tail} = take_t(Cs1, 0, Seps),
+ case is_empty(Head) of
+ true -> {Head, append(GC,Tail)};
+ false -> {append(GC,Head), Tail}
end;
false ->
- {Head, Tail} = take_t(Cs, 0, Sep),
- {append(CP,Head), Tail}
+ {Head, Tail} = take_t(Cs1, 0, Seps),
+ {append(GC,Head), Tail}
end;
[] -> {[],[]}
end;
-take_t(Bin, N, Sep) when is_binary(Bin) ->
+take_t(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search(Rest, Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(Rest, [], Seps) of
{nomatch,_} -> {Bin, <<>>};
[SepStart] ->
- case bin_search_inv(SepStart, [], Sep) of
+ case bin_search_inv(SepStart, [], GCs) of
{nomatch,_} ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
<<Before:KeepSz/binary, End/binary>> = Bin,
{Before, End};
[NonSep] ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- take_t(Bin, KeepSz, Sep)
+ take_t(Bin, KeepSz, Seps)
end
end.
-take_tc([Bin|Cont0], N, Sep) when is_binary(Bin) ->
+take_tc([CP1|[CP2|_]=Cont], _, {GCs,_,_}=Seps) when ?ASCII_LIST(CP1,CP2) ->
+ case lists:member(CP1, GCs) of
+ false ->
+ {Head, Tail} = take_tc(Cont, 0, Seps),
+ case is_empty(Head) of
+ true -> {Head, append(CP1,Tail)};
+ false -> {append(CP1,Head), Tail}
+ end;
+ true ->
+ {Head, Tail} = take_tc(Cont, 0, Seps),
+ {append(CP1,Head), Tail}
+ end;
+take_tc([Bin|Cont0], N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search_inv(Rest, Cont0, Sep) of
+ case bin_search_inv(Rest, Cont0, GCs) of
{nomatch,Cont} ->
Used = cp_prefix(Cont0, Cont),
- {Head, Tail} = take_tc(Cont, 0, Sep),
+ {Head, Tail} = take_tc(Cont, 0, Seps0),
{stack(unicode:characters_to_binary([Bin|Used]), Head), Tail};
[SepStart|Cont1] ->
- case bin_search(SepStart, Cont1, Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(SepStart, Cont1, Seps) of
{nomatch, Cont} ->
- {Head, Tail} = take_tc(Cont, 0, Sep),
+ {Head, Tail} = take_tc(Cont, 0, Seps),
Used = cp_prefix(Cont0, Cont),
- case equal(Tail, Cont) of
+ case is_empty(Head) of
true ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
<<Keep:KeepSz/binary, End/binary>> = Bin,
- {stack(Keep,Head), stack(stack(End,Used),Tail)};
+ {Keep, stack(stack(End,Used),Tail)};
false ->
{stack(unicode:characters_to_binary([Bin|Used]),Head), Tail}
end;
[NonSep|Cont] when is_binary(NonSep) ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- take_tc([Bin|Cont], KeepSz, Sep)
+ take_tc([Bin|Cont], KeepSz, Seps)
end
end;
-take_tc(Str, 0, {GCs,CPs,_}=Sep) when is_list(Str) ->
- case unicode_util:cp(Str) of
- [CP|Cs] ->
- case lists:member(CP, CPs) of
- true ->
- [GC|Cs1] = unicode_util:gc(Str),
- case lists:member(GC, GCs) of
- false ->
- {Head, Tail} = take_tc(Cs1, 0, Sep),
- case equal(Tail, Cs1) of
- true -> {Head, append(GC,Tail)};
- false -> {append(GC,Head), Tail}
- end;
- true ->
- {Head, Tail} = take_tc(Cs1, 0, Sep),
- {append(GC,Head), Tail}
- end;
+take_tc(Str, 0, {GCs,_,_}=Seps) when is_list(Str) ->
+ case unicode_util:gc(Str) of
+ [GC|Cs1] ->
+ case lists:member(GC, GCs) of
false ->
- {Head, Tail} = take_tc(Cs, 0, Sep),
- case equal(Tail, Cs) of
- true -> {Head, append(CP,Tail)};
- false -> {append(CP,Head), Tail}
- end
+ {Head, Tail} = take_tc(Cs1, 0, Seps),
+ case is_empty(Head) of
+ true -> {Head, append(GC,Tail)};
+ false -> {append(GC,Head), Tail}
+ end;
+ true ->
+ {Head, Tail} = take_tc(Cs1, 0, Seps),
+ {append(GC,Head), Tail}
end;
[] -> {[],[]}
end;
-take_tc(Bin, N, Sep) when is_binary(Bin) ->
+take_tc(Bin, N, {GCs,_,_}=Seps0) when is_binary(Bin) ->
<<_:N/binary, Rest/binary>> = Bin,
- case bin_search_inv(Rest, [], Sep) of
+ case bin_search_inv(Rest, [], GCs) of
{nomatch,_} -> {Bin, <<>>};
[SepStart] ->
- case bin_search(SepStart, [], Sep) of
+ Seps = search_compile(Seps0),
+ case bin_search(SepStart, [], Seps) of
{nomatch,_} ->
KeepSz = byte_size(Bin) - byte_size(SepStart),
<<Before:KeepSz/binary, End/binary>> = Bin,
{Before, End};
[NonSep] ->
KeepSz = byte_size(Bin) - byte_size(NonSep),
- take_tc(Bin, KeepSz, Sep)
+ take_tc(Bin, KeepSz, Seps)
end
end.
-prefix_1(Cs, []) -> Cs;
-prefix_1(Cs, [_]=Pre) ->
- prefix_2(unicode_util:gc(Cs), Pre);
-prefix_1(Cs, Pre) ->
- prefix_2(unicode_util:cp(Cs), Pre).
-
-prefix_2([C|Cs], [C|Pre]) ->
- prefix_1(Cs, Pre);
-prefix_2(_, _) ->
- nomatch.
+prefix_1(Cs0, [GC]) ->
+ case unicode_util:gc(Cs0) of
+ [GC|Cs] -> Cs;
+ _ -> nomatch
+ end;
+prefix_1([CP|Cs], [Pre|PreR]) when is_integer(CP) ->
+ case CP =:= Pre of
+ true -> prefix_1(Cs,PreR);
+ false -> nomatch
+ end;
+prefix_1(<<CP/utf8, Cs/binary>>, [Pre|PreR]) ->
+ case CP =:= Pre of
+ true -> prefix_1(Cs,PreR);
+ false -> nomatch
+ end;
+prefix_1(Cs0, [Pre|PreR]) ->
+ case unicode_util:cp(Cs0) of
+ [Pre|Cs] -> prefix_1(Cs,PreR);
+ _ -> nomatch
+ end.
+split_1([CP1|Cs]=Cs0, [C|_]=Needle, _, Where, Curr, Acc) when is_integer(CP1) ->
+ case CP1=:=C of
+ true ->
+ case prefix_1(Cs0, Needle) of
+ nomatch -> split_1(Cs, Needle, 0, Where, append(C,Curr), Acc);
+ Rest when Where =:= leading ->
+ [rev(Curr), Rest];
+ Rest when Where =:= trailing ->
+ split_1(Cs, Needle, 0, Where, [C|Curr], [rev(Curr), Rest]);
+ Rest when Where =:= all ->
+ split_1(Rest, Needle, 0, Where, [], [rev(Curr)|Acc])
+ end;
+ false ->
+ split_1(Cs, Needle, 0, Where, append(CP1,Curr), Acc)
+ end;
split_1([Bin|Cont0], Needle, Start, Where, Curr0, Acc)
when is_binary(Bin) ->
case bin_search_str(Bin, Start, Cont0, Needle) of
@@ -971,32 +1150,50 @@ split_1(Bin, [_C|_]=Needle, Start, Where, Curr0, Acc) ->
end
end.
-lexemes_m([Bin|Cont0], Seps, Ts) when is_binary(Bin) ->
- case bin_search_inv(Bin, Cont0, Seps) of
+lexemes_m([CP|_]=Cs0, {GCs,CPs,_}=Seps, Ts) when is_integer(CP) ->
+ case lists:member(CP, CPs) of
+ true ->
+ [GC|Cs2] = unicode_util:gc(Cs0),
+ case lists:member(GC, GCs) of
+ true ->
+ lexemes_m(Cs2, Seps, Ts);
+ false ->
+ {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []),
+ lexemes_m(Rest, Seps, [Lexeme|Ts])
+ end;
+ false ->
+ {Lexeme,Rest} = lexeme_pick(Cs0, Seps, []),
+ lexemes_m(Rest, Seps, [Lexeme|Ts])
+ end;
+lexemes_m([Bin|Cont0], {GCs,_,_}=Seps0, Ts) when is_binary(Bin) ->
+ case bin_search_inv(Bin, Cont0, GCs) of
{nomatch,Cont} ->
- lexemes_m(Cont, Seps, Ts);
+ lexemes_m(Cont, Seps0, Ts);
Cs ->
+ Seps = search_compile(Seps0),
{Lexeme,Rest} = lexeme_pick(Cs, Seps, []),
lexemes_m(Rest, Seps, [Lexeme|Ts])
end;
-lexemes_m(Cs0, {GCs, _, _}=Seps, Ts) when is_list(Cs0) ->
+lexemes_m(Cs0, {GCs, _, _}=Seps0, Ts) when is_list(Cs0) ->
case unicode_util:gc(Cs0) of
[C|Cs] ->
case lists:member(C, GCs) of
true ->
- lexemes_m(Cs, Seps, Ts);
+ lexemes_m(Cs, Seps0, Ts);
false ->
+ Seps = search_compile(Seps0),
{Lexeme,Rest} = lexeme_pick(Cs0, Seps, []),
lexemes_m(Rest, Seps, [Lexeme|Ts])
end;
[] ->
lists:reverse(Ts)
end;
-lexemes_m(Bin, Seps, Ts) when is_binary(Bin) ->
- case bin_search_inv(Bin, [], Seps) of
+lexemes_m(Bin, {GCs,_,_}=Seps0, Ts) when is_binary(Bin) ->
+ case bin_search_inv(Bin, [], GCs) of
{nomatch,_} ->
lists:reverse(Ts);
[Cs] ->
+ Seps = search_compile(Seps0),
{Lexeme,Rest} = lexeme_pick(Cs, Seps, []),
lexemes_m(Rest, Seps, add_non_empty(Lexeme,Ts))
end.
@@ -1027,7 +1224,7 @@ lexeme_pick(Cs0, {GCs, CPs, _} = Seps, Tkn) when is_list(Cs0) ->
true ->
[GC|Cs2] = unicode_util:gc(Cs0),
case lists:member(GC, GCs) of
- true -> {rev(Tkn), Cs0};
+ true -> {rev(Tkn), Cs2};
false -> lexeme_pick(Cs2, Seps, append(rev(GC),Tkn))
end;
false ->
@@ -1037,7 +1234,7 @@ lexeme_pick(Cs0, {GCs, CPs, _} = Seps, Tkn) when is_list(Cs0) ->
{rev(Tkn), []}
end;
lexeme_pick(Bin, Seps, Tkn) when is_binary(Bin) ->
- case bin_search(Bin, Seps) of
+ case bin_search(Bin, [], Seps) of
{nomatch,_} ->
{btoken(Bin,Tkn), []};
[Left] ->
@@ -1046,35 +1243,38 @@ lexeme_pick(Bin, Seps, Tkn) when is_binary(Bin) ->
{btoken(Lexeme, Tkn), Left}
end.
-nth_lexeme_m([Bin|Cont0], Seps, N) when is_binary(Bin) ->
- case bin_search_inv(Bin, Cont0, Seps) of
+nth_lexeme_m([Bin|Cont0], {GCs,_,_}=Seps0, N) when is_binary(Bin) ->
+ case bin_search_inv(Bin, Cont0, GCs) of
{nomatch,Cont} ->
- nth_lexeme_m(Cont, Seps, N);
+ nth_lexeme_m(Cont, Seps0, N);
Cs when N > 1 ->
- Rest = lexeme_skip(Cs, Seps),
- nth_lexeme_m(Rest, Seps, N-1);
+ Rest = lexeme_skip(Cs, Seps0),
+ nth_lexeme_m(Rest, Seps0, N-1);
Cs ->
+ Seps = search_compile(Seps0),
{Lexeme,_} = lexeme_pick(Cs, Seps, []),
Lexeme
end;
-nth_lexeme_m(Cs0, {GCs, _, _}=Seps, N) when is_list(Cs0) ->
+nth_lexeme_m(Cs0, {GCs, _, _}=Seps0, N) when is_list(Cs0) ->
case unicode_util:gc(Cs0) of
[C|Cs] ->
case lists:member(C, GCs) of
true ->
- nth_lexeme_m(Cs, Seps, N);
+ nth_lexeme_m(Cs, Seps0, N);
false when N > 1 ->
- Cs1 = lexeme_skip(Cs, Seps),
- nth_lexeme_m(Cs1, Seps, N-1);
+ Cs1 = lexeme_skip(Cs, Seps0),
+ nth_lexeme_m(Cs1, Seps0, N-1);
false ->
+ Seps = search_compile(Seps0),
{Lexeme,_} = lexeme_pick(Cs0, Seps, []),
Lexeme
end;
[] ->
[]
end;
-nth_lexeme_m(Bin, Seps, N) when is_binary(Bin) ->
- case bin_search_inv(Bin, [], Seps) of
+nth_lexeme_m(Bin, {GCs,_,_}=Seps0, N) when is_binary(Bin) ->
+ Seps = search_compile(Seps0),
+ case bin_search_inv(Bin, [], GCs) of
[Cs] when N > 1 ->
Cs1 = lexeme_skip(Cs, Seps),
nth_lexeme_m(Cs1, Seps, N-1);
@@ -1090,16 +1290,17 @@ lexeme_skip([CP|Cs1]=Cs0, {GCs,CPs,_}=Seps) when is_integer(CP) ->
true ->
[GC|Cs2] = unicode_util:gc(Cs0),
case lists:member(GC, GCs) of
- true -> Cs0;
+ true -> Cs2;
false -> lexeme_skip(Cs2, Seps)
end;
false ->
lexeme_skip(Cs1, Seps)
end;
-lexeme_skip([Bin|Cont0], Seps) when is_binary(Bin) ->
+lexeme_skip([Bin|Cont0], Seps0) when is_binary(Bin) ->
+ Seps = search_compile(Seps0),
case bin_search(Bin, Cont0, Seps) of
{nomatch,_} -> lexeme_skip(Cont0, Seps);
- Cs -> Cs
+ Cs -> tl(unicode_util:gc(Cs))
end;
lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) ->
case unicode_util:cp(Cs0) of
@@ -1108,7 +1309,7 @@ lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) ->
true ->
[GC|Cs2] = unicode_util:gc(Cs0),
case lists:member(GC, GCs) of
- true -> Cs0;
+ true -> Cs2;
false -> lexeme_skip(Cs2, Seps)
end;
false ->
@@ -1117,12 +1318,23 @@ lexeme_skip(Cs0, {GCs, CPs, _} = Seps) when is_list(Cs0) ->
[] ->
[]
end;
-lexeme_skip(Bin, Seps) when is_binary(Bin) ->
- case bin_search(Bin, Seps) of
+lexeme_skip(Bin, Seps0) when is_binary(Bin) ->
+ Seps = search_compile(Seps0),
+ case bin_search(Bin, [], Seps) of
{nomatch,_} -> <<>>;
- [Left] -> Left
+ [Left] -> tl(unicode_util:gc(Left))
end.
+find_l([C1|Cs]=Cs0, [C|_]=Needle) when is_integer(C1) ->
+ case C1 of
+ C ->
+ case prefix_1(Cs0, Needle) of
+ nomatch -> find_l(Cs, Needle);
+ _ -> Cs0
+ end;
+ _ ->
+ find_l(Cs, Needle)
+ end;
find_l([Bin|Cont0], Needle) when is_binary(Bin) ->
case bin_search_str(Bin, 0, Cont0, Needle) of
{nomatch, _, Cont} ->
@@ -1147,6 +1359,16 @@ find_l(Bin, Needle) ->
{_Before, [Cs], _After} -> Cs
end.
+find_r([Cp|Cs]=Cs0, [C|_]=Needle, Res) when is_integer(Cp) ->
+ case Cp of
+ C ->
+ case prefix_1(Cs0, Needle) of
+ nomatch -> find_r(Cs, Needle, Res);
+ _ -> find_r(Cs, Needle, Cs0)
+ end;
+ _ ->
+ find_r(Cs, Needle, Res)
+ end;
find_r([Bin|Cont0], Needle, Res) when is_binary(Bin) ->
case bin_search_str(Bin, 0, Cont0, Needle) of
{nomatch,_,Cont} ->
@@ -1217,11 +1439,6 @@ cp_prefix_1(Orig, Until, Cont) ->
%% Binary special
-bin_search(Bin, Seps) ->
- bin_search(Bin, [], Seps).
-
-bin_search(_Bin, Cont, {[],_,_}) ->
- {nomatch, Cont};
bin_search(Bin, Cont, {Seps,_,BP}) ->
bin_search_loop(Bin, 0, BP, Cont, Seps).
@@ -1229,10 +1446,14 @@ bin_search(Bin, Cont, {Seps,_,BP}) ->
%% i.e. å in nfd form $a "COMBINING RING ABOVE"
%% and PREPEND characters like "ARABIC NUMBER SIGN" 1536 <<216,128>>
%% combined with other characters are currently ignored.
+search_pattern({_,_,_}=P) -> P;
search_pattern(Seps) ->
CPs = search_cp(Seps),
- Bin = bin_pattern(CPs),
- {Seps, CPs, Bin}.
+ {Seps, CPs, undefined}.
+
+search_compile({Sep, CPs, undefined}) ->
+ {Sep, CPs, binary:compile_pattern(bin_pattern(CPs))};
+search_compile({_,_,_}=Compiled) -> Compiled.
search_cp([CP|Seps]) when is_integer(CP) ->
[CP|search_cp(Seps)];
@@ -1253,9 +1474,21 @@ bin_search_loop(Bin0, Start, BinSeps, Cont, Seps) ->
case binary:match(Bin, BinSeps) of
nomatch ->
{nomatch,Cont};
+ {Where, _CL} when Cont =:= [] ->
+ <<_:Where/binary, Cont1/binary>> = Bin,
+ [GC|Cont2] = unicode_util:gc(Cont1),
+ case lists:member(GC, Seps) of
+ false when Cont2 =:= [] ->
+ {nomatch, []};
+ false ->
+ Next = byte_size(Bin0) - byte_size(Cont2),
+ bin_search_loop(Bin0, Next, BinSeps, Cont, Seps);
+ true ->
+ [Cont1]
+ end;
{Where, _CL} ->
<<_:Where/binary, Cont0/binary>> = Bin,
- Cont1 = stack(Cont0, Cont),
+ Cont1 = [Cont0|Cont],
[GC|Cont2] = unicode_util:gc(Cont1),
case lists:member(GC, Seps) of
false ->
@@ -1263,55 +1496,108 @@ bin_search_loop(Bin0, Start, BinSeps, Cont, Seps) ->
[BinR|Cont] when is_binary(BinR) ->
Next = byte_size(Bin0) - byte_size(BinR),
bin_search_loop(Bin0, Next, BinSeps, Cont, Seps);
- BinR when is_binary(BinR), Cont =:= [] ->
- Next = byte_size(Bin0) - byte_size(BinR),
- bin_search_loop(Bin0, Next, BinSeps, Cont, Seps);
_ ->
{nomatch, Cont2}
end;
- true when is_list(Cont1) ->
- Cont1;
true ->
- [Cont1]
+ Cont1
end
end.
-bin_search_inv(Bin, Cont, {[], _, _}) ->
- [Bin|Cont];
-bin_search_inv(Bin, Cont, {[Sep], _, _}) ->
- bin_search_inv_1([Bin|Cont], Sep);
-bin_search_inv(Bin, Cont, {Seps, _, _}) ->
- bin_search_inv_n([Bin|Cont], Seps).
-
-bin_search_inv_1([<<>>|CPs], _) ->
- {nomatch, CPs};
-bin_search_inv_1(CPs = [Bin0|Cont], Sep) when is_binary(Bin0) ->
- case unicode_util:gc(CPs) of
- [Sep|Bin] when is_binary(Bin), Cont =:= [] ->
- bin_search_inv_1([Bin], Sep);
- [Sep|[Bin|Cont]=Cs] when is_binary(Bin) ->
- bin_search_inv_1(Cs, Sep);
- [Sep|Cs] ->
- {nomatch, Cs};
- _ -> CPs
- end.
+bin_search_inv(<<>>, Cont, _) ->
+ {nomatch, Cont};
+bin_search_inv(Bin, Cont, [Sep]) ->
+ bin_search_inv_1(Bin, Cont, Sep);
+bin_search_inv(Bin, Cont, Seps) ->
+ bin_search_inv_n(Bin, Cont, Seps).
+
+bin_search_inv_1(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Sep) ->
+ case BinRest of
+ <<CP2/utf8, _/binary>> when ?ASCII_LIST(CP1, CP2) ->
+ case CP1 of
+ Sep -> bin_search_inv_1(BinRest, Cont, Sep);
+ _ -> [Bin0|Cont]
+ end;
+ _ when Cont =:= [] ->
+ case unicode_util:gc(Bin0) of
+ [Sep|Bin] -> bin_search_inv_1(Bin, Cont, Sep);
+ _ -> [Bin0|Cont]
+ end;
+ _ ->
+ case unicode_util:gc([Bin0|Cont]) of
+ [Sep|[Bin|Cont]] when is_binary(Bin) ->
+ bin_search_inv_1(Bin, Cont, Sep);
+ [Sep|Cs] ->
+ {nomatch, Cs};
+ _ -> [Bin0|Cont]
+ end
+ end;
+bin_search_inv_1(<<>>, Cont, _Sep) ->
+ {nomatch, Cont};
+bin_search_inv_1([], Cont, _Sep) ->
+ {nomatch, Cont}.
-bin_search_inv_n([<<>>|CPs], _) ->
- {nomatch, CPs};
-bin_search_inv_n([Bin0|Cont]=CPs, Seps) when is_binary(Bin0) ->
- [C|Cs0] = unicode_util:gc(CPs),
- case {lists:member(C, Seps), Cs0} of
- {true, Cs} when is_binary(Cs), Cont =:= [] ->
- bin_search_inv_n([Cs], Seps);
- {true, [Bin|Cont]=Cs} when is_binary(Bin) ->
- bin_search_inv_n(Cs, Seps);
- {true, Cs} -> {nomatch, Cs};
- {false, _} -> CPs
- end.
+bin_search_inv_n(<<CP1/utf8, BinRest/binary>>=Bin0, Cont, Seps) ->
+ case BinRest of
+ <<CP2/utf8, _/binary>> when ?ASCII_LIST(CP1, CP2) ->
+ case lists:member(CP1,Seps) of
+ true -> bin_search_inv_n(BinRest, Cont, Seps);
+ false -> [Bin0|Cont]
+ end;
+ _ when Cont =:= [] ->
+ [GC|Bin] = unicode_util:gc(Bin0),
+ case lists:member(GC, Seps) of
+ true -> bin_search_inv_n(Bin, Cont, Seps);
+ false -> [Bin0|Cont]
+ end;
+ _ ->
+ [GC|Cs0] = unicode_util:gc([Bin0|Cont]),
+ case lists:member(GC, Seps) of
+ false -> [Bin0|Cont];
+ true ->
+ case Cs0 of
+ [Bin|Cont] when is_binary(Bin) ->
+ bin_search_inv_n(Bin, Cont, Seps);
+ _ ->
+ {nomatch, Cs0}
+ end
+ end
+ end;
+bin_search_inv_n(<<>>, Cont, _Sep) ->
+ {nomatch, Cont};
+bin_search_inv_n([], Cont, _Sep) ->
+ {nomatch, Cont}.
+
+bin_search_str(Bin0, Start, [], SearchCPs) ->
+ Compiled = binary:compile_pattern(unicode:characters_to_binary(SearchCPs)),
+ bin_search_str_1(Bin0, Start, Compiled, SearchCPs);
bin_search_str(Bin0, Start, Cont, [CP|_]=SearchCPs) ->
+ First = binary:compile_pattern(<<CP/utf8>>),
+ bin_search_str_2(Bin0, Start, Cont, First, SearchCPs).
+
+bin_search_str_1(Bin0, Start, First, SearchCPs) ->
+ <<_:Start/binary, Bin/binary>> = Bin0,
+ case binary:match(Bin, First) of
+ nomatch -> {nomatch, byte_size(Bin0), []};
+ {Where0, _} ->
+ Where = Start+Where0,
+ <<Keep:Where/binary, Cs0/binary>> = Bin0,
+ case prefix_1(Cs0, SearchCPs) of
+ nomatch ->
+ <<_/utf8, Cs/binary>> = Cs0,
+ KeepSz = byte_size(Bin0) - byte_size(Cs),
+ bin_search_str_1(Bin0, KeepSz, First, SearchCPs);
+ [] ->
+ {Keep, [Cs0], <<>>};
+ Rest ->
+ {Keep, [Cs0], Rest}
+ end
+ end.
+
+bin_search_str_2(Bin0, Start, Cont, First, SearchCPs) ->
<<_:Start/binary, Bin/binary>> = Bin0,
- case binary:match(Bin, <<CP/utf8>>) of
+ case binary:match(Bin, First) of
nomatch -> {nomatch, byte_size(Bin0), Cont};
{Where0, _} ->
Where = Start+Where0,
@@ -1320,7 +1606,7 @@ bin_search_str(Bin0, Start, Cont, [CP|_]=SearchCPs) ->
case prefix_1(stack(Cs0,Cont), SearchCPs) of
nomatch when is_binary(Cs) ->
KeepSz = byte_size(Bin0) - byte_size(Cs),
- bin_search_str(Bin0, KeepSz, Cont, SearchCPs);
+ bin_search_str_2(Bin0, KeepSz, Cont, First, SearchCPs);
nomatch ->
{nomatch, Where, stack([GC|Cs],Cont)};
[] ->
diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl
index 90f980c0e5..f43bfb4482 100644
--- a/lib/stdlib/test/string_SUITE.erl
+++ b/lib/stdlib/test/string_SUITE.erl
@@ -92,14 +92,11 @@ end_per_testcase(_Case, _Config) ->
ok.
debug() ->
- Config = [{data_dir, ?MODULE_STRING++"_data"}],
+ Config = [{data_dir, "./" ++ ?MODULE_STRING++"_data"}],
[io:format("~p:~p~n",[Test,?MODULE:Test(Config)]) ||
{_,Tests} <- groups(), Test <- Tests].
-define(TEST(B,C,D), test(?LINE,?FUNCTION_NAME,B,C,D, true)).
--define(TEST_EQ(B,C,D),
- test(?LINE,?FUNCTION_NAME,B,C,D, true),
- test(?LINE,?FUNCTION_NAME,hd(C),[B|tl(C),D, true)).
-define(TEST_NN(B,C,D),
test(?LINE,?FUNCTION_NAME,B,C,D, false),
@@ -294,6 +291,7 @@ trim(_) ->
?TEST(["..h", ".e", <<"j..">>], [both, ". "], "h.ej"),
?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [both, ". "], "h.ejsan"),
%% Test that it behaves with graphemes (i.e. nfd tests are the hard part)
+ ?TEST([1013,101,778,101,101], [trailing, [101]], [1013,101,778]),
?TEST("aaåaa", [both, "a"], "å"),
?TEST(["aaa",778,"äöoo"], [both, "ao"], "åäö"),
?TEST([<<"aaa">>,778,"äöoo"], [both, "ao"], "åäö"),
@@ -353,6 +351,7 @@ take(_) ->
?TEST([<<>>,<<"..">>, " h.ej", <<" ..">>], [Chars, true, leading], {".. ", "h.ej .."}),
?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [Chars, true, leading], {"..", "h.ejsan.."}),
%% Test that it behaves with graphemes (i.e. nfd tests are the hard part)
+ ?TEST([101,778], [[[101, 779]], true], {[101,778], []}),
?TEST(["aaee",778,"äöoo"], [[[$e,778]], true, leading], {"aae", [$e,778|"äöoo"]}),
?TEST([<<"aae">>,778,"äöoo"], [[[$e,778]],true,leading], {"aa", [$e,778|"äöoo"]}),
?TEST([<<"e">>,778,"åäöe", <<778/utf8>>], [[[$e,778]], true, leading], {[], [$e,778]++"åäöe"++[778]}),
@@ -713,29 +712,123 @@ nth_lexeme(_) ->
meas(Config) ->
+ Parent = self(),
+ Exec = fun() ->
+ DataDir0 = proplists:get_value(data_dir, Config),
+ DataDir = filename:join(lists:droplast(filename:split(DataDir0))),
+ case proplists:get_value(profile, Config, false) of
+ false ->
+ do_measure(DataDir);
+ eprof ->
+ eprof:profile(fun() -> do_measure(DataDir) end, [set_on_spawn]),
+ eprof:stop_profiling(),
+ eprof:analyze(),
+ eprof:stop()
+ end,
+ Parent ! {test_done, self()},
+ normal
+ end,
+ ct:timetrap({minutes,2}),
case ct:get_timetrap_info() of
{_,{_,Scale}} when Scale > 1 ->
{skip,{will_not_run_in_debug,Scale}};
- _ -> % No scaling
- DataDir = proplists:get_value(data_dir, Config),
- TestDir = filename:dirname(string:trim(DataDir, trailing, "/")),
- do_measure(TestDir)
+ _ -> % No scaling, run at most 1.5 min
+ Tester = spawn(Exec),
+ receive {test_done, Tester} -> ok
+ after 90000 ->
+ io:format("Timelimit reached stopping~n",[]),
+ exit(Tester, die)
+ end,
+ ok
end.
-do_measure(TestDir) ->
- File = filename:join(TestDir, ?MODULE_STRING ++ ".erl"),
+do_measure(DataDir) ->
+ File = filename:join([DataDir,"unicode_util_SUITE_data","NormalizationTest.txt"]),
io:format("File ~s ",[File]),
{ok, Bin} = file:read_file(File),
io:format("~p~n",[byte_size(Bin)]),
Do = fun(Name, Func, Mode) ->
{N, Mean, Stddev, _} = time_func(Func, Mode, Bin),
- io:format("~10w ~6w ~6.2fms ±~4.2fms #~.2w gc included~n",
+ io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n",
[Name, Mode, Mean/1000, Stddev/1000, N])
end,
+ Do2 = fun(Name, Func, Mode) ->
+ {N, Mean, Stddev, _} = time_func(Func, binary, <<>>),
+ io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n",
+ [Name, Mode, Mean/1000, Stddev/1000, N])
+ end,
io:format("----------------------~n"),
- Do(tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list),
+
+ Do(old_tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list),
Tokens = {lexemes, fun(Str) -> string:lexemes(Str, [$\n,$\r]) end},
[Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- [list, binary]],
+
+ S0 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....",
+ S0B = <<"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....">>,
+ Do2(old_strip_l, repeat(fun() -> string:strip(S0, left, $x) end), list),
+ Do2(trim_l, repeat(fun() -> string:trim(S0, leading, [$x]) end), list),
+ Do2(trim_l, repeat(fun() -> string:trim(S0B, leading, [$x]) end), binary),
+ Do2(old_strip_r, repeat(fun() -> string:strip(S0, right, $.) end), list),
+ Do2(trim_t, repeat(fun() -> string:trim(S0, trailing, [$.]) end), list),
+ Do2(trim_t, repeat(fun() -> string:trim(S0B, trailing, [$.]) end), binary),
+
+ Do2(old_chr_sub, repeat(fun() -> string:sub_string(S0, string:chr(S0, $.)) end), list),
+ Do2(old_str_sub, repeat(fun() -> string:sub_string(S0, string:str(S0, [$.])) end), list),
+ Do2(find, repeat(fun() -> string:find(S0, [$.]) end), list),
+ Do2(find, repeat(fun() -> string:find(S0B, [$.]) end), binary),
+ Do2(old_str_sub2, repeat(fun() -> N = string:str(S0, "xy.."),
+ {string:sub_string(S0,1,N), string:sub_string(S0,N+4)} end), list),
+ Do2(split, repeat(fun() -> string:split(S0, "xy..") end), list),
+ Do2(split, repeat(fun() -> string:split(S0B, "xy..") end), binary),
+
+ Do2(old_rstr_sub, repeat(fun() -> string:sub_string(S0, string:rstr(S0, [$y])) end), list),
+ Do2(find_t, repeat(fun() -> string:find(S0, [$y], trailing) end), list),
+ Do2(find_t, repeat(fun() -> string:find(S0B, [$y], trailing) end), binary),
+ Do2(old_rstr_sub2, repeat(fun() -> N = string:rstr(S0, "y.."),
+ {string:sub_string(S0,1,N), string:sub_string(S0,N+3)} end), list),
+ Do2(split_t, repeat(fun() -> string:split(S0, "y..", trailing) end), list),
+ Do2(split_t, repeat(fun() -> string:split(S0B, "y..", trailing) end), binary),
+
+ Do2(old_span, repeat(fun() -> N=string:span(S0, [$x, $y]),
+ {string:sub_string(S0,1,N),string:sub_string(S0,N+1)}
+ end), list),
+ Do2(take, repeat(fun() -> string:take(S0, [$x, $y]) end), list),
+ Do2(take, repeat(fun() -> string:take(S0B, [$x, $y]) end), binary),
+
+ Do2(old_cspan, repeat(fun() -> N=string:cspan(S0, [$.,$y]),
+ {string:sub_string(S0,1,N),string:sub_string(S0,N+1)}
+ end), list),
+ Do2(take_c, repeat(fun() -> string:take(S0, [$.,$y], true) end), list),
+ Do2(take_c, repeat(fun() -> string:take(S0B, [$.,$y], true) end), binary),
+
+ Do2(old_substr, repeat(fun() -> string:substr(S0, 21, 15) end), list),
+ Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list),
+ Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary),
+
+ io:format("--~n",[]),
+ NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end},
+ [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]],
+ Do2(take_t, repeat(fun() -> string:take(S0, [$.,$y], false, trailing) end), list),
+ Do2(take_t, repeat(fun() -> string:take(S0B, [$.,$y], false, trailing) end), binary),
+ Do2(take_tc, repeat(fun() -> string:take(S0, [$x], true, trailing) end), list),
+ Do2(take_tc, repeat(fun() -> string:take(S0B, [$x], true, trailing) end), binary),
+
+ Length = {length, fun(Str) -> string:length(Str) end},
+ [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- [list, binary]],
+
+ Reverse = {reverse, fun(Str) -> string:reverse(Str) end},
+ [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- [list, binary]],
+
+ ok.
+
+repeat(F) ->
+ fun(_) -> repeat_1(F,20000) end.
+
+repeat_1(F, N) when N > 0 ->
+ F(),
+ repeat_1(F, N-1);
+repeat_1(_, _) ->
+ erlang:garbage_collect(),
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -865,8 +958,6 @@ check_types_1({list, _},{list, undefined}) ->
ok;
check_types_1({list, _},{list, codepoints}) ->
ok;
-check_types_1({list, _},{list, {list, codepoints}}) ->
- ok;
check_types_1({list, {list, _}},{list, {list, codepoints}}) ->
ok;
check_types_1(mixed,_) ->
@@ -947,7 +1038,7 @@ time_func(Fun, Mode, Bin) ->
end),
receive {Pid,Msg} -> Msg end.
-time_func(N,Sum,SumSq, Fun, Str, _) when N < 50 ->
+time_func(N,Sum,SumSq, Fun, Str, _) when N < 20 ->
{Time, Res} = timer:tc(fun() -> Fun(Str) end),
time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res);
time_func(N,Sum,SumSq, _, _, Res) ->
diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl
index 03c24c7027..a89627eba5 100644
--- a/lib/stdlib/test/unicode_util_SUITE.erl
+++ b/lib/stdlib/test/unicode_util_SUITE.erl
@@ -310,12 +310,23 @@ get(_) ->
add_get_tests.
count(Config) ->
+ Parent = self(),
+ Exec = fun() ->
+ do_measure(Config),
+ Parent ! {test_done, self()}
+ end,
ct:timetrap({minutes,5}),
case ct:get_timetrap_info() of
- {_,{_,Scale}} ->
+ {_,{_,Scale}} when Scale > 1 ->
{skip,{measurments_skipped_debug,Scale}};
- _ -> % No scaling
- do_measure(Config)
+ _ -> % No scaling, run at most 2 min
+ Tester = spawn(Exec),
+ receive {test_done, Tester} -> ok
+ after 120000 ->
+ io:format("Timelimit reached stopping~n",[]),
+ exit(Tester, die)
+ end,
+ ok
end.
do_measure(Config) ->
diff --git a/lib/stdlib/uc_spec/gen_unicode_mod.escript b/lib/stdlib/uc_spec/gen_unicode_mod.escript
index fefd7d3b70..73c351e1af 100755
--- a/lib/stdlib/uc_spec/gen_unicode_mod.escript
+++ b/lib/stdlib/uc_spec/gen_unicode_mod.escript
@@ -170,7 +170,7 @@ gen_header(Fd) ->
io:put_chars(Fd, "-export([spec_version/0, lookup/1, get_case/1]).\n"),
io:put_chars(Fd, "-inline([class/1]).\n"),
io:put_chars(Fd, "-compile(nowarn_unused_vars).\n"),
- io:put_chars(Fd, "-dialyzer({no_improper_lists, [cp/1, gc_prepend/2, gc_e_cont/2]}).\n"),
+ io:put_chars(Fd, "-dialyzer({no_improper_lists, [cp/1, gc/1, gc_prepend/2, gc_e_cont/2]}).\n"),
io:put_chars(Fd, "-type gc() :: char()|[char()].\n\n\n"),
ok.
@@ -240,7 +240,7 @@ gen_norm(Fd) ->
"-spec nfd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n"
"nfd(Str0) ->\n"
" case gc(Str0) of\n"
- " [GC|R] when GC < 127 -> [GC|R];\n"
+ " [GC|R] when GC < 128 -> [GC|R];\n"
" [GC|Str] -> [decompose(GC)|Str];\n"
" [] -> [];\n"
" {error,_}=Error -> Error\n end.\n\n"
@@ -250,7 +250,7 @@ gen_norm(Fd) ->
"-spec nfkd(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n"
"nfkd(Str0) ->\n"
" case gc(Str0) of\n"
- " [GC|R] when GC < 127 -> [GC|R];\n"
+ " [GC|R] when GC < 128 -> [GC|R];\n"
" [GC|Str] -> [decompose_compat(GC)|Str];\n"
" [] -> [];\n"
" {error,_}=Error -> Error\n end.\n\n"
@@ -260,7 +260,7 @@ gen_norm(Fd) ->
"-spec nfc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n"
"nfc(Str0) ->\n"
" case gc(Str0) of\n"
- " [GC|R] when GC < 255 -> [GC|R];\n"
+ " [GC|R] when GC < 256 -> [GC|R];\n"
" [GC|Str] -> [compose(decompose(GC))|Str];\n"
" [] -> [];\n"
" {error,_}=Error -> Error\n end.\n\n"
@@ -270,7 +270,7 @@ gen_norm(Fd) ->
"-spec nfkc(unicode:chardata()) -> maybe_improper_list(gc(),unicode:chardata()) | {error, unicode:chardata()}.\n"
"nfkc(Str0) ->\n"
" case gc(Str0) of\n"
- " [GC|R] when GC < 127 -> [GC|R];\n"
+ " [GC|R] when GC < 128 -> [GC|R];\n"
" [GC|Str] -> [compose_compat_0(decompose_compat(GC))|Str];\n"
" [] -> [];\n"
" {error,_}=Error -> Error\n end.\n\n"
@@ -476,13 +476,30 @@ gen_gc(Fd, GBP) ->
"-spec gc(String::unicode:chardata()) ->"
" maybe_improper_list() | {error, unicode:chardata()}.\n"),
io:put_chars(Fd,
+ "gc([CP1, CP2|_]=T)\n"
+ " when CP1 < 256, CP2 < 256, CP1 =/= $\r -> %% Ascii Fast path\n"
+ " T;\n"
+ "gc(<<CP1/utf8, Rest/binary>>) ->\n"
+ " if CP1 < 256, CP1 =/= $\r ->\n"
+ " case Rest of\n"
+ " <<CP2/utf8, _/binary>> when CP2 < 256 -> %% Ascii Fast path\n"
+ " [CP1|Rest];\n"
+ " _ -> gc_1([CP1|Rest])\n"
+ " end;\n"
+ " true -> gc_1([CP1|Rest])\n"
+ " end;\n"
"gc(Str) ->\n"
" gc_1(cp(Str)).\n\n"
"gc_1([$\\r|R0] = R) ->\n"
" case cp(R0) of % Don't break CRLF\n"
" [$\\n|R1] -> [[$\\r,$\\n]|R1];\n"
" _ -> R\n"
- " end;\n"),
+ " end;\n"
+ %% "gc_1([CP1, CP2|_]=T) when CP1 < 256, CP2 < 256 ->\n"
+ %% " T; %% Fast path\n"
+ %% "gc_1([CP1|<<CP2/utf8, _/binary>>]=T) when CP1 < 256, CP2 < 256 ->\n"
+ %% " T; %% Fast path\n"
+ ),
io:put_chars(Fd, "%% Handle control\n"),
GenControl = fun(Range) -> io:format(Fd, "gc_1~s R0;\n", [gen_clause(Range)]) end,
@@ -490,7 +507,7 @@ gen_gc(Fd, GBP) ->
[R1,R2,R3|Crs] = CRs0,
[GenControl(CP) || CP <- merge_ranges([R1,R2,R3], split), CP =/= {$\r, undefined}],
%%GenControl(R1),GenControl(R2),GenControl(R3),
- io:format(Fd, "gc_1([CP|R]) when CP < 255 -> gc_extend(R,CP);\n", []),
+ io:format(Fd, "gc_1([CP|R]) when CP < 256 -> gc_extend(R,CP);\n", []),
[GenControl(CP) || CP <- Crs],
%% One clause per CP
%% CRs0 = merge_ranges(maps:get(cr, GBP) ++ maps:get(lf, GBP) ++ maps:get(control, GBP)),
diff --git a/lib/tools/doc/src/Makefile b/lib/tools/doc/src/Makefile
index 7011f869cd..b554781382 100644
--- a/lib/tools/doc/src/Makefile
+++ b/lib/tools/doc/src/Makefile
@@ -58,8 +58,7 @@ XML_CHAPTER_FILES = \
lcnt_chapter.xml \
erlang_mode_chapter.xml \
xref_chapter.xml \
- notes.xml \
- notes_history.xml
+ notes.xml
BOOK_FILES = book.xml