aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--HOWTO/INSTALL.md24
-rw-r--r--Makefile.in12
-rw-r--r--OTP_VERSION2
-rw-r--r--erts/Makefile4
-rw-r--r--erts/doc/src/Makefile4
-rw-r--r--erts/doc/src/erl_nif.xml16
-rw-r--r--erts/doc/src/erlang.xml19
-rw-r--r--erts/doc/src/notes.xml121
-rw-r--r--erts/doc/src/run_erl.xml6
-rw-r--r--erts/emulator/beam/atom.h2
-rw-r--r--erts/emulator/beam/beam_load.c35
-rw-r--r--erts/emulator/beam/break.c31
-rw-r--r--erts/emulator/beam/dist.c34
-rw-r--r--erts/emulator/beam/erl_gc.c47
-rw-r--r--erts/emulator/beam/erl_msacc.h32
-rw-r--r--erts/emulator/beam/erl_nif.c55
-rw-r--r--erts/emulator/beam/erl_nif.h5
-rw-r--r--erts/emulator/beam/erl_process.c18
-rw-r--r--erts/emulator/beam/erl_process_dump.c42
-rw-r--r--erts/emulator/beam/global.h1
-rw-r--r--erts/emulator/beam/index.c2
-rw-r--r--erts/emulator/drivers/unix/unix_efile.c2
-rw-r--r--erts/emulator/hipe/hipe_amd64_bifs.m437
-rw-r--r--erts/emulator/hipe/hipe_bif0.tab1
-rw-r--r--erts/emulator/hipe/hipe_bif_list.m45
-rw-r--r--erts/emulator/hipe/hipe_debug.c32
-rw-r--r--erts/emulator/hipe/hipe_native_bif.c6
-rw-r--r--erts/emulator/hipe/hipe_native_bif.h2
-rw-r--r--erts/emulator/hipe/hipe_primops.h1
-rw-r--r--erts/emulator/hipe/hipe_risc_stack.c8
-rw-r--r--erts/emulator/hipe/hipe_x86_stack.c8
-rw-r--r--erts/emulator/nifs/common/zlib_nif.c30
-rw-r--r--erts/emulator/test/code_SUITE.erl60
-rw-r--r--erts/emulator/test/distribution_SUITE.erl64
-rw-r--r--erts/emulator/test/process_SUITE.erl13
-rw-r--r--erts/etc/unix/run_erl.c7
-rw-r--r--erts/preloaded/ebin/zlib.beambin19784 -> 19744 bytes
-rw-r--r--erts/preloaded/src/zlib.erl13
-rw-r--r--erts/vsn.mk2
-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/Makefile.in25
-rw-r--r--lib/crypto/c_src/crypto.c1010
-rw-r--r--lib/crypto/c_src/otp_test_engine.c264
-rw-r--r--lib/crypto/doc/src/Makefile20
-rw-r--r--lib/crypto/doc/src/crypto.xml261
-rw-r--r--lib/crypto/doc/src/engine_keys.xml129
-rw-r--r--lib/crypto/doc/src/engine_load.xml110
-rw-r--r--lib/crypto/doc/src/usersguide.xml7
-rw-r--r--lib/crypto/src/Makefile18
-rw-r--r--lib/crypto/src/crypto.erl358
-rw-r--r--lib/crypto/test/Makefile7
-rw-r--r--lib/crypto/test/crypto_SUITE.erl2
-rw-r--r--lib/crypto/test/engine_SUITE.erl660
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem9
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem12
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem8
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem6
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem28
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem30
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem9
-rw-r--r--lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem9
-rw-r--r--lib/debugger/doc/src/Makefile2
-rw-r--r--lib/debugger/src/dbg_wx_win.erl2
-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/hipe/doc/src/hipe_app.xml66
-rw-r--r--lib/hipe/main/hipe.app.src2
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_construct.erl9
-rw-r--r--lib/inets/doc/src/Makefile1
-rw-r--r--lib/inets/doc/src/notes.xml53
-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/src/http_server/httpd_esi.erl2
-rw-r--r--lib/inets/src/http_server/httpd_example.erl2
-rw-r--r--lib/inets/src/inets_app/inets.appup.src4
-rw-r--r--lib/inets/test/http_format_SUITE.erl5
-rw-r--r--lib/inets/test/httpc_SUITE.erl3
-rw-r--r--lib/inets/test/httpd_SUITE.erl7
-rw-r--r--lib/inets/vsn.mk2
-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/kernel/test/zlib_SUITE.erl53
-rw-r--r--lib/mnesia/doc/src/Makefile1
-rw-r--r--lib/mnesia/src/mnesia.erl3
-rw-r--r--lib/mnesia/src/mnesia_log.erl4
-rw-r--r--lib/observer/doc/src/Makefile4
-rw-r--r--lib/observer/src/cdv_bin_cb.erl2
-rw-r--r--lib/observer/src/crashdump_viewer.erl504
-rw-r--r--lib/observer/src/observer_html_lib.erl6
-rw-r--r--lib/observer/src/observer_lib.erl8
-rw-r--r--lib/observer/test/crashdump_helper.erl14
-rw-r--r--lib/observer/test/crashdump_viewer_SUITE.erl109
-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/snmp/test/snmp_to_snmpnet_SUITE.erl25
-rw-r--r--lib/ssh/doc/src/Makefile2
-rw-r--r--lib/ssh/doc/src/notes.xml27
-rw-r--r--lib/ssh/doc/src/ssh_client_key_api.xml33
-rw-r--r--lib/ssh/doc/src/ssh_server_key_api.xml28
-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.erl38
-rw-r--r--lib/ssh/test/Makefile2
-rw-r--r--lib/ssh/test/ssh_engine_SUITE.erl140
-rw-r--r--lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem9
-rw-r--r--lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem8
-rw-r--r--lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem28
-rw-r--r--lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem30
-rw-r--r--lib/ssh/test/ssh_key_cb_engine_keys.erl62
-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.xml16
-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.erl3
-rw-r--r--lib/ssl/src/ssl_config.erl10
-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.erl1936
-rw-r--r--lib/ssl/src/ssl_internal.hrl13
-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/test/Makefile1
-rw-r--r--lib/ssl/test/ssl_engine_SUITE.erl142
-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
-rw-r--r--make/otp_release_targets.mk45
-rw-r--r--make/otp_subdir.mk2
-rw-r--r--make/run_make.mk6
-rw-r--r--otp_versions.table8
-rw-r--r--system/doc/efficiency_guide/profiling.xml171
-rw-r--r--system/doc/efficiency_guide/xmlfiles.mk4
-rw-r--r--system/doc/reference_manual/xmlfiles.mk5
-rw-r--r--system/doc/top/Makefile6
173 files changed, 8626 insertions, 3556 deletions
diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md
index 36365799e3..53f2dd26e2 100644
--- a/HOWTO/INSTALL.md
+++ b/HOWTO/INSTALL.md
@@ -18,9 +18,6 @@ Required Utilities
These are the tools you need in order to unpack and build Erlang/OTP.
-> *WARNING*: Please have a look at the [Known platform issues][] chapter
-> before you start.
-
### Unpacking ###
* GNU unzip, or a modern uncompress.
@@ -520,12 +517,26 @@ If you have Xcode 4.3, or later, you will also need to download
#### Building with wxErlang ####
If you want to build the `wx` application, you will need to get wxWidgets-3.0
-(`wxWidgets-3.0.0.tar.bz2` from <http://sourceforge.net/projects/wxwindows/files/3.0.0/>) or get it from github with bug fixes:
+(`wxWidgets-3.0.3.tar.bz2` from <https://github.com/wxWidgets/wxWidgets/releases/download/v3.0.3/wxWidgets-3.0.3.tar.bz2>) or get it from github with bug fixes:
$ git clone --branch WX_3_0_BRANCH [email protected]:wxWidgets/wxWidgets.git
-Be aware that the wxWidgets-3.0 is a new release of wxWidgets, it is not as
-mature as the old releases and the OS X port still lags behind the other ports.
+The wxWidgets-3.1 version should also work if 2.8 compatibility is enabled,
+add `--enable-compat28` to configure commands below.
+
+Configure and build wxWidgets (shared library on linux):
+
+ $ ./configure --prefix=/usr/local
+ $ make && sudo make install
+ $ export PATH=/usr/local/bin:$PATH
+
+Configure and build wxWidgets (static library on linux):
+
+ $ export CFLAGS=-fPIC
+ $ export CXXFLAGS=-fPIC
+ $ ./configure --prefix=/usr/local --disable-shared
+ $ make && sudo make install
+ $ export PATH=/usr/local/bin:$PATH
Configure and build wxWidgets (on Mavericks - 10.9):
@@ -794,7 +805,6 @@ Use `hipe:help_options/0` to print out the available options.
[man pages]: http://www.erlang.org/download/otp_doc_man_%OTP-VSN%.tar.gz
[the released source tar ball]: http://www.erlang.org/download/otp_src_%OTP-VSN%.tar.gz
[System Principles]: ../system_principles/system_principles
- [Known platform issues]: #Known-platform-issues
[native build]: #How-to-Build-and-Install-ErlangOTP
[cross build]: INSTALL-CROSS.md
[Required Utilities]: #Required-Utilities
diff --git a/Makefile.in b/Makefile.in
index 6b5ce8c53f..3dce72ba78 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -427,6 +427,18 @@ ifneq ($(OTP_SMALL_BUILD),true)
echo "OTP doc built" > $(ERL_TOP)/make/otp_doc_built
endif
+xmllint: docs
+ PATH=$(BOOT_PREFIX)"$${PATH}" ERL_TOP=$(ERL_TOP) \
+ $(MAKE) -C erts/ $@
+ifeq ($(OTP_SMALL_BUILD),true)
+ PATH=$(BOOT_PREFIX)"$${PATH}" ERL_TOP=$(ERL_TOP) \
+ $(MAKE) -C lib/ $@
+else
+ PATH=$(BOOT_PREFIX)"$${PATH}" ERL_TOP=$(ERL_TOP) \
+ $(MAKE) BUILD_ALL=1 -C lib/ $@
+ PATH=$(BOOT_PREFIX)"$${PATH}" ERL_TOP=$(ERL_TOP) \
+ $(MAKE) -C system/doc $@
+endif
mod2app:
PATH=$(BOOT_PREFIX)"$${PATH}" escript $(BOOTSTRAP_ROOT)/bootstrap/lib/erl_docgen/priv/bin/xref_mod_app.escript -topdir $(ERL_TOP) -outfile $(ERL_TOP)/make/$(TARGET)/mod2app.xml
diff --git a/OTP_VERSION b/OTP_VERSION
index 42ee6ac80e..bf8f7ca9a2 100644
--- a/OTP_VERSION
+++ b/OTP_VERSION
@@ -1 +1 @@
-20.1.3
+20.1.7
diff --git a/erts/Makefile b/erts/Makefile
index 12d2ec57a8..ffada839a7 100644
--- a/erts/Makefile
+++ b/erts/Makefile
@@ -147,3 +147,7 @@ release:
.PHONY: release_docs
release_docs:
$(V_at)( cd doc/src && $(MAKE) $@ )
+
+.PHONY: xmllint
+xmllint:
+ $(MAKE) -C doc/src $@
diff --git a/erts/doc/src/Makefile b/erts/doc/src/Makefile
index 1f591a5cff..18c5490d7b 100644
--- a/erts/doc/src/Makefile
+++ b/erts/doc/src/Makefile
@@ -69,6 +69,7 @@ XML_PART_FILES = \
part.xml
XML_CHAPTER_FILES = \
+ introduction.xml \
tty.xml \
match_spec.xml \
crash_dump.xml \
@@ -80,8 +81,7 @@ XML_CHAPTER_FILES = \
erl_dist_protocol.xml \
communication.xml \
time_correction.xml \
- notes.xml \
- notes_history.xml
+ notes.xml
TOPDOCDIR=../../../doc
diff --git a/erts/doc/src/erl_nif.xml b/erts/doc/src/erl_nif.xml
index 419e41693e..ef3cdb89e9 100644
--- a/erts/doc/src/erl_nif.xml
+++ b/erts/doc/src/erl_nif.xml
@@ -952,6 +952,8 @@ typedef struct {
<desc>
<p>Allocates memory of <c>size</c> bytes.</p>
<p>Returns <c>NULL</c> if the allocation fails.</p>
+ <p>The returned pointer is suitably aligned for any built-in type that
+ fit in the allocated memory.</p>
</desc>
</func>
@@ -2760,6 +2762,20 @@ enif_map_iterator_destroy(env, &amp;iter);</code>
</func>
<func>
+ <name><ret>void *</ret>
+ <nametext>enif_realloc(void* ptr, size_t size)</nametext></name>
+ <fsummary>Reallocate dynamic memory.</fsummary>
+ <desc>
+ <p>Reallocates memory allocated by
+ <seealso marker="#enif_alloc"><c>enif_alloc</c></seealso> to
+ <c>size</c> bytes.</p>
+ <p>Returns <c>NULL</c> if the reallocation fails.</p>
+ <p>The returned pointer is suitably aligned for any built-in type that
+ fit in the allocated memory.</p>
+ </desc>
+ </func>
+
+ <func>
<name><ret>int</ret>
<nametext>enif_realloc_binary(ErlNifBinary* bin, size_t size)</nametext>
</name>
diff --git a/erts/doc/src/erlang.xml b/erts/doc/src/erlang.xml
index 2465f49581..b04f2b008e 100644
--- a/erts/doc/src/erlang.xml
+++ b/erts/doc/src/erlang.xml
@@ -2955,7 +2955,10 @@ os_prompt%</pre>
<p>The total amount of memory currently allocated for
the emulator that is not directly related to any Erlang
process. Memory presented as <c>processes</c> is not
- included in this memory.</p>
+ included in this memory. <seealso marker="tools:instrument">
+ <c>instrument(3)</c></seealso> can be used to
+ get a more detailed breakdown of what memory is part
+ of this type.</p>
</item>
<tag><c>atom</c></tag>
<item>
@@ -4687,7 +4690,7 @@ RealSystem = system + MissedSystem</code>
<p>The default <c>message_queue_data</c> process flag is determined
by command-line argument <seealso marker="erl#+hmqd">
<c>+hmqd</c></seealso> in <c>erl(1)</c>.</p>
- <p>If the process potentially can get many messages,
+ <p>If the process potentially can get many messages in its queue,
you are advised to set the flag to <c>off_heap</c>. This
because a garbage collection with many messages placed on
the heap can become extremely expensive and the process can
@@ -4960,11 +4963,15 @@ RealSystem = system + MissedSystem</code>
<tag><c>{binary, <anno>BinInfo</anno>}</c></tag>
<item>
<p><c><anno>BinInfo</anno></c> is a list containing miscellaneous
- information about binaries currently referred to by this
- process. This <c><anno>InfoTuple</anno></c> can be changed or
+ information about binaries on the heap of this
+ process.
+ This <c><anno>InfoTuple</anno></c> can be changed or
removed without prior notice. In the current implementation
<c><anno>BinInfo</anno></c> is a list of tuples. The tuples
contain; <c>BinaryId</c>, <c>BinarySize</c>, <c>BinaryRefcCount</c>.</p>
+ <p>The message queue is on the heap depending on the
+ process flag <seealso marker="#process_flag_message_queue_data">
+ <c>message_queue_data</c></seealso>.</p>
</item>
<tag><c>{catchlevel, <anno>CatchLevel</anno>}</c></tag>
<item>
@@ -8869,6 +8876,10 @@ hello
</pre>
<p>See also <seealso marker="#binary_to_term/1">
<c>binary_to_term/1</c></seealso>.</p>
+ <note>
+ <p>There is no guarantee that this function will return
+ the same encoded representation for the same term.</p>
+ </note>
</desc>
</func>
diff --git a/erts/doc/src/notes.xml b/erts/doc/src/notes.xml
index e4c33f8bd3..91eabb5607 100644
--- a/erts/doc/src/notes.xml
+++ b/erts/doc/src/notes.xml
@@ -31,6 +31,75 @@
</header>
<p>This document describes the changes made to the ERTS application.</p>
+<section><title>Erts 9.1.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Fixed a bug in file closure on Unix; close(2) was
+ retried on EINTR which could cause a different (recently
+ opened) file to be closed as well.</p>
+ <p>
+ Own Id: OTP-14775</p>
+ </item>
+ <item>
+ <p>
+ A race-condition when tearing down a connection with
+ active node monitors could cause the runtime system to
+ crash.</p>
+ <p>
+ This bug was introduced in ERTS version 8.0 (OTP 19.0).</p>
+ <p>
+ Own Id: OTP-14781 Aux Id: OTP-13047 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Erts 9.1.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>Microstate accounting sometimes produced incorrect
+ results for dirty schedulers.</p>
+ <p>
+ Own Id: OTP-14707</p>
+ </item>
+ <item>
+ <p>Fixed a regression in <c>zlib:gunzip/1</c> that
+ prevented it from working when the decompressed size was
+ a perfect multiple of 16384. This regression was
+ introduced in 20.1.1</p>
+ <p>
+ Own Id: OTP-14730 Aux Id: ERL-507 </p>
+ </item>
+ <item>
+ <p>Fixed a memory corruption bug in
+ <c>enif_inspect_iovec</c>; writable binaries stayed
+ writable after entering the iovec.</p>
+ <p>
+ Own Id: OTP-14745</p>
+ </item>
+ <item>
+ <p>Fixed a crash in <c>enif_inspect_iovec</c> on
+ encountering empty binaries.</p>
+ <p>
+ Own Id: OTP-14750</p>
+ </item>
+ <item>
+ <p><c>zlib:deflateParams/3</c> will no longer return
+ <c>buf_error</c> when called after <c>zlib:deflate/2</c>
+ with zlib <c>1.2.11</c>.</p>
+ <p>
+ Own Id: OTP-14751</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Erts 9.1.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
@@ -2850,6 +2919,58 @@
</section>
+<section><title>Erts 7.3.1.4</title>
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Fix performance bug in pre-allocators that could cause
+ them to permanently fall back on normal more expensive
+ memory allocation. Pre-allocators are used for quick
+ allocation of short lived meta data used by messages and
+ other scheduled tasks. Bug exists since OTP_R15B02.</p>
+ <p>
+ Own Id: OTP-14491</p>
+ </item>
+ <item>
+ <p>
+ Fixed bug in operator <c>bxor</c> causing erroneuos
+ result when one operand is a big <em>negative</em>
+ integer with the lowest <c>N*W</c> bits as zero and the
+ other operand not larger than <c>N*W</c> bits. <c>N</c>
+ is an integer of 1 or larger and <c>W</c> is 32 or 64
+ depending on word size.</p>
+ <p>
+ Own Id: OTP-14514</p>
+ </item>
+ <item>
+ <p>
+ A timer internal bit-field used for storing scheduler id
+ was too small. As a result, VM internal timer data
+ structures could become inconsistent when using 1024
+ schedulers on the system. Note that systems with less
+ than 1024 schedulers are not effected by this bug.</p>
+ <p>
+ This bug was introduced in ERTS version 7.0 (OTP 18.0).</p>
+ <p>
+ Own Id: OTP-14548 Aux Id: OTP-11997, ERL-468 </p>
+ </item>
+ <item>
+ <p>
+ Fixed bug in <c>binary_to_term</c> and
+ <c>binary_to_atom</c> that could cause VM crash.
+ Typically happens when the last character of an UTF8
+ string is in the range 128 to 255, but truncated to only
+ one byte. Bug exists in <c>binary_to_term</c> since ERTS
+ version 5.10.2 (OTP_R16B01) and <c>binary_to_atom</c>
+ since ERTS version 9.0 (OTP-20.0).</p>
+ <p>
+ Own Id: OTP-14590 Aux Id: ERL-474 </p>
+ </item>
+ </list>
+ </section>
+</section>
+
<section><title>Erts 7.3.1.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/erts/doc/src/run_erl.xml b/erts/doc/src/run_erl.xml
index a9b6a7e2c6..e4c1b943c4 100644
--- a/erts/doc/src/run_erl.xml
+++ b/erts/doc/src/run_erl.xml
@@ -181,6 +181,12 @@
<item>
<p>Controls the number of log files written before older
files are reused. Defaults to 5, minimum is 2, maximum is 1000.</p>
+ <p>Note that, as a way to indicate the newest file, <c>run_erl</c> will
+ delete the oldest log file to maintain a "hole" in the file
+ sequences. For example, if log files #1, #2, #4 and #5 exists, that
+ means #2 is the latest and #4 is the oldest. You will therefore at most
+ get one less log file than the value set by
+ <c>RUN_ERL_LOG_GENERATIONS</c>.</p>
</item>
<tag><c>RUN_ERL_LOG_MAXSIZE</c></tag>
<item>
diff --git a/erts/emulator/beam/atom.h b/erts/emulator/beam/atom.h
index be998a46bd..385120a8d9 100644
--- a/erts/emulator/beam/atom.h
+++ b/erts/emulator/beam/atom.h
@@ -36,7 +36,7 @@
/* Internal atom cache needs MAX_ATOM_TABLE_SIZE to be less than an
unsigned 32 bit integer. See external.c(erts_encode_ext_dist_header_setup)
for more details. */
-#define MAX_ATOM_TABLE_SIZE ((MAX_ATOM_INDEX + 1 < (UWORD_CONSTANT(1) << 32)) ? MAX_ATOM_INDEX + 1 : (UWORD_CONSTANT(1) << 32))
+#define MAX_ATOM_TABLE_SIZE ((MAX_ATOM_INDEX + 1 < (UWORD_CONSTANT(1) << 32)) ? MAX_ATOM_INDEX + 1 : ((UWORD_CONSTANT(1) << 31) - 1)) /* Here we use maximum signed interger value to avoid integer overflow */
#else
#define MAX_ATOM_TABLE_SIZE (MAX_ATOM_INDEX + 1)
#endif
diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 23258dbe9c..adf8779f11 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -5665,13 +5665,36 @@ erts_release_literal_area(ErtsLiteralArea* literal_area)
return;
oh = literal_area->off_heap;
-
+
while (oh) {
- Binary* bptr;
- ASSERT(thing_subtag(oh->thing_word) == REFC_BINARY_SUBTAG);
- bptr = ((ProcBin*)oh)->val;
- erts_bin_release(bptr);
- oh = oh->next;
+ switch (thing_subtag(oh->thing_word)) {
+ case REFC_BINARY_SUBTAG:
+ {
+ Binary* bptr = ((ProcBin*)oh)->val;
+ erts_bin_release(bptr);
+ break;
+ }
+ case FUN_SUBTAG:
+ {
+ ErlFunEntry* fe = ((ErlFunThing*)oh)->fe;
+ if (erts_smp_refc_dectest(&fe->refc, 0) == 0) {
+ erts_erase_fun_entry(fe);
+ }
+ break;
+ }
+ case REF_SUBTAG:
+ {
+ ErtsMagicBinary *bptr;
+ ASSERT(is_magic_ref_thing(oh));
+ bptr = ((ErtsMRefThing *) oh)->mb;
+ erts_bin_release((Binary *) bptr);
+ break;
+ }
+ default:
+ ASSERT(is_external_header(oh->thing_word));
+ erts_deref_node_entry(((ExternalThing*)oh)->node);
+ }
+ oh = oh->next;
}
erts_free(ERTS_ALC_T_LITERAL, literal_area);
}
diff --git a/erts/emulator/beam/break.c b/erts/emulator/beam/break.c
index e57be5a595..e4c2801ea2 100644
--- a/erts/emulator/beam/break.c
+++ b/erts/emulator/beam/break.c
@@ -492,9 +492,7 @@ loaded(fmtfn_t to, void *to_arg)
static void
dump_attributes(fmtfn_t to, void *to_arg, byte* ptr, int size)
{
- while (size-- > 0) {
- erts_print(to, to_arg, "%02X", *ptr++);
- }
+ erts_print_base64(to, to_arg, ptr, size);
erts_print(to, to_arg, "\n");
}
@@ -858,7 +856,7 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
}
time(&now);
- erts_cbprintf(to, to_arg, "=erl_crash_dump:0.4\n%s", ctime(&now));
+ erts_cbprintf(to, to_arg, "=erl_crash_dump:0.5\n%s", ctime(&now));
if (file != NULL)
erts_cbprintf(to, to_arg, "The error occurred in file %s, line %d\n", file, line);
@@ -975,3 +973,28 @@ erl_crash_dump_v(char *file, int line, char* fmt, va_list args)
erts_fprintf(stderr,"done\n");
}
+void
+erts_print_base64(fmtfn_t to, void *to_arg, byte* src, Uint size)
+{
+ static const byte base64_chars[] =
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";
+
+ while (size >= 3) {
+ erts_putc(to, to_arg, base64_chars[src[0] >> 2]);
+ erts_putc(to, to_arg, base64_chars[((src[0] & 0x03) << 4) | (src[1] >> 4)]);
+ erts_putc(to, to_arg, base64_chars[((src[1] & 0x0f) << 2) | (src[2] >> 6)]);
+ erts_putc(to, to_arg, base64_chars[src[2] & 0x3f]);
+ size -= 3;
+ src += 3;
+ }
+ if (size == 1) {
+ erts_putc(to, to_arg, base64_chars[src[0] >> 2]);
+ erts_putc(to, to_arg, base64_chars[(src[0] & 0x03) << 4]);
+ erts_print(to, to_arg, "==");
+ } else if (size == 2) {
+ erts_putc(to, to_arg, base64_chars[src[0] >> 2]);
+ erts_putc(to, to_arg, base64_chars[((src[0] & 0x03) << 4) | (src[1] >> 4)]);
+ erts_putc(to, to_arg, base64_chars[(src[1] & 0x0f) << 2]);
+ erts_putc(to, to_arg, '=');
+ }
+}
diff --git a/erts/emulator/beam/dist.c b/erts/emulator/beam/dist.c
index 09fdb897f5..9fddac8980 100644
--- a/erts/emulator/beam/dist.c
+++ b/erts/emulator/beam/dist.c
@@ -385,22 +385,24 @@ static void doit_node_link_net_exits(ErtsLink *lnk, void *vnecp)
if (!rp)
goto done;
erts_smp_proc_lock(rp, rp_locks);
- rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name);
- if (rlnk != NULL) {
- ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE));
- erts_destroy_link(rlnk);
- }
- n = ERTS_LINK_REFC(lnk);
- for (i = 0; i < n; ++i) {
- Eterm tup;
- Eterm *hp;
- ErtsMessage *msgp;
-
- msgp = erts_alloc_message_heap(rp, &rp_locks,
- 3, &hp, &ohp);
- tup = TUPLE2(hp, am_nodedown, name);
- erts_queue_message(rp, rp_locks, msgp, tup, am_system);
- }
+ if (!ERTS_PROC_IS_EXITING(rp)) {
+ rlnk = erts_remove_link(&ERTS_P_LINKS(rp), name);
+ if (rlnk != NULL) {
+ ASSERT(is_atom(rlnk->pid) && (rlnk->type == LINK_NODE));
+ erts_destroy_link(rlnk);
+ }
+ n = ERTS_LINK_REFC(lnk);
+ for (i = 0; i < n; ++i) {
+ Eterm tup;
+ Eterm *hp;
+ ErtsMessage *msgp;
+
+ msgp = erts_alloc_message_heap(rp, &rp_locks,
+ 3, &hp, &ohp);
+ tup = TUPLE2(hp, am_nodedown, name);
+ erts_queue_message(rp, rp_locks, msgp, tup, am_system);
+ }
+ }
erts_smp_proc_unlock(rp, rp_locks);
}
done:
diff --git a/erts/emulator/beam/erl_gc.c b/erts/emulator/beam/erl_gc.c
index 8cb977a7f3..6a87136463 100644
--- a/erts/emulator/beam/erl_gc.c
+++ b/erts/emulator/beam/erl_gc.c
@@ -1234,8 +1234,8 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
p->old_htop = old_htop;
/*
- * Prepare to sweep binaries. Since all MSOs on the new heap
- * must be come before MSOs on the old heap, find the end of
+ * Prepare to sweep off-heap objects. Since all MSOs on the new
+ * heap must be come before MSOs on the old heap, find the end of
* current MSO list and use that as a starting point.
*/
@@ -1247,25 +1247,50 @@ erts_garbage_collect_literals(Process* p, Eterm* literals,
}
/*
- * Sweep through all binaries in the temporary literal area.
+ * Sweep through all off-heap objects in the temporary literal area.
*/
while (oh) {
if (IS_MOVED_BOXED(oh->thing_word)) {
- Binary* bptr;
struct erl_off_heap_header* ptr;
- ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
- ASSERT(thing_subtag(ptr->thing_word) == REFC_BINARY_SUBTAG);
- bptr = ((ProcBin*)ptr)->val;
-
- /*
- * This binary has been copied to the heap.
+ /*
+ * This off-heap object has been copied to the heap.
* We must increment its reference count and
* link it into the MSO list for the process.
*/
- erts_refc_inc(&bptr->intern.refc, 1);
+ ptr = (struct erl_off_heap_header*) boxed_val(oh->thing_word);
+ switch (thing_subtag(ptr->thing_word)) {
+ case REFC_BINARY_SUBTAG:
+ {
+ Binary* bptr = ((ProcBin*)ptr)->val;
+ erts_refc_inc(&bptr->intern.refc, 1);
+ break;
+ }
+ case FUN_SUBTAG:
+ {
+ ErlFunEntry* fe = ((ErlFunThing*)ptr)->fe;
+ erts_refc_inc(&fe->refc, 1);
+ break;
+ }
+ case REF_SUBTAG:
+ {
+ ErtsMagicBinary *bptr;
+ ASSERT(is_magic_ref_thing(ptr));
+ bptr = ((ErtsMRefThing *) ptr)->mb;
+ erts_refc_inc(&bptr->intern.refc, 1);
+ break;
+ }
+ default:
+ {
+ ExternalThing *etp;
+ ASSERT(is_external_header(ptr->thing_word));
+ etp = (ExternalThing *) ptr;
+ erts_smp_refc_inc(&etp->node->refc, 1);
+ break;
+ }
+ }
*prev = ptr;
prev = &ptr->next;
}
diff --git a/erts/emulator/beam/erl_msacc.h b/erts/emulator/beam/erl_msacc.h
index d64ef8c8b9..3f6273f214 100644
--- a/erts/emulator/beam/erl_msacc.h
+++ b/erts/emulator/beam/erl_msacc.h
@@ -279,18 +279,32 @@ void erts_msacc_init_thread(char *type, int id, int liberty);
#define ERTS_MSACC_PUSH_STATE_M() \
ERTS_MSACC_DECLARE_CACHE(); \
ERTS_MSACC_PUSH_STATE_CACHED_M()
-#define ERTS_MSACC_PUSH_STATE_CACHED_M() \
- __erts_msacc_state = ERTS_MSACC_IS_ENABLED_CACHED() ? \
- erts_msacc_get_state_m__(__erts_msacc_cache) : ERTS_MSACC_STATE_OTHER
+#define ERTS_MSACC_PUSH_STATE_CACHED_M() \
+ do { \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) { \
+ ASSERT(!__erts_msacc_cache->unmanaged); \
+ __erts_msacc_state = erts_msacc_get_state_m__(__erts_msacc_cache); \
+ } else { \
+ __erts_msacc_state = ERTS_MSACC_STATE_OTHER; \
+ } \
+ } while(0)
#define ERTS_MSACC_SET_STATE_M(state) \
ERTS_MSACC_DECLARE_CACHE(); \
ERTS_MSACC_SET_STATE_CACHED_M(state)
-#define ERTS_MSACC_SET_STATE_CACHED_M(state) \
- if (ERTS_MSACC_IS_ENABLED_CACHED()) \
- erts_msacc_set_state_m__(__erts_msacc_cache, state, 1)
-#define ERTS_MSACC_POP_STATE_M() \
- if (ERTS_MSACC_IS_ENABLED_CACHED()) \
- erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0)
+#define ERTS_MSACC_SET_STATE_CACHED_M(state) \
+ do { \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) { \
+ ASSERT(!__erts_msacc_cache->unmanaged); \
+ erts_msacc_set_state_m__(__erts_msacc_cache, state, 1); \
+ } \
+ } while(0)
+#define ERTS_MSACC_POP_STATE_M() \
+ do { \
+ if (ERTS_MSACC_IS_ENABLED_CACHED()) { \
+ ASSERT(!__erts_msacc_cache->unmanaged); \
+ erts_msacc_set_state_m__(__erts_msacc_cache, __erts_msacc_state, 0); \
+ } \
+ } while(0)
#define ERTS_MSACC_PUSH_AND_SET_STATE_M(state) \
ERTS_MSACC_PUSH_STATE_M(); ERTS_MSACC_SET_STATE_CACHED_M(state)
diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c
index ac4ecd77e5..f67b67325d 100644
--- a/erts/emulator/beam/erl_nif.c
+++ b/erts/emulator/beam/erl_nif.c
@@ -550,6 +550,9 @@ void enif_clear_env(ErlNifEnv* env)
ASSERT(p == menv->env.proc);
ASSERT(p->common.id == ERTS_INVALID_PID);
ASSERT(MBUF(p) == menv->env.heap_frag);
+
+ free_tmp_objs(env);
+
if (MBUF(p) != NULL) {
erts_cleanup_offheap(&MSO(p));
clear_offheap(&MSO(p));
@@ -561,7 +564,6 @@ void enif_clear_env(ErlNifEnv* env)
menv->env.hp = menv->env.hp_end = HEAP_TOP(p);
ASSERT(!is_offheap(&MSO(p)));
- free_tmp_objs(env);
}
#ifdef ERTS_SMP
@@ -3426,36 +3428,38 @@ static int examine_iovec_term(Eterm list, UWord max_length, iovec_slice_t *resul
size = binary_size(binary);
binary_header = binary_val(binary);
- /* If we're a sub-binary we'll need to check our underlying binary to
- * determine whether we're on-heap or not. */
- if(thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) {
- ErlSubBin *sb = (ErlSubBin*)binary_header;
+ if (size > 0) {
+ /* If we're a sub-binary we'll need to check our underlying binary
+ * to determine whether we're on-heap or not. */
+ if (thing_subtag(*binary_header) == SUB_BINARY_SUBTAG) {
+ ErlSubBin *sb = (ErlSubBin*)binary_header;
- /* Reject bitstrings */
- if((sb->bitoffs + sb->bitsize) > 0) {
- return 0;
- }
+ /* Reject bitstrings */
+ if((sb->bitoffs + sb->bitsize) > 0) {
+ return 0;
+ }
- ASSERT(size <= binary_size(sb->orig));
- binary_header = binary_val(sb->orig);
- }
+ ASSERT(size <= binary_size(sb->orig));
+ binary_header = binary_val(sb->orig);
+ }
- if(thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) {
- ASSERT(size <= ERL_ONHEAP_BIN_LIMIT);
+ if (thing_subtag(*binary_header) == HEAP_BINARY_SUBTAG) {
+ ASSERT(size <= ERL_ONHEAP_BIN_LIMIT);
- result->iovec_len += 1;
- result->onheap_size += size;
- } else {
- ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG);
+ result->iovec_len += 1;
+ result->onheap_size += size;
+ } else {
+ ASSERT(thing_subtag(*binary_header) == REFC_BINARY_SUBTAG);
- result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN;
- result->offheap_size += size;
+ result->iovec_len += 1 + size / MAX_SYSIOVEC_IOVLEN;
+ result->offheap_size += size;
+ }
}
result->sublist_length += 1;
lookahead = CDR(cell);
- if(result->sublist_length >= max_length) {
+ if (result->sublist_length >= max_length) {
break;
}
}
@@ -3488,6 +3492,10 @@ static void inspect_raw_binary_data(Eterm binary, ErlNifBinary *result) {
if (thing_subtag(*parent_header) == REFC_BINARY_SUBTAG) {
ProcBin *pb = (ProcBin*)parent_header;
+ if (pb->flags & (PB_IS_WRITABLE | PB_ACTIVE_WRITER)) {
+ erts_emasculate_writable_binary(pb);
+ }
+
ASSERT(pb->val != NULL);
ASSERT(byte_offset < pb->size);
ASSERT(&pb->bytes[byte_offset] >= (byte*)(pb->val)->orig_bytes);
@@ -3531,7 +3539,7 @@ static int fill_iovec_with_slice(ErlNifEnv *env,
/* If this isn't a refc binary, copy its contents to the onheap buffer
* and reference that instead. */
- if (raw_data.ref_bin == NULL) {
+ if (raw_data.size > 0 && raw_data.ref_bin == NULL) {
ASSERT(onheap_offset < onheap_data.size);
ASSERT(slice->onheap_size > 0);
@@ -3542,12 +3550,11 @@ static int fill_iovec_with_slice(ErlNifEnv *env,
raw_data.ref_bin = onheap_data.ref_bin;
}
- ASSERT(raw_data.ref_bin != NULL);
-
while (raw_data.size > 0) {
UWord chunk_len = MIN(raw_data.size, MAX_SYSIOVEC_IOVLEN);
ASSERT(iovec_idx < iovec->iovcnt);
+ ASSERT(raw_data.ref_bin != NULL);
iovec->iov[iovec_idx].iov_base = raw_data.data;
iovec->iov[iovec_idx].iov_len = chunk_len;
diff --git a/erts/emulator/beam/erl_nif.h b/erts/emulator/beam/erl_nif.h
index d195721054..7fb447e4a8 100644
--- a/erts/emulator/beam/erl_nif.h
+++ b/erts/emulator/beam/erl_nif.h
@@ -50,10 +50,11 @@
** 2.9: 18.2 enif_getenv
** 2.10: Time API
** 2.11: 19.0 enif_snprintf
-** 2.12: 20.0 add enif_queue
+** 2.12: 20.0 add enif_select, enif_open_resource_type_x
+** 2.13: 20.1 add enif_ioq
*/
#define ERL_NIF_MAJOR_VERSION 2
-#define ERL_NIF_MINOR_VERSION 12
+#define ERL_NIF_MINOR_VERSION 13
/*
* The emulator will refuse to load a nif-lib with a major version
diff --git a/erts/emulator/beam/erl_process.c b/erts/emulator/beam/erl_process.c
index 1ce2b5071c..63e9275ac1 100644
--- a/erts/emulator/beam/erl_process.c
+++ b/erts/emulator/beam/erl_process.c
@@ -3417,7 +3417,7 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
int thr_prgr_active = 1;
erts_aint32_t flgs;
#endif
- ERTS_MSACC_PUSH_STATE_M();
+ ERTS_MSACC_PUSH_STATE();
#ifdef ERTS_SMP
ERTS_SMP_LC_ASSERT(erts_smp_lc_runq_is_locked(rq));
@@ -3542,9 +3542,9 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
- 1) + 1;
} else
timeout = -1;
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_SLEEP);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_SLEEP);
res = erts_tse_twait(ssi->event, timeout);
- ERTS_MSACC_POP_STATE_M();
+ ERTS_MSACC_POP_STATE();
current_time = ERTS_SCHEDULER_IS_DIRTY(esdp) ? 0 :
erts_get_monotonic_time(esdp);
} while (res == EINTR);
@@ -3743,12 +3743,12 @@ scheduler_wait(int *fcalls, ErtsSchedulerData *esdp, ErtsRunQueue *rq)
ASSERT(!erts_port_task_have_outstanding_io_tasks());
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_CHECK_IO);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_CHECK_IO);
LTTNG2(scheduler_poll, esdp->no, 0);
erl_sys_schedule(0);
- ERTS_MSACC_POP_STATE_M();
+ ERTS_MSACC_POP_STATE();
if (!ERTS_SCHEDULER_IS_DIRTY(esdp)) {
ErtsMonotonicTime current_time = erts_get_monotonic_time(esdp);
@@ -10350,7 +10350,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
| ERTS_PROC_LOCK_STATUS
| ERTS_PROC_LOCK_TRACE));
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
#ifdef ERTS_SMP
if (state & ERTS_PSFLG_FREE) {
@@ -10642,7 +10642,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
case 0: /* No process at all */
default:
ASSERT(qmask == 0);
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_OTHER);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_OTHER);
goto check_activities_to_run;
}
@@ -10766,7 +10766,7 @@ Process *erts_schedule(ErtsSchedulerData *esdp, Process *p, int calls)
}
- ERTS_MSACC_SET_STATE_CACHED_M(ERTS_MSACC_STATE_EMULATOR);
+ ERTS_MSACC_SET_STATE_CACHED(ERTS_MSACC_STATE_EMULATOR);
#ifdef ERTS_SMP
@@ -11591,7 +11591,7 @@ request_system_task(Process *c_p, Eterm requester, Eterm target,
goto badarg;
req_type = tp[1];
req_id = tp[2];
- req_id_sz = is_immed(req_id) ? req_id : size_object(req_id);
+ req_id_sz = is_immed(req_id) ? 0 : size_object(req_id);
tot_sz = req_id_sz;
for (i = 0; i < ERTS_MAX_PROC_SYS_TASK_ARGS; i++) {
int tix = 3 + i;
diff --git a/erts/emulator/beam/erl_process_dump.c b/erts/emulator/beam/erl_process_dump.c
index 5641195458..e0b795fbf3 100644
--- a/erts/emulator/beam/erl_process_dump.c
+++ b/erts/emulator/beam/erl_process_dump.c
@@ -51,6 +51,8 @@ static void stack_trace_dump(fmtfn_t to, void *to_arg, Eterm* sp);
static void print_function_from_pc(fmtfn_t to, void *to_arg, BeamInstr* x);
static void heap_dump(fmtfn_t to, void *to_arg, Eterm x);
static void dump_binaries(fmtfn_t to, void *to_arg, Binary* root);
+void erts_print_base64(fmtfn_t to, void *to_arg,
+ byte* src, Uint size);
static void dump_externally(fmtfn_t to, void *to_arg, Eterm term);
static void mark_literal(Eterm* ptr);
static void init_literal_areas(void);
@@ -193,6 +195,7 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
else {
byte *e;
size_t sz;
+
if (!(edep->flags & ERTS_DIST_EXT_ATOM_TRANS_TAB))
erts_print(to, to_arg, "D0:");
else {
@@ -210,12 +213,18 @@ dump_dist_ext(fmtfn_t to, void *to_arg, ErtsDistExternal *edep)
else {
ASSERT(*e == VERSION_MAGIC);
}
-
erts_print(to, to_arg, "E%X:", sz);
- if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR)
- erts_print(to, to_arg, "%02X", VERSION_MAGIC);
- while (e < edep->ext_endp)
- erts_print(to, to_arg, "%02X", *e++);
+ if (edep->flags & ERTS_DIST_EXT_DFLAG_HDR) {
+ byte sbuf[3];
+ int i = 0;
+
+ sbuf[i++] = VERSION_MAGIC;
+ while (i < sizeof(sbuf) && e < edep->ext_endp) {
+ sbuf[i++] = *e++;
+ }
+ erts_print_base64(to, to_arg, sbuf, i);
+ }
+ erts_print_base64(to, to_arg, e, edep->ext_endp - e);
}
}
@@ -444,16 +453,13 @@ heap_dump(fmtfn_t to, void *to_arg, Eterm x)
} else if (is_binary_header(hdr)) {
Uint tag = thing_subtag(hdr);
Uint size = binary_size(x);
- Uint i;
if (tag == HEAP_BINARY_SUBTAG) {
byte* p;
erts_print(to, to_arg, "Yh%X:", size);
p = binary_bytes(x);
- for (i = 0; i < size; i++) {
- erts_print(to, to_arg, "%02X", p[i]);
- }
+ erts_print_base64(to, to_arg, p, size);
} else if (tag == REFC_BINARY_SUBTAG) {
ProcBin* pb = (ProcBin *) binary_val(x);
Binary* val = pb->val;
@@ -596,16 +602,13 @@ static void
dump_binaries(fmtfn_t to, void *to_arg, Binary* current)
{
while (current) {
- long i;
- long size = current->orig_size;
+ SWord size = current->orig_size;
byte* bytes = (byte*) current->orig_bytes;
erts_print(to, to_arg, "=binary:" PTR_FMT "\n", current);
erts_print(to, to_arg, "%X:", size);
- for (i = 0; i < size; i++) {
- erts_print(to, to_arg, "%02X", bytes[i]);
- }
- erts_putc(to, to_arg, '\n');
+ erts_print_base64(to, to_arg, bytes, size);
+ erts_putc(to, to_arg, '\n');
current = (Binary *) current->intern.flags;
}
}
@@ -644,9 +647,7 @@ dump_externally(fmtfn_t to, void *to_arg, Eterm term)
s = p = sbuf;
erts_encode_ext(term, &p);
erts_print(to, to_arg, "E%X:", p-s);
- while (s < p) {
- erts_print(to, to_arg, "%02X", *s++);
- }
+ erts_print_base64(to, to_arg, sbuf, p-s);
}
/*
@@ -802,16 +803,13 @@ dump_module_literals(fmtfn_t to, void *to_arg, ErtsLiteralArea* lit_area)
} else if (is_binary_header(w)) {
Uint tag = thing_subtag(w);
Uint size = binary_size(term);
- Uint i;
if (tag == HEAP_BINARY_SUBTAG) {
byte* p;
erts_print(to, to_arg, "Yh%X:", size);
p = binary_bytes(term);
- for (i = 0; i < size; i++) {
- erts_print(to, to_arg, "%02X", p[i]);
- }
+ erts_print_base64(to, to_arg, p, size);
} else if (tag == REFC_BINARY_SUBTAG) {
ProcBin* pb = (ProcBin *) binary_val(term);
Binary* val = pb->val;
diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h
index 440723aea6..9505942307 100644
--- a/erts/emulator/beam/global.h
+++ b/erts/emulator/beam/global.h
@@ -966,6 +966,7 @@ void process_info(fmtfn_t, void *);
void print_process_info(fmtfn_t, void *, Process*);
void info(fmtfn_t, void *);
void loaded(fmtfn_t, void *);
+void erts_print_base64(fmtfn_t to, void *to_arg, byte* src, Uint size);
/* sighandler sys.c */
int erts_set_signal(Eterm signal, Eterm type);
diff --git a/erts/emulator/beam/index.c b/erts/emulator/beam/index.c
index a1f6f54543..7bf1a032c1 100644
--- a/erts/emulator/beam/index.c
+++ b/erts/emulator/beam/index.c
@@ -58,7 +58,7 @@ IndexTable*
erts_index_init(ErtsAlcType_t type, IndexTable* t, char* name,
int size, int limit, HashFunctions fun)
{
- Uint base_size = ((limit+INDEX_PAGE_SIZE-1)/INDEX_PAGE_SIZE)*sizeof(IndexSlot*);
+ Uint base_size = (((Uint)limit+INDEX_PAGE_SIZE-1)/INDEX_PAGE_SIZE)*sizeof(IndexSlot*);
hash_init(type, &t->htable, name, 3*size/4, fun);
t->size = 0;
diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c
index f8341f788a..33e4d75ef7 100644
--- a/erts/emulator/drivers/unix/unix_efile.c
+++ b/erts/emulator/drivers/unix/unix_efile.c
@@ -466,7 +466,7 @@ efile_may_openfile(Efile_error* errInfo, char *name) {
void
efile_closefile(int fd)
{
- while((close(fd) < 0) && (errno == EINTR));
+ close(fd);
}
int
diff --git a/erts/emulator/hipe/hipe_amd64_bifs.m4 b/erts/emulator/hipe/hipe_amd64_bifs.m4
index dca3887564..aff10f1528 100644
--- a/erts/emulator/hipe/hipe_amd64_bifs.m4
+++ b/erts/emulator/hipe/hipe_amd64_bifs.m4
@@ -463,6 +463,43 @@ ASYM($1):
#endif')
/*
+ * nogc_bif_interface_1(nbif_name, cbif_name)
+ *
+ * Generate native interface for a bif with implicit P
+ * The bif can fail but cannot do GC.
+ */
+
+define(nogc_bif_interface_1,
+`
+#ifndef HAVE_$1
+#`define' HAVE_$1
+ TEXT
+ .align 4
+ GLOBAL(ASYM($1))
+ASYM($1):
+ /* set up the parameters */
+ movq P, %rdi
+ NBIF_ARG(%rsi,1,0)
+
+ /* make the call on the C stack */
+ SWITCH_ERLANG_TO_C
+ pushq %rsi
+ movq %rsp, %rsi /* Eterm* BIF__ARGS */
+ sub $(8), %rsp /* stack frame 16-byte alignment */
+ CALL_BIF($2)
+ add $(1*8 + 8), %rsp
+ SWITCH_C_TO_ERLANG
+
+ /* throw exception if failure, otherwise return */
+ TEST_GOT_EXN
+ jz nbif_1_simple_exception
+ NBIF_RET(1)
+ SET_SIZE(ASYM($1))
+ TYPE_FUNCTION(ASYM($1))
+#endif')
+
+
+/*
* noproc_primop_interface_0(nbif_name, cbif_name)
* noproc_primop_interface_1(nbif_name, cbif_name)
* noproc_primop_interface_2(nbif_name, cbif_name)
diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab
index 4038ca7ef8..4f73770d24 100644
--- a/erts/emulator/hipe/hipe_bif0.tab
+++ b/erts/emulator/hipe/hipe_bif0.tab
@@ -140,3 +140,4 @@ atom bs_validate_unicode_retract
atom emulate_fpe
atom emasculate_binary
atom is_divisible
+atom is_unicode \ No newline at end of file
diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4
index f034c4700c..b86f2dafdc 100644
--- a/erts/emulator/hipe/hipe_bif_list.m4
+++ b/erts/emulator/hipe/hipe_bif_list.m4
@@ -223,6 +223,7 @@ standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub)
standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address)
nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error)
standard_bif_interface_2(nbif_is_divisible, hipe_is_divisible)
+noproc_primop_interface_1(nbif_is_unicode, hipe_is_unicode)
/*
* Mbox primops with implicit P parameter.
@@ -247,7 +248,11 @@ nofail_primop_interface_3(nbif_bs_get_float_2, erts_bs_get_float_2)
standard_bif_interface_3(nbif_bs_put_utf8, hipe_bs_put_utf8)
standard_bif_interface_3(nbif_bs_put_utf16be, hipe_bs_put_utf16be)
standard_bif_interface_3(nbif_bs_put_utf16le, hipe_bs_put_utf16le)
+ifdef(`nogc_bif_interface_1',`
+nogc_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
+',`
standard_bif_interface_1(nbif_bs_validate_unicode, hipe_bs_validate_unicode)
+')
/*
* Bit-syntax primops without any P parameter.
diff --git a/erts/emulator/hipe/hipe_debug.c b/erts/emulator/hipe/hipe_debug.c
index 222a11db3d..929b2a9432 100644
--- a/erts/emulator/hipe/hipe_debug.c
+++ b/erts/emulator/hipe/hipe_debug.c
@@ -63,12 +63,13 @@ static void print_beam_pc(BeamInstr *pc)
printf("normal-process-exit");
} else {
ErtsCodeMFA *cmfa = find_function_from_pc(pc);
- if (cmfa)
+ if (cmfa) {
+ fflush(stdout);
erts_printf("%T:%T/%bpu + 0x%bpx",
cmfa->module, cmfa->function,
cmfa->arity,
pc - erts_codemfa_to_code(cmfa));
- else
+ } else
printf("?");
}
}
@@ -116,6 +117,7 @@ static void print_stack(Eterm *sp, Eterm *end)
printf(" | 0x%0*lx | 0x%0*lx | ",
2*(int)sizeof(long), (unsigned long)sp,
2*(int)sizeof(long), (unsigned long)val);
+ fflush(stdout);
erts_printf("%.30T", val);
printf("\r\n");
}
@@ -126,7 +128,9 @@ static void print_stack(Eterm *sp, Eterm *end)
void hipe_print_estack(Process *p)
{
- printf(" | BEAM STACK |\r\n");
+ printf(" | %*s BEAM STACK %*s |\r\n",
+ 2*(int)sizeof(long)-3, "",
+ 2*(int)sizeof(long)-4, "");
print_stack(p->stop, STACK_START(p));
}
@@ -135,7 +139,9 @@ static void print_heap(Eterm *pos, Eterm *end)
printf("From: 0x%0*lx to 0x%0*lx\n\r",
2*(int)sizeof(long), (unsigned long)pos,
2*(int)sizeof(long), (unsigned long)end);
- printf(" | H E A P |\r\n");
+ printf(" | %*s H E A P %*s |\r\n",
+ 2*(int)sizeof(long)-1, "",
+ 2*(int)sizeof(long)-1, "");
printf(" | %*s | %*s |\r\n",
2+2*(int)sizeof(long), "Address",
2+2*(int)sizeof(long), "Contents");
@@ -158,8 +164,10 @@ static void print_heap(Eterm *pos, Eterm *end)
++pos;
--ari;
}
- } else
+ } else {
+ fflush(stdout);
erts_printf("%.30T", val);
+ }
printf("\r\n");
}
printf(" |%s|%s|\r\n", dashes, dashes);
@@ -173,11 +181,15 @@ void hipe_print_heap(Process *p)
void hipe_print_pcb(Process *p)
{
printf("P: 0x%0*lx\r\n", 2*(int)sizeof(long), (unsigned long)p);
- printf("-----------------------------------------------\r\n");
- printf("Offset| Name | Value | *Value |\r\n");
+ printf("%.*s\r\n",
+ 6+1+13+1+2*(int)sizeof(long)+4+1+2*(int)sizeof(long)+4+1,
+ "---------------------------------------------------------------");
+ printf("Offset| Name | Value %*s | *Value %*s |\r\n",
+ 2*(int)sizeof(long)-4, "",
+ 2*(int)sizeof(long)-5, "");
#undef U
#define U(n,x) \
- printf(" % 4d | %s | 0x%0*lx | |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x)
+ printf(" % 4d | %s | 0x%0*lx | %*s |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long)+2, "")
#undef P
#define P(n,x) \
printf(" % 4d | %s | 0x%0*lx | 0x%0*lx |\r\n", (int)offsetof(Process,x), n, 2*(int)sizeof(long), (unsigned long)p->x, 2*(int)sizeof(long), p->x ? (unsigned long)*(p->x) : -1UL)
@@ -241,5 +253,7 @@ void hipe_print_pcb(Process *p)
#endif /* HIPE */
#undef U
#undef P
- printf("-----------------------------------------------\r\n");
+ printf("%.*s\r\n",
+ 6+1+14+1+2*(int)sizeof(long)+4+1+2*(int)sizeof(long)+4+1,
+ "---------------------------------------------------------------");
}
diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c
index d8044fe6da..e1c22701d0 100644
--- a/erts/emulator/hipe/hipe_native_bif.c
+++ b/erts/emulator/hipe/hipe_native_bif.c
@@ -495,6 +495,12 @@ BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1)
return NIL;
}
+Uint hipe_is_unicode(Eterm arg)
+{
+ return (Uint) validate_unicode(arg);
+}
+
+
int hipe_bs_validate_unicode_retract(ErlBinMatchBuffer* mb, Eterm arg)
{
if (!validate_unicode(arg)) {
diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h
index 38f874888b..1127d4ac56 100644
--- a/erts/emulator/hipe/hipe_native_bif.h
+++ b/erts/emulator/hipe/hipe_native_bif.h
@@ -67,6 +67,7 @@ AEXTERN(Eterm,nbif_bs_put_utf16be,(Process*,Eterm,byte*,unsigned int));
AEXTERN(Eterm,nbif_bs_put_utf16le,(Process*,Eterm,byte*,unsigned int));
AEXTERN(Eterm,nbif_bs_get_utf16,(void));
AEXTERN(Eterm,nbif_bs_validate_unicode,(Process*,Eterm));
+AEXTERN(Uint,nbif_is_unicode,(Eterm));
AEXTERN(Eterm,nbif_bs_validate_unicode_retract,(void));
AEXTERN(void,nbif_is_divisible,(Process*,Uint,Uint));
@@ -92,6 +93,7 @@ Eterm hipe_bs_utf16_size(Eterm);
BIF_RETTYPE nbif_impl_hipe_bs_put_utf16be(NBIF_ALIST_3);
BIF_RETTYPE nbif_impl_hipe_bs_put_utf16le(NBIF_ALIST_3);
BIF_RETTYPE nbif_impl_hipe_bs_validate_unicode(NBIF_ALIST_1);
+Uint hipe_is_unicode(Eterm);
struct erl_bin_match_buffer;
int hipe_bs_validate_unicode_retract(struct erl_bin_match_buffer*, Eterm);
BIF_RETTYPE nbif_impl_hipe_is_divisible(NBIF_ALIST_2);
diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h
index 4fcbc9df38..77f0dfe7e5 100644
--- a/erts/emulator/hipe/hipe_primops.h
+++ b/erts/emulator/hipe/hipe_primops.h
@@ -66,6 +66,7 @@ PRIMOP_LIST(am_bs_put_utf16be, &nbif_bs_put_utf16be)
PRIMOP_LIST(am_bs_put_utf16le, &nbif_bs_put_utf16le)
PRIMOP_LIST(am_bs_get_utf16, &nbif_bs_get_utf16)
PRIMOP_LIST(am_bs_validate_unicode, &nbif_bs_validate_unicode)
+PRIMOP_LIST(am_is_unicode, &nbif_is_unicode)
PRIMOP_LIST(am_bs_validate_unicode_retract, &nbif_bs_validate_unicode_retract)
PRIMOP_LIST(am_is_divisible, &nbif_is_divisible)
diff --git a/erts/emulator/hipe/hipe_risc_stack.c b/erts/emulator/hipe/hipe_risc_stack.c
index 4001bedeb6..bb93a918a2 100644
--- a/erts/emulator/hipe/hipe_risc_stack.c
+++ b/erts/emulator/hipe/hipe_risc_stack.c
@@ -47,8 +47,10 @@ static void print_slot(Eterm *sp, unsigned int live)
printf(" | 0x%0*lx | 0x%0*lx | ",
2*(int)sizeof(long), (unsigned long)sp,
2*(int)sizeof(long), val);
- if (live)
+ if (live) {
+ fflush(stdout);
erts_printf("%.30T", val);
+ }
printf("\r\n");
}
@@ -68,7 +70,9 @@ void hipe_print_nstack(Process *p)
[0 ... 2*sizeof(long)+3] = '-'
};
- printf(" | NATIVE STACK |\r\n");
+ printf(" | %*s NATIVE STACK %*s |\r\n",
+ 2*(int)sizeof(long)-5, "",
+ 2*(int)sizeof(long)-4, "");
printf(" |%s|%s|\r\n", dashes, dashes);
printf(" | %*s | 0x%0*lx |\r\n",
2+2*(int)sizeof(long), "heap",
diff --git a/erts/emulator/hipe/hipe_x86_stack.c b/erts/emulator/hipe/hipe_x86_stack.c
index 31582b3a2e..615e07917a 100644
--- a/erts/emulator/hipe/hipe_x86_stack.c
+++ b/erts/emulator/hipe/hipe_x86_stack.c
@@ -43,8 +43,10 @@ static void print_slot(Eterm *sp, unsigned int live)
printf(" | 0x%0*lx | 0x%0*lx | ",
2*(int)sizeof(long), (unsigned long)sp,
2*(int)sizeof(long), val);
- if (live)
+ if (live) {
+ fflush(stdout);
erts_printf("%.30T", val);
+ }
printf("\r\n");
}
@@ -74,7 +76,9 @@ void hipe_print_nstack(Process *p)
sdesc0.livebits[0] = ~1;
sdesc = &sdesc0;
- printf(" | NATIVE STACK |\r\n");
+ printf(" | %*s NATIVE STACK %*s |\r\n",
+ 2*(int)sizeof(long)-5, "",
+ 2*(int)sizeof(long)-4, "");
printf(" |%s|%s|\r\n", dashes, dashes);
printf(" | %*s | 0x%0*lx |\r\n",
2+2*(int)sizeof(long), "heap",
diff --git a/erts/emulator/nifs/common/zlib_nif.c b/erts/emulator/nifs/common/zlib_nif.c
index fa29b4fb71..b709ed5a6f 100644
--- a/erts/emulator/nifs/common/zlib_nif.c
+++ b/erts/emulator/nifs/common/zlib_nif.c
@@ -717,7 +717,9 @@ static ERL_NIF_TERM zlib_deflateEnd(ErlNifEnv *env, int argc, const ERL_NIF_TERM
static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[]) {
zlib_data_t *d;
+
int res, level, strategy;
+ Bytef dummy_buffer;
if(argc != 3 || !get_zlib_data(env, argv[0], &d)
|| !enif_get_int(env, argv[1], &level)
@@ -729,12 +731,27 @@ static ERL_NIF_TERM zlib_deflateParams(ErlNifEnv *env, int argc, const ERL_NIF_T
return enif_raise_exception(env, am_not_initialized);
}
- /* deflateParams will flush everything currently in the stream, corrupting
- * the heap unless it's empty. We therefore pretend to have a full output
- * buffer, forcing a Z_BUF_ERROR if there's anything left to be flushed. */
- d->s.avail_out = 0;
+ /* This is a bit of a hack; deflateParams flushes with Z_BLOCK which won't
+ * stop at a byte boundary, so we can't split this operation up, and we
+ * can't allocate a buffer large enough to fit it in one go since we have
+ * to support zlib versions that lack deflatePending.
+ *
+ * We therefore flush everything prior to this call to ensure that we are
+ * stopped on a byte boundary and have no pending data. We then hand it a
+ * dummy buffer to detect when this assumption doesn't hold (Hopefully
+ * never), and to smooth over an issue with zlib 1.2.11 which always
+ * returns Z_BUF_ERROR when d->s.avail_out is 0, regardless of whether
+ * there's any pending data or not. */
+
+ d->s.next_out = &dummy_buffer;
+ d->s.avail_out = 1;
+
res = deflateParams(&d->s, level, strategy);
+ if(d->s.avail_out == 0) {
+ return zlib_return(env, Z_STREAM_ERROR);
+ }
+
return zlib_return(env, res);
}
@@ -929,7 +946,7 @@ static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar
return enif_raise_exception(env, am_not_initialized);
}
- if(d->eos_seen) {
+ if(d->eos_seen && enif_ioq_size(d->input_queue) > 0) {
int res;
switch(d->eos_behavior) {
@@ -943,11 +960,10 @@ static ERL_NIF_TERM zlib_inflate(ErlNifEnv *env, int argc, const ERL_NIF_TERM ar
}
d->eos_seen = 0;
+
break;
case EOS_BEHAVIOR_CUT:
zlib_reset_input(d);
-
- return enif_make_tuple2(env, am_finished, enif_make_list(env, 0));
}
}
diff --git a/erts/emulator/test/code_SUITE.erl b/erts/emulator/test/code_SUITE.erl
index 77321aa50f..dca600bc7b 100644
--- a/erts/emulator/test/code_SUITE.erl
+++ b/erts/emulator/test/code_SUITE.erl
@@ -25,6 +25,7 @@
multi_proc_purge/1, t_check_old_code/1,
external_fun/1,get_chunk/1,module_md5/1,
constant_pools/1,constant_refc_binaries/1,
+ fake_literals/1,
false_dependency/1,coverage/1,fun_confusion/1,
t_copy_literals/1, t_copy_literals_frags/1]).
@@ -38,7 +39,8 @@ all() ->
call_purged_fun_code_reload, call_purged_fun_code_there,
multi_proc_purge, t_check_old_code, external_fun, get_chunk,
module_md5,
- constant_pools, constant_refc_binaries, false_dependency,
+ constant_pools, constant_refc_binaries, fake_literals,
+ false_dependency,
coverage, fun_confusion, t_copy_literals, t_copy_literals_frags].
init_per_suite(Config) ->
@@ -554,6 +556,62 @@ wait_for_memory_deallocations() ->
wait_for_memory_deallocations()
end.
+fake_literals(_Config) ->
+ Mod = fake__literals__module,
+ try
+ do_fake_literals(Mod)
+ after
+ _ = code:purge(Mod),
+ _ = code:delete(Mod),
+ _ = code:purge(Mod),
+ _ = code:delete(Mod)
+ end,
+ ok.
+
+do_fake_literals(Mod) ->
+ Tid = ets:new(test, []),
+ ExtTerms = get_external_terms(),
+ Term0 = {self(),make_ref(),Tid,fun() -> ok end,ExtTerms},
+ Terms = [begin
+ make_literal_module(Mod, Term0),
+ Mod:term()
+ end || _ <- lists:seq(1, 10)],
+ verify_lit_terms(Terms, Term0),
+ true = ets:delete(Tid),
+ ok.
+
+make_literal_module(Mod, Term) ->
+ Exp = [{term,0}],
+ Attr = [],
+ Fs = [{function,term,0,2,
+ [{label,1},
+ {line,[]},
+ {func_info,{atom,Mod},{atom,term},0},
+ {label,2},
+ {move,{literal,Term},{x,0}},
+ return]}],
+ Asm = {Mod,Exp,Attr,Fs,2},
+ {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]),
+ code:load_binary(Mod, atom_to_list(Mod), Beam).
+
+verify_lit_terms([H|T], Term) ->
+ case H =:= Term of
+ true ->
+ verify_lit_terms(T, Term);
+ false ->
+ error({bad_term,H})
+ end;
+verify_lit_terms([], _) ->
+ ok.
+
+get_external_terms() ->
+ {ok,Node} = test_server:start_node(?FUNCTION_NAME, slave, []),
+ Ref = rpc:call(Node, erlang, make_ref, []),
+ Ports = rpc:call(Node, erlang, ports, []),
+ Pid = rpc:call(Node, erlang, self, []),
+ _ = test_server:stop_node(Node),
+ {Ref,hd(Ports),Pid}.
+
%% OTP-7559: c_p->cp could contain garbage and create a false dependency
%% to a module in a process. (Thanks to Richard Carlsson.)
false_dependency(Config) when is_list(Config) ->
diff --git a/erts/emulator/test/distribution_SUITE.erl b/erts/emulator/test/distribution_SUITE.erl
index 4a0b299e03..e731b68f2f 100644
--- a/erts/emulator/test/distribution_SUITE.erl
+++ b/erts/emulator/test/distribution_SUITE.erl
@@ -1363,81 +1363,59 @@ bad_dist_structure(Config) when is_list(Config) ->
start_monitor(Offender,P),
P ! one,
send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_monitor(Offender,P),
send_bad_structure(Offender, P,{?DOP_MONITOR_P_EXIT,'replace',P,normal,normal},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_link(Offender,P),
send_bad_structure(Offender, P,{?DOP_LINK},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_link(Offender,P),
send_bad_structure(Offender, P,{?DOP_UNLINK,'replace'},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_link(Offender,P),
send_bad_structure(Offender, P,{?DOP_UNLINK,'replace',make_ref()},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_link(Offender,P),
send_bad_structure(Offender, P,{?DOP_UNLINK,make_ref(),P},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_link(Offender,P),
send_bad_structure(Offender, P,{?DOP_UNLINK,normal,normal},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_monitor(Offender,P),
send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_monitor(Offender,P),
send_bad_structure(Offender, P,{?DOP_MONITOR_P,'replace',P,normal},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_monitor(Offender,P),
send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
start_monitor(Offender,P),
send_bad_structure(Offender, P,{?DOP_DEMONITOR_P,'replace',P,normal},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
+
send_bad_structure(Offender, P,{?DOP_EXIT,'replace',P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT,make_ref(),normal,normal},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT_TT,'replace',token,P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT_TT,make_ref(),token,normal,normal},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT2,'replace',P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT2,make_ref(),normal,normal},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT2_TT,'replace',token,P},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_EXIT2_TT,make_ref(),token,normal,normal},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace'},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace','atomic'},2),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_GROUP_LEADER,'replace',P},0),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name},2,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND_TT,'replace','',name,token},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace',''},2,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',P},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_REG_SEND,'replace','',name,{token}},2,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_SEND_TT,'',P},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_SEND_TT,'',name,token},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_SEND,''},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_SEND,'',name},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
send_bad_structure(Offender, P,{?DOP_SEND,'',P,{token}},0,{message}),
- pong = rpc:call(Victim, net_adm, ping, [Offender]),
P ! two,
P ! check_msgs,
receive
@@ -1683,13 +1661,16 @@ bad_dist_ext_size(Config) when is_list(Config) ->
start_node_monitors([Offender,Victim]),
Parent = self(),
- P = spawn_link(Victim,
+ P = spawn_opt(Victim,
fun () ->
Parent ! {self(), started},
receive check_msgs -> ok end, %% DID CRASH HERE
bad_dist_ext_check_msgs([one]),
Parent ! {self(), messages_checked}
- end),
+ end,
+ [link,
+ %% on_heap to force total_heap_size to inspect msg queue
+ {message_queue_data, on_heap}]),
receive {P, started} -> ok end,
P ! one,
@@ -1712,6 +1693,7 @@ bad_dist_ext_size(Config) when is_list(Config) ->
verify_still_up(Offender, Victim),
+ %% Let process_info(P, total_heap_size) find bad msg and disconnect
rpc:call(Victim, erlang, process_info, [P, total_heap_size]),
verify_down(Offender, connection_closed, Victim, killed),
@@ -1792,10 +1774,11 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf) ->
send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
Parent = self(),
Done = make_ref(),
- spawn(Offender,
+ spawn_link(Offender,
fun () ->
Node = node(Victim),
pong = net_adm:ping(Node),
+ erlang:monitor_node(Node, true),
DPrt = dport(Node),
Bad1 = case WhereToPutSelf of
0 ->
@@ -1809,7 +1792,16 @@ send_bad_structure(Offender,Victim,Bad,WhereToPutSelf,PayLoad) ->
[] -> [];
_Other -> [dmsg_ext(PayLoad)]
end,
+
+ receive {nodedown, Node} -> exit("premature nodedown")
+ after 10 -> ok
+ end,
+
port_command(DPrt, DData),
+
+ receive {nodedown, Node} -> ok
+ after 5000 -> exit("missing nodedown")
+ end,
Parent ! {DData,Done}
end),
receive
diff --git a/erts/emulator/test/process_SUITE.erl b/erts/emulator/test/process_SUITE.erl
index a9f20f9928..a8bcfac84d 100644
--- a/erts/emulator/test/process_SUITE.erl
+++ b/erts/emulator/test/process_SUITE.erl
@@ -2532,8 +2532,13 @@ system_task_on_suspended(Config) when is_list(Config) ->
end.
gc_request_when_gc_disabled(Config) when is_list(Config) ->
- Master = self(),
AIS = erts_debug:set_internal_state(available_internal_state, true),
+ gc_request_when_gc_disabled_do(ref),
+ gc_request_when_gc_disabled_do(immed),
+ erts_debug:set_internal_state(available_internal_state, AIS).
+
+gc_request_when_gc_disabled_do(ReqIdType) ->
+ Master = self(),
{P, M} = spawn_opt(fun () ->
true = erts_debug:set_internal_state(gc_state,
false),
@@ -2545,7 +2550,10 @@ gc_request_when_gc_disabled(Config) when is_list(Config) ->
receive after 100 -> ok end
end, [monitor, link]),
receive {P, gc_state, false} -> ok end,
- ReqId = make_ref(),
+ ReqId = case ReqIdType of
+ ref -> make_ref();
+ immed -> immed
+ end,
async = garbage_collect(P, [{async, ReqId}]),
receive
{garbage_collect, ReqId, Result} ->
@@ -2554,7 +2562,6 @@ gc_request_when_gc_disabled(Config) when is_list(Config) ->
ok
end,
receive {garbage_collect, ReqId, true} -> ok end,
- erts_debug:set_internal_state(available_internal_state, AIS),
receive {'DOWN', M, process, P, _Reason} -> ok end,
ok.
diff --git a/erts/etc/unix/run_erl.c b/erts/etc/unix/run_erl.c
index f05c729eeb..81a0036c99 100644
--- a/erts/etc/unix/run_erl.c
+++ b/erts/etc/unix/run_erl.c
@@ -1343,11 +1343,8 @@ static int sf_open(const char *path, int type, mode_t mode) {
return fd;
}
static int sf_close(int fd) {
- int res = 0;
-
- do { res = close(fd); } while(fd < 0 && errno == EINTR);
-
- return res;
+ /* "close() should not be retried after an EINTR" */
+ return close(fd);
}
/* Extract any control sequences that are ment only for run_erl
* and should not be forwarded to the pty.
diff --git a/erts/preloaded/ebin/zlib.beam b/erts/preloaded/ebin/zlib.beam
index f388bc723a..4ad5f37434 100644
--- a/erts/preloaded/ebin/zlib.beam
+++ b/erts/preloaded/ebin/zlib.beam
Binary files differ
diff --git a/erts/preloaded/src/zlib.erl b/erts/preloaded/src/zlib.erl
index 03c9ae38a1..a4ef42204d 100644
--- a/erts/preloaded/src/zlib.erl
+++ b/erts/preloaded/src/zlib.erl
@@ -188,14 +188,13 @@ deflateReset_nif(_Z) ->
deflateParams(Z, Level0, Strategy0) ->
Level = arg_level(Level0),
Strategy = arg_strategy(Strategy0),
+ Progress = deflate(Z, <<>>, sync),
case deflateParams_nif(Z, Level, Strategy) of
- buf_error ->
- %% We had data left in the pipe; flush everything and stash it away
- %% for the next deflate call before trying again.
- Output = deflate(Z, <<>>, full),
- save_progress(Z, deflate, Output),
- deflateParams_nif(Z, Level, Strategy);
- Any -> Any
+ ok ->
+ save_progress(Z, deflate, Progress),
+ ok;
+ Other ->
+ Other
end.
deflateParams_nif(_Z, _Level, _Strategy) ->
erlang:nif_error(undef).
diff --git a/erts/vsn.mk b/erts/vsn.mk
index a788b2e491..8cb891e384 100644
--- a/erts/vsn.mk
+++ b/erts/vsn.mk
@@ -18,7 +18,7 @@
# %CopyrightEnd%
#
-VSN = 9.1.3
+VSN = 9.1.5
# Port number 4365 in 4.2
# Port number 4366 in 4.3
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/Makefile.in b/lib/crypto/c_src/Makefile.in
index af7c209c75..31124ba477 100644
--- a/lib/crypto/c_src/Makefile.in
+++ b/lib/crypto/c_src/Makefile.in
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1999-2016. All Rights Reserved.
+# Copyright Ericsson AB 1999-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.
@@ -78,12 +78,16 @@ CRYPTO_STATIC_OBJS = $(OBJDIR)/crypto_static$(TYPEMARKER).o\
NIF_ARCHIVE = $(LIBDIR)/crypto$(TYPEMARKER).a
+TEST_ENGINE_OBJS = $(OBJDIR)/otp_test_engine$(TYPEMARKER).o
+
ifeq ($(findstring win32,$(TARGET)), win32)
NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).dll
CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).dll
+TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).dll
else
NIF_LIB = $(LIBDIR)/crypto$(TYPEMARKER).so
CALLBACK_LIB = $(LIBDIR)/crypto_callback$(TYPEMARKER).so
+TEST_ENGINE_LIB = $(LIBDIR)/otp_test_engine$(TYPEMARKER).so
endif
ifeq ($(HOST_OS),)
@@ -129,10 +133,22 @@ ALL_STATIC_CFLAGS = $(DED_STATIC_CFLAGS) $(INCLUDES)
_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR))
-debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB)
+debug opt valgrind: $(NIF_LIB) $(CALLBACK_LIB) $(TEST_ENGINE_LIB)
static_lib: $(NIF_ARCHIVE)
+$(OBJDIR)/otp_test_engine$(TYPEMARKER).o: otp_test_engine.c
+ $(V_at)$(INSTALL_DIR) $(OBJDIR)
+ $(V_CC) -c -o $@ $(ALL_CFLAGS) $<
+
+$(LIBDIR)/otp_test_engine$(TYPEMARKER).so: $(TEST_ENGINE_OBJS)
+ $(V_at)$(INSTALL_DIR) $(LIBDIR)
+ $(V_LD) $(LDFLAGS) -o $@ $^ $(LDLIBS) $(CRYPTO_LINK_LIB)
+
+$(LIBDIR)/otp_test_engine$(TYPEMARKER).dll: $(TEST_ENGINE_OBJS)
+ $(V_at)$(INSTALL_DIR) $(LIBDIR)
+ $(V_LD) $(LDFLAGS) -o $@ $(SSL_DED_LD_RUNTIME_LIBRARY_PATH) -L$(SSL_LIBDIR) $(TEST_ENGINE_OBJS) -l$(SSL_CRYPTO_LIBNAME) -l$(SSL_SSL_LIBNAME)
+
$(OBJDIR)/%$(TYPEMARKER).o: %.c
$(V_at)$(INSTALL_DIR) $(OBJDIR)
$(V_CC) -c -o $@ $(ALL_CFLAGS) $<
@@ -170,6 +186,7 @@ ifeq ($(findstring win32,$(TARGET)), win32)
rm -f $(LIBDIR)/crypto.debug.dll
rm -f $(LIBDIR)/crypto_callback.dll
rm -f $(LIBDIR)/crypto_callback.debug.dll
+ rm -f $(LIBDIR)/otp_test_engine.dll
else
rm -f $(LIBDIR)/crypto.so
rm -f $(LIBDIR)/crypto.debug.so
@@ -177,6 +194,7 @@ else
rm -f $(LIBDIR)/crypto_callback.so
rm -f $(LIBDIR)/crypto_callback.debug.so
rm -f $(LIBDIR)/crypto_callback.valgrind.so
+ rm -f $(LIBDIR)/otp_test_engine.so
endif
rm -f $(OBJDIR)/crypto.o
rm -f $(OBJDIR)/crypto_static.o
@@ -187,6 +205,7 @@ endif
rm -f $(OBJDIR)/crypto_callback.o
rm -f $(OBJDIR)/crypto_callback.debug.o
rm -f $(OBJDIR)/crypto_callback.valgrind.o
+ rm -f $(OBJDIR)/otp_test_engine.o
rm -f core *~
docs:
@@ -206,6 +225,8 @@ ifeq ($(DYNAMIC_CRYPTO_LIB),yes)
$(INSTALL_PROGRAM) $(CALLBACK_OBJS) "$(RELSYSDIR)/priv/obj"
$(INSTALL_PROGRAM) $(CALLBACK_LIB) "$(RELSYSDIR)/priv/lib"
endif
+ $(INSTALL_PROGRAM) $(TEST_ENGINE_OBJS) "$(RELSYSDIR)/priv/obj"
+ $(INSTALL_PROGRAM) $(TEST_ENGINE_LIB) "$(RELSYSDIR)/priv/lib"
release_docs_spec:
diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c
index c4e80e3153..6957d25774 100644
--- a/lib/crypto/c_src/crypto.c
+++ b/lib/crypto/c_src/crypto.c
@@ -1,4 +1,4 @@
-/*
+/*
* %CopyrightBegin%
*
* Copyright Ericsson AB 2010-2017. All Rights Reserved.
@@ -19,8 +19,8 @@
*/
/*
- * Purpose: Dynamically loadable NIF library for cryptography.
- * Based on OpenSSL.
+ * Purpose: Dynamically loadable NIF library for cryptography.
+ * Based on OpenSSL.
*/
#ifdef __WIN32__
@@ -60,6 +60,8 @@
#include <openssl/rand.h>
#include <openssl/evp.h>
#include <openssl/hmac.h>
+#include <openssl/engine.h>
+#include <openssl/err.h>
/* Helper macro to construct a OPENSSL_VERSION_NUMBER.
* See openssl/opensslv.h
@@ -79,9 +81,9 @@
*
* Therefor works tests like this as intendend:
* OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(1,0,0)
- * (The test is for example "2.4.2" >= "1.0.0" although the test
+ * (The test is for example "2.4.2" >= "1.0.0" although the test
* with the cloned OpenSSL test would be "1.0.1" >= "1.0.0")
- *
+ *
* But tests like this gives wrong result:
* OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0)
* (The test is false since "2.4.2" < "1.1.0". It should have been
@@ -119,6 +121,10 @@
#include <openssl/modes.h>
#endif
+#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION(0,9,8,'h')
+#define HAS_ENGINE_SUPPORT
+#endif
+
#include "crypto_callback.h"
#if OPENSSL_VERSION_NUMBER >= PACKED_OPENSSL_VERSION_PLAIN(0,9,8) \
@@ -240,7 +246,7 @@
/* This shall correspond to the similar macro in crypto.erl */
/* Current value is: erlang:system_info(context_reductions) * 10 */
-#define MAX_BYTES_TO_NIF 20000
+#define MAX_BYTES_TO_NIF 20000
#define CONSUME_REDS(NifEnv, Ibin) \
do { \
@@ -342,6 +348,10 @@ static INLINE void RSA_get0_crt_params(const RSA *r, const BIGNUM **dmp1, const
static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key);
static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g);
+static INLINE void DSA_get0_pqg(const DSA *dsa,
+ const BIGNUM **p, const BIGNUM **q, const BIGNUM **g);
+static INLINE void DSA_get0_key(const DSA *dsa,
+ const BIGNUM **pub_key, const BIGNUM **priv_key);
static INLINE int DSA_set0_key(DSA *d, BIGNUM *pub_key, BIGNUM *priv_key)
{
@@ -358,6 +368,23 @@ static INLINE int DSA_set0_pqg(DSA *d, BIGNUM *p, BIGNUM *q, BIGNUM *g)
return 1;
}
+static INLINE void
+DSA_get0_pqg(const DSA *dsa, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g)
+{
+ *p = dsa->p;
+ *q = dsa->q;
+ *g = dsa->g;
+}
+
+static INLINE void
+DSA_get0_key(const DSA *dsa, const BIGNUM **pub_key, const BIGNUM **priv_key)
+{
+ if (pub_key) *pub_key = dsa->pub_key;
+ if (priv_key) *priv_key = dsa->priv_key;
+}
+
+
+
static INLINE int DH_set0_key(DH *dh, BIGNUM *pub_key, BIGNUM *priv_key);
static INLINE int DH_set0_pqg(DH *dh, BIGNUM *p, BIGNUM *q, BIGNUM *g);
static INLINE int DH_set_length(DH *dh, long length);
@@ -387,6 +414,8 @@ static INLINE int DH_set_length(DH *dh, long length)
return 1;
}
+
+
static INLINE void
DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g)
{
@@ -398,8 +427,8 @@ DH_get0_pqg(const DH *dh, const BIGNUM **p, const BIGNUM **q, const BIGNUM **g)
static INLINE void
DH_get0_key(const DH *dh, const BIGNUM **pub_key, const BIGNUM **priv_key)
{
- *pub_key = dh->pub_key;
- *priv_key = dh->priv_key;
+ if (pub_key) *pub_key = dh->pub_key;
+ if (priv_key) *priv_key = dh->priv_key;
}
#else /* End of compatibility definitions. */
@@ -448,6 +477,7 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E
static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM srp_value_B_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM srp_user_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM srp_host_secret_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
@@ -466,6 +496,22 @@ static ERL_NIF_TERM aes_gcm_decrypt_NO_EVP(ErlNifEnv* env, int argc, const ERL_N
static ERL_NIF_TERM chacha20_poly1305_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
static ERL_NIF_TERM chacha20_poly1305_decrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i);
+static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]);
+
/* helpers */
static void init_algorithms_types(ErlNifEnv*);
static void init_digest_types(ErlNifEnv* env);
@@ -477,6 +523,10 @@ static int term2point(ErlNifEnv* env, ERL_NIF_TERM term,
#endif
static ERL_NIF_TERM bin_from_bn(ErlNifEnv* env, const BIGNUM *bn);
+#ifdef HAS_ENGINE_SUPPORT
+static int zero_terminate(ErlNifBinary bin, char **buf);
+#endif
+
static int library_refc = 0; /* number of users of this dynamic library */
static ErlNifFunc nif_funcs[] = {
@@ -516,6 +566,7 @@ static ErlNifFunc nif_funcs[] = {
{"dh_check", 1, dh_check},
{"dh_generate_key_nif", 4, dh_generate_key_nif},
{"dh_compute_key_nif", 3, dh_compute_key_nif},
+ {"privkey_to_pubkey_nif", 2, privkey_to_pubkey_nif},
{"srp_value_B_nif", 5, srp_value_B_nif},
{"srp_user_secret_nif", 7, srp_user_secret_nif},
{"srp_host_secret_nif", 5, srp_host_secret_nif},
@@ -529,12 +580,27 @@ static ErlNifFunc nif_funcs[] = {
{"aes_gcm_decrypt", 5, aes_gcm_decrypt},
{"chacha20_poly1305_encrypt", 4, chacha20_poly1305_encrypt},
- {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt}
+ {"chacha20_poly1305_decrypt", 5, chacha20_poly1305_decrypt},
+
+ {"engine_by_id_nif", 1, engine_by_id_nif},
+ {"engine_init_nif", 1, engine_init_nif},
+ {"engine_finish_nif", 1, engine_finish_nif},
+ {"engine_free_nif", 1, engine_free_nif},
+ {"engine_load_dynamic_nif", 0, engine_load_dynamic_nif},
+ {"engine_ctrl_cmd_strings_nif", 3, engine_ctrl_cmd_strings_nif},
+ {"engine_register_nif", 2, engine_register_nif},
+ {"engine_unregister_nif", 2, engine_unregister_nif},
+ {"engine_add_nif", 1, engine_add_nif},
+ {"engine_remove_nif", 1, engine_remove_nif},
+ {"engine_get_first_nif", 0, engine_get_first_nif},
+ {"engine_get_next_nif", 1, engine_get_next_nif},
+ {"engine_get_id_nif", 1, engine_get_id_nif},
+ {"engine_get_all_methods_nif", 0, engine_get_all_methods_nif}
+
};
ERL_NIF_INIT(crypto,nif_funcs,load,NULL,upgrade,unload)
-
#define MD5_CTX_LEN (sizeof(MD5_CTX))
#define MD4_CTX_LEN (sizeof(MD4_CTX))
#define RIPEMD160_CTX_LEN (sizeof(RIPEMD160_CTX))
@@ -603,7 +669,33 @@ static ERL_NIF_TERM atom_sha512;
static ERL_NIF_TERM atom_md5;
static ERL_NIF_TERM atom_ripemd160;
-
+#ifdef HAS_ENGINE_SUPPORT
+static ERL_NIF_TERM atom_bad_engine_method;
+static ERL_NIF_TERM atom_bad_engine_id;
+static ERL_NIF_TERM atom_ctrl_cmd_failed;
+static ERL_NIF_TERM atom_engine_init_failed;
+static ERL_NIF_TERM atom_register_engine_failed;
+static ERL_NIF_TERM atom_add_engine_failed;
+static ERL_NIF_TERM atom_remove_engine_failed;
+static ERL_NIF_TERM atom_engine_method_not_supported;
+
+static ERL_NIF_TERM atom_engine_method_rsa;
+static ERL_NIF_TERM atom_engine_method_dsa;
+static ERL_NIF_TERM atom_engine_method_dh;
+static ERL_NIF_TERM atom_engine_method_rand;
+static ERL_NIF_TERM atom_engine_method_ecdh;
+static ERL_NIF_TERM atom_engine_method_ecdsa;
+static ERL_NIF_TERM atom_engine_method_ciphers;
+static ERL_NIF_TERM atom_engine_method_digests;
+static ERL_NIF_TERM atom_engine_method_store;
+static ERL_NIF_TERM atom_engine_method_pkey_meths;
+static ERL_NIF_TERM atom_engine_method_pkey_asn1_meths;
+static ERL_NIF_TERM atom_engine_method_ec;
+
+static ERL_NIF_TERM atom_engine;
+static ERL_NIF_TERM atom_key_id;
+static ERL_NIF_TERM atom_password;
+#endif
static ErlNifResourceType* hmac_context_rtype;
struct hmac_context
@@ -728,11 +820,13 @@ static struct cipher_type_t cipher_types[] =
static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len);
+
/*
#define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n")
#define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1)
#define PRINTF_ERR2(FMT, A1, A2) enif_fprintf(stderr, FMT "\n", A1, A2)
*/
+
#define PRINTF_ERR0(FMT)
#define PRINTF_ERR1(FMT,A1)
#define PRINTF_ERR2(FMT,A1,A2)
@@ -758,6 +852,23 @@ static void evp_cipher_ctx_dtor(ErlNifEnv* env, struct evp_cipher_ctx* ctx) {
}
#endif
+// Engine
+#ifdef HAS_ENGINE_SUPPORT
+static ErlNifResourceType* engine_ctx_rtype;
+struct engine_ctx {
+ ENGINE *engine;
+ char *id;
+};
+static void engine_ctx_dtor(ErlNifEnv* env, struct engine_ctx* ctx) {
+ PRINTF_ERR0("engine_ctx_dtor");
+ if(ctx->id) {
+ PRINTF_ERR1(" non empty ctx->id=%s", ctx->id);
+ enif_free(ctx->id);
+ } else
+ PRINTF_ERR0(" empty ctx->id=NULL");
+}
+#endif
+
static int verify_lib_version(void)
{
const unsigned long libv = SSLeay();
@@ -793,7 +904,7 @@ static char crypto_callback_name[] = "crypto_callback";
static int change_basename(ErlNifBinary* bin, char* buf, int bufsz, const char* newfile)
{
int i;
-
+
for (i = bin->size; i > 0; i--) {
if (bin->data[i-1] == '/')
break;
@@ -869,12 +980,23 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
return __LINE__;
}
#endif
+#ifdef HAS_ENGINE_SUPPORT
+ engine_ctx_rtype = enif_open_resource_type(env, NULL, "ENGINE_CTX",
+ (ErlNifResourceDtor*) engine_ctx_dtor,
+ ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER,
+ NULL);
+ if (!engine_ctx_rtype) {
+ PRINTF_ERR0("CRYPTO: Could not open resource type 'ENGINE_CTX'");
+ return __LINE__;
+ }
+
if (library_refc > 0) {
/* Repeated loading of this library (module upgrade).
* Atoms and callbacks are already set, we are done.
*/
return 0;
}
+#endif
atom_true = enif_make_atom(env,"true");
atom_false = enif_make_atom(env,"false");
@@ -952,6 +1074,33 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
atom_md5 = enif_make_atom(env,"md5");
atom_ripemd160 = enif_make_atom(env,"ripemd160");
+#ifdef HAS_ENGINE_SUPPORT
+ atom_bad_engine_method = enif_make_atom(env,"bad_engine_method");
+ atom_bad_engine_id = enif_make_atom(env,"bad_engine_id");
+ atom_ctrl_cmd_failed = enif_make_atom(env,"ctrl_cmd_failed");
+ atom_engine_init_failed = enif_make_atom(env,"engine_init_failed");
+ atom_engine_method_not_supported = enif_make_atom(env,"engine_method_not_supported");
+ atom_add_engine_failed = enif_make_atom(env,"add_engine_failed");
+ atom_remove_engine_failed = enif_make_atom(env,"remove_engine_failed");
+
+ atom_engine_method_rsa = enif_make_atom(env,"engine_method_rsa");
+ atom_engine_method_dsa = enif_make_atom(env,"engine_method_dsa");
+ atom_engine_method_dh = enif_make_atom(env,"engine_method_dh");
+ atom_engine_method_rand = enif_make_atom(env,"engine_method_rand");
+ atom_engine_method_ecdh = enif_make_atom(env,"engine_method_ecdh");
+ atom_engine_method_ecdsa = enif_make_atom(env,"engine_method_ecdsa");
+ atom_engine_method_store = enif_make_atom(env,"engine_method_store");
+ atom_engine_method_ciphers = enif_make_atom(env,"engine_method_ciphers");
+ atom_engine_method_digests = enif_make_atom(env,"engine_method_digests");
+ atom_engine_method_pkey_meths = enif_make_atom(env,"engine_method_pkey_meths");
+ atom_engine_method_pkey_asn1_meths = enif_make_atom(env,"engine_method_pkey_asn1_meths");
+ atom_engine_method_ec = enif_make_atom(env,"engine_method_ec");
+
+ atom_engine = enif_make_atom(env,"engine");
+ atom_key_id = enif_make_atom(env,"key_id");
+ atom_password = enif_make_atom(env,"password");
+#endif
+
init_digest_types(env);
init_cipher_types(env);
init_algorithms_types(env);
@@ -973,24 +1122,24 @@ static int initialize(ErlNifEnv* env, ERL_NIF_TERM load_info)
#else /* !HAVE_DYNAMIC_CRYPTO_LIB */
funcp = &get_crypto_callbacks;
#endif
-
+
#ifdef OPENSSL_THREADS
enif_system_info(&sys_info, sizeof(sys_info));
if (sys_info.scheduler_threads > 1) {
- nlocks = CRYPTO_num_locks();
+ nlocks = CRYPTO_num_locks();
}
/* else no need for locks */
#endif
-
+
ccb = (*funcp)(nlocks);
-
+
if (!ccb || ccb->sizeof_me != sizeof(*ccb)) {
PRINTF_ERR0("Invalid 'crypto_callbacks'");
return __LINE__;
}
-
+
CRYPTO_set_mem_functions(ccb->crypto_alloc, ccb->crypto_realloc, ccb->crypto_free);
-
+
#ifdef OPENSSL_THREADS
if (nlocks > 0) {
CRYPTO_set_locking_callback(ccb->locking_function);
@@ -1186,11 +1335,11 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
* Version string is still from library though.
*/
- memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz);
+ memcpy(enif_make_new_binary(env, name_sz, &name_term), libname, name_sz);
memcpy(enif_make_new_binary(env, ver_sz, &ver_term), ver, ver_sz);
return enif_make_list1(env, enif_make_tuple3(env, name_term,
- enif_make_int(env, ver_num),
+ enif_make_int(env, ver_num),
ver_term));
}
@@ -1225,6 +1374,8 @@ static ERL_NIF_TERM enable_fips_mode(ErlNifEnv* env, int argc, const ERL_NIF_TER
}
}
+
+#if defined(HAVE_EC)
static ERL_NIF_TERM make_badarg_maybe(ErlNifEnv* env)
{
ERL_NIF_TERM reason;
@@ -1233,6 +1384,7 @@ static ERL_NIF_TERM make_badarg_maybe(ErlNifEnv* env)
else
return enif_make_badarg(env);
}
+#endif
static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Type, Data) */
@@ -1668,7 +1820,7 @@ static ERL_NIF_TERM hmac_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
{/* (Context, Data) */
ErlNifBinary data;
struct hmac_context* obj;
-
+
if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj)
|| !enif_inspect_iolist_as_binary(env, argv[1], &data)) {
return enif_make_badarg(env);
@@ -1704,13 +1856,13 @@ static ERL_NIF_TERM hmac_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM
enif_mutex_unlock(obj->mtx);
return enif_make_badarg(env);
}
-
+
HMAC_Final(obj->ctx, mac_buf, &mac_len);
HMAC_CTX_free(obj->ctx);
obj->alive = 0;
enif_mutex_unlock(obj->mtx);
- if (argc == 2 && req_len < mac_len) {
+ if (argc == 2 && req_len < mac_len) {
/* Only truncate to req_len bytes if asked. */
mac_len = req_len;
}
@@ -2021,7 +2173,7 @@ static ERL_NIF_TERM aes_ctr_stream_init(ErlNifEnv* env, int argc, const ERL_NIF_
}
static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* ({Key, IVec, ECount, Num}, Data) */
+{/* ({Key, IVec, ECount, Num}, Data) */
ErlNifBinary key_bin, ivec_bin, text_bin, ecount_bin;
AES_KEY aes_key;
unsigned int num;
@@ -2042,14 +2194,14 @@ static ERL_NIF_TERM aes_ctr_stream_encrypt(ErlNifEnv* env, int argc, const ERL_N
return enif_make_badarg(env);
}
- ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term);
+ ivec2_buf = enif_make_new_binary(env, ivec_bin.size, &ivec2_term);
ecount2_buf = enif_make_new_binary(env, ecount_bin.size, &ecount2_term);
-
+
memcpy(ivec2_buf, ivec_bin.data, 16);
memcpy(ecount2_buf, ecount_bin.data, ecount_bin.size);
AES_ctr128_encrypt((unsigned char *) text_bin.data,
- enif_make_new_binary(env, text_bin.size, &cipher_term),
+ enif_make_new_binary(env, text_bin.size, &cipher_term),
text_bin.size, &aes_key, ivec2_buf, ecount2_buf, &num);
num2_term = enif_make_uint(env, num);
@@ -2352,7 +2504,7 @@ out_err:
}
static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
-{/* (Bytes) */
+{/* (Bytes) */
unsigned bytes;
unsigned char* data;
ERL_NIF_TERM ret;
@@ -2446,7 +2598,7 @@ static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER
bn_to = BN_new();
BN_sub(bn_to, bn_rand, bn_from);
- BN_pseudo_rand_range(bn_rand, bn_to);
+ BN_pseudo_rand_range(bn_rand, bn_to);
BN_add(bn_rand, bn_rand, bn_from);
dlen = BN_num_bytes(bn_rand);
data = enif_make_new_binary(env, dlen+4, &ret);
@@ -2464,7 +2616,7 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
BIGNUM *bn_base=NULL, *bn_exponent=NULL, *bn_modulo=NULL, *bn_result;
BN_CTX *bn_ctx;
unsigned char* ptr;
- unsigned dlen;
+ unsigned dlen;
unsigned bin_hdr; /* return type: 0=plain binary, 4: mpint */
unsigned extra_byte;
ERL_NIF_TERM ret;
@@ -2485,7 +2637,7 @@ static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
dlen = BN_num_bytes(bn_result);
extra_byte = bin_hdr && BN_is_bit_set(bn_result, dlen*8-1);
ptr = enif_make_new_binary(env, bin_hdr+extra_byte+dlen, &ret);
- if (bin_hdr) {
+ if (bin_hdr) {
put_int32(ptr, extra_byte+dlen);
ptr[4] = 0; /* extra zeroed byte to ensure a positive mpint */
ptr += bin_hdr + extra_byte;
@@ -2545,6 +2697,7 @@ static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len)
return NULL;
}
+
static ERL_NIF_TERM do_exor(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (Data1, Data2) */
ErlNifBinary d1, d2;
@@ -2578,7 +2731,7 @@ static ERL_NIF_TERM rc4_set_key(ErlNifEnv* env, int argc, const ERL_NIF_TERM arg
return enif_make_badarg(env);
}
RC4_set_key((RC4_KEY*)enif_make_new_binary(env, sizeof(RC4_KEY), &ret),
- key.size, key.data);
+ key.size, key.data);
return ret;
#else
return enif_raise_exception(env, atom_notsup);
@@ -2871,7 +3024,7 @@ static ERL_NIF_TERM dh_generate_parameters_nif(ErlNifEnv* env, int argc, const E
BN_bn2bin(dh_g, g_ptr);
ERL_VALGRIND_MAKE_MEM_DEFINED(p_ptr, p_len);
ERL_VALGRIND_MAKE_MEM_DEFINED(g_ptr, g_len);
- return enif_make_list2(env, ret_p, ret_g);
+ return enif_make_list2(env, ret_p, ret_g);
}
static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
@@ -2881,9 +3034,9 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
ERL_NIF_TERM ret, head, tail;
BIGNUM *dh_p, *dh_g;
- if (!enif_get_list_cell(env, argv[0], &head, &tail)
+ if (!enif_get_list_cell(env, argv[0], &head, &tail)
|| !get_bn_from_bin(env, head, &dh_p)
- || !enif_get_list_cell(env, tail, &head, &tail)
+ || !enif_get_list_cell(env, tail, &head, &tail)
|| !get_bn_from_bin(env, head, &dh_g)
|| !enif_is_empty_list(env,tail)) {
@@ -2900,12 +3053,12 @@ static ERL_NIF_TERM dh_check(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]
else if (i & DH_NOT_SUITABLE_GENERATOR) ret = atom_not_suitable_generator;
else ret = enif_make_tuple2(env, atom_unknown, enif_make_uint(env, i));
}
- else { /* Check Failed */
+ else { /* Check Failed */
ret = enif_make_tuple2(env, atom_error, atom_check_failed);
}
DH_free(dh_params);
return ret;
-}
+}
static ERL_NIF_TERM dh_generate_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
{/* (PrivKey|undefined, DHParams=[P,G], Mpint, Len|0) */
@@ -3007,7 +3160,7 @@ static ERL_NIF_TERM dh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF_T
i = DH_compute_key(ret_bin.data, other_pub_key, dh_params);
if (i > 0) {
if (i != ret_bin.size) {
- enif_realloc_binary(&ret_bin, i);
+ enif_realloc_binary(&ret_bin, i);
}
ret = enif_make_binary(env, &ret_bin);
}
@@ -3803,9 +3956,69 @@ static int get_pkey_sign_options(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF
}
+#ifdef HAS_ENGINE_SUPPORT
+static int get_engine_and_key_id(ErlNifEnv *env, ERL_NIF_TERM key, char ** id, ENGINE **e)
+{
+ ERL_NIF_TERM engine_res, key_id_term;
+ struct engine_ctx *ctx;
+ ErlNifBinary key_id_bin;
+
+ if (!enif_get_map_value(env, key, atom_engine, &engine_res) ||
+ !enif_get_resource(env, engine_res, engine_ctx_rtype, (void**)&ctx) ||
+ !enif_get_map_value(env, key, atom_key_id, &key_id_term) ||
+ !enif_inspect_binary(env, key_id_term, &key_id_bin)) {
+ return 0;
+ }
+ else {
+ *e = ctx->engine;
+ return zero_terminate(key_id_bin, id);
+ }
+}
+
+
+static char *get_key_password(ErlNifEnv *env, ERL_NIF_TERM key) {
+ ERL_NIF_TERM tmp_term;
+ ErlNifBinary pwd_bin;
+ char *pwd;
+ if (enif_get_map_value(env, key, atom_password, &tmp_term) &&
+ enif_inspect_binary(env, tmp_term, &pwd_bin) &&
+ zero_terminate(pwd_bin, &pwd)
+ ) return pwd;
+
+ return NULL;
+}
+
+static int zero_terminate(ErlNifBinary bin, char **buf) {
+ *buf = enif_alloc(bin.size+1);
+ if (!*buf)
+ return 0;
+ memcpy(*buf, bin.data, bin.size);
+ *(*buf+bin.size) = 0;
+ return 1;
+}
+#endif
+
static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key, EVP_PKEY **pkey)
{
- if (algorithm == atom_rsa) {
+ if (enif_is_map(env, key)) {
+#ifdef HAS_ENGINE_SUPPORT
+ /* Use key stored in engine */
+ ENGINE *e;
+ char *id;
+ char *password;
+
+ if (!get_engine_and_key_id(env, key, &id, &e))
+ return PKEY_BADARG;
+ password = get_key_password(env, key);
+ *pkey = ENGINE_load_private_key(e, id, NULL, password);
+ if (!*pkey)
+ return PKEY_BADARG;
+ enif_free(id);
+#else
+ return PKEY_BADARG;
+#endif
+ }
+ else if (algorithm == atom_rsa) {
RSA *rsa = RSA_new();
if (!get_rsa_private_key(env, key, rsa)) {
@@ -3866,7 +4079,24 @@ static int get_pkey_private_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_
static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_TERM key,
EVP_PKEY **pkey)
{
- if (algorithm == atom_rsa) {
+ if (enif_is_map(env, key)) {
+#ifdef HAS_ENGINE_SUPPORT
+ /* Use key stored in engine */
+ ENGINE *e;
+ char *id;
+ char *password;
+
+ if (!get_engine_and_key_id(env, key, &id, &e))
+ return PKEY_BADARG;
+ password = get_key_password(env, key);
+ *pkey = ENGINE_load_public_key(e, id, NULL, password);
+ if (!pkey)
+ return PKEY_BADARG;
+ enif_free(id);
+#else
+ return PKEY_BADARG;
+#endif
+ } else if (algorithm == atom_rsa) {
RSA *rsa = RSA_new();
if (!get_rsa_public_key(env, key, rsa)) {
@@ -3924,7 +4154,7 @@ static int get_pkey_public_key(ErlNifEnv *env, ERL_NIF_TERM algorithm, ERL_NIF_T
}
static ERL_NIF_TERM pkey_sign_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM argv[])
-{/* (Algorithm, Type, Data|{digest,Digest}, Key, Options) */
+{/* (Algorithm, Type, Data|{digest,Digest}, Key|#{}, Options) */
int i;
const EVP_MD *md = NULL;
unsigned char md_value[EVP_MAX_MD_SIZE];
@@ -3944,6 +4174,13 @@ enif_get_atom(env,argv[0],buf,1024,ERL_NIF_LATIN1); printf("algo=%s ",buf);
enif_get_atom(env,argv[1],buf,1024,ERL_NIF_LATIN1); printf("hash=%s ",buf);
printf("\r\n");
*/
+
+#ifndef HAS_ENGINE_SUPPORT
+ if (enif_is_map(env, argv[3])) {
+ return atom_notsup;
+ }
+#endif
+
i = get_pkey_sign_digest(env, argv[0], argv[1], argv[2], md_value, &md, &tbs, &tbslen);
if (i != PKEY_OK) {
if (i == PKEY_NOTSUP)
@@ -3965,10 +4202,9 @@ printf("\r\n");
}
#ifdef HAS_EVP_PKEY_CTX
-/* printf("EVP interface\r\n");
- */
ctx = EVP_PKEY_CTX_new(pkey, NULL);
if (!ctx) goto badarg;
+
if (EVP_PKEY_sign_init(ctx) <= 0) goto badarg;
if (md != NULL && EVP_PKEY_CTX_set_signature_md(ctx, md) <= 0) goto badarg;
@@ -4070,6 +4306,12 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
unsigned char *tbs; /* data to be signed */
size_t tbslen;
+#ifndef HAS_ENGINE_SUPPORT
+ if (enif_is_map(env, argv[4])) {
+ return atom_notsup;
+ }
+#endif
+
if (!enif_inspect_binary(env, argv[3], &sig_bin)) {
return enif_make_badarg(env);
}
@@ -4095,7 +4337,7 @@ static ERL_NIF_TERM pkey_verify_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
}
#ifdef HAS_EVP_PKEY_CTX
-/* printf("EVP interface\r\n");
+/* printf("EVP interface\r\n");
*/
ctx = EVP_PKEY_CTX_new(pkey, NULL);
if (!ctx) goto badarg;
@@ -4280,7 +4522,13 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
int algo_init = 0;
/* char algo[1024]; */
-
+
+#ifndef HAS_ENGINE_SUPPORT
+ if (enif_is_map(env, argv[2])) {
+ return atom_notsup;
+ }
+#endif
+
if (!enif_inspect_binary(env, argv[1], &in_bin)) {
return enif_make_badarg(env);
}
@@ -4409,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 */
@@ -4542,6 +4789,80 @@ static ERL_NIF_TERM pkey_crypt_nif(ErlNifEnv *env, int argc, const ERL_NIF_TERM
/*--------------------------------*/
+static ERL_NIF_TERM privkey_to_pubkey_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{ /* (Algorithm, PrivKey | KeyMap) */
+ 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);
+ }
+
+ if (alg == atom_rsa) {
+ const BIGNUM *n = NULL, *e = NULL, *d = NULL;
+ RSA *rsa = EVP_PKEY_get1_RSA(pkey);
+ if (rsa) {
+ RSA_get0_key(rsa, &n, &e, &d);
+ result[0] = bin_from_bn(env, e); // Exponent E
+ result[1] = bin_from_bn(env, n); // Modulus N = p*q
+ EVP_PKEY_free(pkey);
+ return enif_make_list_from_array(env, result, 2);
+ }
+
+ } else if (argv[0] == atom_dss) {
+ const BIGNUM *p = NULL, *q = NULL, *g = NULL, *pub_key = NULL;
+ DSA *dsa = EVP_PKEY_get1_DSA(pkey);
+ if (dsa) {
+ DSA_get0_pqg(dsa, &p, &q, &g);
+ DSA_get0_key(dsa, &pub_key, NULL);
+ result[0] = bin_from_bn(env, p);
+ result[1] = bin_from_bn(env, q);
+ result[2] = bin_from_bn(env, g);
+ result[3] = bin_from_bn(env, pub_key);
+ EVP_PKEY_free(pkey);
+ return enif_make_list_from_array(env, result, 4);
+ }
+
+ } else if (argv[0] == atom_ecdsa) {
+#if defined(HAVE_EC)
+ /* not yet implemented
+ EC_KEY *ec = EVP_PKEY_get1_EC_KEY(pkey);
+ if (ec) {
+ / * Example of result:
+ {
+ Curve = {Field, Prime, Point, Order, CoFactor} =
+ {
+ Field = {prime_field,<<255,...,255>>},
+ Prime = {<<255,...,252>>,
+ <<90,...,75>>,
+ <<196,...,144>>
+ },
+ Point = <<4,...,245>>,
+ Order = <<255,...,81>>,
+ CoFactor = <<1>>
+ },
+ Key = <<151,...,62>>
+ }
+ or
+ {
+ Curve =
+ {characteristic_two_field,
+ M,
+ Basis = {tpbasis, _}
+ | {ppbasis, k1, k2, k3}
+ },
+ Key
+ }
+ * /
+ EVP_PKEY_free(pkey);
+ return enif_make_list_from_array(env, ..., ...);
+ */
+#endif
+ }
+
+ if (pkey) EVP_PKEY_free(pkey);
+ return enif_make_badarg(env);
+}
/*================================================================*/
@@ -4554,3 +4875,600 @@ static ERL_NIF_TERM rand_seed_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a
RAND_seed(seed_bin.data,seed_bin.size);
return atom_ok;
}
+
+/*================================================================*/
+/* Engine */
+/*================================================================*/
+static ERL_NIF_TERM engine_by_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (EngineId) */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM ret;
+ ErlNifBinary engine_id_bin;
+ char *engine_id;
+ ENGINE *engine;
+ struct engine_ctx *ctx;
+
+ // Get Engine Id
+ if(!enif_inspect_binary(env, argv[0], &engine_id_bin)) {
+ PRINTF_ERR0("engine_by_id_nif Leaved: badarg");
+ return enif_make_badarg(env);
+ } else {
+ 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);
+ }
+
+ ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ ctx->engine = engine;
+ ctx->id = engine_id;
+
+ ret = enif_make_resource(env, ctx);
+ enif_release_resource(ctx);
+
+ return enif_make_tuple2(env, atom_ok, ret);
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM ret = atom_ok;
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_init_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+ if (!ENGINE_init(ctx->engine)) {
+ //ERR_print_errors_fp(stderr);
+ PRINTF_ERR0("engine_init_nif Leaved: {error, engine_init_failed}");
+ return enif_make_tuple2(env, atom_error, atom_engine_init_failed);
+ }
+
+ return ret;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_free_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_free_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ ENGINE_free(ctx->engine);
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_finish_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_finish_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ ENGINE_finish(ctx->engine);
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_load_dynamic_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* () */
+#ifdef HAS_ENGINE_SUPPORT
+ ENGINE_load_dynamic();
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_ctrl_cmd_strings_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine, Commands) */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM ret = atom_ok;
+ unsigned int cmds_len = 0;
+ char **cmds = NULL;
+ struct engine_ctx *ctx;
+ int i, optional = 0;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ PRINTF_ERR1("Engine Id: %s\r\n", ENGINE_get_id(ctx->engine));
+
+ // Get Command List
+ if(!enif_get_list_length(env, argv[1], &cmds_len)) {
+ PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Bad Command List");
+ return enif_make_badarg(env);
+ } else {
+ cmds_len *= 2; // Key-Value list from erlang
+ cmds = enif_alloc((cmds_len+1)*sizeof(char*));
+ if(get_engine_load_cmd_list(env, argv[1], cmds, 0)) {
+ PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Couldn't read Command List");
+ ret = enif_make_badarg(env);
+ goto error;
+ }
+ }
+
+ if(!enif_get_int(env, argv[2], &optional)) {
+ PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: Parameter optional not an integer");
+ return enif_make_badarg(env);
+ }
+
+ for(i = 0; i < cmds_len; i+=2) {
+ PRINTF_ERR2("Cmd: %s:%s\r\n",
+ cmds[i] ? cmds[i] : "(NULL)",
+ cmds[i+1] ? cmds[i+1] : "(NULL)");
+ if(!ENGINE_ctrl_cmd_string(ctx->engine, cmds[i], cmds[i+1], optional)) {
+ PRINTF_ERR2("Command failed: %s:%s\r\n",
+ cmds[i] ? cmds[i] : "(NULL)",
+ cmds[i+1] ? cmds[i+1] : "(NULL)");
+ //ENGINE_free(ctx->engine);
+ ret = enif_make_tuple2(env, atom_error, atom_ctrl_cmd_failed);
+ PRINTF_ERR0("engine_ctrl_cmd_strings_nif Leaved: {error, ctrl_cmd_failed}");
+ goto error;
+ }
+ }
+
+ error:
+ for(i = 0; cmds != NULL && cmds[i] != NULL; i++)
+ enif_free(cmds[i]);
+ enif_free(cmds);
+ return ret;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_add_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_add_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ if (!ENGINE_add(ctx->engine)) {
+ PRINTF_ERR0("engine_add_nif Leaved: {error, add_engine_failed}");
+ return enif_make_tuple2(env, atom_error, atom_add_engine_failed);
+ }
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_remove_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_remove_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ if (!ENGINE_remove(ctx->engine)) {
+ PRINTF_ERR0("engine_remove_nif Leaved: {error, remove_engine_failed}");
+ return enif_make_tuple2(env, atom_error, atom_remove_engine_failed);
+ }
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_register_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine, EngineMethod) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+ unsigned int method;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_register_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+ // Get Method
+ if (!enif_get_uint(env, argv[1], &method)) {
+ PRINTF_ERR0("engine_register_nif Leaved: Parameter Method not an uint");
+ return enif_make_badarg(env);
+ }
+
+ switch(method)
+ {
+#ifdef ENGINE_METHOD_RSA
+ case ENGINE_METHOD_RSA:
+ if (!ENGINE_register_RSA(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DSA
+ case ENGINE_METHOD_DSA:
+ if (!ENGINE_register_DSA(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DH
+ case ENGINE_METHOD_DH:
+ if (!ENGINE_register_DH(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_RAND
+ case ENGINE_METHOD_RAND:
+ if (!ENGINE_register_RAND(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_ECDH
+ case ENGINE_METHOD_ECDH:
+ if (!ENGINE_register_ECDH(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_ECDSA
+ case ENGINE_METHOD_ECDSA:
+ if (!ENGINE_register_ECDSA(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_STORE
+ case ENGINE_METHOD_STORE:
+ if (!ENGINE_register_STORE(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_CIPHERS
+ case ENGINE_METHOD_CIPHERS:
+ if (!ENGINE_register_ciphers(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DIGESTS
+ case ENGINE_METHOD_DIGESTS:
+ if (!ENGINE_register_digests(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_PKEY_METHS
+ case ENGINE_METHOD_PKEY_METHS:
+ if (!ENGINE_register_pkey_meths(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_PKEY_ASN1_METHS
+ case ENGINE_METHOD_PKEY_ASN1_METHS:
+ if (!ENGINE_register_pkey_asn1_meths(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+#ifdef ENGINE_METHOD_EC
+ case ENGINE_METHOD_EC:
+ if (!ENGINE_register_EC(ctx->engine))
+ return enif_make_tuple2(env, atom_error, atom_register_engine_failed);
+ break;
+#endif
+ default:
+ return enif_make_tuple2(env, atom_error, atom_engine_method_not_supported);
+ break;
+ }
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_unregister_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine, EngineMethod) */
+#ifdef HAS_ENGINE_SUPPORT
+ struct engine_ctx *ctx;
+ unsigned int method;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_unregister_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+ // Get Method
+ if (!enif_get_uint(env, argv[1], &method)) {
+ PRINTF_ERR0("engine_unregister_nif Leaved: Parameter Method not an uint");
+ return enif_make_badarg(env);
+ }
+
+ switch(method)
+ {
+#ifdef ENGINE_METHOD_RSA
+ case ENGINE_METHOD_RSA:
+ ENGINE_unregister_RSA(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DSA
+ case ENGINE_METHOD_DSA:
+ ENGINE_unregister_DSA(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DH
+ case ENGINE_METHOD_DH:
+ ENGINE_unregister_DH(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_RAND
+ case ENGINE_METHOD_RAND:
+ ENGINE_unregister_RAND(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_ECDH
+ case ENGINE_METHOD_ECDH:
+ ENGINE_unregister_ECDH(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_ECDSA
+ case ENGINE_METHOD_ECDSA:
+ ENGINE_unregister_ECDSA(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_STORE
+ case ENGINE_METHOD_STORE:
+ ENGINE_unregister_STORE(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_CIPHERS
+ case ENGINE_METHOD_CIPHERS:
+ ENGINE_unregister_ciphers(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_DIGESTS
+ case ENGINE_METHOD_DIGESTS:
+ ENGINE_unregister_digests(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_PKEY_METHS
+ case ENGINE_METHOD_PKEY_METHS:
+ ENGINE_unregister_pkey_meths(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_PKEY_ASN1_METHS
+ case ENGINE_METHOD_PKEY_ASN1_METHS:
+ ENGINE_unregister_pkey_asn1_meths(ctx->engine);
+ break;
+#endif
+#ifdef ENGINE_METHOD_EC
+ case ENGINE_METHOD_EC:
+ ENGINE_unregister_EC(ctx->engine);
+ break;
+#endif
+ default:
+ break;
+ }
+ return atom_ok;
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_get_first_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM ret;
+ ENGINE *engine;
+ ErlNifBinary engine_bin;
+ struct engine_ctx *ctx;
+
+ engine = ENGINE_get_first();
+ if(!engine) {
+ enif_alloc_binary(0, &engine_bin);
+ engine_bin.size = 0;
+ return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin));
+ }
+
+ ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ ctx->engine = engine;
+ ctx->id = NULL;
+
+ ret = enif_make_resource(env, ctx);
+ enif_release_resource(ctx);
+
+ return enif_make_tuple2(env, atom_ok, ret);
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_get_next_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM ret;
+ ENGINE *engine;
+ ErlNifBinary engine_bin;
+ struct engine_ctx *ctx, *next_ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_get_next_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+ engine = ENGINE_get_next(ctx->engine);
+ if (!engine) {
+ enif_alloc_binary(0, &engine_bin);
+ engine_bin.size = 0;
+ return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_bin));
+ }
+
+ next_ctx = enif_alloc_resource(engine_ctx_rtype, sizeof(struct engine_ctx));
+ next_ctx->engine = engine;
+ next_ctx->id = NULL;
+
+ ret = enif_make_resource(env, next_ctx);
+ enif_release_resource(next_ctx);
+
+ return enif_make_tuple2(env, atom_ok, ret);
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_get_id_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* (Engine) */
+#ifdef HAS_ENGINE_SUPPORT
+ ErlNifBinary engine_id_bin;
+ const char *engine_id;
+ int size;
+ struct engine_ctx *ctx;
+
+ // Get Engine
+ if (!enif_get_resource(env, argv[0], engine_ctx_rtype, (void**)&ctx)) {
+ PRINTF_ERR0("engine_get_id_nif Leaved: Parameter not an engine resource object");
+ return enif_make_badarg(env);
+ }
+
+ engine_id = ENGINE_get_id(ctx->engine);
+ if (!engine_id) {
+ enif_alloc_binary(0, &engine_id_bin);
+ engine_id_bin.size = 0;
+ return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin));
+ }
+
+ size = strlen(engine_id);
+ enif_alloc_binary(size, &engine_id_bin);
+ engine_id_bin.size = size;
+ memcpy(engine_id_bin.data, engine_id, size);
+
+ return enif_make_tuple2(env, atom_ok, enif_make_binary(env, &engine_id_bin));
+#else
+ return atom_notsup;
+#endif
+}
+
+static int get_engine_load_cmd_list(ErlNifEnv* env, const ERL_NIF_TERM term, char **cmds, int i)
+{
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM head, tail;
+ const ERL_NIF_TERM *tmp_tuple;
+ ErlNifBinary tmpbin;
+ int arity;
+ char* tmpstr;
+
+ if(!enif_is_empty_list(env, term)) {
+ if(!enif_get_list_cell(env, term, &head, &tail)) {
+ cmds[i] = NULL;
+ return -1;
+ } else {
+ if(!enif_get_tuple(env, head, &arity, &tmp_tuple) || arity != 2) {
+ cmds[i] = NULL;
+ return -1;
+ } else {
+ if(!enif_inspect_binary(env, tmp_tuple[0], &tmpbin)) {
+ cmds[i] = NULL;
+ return -1;
+ } else {
+ 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)) {
+ cmds[i] = NULL;
+ return -1;
+ } else {
+ if(tmpbin.size == 0)
+ cmds[i++] = NULL;
+ else {
+ tmpstr = enif_alloc(tmpbin.size+1);
+ (void) memcpy(tmpstr, tmpbin.data, tmpbin.size);
+ tmpstr[tmpbin.size] = '\0';
+ cmds[i++] = tmpstr;
+ }
+ }
+ return get_engine_load_cmd_list(env, tail, cmds, i);
+ }
+ }
+ } else {
+ cmds[i] = NULL;
+ return 0;
+ }
+#else
+ return atom_notsup;
+#endif
+}
+
+static ERL_NIF_TERM engine_get_all_methods_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[])
+{/* () */
+#ifdef HAS_ENGINE_SUPPORT
+ ERL_NIF_TERM method_array[12];
+ int i = 0;
+
+#ifdef ENGINE_METHOD_RSA
+ method_array[i++] = atom_engine_method_rsa;
+#endif
+#ifdef ENGINE_METHOD_DSA
+ method_array[i++] = atom_engine_method_dsa;
+#endif
+#ifdef ENGINE_METHOD_DH
+ method_array[i++] = atom_engine_method_dh;
+#endif
+#ifdef ENGINE_METHOD_RAND
+ method_array[i++] = atom_engine_method_rand;
+#endif
+#ifdef ENGINE_METHOD_ECDH
+ method_array[i++] = atom_engine_method_ecdh;
+#endif
+#ifdef ENGINE_METHOD_ECDSA
+ method_array[i++] = atom_engine_method_ecdsa;
+#endif
+#ifdef ENGINE_METHOD_STORE
+ method_array[i++] = atom_engine_method_store;
+#endif
+#ifdef ENGINE_METHOD_CIPHERS
+ method_array[i++] = atom_engine_method_ciphers;
+#endif
+#ifdef ENGINE_METHOD_DIGESTS
+ method_array[i++] = atom_engine_method_digests;
+#endif
+#ifdef ENGINE_METHOD_PKEY_METHS
+ method_array[i++] = atom_engine_method_pkey_meths;
+#endif
+#ifdef ENGINE_METHOD_PKEY_ASN1_METHS
+ method_array[i++] = atom_engine_method_pkey_asn1_meths;
+#endif
+#ifdef ENGINE_METHOD_EC
+ method_array[i++] = atom_engine_method_ec;
+#endif
+
+ return enif_make_list_from_array(env, method_array, i);
+#else
+ return atom_notsup;
+#endif
+}
diff --git a/lib/crypto/c_src/otp_test_engine.c b/lib/crypto/c_src/otp_test_engine.c
new file mode 100644
index 0000000000..5c6122c06a
--- /dev/null
+++ b/lib/crypto/c_src/otp_test_engine.c
@@ -0,0 +1,264 @@
+/*
+ * %CopyrightBegin%
+ *
+ * Copyright Ericsson AB 2017-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%
+ */
+
+#ifdef _WIN32
+#define OPENSSL_OPT_WINDLL
+#endif
+#include <stdio.h>
+#include <string.h>
+
+#include <openssl/engine.h>
+#include <openssl/md5.h>
+#include <openssl/rsa.h>
+#include <openssl/pem.h>
+
+#define PACKED_OPENSSL_VERSION(MAJ, MIN, FIX, P) \
+ ((((((((MAJ << 8) | MIN) << 8 ) | FIX) << 8) | (P-'a'+1)) << 4) | 0xf)
+
+#define PACKED_OPENSSL_VERSION_PLAIN(MAJ, MIN, FIX) \
+ PACKED_OPENSSL_VERSION(MAJ,MIN,FIX,('a'-1))
+
+#if OPENSSL_VERSION_NUMBER < PACKED_OPENSSL_VERSION_PLAIN(1,1,0) \
+ || defined(LIBRESSL_VERSION_NUMBER)
+#define OLD
+#endif
+
+static const char *test_engine_id = "MD5";
+static const char *test_engine_name = "MD5 test engine";
+
+/* The callback that does the job of fetching keys on demand by the Engine */
+EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *callback_data);
+
+
+static int test_init(ENGINE *e) {
+ printf("OTP Test Engine Initializatzion!\r\n");
+
+ /* Load all digest and cipher algorithms. Needed for password protected private keys */
+ OpenSSL_add_all_algorithms();
+
+ return 111;
+}
+
+static void add_test_data(unsigned char *md, unsigned int len)
+{
+ unsigned int i;
+
+ for (i=0; i<len; i++) {
+ md[i] = (unsigned char)(i & 0xff);
+ }
+}
+
+/* MD5 part */
+#undef data
+#ifdef OLD
+#define data(ctx) ((MD5_CTX *)ctx->md_data)
+#endif
+
+static int test_engine_md5_init(EVP_MD_CTX *ctx) {
+ fprintf(stderr, "MD5 initialized\r\n");
+#ifdef OLD
+ return MD5_Init(data(ctx));
+#else
+ return 1;
+#endif
+}
+
+static int test_engine_md5_update(EVP_MD_CTX *ctx,const void *data, size_t count)
+{
+ fprintf(stderr, "MD5 update\r\n");
+#ifdef OLD
+ return MD5_Update(data(ctx), data, (size_t)count);
+#else
+ return 1;
+#endif
+}
+
+static int test_engine_md5_final(EVP_MD_CTX *ctx,unsigned char *md) {
+#ifdef OLD
+ int ret;
+
+ fprintf(stderr, "MD5 final size of EVP_MD: %lu\r\n", sizeof(EVP_MD));
+ ret = MD5_Final(md, data(ctx));
+
+ if (ret > 0) {
+ add_test_data(md, MD5_DIGEST_LENGTH);
+ }
+ return ret;
+#else
+ fprintf(stderr, "MD5 final\r\n");
+ add_test_data(md, MD5_DIGEST_LENGTH);
+ return 1;
+#endif
+}
+
+#ifdef OLD
+static EVP_MD test_engine_md5_method= {
+ NID_md5, /* The name ID for MD5 */
+ NID_undef, /* IGNORED: MD5 with private key encryption NID */
+ MD5_DIGEST_LENGTH, /* Size of MD5 result, in bytes */
+ 0, /* Flags */
+ test_engine_md5_init, /* digest init */
+ test_engine_md5_update, /* digest update */
+ test_engine_md5_final, /* digest final */
+ NULL, /* digest copy */
+ NULL, /* digest cleanup */
+ EVP_PKEY_NULL_method, /* IGNORED: pkey methods */
+ MD5_CBLOCK, /* Internal blocksize, see rfc1321/md5.h */
+ sizeof(EVP_MD *) + sizeof(MD5_CTX),
+ NULL, /* IGNORED: control function */
+};
+#endif
+
+static int test_digest_ids[] = {NID_md5};
+
+static int test_engine_digest_selector(ENGINE *e, const EVP_MD **digest,
+ const int **nids, int nid) {
+ int ok = 1;
+ if (!digest) {
+ *nids = test_digest_ids;
+ fprintf(stderr, "Digest is empty! Nid:%d\r\n", nid);
+ return 2;
+ }
+ fprintf(stderr, "Digest no %d requested\r\n",nid);
+ if (nid == NID_md5) {
+#ifdef OLD
+ *digest = &test_engine_md5_method;
+#else
+ EVP_MD *md = EVP_MD_meth_new(NID_md5, NID_undef);
+ if (!md ||
+ !EVP_MD_meth_set_result_size(md, MD5_DIGEST_LENGTH) ||
+ !EVP_MD_meth_set_flags(md, 0) ||
+ !EVP_MD_meth_set_init(md, test_engine_md5_init) ||
+ !EVP_MD_meth_set_update(md, test_engine_md5_update) ||
+ !EVP_MD_meth_set_final(md, test_engine_md5_final) ||
+ !EVP_MD_meth_set_copy(md, NULL) ||
+ !EVP_MD_meth_set_cleanup(md, NULL) ||
+ !EVP_MD_meth_set_input_blocksize(md, MD5_CBLOCK) ||
+ !EVP_MD_meth_set_app_datasize(md, sizeof(EVP_MD *) + sizeof(MD5_CTX)) ||
+ !EVP_MD_meth_set_ctrl(md, NULL))
+ {
+ ok = 0;
+ *digest = NULL;
+ } else
+ {
+ *digest = md;
+ }
+#endif
+ }
+ else {
+ ok = 0;
+ *digest = NULL;
+ }
+
+ return ok;
+}
+
+
+static int bind_helper(ENGINE * e, const char *id)
+{
+ if (!ENGINE_set_id(e, test_engine_id) ||
+ !ENGINE_set_name(e, test_engine_name) ||
+ !ENGINE_set_init_function(e, test_init) ||
+ !ENGINE_set_digests(e, &test_engine_digest_selector) ||
+ /* For testing of key storage in an Engine: */
+ !ENGINE_set_load_privkey_function(e, &test_key_load) ||
+ !ENGINE_set_load_pubkey_function(e, &test_key_load)
+ )
+ return 0;
+
+ return 1;
+}
+
+IMPLEMENT_DYNAMIC_CHECK_FN();
+
+IMPLEMENT_DYNAMIC_BIND_FN(bind_helper);
+
+/********************************************************
+ *
+ * Engine storage simulation
+ *
+ */
+int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password);
+
+EVP_PKEY* test_key_load(ENGINE *er, const char *id, UI_METHOD *ui_method, void *callback_data)
+{
+ EVP_PKEY *pkey = NULL;
+ FILE *f = fopen(id, "r");
+
+ if (!f) {
+ fprintf(stderr, "%s:%d fopen(%s) failed\r\n", __FILE__,__LINE__,id);
+ return NULL;
+ }
+
+ /* First try to read as a private key. If that fails, try to read as a public key: */
+ pkey = PEM_read_PrivateKey(f, NULL, pem_passwd_cb_fun, callback_data);
+ if (!pkey) {
+ /* ERR_print_errors_fp (stderr); */
+ fclose(f);
+ f = fopen(id, "r");
+ pkey = PEM_read_PUBKEY(f, NULL, NULL, NULL);
+ }
+ fclose(f);
+
+ if (!pkey) {
+ fprintf(stderr, "%s:%d Key read from file %s failed.\r\n", __FILE__,__LINE__,id);
+ if (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 */
+ char c;
+ while (!feof(f)) {
+ switch (c=fgetc(f)) {
+ case '\n':
+ 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;
+}
+
+
+int pem_passwd_cb_fun(char *buf, int size, int rwflag, void *password)
+{
+ int i;
+
+ fprintf(stderr, "In pem_passwd_cb_fun\r\n");
+ if (!password)
+ return 0;
+
+ i = strlen(password);
+ if (i < size) {
+ /* whole pwd (incl terminating 0) fits */
+ fprintf(stderr, "Got FULL pwd %d(%d) chars\r\n", i, size);
+ memcpy(buf, (char*)password, i+1);
+ return i+1;
+ } else {
+ fprintf(stderr, "Got TO LONG pwd %d(%d) chars\r\n", i, size);
+ /* meaningless with a truncated password */
+ return 0;
+ }
+}
diff --git a/lib/crypto/doc/src/Makefile b/lib/crypto/doc/src/Makefile
index 9c503b8fe0..aa987d2b39 100644
--- a/lib/crypto/doc/src/Makefile
+++ b/lib/crypto/doc/src/Makefile
@@ -9,11 +9,11 @@
# 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.
-#
+#
# The Initial Developer of the Original Code is Ericsson Utvecklings AB.
# Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
# AB. All Rights Reserved.''
-#
+#
# $Id$
#
include $(ERL_TOP)/make/target.mk
@@ -38,13 +38,13 @@ XML_APPLICATION_FILES = ref_man.xml
XML_REF3_FILES = crypto.xml
XML_REF6_FILES = crypto_app.xml
-XML_PART_FILES = release_notes.xml usersguide.xml
-XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml
+XML_PART_FILES = usersguide.xml
+XML_CHAPTER_FILES = notes.xml licenses.xml fips.xml engine_load.xml engine_keys.xml
BOOK_FILES = book.xml
XML_FILES = $(BOOK_FILES) $(XML_APPLICATION_FILES) $(XML_REF3_FILES) $(XML_REF6_FILES) \
- $(XML_PART_FILES) $(XML_CHAPTER_FILES)
+ $(XML_PART_FILES) $(XML_CHAPTER_FILES)
GIF_FILES =
@@ -63,9 +63,9 @@ HTML_REF_MAN_FILE = $(HTMLDIR)/index.html
TOP_PDF_FILE = $(PDFDIR)/$(APPLICATION)-$(VSN).pdf
# ----------------------------------------------------
-# FLAGS
+# FLAGS
# ----------------------------------------------------
-XML_FLAGS +=
+XML_FLAGS +=
# ----------------------------------------------------
# Targets
@@ -73,7 +73,6 @@ XML_FLAGS +=
$(HTMLDIR)/%.gif: %.gif
$(INSTALL_DATA) $< $@
-
docs: pdf html man
$(TOP_PDF_FILE): $(XML_FILES)
@@ -86,7 +85,7 @@ man: $(MAN3_FILES) $(MAN6_FILES)
gifs: $(GIF_FILES:%=$(HTMLDIR)/%)
-debug opt valgrind:
+debug opt valgrind:
clean clean_docs clean_tex:
rm -rf $(HTMLDIR)/*
@@ -97,7 +96,7 @@ clean clean_docs clean_tex:
# ----------------------------------------------------
# Release Target
-# ----------------------------------------------------
+# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
release_docs_spec: docs
@@ -114,4 +113,3 @@ release_docs_spec: docs
release_spec:
-
diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml
index 5b2c46a004..464799b320 100644
--- a/lib/crypto/doc/src/crypto.xml
+++ b/lib/crypto/doc/src/crypto.xml
@@ -11,7 +11,7 @@
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
@@ -19,7 +19,6 @@
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>crypto</title>
@@ -68,11 +67,11 @@
<section>
<title>DATA TYPES </title>
-
- <code>key_value() = integer() | binary() </code>
+
+ <code>key_value() = integer() | binary() </code>
<p>Always <c>binary()</c> when used as return value</p>
- <code>rsa_public() = [key_value()] = [E, N] </code>
+ <code>rsa_public() = [key_value()] = [E, N] </code>
<p> Where E is the public exponent and N is public modulus. </p>
<code>rsa_private() = [key_value()] = [E, N, D] | [E, N, D, P1, P2, E1, E2, C] </code>
@@ -85,7 +84,7 @@
<code>dss_public() = [key_value()] = [P, Q, G, Y] </code>
<p>Where P, Q and G are the dss parameters and Y is the public key.</p>
- <code>dss_private() = [key_value()] = [P, Q, G, X] </code>
+ <code>dss_private() = [key_value()] = [P, Q, G, X] </code>
<p>Where P, Q and G are the dss parameters and X is the private key.</p>
<code>srp_public() = key_value() </code>
@@ -109,15 +108,16 @@
<code>ecdh_private() = key_value() </code>
- <code>ecdh_params() = ec_named_curve() | ec_explicit_curve()</code>
+ <code>ecdh_params() = ec_named_curve() | ec_explicit_curve()</code>
<code>ec_explicit_curve() =
- {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(), CoFactor :: none | integer()} </code>
+ {ec_field(), Prime :: key_value(), Point :: key_value(), Order :: integer(),
+ CoFactor :: none | integer()} </code>
<code>ec_field() = {prime_field, Prime :: integer()} |
{characteristic_two_field, M :: integer(), Basis :: ec_basis()}</code>
- <code>ec_basis() = {tpbasis, K :: non_neg_integer()} |
+ <code>ec_basis() = {tpbasis, K :: non_neg_integer()} |
{ppbasis, K1 :: non_neg_integer(), K2 :: non_neg_integer(), K3 :: non_neg_integer()} |
onbasis</code>
@@ -136,16 +136,34 @@
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_ref() = term()</code>
+ <p>The result of a call to <seealso marker="#engine_load-3">engine_load/3</seealso>.
+ </p>
+
+ <code>key_id() = string() | binary()</code>
+ <p>Identifies the key to be used. The format depends on the loaded engine. It is passed to
+ the <c>ENGINE_load_(private|public)_key</c> functions in libcrypto.
+ </p>
+
+ <code>password() = string() | binary()</code>
+ <p>The key's password
+ </p>
+
<code>stream_cipher() = rc4 | aes_ctr </code>
- <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
+ <code>block_cipher() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ige256 | blowfish_cbc |
blowfish_cfb64 | des_cbc | des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc </code>
- <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code>
+ <code>aead_cipher() = aes_gcm | chacha20_poly1305 </code>
- <code>stream_key() = aes_key() | rc4_key() </code>
+ <code>stream_key() = aes_key() | rc4_key() </code>
- <code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code>
+ <code>block_key() = aes_key() | blowfish_key() | des_key()| des3_key() </code>
<code>aes_key() = iodata() </code> <p>Key length is 128, 192 or 256 bits</p>
@@ -174,13 +192,17 @@
Note that both md4 and md5 are recommended only for compatibility with existing applications.
</p>
<code> cipher_algorithms() = aes_cbc | aes_cfb8 | aes_cfb128 | aes_ctr | aes_gcm |
- aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc | des_cfb |
- des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code>
- <code> mac_algorithms() = hmac | cmac</code>
- <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
+ aes_ige256 | blowfish_cbc | blowfish_cfb64 | chacha20_poly1305 | des_cbc |
+ des_cfb | des3_cbc | des3_cfb | des_ede3 | rc2_cbc | rc4 </code>
+ <code> mac_algorithms() = hmac | cmac</code>
+ <code> public_key_algorithms() = rsa |dss | ecdsa | dh | ecdh | ec_gf2m</code>
<p>Note that ec_gf2m is not strictly a public key algorithm, but a restriction on what curves are supported
with ecdsa and ecdh.
</p>
+ <code>engine_method_type() = engine_method_rsa | engine_method_dsa | engine_method_dh |
+ engine_method_rand | engine_method_ecdh | engine_method_ecdsa |
+ engine_method_ciphers | engine_method_digests | engine_method_store |
+ engine_method_pkey_meths | engine_method_pkey_asn1_meths</code>
</section>
@@ -261,13 +283,13 @@
is not supported by the underlying OpenSSL implementation.</p>
</desc>
</func>
-
+
<func>
<name>bytes_to_integer(Bin) -> Integer </name>
<fsummary>Convert binary representation, of an integer, to an Erlang integer.</fsummary>
<type>
<v>Bin = binary() - as returned by crypto functions</v>
-
+
<v>Integer = integer() </v>
</type>
<desc>
@@ -439,7 +461,7 @@
</type>
<desc>
<p>Updates the HMAC represented by <c>Context</c> using the given <c>Data</c>. <c>Context</c>
- must have been generated using an HMAC init function (such as
+ must have been generated using an HMAC init function (such as
<seealso marker="#hmac_init-2">hmac_init</seealso>). <c>Data</c> can be any length. <c>NewContext</c>
must be passed into the next call to <c>hmac_update</c>
or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and
@@ -580,7 +602,7 @@
<type>
<v>Type = rsa</v>
<v>CipherText = binary()</v>
- <v>PrivateKey = rsa_private()</v>
+ <v>PrivateKey = rsa_private() | engine_key_ref()</v>
<v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v>
<v>PlainText = binary()</v>
</type>
@@ -594,7 +616,22 @@
</p>
</desc>
</func>
-
+
+ <func>
+ <name>privkey_to_pubkey(Type, EnginePrivateKeyRef) -> PublicKey</name>
+ <fsummary>Fetches a public key from an Engine stored private key.</fsummary>
+ <type>
+ <v>Type = rsa | dss</v>
+ <v>EnginePrivateKeyRef = engine_key_ref()</v>
+ <v>PublicKey = rsa_public() | dss_public()</v>
+ </type>
+ <desc>
+ <p>Fetches the corresponding public key from a private key stored in an Engine.
+ The key must be of the type indicated by the Type parameter.
+ </p>
+ </desc>
+ </func>
+
<func>
<name>private_encrypt(Type, PlainText, PrivateKey, Padding) -> CipherText</name>
<fsummary>Encrypts PlainText using the private Key.</fsummary>
@@ -605,7 +642,7 @@
than <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is
used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c> is
used, where N is public modulus of the RSA key.</d>
- <v>PrivateKey = rsa_private()</v>
+ <v>PrivateKey = rsa_private() | engine_key_ref()</v>
<v>Padding = rsa_pkcs1_padding | rsa_no_padding</v>
<v>CipherText = binary()</v>
</type>
@@ -624,7 +661,7 @@
<type>
<v>Type = rsa</v>
<v>CipherText = binary()</v>
- <v>PublicKey = rsa_public() </v>
+ <v>PublicKey = rsa_public() | engine_key_ref()</v>
<v>Padding = rsa_pkcs1_padding | rsa_no_padding</v>
<v>PlainText = binary()</v>
</type>
@@ -649,7 +686,7 @@
than <c>byte_size(N)-11</c> if <c>rsa_pkcs1_padding</c> is
used, and <c>byte_size(N)</c> if <c>rsa_no_padding</c> is
used, where N is public modulus of the RSA key.</d>
- <v>PublicKey = rsa_public()</v>
+ <v>PublicKey = rsa_public() | engine_key_ref()</v>
<v>Padding = rsa_pkcs1_padding | rsa_pkcs1_oaep_padding | rsa_no_padding</v>
<v>CipherText = binary()</v>
</type>
@@ -702,7 +739,7 @@
signed or it is the hashed value of "cleartext" i.e. the
digest (plaintext).</d>
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
- <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()]</v>
+ <v>Key = rsa_private() | dss_private() | [ecdh_private(),ecdh_params()] | engine_key_ref()</v>
<v>Options = sign_options()</v>
</type>
<desc>
@@ -893,7 +930,7 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
or it is the hashed value of "cleartext" i.e. the digest (plaintext).</d>
<v>DigestType = rsa_digest_type() | dss_digest_type() | ecdsa_digest_type()</v>
<v>Signature = binary()</v>
- <v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()]</v>
+ <v>Key = rsa_public() | dss_public() | [ecdh_public(),ecdh_params()] | engine_key_ref()</v>
<v>Options = sign_options()</v>
</type>
<desc>
@@ -905,6 +942,175 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
</desc>
</func>
+ <!-- Engine functions -->
+ <func>
+ <name>engine_get_all_methods() -> Result</name>
+ <fsummary>Return list of all possible engine methods</fsummary>
+ <type>
+ <v>Result = [EngineMethod::atom()]</v>
+ </type>
+ <desc>
+ <p>
+ Returns a list of all possible engine methods.
+ </p>
+ <p>
+ May throw exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ <p>
+ See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ in the User's Guide.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_load(EngineId, PreCmds, PostCmds) -> Result</name>
+ <fsummary>Dynamical load an encryption engine</fsummary>
+ <type>
+ <v>EngineId = unicode:chardata()</v>
+ <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v>
+ <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v>
+ </type>
+ <desc>
+ <p>
+ Loads the OpenSSL engine given by <c>EngineId</c> if it is available and then returns ok and
+ an engine handle. This function is the same as calling <c>engine_load/4</c> with
+ <c>EngineMethods</c> set to a list of all the possible methods. An error tuple is
+ returned if the engine can't be loaded.
+ </p>
+ <p>
+ The function throws a badarg if the parameters are in wrong format.
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ <p>
+ See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ in the User's Guide.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_load(EngineId, PreCmds, PostCmds, EngineMethods) -> Result</name>
+ <fsummary>Dynamical load an encryption engine</fsummary>
+ <type>
+ <v>EngineId = unicode:chardata()</v>
+ <v>PreCmds, PostCmds = [{unicode:chardata(), unicode:chardata()}]</v>
+ <v>EngineMethods = [engine_method_type()]</v>
+ <v>Result = {ok, Engine::term()} | {error, Reason::term()}</v>
+ </type>
+ <desc>
+ <p>
+ Loads the OpenSSL engine given by <c>EngineId</c> if it is available and then returns ok and
+ an engine handle. An error tuple is returned if the engine can't be loaded.
+ </p>
+ <p>
+ The function throws a badarg if the parameters are in wrong format.
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ <p>
+ See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ in the User's Guide.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_unload(Engine) -> Result</name>
+ <fsummary>Dynamical load an encryption engine</fsummary>
+ <type>
+ <v>Engine = term()</v>
+ <v>Result = ok | {error, Reason::term()}</v>
+ </type>
+ <desc>
+ <p>
+ Unloads the OpenSSL engine given by <c>EngineId</c>.
+ An error tuple is returned if the engine can't be unloaded.
+ </p>
+ <p>
+ The function throws a badarg if the parameter is in wrong format.
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ <p>
+ See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ in the User's Guide.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_list() -> Result</name>
+ <fsummary>List the known engine ids</fsummary>
+ <type>
+ <v>Result = [EngineId::unicode:chardata()]</v>
+ </type>
+ <desc>
+ <p>List the id's of all engines in OpenSSL's internal list.</p>
+ <p>
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ <p>
+ See also the chapter <seealso marker="crypto:engine_load#engine_load">Engine Load</seealso>
+ in the User's Guide.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg) -> Result</name>
+ <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary>
+ <type>
+ <v>Engine = term()</v>
+ <v>CmdName = unicode:chardata()</v>
+ <v>CmdArg = unicode:chardata()</v>
+ <v>Result = ok | {error, Reason::term()}</v>
+ </type>
+ <desc>
+ <p>
+ Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>.
+ This function is the same as calling <c>engine_ctrl_cmd_string/4</c> with
+ <c>Optional</c> set to <c>false</c>.
+ </p>
+ <p>
+ The function throws a badarg if the parameters are in wrong format.
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ </desc>
+ </func>
+
+ <func>
+ <name>engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) -> Result</name>
+ <fsummary>Sends ctrl commands to an OpenSSL engine</fsummary>
+ <type>
+ <v>Engine = term()</v>
+ <v>CmdName = unicode:chardata()</v>
+ <v>CmdArg = unicode:chardata()</v>
+ <v>Optional = boolean()</v>
+ <v>Result = ok | {error, Reason::term()}</v>
+ </type>
+ <desc>
+ <p>
+ Sends ctrl commands to the OpenSSL engine given by <c>Engine</c>.
+ <c>Optional</c> is a boolean argument that can relax the semantics of the function.
+ If set to <c>true</c> it will only return failure if the ENGINE supported the given
+ command name but failed while executing it, if the ENGINE doesn't support the command
+ name it will simply return success without doing anything. In this case we assume
+ the user is only supplying commands specific to the given ENGINE so we set this to
+ <c>false</c>.
+ </p>
+ <p>
+ The function throws a badarg if the parameters are in wrong format.
+ It may also throw the exception notsup in case there is
+ no engine support in the underlying OpenSSL implementation.
+ </p>
+ </desc>
+ </func>
+
</funcs>
<!-- Maybe put this in the users guide -->
@@ -979,4 +1185,3 @@ _FloatValue = rand:uniform(). % [0.0; 1.0[</pre>
<!-- </p> -->
<!-- </section> -->
</erlref>
-
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/engine_load.xml b/lib/crypto/doc/src/engine_load.xml
new file mode 100644
index 0000000000..e5c3f5d561
--- /dev/null
+++ b/lib/crypto/doc/src/engine_load.xml
@@ -0,0 +1,110 @@
+<?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 Load</title>
+ <prepared>Lars Thorsén</prepared>
+ <date>2017-08-22</date>
+ <file>engine_load.xml</file>
+ </header>
+ <p>
+ <marker id="engine_load"></marker>
+ This chapter describes the support for loading encryption engines in the crypto application.
+ </p>
+
+ <section>
+ <title>Background</title>
+ <p>
+ OpenSSL exposes an Engine API, which makes it possible to plug in alternative
+ implementations for some or all of the cryptographic operations implemented by OpenSSL.
+ When configured appropriately, OpenSSL calls the engine's implementation of these
+ operations instead of its own.
+ </p>
+ <p>
+ Typically, OpenSSL engines provide a hardware implementation of specific cryptographic
+ operations. The hardware implementation usually offers improved performance over its
+ software-based counterpart, which is known as cryptographic acceleration.
+ </p>
+ </section>
+
+ <section>
+ <title>Use Cases</title>
+ <section>
+ <title>Dynamically load an engine from default directory</title>
+ <p>
+ If the engine is located in the OpenSSL/LibreSSL installation <c>engines</c> directory.
+ </p>
+ <code>
+1> {ok, Engine} = crypto:engine_load(&lt;&lt;"otp_test_engine">>, [], []).
+ {ok, #Ref}</code>
+ <note>
+ <p>The file name requirement on the engine dynamic library can differ between SSL versions.</p>
+ </note>
+ </section>
+
+ <section>
+ <title>Load an engine with the dynamic engine</title>
+ <p>
+ Load an engine with the help of the dynamic engine by giving the path to the library.
+ </p>
+ <code>
+ 2> {ok, Engine} = crypto:engine_load(&lt;&lt;"dynamic">>,
+ [{&lt;&lt;"SO_PATH">>,
+ &lt;&lt;"/some/path/otp_test_engine.so">>},
+ {&lt;&lt;"ID">>, &lt;&lt;"MD5">>},
+ &lt;&lt;"LOAD">>],
+ []).
+ {ok, #Ref}</code>
+ <note>
+ <p>The dynamic engine is not supported in LibreSSL from version 2.2.1</p>
+ </note>
+ </section>
+
+ <section>
+ <title>Load an engine and replace some methods</title>
+ <p>
+ Load an engine with the help of the dynamic engine and just
+ replace some engine methods.
+ </p>
+ <code>
+ 3> Methods = crypto:engine_get_all_methods() -- [engine_method_dh,engine_method_rand,
+engine_method_ciphers,engine_method_digests, engine_method_store,
+engine_method_pkey_meths, engine_method_pkey_asn1_meths].
+[engine_method_rsa,engine_method_dsa,
+ engine_method_ecdh,engine_method_ecdsa]
+ 4> {ok, Engine} = crypto:engine_load(&lt;&lt;"dynamic">>,
+ [{&lt;&lt;"SO_PATH">>,
+ &lt;&lt;"/some/path/otp_test_engine.so">>},
+ {&lt;&lt;"ID">>, &lt;&lt;"MD5">>},
+ &lt;&lt;"LOAD">>],
+ [],
+ Methods).
+ {ok, #Ref}</code>
+ </section>
+
+ <section>
+ <title>List all engines currently loaded</title>
+ <code>
+ 5> crypto:engine_list().
+[&lt;&lt;"dynamic">>, &lt;&lt;"MD5">>]</code>
+ </section>
+
+ </section>
+</chapter>
diff --git a/lib/crypto/doc/src/usersguide.xml b/lib/crypto/doc/src/usersguide.xml
index 7971aefff4..e2ba1fe160 100644
--- a/lib/crypto/doc/src/usersguide.xml
+++ b/lib/crypto/doc/src/usersguide.xml
@@ -11,7 +11,7 @@
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
@@ -19,7 +19,7 @@
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>Crypto User's Guide</title>
@@ -48,5 +48,6 @@
</description>
<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/Makefile b/lib/crypto/src/Makefile
index aea8a5a71c..edad0e6b61 100644
--- a/lib/crypto/src/Makefile
+++ b/lib/crypto/src/Makefile
@@ -39,8 +39,7 @@ MODULES= \
crypto \
crypto_ec_curves
-HRL_FILES=
-
+HRL_FILES=
ERL_FILES= $(MODULES:%=%.erl)
TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR))
@@ -56,16 +55,16 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
# ----------------------------------------------------
# FLAGS
# ----------------------------------------------------
-ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror
+ERL_COMPILE_FLAGS += -DCRYPTO_VSN=\"$(VSN)\" -Werror -I../include
# ----------------------------------------------------
# Targets
# ----------------------------------------------------
-debug opt valgrind: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+debug opt valgrind: $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
clean:
- rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
+ rm -f $(TARGET_FILES) $(APP_TARGET) $(APPUP_TARGET)
rm -f errs core *~
$(APP_TARGET): $(APP_SRC) ../vsn.mk
@@ -78,7 +77,7 @@ docs:
# ----------------------------------------------------
# Release Target
-# ----------------------------------------------------
+# ----------------------------------------------------
include $(ERL_TOP)/make/otp_release_targets.mk
release_spec: opt
@@ -89,10 +88,3 @@ release_spec: opt
$(APPUP_TARGET) "$(RELSYSDIR)/ebin"
release_docs_spec:
-
-
-
-
-
-
-
diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl
index f9c4f7b71d..1a1b4f98b5 100644
--- a/lib/crypto/src/crypto.erl
+++ b/lib/crypto/src/crypto.erl
@@ -42,12 +42,28 @@
-export([public_encrypt/4, private_decrypt/4]).
-export([private_encrypt/4, public_decrypt/4]).
-export([dh_generate_parameters/2, dh_check/1]). %% Testing see
+-export([privkey_to_pubkey/2]).
-export([ec_curve/1, ec_curves/0]).
-export([rand_seed/1]).
+%% Engine
+-export([
+ engine_get_all_methods/0,
+ engine_load/3,
+ engine_load/4,
+ engine_unload/1,
+ engine_list/0,
+ engine_ctrl_cmd_string/3,
+ engine_ctrl_cmd_string/4
+ ]).
+
+-export_type([engine_ref/0,
+ key_id/0,
+ password/0
+ ]).
-%% Private. For tests.
--export([packed_openssl_version/4]).
+%% Private. For tests.
+-export([packed_openssl_version/4, engine_methods_convert_to_bitmask/2, get_test_engine/0]).
-deprecated({rand_uniform, 2, next_major_release}).
@@ -421,13 +437,24 @@ sign(Algorithm, Type, Data, Key, Options) ->
end.
+
+-type key_id() :: string() | binary() .
+-type password() :: string() | binary() .
+
+-type engine_key_ref() :: #{engine := engine_ref(),
+ key_id := key_id(),
+ password => password(),
+ term() => term()
+ }.
+
-type pk_algs() :: rsa | ecdsa | dss .
--type pk_opt() :: list() | rsa_padding() .
+-type pk_key() :: engine_key_ref() | [integer() | binary()] .
+-type pk_opt() :: list() | rsa_padding() .
--spec public_encrypt(pk_algs(), binary(), [binary()], pk_opt()) -> binary().
--spec public_decrypt(pk_algs(), binary(), [integer() | binary()], pk_opt()) -> binary().
--spec private_encrypt(pk_algs(), binary(), [integer() | binary()], pk_opt()) -> binary().
--spec private_decrypt(pk_algs(), binary(), [integer() | binary()], pk_opt()) -> binary().
+-spec public_encrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary().
+-spec public_decrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary().
+-spec private_encrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary().
+-spec private_decrypt(pk_algs(), binary(), pk_key(), pk_opt()) -> binary().
public_encrypt(Algorithm, In, Key, Options) when is_list(Options) ->
case pkey_crypt_nif(Algorithm, In, format_pkey(Algorithm, Key), Options, false, true) of
@@ -568,10 +595,174 @@ compute_key(ecdh, Others, My, Curve) ->
nif_curve_params(Curve),
ensure_int_as_bin(My)).
+%%======================================================================
+%% Engine functions
+%%======================================================================
+%%----------------------------------------------------------------------
+%% Function: engine_get_all_methods/0
+%%----------------------------------------------------------------------
+-type engine_method_type() :: engine_method_rsa | engine_method_dsa | engine_method_dh |
+ engine_method_rand | engine_method_ecdh | engine_method_ecdsa |
+ engine_method_ciphers | engine_method_digests | engine_method_store |
+ engine_method_pkey_meths | engine_method_pkey_asn1_meths |
+ engine_method_ec.
+
+-type engine_ref() :: term().
+
+-spec engine_get_all_methods() ->
+ [engine_method_type()].
+engine_get_all_methods() ->
+ notsup_to_error(engine_get_all_methods_nif()).
+
+%%----------------------------------------------------------------------
+%% Function: engine_load/3
+%%----------------------------------------------------------------------
+-spec engine_load(EngineId::unicode:chardata(),
+ PreCmds::[{unicode:chardata(), unicode:chardata()}],
+ PostCmds::[{unicode:chardata(), unicode:chardata()}]) ->
+ {ok, Engine::engine_ref()} | {error, Reason::term()}.
+engine_load(EngineId, PreCmds, PostCmds) when is_list(PreCmds), is_list(PostCmds) ->
+ engine_load(EngineId, PreCmds, PostCmds, engine_get_all_methods()).
+
+%%----------------------------------------------------------------------
+%% Function: engine_load/4
+%%----------------------------------------------------------------------
+-spec engine_load(EngineId::unicode:chardata(),
+ PreCmds::[{unicode:chardata(), unicode:chardata()}],
+ PostCmds::[{unicode:chardata(), unicode:chardata()}],
+ EngineMethods::[engine_method_type()]) ->
+ {ok, Engine::term()} | {error, Reason::term()}.
+engine_load(EngineId, PreCmds, PostCmds, EngineMethods) when is_list(PreCmds),
+ is_list(PostCmds) ->
+ try
+ ok = notsup_to_error(engine_load_dynamic_nif()),
+ case notsup_to_error(engine_by_id_nif(ensure_bin_chardata(EngineId))) of
+ {ok, Engine} ->
+ ok = engine_load_1(Engine, PreCmds, PostCmds, EngineMethods),
+ {ok, Engine};
+ {error, Error1} ->
+ {error, Error1}
+ end
+ catch
+ throw:Error2 ->
+ Error2
+ end.
+
+engine_load_1(Engine, PreCmds, PostCmds, EngineMethods) ->
+ try
+ ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PreCmds), 0)),
+ ok = engine_nif_wrapper(engine_add_nif(Engine)),
+ ok = engine_nif_wrapper(engine_init_nif(Engine)),
+ engine_load_2(Engine, PostCmds, EngineMethods),
+ ok
+ catch
+ throw:Error ->
+ %% The engine couldn't initialise, release the structural reference
+ ok = engine_free_nif(Engine),
+ throw(Error)
+ end.
+
+engine_load_2(Engine, PostCmds, EngineMethods) ->
+ try
+ ok = engine_nif_wrapper(engine_ctrl_cmd_strings_nif(Engine, ensure_bin_cmds(PostCmds), 0)),
+ [ok = engine_nif_wrapper(engine_register_nif(Engine, engine_method_atom_to_int(Method))) ||
+ Method <- EngineMethods],
+ ok
+ catch
+ throw:Error ->
+ %% The engine registration failed, release the functional reference
+ ok = engine_finish_nif(Engine),
+ throw(Error)
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: engine_unload/1
+%%----------------------------------------------------------------------
+-spec engine_unload(Engine::term()) ->
+ ok | {error, Reason::term()}.
+engine_unload(Engine) ->
+ engine_unload(Engine, engine_get_all_methods()).
+
+-spec engine_unload(Engine::term(), EngineMethods::[engine_method_type()]) ->
+ ok | {error, Reason::term()}.
+engine_unload(Engine, EngineMethods) ->
+ try
+ [ok = engine_nif_wrapper(engine_unregister_nif(Engine, engine_method_atom_to_int(Method))) ||
+ Method <- EngineMethods],
+ ok = engine_nif_wrapper(engine_remove_nif(Engine)),
+ %% Release the functional reference from engine_init_nif
+ ok = engine_nif_wrapper(engine_finish_nif(Engine)),
+ %% Release the structural reference from engine_by_id_nif
+ ok = engine_nif_wrapper(engine_free_nif(Engine))
+ catch
+ throw:Error ->
+ Error
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: engine_list/0
+%%----------------------------------------------------------------------
+-spec engine_list() ->
+ [EngineId::binary()].
+engine_list() ->
+ case notsup_to_error(engine_get_first_nif()) of
+ {ok, <<>>} ->
+ [];
+ {ok, Engine} ->
+ case notsup_to_error(engine_get_id_nif(Engine)) of
+ {ok, <<>>} ->
+ engine_list(Engine, []);
+ {ok, EngineId} ->
+ engine_list(Engine, [EngineId])
+ end
+ end.
+
+engine_list(Engine0, IdList) ->
+ case notsup_to_error(engine_get_next_nif(Engine0)) of
+ {ok, <<>>} ->
+ lists:reverse(IdList);
+ {ok, Engine1} ->
+ case notsup_to_error(engine_get_id_nif(Engine1)) of
+ {ok, <<>>} ->
+ engine_list(Engine1, IdList);
+ {ok, EngineId} ->
+ engine_list(Engine1, [EngineId |IdList])
+ end
+ end.
+
+%%----------------------------------------------------------------------
+%% Function: engine_ctrl_cmd_string/3
+%%----------------------------------------------------------------------
+-spec engine_ctrl_cmd_string(Engine::term(),
+ CmdName::unicode:chardata(),
+ CmdArg::unicode:chardata()) ->
+ ok | {error, Reason::term()}.
+engine_ctrl_cmd_string(Engine, CmdName, CmdArg) ->
+ engine_ctrl_cmd_string(Engine, CmdName, CmdArg, false).
+
+%%----------------------------------------------------------------------
+%% Function: engine_ctrl_cmd_string/4
+%%----------------------------------------------------------------------
+-spec engine_ctrl_cmd_string(Engine::term(),
+ CmdName::unicode:chardata(),
+ CmdArg::unicode:chardata(),
+ Optional::boolean()) ->
+ ok | {error, Reason::term()}.
+engine_ctrl_cmd_string(Engine, CmdName, CmdArg, Optional) ->
+ case engine_ctrl_cmd_strings_nif(Engine,
+ ensure_bin_cmds([{CmdName, CmdArg}]),
+ bool_to_int(Optional)) of
+ ok ->
+ ok;
+ notsup ->
+ erlang:error(notsup);
+ {error, Error} ->
+ {error, Error}
+ end.
+
%%--------------------------------------------------------------------
%%% On load
%%--------------------------------------------------------------------
-
on_load() ->
LibBaseName = "crypto",
PrivDir = code:priv_dir(crypto),
@@ -631,12 +822,12 @@ path2bin(Path) when is_list(Path) ->
end.
%%--------------------------------------------------------------------
-%%% Internal functions
+%%% Internal functions
%%--------------------------------------------------------------------
max_bytes() ->
?MAX_BYTES_TO_NIF.
-notsup_to_error(notsup) ->
+notsup_to_error(notsup) ->
erlang:error(notsup);
notsup_to_error(Other) ->
Other.
@@ -760,7 +951,7 @@ do_stream_decrypt({rc4, State0}, Data) ->
%%
-%% AES - in counter mode (CTR) with state maintained for multi-call streaming
+%% AES - in counter mode (CTR) with state maintained for multi-call streaming
%%
-type ctr_state() :: { iodata(), binary(), binary(), integer() } | binary().
@@ -769,11 +960,11 @@ do_stream_decrypt({rc4, State0}, Data) ->
{ ctr_state(), binary() }.
-spec aes_ctr_stream_decrypt(ctr_state(), binary()) ->
{ ctr_state(), binary() }.
-
+
aes_ctr_stream_init(_Key, _IVec) -> ?nif_stub.
aes_ctr_stream_encrypt(_State, _Data) -> ?nif_stub.
aes_ctr_stream_decrypt(_State, _Cipher) -> ?nif_stub.
-
+
%%
%% RC4 - symmetric stream cipher
%%
@@ -858,22 +1049,22 @@ pkey_verify_nif(_Algorithm, _Type, _Data, _Signature, _Key, _Options) -> ?nif_st
rsa_generate_key_nif(_Bits, _Exp) -> ?nif_stub.
%% DH Diffie-Hellman functions
-%%
+%%
%% Generate (and check) Parameters is not documented because they are implemented
%% for testing (and offline parameter generation) only.
-%% From the openssl doc:
+%% From the openssl doc:
%% DH_generate_parameters() may run for several hours before finding a suitable prime.
-%% Thus dh_generate_parameters may in this implementation block
+%% Thus dh_generate_parameters may in this implementation block
%% the emulator for several hours.
%%
-%% usage: dh_generate_parameters(1024, 2 or 5) ->
+%% usage: dh_generate_parameters(1024, 2 or 5) ->
%% [Prime=mpint(), SharedGenerator=mpint()]
dh_generate_parameters(PrimeLen, Generator) ->
case dh_generate_parameters_nif(PrimeLen, Generator) of
error -> erlang:error(generation_failed, [PrimeLen,Generator]);
Ret -> Ret
- end.
+ end.
dh_generate_parameters_nif(_PrimeLen, _Generator) -> ?nif_stub.
@@ -899,6 +1090,24 @@ ec_curves() ->
ec_curve(X) ->
crypto_ec_curves:curve(X).
+
+privkey_to_pubkey(Alg, EngineMap) when Alg == rsa; Alg == dss; Alg == ecdsa ->
+ 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.
+
+
%%
%% EC
%%
@@ -966,6 +1175,19 @@ ensure_int_as_bin(Int) when is_integer(Int) ->
ensure_int_as_bin(Bin) ->
Bin.
+map_ensure_bin_as_int(List) when is_list(List) ->
+ lists:map(fun ensure_bin_as_int/1, List).
+
+ensure_bin_as_int(Bin) when is_binary(Bin) ->
+ bin_to_int(Bin);
+ensure_bin_as_int(E) ->
+ E.
+
+format_pkey(_Alg, #{engine:=_, key_id:=T}=M) when is_binary(T) -> format_pwd(M);
+format_pkey(_Alg, #{engine:=_, key_id:=T}=M) when is_list(T) -> format_pwd(M#{key_id:=list_to_binary(T)});
+format_pkey(_Alg, #{engine:=_ }=M) -> error({bad_key_id, M});
+format_pkey(_Alg, #{}=M) -> error({bad_engine_map, M});
+%%%
format_pkey(rsa, Key) ->
map_ensure_int_as_bin(Key);
format_pkey(ecdsa, [Key, Curve]) ->
@@ -975,6 +1197,9 @@ format_pkey(dss, Key) ->
format_pkey(_, Key) ->
Key.
+format_pwd(#{password := Pwd}=M) when is_list(Pwd) -> M#{password := list_to_binary(Pwd)};
+format_pwd(M) -> M.
+
%%--------------------------------------------------------------------
%%
-type rsa_padding() :: 'rsa_pkcs1_padding' | 'rsa_pkcs1_oaep_padding' | 'rsa_no_padding'.
@@ -985,7 +1210,7 @@ pkey_crypt_nif(_Algorithm, _In, _Key, _Options, _IsPrivate, _IsEncrypt) -> ?nif_
%% MP representaion (SSH2)
mpint(X) when X < 0 -> mpint_neg(X);
mpint(X) -> mpint_pos(X).
-
+
-define(UINT32(X), X:32/unsigned-big-integer).
@@ -993,7 +1218,7 @@ mpint_neg(X) ->
Bin = int_to_bin_neg(X, []),
Sz = byte_size(Bin),
<<?UINT32(Sz), Bin/binary>>.
-
+
mpint_pos(X) ->
Bin = int_to_bin_pos(X, []),
<<MSB,_/binary>> = Bin,
@@ -1015,7 +1240,6 @@ erlint(<<MPIntSize:32/integer,MPIntValue/binary>>) ->
%%
mod_exp_nif(_Base,_Exp,_Mod,_bin_hdr) -> ?nif_stub.
-
%%%----------------------------------------------------------------
%% 9470495 == V(0,9,8,zh).
%% 268435615 == V(1,0,0,i).
@@ -1026,3 +1250,95 @@ packed_openssl_version(MAJ, MIN, FIX, P0) ->
P1 = atom_to_list(P0),
P = lists:sum([C-$a||C<-P1]),
((((((((MAJ bsl 8) bor MIN) bsl 8 ) bor FIX) bsl 8) bor (P+1)) bsl 4) bor 16#f).
+
+%%--------------------------------------------------------------------
+%% Engine nifs
+engine_by_id_nif(_EngineId) -> ?nif_stub.
+engine_init_nif(_Engine) -> ?nif_stub.
+engine_finish_nif(_Engine) -> ?nif_stub.
+engine_free_nif(_Engine) -> ?nif_stub.
+engine_load_dynamic_nif() -> ?nif_stub.
+engine_ctrl_cmd_strings_nif(_Engine, _Cmds, _Optional) -> ?nif_stub.
+engine_add_nif(_Engine) -> ?nif_stub.
+engine_remove_nif(_Engine) -> ?nif_stub.
+engine_register_nif(_Engine, _EngineMethod) -> ?nif_stub.
+engine_unregister_nif(_Engine, _EngineMethod) -> ?nif_stub.
+engine_get_first_nif() -> ?nif_stub.
+engine_get_next_nif(_Engine) -> ?nif_stub.
+engine_get_id_nif(_Engine) -> ?nif_stub.
+engine_get_all_methods_nif() -> ?nif_stub.
+
+%%--------------------------------------------------------------------
+%% Engine internals
+engine_nif_wrapper(ok) ->
+ ok;
+engine_nif_wrapper(notsup) ->
+ erlang:error(notsup);
+engine_nif_wrapper({error, Error}) ->
+ throw({error, Error}).
+
+ensure_bin_chardata(CharData) when is_binary(CharData) ->
+ CharData;
+ensure_bin_chardata(CharData) ->
+ unicode:characters_to_binary(CharData).
+
+ensure_bin_cmds(CMDs) ->
+ ensure_bin_cmds(CMDs, []).
+
+ensure_bin_cmds([], Acc) ->
+ lists:reverse(Acc);
+ensure_bin_cmds([{Key, Value} |CMDs], Acc) ->
+ ensure_bin_cmds(CMDs, [{ensure_bin_chardata(Key), ensure_bin_chardata(Value)} | Acc]);
+ensure_bin_cmds([Key | CMDs], Acc) ->
+ ensure_bin_cmds(CMDs, [{ensure_bin_chardata(Key), <<"">>} | Acc]).
+
+engine_methods_convert_to_bitmask([], BitMask) ->
+ BitMask;
+engine_methods_convert_to_bitmask(engine_method_all, _BitMask) ->
+ 16#FFFF;
+engine_methods_convert_to_bitmask(engine_method_none, _BitMask) ->
+ 16#0000;
+engine_methods_convert_to_bitmask([M |Ms], BitMask) ->
+ engine_methods_convert_to_bitmask(Ms, BitMask bor engine_method_atom_to_int(M)).
+
+bool_to_int(true) -> 1;
+bool_to_int(false) -> 0.
+
+engine_method_atom_to_int(engine_method_rsa) -> 16#0001;
+engine_method_atom_to_int(engine_method_dsa) -> 16#0002;
+engine_method_atom_to_int(engine_method_dh) -> 16#0004;
+engine_method_atom_to_int(engine_method_rand) -> 16#0008;
+engine_method_atom_to_int(engine_method_ecdh) -> 16#0010;
+engine_method_atom_to_int(engine_method_ecdsa) -> 16#0020;
+engine_method_atom_to_int(engine_method_ciphers) -> 16#0040;
+engine_method_atom_to_int(engine_method_digests) -> 16#0080;
+engine_method_atom_to_int(engine_method_store) -> 16#0100;
+engine_method_atom_to_int(engine_method_pkey_meths) -> 16#0200;
+engine_method_atom_to_int(engine_method_pkey_asn1_meths) -> 16#0400;
+engine_method_atom_to_int(engine_method_ec) -> 16#0800;
+engine_method_atom_to_int(X) ->
+ erlang:error(badarg, [X]).
+
+get_test_engine() ->
+ Type = erlang:system_info(system_architecture),
+ LibDir = filename:join([code:priv_dir(crypto), "lib"]),
+ ArchDir = filename:join([LibDir, Type]),
+ case filelib:is_dir(ArchDir) of
+ true -> check_otp_test_engine(ArchDir);
+ false -> check_otp_test_engine(LibDir)
+ end.
+
+check_otp_test_engine(LibDir) ->
+ case filelib:wildcard("otp_test_engine*", LibDir) of
+ [] ->
+ {error, notexist};
+ [LibName] ->
+ LibPath = filename:join(LibDir,LibName),
+ case filelib:is_file(LibPath) of
+ true ->
+ {ok, unicode:characters_to_binary(LibPath)};
+ false ->
+ {error, notexist}
+ end
+ end.
+
diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile
index 138081d386..e046a25338 100644
--- a/lib/crypto/test/Makefile
+++ b/lib/crypto/test/Makefile
@@ -7,7 +7,8 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk
MODULES = \
blowfish_SUITE \
- crypto_SUITE
+ crypto_SUITE \
+ engine_SUITE
ERL_FILES= $(MODULES:%=%.erl)
@@ -27,7 +28,7 @@ RELSYSDIR = $(RELEASE_PATH)/crypto_test
# FLAGS
# ----------------------------------------------------
ERL_MAKE_FLAGS +=
-ERL_COMPILE_FLAGS +=
+ERL_COMPILE_FLAGS += +nowarn_export_all
EBIN = .
MAKE_EMAKE = $(wildcard $(ERL_TOP)/make/make_emakefile)
@@ -77,7 +78,7 @@ release_spec:
release_tests_spec: $(TEST_TARGET)
$(INSTALL_DIR) "$(RELSYSDIR)"
$(INSTALL_DATA) crypto.spec crypto.cover $(RELTEST_FILES) "$(RELSYSDIR)"
- @tar cfh - crypto_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
+ @tar cfh - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -)
chmod -R u+w "$(RELSYSDIR)"
release_docs_spec:
diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl
index 69f02d3da6..6dab459df6 100644
--- a/lib/crypto/test/crypto_SUITE.erl
+++ b/lib/crypto/test/crypto_SUITE.erl
@@ -198,7 +198,7 @@ init_per_suite(Config) ->
%% This is NOT how you want to do seeding, it is just here
%% to make the tests pass. Check your OS manual for how you
%% really want to seed.
- {H,M,L} = erlang:now(),
+ {H,M,L} = erlang:timestamp(),
Bin = <<H:24,M:20,L:20>>,
crypto:rand_seed(<< <<Bin/binary>> || _ <- lists:seq(1,16) >>),
Config
diff --git a/lib/crypto/test/engine_SUITE.erl b/lib/crypto/test/engine_SUITE.erl
new file mode 100644
index 0000000000..f206f967c7
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE.erl
@@ -0,0 +1,660 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-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(engine_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{seconds, 10}}
+ ].
+
+all() ->
+ [
+ get_all_possible_methods,
+ engine_load_all_methods,
+ engine_load_some_methods,
+ bad_arguments,
+ unknown_engine,
+ pre_command_fail_bad_value,
+ pre_command_fail_bad_key,
+ failed_engine_init,
+ ctrl_cmd_string,
+ ctrl_cmd_string_optional,
+ {group, engine_stored_key}
+ ].
+
+groups() ->
+ [{engine_stored_key, [],
+ [sign_verify_rsa,
+ 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
+ ]}].
+
+
+init_per_suite(Config) ->
+ try crypto:start() of
+ ok ->
+ Config;
+ {error,{already_started,crypto}} ->
+ Config
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+end_per_suite(_Config) ->
+ ok.
+
+%%--------------------------------------------------------------------
+init_per_group(engine_stored_key, Config) ->
+ case load_storage_engine(Config) of
+ {ok, E} ->
+ KeyDir = key_dir(Config),
+ [{storage_engine,E}, {storage_dir,KeyDir} | Config];
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {error, notsup} ->
+ {skip, "Engine not supported on this OpenSSL version"};
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"};
+ Other ->
+ ct:log("Engine load failed: ~p",[Other]),
+ {fail, "Engine load failed"}
+ end;
+init_per_group(_Group, Config0) ->
+ Config0.
+
+end_per_group(engine_stored_key, Config) ->
+ case proplists:get_value(storage_engine, Config) of
+ undefined ->
+ ok;
+ E ->
+ ok = crypto:engine_unload(E)
+ end;
+end_per_group(_, _) ->
+ ok.
+
+%%--------------------------------------------------------------------
+init_per_testcase(_Case, Config) ->
+ Config.
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+%%-------------------------------------------------------------------------
+%% Test cases starts here.
+%%-------------------------------------------------------------------------
+get_all_possible_methods() ->
+ [{doc, "Just fetch all possible engine methods supported."}].
+
+get_all_possible_methods(Config) when is_list(Config) ->
+ try
+ List = crypto:engine_get_all_methods(),
+ ct:log("crypto:engine_get_all_methods() -> ~p\n", [List]),
+ ok
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+engine_load_all_methods()->
+ [{doc, "Use a dummy md5 engine that does not implement md5"
+ "but rather returns a static binary to test that crypto:engine_load "
+ "functions works."}].
+
+engine_load_all_methods(Config) when is_list(Config) ->
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ try
+ Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>,
+ Md5Hash1 = crypto:hash(md5, "Don't panic"),
+ Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>,
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ []) of
+ {ok, E} ->
+ case crypto:hash(md5, "Don't panic") of
+ Md5Hash1 ->
+ ct:fail(fail_to_load_still_original_engine);
+ Md5Hash2 ->
+ ok;
+ _ ->
+ ct:fail(fail_to_load_engine)
+ end,
+ ok = crypto:engine_unload(E),
+ case crypto:hash(md5, "Don't panic") of
+ Md5Hash2 ->
+ ct:fail(fail_to_unload_still_test_engine);
+ Md5Hash1 ->
+ ok;
+ _ ->
+ ct:fail(fail_to_unload_engine)
+ end;
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end
+ end.
+
+engine_load_some_methods()->
+ [{doc, "Use a dummy md5 engine that does not implement md5"
+ "but rather returns a static binary to test that crypto:engine_load "
+ "functions works."}].
+
+engine_load_some_methods(Config) when is_list(Config) ->
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ try
+ Md5Hash1 = <<106,30,3,246,166,222,229,158,244,217,241,179,50,232,107,109>>,
+ Md5Hash1 = crypto:hash(md5, "Don't panic"),
+ Md5Hash2 = <<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15>>,
+ EngineMethods = crypto:engine_get_all_methods() --
+ [engine_method_dh,engine_method_rand,
+ engine_method_ciphers, engine_method_store,
+ engine_method_pkey_meths, engine_method_pkey_asn1_meths],
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ [],
+ EngineMethods) of
+ {ok, E} ->
+ case crypto:hash(md5, "Don't panic") of
+ Md5Hash1 ->
+ ct:fail(fail_to_load_engine_still_original);
+ Md5Hash2 ->
+ ok;
+ _ ->
+ ct:fail(fail_to_load_engine)
+ end,
+ ok = crypto:engine_unload(E),
+ case crypto:hash(md5, "Don't panic") of
+ Md5Hash2 ->
+ ct:fail(fail_to_unload_still_test_engine);
+ Md5Hash1 ->
+ ok;
+ _ ->
+ ct:fail(fail_to_unload_engine)
+ end;
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end
+ end.
+
+%%-------------------------------------------------------------------------
+%% Error cases
+bad_arguments()->
+ [{doc, "Test different arguments in bad format."}].
+
+bad_arguments(Config) when is_list(Config) ->
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ try
+ try
+ crypto:engine_load(fail_engine, [], [])
+ catch
+ error:badarg ->
+ ok
+ end,
+ try
+ crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ 1,
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ [])
+ catch
+ error:badarg ->
+ ok
+ end,
+ try
+ crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {'ID', <<"MD5">>},
+ <<"LOAD">>],
+ [])
+ catch
+ error:badarg ->
+ ok
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end
+ end.
+
+unknown_engine() ->
+ [{doc, "Try to load a non existent engine."}].
+
+unknown_engine(Config) when is_list(Config) ->
+ try
+ {error, bad_engine_id} = crypto:engine_load(<<"fail_engine">>, [], []),
+ ok
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+pre_command_fail_bad_value() ->
+ [{doc, "Test pre command due to bad value"}].
+
+pre_command_fail_bad_value(Config) when is_list(Config) ->
+ DataDir = unicode:characters_to_binary(code:priv_dir(crypto)),
+ try
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>,
+ <<DataDir/binary, <<"/libfail_engine.so">>/binary >>},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ []) of
+ {error, ctrl_cmd_failed} ->
+ ok;
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+pre_command_fail_bad_key() ->
+ [{doc, "Test pre command due to bad key"}].
+
+pre_command_fail_bad_key(Config) when is_list(Config) ->
+ try
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_WRONG_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ []) of
+ {error, ctrl_cmd_failed} ->
+ ok;
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+failed_engine_init()->
+ [{doc, "Test failing engine init due to missed pre command"}].
+
+failed_engine_init(Config) when is_list(Config) ->
+ try
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>}],
+ []) of
+ {error, add_engine_failed} ->
+ ok;
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+
+ctrl_cmd_string()->
+ [{doc, "Test that a not known optional ctrl comand do not fail"}].
+ctrl_cmd_string(Config) when is_list(Config) ->
+ try
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ []) of
+ {ok, E} ->
+ case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>) of
+ ok ->
+ ct:fail(fail_ctrl_cmd_should_fail);
+ {error,ctrl_cmd_failed} ->
+ ok
+ end,
+ ok = crypto:engine_unload(E);
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+ctrl_cmd_string_optional()->
+ [{doc, "Test that a not known optional ctrl comand do not fail"}].
+ctrl_cmd_string_optional(Config) when is_list(Config) ->
+ try
+ case crypto:get_test_engine() of
+ {error, notexist} ->
+ {skip, "OTP Test engine not found"};
+ {ok, Engine} ->
+ case crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ {<<"ID">>, <<"MD5">>},
+ <<"LOAD">>],
+ []) of
+ {ok, E} ->
+ case crypto:engine_ctrl_cmd_string(E, <<"TEST">>, <<"17">>, true) of
+ ok ->
+ ok;
+ _ ->
+ ct:fail(fail_ctrl_cmd_string)
+ end,
+ ok = crypto:engine_unload(E);
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"}
+ end
+ end
+ catch
+ error:notsup ->
+ {skip, "Engine not supported on this OpenSSL version"}
+ end.
+
+%%%----------------------------------------------------------------
+%%% Pub/priv key storage tests. Thoose are for testing the crypto.erl
+%%% support for using priv/pub keys stored in an engine.
+
+sign_verify_rsa(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key.pem")},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_public_key.pem")},
+ sign_verify(rsa, sha, Priv, Pub).
+
+sign_verify_dsa(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "dsa_private_key.pem")},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "dsa_public_key.pem")},
+ sign_verify(dss, sha, Priv, Pub).
+
+sign_verify_ecdsa(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "ecdsa_private_key.pem")},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "ecdsa_public_key.pem")},
+ sign_verify(ecdsa, sha, Priv, Pub).
+
+sign_verify_rsa_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ 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_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")},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_public_key.pem")},
+ priv_enc_pub_dec(rsa, Priv, Pub, rsa_pkcs1_padding).
+
+priv_encrypt_pub_decrypt_rsa_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ 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_pwd.pem")},
+ priv_enc_pub_dec(rsa, Priv, Pub, rsa_pkcs1_padding).
+
+pub_encrypt_priv_decrypt_rsa(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_private_key.pem")},
+ Pub = #{engine => engine_ref(Config),
+ key_id => key_id(Config, "rsa_public_key.pem")},
+ pub_enc_priv_dec(rsa, Pub, Priv, rsa_pkcs1_padding).
+
+pub_encrypt_priv_decrypt_rsa_pwd(Config) ->
+ Priv = #{engine => engine_ref(Config),
+ 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_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")},
+ 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")},
+ 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")},
+ 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.
+
+%%%================================================================
+%%% Help for engine_stored_pub_priv_keys* test cases
+%%%
+load_storage_engine(_Config) ->
+ case crypto:get_test_engine() of
+ {ok, Engine} ->
+ try crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ <<"LOAD">>],
+ [])
+ catch
+ error:notsup ->
+ {error, notsup}
+ end;
+
+ {error, Error} ->
+ {error, Error}
+ end.
+
+
+key_dir(Config) ->
+ DataDir = unicode:characters_to_binary(proplists:get_value(data_dir, Config)),
+ filename:join(DataDir, "pkcs8").
+
+
+engine_ref(Config) ->
+ proplists:get_value(storage_engine, Config).
+
+key_id(Config, File) ->
+ filename:join(proplists:get_value(storage_dir,Config), File).
+
+pubkey_alg_supported(Alg) ->
+ lists:member(Alg,
+ proplists:get_value(public_keys, crypto:supports())).
+
+
+pub_enc_priv_dec(Alg, KeyEnc, KeyDec, Padding) ->
+ case pubkey_alg_supported(Alg) of
+ true ->
+ PlainText = <<"Hej på dig">>,
+ CryptoText = crypto:public_encrypt(Alg, PlainText, KeyEnc, Padding),
+ case crypto:private_decrypt(Alg, CryptoText, KeyDec, Padding) of
+ PlainText -> ok;
+ _ -> {fail, "Encrypt-decrypt error"}
+ end;
+ false ->
+ {skip, lists:concat([Alg," is not supported by cryptolib"])}
+ end.
+
+priv_enc_pub_dec(Alg, KeyEnc, KeyDec, Padding) ->
+ case pubkey_alg_supported(Alg) of
+ true ->
+ PlainText = <<"Hej på dig">>,
+ CryptoText = crypto:private_encrypt(Alg, PlainText, KeyEnc, Padding),
+ case crypto:public_decrypt(Alg, CryptoText, KeyDec, Padding) of
+ PlainText -> ok;
+ _ -> {fail, "Encrypt-decrypt error"}
+ end;
+ false ->
+ {skip, lists:concat([Alg," is not supported by cryptolib"])}
+ end.
+
+sign_verify(Alg, Sha, KeySign, KeyVerify) ->
+ case pubkey_alg_supported(Alg) of
+ true ->
+ PlainText = <<"Hej på dig">>,
+ Signature = crypto:sign(Alg, Sha, PlainText, KeySign),
+ case crypto:verify(Alg, Sha, PlainText, Signature, KeyVerify) of
+ true -> ok;
+ _ -> {fail, "Sign-verify error"}
+ end;
+ false ->
+ {skip, lists:concat([Alg," is not supported by cryptolib"])}
+ end.
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem
new file mode 100644
index 0000000000..778ffac675
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_private_key.pem
@@ -0,0 +1,9 @@
+-----BEGIN PRIVATE KEY-----
+MIIBSwIBADCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQ
+F87IE+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcAB
+gX3IwF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9
+PFrv8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF
+2w7zAw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfH
+EhHoQmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKK
+w/IYdlqcuYa4Cgm2TapT5uEMqH4jhzEEFgIULh8swEUWmU8aJNWsrWl4eCiuUUg=
+-----END PRIVATE KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem
new file mode 100644
index 0000000000..0fa5428828
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/dsa_public_key.pem
@@ -0,0 +1,12 @@
+-----BEGIN PUBLIC KEY-----
+MIIBtzCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQF87I
+E+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcABgX3I
+wF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9PFrv
+8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF2w7z
+Aw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfHEhHo
+QmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKKw/IY
+dlqcuYa4Cgm2TapT5uEMqH4jhzEDgYQAAoGAXPygOFYdeKgfLmuIC303cESYXvic
+e2GNJomv8vaWLZmbLVVDfwA1fNsuF1hZkWw8f7aYaN9iZ3yl9u4Yk4TbJKkqfJqd
+dgVt288SUqvi+NMHODUzYi9KAOXxupXffZSvdu54gKRaDuFTZ5XNcRqIJWGYlJYg
+NVHF5FPZ4Bk2FYA=
+-----END PUBLIC KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem
new file mode 100644
index 0000000000..a45522064f
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_private_key.pem
@@ -0,0 +1,8 @@
+-----BEGIN PRIVATE KEY-----
+MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBparGjr0KcdNrVM2J
+G0mW5ltP1QyvxDqBMyWLWo3fruRZv6Qoohl5skd1u4O+KJoM/UrrSTOXI/MDR7NN
+i1yl7O+hgYkDgYYABAG8K2XVsK0ahG9+HIIPwCO0pJY8ulwSTXwIjkCGyB2lpglh
+8qJmRzuyGcfRTslv8wfv0sPlT9H9PKDvgrTUL7rvQQDdOODNgVPXSecUoXoPn+X+
+eqxs77bjx+A5x0t/i3m5PfkaNPh5MZ1H/bWuOOdj2ZXZw0R4rlVc0zVrgnPU8L8S
+BQ==
+-----END PRIVATE KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem
new file mode 100644
index 0000000000..6d22fe43fe
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/ecdsa_public_key.pem
@@ -0,0 +1,6 @@
+-----BEGIN PUBLIC KEY-----
+MIGbMBAGByqGSM49AgEGBSuBBAAjA4GGAAQBvCtl1bCtGoRvfhyCD8AjtKSWPLpc
+Ek18CI5AhsgdpaYJYfKiZkc7shnH0U7Jb/MH79LD5U/R/Tyg74K01C+670EA3Tjg
+zYFT10nnFKF6D5/l/nqsbO+248fgOcdLf4t5uT35GjT4eTGdR/21rjjnY9mV2cNE
+eK5VXNM1a4Jz1PC/EgU=
+-----END PUBLIC KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem
new file mode 100644
index 0000000000..ea0e3d3958
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key.pem
@@ -0,0 +1,28 @@
+-----BEGIN PRIVATE KEY-----
+MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCwwb0/ddXGXTFK
+4FLxXdV6a/WJMSoPPS55RvZIAHFsiTtvPLbJ8LxDsZ6wSVZLN0/UQ4wdWn9jftyj
+U5/IxBVG8XOtKimTMvm3/ZOzVLueGHBbrLYscRv9oL85ulTKHWgrZDu0lBX5JJTI
+v5UTCErzJRQbka9DG1GaBgDb1PlXfkzBWMwfsBZmwoC77KvCcIGCgbW/XCY03TP2
+3Tg8drvpByMStddP2FQ4fZ91qFUzPu8uhZEsqSQTFlmhgGEx7dLlky0xvu62RuAD
+RTpINpcWZtWDHTdssOqu653LwwqBY8lBopCZ/4Af8QR3ZYkQhen1YLEbVheXRuzI
+LSCZIiJNAgMBAAECggEBAJH4/fxpqQkvr2Shy33Pu1xlyhnpw01gfn/jrcKasxEq
+aC4eWup86E2TY3U8q4pkfIXU3uLi+O9HNpmflwargNLc1mY8uqb44ygiv5bLNEKE
+9k2PXcdoBfC4jxPyoNFl5cBn/7LK1TazEjiTl15na9ZPWcLG1pG5/vMPYCgsQ1sP
+8J3c4E3aaXIj9QceYxBprl490OCzieGyZlRipncz3g4UShRc/b4cycvDZOJpmAy4
+zbWTcBcSMPVPi5coF0K8UcimiqZkotfb/2RLc433i34IdsIXMM+brdq+g8rmjg5a
++oQPy02M6tFApBruEhAz8DGgaLtDY6MLtyZAt3SjXnUCgYEA1zLgamdTHOqrrmIi
+eIQBnAJiyIfcY8B9SX1OsLGYFCHiPVwgUY35B2c7MavMsGcExJhtE+uxU7o5djtM
+R6r9cRHOXJ6EQwa8OwzzPqbM17/YqNDeK39bc9WOFUqRWrhDhVMPy6z8rmZr73mG
+IUC7mBNx/1GBdVYXIlsXzC96dI8CgYEA0kUAhz6I5nyPa70NDEUYHLHf3IW1BCmE
+UoVbraSePJtIEY/IqFx7oDuFo30d4n5z+8ICCtyid1h/Cp3mf3akOiqltYUfgV1G
+JgcEjKKYWEnO7cfFyO7LB7Y3GYYDJNy6EzVWPiwTGk9ZTfFJEESmHC45Unxgd17m
+Dx/R58rFgWMCgYBQXQWFdtSI5fH7C1bIHrPjKNju/h2FeurOuObcAVZDnmu4cmD3
+U8d9xkVKxVeJQM99A1coq0nrdI3k4zwXP3mp8fZYjDHkPe2pN6rW6L9yiohEcsuk
+/siON1/5/4DMmidM8LnjW9R45HLGWWGHpX7oyco2iJ+Jy/6Tq+T1MX3PbQKBgQCm
+hdsbQJ0u3CrBSmFQ/E9SOlRt0r4+45pVuCOY6yweF2QF9HcXTtbhWQJHLclDHJ5C
+Ha18aKuKFN3XzKFFBPKe1jOSBDGlQ/dQGnKx5fr8wMdObM3oiaTlIJuWbRmEUgJT
+QARjDIi8Z2b0YUhZx+Q9oSXoe3PyVYehJrQX+/BavQKBgQCIr7Zp0rQPbfqcTL+M
+OYHUoNcb14f9f8hXeXHQOqVpsGwxGdRQAU9wbx/4+obKB5xIkzBsVNcJwavisNja
+hegnGjTB/9Hc4m+5bMGwH0bhS2eQO4o+YYM2ypDmFQqDLRfFUlZ5PVHffm/aA9+g
+GanNBCsmtoHtV6CJ1UZ7NmBuIA==
+-----END PRIVATE KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem
new file mode 100644
index 0000000000..501662fc35
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_private_key_pwd.pem
@@ -0,0 +1,30 @@
+-----BEGIN ENCRYPTED PRIVATE KEY-----
+MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIh888Iq6gxuMCAggA
+MBQGCCqGSIb3DQMHBAic/11YZ8Nt5gSCBMjG/Jb4qiMoBS50iQvHXqcETPE+0NBr
+jhsn9w94LkdRBstMPAsoKmY98Er96Rnde/NfmqlU9CupKTkd7Ce5poBf72Y6KMED
+cPURyjbGRFsu6x9skXB2obhyKYEqAEF2oQAg4Qbe5v1qXBIgDuC/NgiJnM+w2zCZ
+LkHSZB2/NmcnvDzcgPF7TM8pTO23xCJ33m37qjfWvHsgocVqZmL9wQ4+wr/NMYjJ
+pJvX1OHW1vBsZsXh40WchalYRSB1VeO368QfsE8coRJztqbMzdce9EQdMB6Q6jlO
+cetd3moLIoMP4I7HW0/SgokbycTbRiYSvRyU1TGc2WbW6BrFZV24IckcnnVUFatf
+6HKUcaYLG68dJcRgs5QMGkcmgVvlddENHFmHZlo0eym/xSiUl/AT8/5odscm6ML8
+wW5sneax+TF4J2eYmiN7yjAUCodXVTNYNDVKo6uUhntlymbM0o4UitVIbPIfTDHl
+sxJAEZ7vpuPqeNMxUk6G6zipuEjqsVbnuFSBSZmgKiGYcifRPUmqqINa3DdS4WVx
+xaPWdHbHVRD//ze3h/FsA+1lIE5q2kUE0xXseJA1ISog++kJp14XeaaL2j/tx3Ob
+OsbcaOAD/IUw/ItDt9kn0qzfnar7sS0Wov8AmJQxHmH7Lm93jHTLM05yE0AR/eBr
+Mig2ZdC+9OqVC+GPuBkRjSs8NpltQIDroz6EV9IMwPwXm0szSYoyoPLmlHJUdnLs
+ZUef+au6hYkEJBrvuisagnq5eT/fCV3hsjD7yODebNU2CmBTo6X2PRx/xsBHRMWl
+QkoM9PBdSCnKv6HpHl4pchuoqU2NpFjN0BCaad6aHfZSTnqgzK4bEh1oO6dI8/rB
+/eh71JyFFG5J4xbpaqz5Su01V1iwU5leK5bDwqals4M4+ZGHGciou7qnXUmX2fJl
+r6DlMUa/xy+A2ZG0NuZR05yk2oB3+KVNMgp6zFty3XaxwoNtc8GTLtLnBnIh2rlP
+mE1+I65LRWwrNQalPeOAUrYuEzhyp2Df7a8Ykas5PUH7MGR/S0Ge/dLxtE2bJuK4
+znbLAsGhvo/SbNxYqIp6D4iDtd3va6yUGncy41paA/vTKFVvXZDrXcwJQYYCVOGT
+OwdzNuozU8Dc7oxsd8oakfC46kvmVaOrGvZbm56PFfprcaL/Hslska5xxEni/eZe
+WRxZbCBhAVqS1pn5zkDQVUe9uFlR/x39Qi01HIlKLBsjpSs6qQsFArMe8hgXmXLG
+xP+dyVuOE18NzSewdEjeqSRKIM7Qi8EOjZsI4HdSRBY7bh9VhmaVXDZiCSf33TTE
+3y8nimzQAeuGoYg6WqHmWWC2Qnpki2HlaIH/ayXEyQWkP/qvg61e8ovdg9Fy8JOO
+0AacXVt5zj0q00AW5bKx7usi4NIjZedi86hUm6H19aBm7r86BKjwYTEI/GOcdrbV
+9HC/8ayOimgwiAG3gq+aLioWym+Z6KnsbVd7XReVbvM/InQx54WA2y5im0A+/c67
+oQFFPV84XGX9waeqv/K4Wzkm6HW+qVAEM67482VGOf0PVrlQMno6dOotT/Y7ljoZ
+2iz0LmN9yylJnLPDrr1i6gzbs5OhhUgbF5LI2YP2wWdCZTl/DrKSIvQZWl8U+tw3
+ciA=
+-----END ENCRYPTED PRIVATE KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem
new file mode 100644
index 0000000000..d3fb5a2cc9
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key.pem
@@ -0,0 +1,9 @@
+-----BEGIN PUBLIC KEY-----
+MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAsMG9P3XVxl0xSuBS8V3V
+emv1iTEqDz0ueUb2SABxbIk7bzy2yfC8Q7GesElWSzdP1EOMHVp/Y37co1OfyMQV
+RvFzrSopkzL5t/2Ts1S7nhhwW6y2LHEb/aC/ObpUyh1oK2Q7tJQV+SSUyL+VEwhK
+8yUUG5GvQxtRmgYA29T5V35MwVjMH7AWZsKAu+yrwnCBgoG1v1wmNN0z9t04PHa7
+6QcjErXXT9hUOH2fdahVMz7vLoWRLKkkExZZoYBhMe3S5ZMtMb7utkbgA0U6SDaX
+FmbVgx03bLDqruudy8MKgWPJQaKQmf+AH/EEd2WJEIXp9WCxG1YXl0bsyC0gmSIi
+TQIDAQAB
+-----END PUBLIC KEY-----
diff --git a/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem
new file mode 100644
index 0000000000..f74361cead
--- /dev/null
+++ b/lib/crypto/test/engine_SUITE_data/pkcs8/rsa_public_key_pwd.pem
@@ -0,0 +1,9 @@
+-----BEGIN PUBLIC KEY-----
+MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxquo1Na8C+kjeW0YESGm
+vE1bgNW9xh+SQjU1fv/97ePK8mQW2zO1h/vUNz23pfZAKjQu3rlFW/VgGJQ0LgCs
+8Gr/HbMwNcCJzuFMePUrnWn/qBeR7OKUZCJ3E1pp4kwsTdGDDO7jPtNzKf0bdKlg
+G2GHfZWhUediRX8NsRg12X1odVPuRGVRsyJ952YODk9PFjK7pro7Ynf3Icx7di9d
+PXL5vEcKSRdomXvt1rgM8XVHES94RQqoz60ZhfV2JnPfa9V8qu0KaGntpEr7p4rQ
+5BSiLFPjPOArjsD5tKyo8ldKCdQjLfisEp7AetfMjLPVVPw9o/SmCjDxsYWTVRQ2
+tQIDAQAB
+-----END PUBLIC KEY-----
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/debugger/src/dbg_wx_win.erl b/lib/debugger/src/dbg_wx_win.erl
index 9f59915476..f1298154ab 100644
--- a/lib/debugger/src/dbg_wx_win.erl
+++ b/lib/debugger/src/dbg_wx_win.erl
@@ -299,7 +299,7 @@ open_help(_Parent, HelpHtmlFile) ->
%%--------------------------------------------------------------------
to_string(Atom) when is_atom(Atom) ->
- io_lib:format("~tw", [Atom]);
+ atom_to_list(Atom);
to_string(Integer) when is_integer(Integer) ->
integer_to_list(Integer);
to_string([]) -> "";
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/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml
index e489d155c3..9299c6d73f 100644
--- a/lib/hipe/doc/src/hipe_app.xml
+++ b/lib/hipe/doc/src/hipe_app.xml
@@ -47,6 +47,72 @@
Details on HiPE compiler options are given by <c>hipe:help_options()</c>.</p>
</description>
<section>
+ <title>Feature Limitations</title>
+ <p>
+ The HiPE compiler is in general compliant with the normal BEAM compiler,
+ with respect to semantic behavior. There are however features in the BEAM compiler
+ and the runtime system that have limited or no support for HiPE compiled modules.
+ </p>
+ <taglist>
+ <tag>Stack traces</tag>
+ <item><p>Stack traces returned from <seealso marker="erts:erlang#get_stacktrace/0">
+ <c>erlang:get_stacktrace/0</c></seealso> or as part of <c>'EXIT'</c> terms
+ can look incomplete if HiPE compiled functions are involved. Typically a stack trace
+ will contain only BEAM compiled functions or only HiPE compiled functions, depending
+ on where the exception was raised.</p>
+ <p>Source code line numbers in stack traces are also not supported by HiPE compiled functions.</p>
+ </item>
+
+ <tag>Tracing</tag>
+ <item><p>Erlang call trace is not supported by HiPE. Calling
+ <seealso marker="erts:erlang#trace_pattern/3"><c>erlang:trace_pattern({M,F,A}, ...)</c></seealso>
+ does not have any effect on HiPE compiled modules.</p>
+ </item>
+
+ <tag>NIFs</tag>
+ <item><p>Modules compiled with HiPE can not call <seealso marker="erts:erlang#load_nif-2">
+ <c>erlang:load_nif/2</c></seealso> to load NIFs.</p>
+ </item>
+
+ <tag>-on_load</tag>
+ <item><p>Modules compiled with HiPE can not use
+ <seealso marker="doc/reference_manual:code_loading#on_load"><c>-on_load()</c></seealso>
+ directives.</p>
+ </item>
+ </taglist>
+
+ </section>
+ <section>
+ <title>Performance Limitations</title>
+ <p>
+ The HiPE compiler does in general produce faster code than the
+ BEAM compiler. There are however some situation when HiPE
+ compiled code will perform worse than BEAM code.
+ </p>
+ <taglist>
+ <tag>Mode switches</tag>
+ <item><p>Every time a process changes from executing code in a
+ HiPE compiled module to a BEAM compiled module (or vice versa),
+ it will do a mode switch. This involves a certain amount of
+ CPU overhead which can have a negative net impact if the
+ process is switching back and forth without getting enough done in
+ each mode.</p>
+ </item>
+
+ <tag>Optimization for <c>receive</c> with unique references</tag>
+ <item><p>The BEAM compiler can do an optimization when
+ a <c>receive</c> statement is <em>only</em> waiting for messages
+ containing a reference created before the receive. All messages
+ that existed in the queue when the reference was created will be
+ bypassed, as they cannot possibly contain the reference. HiPE
+ does not implement this optimization.</p>
+ <p>An example of this is when
+ <c>gen_server:call()</c> waits for the reply message.</p>
+ </item>
+
+ </taglist>
+ </section>
+ <section>
<title>SEE ALSO</title>
<p>
<seealso marker="stdlib:c">c(3)</seealso>,
diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src
index 5b2280594f..fb750dd418 100644
--- a/lib/hipe/main/hipe.app.src
+++ b/lib/hipe/main/hipe.app.src
@@ -236,4 +236,4 @@
{applications, [kernel,stdlib]},
{env, []},
{runtime_dependencies, ["syntax_tools-1.6.14","stdlib-3.4","kernel-5.3",
- "erts-9.0","compiler-5.0"]}]}.
+ "erts-9.2","compiler-5.0"]}]}.
diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
index 52ea5db382..bc215e3abe 100644
--- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl
+++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl
@@ -195,8 +195,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab
bs_validate_unicode ->
[_Arg] = Args,
- [hipe_rtl:mk_call([], bs_validate_unicode, Args,
- TrueLblName, FalseLblName, not_remote)];
+ [IsUnicode] = create_regs(1),
+ RetLbl = hipe_rtl:mk_new_label(),
+ [hipe_rtl:mk_call([IsUnicode], is_unicode, Args,
+ hipe_rtl:label_name(RetLbl), [], not_remote),
+ RetLbl,
+ hipe_rtl:mk_branch(IsUnicode, ne, hipe_rtl:mk_imm(0),
+ TrueLblName, FalseLblName, 0.99)];
bs_final ->
Zero = hipe_rtl:mk_imm(0),
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/doc/src/notes.xml b/lib/inets/doc/src/notes.xml
index 10ef84d7cf..07e29b5542 100644
--- a/lib/inets/doc/src/notes.xml
+++ b/lib/inets/doc/src/notes.xml
@@ -33,7 +33,58 @@
<file>notes.xml</file>
</header>
- <section><title>Inets 6.4.2</title>
+ <section><title>Inets 6.4.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Correct the handling of location headers so that the
+ status code is not hard coded. This should have been
+ fixed by commit 2cc5ba70cbbc6b3ace81a2a0324417c3b65265bb
+ but unfortunately was broken during a code refactoring
+ and unnoticed due to a faulty placed test case.</p>
+ <p>
+ Own Id: OTP-14761</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.4.3</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Fix broken handling of POST requests</p>
+ <p>
+ New chunk mechanism of body data in POST requests added
+ in 5d01c70ca399edf28e99dc760506329689fab6ba broke
+ handling of POST body data not using the new mechanism.</p>
+ <p>
+ Own Id: OTP-14656</p>
+ </item>
+ <item>
+ <p>
+ Make sure ints:stop/2 of the service httpd is synchronous</p>
+ <p>
+ Own Id: OTP-14696</p>
+ </item>
+ <item>
+ <p>
+ Honor status code returned by ESI script and modernize
+ "location" header handling.</p>
+ <p>
+ Own Id: OTP-14716</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Inets 6.4.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
<list>
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/src/http_server/httpd_esi.erl b/lib/inets/src/http_server/httpd_esi.erl
index fd50934d00..f5493f6fad 100644
--- a/lib/inets/src/http_server/httpd_esi.erl
+++ b/lib/inets/src/http_server/httpd_esi.erl
@@ -86,7 +86,7 @@ handle_headers([], NewHeaders, StatusCode, _) ->
handle_headers([Header | Headers], NewHeaders, StatusCode, NoESIStatus) ->
{FieldName, FieldValue} = httpd_response:split_header(Header, []),
case FieldName of
- "location" ->
+ "location" when NoESIStatus == true ->
handle_headers(Headers,
[{FieldName, FieldValue} | NewHeaders],
302, NoESIStatus);
diff --git a/lib/inets/src/http_server/httpd_example.erl b/lib/inets/src/http_server/httpd_example.erl
index adbbf64685..47a8c48d01 100644
--- a/lib/inets/src/http_server/httpd_example.erl
+++ b/lib/inets/src/http_server/httpd_example.erl
@@ -91,7 +91,7 @@ yahoo(_Env,_Input) ->
"Location: http://www.yahoo.com\r\n\r\n".
new_status_and_location(_Env,_Input) ->
- "status:201\r\n Location: http://www.yahoo.com\r\n\r\n".
+ "status:201 Created\r\n Location: http://www.yahoo.com\r\n\r\n".
default(Env,Input) ->
[header(),
diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src
index a86413147c..fdf4cc6e07 100644
--- a/lib/inets/src/inets_app/inets.appup.src
+++ b/lib/inets/src/inets_app/inets.appup.src
@@ -18,10 +18,14 @@
%% %CopyrightEnd%
{"%VSN%",
[
+ {<<"6.4.3">>, [{load_module, httpd_esi,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
],
[
+ {<<"6.4.3">>, [{load_module, httpd_esi,
+ soft_purge, soft_purge, []}]},
{<<"6\\..*">>,[{restart_application, inets}]},
{<<"5\\..*">>,[{restart_application, inets}]}
]
diff --git a/lib/inets/test/http_format_SUITE.erl b/lib/inets/test/http_format_SUITE.erl
index 9a13ed3d17..647eff4f7c 100644
--- a/lib/inets/test/http_format_SUITE.erl
+++ b/lib/inets/test/http_format_SUITE.erl
@@ -536,7 +536,10 @@ esi_parse_headers(Config) when is_list(Config) ->
httpd_esi:handle_headers(Headers2),
{ok,[{"location","/foo/bar.html"}], 302} =
- httpd_esi:handle_headers("location:/foo/bar.html\r\n").
+ httpd_esi:handle_headers("location:/foo/bar.html\r\n"),
+
+ {ok,[{"location","http://foo/bar.html"}],201} =
+ httpd_esi:handle_headers("status:201 Created\r\nlocation:http://foo/bar.html\r\n").
%%--------------------------------------------------------------------
cgi_parse_headers() ->
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/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl
index 0c649d9abf..9a85c51d24 100644
--- a/lib/inets/test/httpd_SUITE.erl
+++ b/lib/inets/test/httpd_SUITE.erl
@@ -923,8 +923,11 @@ esi(Config) when is_list(Config) ->
{no_header, "cache-control"}]),
ok = http_status("GET /cgi-bin/erl/httpd_example:peer ",
Config, [{statuscode, 200},
- {header, "peer-cert-exist", peer(Config)}]).
-
+ {header, "peer-cert-exist", peer(Config)}]),
+ ok = http_status("GET /cgi-bin/erl/httpd_example:new_status_and_location ",
+ Config, [{statuscode, 201},
+ {header, "location"}]).
+
%%-------------------------------------------------------------------------
esi_put() ->
[{doc, "Test mod_esi PUT"}].
diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk
index 34b6902747..560d524bac 100644
--- a/lib/inets/vsn.mk
+++ b/lib/inets/vsn.mk
@@ -19,6 +19,6 @@
# %CopyrightEnd%
APPLICATION = inets
-INETS_VSN = 6.4.2
+INETS_VSN = 6.4.4
PRE_VSN =
APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)"
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/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl
index 1afcd155b3..26602bdcda 100644
--- a/lib/kernel/test/zlib_SUITE.erl
+++ b/lib/kernel/test/zlib_SUITE.erl
@@ -166,7 +166,7 @@ api_deflateInit(Config) when is_list(Config) ->
?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)),
?m(ok,zlib:close(Z11)),
?m(ok,zlib:close(Z12))
- end, lists:seq(8, 15)),
+ end, lists:seq(9, 15)),
lists:foreach(fun(MemLevel) ->
Z = zlib:open(),
@@ -213,12 +213,46 @@ api_deflateReset(Config) when is_list(Config) ->
%% Test deflateParams.
api_deflateParams(Config) when is_list(Config) ->
+ Levels = [none, default, best_speed, best_compression] ++ lists:seq(0, 9),
+ Strategies = [filtered, huffman_only, rle, default],
+
Z1 = zlib:open(),
?m(ok, zlib:deflateInit(Z1, default)),
- ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)),
- ?m(ok, zlib:deflateParams(Z1, best_compression, huffman_only)),
- ?m(L when is_list(L), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)),
- ?m(ok, zlib:close(Z1)).
+
+ ApiTest =
+ fun(Level, Strategy) ->
+ ?m(ok, zlib:deflateParams(Z1, Level, Strategy)),
+ ?m(ok, zlib:deflateReset(Z1))
+ end,
+
+ [ ApiTest(Level, Strategy) || Level <- Levels, Strategy <- Strategies ],
+
+ ?m(ok, zlib:close(Z1)),
+
+ FlushTest =
+ fun FlushTest(Size, Level, Strategy) ->
+ Z = zlib:open(),
+ ok = zlib:deflateInit(Z, default),
+ Data = gen_determ_rand_bytes(Size),
+ case zlib:deflate(Z, Data, none) of
+ [<<120, 156>>] ->
+ %% All data is present in the internal zlib state, and will
+ %% be flushed on deflateParams.
+
+ ok = zlib:deflateParams(Z, Level, Strategy),
+ Compressed = [<<120, 156>>, zlib:deflate(Z, <<>>, finish)],
+ Data = zlib:uncompress(Compressed),
+ zlib:close(Z),
+
+ FlushTest(Size + (1 bsl 10), Level, Strategy);
+ _Other ->
+ ok
+ end
+ end,
+
+ [ FlushTest(1, Level, Strategy) || Level <- Levels, Strategy <- Strategies ],
+
+ ok.
%% Test deflate.
api_deflate(Config) when is_list(Config) ->
@@ -652,6 +686,11 @@ api_g_un_zip(Config) when is_list(Config) ->
Concatenated = <<Bin/binary, Bin/binary>>,
?m(Concatenated, zlib:gunzip([Comp, Comp])),
+ %% Don't explode if the uncompressed size is a perfect multiple of the
+ %% internal inflate chunk size.
+ ChunkSizedData = <<0:16384/unit:8>>,
+ ?m(ChunkSizedData, zlib:gunzip(zlib:gzip(ChunkSizedData))),
+
%% Bad CRC; bad length.
BadCrc = bad_crc_data(),
?m(?EXIT(data_error),(catch zlib:gunzip(BadCrc))),
@@ -762,13 +801,13 @@ zip_usage({run,ZIP,ORIG}) ->
?m(ok, zlib:deflateInit(Z, default, deflated, -15, 8, default)),
C2 = zlib:deflate(Z, ORIG, finish),
- ?m(true, C1 == list_to_binary(C2)),
+ ?m(ORIG, zlib:unzip(C2)),
?m(ok, zlib:deflateEnd(Z)),
?m(ok, zlib:deflateInit(Z, none, deflated, -15, 8, filtered)),
?m(ok, zlib:deflateParams(Z, default, default)),
C3 = zlib:deflate(Z, ORIG, finish),
- ?m(true, C1 == list_to_binary(C3)),
+ ?m(ORIG, zlib:unzip(C3)),
?m(ok, zlib:deflateEnd(Z)),
ok = zlib:close(Z),
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/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl
index 55b1d6e419..a2de23a2a3 100644
--- a/lib/mnesia/src/mnesia_log.erl
+++ b/lib/mnesia/src/mnesia_log.erl
@@ -752,8 +752,8 @@ abort_write(B, What, Args, Reason) ->
Opaque = B#backup_args.opaque,
dbg_out("Failed to perform backup. M=~p:F=~tp:A=~tp -> ~tp~n",
[Mod, What, Args, Reason]),
- try apply(Mod, abort_write, [Opaque]) of
- {ok, _Res} -> throw({error, Reason})
+ try {ok, _Res} = apply(Mod, abort_write, [Opaque]) of
+ _ -> throw({error, Reason})
catch _:Other ->
error("Failed to abort backup. ~p:~tp~tp -> ~tp~n",
[Mod, abort_write, [Opaque], Other]),
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/cdv_bin_cb.erl b/lib/observer/src/cdv_bin_cb.erl
index 5502869973..a4a542297c 100644
--- a/lib/observer/src/cdv_bin_cb.erl
+++ b/lib/observer/src/cdv_bin_cb.erl
@@ -71,6 +71,8 @@ hex_binary_fun(Bin) ->
plain_html(io_lib:format("~s",[S]))
end.
+format_hex(<<>>,_) ->
+ [];
format_hex(<<B1:4,B2:4>>,_) ->
[integer_to_list(B1,16),integer_to_list(B2,16)];
format_hex(<<B1:4,B2:4,Bin/binary>>,0) ->
diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl
index ddf2879a97..feaec5c678 100644
--- a/lib/observer/src/crashdump_viewer.erl
+++ b/lib/observer/src/crashdump_viewer.erl
@@ -26,10 +26,25 @@
%% Tables
%% ------
%% cdv_dump_index_table: This table holds all tags read from the
-%% crashdump. Each tag indicates where the information about a
-%% specific item starts. The table entry for a tag includes the start
-%% position for this item-information. In a crash dump file, all tags
-%% start with a "=" at the beginning of a line.
+%% crashdump, except the 'binary' tag. Each tag indicates where the
+%% information about a specific item starts. The table entry for a
+%% tag includes the start position for this item-information. In a
+%% crash dump file, all tags start with a "=" at the beginning of a
+%% line.
+%%
+%% cdv_binary_index_table: This table holds all 'binary' tags. The hex
+%% address for each binary is converted to its integer value before
+%% storing Address -> Start Position in this table. The hex value of
+%% the address is never used for lookup.
+%%
+%% cdv_reg_proc_table: This table holds mappings between pid and
+%% registered name. This is used for timers and monitors.
+%%
+%% cdv_heap_file_chars: For each 'proc_heap' and 'literals' tag, this
+%% table contains the number of characters to read from the crash dump
+%% file. This is used for giving an indication in percent of the
+%% progress when parsing this data.
+%%
%%
%% Process state
%% -------------
@@ -73,6 +88,9 @@
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
terminate/2, code_change/3]).
+%% Test support
+-export([get_dump_versions/0]).
+
%% Debug support
-export([debug/1,stop_debug/0]).
@@ -87,7 +105,10 @@
% line_head/1 function can return
-define(not_available,"N/A").
-define(binary_size_progress_limit,10000).
+-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).
@@ -126,6 +147,7 @@
-record(state,{file,dump_vsn,wordsize=4,num_atoms="unknown"}).
+-record(dec_opts, {bin_addr_adj=0,base64=true}).
%%%-----------------------------------------------------------------
%%% Debugging
@@ -294,6 +316,11 @@ port(Id) ->
expand_binary(Pos) ->
call({expand_binary,Pos}).
+%%%-----------------------------------------------------------------
+%%% For testing only - called from crashdump_viewer_SUITE
+get_dump_versions() ->
+ call(get_dump_versions).
+
%%====================================================================
%% Server functions
%%====================================================================
@@ -343,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}) ->
@@ -419,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]),
@@ -455,8 +486,9 @@ handle_call(index_tables,_From,State=#state{file=File}) ->
handle_call(schedulers,_From,State=#state{file=File}) ->
Schedulers=schedulers(File),
TW = truncated_warning([?scheduler]),
- {reply,{ok,Schedulers,TW},State}.
-
+ {reply,{ok,Schedulers,TW},State};
+handle_call(get_dump_versions,_From,State=#state{dump_vsn=DumpVsn}) ->
+ {reply,{ok,{?max_dump_version,DumpVsn}},State}.
%%--------------------------------------------------------------------
@@ -781,10 +813,8 @@ parse_vsn_str(Str,WS) ->
%%%-----------------------------------------------------------------
-%%% Traverse crash dump and insert index in table for each heading
-%%%
-%%% Progress is reported during the time and MUST be checked with
-%%% crashdump_viewer:get_progress/0 until it returns {ok,done}.
+%%% Traverse crash dump and insert index in table for each heading.
+%%% Progress is reported during the time.
do_read_file(File) ->
erase(?literals), %Clear literal cache.
put(truncated,false), %Not truncated (yet).
@@ -800,17 +830,21 @@ do_read_file(File) ->
{Tag,Id,Rest,N1} = tag(Fd,TagAndRest,1),
case Tag of
?erl_crash_dump ->
- reset_tables(),
- insert_index(Tag,Id,N1+1),
- put_last_tag(Tag,""),
- DumpVsn = [list_to_integer(L) ||
- L<-string:tokens(Id,".")],
- AddrAdj = get_bin_addr_adj(DumpVsn),
- indexify(Fd,AddrAdj,Rest,N1),
- end_progress(),
- check_if_truncated(),
- close(Fd),
- {ok,DumpVsn};
+ case check_dump_version(Id) of
+ {ok,DumpVsn} ->
+ reset_tables(),
+ insert_index(Tag,Id,N1+1),
+ put_last_tag(Tag,""),
+ DecodeOpts = get_decode_opts(DumpVsn),
+ indexify(Fd,DecodeOpts,Rest,N1),
+ end_progress(),
+ check_if_truncated(),
+ close(Fd),
+ {ok,DumpVsn};
+ Error ->
+ close(Fd),
+ Error
+ end;
_Other ->
R = io_lib:format(
"~ts is not an Erlang crash dump~n",
@@ -838,7 +872,19 @@ do_read_file(File) ->
{error,R}
end.
-indexify(Fd,AddrAdj,Bin,N) ->
+check_dump_version(Vsn) ->
+ DumpVsn = [list_to_integer(L) || L<-string:tokens(Vsn,".")],
+ if DumpVsn > ?max_dump_version ->
+ Info =
+ "This Crashdump Viewer is too old for the given "
+ "Erlang crash dump. Please use a newer version of "
+ "Crashdump Viewer.",
+ {error,Info};
+ true ->
+ {ok,DumpVsn}
+ end.
+
+indexify(Fd,DecodeOpts,Bin,N) ->
case binary:match(Bin,<<"\n=">>) of
{Start,Len} ->
Pos = Start+Len,
@@ -851,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)
@@ -875,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) ->
@@ -886,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
@@ -1083,7 +1129,7 @@ get_proc_details(File,Pid,WS,DumpVsn) ->
{{Stack,MsgQ,Dict},TW} =
case truncated_warning([{?proc,Pid}]) of
[] ->
- {expand_memory(Fd,Pid,DumpVsn),[]};
+ expand_memory(Fd,Pid,DumpVsn);
TW0 ->
{{[],[],[]},TW0}
end,
@@ -1402,70 +1448,85 @@ 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),
- Expanded.
-
-read_literals(Fd) ->
+ IncompleteWarning =
+ case erase(incomplete_heap) of
+ undefined ->
+ [];
+ true ->
+ ["WARNING: This process has an incomplete heap. "
+ "Some information might be missing."]
+ end,
+ {Expanded,IncompleteWarning}.
+
+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}.
@@ -1473,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}.
@@ -1501,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.
@@ -1528,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 ->
@@ -1553,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.
@@ -1880,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.
@@ -1943,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
@@ -2552,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) ->
@@ -2679,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.
@@ -2698,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
@@ -2735,26 +2782,55 @@ 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 ->
case get(fd) of
end_of_heap ->
+ put(incomplete_heap,true),
{['#CDVIncompleteHeap'],Line,D0};
Fd ->
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.
@@ -2817,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/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl
index a85808a472..22b4714d63 100644
--- a/lib/observer/src/observer_html_lib.erl
+++ b/lib/observer/src/observer_html_lib.erl
@@ -355,11 +355,11 @@ href_proc_bin(From, T, Acc, LTB) ->
PreviewStr
end
end;
- [PreviewIntStr,SizeStr,Md5] when From =:= obs ->
+ [PreviewIntStr,PreviewBitSizeStr,SizeStr,Md5] when From =:= obs ->
Size = list_to_integer(SizeStr),
PreviewInt = list_to_integer(PreviewIntStr),
- PrevSize = (trunc(math:log2(PreviewInt)/8)+1)*8,
- PreviewStr = preview_string(Size,<<PreviewInt:PrevSize>>),
+ PreviewBitSize = list_to_integer(PreviewBitSizeStr),
+ PreviewStr = preview_string(Size,<<PreviewInt:PreviewBitSize>>),
if LTB ->
href("TARGET=\"expanded\"",
["#OBSBinary?key1="++PreviewIntStr++
diff --git a/lib/observer/src/observer_lib.erl b/lib/observer/src/observer_lib.erl
index 29f4f9fabc..94d199e688 100644
--- a/lib/observer/src/observer_lib.erl
+++ b/lib/observer/src/observer_lib.erl
@@ -810,7 +810,7 @@ progress_dialog_destroy({Dialog,_,_}) ->
make_obsbin(Bin,Tab) ->
Size = byte_size(Bin),
- Preview =
+ {Preview,PreviewBitSize} =
try
%% The binary might be a unicode string, in which case we
%% don't want to split it in the middle of a grapheme
@@ -819,14 +819,14 @@ make_obsbin(Bin,Tab) ->
PB1 = string:slice(Bin,0,PL1),
PS1 = byte_size(PB1) * 8,
<<P1:PS1>> = PB1,
- P1
+ {P1,PS1}
catch _:_ ->
%% Probably not a string, so just split anywhere
PS2 = min(Size, 10) * 8,
<<P2:PS2, _/binary>> = Bin,
- P2
+ {P2,PS2}
end,
Hash = erlang:phash2(Bin),
Key = {Preview, Size, Hash},
ets:insert(Tab, {Key,Bin}),
- ['#OBSBin',Preview,Size,Hash].
+ ['#OBSBin',Preview,PreviewBitSize,Size,Hash].
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 86a60e15f4..9fbd1a62a4 100644
--- a/lib/observer/test/crashdump_viewer_SUITE.erl
+++ b/lib/observer/test/crashdump_viewer_SUITE.erl
@@ -25,7 +25,7 @@
%% Test functions
-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2,
start_stop/1,load_file/1,not_found_items/1,
- non_existing/1,not_a_crashdump/1,old_crashdump/1]).
+ non_existing/1,not_a_crashdump/1,old_crashdump/1,new_crashdump/1]).
-export([init_per_suite/1, end_per_suite/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
@@ -83,6 +83,7 @@ all() ->
non_existing,
not_a_crashdump,
old_crashdump,
+ new_crashdump,
load_file,
not_found_items
].
@@ -212,6 +213,25 @@ not_a_crashdump(Config) when is_list(Config) ->
ok = crashdump_viewer:stop().
+%% Try to load a file with newer version than this crashdump viewer can handle
+new_crashdump(Config) ->
+ Dump = hd(?config(dumps,Config)),
+ ok = start_backend(Dump),
+ {ok,{MaxVsn,CurrentVsn}} = crashdump_viewer:get_dump_versions(),
+ if MaxVsn =/= CurrentVsn ->
+ ct:fail("Current dump version is not equal to cdv's max version");
+ true ->
+ ok
+ end,
+ ok = crashdump_viewer:stop(),
+ NewerVsn = lists:join($.,[integer_to_list(X+1) || X <- MaxVsn]),
+ PrivDir = ?config(priv_dir,Config),
+ NewDump = filename:join(PrivDir,"new_erl_crash.dump"),
+ ok = file:write_file(NewDump,"=erl_crash_dump:"++NewerVsn++"\n"),
+ {error, Reason} = start_backend(NewDump),
+ "This Crashdump Viewer is too old" ++_ = Reason,
+ ok = crashdump_viewer:stop().
+
%% Load files into the tool and view all pages
load_file(Config) when is_list(Config) ->
case ?t:is_debug() of
@@ -328,7 +348,7 @@ browse_file(File) ->
io:format(" info read",[]),
- lookat_all_pids(Procs),
+ lookat_all_pids(Procs,is_truncated(File),incomplete_allowed(File)),
io:format(" pids ok",[]),
lookat_all_ports(Ports),
io:format(" ports ok",[]),
@@ -339,6 +359,21 @@ browse_file(File) ->
Procs. % used as second arg to special/2
+is_truncated(File) ->
+ case filename:extension(File) of
+ ".trunc"++_ ->
+ true;
+ _ ->
+ false
+ end.
+
+incomplete_allowed(File) ->
+ %% Incomplete heap is allowed for native libs, since some literals
+ %% are not dumped - and for pre OTP-20 (really pre 20.2) releases,
+ %% since literals were not dumped at all then.
+ Rel = get_rel_from_dump_name(File),
+ Rel < 20 orelse test_server:is_native(lists).
+
special(File,Procs) ->
case filename:extension(File) of
".full_dist" ->
@@ -368,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,
@@ -426,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,
@@ -528,7 +569,7 @@ special(File,Procs) ->
io:format(" process details ok",[]),
#proc{dict=Dict} = ProcDetails,
- io:format("~p\n", [Dict]),
+ %% io:format("~p\n", [Dict]),
Maps = crashdump_helper:create_maps(),
Maps = proplists:get_value(maps,Dict),
io:format(" maps ok",[]),
@@ -548,14 +589,25 @@ verify_binaries([Bin|T1], [['#CDVBin',Offset,Size,Pos]|T2]) ->
verify_binaries([], []) ->
ok.
-lookat_all_pids([]) ->
+lookat_all_pids([],_,_) ->
ok;
-lookat_all_pids([#proc{pid=Pid0}|Procs]) ->
+lookat_all_pids([#proc{pid=Pid0}|Procs],TruncAllowed,IncompAllowed) ->
Pid = pid_to_list(Pid0),
- {ok,_ProcDetails=#proc{},_ProcTW} = crashdump_viewer:proc_details(Pid),
- {ok,_Ets,_EtsTW} = crashdump_viewer:ets_tables(Pid),
- {ok,_Timers,_TimersTW} = crashdump_viewer:timers(Pid),
- lookat_all_pids(Procs).
+ {ok,_ProcDetails=#proc{},ProcTW} = crashdump_viewer:proc_details(Pid),
+ {ok,_Ets,EtsTW} = crashdump_viewer:ets_tables(Pid),
+ {ok,_Timers,TimersTW} = crashdump_viewer:timers(Pid),
+ case {ProcTW,EtsTW,TimersTW} of
+ {[],[],[]} ->
+ ok;
+ {["WARNING: This process has an incomplete heap."++_],[],[]}
+ when IncompAllowed ->
+ ok; % native libs, literals might not be included in dump
+ _ when TruncAllowed ->
+ ok; % truncated dump
+ TWs ->
+ ct:fail({unexpected_warning,TWs})
+ end,
+ lookat_all_pids(Procs,TruncAllowed,IncompAllowed).
lookat_all_ports([]) ->
ok;
@@ -603,13 +655,7 @@ do_create_dumps(DataDir,Rel) ->
current ->
CD3 = dump_with_args(DataDir,Rel,"instr","+Mim true"),
CD4 = dump_with_strange_module_name(DataDir,Rel,"strangemodname"),
- Tmp = dump_with_args(DataDir,Rel,"trunc_bytes",""),
- {ok,#file_info{size=Max}} = file:read_file_info(Tmp),
- ok = file:delete(Tmp),
- Bytes = max(15,rand:uniform(Max)),
- CD5 = dump_with_args(DataDir,Rel,"trunc_bytes",
- "-env ERL_CRASH_DUMP_BYTES " ++
- integer_to_list(Bytes)),
+ CD5 = dump_with_size_limit_reached(DataDir,Rel,"trunc_bytes"),
CD6 = dump_with_unicode_atoms(DataDir,Rel,"unicode"),
CD7 = dump_with_maps(DataDir,Rel,"maps"),
TruncatedDumps = truncate_dump(CD1),
@@ -628,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),
@@ -722,6 +768,28 @@ dump_with_strange_module_name(DataDir,Rel,DumpName) ->
?t:stop_node(n1),
CD.
+dump_with_size_limit_reached(DataDir,Rel,DumpName) ->
+ Tmp = dump_with_args(DataDir,Rel,DumpName,""),
+ {ok,#file_info{size=Max}} = file:read_file_info(Tmp),
+ ok = file:delete(Tmp),
+ dump_with_size_limit_reached(DataDir,Rel,DumpName,Max).
+
+dump_with_size_limit_reached(DataDir,Rel,DumpName,Max) ->
+ Bytes = max(15,rand:uniform(Max)),
+ CD = dump_with_args(DataDir,Rel,DumpName,
+ "-env ERL_CRASH_DUMP_BYTES " ++
+ integer_to_list(Bytes)),
+ {ok,#file_info{size=Size}} = file:read_file_info(CD),
+ if Size < Bytes ->
+ %% This means that the dump was actually smaller than the
+ %% randomly selected truncation size, so we'll just do it
+ %% again with a smaller numer
+ ok = file:delete(CD),
+ dump_with_size_limit_reached(DataDir,Rel,DumpName,Size-3);
+ true ->
+ CD
+ end.
+
dump_with_unicode_atoms(DataDir,Rel,DumpName) ->
Opt = rel_opt(Rel),
Pz = "-pz \"" ++ filename:dirname(code:which(?MODULE)) ++ "\"",
@@ -794,6 +862,11 @@ dump_prefix(current) ->
dump_prefix(Rel) ->
lists:concat(["r",Rel,"_dump."]).
+get_rel_from_dump_name(File) ->
+ Name = filename:basename(File),
+ ["r"++Rel|_] = string:split(Name,"_"),
+ list_to_integer(Rel).
+
compat_rel(current) ->
"";
compat_rel(Rel) ->
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/snmp/test/snmp_to_snmpnet_SUITE.erl b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl
index 24c14d86ea..6a3466b6e4 100644
--- a/lib/snmp/test/snmp_to_snmpnet_SUITE.erl
+++ b/lib/snmp/test/snmp_to_snmpnet_SUITE.erl
@@ -88,8 +88,17 @@ groups() ->
].
init_per_suite(Config) ->
- [{agent_port, ?AGENT_PORT}, {manager_port, ?MANAGER_PORT} | Config].
-
+ case re:run(os:cmd("snmpd -v"),"NET-SNMP", [{capture, first}]) of
+ nomatch ->
+ {skip, "snmpd is NOT NET-SNMP"};
+ {match, _} ->
+ case re:run(os:cmd("snmpd -v"),"5.4|5.6.2.1", [{capture, first}]) of
+ nomatch ->
+ [{agent_port, ?AGENT_PORT}, {manager_port, ?MANAGER_PORT} | Config];
+ {match, _} ->
+ {skip, "buggy snmpd"}
+ end
+ end.
end_per_suite(_Config) ->
ok.
@@ -322,7 +331,7 @@ snmpget(Oid, Transport, Config) ->
Args =
["-c", "public", net_snmp_version(Versions),
- "-m", "",
+ "-m", ":",
"-Cf",
net_snmp_addr_str(Transport),
oid_str(Oid)],
@@ -353,11 +362,13 @@ start_snmpd(Community, SysDescr, Config) ->
["--rocommunity"++domain_suffix(Domain)++"="
++Community++" "++inet_parse:ntoa(Ip)
|| {Domain, {Ip, _}} <- Targets],
+
SnmpdArgs =
- ["-f", "-r", %"-Dverbose",
- "-c", filename:join(DataDir, "snmpd.conf"),
- "-C", "-Lo",
- "-m", "",
+ ["-f", "-r", %"-Dverbose",
+ "-c", filename:join(DataDir, "snmpd.conf"),
+ "-C",
+ "-Lo",
+ "-m", ":",
"--sysDescr="++SysDescr,
"--agentXSocket=tcp:localhost:"++integer_to_list(Port)]
++ CommunityArgs
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/doc/src/ssh_client_key_api.xml b/lib/ssh/doc/src/ssh_client_key_api.xml
index a1cd9d4b02..98a1676ca4 100644
--- a/lib/ssh/doc/src/ssh_client_key_api.xml
+++ b/lib/ssh/doc/src/ssh_client_key_api.xml
@@ -56,11 +56,17 @@
<tag><c>string() =</c></tag>
<item><p><c>[byte()]</c></p></item>
<tag><c>public_key() =</c></tag>
- <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item>
+ <item><p><c>#'RSAPublicKey'{}
+ | {integer(),#'Dss-Parms'{}}
+ | {#'ECPoint'{},{namedCurve,Curve::string()}}</c></p></item>
<tag><c>private_key() =</c></tag>
- <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item>
+ <item><p><c>#'RSAPrivateKey'{}
+ | #'DSAPrivateKey'{}
+ | #'ECPrivateKey'{}</c></p></item>
<tag><c>public_key_algorithm() =</c></tag>
- <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item>
+ <item><p><c>'ssh-rsa' | 'ssh-dss'
+ | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512'
+ | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item>
</taglist>
</section>
@@ -73,10 +79,11 @@
<d>Description of the host that owns the <c>PublicKey</c>.</d>
<v>Key = public_key()</v>
- <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d>
+ <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d>
<v>ConnectOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d>
+ <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
+ the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
<v>Reason = term().</v>
</type>
<desc>
@@ -89,17 +96,17 @@
<fsummary>Checks if a host key is trusted.</fsummary>
<type>
<v>Key = public_key() </v>
- <d>Normally an RSA or DSA public key, but handling of other public keys can be added.</d>
+ <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added.</d>
<v>Host = string()</v>
<d>Description of the host.</d>
<v>Algorithm = public_key_algorithm()</v>
- <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c>, but more algorithms
- can be handled.</d>
+ <d>Host key algorithm.</d>
<v>ConnectOptions = proplists:proplist() </v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>.</d>
+ <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
+ the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
<v>Result = boolean()</v>
</type>
@@ -110,15 +117,15 @@
<func>
<name>Module:user_key(Algorithm, ConnectOptions) ->
- {ok, PrivateKey} | {error, Reason}</name>
+ {ok, PrivateKey} | {error, Reason}</name>
<fsummary>Fetches the users <em>public key</em> matching the <c>Algorithm</c>.</fsummary>
<type>
<v>Algorithm = public_key_algorithm()</v>
- <d>Host key algorithm. Is to support <c>'ssh-rsa'| 'ssh-dss'</c> but more algorithms
- can be handled.</d>
+ <d>Host key algorithm.</d>
<v>ConnectOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso></d>
+ <d>Options provided to <seealso marker="ssh#connect-3">ssh:connect/[3,4]</seealso>. The option list given in
+ the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
<v>PrivateKey = private_key()</v>
<d>Private key of the user matching the <c>Algorithm</c>.</d>
diff --git a/lib/ssh/doc/src/ssh_server_key_api.xml b/lib/ssh/doc/src/ssh_server_key_api.xml
index a0694ca8d9..c6808b95d1 100644
--- a/lib/ssh/doc/src/ssh_server_key_api.xml
+++ b/lib/ssh/doc/src/ssh_server_key_api.xml
@@ -57,11 +57,17 @@
<tag><c>string() =</c></tag>
<item><p><c>[byte()]</c></p></item>
<tag><c>public_key() =</c></tag>
- <item><p><c>#'RSAPublicKey'{}| {integer(), #'Dss-Parms'{}}| term()</c></p></item>
+ <item><p><c>#'RSAPublicKey'{}
+ | {integer(),#'Dss-Parms'{}}
+ | {#'ECPoint'{},{namedCurve,Curve::string()}}</c></p></item>
<tag><c>private_key() =</c></tag>
- <item><p><c>#'RSAPrivateKey'{} | #'DSAPrivateKey'{} | term()</c></p></item>
+ <item><p><c>#'RSAPrivateKey'{}
+ | #'DSAPrivateKey'{}
+ | #'ECPrivateKey'{}</c></p></item>
<tag><c>public_key_algorithm() =</c></tag>
- <item><p><c>'ssh-rsa'| 'ssh-dss' | atom()</c></p></item>
+ <item><p><c>'ssh-rsa' | 'ssh-dss'
+ | 'rsa-sha2-256' | 'rsa-sha2-384' | 'rsa-sha2-512'
+ | 'ecdsa-sha2-nistp256' | 'ecdsa-sha2-nistp384' | 'ecdsa-sha2-nistp521' </c></p></item>
</taglist>
</section>
@@ -72,12 +78,13 @@
<fsummary>Fetches the host’s private key.</fsummary>
<type>
<v>Algorithm = public_key_algorithm()</v>
- <d>Host key algorithm. Is to support <c>'ssh-rsa' | 'ssh-dss'</c>, but more algorithms
- can be handled.</d>
+ <d>Host key algorithm.</d>
<v>DaemonOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d>
- <v>Key = private_key()</v>
- <d>Private key of the host matching the <c>Algorithm</c>.</d>
+ <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in
+ the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
+ <v>Key = private_key() | crypto:engine_key_ref()</v>
+ <d>Private key of the host matching the <c>Algorithm</c>.
+ It may be a reference to a 'ssh-rsa', rsa-sha2-* or 'ssh-dss' (NOT ecdsa) key stored in a loaded Engine.</d>
<v>Reason = term()</v>
</type>
<desc>
@@ -90,11 +97,12 @@
<fsummary>Checks if the user key is authorized.</fsummary>
<type>
<v>Key = public_key()</v>
- <d>Normally an RSA or DSA public key, but handling of other public keys can be added</d>
+ <d>Normally an RSA, DSA or ECDSA public key, but handling of other public keys can be added</d>
<v>User = string()</v>
<d>User owning the public key.</d>
<v>DaemonOptions = proplists:proplist()</v>
- <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>.</d>
+ <d>Options provided to <seealso marker="ssh#daemon-2">ssh:daemon/[2,3]</seealso>. The option list given in
+ the <c>key_cb</c> option is available with the key <c>key_cb_private</c>.</d>
<v>Result = boolean()</v>
</type>
<desc>
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 d8f7a96c15..90a94a7e86 100644
--- a/lib/ssh/src/ssh_transport.erl
+++ b/lib/ssh/src/ssh_transport.erl
@@ -811,7 +811,15 @@ extract_public_key(#'DSAPrivateKey'{y = Y, p = P, q = Q, g = G}) ->
{Y, #'Dss-Parms'{p=P, q=Q, g=G}};
extract_public_key(#'ECPrivateKey'{parameters = {namedCurve,OID},
publicKey = Q}) ->
- {#'ECPoint'{point=Q}, {namedCurve,OID}}.
+ {#'ECPoint'{point=Q}, {namedCurve,OID}};
+extract_public_key(#{engine:=_, key_id:=_, algorithm:=Alg} = M) ->
+ case {Alg, crypto:privkey_to_pubkey(Alg, M)} of
+ {rsa, [E,N]} ->
+ #'RSAPublicKey'{modulus = N, publicExponent = E};
+ {dss, [P,Q,G,Y]} ->
+ {Y, #'Dss-Parms'{p=P, q=Q, g=G}}
+ end.
+
verify_host_key(#ssh{algorithms=Alg}=SSH, PublicKey, Digest, {AlgStr,Signature}) ->
@@ -1261,10 +1269,12 @@ payload(<<PacketLen:32, PaddingLen:8, PayloadAndPadding/binary>>) ->
<<Payload:PayloadLen/binary, _/binary>> = PayloadAndPadding,
Payload.
+sign(SigData, HashAlg, #{algorithm:=dss} = Key) ->
+ mk_dss_sig(crypto:sign(dss, HashAlg, SigData, Key));
+sign(SigData, HashAlg, #{algorithm:=SigAlg} = Key) ->
+ crypto:sign(SigAlg, HashAlg, SigData, Key);
sign(SigData, HashAlg, #'DSAPrivateKey'{} = Key) ->
- DerSignature = public_key:sign(SigData, HashAlg, Key),
- #'Dss-Sig-Value'{r = R, s = S} = public_key:der_decode('Dss-Sig-Value', DerSignature),
- <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>;
+ mk_dss_sig(public_key:sign(SigData, HashAlg, Key));
sign(SigData, HashAlg, Key = #'ECPrivateKey'{}) ->
DerEncodedSign = public_key:sign(SigData, HashAlg, Key),
#'ECDSA-Sig-Value'{r=R, s=S} = public_key:der_decode('ECDSA-Sig-Value', DerEncodedSign),
@@ -1272,6 +1282,12 @@ sign(SigData, HashAlg, Key = #'ECPrivateKey'{}) ->
sign(SigData, HashAlg, Key) ->
public_key:sign(SigData, HashAlg, Key).
+
+mk_dss_sig(DerSignature) ->
+ #'Dss-Sig-Value'{r = R, s = S} = public_key:der_decode('Dss-Sig-Value', DerSignature),
+ <<R:160/big-unsigned-integer, S:160/big-unsigned-integer>>.
+
+
verify(PlainText, HashAlg, Sig, {_, #'Dss-Parms'{}} = Key) ->
case Sig of
<<R:160/big-unsigned-integer, S:160/big-unsigned-integer>> ->
@@ -1823,6 +1839,8 @@ kex_alg_dependent({Min, NBits, Max, Prime, Gen, E, F, K}) ->
%%%----------------------------------------------------------------
+valid_key_sha_alg(#{engine:=_, key_id:=_}, _Alg) -> true; % Engine key
+
valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-512') -> true;
valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-384') -> true;
valid_key_sha_alg(#'RSAPublicKey'{}, 'rsa-sha2-256') -> true;
@@ -2009,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/Makefile b/lib/ssh/test/Makefile
index 5ea048a352..a18383d148 100644
--- a/lib/ssh/test/Makefile
+++ b/lib/ssh/test/Makefile
@@ -38,6 +38,7 @@ MODULES= \
ssh_basic_SUITE \
ssh_bench_SUITE \
ssh_connection_SUITE \
+ ssh_engine_SUITE \
ssh_protocol_SUITE \
ssh_property_test_SUITE \
ssh_sftp_SUITE \
@@ -49,6 +50,7 @@ MODULES= \
ssh_test_lib \
ssh_key_cb \
ssh_key_cb_options \
+ ssh_key_cb_engine_keys \
ssh_trpt_test_lib \
ssh_echo_server \
ssh_bench_dev_null \
diff --git a/lib/ssh/test/ssh_engine_SUITE.erl b/lib/ssh/test/ssh_engine_SUITE.erl
new file mode 100644
index 0000000000..daf93891e9
--- /dev/null
+++ b/lib/ssh/test/ssh_engine_SUITE.erl
@@ -0,0 +1,140 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2008-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(ssh_engine_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+-include("ssh_test_lib.hrl").
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{seconds,40}}].
+
+all() ->
+ [{group, dsa_key},
+ {group, rsa_key}
+ ].
+
+groups() ->
+ [{dsa_key, [], basic_tests()},
+ {rsa_key, [], basic_tests()}
+ ].
+
+basic_tests() ->
+ [simple_connect
+ ].
+
+
+%%--------------------------------------------------------------------
+init_per_suite(Config) ->
+ ssh:start(),
+ ?CHECK_CRYPTO(
+ case load_engine() of
+ {ok,E} ->
+ [{engine,E}|Config];
+ {error, notsup} ->
+ {skip, "Engine not supported on this OpenSSL version"};
+ {error, bad_engine_id} ->
+ {skip, "Dynamic Engine not supported"};
+ Other ->
+ ct:log("Engine load failed: ~p",[Other]),
+ {fail, "Engine load failed"}
+ end
+ ).
+
+end_per_suite(Config) ->
+ catch crypto:engine_unload( proplists:get_value(engine,Config) ),
+ ssh:stop().
+
+%%--------------------------------------------------------------------
+init_per_group(dsa_key, Config) ->
+ case lists:member('ssh-dss',
+ ssh_transport:default_algorithms(public_key)) of
+ true ->
+ start_daemon(Config, 'ssh-dss', "dsa_private_key.pem");
+ false ->
+ {skip, unsupported_pub_key}
+ end;
+init_per_group(rsa_key, Config) ->
+ case lists:member('ssh-rsa',
+ ssh_transport:default_algorithms(public_key)) of
+ true ->
+ start_daemon(Config, 'ssh-rsa', "rsa_private_key.pem");
+ false ->
+ {skip, unsupported_pub_key}
+ end.
+
+start_daemon(Config, KeyType, KeyId) ->
+ SystemDir = proplists:get_value(data_dir, Config),
+ FullKeyId = filename:join(SystemDir, KeyId),
+ KeyCBOpts = [{engine, proplists:get_value(engine,Config)},
+ {KeyType, FullKeyId}
+ ],
+ Opts = [{key_cb, {ssh_key_cb_engine_keys, KeyCBOpts}}],
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts),
+ [{host_port,{Host,Port}}, {daemon_pid,Pid}| Config].
+
+
+end_per_group(_, Config) ->
+ catch ssh:stop_daemon(proplists:get_value(daemon_pid,Config)),
+ Config.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+%% A simple exec call
+simple_connect(Config) ->
+ {Host,Port} = proplists:get_value(host_port, Config),
+ CRef = ssh_test_lib:std_connect(Config, Host, Port, []),
+ ssh:close(CRef).
+
+%%--------------------------------------------------------------------
+%%--------------------------------------------------------------------
+load_engine() ->
+ case crypto:get_test_engine() of
+ {ok, Engine} ->
+ try crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, Engine},
+ <<"LOAD">>],
+ [])
+ catch
+ error:notsup ->
+ {error, notsup}
+ end;
+
+ {error, Error} ->
+ {error, Error}
+ end.
+
+start_std_daemon(Opts, Config) ->
+ ct:log("starting std_daemon",[]),
+ {Pid, Host, Port} = ssh_test_lib:std_daemon(Config, Opts),
+ ct:log("started ~p:~p ~p",[Host,Port,Opts]),
+ [{srvr_pid,Pid},{srvr_addr,{Host,Port}} | Config].
diff --git a/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem
new file mode 100644
index 0000000000..778ffac675
--- /dev/null
+++ b/lib/ssh/test/ssh_engine_SUITE_data/dsa_private_key.pem
@@ -0,0 +1,9 @@
+-----BEGIN PRIVATE KEY-----
+MIIBSwIBADCCASwGByqGSM44BAEwggEfAoGBAMyitTMR7vPbpqyAXJpqnB0AhFwQ
+F87IE+JKFl5bD/MSkhhRV5sM73HUU1ooXY0FjhZ+cdLUCATuZR5ta4ydANqWIcAB
+gX3IwF1B4zf5SXEKTWkUYneL9dOKtiZLtoG28swrk8xMxwX+0fLHkltCEj6FiTW9
+PFrv8GmIfV6DjcI9AhUAqXWbb3RtoN9Ld28fVMhGZrj3LJUCgYEAwnxGHGBMpJaF
+2w7zAw3jHjL8PMYlV6vnufGHQlwF0ZUXJxRsvagMb/X1qACTu2VPYEVoLQGM3cfH
+EhHoQmvSXGAyTfR7Bmn3gf1n/s/DcFbdZduUCZ/rAyIrfd0eSbc1I+kZk85UCsKK
+w/IYdlqcuYa4Cgm2TapT5uEMqH4jhzEEFgIULh8swEUWmU8aJNWsrWl4eCiuUUg=
+-----END PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem
new file mode 100644
index 0000000000..a45522064f
--- /dev/null
+++ b/lib/ssh/test/ssh_engine_SUITE_data/ecdsa_private_key.pem
@@ -0,0 +1,8 @@
+-----BEGIN PRIVATE KEY-----
+MIHuAgEAMBAGByqGSM49AgEGBSuBBAAjBIHWMIHTAgEBBEIBparGjr0KcdNrVM2J
+G0mW5ltP1QyvxDqBMyWLWo3fruRZv6Qoohl5skd1u4O+KJoM/UrrSTOXI/MDR7NN
+i1yl7O+hgYkDgYYABAG8K2XVsK0ahG9+HIIPwCO0pJY8ulwSTXwIjkCGyB2lpglh
+8qJmRzuyGcfRTslv8wfv0sPlT9H9PKDvgrTUL7rvQQDdOODNgVPXSecUoXoPn+X+
+eqxs77bjx+A5x0t/i3m5PfkaNPh5MZ1H/bWuOOdj2ZXZw0R4rlVc0zVrgnPU8L8S
+BQ==
+-----END PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem
new file mode 100644
index 0000000000..ea0e3d3958
--- /dev/null
+++ b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key.pem
@@ -0,0 +1,28 @@
+-----BEGIN PRIVATE KEY-----
+MIIEvwIBADANBgkqhkiG9w0BAQEFAASCBKkwggSlAgEAAoIBAQCwwb0/ddXGXTFK
+4FLxXdV6a/WJMSoPPS55RvZIAHFsiTtvPLbJ8LxDsZ6wSVZLN0/UQ4wdWn9jftyj
+U5/IxBVG8XOtKimTMvm3/ZOzVLueGHBbrLYscRv9oL85ulTKHWgrZDu0lBX5JJTI
+v5UTCErzJRQbka9DG1GaBgDb1PlXfkzBWMwfsBZmwoC77KvCcIGCgbW/XCY03TP2
+3Tg8drvpByMStddP2FQ4fZ91qFUzPu8uhZEsqSQTFlmhgGEx7dLlky0xvu62RuAD
+RTpINpcWZtWDHTdssOqu653LwwqBY8lBopCZ/4Af8QR3ZYkQhen1YLEbVheXRuzI
+LSCZIiJNAgMBAAECggEBAJH4/fxpqQkvr2Shy33Pu1xlyhnpw01gfn/jrcKasxEq
+aC4eWup86E2TY3U8q4pkfIXU3uLi+O9HNpmflwargNLc1mY8uqb44ygiv5bLNEKE
+9k2PXcdoBfC4jxPyoNFl5cBn/7LK1TazEjiTl15na9ZPWcLG1pG5/vMPYCgsQ1sP
+8J3c4E3aaXIj9QceYxBprl490OCzieGyZlRipncz3g4UShRc/b4cycvDZOJpmAy4
+zbWTcBcSMPVPi5coF0K8UcimiqZkotfb/2RLc433i34IdsIXMM+brdq+g8rmjg5a
++oQPy02M6tFApBruEhAz8DGgaLtDY6MLtyZAt3SjXnUCgYEA1zLgamdTHOqrrmIi
+eIQBnAJiyIfcY8B9SX1OsLGYFCHiPVwgUY35B2c7MavMsGcExJhtE+uxU7o5djtM
+R6r9cRHOXJ6EQwa8OwzzPqbM17/YqNDeK39bc9WOFUqRWrhDhVMPy6z8rmZr73mG
+IUC7mBNx/1GBdVYXIlsXzC96dI8CgYEA0kUAhz6I5nyPa70NDEUYHLHf3IW1BCmE
+UoVbraSePJtIEY/IqFx7oDuFo30d4n5z+8ICCtyid1h/Cp3mf3akOiqltYUfgV1G
+JgcEjKKYWEnO7cfFyO7LB7Y3GYYDJNy6EzVWPiwTGk9ZTfFJEESmHC45Unxgd17m
+Dx/R58rFgWMCgYBQXQWFdtSI5fH7C1bIHrPjKNju/h2FeurOuObcAVZDnmu4cmD3
+U8d9xkVKxVeJQM99A1coq0nrdI3k4zwXP3mp8fZYjDHkPe2pN6rW6L9yiohEcsuk
+/siON1/5/4DMmidM8LnjW9R45HLGWWGHpX7oyco2iJ+Jy/6Tq+T1MX3PbQKBgQCm
+hdsbQJ0u3CrBSmFQ/E9SOlRt0r4+45pVuCOY6yweF2QF9HcXTtbhWQJHLclDHJ5C
+Ha18aKuKFN3XzKFFBPKe1jOSBDGlQ/dQGnKx5fr8wMdObM3oiaTlIJuWbRmEUgJT
+QARjDIi8Z2b0YUhZx+Q9oSXoe3PyVYehJrQX+/BavQKBgQCIr7Zp0rQPbfqcTL+M
+OYHUoNcb14f9f8hXeXHQOqVpsGwxGdRQAU9wbx/4+obKB5xIkzBsVNcJwavisNja
+hegnGjTB/9Hc4m+5bMGwH0bhS2eQO4o+YYM2ypDmFQqDLRfFUlZ5PVHffm/aA9+g
+GanNBCsmtoHtV6CJ1UZ7NmBuIA==
+-----END PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem
new file mode 100644
index 0000000000..501662fc35
--- /dev/null
+++ b/lib/ssh/test/ssh_engine_SUITE_data/rsa_private_key_pwd.pem
@@ -0,0 +1,30 @@
+-----BEGIN ENCRYPTED PRIVATE KEY-----
+MIIFDjBABgkqhkiG9w0BBQ0wMzAbBgkqhkiG9w0BBQwwDgQIh888Iq6gxuMCAggA
+MBQGCCqGSIb3DQMHBAic/11YZ8Nt5gSCBMjG/Jb4qiMoBS50iQvHXqcETPE+0NBr
+jhsn9w94LkdRBstMPAsoKmY98Er96Rnde/NfmqlU9CupKTkd7Ce5poBf72Y6KMED
+cPURyjbGRFsu6x9skXB2obhyKYEqAEF2oQAg4Qbe5v1qXBIgDuC/NgiJnM+w2zCZ
+LkHSZB2/NmcnvDzcgPF7TM8pTO23xCJ33m37qjfWvHsgocVqZmL9wQ4+wr/NMYjJ
+pJvX1OHW1vBsZsXh40WchalYRSB1VeO368QfsE8coRJztqbMzdce9EQdMB6Q6jlO
+cetd3moLIoMP4I7HW0/SgokbycTbRiYSvRyU1TGc2WbW6BrFZV24IckcnnVUFatf
+6HKUcaYLG68dJcRgs5QMGkcmgVvlddENHFmHZlo0eym/xSiUl/AT8/5odscm6ML8
+wW5sneax+TF4J2eYmiN7yjAUCodXVTNYNDVKo6uUhntlymbM0o4UitVIbPIfTDHl
+sxJAEZ7vpuPqeNMxUk6G6zipuEjqsVbnuFSBSZmgKiGYcifRPUmqqINa3DdS4WVx
+xaPWdHbHVRD//ze3h/FsA+1lIE5q2kUE0xXseJA1ISog++kJp14XeaaL2j/tx3Ob
+OsbcaOAD/IUw/ItDt9kn0qzfnar7sS0Wov8AmJQxHmH7Lm93jHTLM05yE0AR/eBr
+Mig2ZdC+9OqVC+GPuBkRjSs8NpltQIDroz6EV9IMwPwXm0szSYoyoPLmlHJUdnLs
+ZUef+au6hYkEJBrvuisagnq5eT/fCV3hsjD7yODebNU2CmBTo6X2PRx/xsBHRMWl
+QkoM9PBdSCnKv6HpHl4pchuoqU2NpFjN0BCaad6aHfZSTnqgzK4bEh1oO6dI8/rB
+/eh71JyFFG5J4xbpaqz5Su01V1iwU5leK5bDwqals4M4+ZGHGciou7qnXUmX2fJl
+r6DlMUa/xy+A2ZG0NuZR05yk2oB3+KVNMgp6zFty3XaxwoNtc8GTLtLnBnIh2rlP
+mE1+I65LRWwrNQalPeOAUrYuEzhyp2Df7a8Ykas5PUH7MGR/S0Ge/dLxtE2bJuK4
+znbLAsGhvo/SbNxYqIp6D4iDtd3va6yUGncy41paA/vTKFVvXZDrXcwJQYYCVOGT
+OwdzNuozU8Dc7oxsd8oakfC46kvmVaOrGvZbm56PFfprcaL/Hslska5xxEni/eZe
+WRxZbCBhAVqS1pn5zkDQVUe9uFlR/x39Qi01HIlKLBsjpSs6qQsFArMe8hgXmXLG
+xP+dyVuOE18NzSewdEjeqSRKIM7Qi8EOjZsI4HdSRBY7bh9VhmaVXDZiCSf33TTE
+3y8nimzQAeuGoYg6WqHmWWC2Qnpki2HlaIH/ayXEyQWkP/qvg61e8ovdg9Fy8JOO
+0AacXVt5zj0q00AW5bKx7usi4NIjZedi86hUm6H19aBm7r86BKjwYTEI/GOcdrbV
+9HC/8ayOimgwiAG3gq+aLioWym+Z6KnsbVd7XReVbvM/InQx54WA2y5im0A+/c67
+oQFFPV84XGX9waeqv/K4Wzkm6HW+qVAEM67482VGOf0PVrlQMno6dOotT/Y7ljoZ
+2iz0LmN9yylJnLPDrr1i6gzbs5OhhUgbF5LI2YP2wWdCZTl/DrKSIvQZWl8U+tw3
+ciA=
+-----END ENCRYPTED PRIVATE KEY-----
diff --git a/lib/ssh/test/ssh_key_cb_engine_keys.erl b/lib/ssh/test/ssh_key_cb_engine_keys.erl
new file mode 100644
index 0000000000..fc9cbfd49b
--- /dev/null
+++ b/lib/ssh/test/ssh_key_cb_engine_keys.erl
@@ -0,0 +1,62 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015-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%
+%%
+
+%%
+%%----------------------------------------------------------------------
+
+%% Note: This module is used by ssh_basic_SUITE
+
+-module(ssh_key_cb_engine_keys).
+-behaviour(ssh_server_key_api).
+-compile(export_all).
+
+host_key(SshAlg, Options) ->
+ KBopts = proplists:get_value(key_cb_private, Options, []),
+ Engine = proplists:get_value(engine, KBopts),
+ case proplists:get_value(SshAlg, KBopts) of
+ undefined ->
+ {error, {unknown_alg,SshAlg}};
+ KeyId ->
+ case crypto_alg(SshAlg) of
+ undefined ->
+ {error, {unsupported_alg,SshAlg}};
+ CryptoAlg ->
+ PrivKey = #{engine => Engine,
+ key_id => KeyId,
+ algorithm => CryptoAlg},
+ %% Is there a key with this reference ?
+ case crypto:privkey_to_pubkey(CryptoAlg, PrivKey) of
+ [_|_] ->
+ {ok, PrivKey};
+ _ ->
+ {error, {no_hostkey,SshAlg}}
+ end
+ end
+ end.
+
+is_auth_key(_PublicUserKey, _User, _Options) ->
+ false.
+
+
+
+crypto_alg('ssh-rsa') -> rsa;
+crypto_alg('ssh-dss') -> dss;
+crypto_alg(_) -> undefined.
+
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 e80fd59a7f..8fcda78ed5 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -69,7 +69,9 @@
<p><c>| {cert, public_key:der_encoded()}</c></p>
<p><c>| {certfile, path()}</c></p>
<p><c>| {key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
- | 'PrivateKeyInfo', public_key:der_encoded()}}</c></p>
+ | 'PrivateKeyInfo', public_key:der_encoded()} |
+ #{algorithm := rsa | dss | ecdsa,
+ engine := crypto:engine_ref(), key_id := crypto:key_id(), password => crypto:password()}</c></p>
<p><c>| {keyfile, path()}</c></p>
<p><c>| {password, string()}</c></p>
<p><c>| {cacerts, [public_key:der_encoded()]}</c></p>
@@ -201,9 +203,15 @@
<tag><c>{certfile, path()}</c></tag>
<item><p>Path to a file containing the user certificate.</p></item>
- <tag><c>{key, {'RSAPrivateKey'| 'DSAPrivateKey' | 'ECPrivateKey'
- |'PrivateKeyInfo', public_key:der_encoded()}}</c></tag>
- <item><p>The DER-encoded user's private key. If this option
+ <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: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>
<tag><c>{keyfile, path()}</c></tag>
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.erl b/lib/ssl/src/ssl.erl
index 60118549e4..4007e44a83 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -896,7 +896,8 @@ validate_option(key, {KeyType, Value}) when is_binary(Value),
KeyType == 'ECPrivateKey';
KeyType == 'PrivateKeyInfo' ->
{KeyType, Value};
-
+validate_option(key, #{algorithm := _} = Value) ->
+ Value;
validate_option(keyfile, undefined) ->
<<>>;
validate_option(keyfile, Value) when is_binary(Value) ->
diff --git a/lib/ssl/src/ssl_config.erl b/lib/ssl/src/ssl_config.erl
index e4611995ec..022fb7eac0 100644
--- a/lib/ssl/src/ssl_config.erl
+++ b/lib/ssl/src/ssl_config.erl
@@ -91,7 +91,15 @@ init_certificates(undefined, #{pem_cache := PemCache} = Config, CertFile, server
end;
init_certificates(Cert, Config, _, _) ->
{ok, Config#{own_certificate => Cert}}.
-
+init_private_key(_, #{algorithm := Alg} = Key, <<>>, _Password, _Client) when Alg == ecdsa;
+ Alg == rsa;
+ Alg == dss ->
+ case maps:is_key(engine, Key) andalso maps:is_key(key_id, Key) of
+ true ->
+ Key;
+ false ->
+ throw({key, {invalid_key_id, Key}})
+ end;
init_private_key(_, undefined, <<>>, _Password, _Client) ->
undefined;
init_private_key(DbHandle, undefined, KeyFile, Password, _) ->
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 0ee9ee3322..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 ->
@@ -1646,17 +1297,123 @@ digitally_signed(Version, Hashes, HashAlgo, PrivateKey) ->
error:badkey->
throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE, bad_key(PrivateKey)))
end.
-
+do_digitally_signed({3, Minor}, Hash, HashAlgo, #{algorithm := Alg} = Engine)
+ when Minor >= 3 ->
+ crypto:sign(Alg, HashAlgo, {digest, Hash}, maps:remove(algorithm, Engine));
do_digitally_signed({3, Minor}, Hash, HashAlgo, Key) when Minor >= 3 ->
public_key:sign({digest, Hash}, HashAlgo, Key);
-do_digitally_signed(_Version, Hash, HashAlgo, #'DSAPrivateKey'{} = Key) ->
- public_key:sign({digest, Hash}, HashAlgo, Key);
do_digitally_signed(_Version, Hash, _HashAlgo, #'RSAPrivateKey'{} = Key) ->
public_key:encrypt_private(Hash, Key,
[{rsa_pad, rsa_pkcs1_padding}]);
+do_digitally_signed({3, _}, Hash, _,
+ #{algorithm := rsa} = Engine) ->
+ crypto:private_encrypt(rsa, Hash, maps:remove(algorithm, Engine),
+ rsa_pkcs1_padding);
+do_digitally_signed({3, _}, Hash, HashAlgo, #{algorithm := Alg} = Engine) ->
+ crypto:sign(Alg, HashAlgo, {digest, Hash}, maps:remove(algorithm, 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) ->
@@ -1709,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
@@ -1766,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),
@@ -1854,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, _) ->
@@ -1995,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, []).
@@ -2039,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;
@@ -2060,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);
@@ -2124,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;
@@ -2317,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).
@@ -2337,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_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index 24ac34653e..9bb1cbaeb0 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -95,7 +95,8 @@
certfile :: binary(),
cert :: public_key:der_encoded() | secret_printout() | 'undefined',
keyfile :: binary(),
- key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo', public_key:der_encoded()} | secret_printout() | 'undefined',
+ key :: {'RSAPrivateKey' | 'DSAPrivateKey' | 'ECPrivateKey' | 'PrivateKeyInfo',
+ public_key:der_encoded()} | key_map() | secret_printout() | 'undefined',
password :: string() | secret_printout() | 'undefined',
cacerts :: [public_key:der_encoded()] | secret_printout() | 'undefined',
cacertfile :: binary(),
@@ -164,7 +165,15 @@
connection_cb
}).
-
+-type key_map() :: #{algorithm := rsa | dss | ecdsa,
+ %% engine and key_id ought to
+ %% be :=, but putting it in
+ %% the spec gives dialyzer warning
+ %% of correct code!
+ engine => crypto:engine_ref(),
+ key_id => crypto:key_id(),
+ password => crypto:password()
+ }.
-type state_name() :: hello | abbreviated | certify | cipher | connection.
-type gen_fsm_state_return() :: {next_state, state_name(), term()} |
{next_state, state_name(), term(), timeout()} |
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/test/Makefile b/lib/ssl/test/Makefile
index c7e2f402af..aa01552c39 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -44,6 +44,7 @@ MODULES = \
ssl_certificate_verify_SUITE\
ssl_crl_SUITE\
ssl_dist_SUITE \
+ ssl_engine_SUITE\
ssl_handshake_SUITE \
ssl_npn_hello_SUITE \
ssl_npn_handshake_SUITE \
diff --git a/lib/ssl/test/ssl_engine_SUITE.erl b/lib/ssl/test/ssl_engine_SUITE.erl
new file mode 100644
index 0000000000..bc221d35fd
--- /dev/null
+++ b/lib/ssl/test/ssl_engine_SUITE.erl
@@ -0,0 +1,142 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017-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(ssl_engine_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include_lib("common_test/include/ct.hrl").
+-include_lib("public_key/include/public_key.hrl").
+
+%%--------------------------------------------------------------------
+%% Common Test interface functions -----------------------------------
+%%--------------------------------------------------------------------
+all() ->
+ [
+ private_key
+ ].
+
+init_per_suite(Config) ->
+ catch crypto:stop(),
+ try crypto:start() of
+ ok ->
+ ssl_test_lib:clean_start(),
+ case crypto:get_test_engine() of
+ {ok, EngineName} ->
+ try crypto:engine_load(<<"dynamic">>,
+ [{<<"SO_PATH">>, EngineName},
+ <<"LOAD">>],
+ []) of
+ {ok, Engine} ->
+ [{engine, Engine} |Config];
+ {error, Reason} ->
+ ct:pal("Reason ~p", [Reason]),
+ {skip, "No dynamic engine support"}
+ catch error:notsup ->
+ {skip, "No engine support in OpenSSL"}
+ end;
+ {error, notexist} ->
+ {skip, "Test engine not found"}
+ end
+ catch _:_ ->
+ {skip, "Crypto did not start"}
+ end.
+
+end_per_suite(Config) ->
+ Engine = proplists:get_value(engine, Config),
+ crypto:engine_unload(Engine),
+ ssl:stop(),
+ application:stop(crypto).
+
+
+init_per_testcase(_TestCase, Config) ->
+ ssl:stop(),
+ ssl:start(),
+ ssl_test_lib:ct_log_supported_protocol_versions(Config),
+ ct:timetrap({seconds, 10}),
+ Config.
+
+end_per_testcase(_TestCase, Config) ->
+ Config.
+
+%%--------------------------------------------------------------------
+%% Test Cases --------------------------------------------------------
+%%--------------------------------------------------------------------
+
+private_key(Config) when is_list(Config) ->
+ ClientFileBase = filename:join([proplists:get_value(priv_dir, Config), "client_engine"]),
+ ServerFileBase = filename:join([proplists:get_value(priv_dir, Config), "server_engine"]),
+ #{server_config := ServerConf,
+ client_config := ClientConf} = GenCertData =
+ public_key:pkix_test_data(#{server_chain =>
+ #{root => [{key, ssl_test_lib:hardcode_rsa_key(1)}],
+ intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(2)}]],
+ peer => [{key, ssl_test_lib:hardcode_rsa_key(3)}
+ ]},
+ client_chain =>
+ #{root => [{key, ssl_test_lib:hardcode_rsa_key(4)}],
+ intermediates => [[{key, ssl_test_lib:hardcode_rsa_key(5)}]],
+ peer => [{key, ssl_test_lib:hardcode_rsa_key(6)}]}}),
+ [{server_config, FileServerConf},
+ {client_config, FileClientConf}] =
+ x509_test:gen_pem_config_files(GenCertData, ClientFileBase, ServerFileBase),
+
+ Engine = proplists:get_value(engine, Config),
+
+ ClientKey = engine_key(FileClientConf),
+ ServerKey = engine_key(FileServerConf),
+
+ EngineClientConf = [{key, #{algorithm => rsa,
+ engine => Engine,
+ key_id => ClientKey}} | proplists:delete(key, ClientConf)],
+
+ EngineServerConf = [{key, #{algorithm => rsa,
+ engine => Engine,
+ key_id => ServerKey}} | proplists:delete(key, ServerConf)],
+ %% Test with engine
+ test_tls_connection(EngineServerConf, EngineClientConf, Config),
+ %% Test that sofware fallback is available
+ test_tls_connection(ServerConf, [{reuse_sessions, false} |ClientConf], Config).
+
+engine_key(Conf) ->
+ FileStr = proplists:get_value(keyfile, Conf),
+ list_to_binary(FileStr).
+
+
+test_tls_connection(ServerConf, ClientConf, Config) ->
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{verify, verify_peer}
+ | ServerConf]}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{verify, verify_peer} | ClientConf]}]),
+
+ ssl_test_lib:check_result(Server, ok, Client, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
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
diff --git a/make/otp_release_targets.mk b/make/otp_release_targets.mk
index 13b54645ad..23b4416963 100644
--- a/make/otp_release_targets.mk
+++ b/make/otp_release_targets.mk
@@ -94,6 +94,8 @@ $(HTMLDIR)/users_guide.html: $(XML_FILES)
# ------------------------------------------------------------------------
# The following targets just exist in the documentation directory
# ------------------------------------------------------------------------
+.PHONY: xmllint
+
ifneq ($(XML_FILES),)
# ----------------------------------------------------
@@ -108,21 +110,38 @@ $(HTMLDIR)/$(APPLICATION).eix: $(XML_FILES) $(SPECS_FILES)
-xinclude $(TOP_SPECS_PARAM) \
-path $(DOCGEN)/priv/dtd \
-path $(DOCGEN)/priv/dtd_html_entities \
- $(DOCGEN)/priv/xsl/db_eix.xsl book.xml > $@
+ $(DOCGEN)/priv/xsl/db_eix.xsl book.xml > $@
docs: $(HTMLDIR)/$(APPLICATION).eix
-xmllint: $(XML_FILES)
- @echo "Running xmllint"
- @BookFiles=`awk -F\" '/xi:include/ {print $$2}' book.xml`; \
- for i in $$BookFiles; do \
- if [ $$i = "notes.xml" ]; then \
- echo Checking $$i; \
- xmllint --noout --valid --nodefdtd --loaddtd --path $(DOCGEN)/priv/dtd:$(DOCGEN)/priv/dtd_html_entities $$i; \
- else\
- awk -F\" '/xi:include/ {print "echo Checking " $$2 ;print "xmllint --noout --valid --nodefdtd --loaddtd --path $(DOCGEN)/priv/dtd:$(DOCGEN)/priv/dtd_html_entities:$(XMLLINT_SRCDIRS) " $$2}' $$i |sh; \
- fi \
- done
+## Here awk is used to find all xi:include files in $(BOOK_FILES)
+## Then we look into all those files check for xi:includes
+BOOK_XI_INC_FILES:=$(foreach file,$(BOOK_FILES),$(shell awk -F\" '/xi:include/ {print $$2}' $(file))) $(BOOK_FILES)
+ALL_XI_INC_FILES:=$(foreach file,$(BOOK_XI_INC_FILES),$(shell awk -F\" '/xi:include/ {if ("$(dir $(file))" != "./") printf "$(dir $(file))"; print $$2}' $(file))) $(BOOK_XI_INC_FILES)
+
+## These are the patterns of file names that xmllint cannot currently parse
+XI_INC_FILES:=%user_man.xml %usersguide.xml %refman.xml %ref_man.xml %part.xml %book.xml
+
+## These are the files that we should run the xmllint on
+LINT_XI_INC_FILES := $(filter-out $(XI_INC_FILES), $(ALL_XI_INC_FILES))
+
+EMPTY :=
+SPACE := $(EMPTY) $(EMPTY)
+XMLLINT_SRCDIRS:=$(subst $(SPACE),:,$(sort $(foreach file,$(XML_FILES),$(dir $(file)))))
+
+xmllint: $(ALL_XI_INC_FILES)
+## We verify that the $(XML_FILES) variable in the Makefile have exactly
+## the same files as we found out by following xi:include.
+ifneq ($(filter-out $(filter %.xml,$(XML_FILES)),$(ALL_XI_INC_FILES)),)
+ $(error "$(filter-out $(filter %.xml,$(XML_FILES)),$(ALL_XI_INC_FILES)) in $$ALL_XI_INC_FILES but not in $$XML_FILES");
+endif
+ifneq ($(filter-out $(ALL_XI_INC_FILES),$(filter %.xml,$(XML_FILES))),)
+ $(error "$(filter-out $(ALL_XI_INC_FILES),$(filter %.xml,$(XML_FILES))) in $$XML_FILES but not in $$ALL_XI_INC_FILES");
+endif
+ @echo "xmllint $(LINT_XI_INC_FILES)"
+ @xmllint --noout --valid --nodefdtd --loaddtd --path \
+ $(DOCGEN)/priv/dtd:$(DOCGEN)/priv/dtd_html_entities:$(XMLLINT_SRCDIRS) \
+ $(LINT_XI_INC_FILES)
# ----------------------------------------------------
# Local documentation target for testing
@@ -143,6 +162,8 @@ local_copy_of_topdefs:
$(DOCGEN)/priv/js/flipmenu/flip_static.gif \
$(DOCGEN)/priv/js/flipmenu/flipmenu.js $(HTMLDIR)/js/flipmenu
+else
+xmllint:
endif
# ----------------------------------------------------
diff --git a/make/otp_subdir.mk b/make/otp_subdir.mk
index 5734970298..19c744955c 100644
--- a/make/otp_subdir.mk
+++ b/make/otp_subdir.mk
@@ -25,7 +25,7 @@
#
# Targets that don't affect documentation directories
#
-opt debug lcnt release docs release_docs tests release_tests clean depend valgrind static_lib:
+opt debug lcnt release docs release_docs tests release_tests clean depend valgrind static_lib xmllint:
@set -e ; \
app_pwd=`pwd` ; \
if test -f vsn.mk; then \
diff --git a/make/run_make.mk b/make/run_make.mk
index 2591a37cad..bcbbf53f7d 100644
--- a/make/run_make.mk
+++ b/make/run_make.mk
@@ -38,9 +38,5 @@ plain smp frag smp_frag:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile FLAVOR=$@
clean generate depend docs release release_spec release_docs release_docs_spec \
- tests release_tests release_tests_spec static_lib:
+ tests release_tests release_tests_spec static_lib xmllint:
$(make_verbose)$(MAKE) -f $(TARGET)/Makefile $@
-
-
-
-
diff --git a/otp_versions.table b/otp_versions.table
index ba3bccfe67..0cf7a34600 100644
--- a/otp_versions.table
+++ b/otp_versions.table
@@ -1,3 +1,7 @@
+OTP-20.1.7 : public_key-1.5.1 ssl-8.2.2 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 erts-9.1.5 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.4 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.2 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
+OTP-20.1.6 : erts-9.1.5 ssh-4.6.2 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.4 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
+OTP-20.1.5 : erts-9.1.4 inets-6.4.4 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.1 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
+OTP-20.1.4 : inets-6.4.3 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 erts-9.1.3 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.8 ssh-4.6.1 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.3 : diameter-2.1.2 erts-9.1.3 snmp-5.2.8 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 ssh-4.6.1 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.2 : diameter-2.1.1 erts-9.1.2 # asn1-5.0.3 common_test-1.15.2 compiler-7.1.3 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.7 ssh-4.6.1 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
OTP-20.1.1 : compiler-7.1.3 erts-9.1.1 ssh-4.6.1 # asn1-5.0.3 common_test-1.15.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.1 debugger-4.2.3 dialyzer-3.2.2 diameter-2.1 edoc-0.9.1 eldap-1.2.2 erl_docgen-0.7.1 erl_interface-3.10 et-1.6.1 eunit-2.3.4 hipe-3.16.1 ic-4.4.2 inets-6.4.2 jinterface-1.8 kernel-5.4 megaco-3.18.2 mnesia-4.15.1 observer-2.5 odbc-2.12 orber-3.8.3 os_mon-2.4.3 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.5 reltool-0.7.5 runtime_tools-1.12.2 sasl-3.1 snmp-5.2.7 ssl-8.2.1 stdlib-3.4.2 syntax_tools-2.1.3 tools-2.11 wx-1.8.2 xmerl-1.3.15 :
@@ -8,6 +12,7 @@ OTP-20.0.3 : asn1-5.0.2 compiler-7.1.1 erts-9.0.3 ssh-4.5.1 # common_test-1.15.1
OTP-20.0.2 : asn1-5.0.1 erts-9.0.2 kernel-5.3.1 # common_test-1.15.1 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12.1 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4.1 syntax_tools-2.1.2 tools-2.10.1 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0.1 : common_test-1.15.1 erts-9.0.1 runtime_tools-1.12.1 stdlib-3.4.1 tools-2.10.1 # asn1-5.0 compiler-7.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 eldap-1.2.2 erl_docgen-0.7 erl_interface-3.10 et-1.6 eunit-2.3.3 hipe-3.16 ic-4.4.2 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 odbc-2.12 orber-3.8.3 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 syntax_tools-2.1.2 wx-1.8.1 xmerl-1.3.15 :
OTP-20.0 : asn1-5.0 common_test-1.15 compiler-7.1 cosProperty-1.2.2 crypto-4.0 debugger-4.2.2 dialyzer-3.2 diameter-2.0 edoc-0.9 erl_docgen-0.7 erl_interface-3.10 erts-9.0 eunit-2.3.3 hipe-3.16 inets-6.4 jinterface-1.8 kernel-5.3 megaco-3.18.2 mnesia-4.15 observer-2.4 orber-3.8.3 parsetools-2.1.5 public_key-1.4.1 reltool-0.7.4 runtime_tools-1.12 sasl-3.0.4 snmp-5.2.6 ssh-4.5 ssl-8.2 stdlib-3.4 syntax_tools-2.1.2 tools-2.10 wx-1.8.1 xmerl-1.3.15 # cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosTime-1.2.2 cosTransactions-1.3.2 eldap-1.2.2 et-1.6 ic-4.4.2 odbc-2.12 os_mon-2.4.2 otp_mibs-1.1.1 :
+OTP-19.3.6.4 : ssl-8.1.3.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4.1 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 erts-8.3.5.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.3 : compiler-7.0.4.1 erts-8.3.5.3 # asn1-4.0.4 common_test-1.14 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.2 : erts-8.3.5.2 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
OTP-19.3.6.1 : erts-8.3.5.1 # asn1-4.0.4 common_test-1.14 compiler-7.0.4 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7.4 debugger-4.2.1 dialyzer-3.1.1 diameter-1.12.2 edoc-0.8.1 eldap-1.2.2 erl_docgen-0.6.1 erl_interface-3.9.3 et-1.6 eunit-2.3.2 gs-1.6.2 hipe-3.15.4 ic-4.4.2 inets-6.3.9 jinterface-1.7.1 kernel-5.2 megaco-3.18.1 mnesia-4.14.3 observer-2.3.1 odbc-2.12 orber-3.8.2 os_mon-2.4.2 otp_mibs-1.1.1 parsetools-2.1.4 percept-0.9 public_key-1.4 reltool-0.7.3 runtime_tools-1.11.1 sasl-3.0.3 snmp-5.2.5 ssh-4.4.2 ssl-8.1.3 stdlib-3.3 syntax_tools-2.1.1 tools-2.9.1 typer-0.9.12 wx-1.8 xmerl-1.3.14 :
@@ -38,10 +43,13 @@ OTP-19.0.3 : inets-6.3.2 kernel-5.0.1 ssl-8.0.1 # asn1-4.0.3 common_test-1.12.2
OTP-19.0.2 : compiler-7.0.1 erts-8.0.2 stdlib-3.0.1 # asn1-4.0.3 common_test-1.12.2 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0.1 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2.1 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3.1 ssl-8.0 syntax_tools-2.0 tools-2.8.5 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0.1 : dialyzer-3.0.1 erts-8.0.1 inets-6.3.1 observer-2.2.1 ssh-4.3.1 tools-2.8.5 # asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 typer-0.9.11 wx-1.7 xmerl-1.3.11 :
OTP-19.0 : asn1-4.0.3 common_test-1.12.2 compiler-7.0 cosEvent-2.2.1 cosEventDomain-1.2.1 cosFileTransfer-1.2.1 cosNotification-1.2.2 cosProperty-1.2.1 cosTime-1.2.2 cosTransactions-1.3.2 crypto-3.7 debugger-4.2 dialyzer-3.0 diameter-1.12 edoc-0.7.19 eldap-1.2.2 erl_docgen-0.5 erl_interface-3.9 erts-8.0 et-1.6 eunit-2.3 gs-1.6.1 hipe-3.15.1 ic-4.4.1 inets-6.3 jinterface-1.7 kernel-5.0 megaco-3.18.1 mnesia-4.14 observer-2.2 odbc-2.11.2 orber-3.8.2 os_mon-2.4.1 otp_mibs-1.1.1 parsetools-2.1.2 percept-0.9 public_key-1.2 reltool-0.7.1 runtime_tools-1.10 sasl-3.0 snmp-5.2.3 ssh-4.3 ssl-8.0 stdlib-3.0 syntax_tools-2.0 tools-2.8.4 typer-0.9.11 wx-1.7 xmerl-1.3.11 # :
+OTP-18.3.4.7 : ssl-7.3.3.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.4 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.4 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
+OTP-18.3.4.6 : compiler-6.0.3.1 eldap-1.2.1.1 erts-7.3.1.4 ssh-4.2.2.4 # asn1-4.0.2 common_test-1.12.1.1 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4.1 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.5 : crypto-3.6.3.1 erts-7.3.1.3 inets-6.2.4.1 ssh-4.2.2.3 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.4 : erts-7.3.1.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.3 : ssh-4.2.2.2 # asn1-4.0.2 common_test-1.12.1.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.2 : common_test-1.12.1.1 erts-7.3.1.1 ssl-7.3.3.1 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
+OTP-18.3.4.1.1 : ssl-7.3.3.0.1 # asn1-4.0.2 common_test-1.12.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2.1 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4.1 : ssh-4.2.2.1 # asn1-4.0.2 common_test-1.12.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 inets-6.2.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssl-7.3.3 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.4 : inets-6.2.4 ssl-7.3.3 # asn1-4.0.2 common_test-1.12.1 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
OTP-18.3.3 : common_test-1.12.1 inets-6.2.3 ssl-7.3.2 # asn1-4.0.2 compiler-6.0.3 cosEvent-2.2 cosEventDomain-1.2 cosFileTransfer-1.2 cosNotification-1.2.1 cosProperty-1.2 cosTime-1.2.1 cosTransactions-1.3.1 crypto-3.6.3 debugger-4.1.2 dialyzer-2.9 diameter-1.11.2 edoc-0.7.18 eldap-1.2.1 erl_docgen-0.4.2 erl_interface-3.8.2 erts-7.3.1 et-1.5.1 eunit-2.2.13 gs-1.6 hipe-3.15 ic-4.4 jinterface-1.6.1 kernel-4.2 megaco-3.18 mnesia-4.13.4 observer-2.1.2 odbc-2.11.1 orber-3.8.1 os_mon-2.4 ose-1.1 otp_mibs-1.1 parsetools-2.1.1 percept-0.8.11 public_key-1.1.1 reltool-0.7 runtime_tools-1.9.3 sasl-2.7 snmp-5.2.2 ssh-4.2.2 stdlib-2.8 syntax_tools-1.7 test_server-3.10 tools-2.8.3 typer-0.9.10 webtool-0.9.1 wx-1.6.1 xmerl-1.3.10 :
diff --git a/system/doc/efficiency_guide/profiling.xml b/system/doc/efficiency_guide/profiling.xml
index bf50a03fa6..f185456158 100644
--- a/system/doc/efficiency_guide/profiling.xml
+++ b/system/doc/efficiency_guide/profiling.xml
@@ -41,30 +41,87 @@
<p>Erlang/OTP contains several tools to help finding bottlenecks:</p>
<list type="bulleted">
- <item><c>fprof</c> provides the most detailed information about
- where the program time is spent, but it significantly slows down the
- program it profiles.</item>
-
- <item><p><c>eprof</c> provides time information of each function
- used in the program. No call graph is produced, but <c>eprof</c> has
- considerable less impact on the program it profiles.</p>
- <p>If the program is too large to be profiled by <c>fprof</c> or
- <c>eprof</c>, the <c>cover</c> and <c>cprof</c> tools can be used
- to locate code parts that are to be more thoroughly profiled using
- <c>fprof</c> or <c>eprof</c>.</p></item>
-
- <item><c>cover</c> provides execution counts per line per
- process, with less overhead than <c>fprof</c>. Execution counts
- can, with some caution, be used to locate potential performance
- bottlenecks.</item>
-
- <item><c>cprof</c> is the most lightweight tool, but it only
- provides execution counts on a function basis (for all processes,
- not per process).</item>
+ <item><p><seealso marker="tools:fprof"><c>fprof</c></seealso> provides
+ the most detailed information about where the program time is spent,
+ but it significantly slows down the program it profiles.</p></item>
+
+ <item><p><seealso marker="tools:eprof"><c>eprof</c></seealso> provides
+ time information of each function used in the program. No call graph is
+ produced, but <c>eprof</c> has considerable less impact on the program it
+ profiles.</p>
+ <p>If the program is too large to be profiled by <c>fprof</c> or
+ <c>eprof</c>, <c>cprof</c> can be used to locate code parts that
+ are to be more thoroughly profiled using <c>fprof</c> or <c>eprof</c>.</p></item>
+
+ <item><p><seealso marker="tools:cprof"><c>cprof</c></seealso> is the
+ most lightweight tool, but it only provides execution counts on a
+ function basis (for all processes, not per process).</p></item>
+
+ <item><p><seealso marker="runtime_tools:dbg"><c>dbg</c></seealso> is the
+ generic erlang tracing frontend. By using the <c>timestamp</c> or
+ <c>cpu_timestamp</c> options it can be used to time how long function
+ calls in a live system take.</p></item>
+
+ <item><p><seealso marker="tools:lcnt"><c>lcnt</c></seealso> is used
+ to find contention points in the Erlang Run-Time System's internal
+ locking mechanisms. It is useful when looking for bottlenecks in
+ interaction between process, port, ets tables and other entities
+ that can be run in parallel.</p></item>
+
</list>
<p>The tools are further described in
<seealso marker="#profiling_tools">Tools</seealso>.</p>
+
+ <p>There are also several open source tools outside of Erlang/OTP
+ that can be used to help profiling. Some of them are:</p>
+
+ <list type="bulleted">
+ <item><url href="https://github.com/isacssouza/erlgrind">erlgrind</url>
+ can be used to visualize fprof data in kcachegrind.</item>
+ <item><url href="https://github.com/proger/eflame">eflame</url>
+ is an alternative to fprof that displays the profiling output as a flamegraph.</item>
+ <item><url href="https://ferd.github.io/recon/index.html">recon</url>
+ is a collection of Erlang profiling and debugging tools.
+ This tool comes with an accompanying E-book called
+ <url href="https://www.erlang-in-anger.com/">Erlang in Anger</url>.</item>
+ </list>
+ </section>
+
+ <section>
+ <title>Memory profiling</title>
+ <pre>eheap_alloc: Cannot allocate 1234567890 bytes of memory (of type "heap").</pre>
+ <p>The above slogan is one of the more common reasons for Erlang to terminate.
+ For unknown reasons the Erlang Run-Time System failed to allocate memory to
+ use. When this happens a crash dump is generated that contains information
+ about the state of the system as it ran out of mmeory. Use the
+ <seealso marker="observer:cdv"><c>crashdump_viewer</c></seealso> to get a
+ view of the memory is being used. Look for processes with large heaps or
+ many messages, large ets tables, etc.</p>
+ <p>When looking at memory usage in a running system the most basic function
+ to get information from is <seealso marker="erts:erlang#memory/0"><c>
+ erlang:memory()</c></seealso>. It returns the current memory usage
+ of the system. <seealso marker="tools:instrument"><c>instrument(3)</c></seealso>
+ can be used to get a more detailed breakdown of where memory is used.</p>
+ <p>Processes, ports and ets tables can then be inspecting using their
+ respective info functions, i.e.
+ <seealso marker="erts:erlang#process_info_memory"><c>erlang:process_info/2
+ </c></seealso>,
+ <seealso marker="erts:erlang#port_info_memory"><c>erlang:port_info/2
+ </c></seealso> and
+ <seealso marker="stdlib:ets#info/1"><c>ets:info/1</c></seealso>.
+ </p>
+ <p>Sometimes the system can enter a state where the reported memory
+ from <c>erlang:memory(total)</c> is very different from the
+ memory reported by the OS. This can be because of internal
+ fragmentation within the Erlang Run-Time System. Data about
+ how memory is allocated can be retrieved using
+ <seealso marker="erts:erlang#system_info_allocator">
+ <c>erlang:system_info(allocator)</c></seealso>.
+ The data you get from that function is very raw and not very plesant to read.
+ <url href="http://ferd.github.io/recon/recon_alloc.html">recon_alloc</url>
+ can be used to extract useful information from system_info
+ statistics counters.</p>
</section>
<section>
@@ -80,6 +137,22 @@
tools on the whole system. Instead you want to concentrate on
central processes and modules, which contribute for a big part
of the execution.</p>
+
+ <p>There are also some tools that can be used to get a view of the
+ whole system with more or less overhead.</p>
+ <list type="bulleted">
+ <item><seealso marker="observer:observer"><c>observer</c></seealso>
+ is a GUI tool that can connect to remote nodes and display a
+ variety of information about the running system.</item>
+ <item><seealso marker="observer:etop"><c>etop</c></seealso>
+ is a command line tool that can connect to remote nodes and
+ display information similar to what the UNIX tool top shows.</item>
+ <item><seealso marker="runtime_tools:msacc"><c>msacc</c></seealso>
+ allows the user to get a view of what the Erlang Run-Time system
+ is spending its time doing. Has a very low overhead, which makes it
+ useful to run in heavily loaded systems to get some idea of where
+ to start doing more granular profiling.</item>
+ </list>
</section>
<section>
@@ -128,7 +201,7 @@
performance impact. Using <c>fprof</c> is just a matter of
calling a few library functions, see the
<seealso marker="tools:fprof">fprof</seealso> manual page in
- Tools .<c>fprof</c> was introduced in R8.</p>
+ Tools.</p>
</section>
<section>
@@ -142,20 +215,6 @@
</section>
<section>
- <title>cover</title>
- <p>The primary use of <c>cover</c> is coverage analysis to verify
- test cases, making sure that all relevant code is covered.
- <c>cover</c> counts how many times each executable line of code
- is executed when a program is run, on a per module basis.</p>
- <p>Clearly, this information can be used to determine what
- code is run very frequently and can therefore be subject for
- optimization. Using <c>cover</c> is just a matter of calling a
- few library functions, see the
- <seealso marker="tools:cover">cover</seealso> manual page in
- Tools.</p>
- </section>
-
- <section>
<title>cprof</title>
<p><c>cprof</c> is something in between <c>fprof</c> and
<c>cover</c> regarding features. It counts how many times each
@@ -202,16 +261,6 @@
<cell>No</cell>
</row>
<row>
- <cell><c>cover</c></cell>
- <cell>Per module to screen/file</cell>
- <cell>Small</cell>
- <cell>Moderate slowdown</cell>
- <cell>Yes, per line</cell>
- <cell>No</cell>
- <cell>No</cell>
- <cell>No</cell>
- </row>
- <row>
<cell><c>cprof</c></cell>
<cell>Per module to caller</cell>
<cell>Small</cell>
@@ -224,6 +273,37 @@
<tcaption>Tool Summary</tcaption>
</table>
</section>
+
+ <section>
+ <title>dbg</title>
+ <p><c>dbg</c> is a generic Erlang trace tool. By using the
+ <c>timestamp</c> or <c>cpu_timestamp</c> options it can be used
+ as a precision instrument to profile how long time a function
+ call takes for a specific process. This can be very useful when
+ trying to understand where time is spent in a heavily loaded
+ system as it is possible to limit the scope of what is profiled
+ to be very small.
+ For more information, see the
+ <seealso marker="runtime_tools:dbg">dbg</seealso> manual page in
+ Runtime Tools.</p>
+ </section>
+
+ <section>
+ <title>lcnt</title>
+ <p><c>lcnt</c> is used to profile interactions inbetween
+ entities that run in parallel. For example if you have
+ a process that all other processes in the system needs
+ to interact with (maybe it has some global configuration),
+ then <c>lcnt</c> can be used to figure out if the interaction
+ with that process is a problem.</p>
+ <p>In the Erlang Run-time System entities are only run in parallel
+ when there are multiple schedulers. Therefore <c>lcnt</c> will
+ show more contention points (and thus be more useful) on systems
+ using many schedulers on many cores.</p>
+ <p>For more information, see the
+ <seealso marker="tools:lcnt">lcnt</seealso> manual page in Tools.</p>
+ </section>
+
</section>
<section>
@@ -282,4 +362,3 @@
</list>
</section>
</chapter>
-
diff --git a/system/doc/efficiency_guide/xmlfiles.mk b/system/doc/efficiency_guide/xmlfiles.mk
index 88df9417f5..23c0d991b4 100644
--- a/system/doc/efficiency_guide/xmlfiles.mk
+++ b/system/doc/efficiency_guide/xmlfiles.mk
@@ -29,5 +29,5 @@ EFF_GUIDE_CHAPTER_FILES = \
processes.xml \
profiling.xml \
tablesDatabases.xml \
- drivers.xml
-
+ drivers.xml \
+ retired_myths.xml
diff --git a/system/doc/reference_manual/xmlfiles.mk b/system/doc/reference_manual/xmlfiles.mk
index 61637ae701..fffcbdd911 100644
--- a/system/doc/reference_manual/xmlfiles.mk
+++ b/system/doc/reference_manual/xmlfiles.mk
@@ -30,5 +30,6 @@ REF_MAN_CHAPTER_FILES = \
processes.xml \
distributed.xml \
code_loading.xml \
- ports.xml
-
+ ports.xml \
+ character_set.xml \
+ typespec.xml
diff --git a/system/doc/top/Makefile b/system/doc/top/Makefile
index 116ec688fa..b6a80aadf5 100644
--- a/system/doc/top/Makefile
+++ b/system/doc/top/Makefile
@@ -50,6 +50,8 @@ include ../tutorial/xmlfiles.mk
include ../design_principles/xmlfiles.mk
include ../oam/xmlfiles.mk
+BOOK_FILES = book.xml
+
XML_FILES = \
$(INST_GUIDE_CHAPTER_FILES:%=../installation_guide/%) \
$(SYSTEM_PRINCIPLES_CHAPTER_FILES:%=../system_principles/%) \
@@ -70,9 +72,9 @@ XML_FILES = \
../efficiency_guide/part.xml \
../tutorial/part.xml \
../design_principles/part.xml \
- ../oam/part.xml
+ ../oam/part.xml \
+ $(BOOK_FILES)
-BOOK_FILES = book.xml
XMLLINT_SRCDIRS= ../installation_guide:../system_principles:../embedded:../getting_started:../reference_manual:../programming_examples:../efficiency_guide:../tutorial:../design_principles:../oam
HTMLDIR= ../html